graphql-engine/server/src-lib/Hasura/Backends/DataConnector/Adapter/Schema.hs

Ignoring revisions in .git-blame-ignore-revs. Click here to bypass and see the normal blame view.

266 lines
11 KiB
Haskell
Raw Normal View History

{-# 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.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.Base.Error
import Hasura.GraphQL.Parser.Class
import Hasura.GraphQL.Schema.Backend (BackendSchema (..), BackendTableSelectSchema (..), 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
server: Metadata origin for definitions (type parameter version v2) The code that builds the GraphQL schema, and `buildGQLContext` in particular, is partial: not every value of `(ServerConfigCtx, GraphQLQueryType, SourceCache, HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject), ActionCache, AnnotatedCustomTypes)` results in a valid GraphQL schema. When it fails, we want to be able to return better error messages than we currently do. The key thing that is missing is a way to trace back GraphQL type information to their origin from the Hasura metadata. Currently, we have a number of correctness checks of our GraphQL schema. But these correctness checks only have access to pure GraphQL type information, and hence can only report errors in terms of that. Possibly the worst is the "conflicting definitions" error, which, in practice, can only be debugged by Hasura engineers. This is terrible DX for customers. This PR allows us to print better error messages, by adding a field to the `Definition` type that traces the GraphQL type to its origin in the metadata. So the idea is simple: just add `MetadataObjId`, or `Maybe` that, or some other sum type of that, to `Definition`. However, we want to avoid having to import a `Hasura.RQL` module from `Hasura.GraphQL.Parser`. So we instead define this additional field of `Definition` through a new type parameter, which is threaded through in `Hasura.GraphQL.Parser`. We then define type synonyms in `Hasura.GraphQL.Schema.Parser` that fill in this type parameter, so that it is not visible for the majority of the codebase. The idea of associating metadata information to `Definition`s really comes to fruition when combined with hasura/graphql-engine-mono#4517. Their combination would allow us to use the API of fatal errors (just like the current `MonadError QErr`) to report _inconsistencies_ in the metadata. Such inconsistencies are then _automatically_ ignored. So no ad-hoc decisions need to be made on how to cut out inconsistent metadata from the GraphQL schema. This will allow us to report much better errors, as well as improve the likelihood of a successful HGE startup. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4770 Co-authored-by: Samir Talwar <47582+SamirTalwar@users.noreply.github.com> GitOrigin-RevId: 728402b0cae83ae8e83463a826ceeb609001acae
2022-06-28 18:52:26 +03:00
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Select qualified as GS.S
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp qualified as IR
import Hasura.RQL.IR.Select 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
2022-05-27 20:21:22 +03:00
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
import Witch qualified
--------------------------------------------------------------------------------
instance BackendSchema 'DataConnector where
-- top level parsers
buildTableQueryAndSubscriptionFields = GS.B.buildTableQueryAndSubscriptionFields
buildTableRelayQueryFields = experimentalBuildTableRelayQueryFields
buildFunctionQueryFields _ _ _ _ _ = pure []
buildFunctionRelayQueryFields _ _ _ _ _ _ = pure []
buildFunctionMutationFields _ _ _ _ _ = pure []
buildTableInsertMutationFields _ _ _ _ _ _ = pure []
buildTableUpdateMutationFields _ _ _ _ _ _ = pure []
buildTableDeleteMutationFields _ _ _ _ _ _ = pure []
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 = DC.NumberTy
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
--------------------------------------------------------------------------------
experimentalBuildTableRelayQueryFields ::
MonadBuildSchema 'DataConnector r m n =>
RQL.MkRootFieldName ->
2022-05-27 20:21:22 +03:00
RQL.SourceInfo 'DataConnector ->
RQL.TableName 'DataConnector ->
RQL.TableInfo 'DataConnector ->
GQLNameIdentifier ->
NESeq (RQL.ColumnInfo 'DataConnector) ->
GS.C.SchemaT r m [P.FieldParser n a]
experimentalBuildTableRelayQueryFields _mkRootFieldName _sourceName _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 ->
P.memoizeOn 'columnParser' (scalarType, nullability) $
GS.C.peelWithOrigin . fmap (RQL.ColumnValue columnType) . possiblyNullable' scalarType nullability
<$> case scalarType of
DC.StringTy -> pure $ J.String <$> P.string
DC.NumberTy -> pure $ J.Number <$> P.scientific
DC.BoolTy -> pure $ J.Bool <$> P.boolean
DC.CustomTy name -> do
gqlName <-
GQL.mkName name
`onNothing` throw400 ValidationFailed ("The column type name " <> name <<> " is not a valid GraphQL name")
pure $ P.jsonScalar gqlName (Just "A custom scalar type")
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.SourceInfo 'DataConnector ->
RQL.ColumnType 'DataConnector ->
GS.C.SchemaT r m (P.Parser 'P.Input n [ComparisonExp 'DataConnector])
comparisonExps' sourceInfo columnType = P.memoizeOn 'comparisonExps' (dataConnectorName, columnType) $ do
tCase <- asks getter
collapseIfNull <- GS.C.retrieve Options.soDangerousBooleanCollapse
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 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
dataConnectorName = sourceInfo ^. RQL.siConfiguration . DC.scDataConnectorName
mkListLiteral :: [RQL.ColumnValue 'DataConnector] -> IR.UnpreparedValue 'DataConnector
mkListLiteral columnValues =
IR.UVLiteral $ DC.ArrayLiteral (columnTypeToScalarType columnType) (RQL.cvValue <$> columnValues)
mkCustomOperators ::
NamingCase ->
Options.DangerouslyCollapseBooleans ->
GQL.Name ->
GS.C.SchemaT r m [P.InputFieldsParser n (Maybe (CustomBooleanOperator (IR.UnpreparedValue 'DataConnector)))]
mkCustomOperators tCase collapseIfNull typeName = do
let capabilities = sourceInfo ^. RQL.siConfiguration . DC.scCapabilities
case Map.lookup (Witch.from $ DC.fromGQLType typeName) (API.unScalarTypesCapabilities $ API._cScalarTypes capabilities) of
Nothing -> pure []
Just API.ScalarTypeCapabilities {..} -> do
traverse (mkCustomOperator tCase collapseIfNull) $ Map.toList $ fmap Witch.from $ 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 =>
2022-05-27 20:21:22 +03:00
RQL.SourceInfo 'DataConnector ->
RQL.TableInfo 'DataConnector ->
GS.C.SchemaT r m (P.InputFieldsParser n (IR.SelectArgsG 'DataConnector (IR.UnpreparedValue 'DataConnector)))
tableArgs' sourceName tableInfo = do
whereParser <- GS.S.tableWhereArg sourceName tableInfo
orderByParser <- GS.S.tableOrderByArg sourceName 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