1
0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-22 23:11:41 +03:00
graphql-engine/server/src-lib/Hasura/LogicalModel/Schema.hs
Daniel Harvey 2d9c8299c2 feature(server): add SQLServer logical models
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8388
GitOrigin-RevId: cbf813d1114cb03816003ba73788d33ac37f1473
2023-03-27 16:56:05 +00:00

176 lines
6.7 KiB
Haskell

{-# LANGUAGE QuasiQuotes #-}
-- | Schema parsers for logical models.
module Hasura.LogicalModel.Schema (defaultBuildLogicalModelRootFields) where
import Data.Has (Has (getter))
import Data.HashMap.Strict qualified as HM
import Data.Monoid (Ap (Ap, getAp))
import Hasura.GraphQL.Schema.Backend
( BackendCustomTypeSelectSchema (..),
BackendSchema (columnParser),
MonadBuildSchema,
)
import Hasura.GraphQL.Schema.Common
( SchemaT,
partialSQLExpToUnpreparedValue,
retrieve,
scRole,
)
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Select
( logicalModelSelectionList,
)
import Hasura.LogicalModel.Cache (LogicalModelInfo (..))
import Hasura.LogicalModel.IR (LogicalModel (..))
import Hasura.LogicalModel.Metadata (InterpolatedQuery (..), LogicalModelArgumentName (getLogicalModelArgumentName))
import Hasura.LogicalModel.Types (NullableScalarType (..), getLogicalModelName)
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp (gBoolExpTrue)
import Hasura.RQL.IR.Root (RemoteRelationshipField)
import Hasura.RQL.IR.Select (QueryDB (QDBMultipleRows))
import Hasura.RQL.IR.Select qualified as IR
import Hasura.RQL.IR.Value (UnpreparedValue (UVParameter), openValueOrigin)
import Hasura.RQL.Types.Column qualified as Column
import Hasura.RQL.Types.Metadata.Object qualified as MO
import Hasura.RQL.Types.Source
( SourceInfo (_siCustomization, _siName),
)
import Hasura.RQL.Types.SourceCustomization
( ResolvedSourceCustomization (_rscNamingConvention),
)
import Hasura.RQL.Types.Table (SelPermInfo (..), _permSel)
import Hasura.SQL.AnyBackend (mkAnyBackend)
import Hasura.Session (RoleName, adminRoleName)
import Language.GraphQL.Draft.Syntax qualified as G
import Language.GraphQL.Draft.Syntax.QQ qualified as G
-- | find list of columns we're allowed to access for this role
getSelPermInfoForLogicalModel ::
RoleName ->
LogicalModelInfo b ->
Maybe (SelPermInfo b)
getSelPermInfoForLogicalModel role logicalModel =
HM.lookup role (_lmiPermissions logicalModel) >>= _permSel
defaultBuildLogicalModelRootFields ::
forall b r m n.
( MonadBuildSchema b r m n,
BackendCustomTypeSelectSchema b
) =>
LogicalModelInfo b ->
SchemaT
r
m
(Maybe (P.FieldParser n (QueryDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
defaultBuildLogicalModelRootFields logicalModel@LogicalModelInfo {..} = runMaybeT $ do
let fieldName = getLogicalModelName _lmiRootFieldName
logicalModelArgsParser <- logicalModelArgumentsSchema @b @r @m @n fieldName _lmiArguments
sourceInfo :: SourceInfo b <- asks getter
roleName <- retrieve scRole
let sourceName = _siName sourceInfo
tCase = _rscNamingConvention $ _siCustomization sourceInfo
description = G.Description <$> _lmiDescription
stringifyNumbers <- retrieve Options.soStringifyNumbers
selectionSetParser <- MaybeT $ logicalModelSelectionList @b @r @m @n (getLogicalModelName _lmiRootFieldName) logicalModel
customTypesArgsParser <- lift $ logicalModelArguments @b @r @m @n (getLogicalModelName _lmiRootFieldName) _lmiReturns
let interpolatedQuery lmArgs =
InterpolatedQuery $
(fmap . fmap)
( \var -> case HM.lookup var lmArgs of
Just arg -> UVParameter Nothing arg
Nothing ->
-- the `logicalModelArgsParser` will already have checked
-- we have all the args the query needs so this _should
-- not_ happen
error $ "No logical model arg passed for " <> show var
)
(getInterpolatedQuery _lmiCode)
let logicalModelPerm = case getSelPermInfoForLogicalModel roleName logicalModel of
Just selectPermissions ->
IR.TablePerm
{ IR._tpFilter = fmap partialSQLExpToUnpreparedValue <$> spiFilter selectPermissions,
IR._tpLimit = spiLimit selectPermissions
}
Nothing -> IR.TablePerm gBoolExpTrue Nothing
pure $
P.setFieldParserOrigin (MO.MOSourceObjId sourceName (mkAnyBackend $ MO.SMOLogicalModel @b _lmiRootFieldName)) $
P.subselection
fieldName
description
( (,)
<$> customTypesArgsParser
<*> logicalModelArgsParser
)
selectionSetParser
<&> \((args, lmArgs), fields) ->
QDBMultipleRows $
IR.AnnSelectG
{ IR._asnFields = fields,
IR._asnFrom =
IR.FromLogicalModel
LogicalModel
{ lmRootFieldName = _lmiRootFieldName,
lmArgs,
lmInterpolatedQuery = interpolatedQuery lmArgs,
lmReturnType = _lmiReturns
},
IR._asnPerm =
if roleName == adminRoleName
then IR.TablePerm gBoolExpTrue Nothing
else logicalModelPerm,
IR._asnArgs = args,
IR._asnStrfyNum = stringifyNumbers,
IR._asnNamingConvention = Just tCase
}
logicalModelArgumentsSchema ::
forall b r m n.
MonadBuildSchema b r m n =>
G.Name ->
HashMap LogicalModelArgumentName (NullableScalarType b) ->
MaybeT (SchemaT r m) (P.InputFieldsParser n (HashMap LogicalModelArgumentName (Column.ColumnValue b)))
logicalModelArgumentsSchema logicalModelName argsSignature = do
-- Lift 'SchemaT r m (InputFieldsParser ..)' into a monoid using Applicative.
-- This lets us use 'foldMap' + monoid structure of hashmaps to avoid awkwardly
-- traversing the arguments and building the resulting parser.
argsParser <-
getAp $
foldMap
( \(name, NullableScalarType {nstType, nstNullable, nstDescription}) -> Ap do
argValueParser <-
fmap (HM.singleton name . openValueOrigin)
<$> lift (columnParser (Column.ColumnScalar nstType) (G.Nullability nstNullable))
-- TODO: Naming conventions?
-- TODO: Custom fields? (Probably not)
argName <- hoistMaybe (G.mkName (getLogicalModelArgumentName name))
let description = case nstDescription of
Just desc -> G.Description desc
Nothing -> G.Description ("Logical model argument " <> getLogicalModelArgumentName name)
pure $
P.field
argName
(Just description)
argValueParser
)
(HM.toList argsSignature)
let desc = Just $ G.Description $ G.unName logicalModelName <> " Logical Model Arguments"
pure $
if null argsSignature
then mempty
else
P.field
[G.name|args|]
desc
(P.object (logicalModelName <> [G.name|_arguments|]) desc argsParser)