mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
2a9bc2354f
* validation support for unions and interfaces * refactor SQL generation logic for improved readability * '/v1/relay' endpoint for relay schema * implement 'Node' interface and top level 'node' field resolver * add relay toggle on graphiql * fix explain api response & index plan id with query type * add hasura mutations to relay * add relay pytests * update CHANGELOG.md Co-authored-by: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Co-authored-by: Rishichandra Wawhal <rishi@hasura.io> Co-authored-by: Rikin Kachhia <54616969+rikinsk@users.noreply.github.com>
962 lines
39 KiB
Haskell
962 lines
39 KiB
Haskell
module Hasura.GraphQL.Schema
|
||
( mkGCtxMap
|
||
, GCtxMap
|
||
, GCtx(..)
|
||
, QueryCtx(..)
|
||
, MutationCtx(..)
|
||
, InsCtx(..)
|
||
, InsCtxMap
|
||
, RelationInfoMap
|
||
|
||
, checkConflictingNode
|
||
, checkSchemaConflicts
|
||
|
||
-- * To be consumed by Hasura.GraphQL.RelaySchema module
|
||
, mkGCtx
|
||
, isAggregateField
|
||
, qualObjectToName
|
||
, ppGCtx
|
||
, getSelPerm
|
||
, isValidObjectName
|
||
, mkAdminSelFlds
|
||
, noFilter
|
||
, getGCtx
|
||
, getMutationRootFieldsRole
|
||
, makeFieldMap
|
||
, mkMutationTypesAndFieldsRole
|
||
, mkAdminInsCtx
|
||
, mkValidConstraints
|
||
, getValidCols
|
||
, mkInsCtx
|
||
) where
|
||
|
||
import Control.Lens.Extended hiding (op)
|
||
import Data.List.Extended (duplicates)
|
||
|
||
import qualified Data.HashMap.Strict as Map
|
||
import qualified Data.HashSet as Set
|
||
import qualified Data.Sequence as Seq
|
||
import qualified Data.Text as T
|
||
import qualified Language.GraphQL.Draft.Syntax as G
|
||
|
||
import Hasura.GraphQL.Context
|
||
import Hasura.GraphQL.Resolve.Context
|
||
import Hasura.GraphQL.Validate.Types
|
||
import Hasura.Prelude
|
||
import Hasura.RQL.DML.Internal (mkAdminRolePermInfo)
|
||
import Hasura.RQL.Types
|
||
import Hasura.Session
|
||
import Hasura.SQL.Types
|
||
|
||
import Hasura.GraphQL.Schema.Action
|
||
import Hasura.GraphQL.Schema.BoolExp
|
||
import Hasura.GraphQL.Schema.Builder
|
||
import Hasura.GraphQL.Schema.Common
|
||
import Hasura.GraphQL.Schema.Function
|
||
import Hasura.GraphQL.Schema.Merge
|
||
import Hasura.GraphQL.Schema.Mutation.Common
|
||
import Hasura.GraphQL.Schema.Mutation.Delete
|
||
import Hasura.GraphQL.Schema.Mutation.Insert
|
||
import Hasura.GraphQL.Schema.Mutation.Update
|
||
import Hasura.GraphQL.Schema.OrderBy
|
||
import Hasura.GraphQL.Schema.Select
|
||
|
||
type TableSchemaCtx = RoleContext (TyAgg, RootFields, InsCtxMap)
|
||
|
||
getInsPerm :: TableInfo -> RoleName -> Maybe InsPermInfo
|
||
getInsPerm tabInfo roleName
|
||
| roleName == adminRoleName = _permIns $ mkAdminRolePermInfo (_tiCoreInfo tabInfo)
|
||
| otherwise = Map.lookup roleName rolePermInfoMap >>= _permIns
|
||
where
|
||
rolePermInfoMap = _tiRolePermInfoMap tabInfo
|
||
|
||
getTabInfo
|
||
:: MonadError QErr m
|
||
=> TableCache -> QualifiedTable -> m TableInfo
|
||
getTabInfo tc t =
|
||
onNothing (Map.lookup t tc) $
|
||
throw500 $ "table not found: " <>> t
|
||
|
||
isValidObjectName :: (ToTxt a) => QualifiedObject a -> Bool
|
||
isValidObjectName = G.isValidName . qualObjectToName
|
||
|
||
isValidCol :: PGColumnInfo -> Bool
|
||
isValidCol = G.isValidName . pgiName
|
||
|
||
isValidRel :: ToTxt a => RelName -> QualifiedObject a -> Bool
|
||
isValidRel rn rt = G.isValidName (mkRelName rn) && isValidObjectName rt
|
||
|
||
isValidRemoteRel :: RemoteFieldInfo -> Bool
|
||
isValidRemoteRel =
|
||
G.isValidName . mkRemoteRelationshipName . _rfiName
|
||
|
||
isValidField :: FieldInfo -> Bool
|
||
isValidField = \case
|
||
FIColumn colInfo -> isValidCol colInfo
|
||
FIRelationship (RelInfo rn _ _ remTab _) -> isValidRel rn remTab
|
||
FIComputedField info -> G.isValidName $ mkComputedFieldName $ _cfiName info
|
||
FIRemoteRelationship remoteField -> isValidRemoteRel remoteField
|
||
|
||
upsertable :: [ConstraintName] -> Bool -> Bool -> Bool
|
||
upsertable uniqueOrPrimaryCons isUpsertAllowed isAView =
|
||
not (null uniqueOrPrimaryCons) && isUpsertAllowed && not isAView
|
||
|
||
getValidCols
|
||
:: FieldInfoMap FieldInfo -> [PGColumnInfo]
|
||
getValidCols = filter isValidCol . getCols
|
||
|
||
getValidRels :: FieldInfoMap FieldInfo -> [RelInfo]
|
||
getValidRels = filter isValidRel' . getRels
|
||
where
|
||
isValidRel' (RelInfo rn _ _ remTab _) = isValidRel rn remTab
|
||
|
||
mkValidConstraints :: [ConstraintName] -> [ConstraintName]
|
||
mkValidConstraints =
|
||
filter (G.isValidName . G.Name . getConstraintTxt)
|
||
|
||
isRelNullable
|
||
:: FieldInfoMap FieldInfo -> RelInfo -> Bool
|
||
isRelNullable fim ri = isNullable
|
||
where
|
||
lCols = Map.keys $ riMapping ri
|
||
allCols = getValidCols fim
|
||
lColInfos = getColInfos lCols allCols
|
||
isNullable = any pgiIsNullable lColInfos
|
||
|
||
isAggregateField :: G.Name -> Bool
|
||
isAggregateField = flip elem (numAggregateOps <> compAggregateOps)
|
||
|
||
mkComputedFieldFunctionArgSeq :: Seq.Seq FunctionArg -> ComputedFieldFunctionArgSeq
|
||
mkComputedFieldFunctionArgSeq inputArgs =
|
||
Seq.fromList $ procFuncArgs inputArgs faName $
|
||
\fa t -> FunctionArgItem (G.Name t) (faName fa) (faHasDefault fa)
|
||
|
||
mkMutationTypesAndFieldsRole
|
||
:: QualifiedTable
|
||
-> Maybe ([PGColumnInfo], RelationInfoMap)
|
||
-- ^ insert permission
|
||
-> Maybe [SelField]
|
||
-- ^ select permission
|
||
-> Maybe [PGColumnInfo]
|
||
-- ^ update cols
|
||
-> Maybe ()
|
||
-- ^ delete cols
|
||
-> Maybe (PrimaryKey PGColumnInfo)
|
||
-> [ConstraintName]
|
||
-- ^ constraints
|
||
-> Maybe ViewInfo
|
||
-> (TypeMap, FieldMap)
|
||
mkMutationTypesAndFieldsRole tn insPermM selFldsM updColsM delPermM pkeyCols constraints viM =
|
||
(mkTyInfoMap allTypes, fieldMap)
|
||
where
|
||
|
||
allTypes = relInsInpObjTys <> onConflictTypes <> jsonOpTys
|
||
<> mutationTypes <> referencedEnumTypes
|
||
|
||
upsertPerm = isJust updColsM
|
||
isUpsertable = upsertable constraints upsertPerm $ isJust viM
|
||
updatableCols = maybe [] (map pgiName) updColsM
|
||
onConflictTypes = mkOnConflictTypes tn constraints updatableCols isUpsertable
|
||
jsonOpTys = fromMaybe [] updJSONOpInpObjTysM
|
||
relInsInpObjTys = maybe [] (map TIInpObj) $
|
||
mutHelper viIsInsertable relInsInpObjsM
|
||
|
||
mutationTypes = catMaybes
|
||
[ TIInpObj <$> mutHelper viIsInsertable insInpObjM
|
||
, TIInpObj <$> mutHelper viIsUpdatable updSetInpObjM
|
||
, TIInpObj <$> mutHelper viIsUpdatable updIncInpObjM
|
||
, TIInpObj <$> mutHelper viIsUpdatable primaryKeysInpObjM
|
||
, TIObj <$> mutRespObjM
|
||
]
|
||
|
||
mutHelper :: (ViewInfo -> Bool) -> Maybe a -> Maybe a
|
||
mutHelper f objM = bool Nothing objM $ isMutable f viM
|
||
|
||
fieldMap = Map.unions $ catMaybes [insInpObjFldsM, updSetInpObjFldsM]
|
||
|
||
-- helper
|
||
mkColFldMap ty cols = Map.fromList $ flip map cols $
|
||
\ci -> ((ty, pgiName ci), RFPGColumn ci)
|
||
|
||
-- insert input type
|
||
insInpObjM = uncurry (mkInsInp tn) <$> insPermM
|
||
-- column fields used in insert input object
|
||
insInpObjFldsM = (mkColFldMap (mkInsInpTy tn) . fst) <$> insPermM
|
||
-- relationship input objects
|
||
relInsInpObjsM = mkRelInsInps tn isUpsertable <$ insPermM
|
||
-- update set input type
|
||
updSetInpObjM = mkUpdSetInp tn <$> updColsM
|
||
-- update increment input type
|
||
updIncInpObjM = mkUpdIncInp tn updColsM
|
||
-- update json operator input type
|
||
updJSONOpInpObjsM = mkUpdJSONOpInp tn <$> updColsM
|
||
updJSONOpInpObjTysM = map TIInpObj <$> updJSONOpInpObjsM
|
||
-- fields used in set input object
|
||
updSetInpObjFldsM = mkColFldMap (mkUpdSetTy tn) <$> updColsM
|
||
|
||
-- primary key columns input object for update_by_pk
|
||
primaryKeysInpObjM = guard (isJust selFldsM) *> (mkPKeyColumnsInpObj tn <$> pkeyCols)
|
||
|
||
-- mut resp obj
|
||
mutRespObjM =
|
||
if isMut
|
||
then Just $ mkMutRespObj tn $ isJust selFldsM
|
||
else Nothing
|
||
|
||
isMut = (isJust insPermM || isJust updColsM || isJust delPermM)
|
||
&& any (`isMutable` viM) [viIsInsertable, viIsUpdatable, viIsDeletable]
|
||
|
||
-- the types for all enums that are /referenced/ by this table (not /defined/ by this table;
|
||
-- there isn’t actually any need to generate a GraphQL enum type for an enum table if it’s
|
||
-- never referenced anywhere else)
|
||
referencedEnumTypes =
|
||
let allColumnInfos =
|
||
(selFldsM ^.. _Just.traverse._SFPGColumn)
|
||
<> (insPermM ^. _Just._1)
|
||
<> (updColsM ^. _Just)
|
||
allEnumReferences = allColumnInfos ^.. traverse.to pgiType._PGColumnEnumReference
|
||
in flip map allEnumReferences $ \enumReference@(EnumReference referencedTableName _) ->
|
||
let typeName = mkTableEnumType referencedTableName
|
||
in TIEnum $ mkHsraEnumTyInfo Nothing typeName (EnumValuesReference enumReference)
|
||
|
||
-- see Note [Split schema generation (TODO)]
|
||
mkTyAggRole
|
||
:: QualifiedTable
|
||
-> Maybe PGDescription
|
||
-- ^ Postgres description
|
||
-> Maybe ([PGColumnInfo], RelationInfoMap)
|
||
-- ^ insert permission
|
||
-> Maybe (Bool, [SelField])
|
||
-- ^ select permission
|
||
-> Maybe [PGColumnInfo]
|
||
-- ^ update cols
|
||
-> Maybe ()
|
||
-- ^ delete cols
|
||
-> Maybe (PrimaryKey PGColumnInfo)
|
||
-> [ConstraintName]
|
||
-- ^ constraints
|
||
-> Maybe ViewInfo
|
||
-> [FunctionInfo]
|
||
-- ^ all functions
|
||
-> TyAgg
|
||
mkTyAggRole tn descM insPermM selPermM updColsM delPermM pkeyCols constraints viM funcs =
|
||
let (mutationTypes, mutationFields) =
|
||
mkMutationTypesAndFieldsRole tn insPermM selFldsM updColsM delPermM pkeyCols constraints viM
|
||
in TyAgg (mkTyInfoMap allTypes <> mutationTypes)
|
||
(fieldMap <> mutationFields)
|
||
scalars ordByCtx
|
||
where
|
||
|
||
ordByCtx = fromMaybe Map.empty ordByCtxM
|
||
funcInpArgTys = bool [] (map TIInpObj funcArgInpObjs) $ isJust selFldsM
|
||
|
||
allTypes = queryTypes <> aggQueryTypes
|
||
<> funcInpArgTys <> computedFieldFuncArgsInps
|
||
|
||
queryTypes = map TIObj selectObjects <>
|
||
catMaybes
|
||
[ TIInpObj <$> boolExpInpObjM
|
||
, TIInpObj <$> ordByInpObjM
|
||
, TIEnum <$> selColInpTyM
|
||
]
|
||
aggQueryTypes = map TIObj aggObjs <> map TIInpObj aggOrdByInps
|
||
|
||
fieldMap = Map.unions $ catMaybes [boolExpInpObjFldsM , selObjFldsM]
|
||
scalars = selByPkScalarSet <> funcArgScalarSet <> computedFieldFuncArgScalars
|
||
|
||
selFldsM = snd <$> selPermM
|
||
selColNamesM = (map pgiName . getPGColumnFields) <$> selFldsM
|
||
selColInpTyM = mkSelColumnTy tn <$> selColNamesM
|
||
|
||
-- boolexp input type
|
||
boolExpInpObjM = case selFldsM of
|
||
Just selFlds -> Just $ mkBoolExpInp tn selFlds
|
||
-- no select permission
|
||
Nothing ->
|
||
-- but update/delete is defined
|
||
if isJust updColsM || isJust delPermM
|
||
then Just $ mkBoolExpInp tn []
|
||
else Nothing
|
||
|
||
-- funcargs input type
|
||
funcArgInpObjs = flip mapMaybe funcs $ \func ->
|
||
mkFuncArgsInp (fiName func) (getInputArgs func)
|
||
-- funcArgCtx = Map.unions funcArgCtxs
|
||
funcArgScalarSet = funcs ^.. folded.to getInputArgs.folded.to (_qptName.faType)
|
||
|
||
-- helper
|
||
mkFldMap ty = Map.fromList . concatMap (mkFld ty)
|
||
mkFld ty = \case
|
||
SFPGColumn ci -> [((ty, pgiName ci), RFPGColumn ci)]
|
||
SFRelationship (RelationshipFieldInfo relInfo allowAgg cols permFilter permLimit _ _) ->
|
||
let relationshipName = riName relInfo
|
||
relFld = ( (ty, mkRelName relationshipName)
|
||
, RFRelationship $ RelationshipField relInfo RFKSimple cols permFilter permLimit
|
||
)
|
||
aggRelFld = ( (ty, mkAggRelName relationshipName)
|
||
, RFRelationship $ RelationshipField relInfo RFKAggregate cols permFilter permLimit
|
||
)
|
||
in case riType relInfo of
|
||
ObjRel -> [relFld]
|
||
ArrRel -> bool [relFld] [relFld, aggRelFld] allowAgg
|
||
SFComputedField cf -> pure
|
||
( (ty, mkComputedFieldName $ _cfName cf)
|
||
, RFComputedField cf
|
||
)
|
||
SFRemoteRelationship remoteField -> pure
|
||
( (ty, G.Name (remoteRelationshipNameToText (_rfiName remoteField)))
|
||
, RFRemoteRelationship remoteField
|
||
)
|
||
|
||
-- the fields used in bool exp
|
||
boolExpInpObjFldsM = mkFldMap (mkBoolExpTy tn) <$> selFldsM
|
||
|
||
-- table obj
|
||
selectObjects = case selPermM of
|
||
Just (_, selFlds) ->
|
||
[ mkTableObj tn descM selFlds
|
||
]
|
||
Nothing -> []
|
||
|
||
-- aggregate objs and order by inputs
|
||
(aggObjs, aggOrdByInps) = case selPermM of
|
||
Just (True, selFlds) ->
|
||
let cols = getPGColumnFields selFlds
|
||
numCols = onlyNumCols cols
|
||
compCols = onlyComparableCols cols
|
||
objs = [ mkTableAggObj tn
|
||
, mkTableAggregateFieldsObj tn (numCols, numAggregateOps) (compCols, compAggregateOps)
|
||
] <> mkColAggregateFieldsObjs selFlds
|
||
ordByInps = mkTabAggOrdByInpObj tn (numCols, numAggregateOps) (compCols, compAggregateOps)
|
||
: mkTabAggregateOpOrdByInpObjs tn (numCols, numAggregateOps) (compCols, compAggregateOps)
|
||
in (objs, ordByInps)
|
||
_ -> ([], [])
|
||
|
||
getNumericCols = onlyNumCols . getPGColumnFields
|
||
getComparableCols = onlyComparableCols . getPGColumnFields
|
||
onlyFloat = const $ mkScalarTy PGFloat
|
||
|
||
mkTypeMaker "sum" = mkColumnType
|
||
mkTypeMaker _ = onlyFloat
|
||
|
||
mkColAggregateFieldsObjs flds =
|
||
let numCols = getNumericCols flds
|
||
compCols = getComparableCols flds
|
||
mkNumObjFld n = mkTableColAggregateFieldsObj tn n (mkTypeMaker n) numCols
|
||
mkCompObjFld n = mkTableColAggregateFieldsObj tn n mkColumnType compCols
|
||
numFldsObjs = bool (map mkNumObjFld numAggregateOps) [] $ null numCols
|
||
compFldsObjs = bool (map mkCompObjFld compAggregateOps) [] $ null compCols
|
||
in numFldsObjs <> compFldsObjs
|
||
-- the fields used in table object
|
||
selObjFldsM = mkFldMap (mkTableTy tn) <$> selFldsM
|
||
-- the scalar set for table_by_pk arguments
|
||
selByPkScalarSet = pkeyCols ^.. folded.to _pkColumns.folded.to pgiType._PGColumnScalar
|
||
|
||
ordByInpCtxM = mkOrdByInpObj tn <$> selFldsM
|
||
(ordByInpObjM, ordByCtxM) = case ordByInpCtxM of
|
||
Just (a, b) -> (Just a, Just b)
|
||
Nothing -> (Nothing, Nothing)
|
||
|
||
-- computed fields' function args input objects and scalar types
|
||
mkComputedFieldRequiredTypes computedFieldInfo =
|
||
let ComputedFieldFunction qf inputArgs _ _ _ = _cfFunction computedFieldInfo
|
||
scalarArgs = map (_qptName . faType) $ toList inputArgs
|
||
in (, scalarArgs) <$> mkFuncArgsInp qf inputArgs
|
||
|
||
computedFieldReqTypes = catMaybes $
|
||
maybe [] (map mkComputedFieldRequiredTypes . getComputedFields) selFldsM
|
||
|
||
computedFieldFuncArgsInps = map (TIInpObj . fst) computedFieldReqTypes
|
||
computedFieldFuncArgScalars = Set.fromList $ concatMap snd computedFieldReqTypes
|
||
|
||
makeFieldMap :: [(a, ObjFldInfo)] -> Map.HashMap G.Name (a, ObjFldInfo)
|
||
makeFieldMap = mapFromL (_fiName . snd)
|
||
|
||
-- see Note [Split schema generation (TODO)]
|
||
getMutationRootFieldsRole
|
||
:: QualifiedTable
|
||
-> Maybe (PrimaryKey PGColumnInfo)
|
||
-> [ConstraintName]
|
||
-> FieldInfoMap FieldInfo
|
||
-> Maybe ([T.Text], Bool) -- insert perm
|
||
-> Maybe (AnnBoolExpPartialSQL, Maybe Int, [T.Text], Bool) -- select filter
|
||
-> Maybe ([PGColumnInfo], PreSetColsPartial, AnnBoolExpPartialSQL, Maybe AnnBoolExpPartialSQL, [T.Text]) -- update filter
|
||
-> Maybe (AnnBoolExpPartialSQL, [T.Text]) -- delete filter
|
||
-> Maybe ViewInfo
|
||
-> TableConfig -- custom config
|
||
-> MutationRootFieldMap
|
||
getMutationRootFieldsRole tn primaryKey constraints fields insM
|
||
selM updM delM viM tableConfig =
|
||
makeFieldMap $ catMaybes
|
||
[ mutHelper viIsInsertable getInsDet insM
|
||
, onlyIfSelectPermExist $ mutHelper viIsInsertable getInsOneDet insM
|
||
, mutHelper viIsUpdatable getUpdDet updM
|
||
, onlyIfSelectPermExist $ mutHelper viIsUpdatable getUpdByPkDet $ (,) <$> updM <*> primaryKey
|
||
, mutHelper viIsDeletable getDelDet delM
|
||
, onlyIfSelectPermExist $ mutHelper viIsDeletable getDelByPkDet $ (,) <$> delM <*> primaryKey
|
||
]
|
||
where
|
||
customRootFields = _tcCustomRootFields tableConfig
|
||
colGNameMap = mkPGColGNameMap $ getCols fields
|
||
|
||
mutHelper :: (ViewInfo -> Bool) -> (a -> b) -> Maybe a -> Maybe b
|
||
mutHelper f getDet mutM =
|
||
bool Nothing (getDet <$> mutM) $ isMutable f viM
|
||
|
||
onlyIfSelectPermExist v = guard (isJust selM) *> v
|
||
|
||
getCustomNameWith f = f customRootFields
|
||
|
||
insCustName = getCustomNameWith _tcrfInsert
|
||
getInsDet (hdrs, upsertPerm) =
|
||
let isUpsertable = upsertable constraints upsertPerm $ isJust viM
|
||
in ( MCInsert $ InsOpCtx tn $ hdrs `union` maybe [] (^. _5) updM
|
||
, mkInsMutFld insCustName tn isUpsertable
|
||
)
|
||
|
||
insOneCustName = getCustomNameWith _tcrfInsertOne
|
||
getInsOneDet (hdrs, upsertPerm) =
|
||
let isUpsertable = upsertable constraints upsertPerm $ isJust viM
|
||
in ( MCInsertOne $ InsOpCtx tn $ hdrs `union` maybe [] (^. _5) updM
|
||
, mkInsertOneMutationField insOneCustName tn isUpsertable
|
||
)
|
||
|
||
updCustName = getCustomNameWith _tcrfUpdate
|
||
getUpdDet (updCols, preSetCols, updFltr, updCheck, hdrs) =
|
||
( MCUpdate $ UpdOpCtx tn hdrs colGNameMap updFltr updCheck preSetCols
|
||
, mkUpdMutFld updCustName tn updCols
|
||
)
|
||
|
||
updByPkCustName = getCustomNameWith _tcrfUpdateByPk
|
||
getUpdByPkDet ((updCols, preSetCols, updFltr, updCheck, hdrs), pKey) =
|
||
( MCUpdateByPk $ UpdOpCtx tn hdrs colGNameMap updFltr updCheck preSetCols
|
||
, mkUpdateByPkMutationField updByPkCustName tn updCols pKey
|
||
)
|
||
|
||
delCustName = getCustomNameWith _tcrfDelete
|
||
getDelDet (delFltr, hdrs) =
|
||
( MCDelete $ DelOpCtx tn hdrs colGNameMap delFltr
|
||
, mkDelMutFld delCustName tn
|
||
)
|
||
delByPkCustName = getCustomNameWith _tcrfDeleteByPk
|
||
getDelByPkDet ((delFltr, hdrs), pKey) =
|
||
( MCDeleteByPk $ DelOpCtx tn hdrs colGNameMap delFltr
|
||
, mkDeleteByPkMutationField delByPkCustName tn pKey
|
||
)
|
||
|
||
-- see Note [Split schema generation (TODO)]
|
||
getQueryRootFieldsRole
|
||
:: QualifiedTable
|
||
-> Maybe (PrimaryKey PGColumnInfo)
|
||
-> FieldInfoMap FieldInfo
|
||
-> [FunctionInfo]
|
||
-> Maybe (AnnBoolExpPartialSQL, Maybe Int, [T.Text], Bool) -- select filter
|
||
-> TableConfig -- custom config
|
||
-> QueryRootFieldMap
|
||
getQueryRootFieldsRole tn primaryKey fields funcs selM tableConfig =
|
||
makeFieldMap $
|
||
funcQueries
|
||
<> funcAggQueries
|
||
<> catMaybes
|
||
[ getSelDet <$> selM
|
||
, getSelAggDet selM
|
||
, getPKeySelDet <$> selM <*> primaryKey
|
||
]
|
||
where
|
||
customRootFields = _tcCustomRootFields tableConfig
|
||
colGNameMap = mkPGColGNameMap $ getCols fields
|
||
|
||
funcQueries = maybe [] getFuncQueryFlds selM
|
||
funcAggQueries = maybe [] getFuncAggQueryFlds selM
|
||
|
||
getCustomNameWith f = f customRootFields
|
||
|
||
selCustName = getCustomNameWith _tcrfSelect
|
||
getSelDet (selFltr, pLimit, hdrs, _) =
|
||
selFldHelper QCSelect (mkSelFld selCustName) selFltr pLimit hdrs
|
||
|
||
selAggCustName = getCustomNameWith _tcrfSelectAggregate
|
||
getSelAggDet (Just (selFltr, pLimit, hdrs, True)) =
|
||
Just $ selFldHelper QCSelectAgg (mkAggSelFld selAggCustName)
|
||
selFltr pLimit hdrs
|
||
getSelAggDet _ = Nothing
|
||
|
||
selFldHelper f g pFltr pLimit hdrs =
|
||
( f $ SelOpCtx tn hdrs colGNameMap pFltr pLimit
|
||
, g tn
|
||
)
|
||
|
||
selByPkCustName = getCustomNameWith _tcrfSelectByPk
|
||
getPKeySelDet (selFltr, _, hdrs, _) key =
|
||
let keyColumns = toList $ _pkColumns key
|
||
in ( QCSelectPkey . SelPkOpCtx tn hdrs selFltr $ mkPGColGNameMap keyColumns
|
||
, mkSelFldPKey selByPkCustName tn keyColumns
|
||
)
|
||
|
||
getFuncQueryFlds (selFltr, pLimit, hdrs, _) =
|
||
funcFldHelper QCFuncQuery mkFuncQueryFld selFltr pLimit hdrs
|
||
|
||
getFuncAggQueryFlds (selFltr, pLimit, hdrs, True) =
|
||
funcFldHelper QCFuncAggQuery mkFuncAggQueryFld selFltr pLimit hdrs
|
||
getFuncAggQueryFlds _ = []
|
||
|
||
funcFldHelper f g pFltr pLimit hdrs =
|
||
flip map funcs $ \fi ->
|
||
( f $ FuncQOpCtx (fiName fi) (mkFuncArgItemSeq fi) hdrs colGNameMap pFltr pLimit
|
||
, g fi $ fiDescription fi
|
||
)
|
||
|
||
getSelPermission :: TableInfo -> RoleName -> Maybe SelPermInfo
|
||
getSelPermission tabInfo roleName =
|
||
Map.lookup roleName (_tiRolePermInfoMap tabInfo) >>= _permSel
|
||
|
||
getSelPerm
|
||
:: (MonadError QErr m)
|
||
=> TableCache
|
||
-- all the fields of a table
|
||
-> FieldInfoMap FieldInfo
|
||
-- role and its permission
|
||
-> RoleName -> SelPermInfo
|
||
-> m (Bool, [SelField])
|
||
getSelPerm tableCache fields roleName selPermInfo = do
|
||
selFlds <- fmap catMaybes $ forM (filter isValidField $ Map.elems fields) $ \case
|
||
FIColumn pgColInfo ->
|
||
return $ fmap SFPGColumn $ bool Nothing (Just pgColInfo) $
|
||
Set.member (pgiColumn pgColInfo) $ spiCols selPermInfo
|
||
FIRelationship relInfo -> do
|
||
remTableInfo <- getTabInfo tableCache $ riRTable relInfo
|
||
let remTableSelPermM = getSelPermission remTableInfo roleName
|
||
remTableFlds = _tciFieldInfoMap $ _tiCoreInfo remTableInfo
|
||
remTableColGNameMap =
|
||
mkPGColGNameMap $ getValidCols remTableFlds
|
||
return $ flip fmap remTableSelPermM $
|
||
\rmSelPermM -> SFRelationship RelationshipFieldInfo
|
||
{ _rfiInfo = relInfo
|
||
, _rfiAllowAgg = spiAllowAgg rmSelPermM
|
||
, _rfiColumns = remTableColGNameMap
|
||
, _rfiPermFilter = spiFilter rmSelPermM
|
||
, _rfiPermLimit = spiLimit rmSelPermM
|
||
, _rfiPrimaryKeyColumns = _pkColumns <$>
|
||
_tciPrimaryKey (_tiCoreInfo remTableInfo)
|
||
, _rfiIsNullable = isRelNullable fields relInfo
|
||
}
|
||
FIComputedField info -> do
|
||
let ComputedFieldInfo name function returnTy _ = info
|
||
inputArgSeq = mkComputedFieldFunctionArgSeq $ _cffInputArgs function
|
||
fmap (SFComputedField . ComputedField name function inputArgSeq) <$>
|
||
case returnTy of
|
||
CFRScalar scalarTy -> pure $ Just $ CFTScalar scalarTy
|
||
CFRSetofTable retTable -> do
|
||
retTableInfo <- getTabInfo tableCache retTable
|
||
let retTableSelPermM = getSelPermission retTableInfo roleName
|
||
retTableFlds = _tciFieldInfoMap $ _tiCoreInfo retTableInfo
|
||
retTableColGNameMap =
|
||
mkPGColGNameMap $ getValidCols retTableFlds
|
||
pure $ flip fmap retTableSelPermM $
|
||
\selPerm -> CFTTable ComputedFieldTable
|
||
{ _cftTable = retTable
|
||
, _cftCols = retTableColGNameMap
|
||
, _cftPermFilter = spiFilter selPerm
|
||
, _cftPermLimit = spiLimit selPerm
|
||
}
|
||
-- TODO: Derive permissions for remote relationships
|
||
FIRemoteRelationship remoteField -> pure $ Just (SFRemoteRelationship remoteField)
|
||
|
||
return (spiAllowAgg selPermInfo, selFlds)
|
||
|
||
mkInsCtx
|
||
:: MonadError QErr m
|
||
=> RoleName
|
||
-> TableCache
|
||
-> FieldInfoMap FieldInfo
|
||
-> InsPermInfo
|
||
-> Maybe UpdPermInfo
|
||
-> m InsCtx
|
||
mkInsCtx role tableCache fields insPermInfo updPermM = do
|
||
relTupsM <- forM rels $ \relInfo -> do
|
||
let remoteTable = riRTable relInfo
|
||
relName = riName relInfo
|
||
remoteTableInfo <- getTabInfo tableCache remoteTable
|
||
let insPermM = getInsPerm remoteTableInfo role
|
||
viewInfoM = _tciViewInfo $ _tiCoreInfo remoteTableInfo
|
||
return $ bool Nothing (Just (relName, relInfo)) $
|
||
isInsertable insPermM viewInfoM && isValidRel relName remoteTable
|
||
|
||
let relInfoMap = Map.fromList $ catMaybes relTupsM
|
||
return $ InsCtx gNamePGColMap checkCond setCols relInfoMap updPermForIns
|
||
where
|
||
gNamePGColMap = mkPGColGNameMap allCols
|
||
allCols = getCols fields
|
||
rels = getValidRels fields
|
||
setCols = ipiSet insPermInfo
|
||
checkCond = ipiCheck insPermInfo
|
||
updPermForIns = mkUpdPermForIns <$> updPermM
|
||
mkUpdPermForIns upi = UpdPermForIns (toList $ upiCols upi) (upiCheck upi)
|
||
(upiFilter upi) (upiSet upi)
|
||
|
||
isInsertable Nothing _ = False
|
||
isInsertable (Just _) viewInfoM = isMutable viIsInsertable viewInfoM
|
||
|
||
mkAdminInsCtx
|
||
:: MonadError QErr m
|
||
=> TableCache
|
||
-> FieldInfoMap FieldInfo
|
||
-> m InsCtx
|
||
mkAdminInsCtx tc fields = do
|
||
relTupsM <- forM rels $ \relInfo -> do
|
||
let remoteTable = riRTable relInfo
|
||
relName = riName relInfo
|
||
remoteTableInfo <- getTabInfo tc remoteTable
|
||
let viewInfoM = _tciViewInfo $ _tiCoreInfo remoteTableInfo
|
||
return $ bool Nothing (Just (relName, relInfo)) $
|
||
isMutable viIsInsertable viewInfoM && isValidRel relName remoteTable
|
||
|
||
let relInfoMap = Map.fromList $ catMaybes relTupsM
|
||
updPerm = UpdPermForIns updCols Nothing noFilter Map.empty
|
||
|
||
return $ InsCtx colGNameMap noFilter Map.empty relInfoMap (Just updPerm)
|
||
where
|
||
allCols = getCols fields
|
||
colGNameMap = mkPGColGNameMap allCols
|
||
updCols = map pgiColumn allCols
|
||
rels = getValidRels fields
|
||
|
||
mkAdminSelFlds
|
||
:: MonadError QErr m
|
||
=> FieldInfoMap FieldInfo
|
||
-> TableCache
|
||
-> m [SelField]
|
||
mkAdminSelFlds fields tableCache =
|
||
forM (filter isValidField $ Map.elems fields) $ \case
|
||
FIColumn info -> pure $ SFPGColumn info
|
||
|
||
FIRelationship info -> do
|
||
let remoteTable = riRTable info
|
||
remoteTableInfo <- _tiCoreInfo <$> getTabInfo tableCache remoteTable
|
||
let remoteTableFlds = _tciFieldInfoMap remoteTableInfo
|
||
remoteTableColGNameMap =
|
||
mkPGColGNameMap $ getValidCols remoteTableFlds
|
||
return $ SFRelationship RelationshipFieldInfo
|
||
{ _rfiInfo = info
|
||
, _rfiAllowAgg = True
|
||
, _rfiColumns = remoteTableColGNameMap
|
||
, _rfiPermFilter = noFilter
|
||
, _rfiPermLimit = Nothing
|
||
, _rfiPrimaryKeyColumns = _pkColumns <$> _tciPrimaryKey remoteTableInfo
|
||
, _rfiIsNullable = isRelNullable fields info
|
||
}
|
||
|
||
FIComputedField info -> do
|
||
let ComputedFieldInfo name function returnTy _ = info
|
||
inputArgSeq = mkComputedFieldFunctionArgSeq $ _cffInputArgs function
|
||
(SFComputedField . ComputedField name function inputArgSeq) <$>
|
||
case returnTy of
|
||
CFRScalar scalarTy -> pure $ CFTScalar scalarTy
|
||
CFRSetofTable retTable -> do
|
||
retTableInfo <- _tiCoreInfo <$> getTabInfo tableCache retTable
|
||
let retTableFlds = _tciFieldInfoMap retTableInfo
|
||
retTableColGNameMap =
|
||
mkPGColGNameMap $ getValidCols retTableFlds
|
||
pure $ CFTTable ComputedFieldTable
|
||
{ _cftTable = retTable
|
||
, _cftCols = retTableColGNameMap
|
||
, _cftPermFilter = noFilter
|
||
, _cftPermLimit = Nothing
|
||
}
|
||
|
||
FIRemoteRelationship info -> pure $ SFRemoteRelationship info
|
||
|
||
mkGCtxRole
|
||
:: (MonadError QErr m)
|
||
=> TableCache
|
||
-> QualifiedTable
|
||
-> Maybe PGDescription
|
||
-> FieldInfoMap FieldInfo
|
||
-> Maybe (PrimaryKey PGColumnInfo)
|
||
-> [ConstraintName]
|
||
-> [FunctionInfo]
|
||
-> Maybe ViewInfo
|
||
-> TableConfig
|
||
-> RoleName
|
||
-> RolePermInfo
|
||
-> m (TyAgg, RootFields, InsCtxMap)
|
||
mkGCtxRole tableCache tn descM fields primaryKey constraints funcs viM tabConfigM role permInfo = do
|
||
selPermM <- mapM (getSelPerm tableCache fields role) $ _permSel permInfo
|
||
tabInsInfoM <- forM (_permIns permInfo) $ \ipi -> do
|
||
ctx <- mkInsCtx role tableCache fields ipi $ _permUpd permInfo
|
||
let permCols = flip getColInfos allCols $ Set.toList $ ipiCols ipi
|
||
return (ctx, (permCols, icRelations ctx))
|
||
let insPermM = snd <$> tabInsInfoM
|
||
insCtxM = fst <$> tabInsInfoM
|
||
updColsM = filterColumnFields . upiCols <$> _permUpd permInfo
|
||
tyAgg = mkTyAggRole tn descM insPermM selPermM updColsM
|
||
(void $ _permDel permInfo) primaryKey constraints viM funcs
|
||
rootFlds = getRootFldsRole tn primaryKey constraints fields funcs
|
||
viM permInfo tabConfigM
|
||
insCtxMap = maybe Map.empty (Map.singleton tn) insCtxM
|
||
return (tyAgg, rootFlds, insCtxMap)
|
||
where
|
||
allCols = getCols fields
|
||
cols = getValidCols fields
|
||
filterColumnFields allowedSet =
|
||
filter ((`Set.member` allowedSet) . pgiColumn) cols
|
||
|
||
getRootFldsRole
|
||
:: QualifiedTable
|
||
-> Maybe (PrimaryKey PGColumnInfo)
|
||
-> [ConstraintName]
|
||
-> FieldInfoMap FieldInfo
|
||
-> [FunctionInfo]
|
||
-> Maybe ViewInfo
|
||
-> RolePermInfo
|
||
-> TableConfig
|
||
-> RootFields
|
||
getRootFldsRole tn pCols constraints fields funcs viM (RolePermInfo insM selM updM delM) tableConfig =
|
||
let queryFields = getQueryRootFieldsRole tn pCols fields funcs (mkSel <$> selM) tableConfig
|
||
mutationFields = getMutationRootFieldsRole tn pCols constraints fields
|
||
(mkIns <$> insM) (mkSel <$> selM)
|
||
(mkUpd <$> updM) (mkDel <$> delM) viM tableConfig
|
||
in RootFields queryFields mutationFields
|
||
where
|
||
mkIns i = (ipiRequiredHeaders i, isJust updM)
|
||
mkSel s = ( spiFilter s, spiLimit s
|
||
, spiRequiredHeaders s, spiAllowAgg s
|
||
)
|
||
mkUpd u = ( flip getColInfos allCols $ Set.toList $ upiCols u
|
||
, upiSet u
|
||
, upiFilter u
|
||
, upiCheck u
|
||
, upiRequiredHeaders u
|
||
)
|
||
mkDel d = (dpiFilter d, dpiRequiredHeaders d)
|
||
|
||
allCols = getCols fields
|
||
|
||
mkGCtxMapTable
|
||
:: (MonadError QErr m)
|
||
=> TableCache
|
||
-> FunctionCache
|
||
-> TableInfo
|
||
-> m (Map.HashMap RoleName TableSchemaCtx)
|
||
mkGCtxMapTable tableCache funcCache tabInfo = do
|
||
m <- flip Map.traverseWithKey rolePermsMap $ \roleName rolePerm ->
|
||
for rolePerm $ mkGCtxRole tableCache tn descM fields primaryKey validConstraints
|
||
tabFuncs viewInfo customConfig roleName
|
||
adminInsCtx <- mkAdminInsCtx tableCache fields
|
||
adminSelFlds <- mkAdminSelFlds fields tableCache
|
||
let adminCtx = mkTyAggRole tn descM (Just (cols, icRelations adminInsCtx))
|
||
(Just (True, adminSelFlds)) (Just cols) (Just ())
|
||
primaryKey validConstraints viewInfo tabFuncs
|
||
adminInsCtxMap = Map.singleton tn adminInsCtx
|
||
adminTableCtx = RoleContext (adminCtx, adminRootFlds, adminInsCtxMap) Nothing
|
||
pure $ Map.insert adminRoleName adminTableCtx m
|
||
where
|
||
TableInfo coreInfo rolePerms _ = tabInfo
|
||
TableCoreInfo tn descM _ fields primaryKey _ _ viewInfo _ customConfig = coreInfo
|
||
validConstraints = mkValidConstraints $ map _cName (tciUniqueOrPrimaryKeyConstraints coreInfo)
|
||
cols = getValidCols fields
|
||
tabFuncs = filter (isValidObjectName . fiName) $ getFuncsOfTable tn funcCache
|
||
|
||
adminRootFlds =
|
||
let insertPermDetails = Just ([], True)
|
||
selectPermDetails = Just (noFilter, Nothing, [], True)
|
||
updatePermDetails = Just (cols, mempty, noFilter, Nothing, [])
|
||
deletePermDetails = Just (noFilter, [])
|
||
|
||
queryFields = getQueryRootFieldsRole tn primaryKey fields tabFuncs
|
||
selectPermDetails customConfig
|
||
mutationFields = getMutationRootFieldsRole tn primaryKey
|
||
validConstraints fields insertPermDetails
|
||
selectPermDetails updatePermDetails
|
||
deletePermDetails viewInfo customConfig
|
||
in RootFields queryFields mutationFields
|
||
|
||
rolePermsMap :: Map.HashMap RoleName (RoleContext RolePermInfo)
|
||
rolePermsMap = flip Map.map rolePerms $ \permInfo ->
|
||
case _permIns permInfo of
|
||
Nothing -> RoleContext permInfo Nothing
|
||
Just insPerm ->
|
||
if ipiBackendOnly insPerm then
|
||
-- Remove insert permission from 'default' context and keep it in 'backend' context.
|
||
RoleContext { _rctxDefault = permInfo{_permIns = Nothing}
|
||
, _rctxBackend = Just permInfo
|
||
}
|
||
-- Remove insert permission from 'backend' context and keep it in 'default' context.
|
||
else RoleContext { _rctxDefault = permInfo
|
||
, _rctxBackend = Just permInfo{_permIns = Nothing}
|
||
}
|
||
|
||
noFilter :: AnnBoolExpPartialSQL
|
||
noFilter = annBoolExpTrue
|
||
|
||
{- Note [Split schema generation (TODO)]
|
||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
As of writing this, the schema is generated per table per role and for queries and mutations
|
||
separately. See functions "mkTyAggRole", "getQueryRootFieldsRole" and "getMutationRootFieldsRole".
|
||
This approach makes hard to differentiate schema generation for each operation
|
||
(select, insert, delete and update) based on respective permission information and safe merging
|
||
those schemas eventually. For backend-only inserts (see https://github.com/hasura/graphql-engine/pull/4224)
|
||
we need to somehow defer the logic of merging schema for inserts with others based on its
|
||
backend-only credibility. This requires significant refactor of this module and
|
||
we can't afford to do it as of now since we're going to rewrite the entire GraphQL schema
|
||
generation (see https://github.com/hasura/graphql-engine/pull/4111). For aforementioned
|
||
backend-only inserts, we're following a hacky implementation of generating schema for
|
||
both default session and one with backend privilege -- the later differs with the former by
|
||
only having the schema related to insert operation.
|
||
-}
|
||
|
||
mkGCtxMap
|
||
:: forall m. (MonadError QErr m)
|
||
=> TableCache -> FunctionCache -> ActionCache -> m GCtxMap
|
||
mkGCtxMap tableCache functionCache actionCache = do
|
||
typesMapL <- mapM (mkGCtxMapTable tableCache functionCache) $
|
||
filter (tableFltr . _tiCoreInfo) $ Map.elems tableCache
|
||
let actionsSchema = mkActionsSchema actionCache
|
||
typesMap <- combineTypes actionsSchema typesMapL
|
||
let gCtxMap = flip Map.map typesMap $
|
||
fmap (\(ty, flds, insCtxMap) -> mkGCtx ty flds insCtxMap)
|
||
pure gCtxMap
|
||
where
|
||
tableFltr ti = not (isSystemDefined $ _tciSystemDefined ti) && isValidObjectName (_tciName ti)
|
||
|
||
combineTypes
|
||
:: Map.HashMap RoleName (RootFields, TyAgg)
|
||
-> [Map.HashMap RoleName TableSchemaCtx]
|
||
-> m (Map.HashMap RoleName TableSchemaCtx)
|
||
combineTypes actionsSchema tableCtxMaps = do
|
||
let tableCtxsMap =
|
||
foldr (Map.unionWith (++) . Map.map pure)
|
||
((\(rf, tyAgg) -> pure $ RoleContext (tyAgg, rf, mempty) Nothing) <$> actionsSchema)
|
||
tableCtxMaps
|
||
|
||
flip Map.traverseWithKey tableCtxsMap $ \_ tableSchemaCtxs -> do
|
||
let defaultTableSchemaCtxs = map _rctxDefault tableSchemaCtxs
|
||
backendGCtxTypesMaybe =
|
||
-- If no table has 'backend' schema context then
|
||
-- aggregated context should be Nothing
|
||
if all (isNothing . _rctxBackend) tableSchemaCtxs then Nothing
|
||
else Just $ flip map tableSchemaCtxs $
|
||
-- Consider 'default' if 'backend' doesn't exist for any table
|
||
-- see Note [Split schema generation (TODO)]
|
||
\(RoleContext def backend) -> fromMaybe def backend
|
||
|
||
RoleContext <$> combineTypes' defaultTableSchemaCtxs
|
||
<*> mapM combineTypes' backendGCtxTypesMaybe
|
||
where
|
||
combineTypes' :: [(TyAgg, RootFields, InsCtxMap)] -> m (TyAgg, RootFields, InsCtxMap)
|
||
combineTypes' typeList = do
|
||
let tyAgg = mconcat $ map (^. _1) typeList
|
||
insCtx = mconcat $ map (^. _3) typeList
|
||
rootFields <- combineRootFields $ map (^. _2) typeList
|
||
pure (tyAgg, rootFields, insCtx)
|
||
|
||
combineRootFields :: [RootFields] -> m RootFields
|
||
combineRootFields rootFields = do
|
||
let duplicateQueryFields = duplicates $
|
||
concatMap (Map.keys . _rootQueryFields) rootFields
|
||
duplicateMutationFields = duplicates $
|
||
concatMap (Map.keys . _rootMutationFields) rootFields
|
||
|
||
-- TODO: The following exception should result in inconsistency
|
||
when (not $ null duplicateQueryFields) $
|
||
throw400 Unexpected $ "following query root fields are duplicated: "
|
||
<> showNames duplicateQueryFields
|
||
|
||
when (not $ null duplicateMutationFields) $
|
||
throw400 Unexpected $ "following mutation root fields are duplicated: "
|
||
<> showNames duplicateMutationFields
|
||
|
||
pure $ mconcat rootFields
|
||
|
||
getGCtx :: BackendOnlyFieldAccess -> SchemaCache -> RoleName -> GCtx
|
||
getGCtx backendOnlyFieldAccess sc roleName =
|
||
case Map.lookup roleName (scGCtxMap sc) of
|
||
Nothing -> scDefaultRemoteGCtx sc
|
||
Just (RoleContext defaultGCtx maybeBackendGCtx) ->
|
||
case backendOnlyFieldAccess of
|
||
BOFAAllowed ->
|
||
-- When backend field access is allowed and if there's no 'backend_only'
|
||
-- permissions defined, we should allow access to non backend only fields
|
||
fromMaybe defaultGCtx maybeBackendGCtx
|
||
BOFADisallowed -> defaultGCtx
|
||
|
||
-- pretty print GCtx
|
||
ppGCtx :: GCtx -> String
|
||
ppGCtx gCtx =
|
||
"GCtx ["
|
||
<> "\n types = " <> show types
|
||
<> "\n query root = " <> show qRoot
|
||
<> "\n mutation root = " <> show mRoot
|
||
<> "\n subscription root = " <> show sRoot
|
||
<> "\n]"
|
||
|
||
where
|
||
types = map (G.unName . G.unNamedType) $ Map.keys $ _gTypes gCtx
|
||
qRoot = (,) (_otiName qRootO) $
|
||
map G.unName $ Map.keys $ _otiFields qRootO
|
||
mRoot = (,) (_otiName <$> mRootO) $
|
||
maybe [] (map G.unName . Map.keys . _otiFields) mRootO
|
||
sRoot = (,) (_otiName <$> sRootO) $
|
||
maybe [] (map G.unName . Map.keys . _otiFields) sRootO
|
||
qRootO = _gQueryRoot gCtx
|
||
mRootO = _gMutRoot gCtx
|
||
sRootO = _gSubRoot gCtx
|
||
|
||
mkGCtx :: TyAgg -> RootFields -> InsCtxMap -> GCtx
|
||
mkGCtx tyAgg (RootFields queryFields mutationFields) insCtxMap =
|
||
let queryRoot = mkQueryRootTyInfo qFlds
|
||
scalarTys = map (TIScalar . mkHsraScalarTyInfo) (Set.toList allScalarTypes)
|
||
compTys = map (TIInpObj . mkCompExpInp) (Set.toList allComparableTypes)
|
||
ordByEnumTyM = bool (Just ordByEnumTy) Nothing $ null qFlds
|
||
allTys = Map.union tyInfos $ mkTyInfoMap $
|
||
catMaybes [ Just $ TIObj queryRoot
|
||
, TIObj <$> mutRootM
|
||
, TIObj <$> subRootM
|
||
, TIEnum <$> ordByEnumTyM
|
||
, Just $ TIObj mkPageInfoObj
|
||
] <>
|
||
scalarTys <> compTys <> defaultTypes <> wiredInGeoInputTypes
|
||
<> wiredInRastInputTypes
|
||
-- for now subscription root is query root
|
||
in GCtx allTys fldInfos queryRoot mutRootM subRootM ordByEnums
|
||
(Map.map fst queryFields) (Map.map fst mutationFields) insCtxMap
|
||
where
|
||
TyAgg tyInfos fldInfos scalars ordByEnums = tyAgg
|
||
colTys = Set.fromList $ map pgiType $ mapMaybe (^? _RFPGColumn) $
|
||
Map.elems fldInfos
|
||
mkMutRoot =
|
||
mkHsraObjTyInfo (Just "mutation root") mutationRootNamedType Set.empty .
|
||
mapFromL _fiName
|
||
mutRootM = bool (Just $ mkMutRoot mFlds) Nothing $ null mFlds
|
||
mkSubRoot =
|
||
mkHsraObjTyInfo (Just "subscription root")
|
||
subscriptionRootNamedType Set.empty . mapFromL _fiName
|
||
subRootM = bool (Just $ mkSubRoot qFlds) Nothing $ null qFlds
|
||
|
||
qFlds = rootFieldInfos queryFields
|
||
mFlds = rootFieldInfos mutationFields
|
||
rootFieldInfos = map snd . Map.elems
|
||
|
||
anyGeoTypes = any (isScalarColumnWhere isGeoType) colTys
|
||
allComparableTypes =
|
||
if anyGeoTypes
|
||
-- due to casting, we need to generate both geometry and geography
|
||
-- operations even if just one of the two appears in the schema
|
||
then Set.union (Set.fromList [PGColumnScalar PGGeometry, PGColumnScalar PGGeography]) colTys
|
||
else colTys
|
||
|
||
additionalScalars = Set.fromList $
|
||
-- raster comparison expression needs geometry input
|
||
(guard anyRasterTypes *> pure PGGeometry)
|
||
-- scalar computed field return types
|
||
<> mapMaybe (^? _RFComputedField.cfType._CFTScalar) (Map.elems fldInfos)
|
||
|
||
allScalarTypes = (allComparableTypes ^.. folded._PGColumnScalar)
|
||
<> additionalScalars <> scalars
|
||
|
||
wiredInGeoInputTypes = guard anyGeoTypes *> map TIInpObj geoInputTypes
|
||
|
||
anyRasterTypes = any (isScalarColumnWhere (== PGRaster)) colTys
|
||
wiredInRastInputTypes = guard anyRasterTypes *>
|
||
map TIInpObj rasterIntersectsInputTypes
|