mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-22 23:11:41 +03:00
a9f77acb32
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7167 Co-authored-by: Daniel Chambers <1214352+daniel-chambers@users.noreply.github.com> GitOrigin-RevId: 926e7282b908e3a9669ac39d625aa54971e11c37
347 lines
16 KiB
Haskell
347 lines
16 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Hasura.Backends.DataConnector.Adapter.Schema () where
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Control.Lens ((^.))
|
|
import Data.Aeson qualified as J
|
|
import Data.Has
|
|
import Data.HashMap.Strict qualified as Map
|
|
import Data.List.NonEmpty qualified as NE
|
|
import Data.Scientific (fromFloatDigits)
|
|
import Data.Text.Casing (GQLNameIdentifier, fromCustomName)
|
|
import Data.Text.Extended ((<<>))
|
|
import Hasura.Backends.DataConnector.API qualified as API
|
|
import Hasura.Backends.DataConnector.Adapter.Backend (CustomBooleanOperator (..), columnTypeToScalarType)
|
|
import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
|
|
import Hasura.Backends.DataConnector.Adapter.Types.Mutations qualified as DC
|
|
import Hasura.Base.Error
|
|
import Hasura.GraphQL.Parser.Class
|
|
import Hasura.GraphQL.Schema.Backend (BackendSchema (..), BackendTableSelectSchema (..), BackendUpdateOperatorsSchema (..), ComparisonExp, MonadBuildSchema)
|
|
import Hasura.GraphQL.Schema.BoolExp qualified as GS.BE
|
|
import Hasura.GraphQL.Schema.Build qualified as GS.B
|
|
import Hasura.GraphQL.Schema.Common qualified as GS.C
|
|
import Hasura.GraphQL.Schema.NamingCase
|
|
import Hasura.GraphQL.Schema.Options qualified as Options
|
|
import Hasura.GraphQL.Schema.Parser qualified as P
|
|
import Hasura.GraphQL.Schema.Select qualified as GS.S
|
|
import Hasura.GraphQL.Schema.Update qualified as GS.U
|
|
import Hasura.GraphQL.Schema.Update.Batch qualified as GS.U.B
|
|
import Hasura.Name qualified as Name
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.IR.BoolExp qualified as IR
|
|
import Hasura.RQL.IR.Delete qualified as IR
|
|
import Hasura.RQL.IR.Insert qualified as IR
|
|
import Hasura.RQL.IR.Root qualified as IR
|
|
import Hasura.RQL.IR.Select qualified as IR
|
|
import Hasura.RQL.IR.Update qualified as IR
|
|
import Hasura.RQL.IR.Value qualified as IR
|
|
import Hasura.RQL.Types.Backend qualified as RQL
|
|
import Hasura.RQL.Types.Column qualified as RQL
|
|
import Hasura.RQL.Types.Source qualified as RQL
|
|
import Hasura.RQL.Types.SourceCustomization qualified as RQL
|
|
import Hasura.RQL.Types.Table qualified as RQL
|
|
import Hasura.SQL.Backend (BackendType (..))
|
|
import Language.GraphQL.Draft.Syntax qualified as GQL
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
instance BackendSchema 'DataConnector where
|
|
-- top level parsers
|
|
buildTableQueryAndSubscriptionFields = GS.B.buildTableQueryAndSubscriptionFields
|
|
|
|
buildTableRelayQueryFields = experimentalBuildTableRelayQueryFields
|
|
|
|
buildFunctionQueryFields _ _ _ _ = pure []
|
|
buildFunctionRelayQueryFields _ _ _ _ _ = pure []
|
|
buildFunctionMutationFields _ _ _ _ = pure []
|
|
buildTableInsertMutationFields = buildTableInsertMutationFields'
|
|
buildTableUpdateMutationFields = buildTableUpdateMutationFields'
|
|
buildTableDeleteMutationFields = buildTableDeleteMutationFields'
|
|
buildTableStreamingSubscriptionFields _ _ _ _ = pure []
|
|
|
|
-- backend extensions
|
|
relayExtension = Nothing
|
|
nodesAggExtension = Just ()
|
|
streamSubscriptionExtension = Nothing
|
|
|
|
-- individual components
|
|
columnParser = columnParser'
|
|
enumParser = enumParser'
|
|
possiblyNullable = possiblyNullable'
|
|
scalarSelectionArgumentsParser _ = pure Nothing
|
|
orderByOperators = orderByOperators'
|
|
comparisonExps = comparisonExps'
|
|
|
|
countTypeInput = countTypeInput'
|
|
|
|
-- aggregateOrderByCountType is only used when generating Relay schemas, and Data Connector backends do not yet support Relay
|
|
-- If/when we want to support this we would need to add something to Capabilities to tell HGE what (integer-like) scalar
|
|
-- type should be used to represent the result of a count aggregate in relay order-by queries.
|
|
aggregateOrderByCountType =
|
|
error "aggregateOrderByCountType: not implemented for Data Connector backend"
|
|
|
|
computedField =
|
|
error "computedField: not implemented for the Data Connector backend."
|
|
|
|
instance BackendTableSelectSchema 'DataConnector where
|
|
tableArguments = tableArgs'
|
|
selectTable = GS.S.defaultSelectTable
|
|
selectTableAggregate = GS.S.defaultSelectTableAggregate
|
|
tableSelectionSet = GS.S.defaultTableSelectionSet
|
|
|
|
instance BackendUpdateOperatorsSchema 'DataConnector where
|
|
type UpdateOperators 'DataConnector = DC.UpdateOperator
|
|
|
|
parseUpdateOperators = parseUpdateOperators'
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
buildTableInsertMutationFields' ::
|
|
MonadBuildSchema 'DataConnector r m n =>
|
|
RQL.MkRootFieldName ->
|
|
GS.C.Scenario ->
|
|
RQL.TableName 'DataConnector ->
|
|
RQL.TableInfo 'DataConnector ->
|
|
GQLNameIdentifier ->
|
|
GS.C.SchemaT r m [P.FieldParser n (IR.AnnotatedInsert 'DataConnector (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue 'DataConnector))]
|
|
buildTableInsertMutationFields' mkRootFieldName scenario tableName tableInfo gqlName = do
|
|
API.Capabilities {..} <- DC._scCapabilities . RQL._siConfiguration @('DataConnector) <$> asks getter
|
|
case _cMutations >>= API._mcInsertCapabilities of
|
|
Just _insertCapabilities -> GS.B.buildTableInsertMutationFields mkBackendInsertParser mkRootFieldName scenario tableName tableInfo gqlName
|
|
Nothing -> pure []
|
|
|
|
mkBackendInsertParser ::
|
|
MonadBuildSchema 'DataConnector r m n =>
|
|
RQL.TableInfo 'DataConnector ->
|
|
GS.C.SchemaT r m (P.InputFieldsParser n (DC.BackendInsert (IR.UnpreparedValue 'DataConnector)))
|
|
mkBackendInsertParser _tableInfo =
|
|
pure $ pure DC.BackendInsert
|
|
|
|
buildTableUpdateMutationFields' ::
|
|
MonadBuildSchema 'DataConnector r m n =>
|
|
GS.C.Scenario ->
|
|
RQL.TableInfo 'DataConnector ->
|
|
GQLNameIdentifier ->
|
|
GS.C.SchemaT r m [P.FieldParser n (IR.AnnotatedUpdateG 'DataConnector (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue 'DataConnector))]
|
|
buildTableUpdateMutationFields' scenario tableInfo gqlName = do
|
|
API.Capabilities {..} <- DC._scCapabilities . RQL._siConfiguration @('DataConnector) <$> asks getter
|
|
case _cMutations >>= API._mcUpdateCapabilities of
|
|
Just _updateCapabilities -> do
|
|
updateRootFields <- GS.B.buildSingleBatchTableUpdateMutationFields DC.SingleBatch scenario tableInfo gqlName
|
|
updateManyRootField <- GS.U.B.updateTableMany DC.MultipleBatches scenario tableInfo gqlName
|
|
pure $ updateRootFields ++ (maybeToList updateManyRootField)
|
|
Nothing -> pure []
|
|
|
|
parseUpdateOperators' ::
|
|
forall m n r.
|
|
MonadBuildSchema 'DataConnector r m n =>
|
|
RQL.TableInfo 'DataConnector ->
|
|
RQL.UpdPermInfo 'DataConnector ->
|
|
GS.C.SchemaT r m (P.InputFieldsParser n (HashMap (RQL.Column 'DataConnector) (DC.UpdateOperator (IR.UnpreparedValue 'DataConnector))))
|
|
parseUpdateOperators' tableInfo updatePermissions = do
|
|
GS.U.buildUpdateOperators
|
|
(DC.UpdateSet <$> GS.U.presetColumns updatePermissions)
|
|
[ DC.UpdateSet <$> GS.U.setOp
|
|
]
|
|
tableInfo
|
|
|
|
buildTableDeleteMutationFields' ::
|
|
MonadBuildSchema 'DataConnector r m n =>
|
|
RQL.MkRootFieldName ->
|
|
GS.C.Scenario ->
|
|
RQL.TableName 'DataConnector ->
|
|
RQL.TableInfo 'DataConnector ->
|
|
GQLNameIdentifier ->
|
|
GS.C.SchemaT r m [P.FieldParser n (IR.AnnDelG 'DataConnector (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue 'DataConnector))]
|
|
buildTableDeleteMutationFields' mkRootFieldName scenario tableName tableInfo gqlName = do
|
|
API.Capabilities {..} <- DC._scCapabilities . RQL._siConfiguration @('DataConnector) <$> asks getter
|
|
case _cMutations >>= API._mcDeleteCapabilities of
|
|
Just _deleteCapabilities -> GS.B.buildTableDeleteMutationFields mkRootFieldName scenario tableName tableInfo gqlName
|
|
Nothing -> pure []
|
|
|
|
experimentalBuildTableRelayQueryFields ::
|
|
MonadBuildSchema 'DataConnector r m n =>
|
|
RQL.MkRootFieldName ->
|
|
RQL.TableName 'DataConnector ->
|
|
RQL.TableInfo 'DataConnector ->
|
|
GQLNameIdentifier ->
|
|
NESeq (RQL.ColumnInfo 'DataConnector) ->
|
|
GS.C.SchemaT r m [P.FieldParser n a]
|
|
experimentalBuildTableRelayQueryFields _mkRootFieldName _tableName _tableInfo _gqlName _pkeyColumns =
|
|
pure []
|
|
|
|
columnParser' ::
|
|
MonadBuildSchema 'DataConnector r m n =>
|
|
RQL.ColumnType 'DataConnector ->
|
|
GQL.Nullability ->
|
|
GS.C.SchemaT r m (P.Parser 'P.Both n (IR.ValueWithOrigin (RQL.ColumnValue 'DataConnector)))
|
|
columnParser' columnType nullability = case columnType of
|
|
RQL.ColumnScalar scalarType@(DC.ScalarType name graphQLType) ->
|
|
P.memoizeOn 'columnParser' (scalarType, nullability) $
|
|
GS.C.peelWithOrigin . fmap (RQL.ColumnValue columnType) . possiblyNullable' scalarType nullability
|
|
<$> do
|
|
gqlName <-
|
|
GQL.mkName name
|
|
`onNothing` throw400 ValidationFailed ("The column type name " <> name <<> " is not a valid GraphQL name")
|
|
pure $ case graphQLType of
|
|
Nothing -> P.jsonScalar gqlName (Just "A custom scalar type")
|
|
Just DC.GraphQLInt -> (J.Number . fromIntegral) <$> P.namedInt gqlName
|
|
Just DC.GraphQLFloat -> (J.Number . fromFloatDigits) <$> P.namedFloat gqlName
|
|
Just DC.GraphQLString -> J.String <$> P.namedString gqlName
|
|
Just DC.GraphQLBoolean -> J.Bool <$> P.namedBoolean gqlName
|
|
Just DC.GraphQLID -> J.String <$> P.namedIdentifier gqlName
|
|
RQL.ColumnEnumReference (RQL.EnumReference tableName enumValues customTableName) ->
|
|
case nonEmpty (Map.toList enumValues) of
|
|
Just enumValuesList ->
|
|
GS.C.peelWithOrigin . fmap (RQL.ColumnValue columnType)
|
|
<$> enumParser' tableName enumValuesList customTableName nullability
|
|
Nothing -> throw400 ValidationFailed "empty enum values"
|
|
|
|
enumParser' ::
|
|
MonadError QErr m =>
|
|
RQL.TableName 'DataConnector ->
|
|
NonEmpty (RQL.EnumValue, RQL.EnumValueInfo) ->
|
|
Maybe GQL.Name ->
|
|
GQL.Nullability ->
|
|
GS.C.SchemaT r m (P.Parser 'P.Both n (RQL.ScalarValue 'DataConnector))
|
|
enumParser' _tableName _enumValues _customTableName _nullability =
|
|
throw400 NotSupported "This column type is unsupported by the Data Connector backend"
|
|
|
|
possiblyNullable' ::
|
|
MonadParse m =>
|
|
RQL.ScalarType 'DataConnector ->
|
|
GQL.Nullability ->
|
|
P.Parser 'P.Both m J.Value ->
|
|
P.Parser 'P.Both m J.Value
|
|
possiblyNullable' _scalarType (GQL.Nullability isNullable)
|
|
| isNullable = fmap (fromMaybe J.Null) . P.nullable
|
|
| otherwise = id
|
|
|
|
orderByOperators' :: RQL.SourceInfo 'DataConnector -> NamingCase -> (GQL.Name, NonEmpty (P.Definition P.EnumValueInfo, (RQL.BasicOrderType 'DataConnector, RQL.NullsOrderType 'DataConnector)))
|
|
orderByOperators' RQL.SourceInfo {_siConfiguration} _tCase =
|
|
let dcName = DC._scDataConnectorName _siConfiguration
|
|
orderBy = GQL.addSuffixes (DC.unDataConnectorName dcName) [$$(GQL.litSuffix "_order_by")]
|
|
in (orderBy,) $
|
|
-- NOTE: NamingCase is not being used here as we don't support naming conventions for this DB
|
|
NE.fromList
|
|
[ ( define $$(GQL.litName "asc") "in ascending order",
|
|
(DC.Ascending, ())
|
|
),
|
|
( define $$(GQL.litName "desc") "in descending order",
|
|
(DC.Descending, ())
|
|
)
|
|
]
|
|
where
|
|
define name desc = P.Definition name (Just desc) Nothing [] P.EnumValueInfo
|
|
|
|
comparisonExps' ::
|
|
forall m n r.
|
|
MonadBuildSchema 'DataConnector r m n =>
|
|
RQL.ColumnType 'DataConnector ->
|
|
GS.C.SchemaT r m (P.Parser 'P.Input n [ComparisonExp 'DataConnector])
|
|
comparisonExps' columnType = do
|
|
collapseIfNull <- GS.C.retrieve Options.soDangerousBooleanCollapse
|
|
sourceInfo :: RQL.SourceInfo 'DataConnector <- asks getter
|
|
let dataConnectorName = sourceInfo ^. RQL.siConfiguration . DC.scDataConnectorName
|
|
tCase = RQL._rscNamingConvention $ RQL._siCustomization sourceInfo
|
|
P.memoizeOn 'comparisonExps' (dataConnectorName, columnType) do
|
|
typedParser <- columnParser' columnType (GQL.Nullability False)
|
|
let name = GQL.addSuffixes (P.getName typedParser) [$$(GQL.litSuffix "_"), GQL.convertNameToSuffix (DC.unDataConnectorName dataConnectorName), $$(GQL.litSuffix "_comparison_exp")]
|
|
desc =
|
|
GQL.Description $
|
|
"Boolean expression to compare columns of type "
|
|
<> P.getName typedParser
|
|
<<> ". All fields are combined with logical 'AND'."
|
|
columnListParser = fmap IR.openValueOrigin <$> P.list typedParser
|
|
customOperators <- (fmap . fmap . fmap) IR.ABackendSpecific <$> mkCustomOperators sourceInfo tCase collapseIfNull (P.getName typedParser)
|
|
pure $
|
|
P.object name (Just desc) $
|
|
fmap catMaybes $
|
|
sequenceA $
|
|
concat
|
|
[ GS.BE.equalityOperators
|
|
tCase
|
|
collapseIfNull
|
|
(IR.mkParameter <$> typedParser)
|
|
(mkListLiteral <$> columnListParser),
|
|
GS.BE.comparisonOperators
|
|
tCase
|
|
collapseIfNull
|
|
(IR.mkParameter <$> typedParser),
|
|
customOperators
|
|
]
|
|
where
|
|
mkListLiteral :: [RQL.ColumnValue 'DataConnector] -> IR.UnpreparedValue 'DataConnector
|
|
mkListLiteral columnValues =
|
|
IR.UVLiteral $ DC.ArrayLiteral (columnTypeToScalarType columnType) (RQL.cvValue <$> columnValues)
|
|
|
|
mkCustomOperators ::
|
|
RQL.SourceInfo 'DataConnector ->
|
|
NamingCase ->
|
|
Options.DangerouslyCollapseBooleans ->
|
|
GQL.Name ->
|
|
GS.C.SchemaT r m [P.InputFieldsParser n (Maybe (CustomBooleanOperator (IR.UnpreparedValue 'DataConnector)))]
|
|
mkCustomOperators sourceInfo tCase collapseIfNull typeName = do
|
|
let capabilities = sourceInfo ^. RQL.siConfiguration . DC.scCapabilities
|
|
case Map.lookup (DC.fromGQLType typeName) (API.unScalarTypesCapabilities $ API._cScalarTypes capabilities) of
|
|
Nothing -> pure []
|
|
Just API.ScalarTypeCapabilities {..} -> do
|
|
traverse (mkCustomOperator tCase collapseIfNull) $ Map.toList $ fmap (DC.mkScalarType capabilities) $ API.unComparisonOperators $ _stcComparisonOperators
|
|
|
|
mkCustomOperator ::
|
|
NamingCase ->
|
|
Options.DangerouslyCollapseBooleans ->
|
|
(GQL.Name, DC.ScalarType) ->
|
|
GS.C.SchemaT r m (P.InputFieldsParser n (Maybe (CustomBooleanOperator (IR.UnpreparedValue 'DataConnector))))
|
|
mkCustomOperator tCase collapseIfNull (operatorName, argType) = do
|
|
argParser <- mkArgParser argType
|
|
pure $
|
|
GS.BE.mkBoolOperator tCase collapseIfNull (fromCustomName operatorName) Nothing $
|
|
CustomBooleanOperator (GQL.unName operatorName) . Just . Right <$> argParser
|
|
|
|
mkArgParser :: DC.ScalarType -> GS.C.SchemaT r m (P.Parser 'P.Both n (IR.UnpreparedValue 'DataConnector))
|
|
mkArgParser argType =
|
|
fmap IR.mkParameter
|
|
<$> columnParser'
|
|
(RQL.ColumnScalar argType)
|
|
(GQL.Nullability True)
|
|
|
|
tableArgs' ::
|
|
forall r m n.
|
|
MonadBuildSchema 'DataConnector r m n =>
|
|
RQL.TableInfo 'DataConnector ->
|
|
GS.C.SchemaT r m (P.InputFieldsParser n (IR.SelectArgsG 'DataConnector (IR.UnpreparedValue 'DataConnector)))
|
|
tableArgs' tableInfo = do
|
|
whereParser <- GS.S.tableWhereArg tableInfo
|
|
orderByParser <- GS.S.tableOrderByArg tableInfo
|
|
let mkSelectArgs whereArg orderByArg limitArg offsetArg =
|
|
IR.SelectArgs
|
|
{ _saWhere = whereArg,
|
|
_saOrderBy = orderByArg,
|
|
_saLimit = limitArg,
|
|
_saOffset = offsetArg,
|
|
_saDistinct = Nothing
|
|
}
|
|
pure $
|
|
mkSelectArgs
|
|
<$> whereParser
|
|
<*> orderByParser
|
|
<*> GS.S.tableLimitArg
|
|
<*> GS.S.tableOffsetArg
|
|
|
|
countTypeInput' ::
|
|
MonadParse n =>
|
|
Maybe (P.Parser 'P.Both n DC.ColumnName) ->
|
|
P.InputFieldsParser n (IR.CountDistinct -> DC.CountAggregate)
|
|
countTypeInput' = \case
|
|
Just columnEnum -> mkCountAggregate <$> P.fieldOptional Name._column Nothing columnEnum
|
|
Nothing -> pure $ mkCountAggregate Nothing
|
|
where
|
|
mkCountAggregate :: Maybe DC.ColumnName -> IR.CountDistinct -> DC.CountAggregate
|
|
mkCountAggregate Nothing _ = DC.StarCount
|
|
mkCountAggregate (Just column) IR.SelectCountDistinct = DC.ColumnDistinctCount column
|
|
mkCountAggregate (Just column) IR.SelectCountNonDistinct = DC.ColumnCount column
|