2023-01-19 14:25:52 +03:00
|
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
|
|
|
2023-02-21 16:45:12 +03:00
|
|
|
-- | Schema parsers for logical models.
|
2023-02-22 12:22:22 +03:00
|
|
|
module Hasura.LogicalModel.Schema (defaultBuildLogicalModelRootFields) where
|
2023-01-19 14:25:52 +03:00
|
|
|
|
|
|
|
import Data.Has (Has (getter))
|
|
|
|
import Data.HashMap.Strict qualified as HM
|
|
|
|
import Data.Monoid (Ap (Ap, getAp))
|
2023-03-31 18:33:32 +03:00
|
|
|
import Hasura.CustomReturnType.Schema
|
2023-01-19 14:25:52 +03:00
|
|
|
import Hasura.GraphQL.Schema.Backend
|
2023-02-15 20:55:06 +03:00
|
|
|
( BackendCustomTypeSelectSchema (..),
|
|
|
|
BackendSchema (columnParser),
|
2023-01-19 14:25:52 +03:00
|
|
|
MonadBuildSchema,
|
|
|
|
)
|
|
|
|
import Hasura.GraphQL.Schema.Common
|
2023-02-15 20:55:06 +03:00
|
|
|
( SchemaT,
|
2023-03-06 19:38:18 +03:00
|
|
|
partialSQLExpToUnpreparedValue,
|
2023-01-19 14:25:52 +03:00
|
|
|
retrieve,
|
2023-03-06 19:38:18 +03:00
|
|
|
scRole,
|
2023-01-19 14:25:52 +03:00
|
|
|
)
|
|
|
|
import Hasura.GraphQL.Schema.Options qualified as Options
|
|
|
|
import Hasura.GraphQL.Schema.Parser qualified as P
|
|
|
|
import Hasura.GraphQL.Schema.Select
|
2023-03-06 19:38:18 +03:00
|
|
|
( logicalModelSelectionList,
|
2023-01-19 14:25:52 +03:00
|
|
|
)
|
2023-03-02 19:02:27 +03:00
|
|
|
import Hasura.LogicalModel.Cache (LogicalModelInfo (..))
|
2023-02-22 16:45:27 +03:00
|
|
|
import Hasura.LogicalModel.IR (LogicalModel (..))
|
2023-03-02 19:02:27 +03:00
|
|
|
import Hasura.LogicalModel.Metadata (InterpolatedQuery (..), LogicalModelArgumentName (getLogicalModelArgumentName))
|
2023-03-07 13:03:34 +03:00
|
|
|
import Hasura.LogicalModel.Types (NullableScalarType (..), getLogicalModelName)
|
2023-01-19 14:25:52 +03:00
|
|
|
import Hasura.Prelude
|
2023-02-15 20:55:06 +03:00
|
|
|
import Hasura.RQL.IR.BoolExp (gBoolExpTrue)
|
2023-01-19 14:25:52 +03:00
|
|
|
import Hasura.RQL.IR.Root (RemoteRelationshipField)
|
2023-01-27 17:36:35 +03:00
|
|
|
import Hasura.RQL.IR.Select (QueryDB (QDBMultipleRows))
|
2023-01-19 14:25:52 +03:00
|
|
|
import Hasura.RQL.IR.Select qualified as IR
|
2023-02-03 14:15:08 +03:00
|
|
|
import Hasura.RQL.IR.Value (UnpreparedValue (UVParameter), openValueOrigin)
|
2023-01-19 14:25:52 +03:00
|
|
|
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),
|
|
|
|
)
|
2023-03-06 19:38:18 +03:00
|
|
|
import Hasura.RQL.Types.Table (SelPermInfo (..), _permSel)
|
2023-01-19 14:25:52 +03:00
|
|
|
import Hasura.SQL.AnyBackend (mkAnyBackend)
|
2023-03-06 19:38:18 +03:00
|
|
|
import Hasura.Session (RoleName, adminRoleName)
|
2023-01-19 14:25:52 +03:00
|
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
import Language.GraphQL.Draft.Syntax.QQ qualified as G
|
|
|
|
|
2023-03-06 19:38:18 +03:00
|
|
|
-- | 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
|
|
|
|
|
2023-02-21 16:45:12 +03:00
|
|
|
defaultBuildLogicalModelRootFields ::
|
2023-01-19 14:25:52 +03:00
|
|
|
forall b r m n.
|
|
|
|
( MonadBuildSchema b r m n,
|
2023-02-15 20:55:06 +03:00
|
|
|
BackendCustomTypeSelectSchema b
|
2023-01-19 14:25:52 +03:00
|
|
|
) =>
|
2023-02-22 16:45:27 +03:00
|
|
|
LogicalModelInfo b ->
|
2023-01-19 14:25:52 +03:00
|
|
|
SchemaT
|
|
|
|
r
|
|
|
|
m
|
|
|
|
(Maybe (P.FieldParser n (QueryDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
|
2023-03-06 19:38:18 +03:00
|
|
|
defaultBuildLogicalModelRootFields logicalModel@LogicalModelInfo {..} = runMaybeT $ do
|
2023-03-02 19:02:27 +03:00
|
|
|
let fieldName = getLogicalModelName _lmiRootFieldName
|
|
|
|
logicalModelArgsParser <- logicalModelArgumentsSchema @b @r @m @n fieldName _lmiArguments
|
2023-02-15 20:55:06 +03:00
|
|
|
|
2023-01-19 14:25:52 +03:00
|
|
|
sourceInfo :: SourceInfo b <- asks getter
|
2023-03-06 19:38:18 +03:00
|
|
|
roleName <- retrieve scRole
|
2023-02-15 20:55:06 +03:00
|
|
|
|
2023-01-19 14:25:52 +03:00
|
|
|
let sourceName = _siName sourceInfo
|
|
|
|
tCase = _rscNamingConvention $ _siCustomization sourceInfo
|
2023-03-02 19:02:27 +03:00
|
|
|
description = G.Description <$> _lmiDescription
|
2023-02-15 20:55:06 +03:00
|
|
|
|
2023-01-19 14:25:52 +03:00
|
|
|
stringifyNumbers <- retrieve Options.soStringifyNumbers
|
|
|
|
|
2023-03-06 19:38:18 +03:00
|
|
|
selectionSetParser <- MaybeT $ logicalModelSelectionList @b @r @m @n (getLogicalModelName _lmiRootFieldName) logicalModel
|
|
|
|
customTypesArgsParser <- lift $ logicalModelArguments @b @r @m @n (getLogicalModelName _lmiRootFieldName) _lmiReturns
|
2023-02-01 11:44:50 +03:00
|
|
|
|
2023-02-22 16:45:27 +03:00
|
|
|
let interpolatedQuery lmArgs =
|
2023-02-03 14:15:08 +03:00
|
|
|
InterpolatedQuery $
|
|
|
|
(fmap . fmap)
|
2023-02-22 16:45:27 +03:00
|
|
|
( \var -> case HM.lookup var lmArgs of
|
2023-02-03 14:15:08 +03:00
|
|
|
Just arg -> UVParameter Nothing arg
|
|
|
|
Nothing ->
|
2023-02-21 16:45:12 +03:00
|
|
|
-- the `logicalModelArgsParser` will already have checked
|
2023-02-03 14:15:08 +03:00
|
|
|
-- we have all the args the query needs so this _should
|
|
|
|
-- not_ happen
|
2023-02-22 16:45:27 +03:00
|
|
|
error $ "No logical model arg passed for " <> show var
|
2023-02-03 14:15:08 +03:00
|
|
|
)
|
2023-03-02 19:02:27 +03:00
|
|
|
(getInterpolatedQuery _lmiCode)
|
2023-02-03 14:15:08 +03:00
|
|
|
|
2023-03-06 19:38:18 +03:00
|
|
|
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
|
|
|
|
|
2023-03-31 18:33:32 +03:00
|
|
|
let customReturnTypeIR = buildCustomReturnType _lmiReturns
|
|
|
|
|
2023-01-19 14:25:52 +03:00
|
|
|
pure $
|
2023-03-02 19:02:27 +03:00
|
|
|
P.setFieldParserOrigin (MO.MOSourceObjId sourceName (mkAnyBackend $ MO.SMOLogicalModel @b _lmiRootFieldName)) $
|
2023-02-15 20:55:06 +03:00
|
|
|
P.subselection
|
|
|
|
fieldName
|
|
|
|
description
|
|
|
|
( (,)
|
|
|
|
<$> customTypesArgsParser
|
2023-02-21 16:45:12 +03:00
|
|
|
<*> logicalModelArgsParser
|
2023-02-15 20:55:06 +03:00
|
|
|
)
|
|
|
|
selectionSetParser
|
2023-02-22 16:45:27 +03:00
|
|
|
<&> \((args, lmArgs), fields) ->
|
2023-01-27 17:36:35 +03:00
|
|
|
QDBMultipleRows $
|
2023-01-19 14:25:52 +03:00
|
|
|
IR.AnnSelectG
|
|
|
|
{ IR._asnFields = fields,
|
|
|
|
IR._asnFrom =
|
2023-02-22 16:45:27 +03:00
|
|
|
IR.FromLogicalModel
|
|
|
|
LogicalModel
|
2023-03-02 19:02:27 +03:00
|
|
|
{ lmRootFieldName = _lmiRootFieldName,
|
2023-02-22 16:45:27 +03:00
|
|
|
lmArgs,
|
2023-03-27 19:54:27 +03:00
|
|
|
lmInterpolatedQuery = interpolatedQuery lmArgs,
|
2023-03-31 18:33:32 +03:00
|
|
|
lmReturnType = customReturnTypeIR
|
2023-01-19 14:25:52 +03:00
|
|
|
},
|
2023-03-06 19:38:18 +03:00
|
|
|
IR._asnPerm =
|
|
|
|
if roleName == adminRoleName
|
|
|
|
then IR.TablePerm gBoolExpTrue Nothing
|
|
|
|
else logicalModelPerm,
|
2023-01-19 14:25:52 +03:00
|
|
|
IR._asnArgs = args,
|
|
|
|
IR._asnStrfyNum = stringifyNumbers,
|
|
|
|
IR._asnNamingConvention = Just tCase
|
|
|
|
}
|
|
|
|
|
2023-02-21 16:45:12 +03:00
|
|
|
logicalModelArgumentsSchema ::
|
2023-01-19 14:25:52 +03:00
|
|
|
forall b r m n.
|
|
|
|
MonadBuildSchema b r m n =>
|
|
|
|
G.Name ->
|
2023-03-07 13:03:34 +03:00
|
|
|
HashMap LogicalModelArgumentName (NullableScalarType b) ->
|
2023-02-22 16:45:27 +03:00
|
|
|
MaybeT (SchemaT r m) (P.InputFieldsParser n (HashMap LogicalModelArgumentName (Column.ColumnValue b)))
|
2023-02-21 16:45:12 +03:00
|
|
|
logicalModelArgumentsSchema logicalModelName argsSignature = do
|
2023-01-19 14:25:52 +03:00
|
|
|
-- 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
|
2023-03-07 13:03:34 +03:00
|
|
|
( \(name, NullableScalarType {nstType, nstNullable, nstDescription}) -> Ap do
|
2023-01-19 14:25:52 +03:00
|
|
|
argValueParser <-
|
|
|
|
fmap (HM.singleton name . openValueOrigin)
|
2023-03-07 13:03:34 +03:00
|
|
|
<$> lift (columnParser (Column.ColumnScalar nstType) (G.Nullability nstNullable))
|
2023-01-19 14:25:52 +03:00
|
|
|
-- TODO: Naming conventions?
|
|
|
|
-- TODO: Custom fields? (Probably not)
|
2023-02-22 16:45:27 +03:00
|
|
|
argName <- hoistMaybe (G.mkName (getLogicalModelArgumentName name))
|
2023-03-07 13:03:34 +03:00
|
|
|
let description = case nstDescription of
|
|
|
|
Just desc -> G.Description desc
|
|
|
|
Nothing -> G.Description ("Logical model argument " <> getLogicalModelArgumentName name)
|
|
|
|
pure $
|
2023-01-19 14:25:52 +03:00
|
|
|
P.field
|
|
|
|
argName
|
2023-03-07 13:03:34 +03:00
|
|
|
(Just description)
|
2023-01-19 14:25:52 +03:00
|
|
|
argValueParser
|
|
|
|
)
|
|
|
|
(HM.toList argsSignature)
|
|
|
|
|
2023-02-21 16:45:12 +03:00
|
|
|
let desc = Just $ G.Description $ G.unName logicalModelName <> " Logical Model Arguments"
|
2023-01-31 13:53:29 +03:00
|
|
|
|
2023-01-19 14:25:52 +03:00
|
|
|
pure $
|
2023-01-31 13:53:29 +03:00
|
|
|
if null argsSignature
|
|
|
|
then mempty
|
|
|
|
else
|
|
|
|
P.field
|
|
|
|
[G.name|args|]
|
|
|
|
desc
|
2023-02-21 16:45:12 +03:00
|
|
|
(P.object (logicalModelName <> [G.name|_arguments|]) desc argsParser)
|