graphql-engine/server/src-lib/Hasura/GraphQL/Schema/Table.hs
Daniel Harvey 8f4692d871 chore(server): move table related things to Hasura.Table.*
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9174
GitOrigin-RevId: d440647ac04b9c1717ecf22a2dbfb8c5f22b7c7a
2023-05-17 08:55:32 +00:00

295 lines
11 KiB
Haskell

{-# LANGUAGE TemplateHaskellQuotes #-}
-- | Helper functions for generating the schema of database tables
module Hasura.GraphQL.Schema.Table
( getTableGQLName,
tableSelectColumnsEnum,
tableSelectColumnsPredEnum,
tableUpdateColumnsEnum,
updateColumnsPlaceholderParser,
tableSelectPermissions,
tableSelectFields,
tableColumns,
tableSelectColumns,
tableUpdateColumns,
getTableIdentifierName,
)
where
import Data.Has
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as Set
import Data.Text.Casing (GQLNameIdentifier)
import Data.Text.Casing qualified as C
import Data.Text.Extended
import Hasura.Base.Error (QErr)
import Hasura.GraphQL.Schema.Backend
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Parser (Kind (..), Parser)
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Typename
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.Roles (RoleName)
import Hasura.RQL.Types.SchemaCache hiding (askTableInfo)
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.Table.Cache
import Language.GraphQL.Draft.Syntax qualified as G
-- | Helper function to get the table GraphQL name. A table may have a
-- custom name configured with it. When the custom name exists, the GraphQL nodes
-- that are generated according to the custom name. For example: Let's say,
-- we have a table called `users address`, the name of the table is not GraphQL
-- compliant so we configure the table with a GraphQL compliant name,
-- say `users_address`
-- The generated top-level nodes of this table will be like `users_address`,
-- `insert_users_address` etc
getTableGQLName ::
forall b m.
(Backend b, MonadError QErr m) =>
TableInfo b ->
m G.Name
getTableGQLName tableInfo = do
let coreInfo = _tiCoreInfo tableInfo
tableName = _tciName coreInfo
tableCustomName = _tcCustomName $ _tciCustomConfig coreInfo
tableCustomName
`onNothing` tableGraphQLName @b tableName
`onLeft` throwError
-- | similar to @getTableGQLName@ but returns table name as a list with name pieces
-- instead of concatenating schema and table name together.
getTableIdentifierName ::
forall b m.
(Backend b, MonadError QErr m) =>
TableInfo b ->
m (C.GQLNameIdentifier)
getTableIdentifierName tableInfo =
let coreInfo = _tiCoreInfo tableInfo
tableName = _tciName coreInfo
tableCustomName = fmap C.fromCustomName $ _tcCustomName $ _tciCustomConfig coreInfo
in onNothing
tableCustomName
(liftEither $ getTableIdentifier @b tableName)
-- | Table select columns enum
--
-- Parser for an enum type that matches the columns of the given
-- table. Used as a parameter for "distinct", among others. Maps to
-- the table_select_column object.
--
-- Return Nothing if there's no column the current user has "select"
-- permissions for.
tableSelectColumnsEnum ::
forall b r m n.
(MonadBuildSchema b r m n) =>
TableInfo b ->
SchemaT r m (Maybe (Parser 'Both n (Column b)))
tableSelectColumnsEnum tableInfo = do
customization <- retrieve $ _siCustomization @b
let tCase = _rscNamingConvention customization
mkTypename = runMkTypename $ _rscTypeNames customization
tableGQLName <- getTableIdentifierName @b tableInfo
columns <- tableSelectColumns tableInfo
let enumName = mkTypename $ applyTypeNameCaseIdentifier tCase $ mkTableSelectColumnTypeName tableGQLName
description =
Just $
G.Description $
"select columns of table " <>> tableInfoName tableInfo
-- We noticed many 'Definition's allocated, from 'define' below, so memoize
-- to gain more sharing and lower memory residency.
case nonEmpty $ map (define . ciName &&& ciColumn) columns of
Nothing -> pure Nothing
Just columnDefinitions ->
Just
<$> P.memoizeOn
'tableSelectColumnsEnum
(enumName, description, columns)
( pure $
P.enum enumName description columnDefinitions
)
where
define name =
P.Definition name (Just $ G.Description "column name") Nothing [] P.EnumValueInfo
-- | Table select columns enum of a certain type.
--
-- Parser for an enum type that matches, of a given table, certain columns which
-- satisfy a predicate. Used as a parameter for aggregation predicate
-- arguments, among others. Maps to the table_select_column object.
--
-- Return Nothing if there's no column the current user has "select"
-- permissions for.
tableSelectColumnsPredEnum ::
forall b r m n.
(MonadBuildSchema b r m n) =>
(ColumnType b -> Bool) ->
GQLNameIdentifier ->
TableInfo b ->
SchemaT r m (Maybe (Parser 'Both n (Column b)))
tableSelectColumnsPredEnum columnPredicate predName tableInfo = do
customization <- retrieve $ _siCustomization @b
let tCase = _rscNamingConvention customization
mkTypename = runMkTypename $ _rscTypeNames customization
predName' = applyFieldNameCaseIdentifier tCase predName
tableGQLName <- getTableIdentifierName @b tableInfo
columns <- filter (columnPredicate . ciType) <$> tableSelectColumns tableInfo
let enumName = mkTypename $ applyTypeNameCaseIdentifier tCase $ mkSelectColumnPredTypeName tableGQLName predName
description =
Just $
G.Description $
"select \"" <> G.unName predName' <> "\" columns of table " <>> tableInfoName tableInfo
pure $
P.enum enumName description
<$> nonEmpty
[ ( define $ ciName column,
ciColumn column
)
| column <- columns
]
where
define name =
P.Definition name (Just $ G.Description "column name") Nothing [] P.EnumValueInfo
-- | Table update columns enum
--
-- Parser for an enum type that matches the columns of the given
-- table. Used for conflict resolution in "insert" mutations, among
-- others. Maps to the table_update_column object.
tableUpdateColumnsEnum ::
forall b r m n.
(MonadBuildSchema b r m n) =>
TableInfo b ->
SchemaT r m (Maybe (Parser 'Both n (Column b)))
tableUpdateColumnsEnum tableInfo = do
roleName <- retrieve scRole
customization <- retrieve $ _siCustomization @b
let tCase = _rscNamingConvention customization
mkTypename = runMkTypename $ _rscTypeNames customization
tableGQLName <- getTableIdentifierName tableInfo
let enumName = mkTypename $ applyTypeNameCaseIdentifier tCase $ mkTableUpdateColumnTypeName tableGQLName
tableName = tableInfoName tableInfo
enumDesc = Just $ G.Description $ "update columns of table " <>> tableName
enumValues = do
column <- tableUpdateColumns roleName tableInfo
pure (define $ ciName column, ciColumn column)
pure $ P.enum enumName enumDesc <$> nonEmpty enumValues
where
define name = P.Definition name (Just $ G.Description "column name") Nothing [] P.EnumValueInfo
-- If there's no column for which the current user has "update"
-- permissions, this functions returns an enum that only contains a
-- placeholder, so as to still allow this type to exist in the schema.
updateColumnsPlaceholderParser ::
forall b r m n.
(MonadBuildSchema b r m n) =>
TableInfo b ->
SchemaT r m (Parser 'Both n (Maybe (Column b)))
updateColumnsPlaceholderParser tableInfo = do
customization <- retrieve $ _siCustomization @b
let tCase = _rscNamingConvention customization
mkTypename = runMkTypename $ _rscTypeNames customization
maybeEnum <- tableUpdateColumnsEnum tableInfo
case maybeEnum of
Just e -> pure $ Just <$> e
Nothing -> do
tableGQLName <- getTableIdentifierName tableInfo
let enumName = mkTypename $ applyTypeNameCaseIdentifier tCase $ mkTableUpdateColumnTypeName tableGQLName
pure $
P.enum enumName (Just $ G.Description $ "placeholder for update columns of table " <> tableInfoName tableInfo <<> " (current role has no relevant permissions)") $
pure
( P.Definition @_ @P.EnumValueInfo Name.__PLACEHOLDER (Just $ G.Description "placeholder (do not use)") Nothing [] P.EnumValueInfo,
Nothing
)
tableSelectPermissions :: RoleName -> TableInfo b -> Maybe (SelPermInfo b)
tableSelectPermissions role tableInfo = _permSel $ getRolePermInfo role tableInfo
tableSelectFields ::
forall b r m.
( Backend b,
MonadError QErr m,
MonadReader r m,
Has SchemaContext r,
Has (SourceInfo b) r
) =>
TableInfo b ->
m [FieldInfo b]
tableSelectFields tableInfo = do
roleName <- retrieve scRole
let tableFields = _tciFieldInfoMap . _tiCoreInfo $ tableInfo
permissions = tableSelectPermissions roleName tableInfo
filterM (canBeSelected roleName permissions) $ HashMap.elems tableFields
where
canBeSelected _ Nothing _ = pure False
canBeSelected _ (Just permissions) (FIColumn columnInfo) =
pure $! HashMap.member (ciColumn columnInfo) (spiCols permissions)
canBeSelected _ (Just permissions) (FINestedObject NestedObjectInfo {..}) =
pure $! HashMap.member _noiColumn (spiCols permissions)
canBeSelected role _ (FIRelationship relationshipInfo) = do
case riTarget relationshipInfo of
RelTargetNativeQuery _ -> error "tableSelectFields RelTargetNativeQuery"
RelTargetTable tableName -> do
tableInfo' <- askTableInfo tableName
pure $! isJust $ tableSelectPermissions @b role tableInfo'
canBeSelected role (Just permissions) (FIComputedField computedFieldInfo) =
case computedFieldReturnType @b (_cfiReturnType computedFieldInfo) of
ReturnsScalar _ ->
pure $! HashMap.member (_cfiName computedFieldInfo) $ spiComputedFields permissions
ReturnsTable tableName -> do
tableInfo' <- askTableInfo tableName
pure $! isJust $ tableSelectPermissions @b role tableInfo'
ReturnsOthers -> pure False
canBeSelected _ _ (FIRemoteRelationship _) = pure True
tableColumns ::
forall b. TableInfo b -> [ColumnInfo b]
tableColumns tableInfo =
mapMaybe columnInfo . HashMap.elems . _tciFieldInfoMap . _tiCoreInfo $ tableInfo
where
columnInfo (FIColumn ci) = Just ci
columnInfo _ = Nothing
-- | Get the columns of a table that my be selected under the given select
-- permissions.
tableSelectColumns ::
forall b r m.
( Backend b,
MonadError QErr m,
MonadReader r m,
Has SchemaContext r,
Has (SourceInfo b) r
) =>
TableInfo b ->
m [ColumnInfo b]
tableSelectColumns tableInfo =
mapMaybe columnInfo <$> tableSelectFields tableInfo
where
columnInfo (FIColumn ci) = Just ci
columnInfo _ = Nothing
-- | Get the columns of a table that my be updated under the given update
-- permissions.
tableUpdateColumns ::
forall b.
(Backend b) =>
RoleName ->
TableInfo b ->
[ColumnInfo b]
tableUpdateColumns role tableInfo =
let permissions = _permUpd $ getRolePermInfo role tableInfo
in filter (isUpdatable permissions) $ tableColumns tableInfo
where
isUpdatable :: Maybe (UpdPermInfo b) -> ColumnInfo b -> Bool
isUpdatable (Just permissions) columnInfo = columnIsUpdatable && columnIsPermitted && columnHasNoPreset
where
columnIsUpdatable = _cmIsUpdatable (ciMutability columnInfo)
columnIsPermitted = Set.member (ciColumn columnInfo) (upiCols permissions)
columnHasNoPreset = not (HashMap.member (ciColumn columnInfo) (upiSet permissions))
isUpdatable Nothing _ = False