graphql-engine/server/src-lib/Hasura/Backends/MSSQL/Instances/Schema.hs
Auke Booij 8ccf7724ce 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 15:53:44 +00:00

479 lines
18 KiB
Haskell

{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | MSSQL Instances Schema
--
-- Defines a 'Hasura.GraphQL.Schema.Backend.BackendSchema' type class instance for MSSQL.
module Hasura.Backends.MSSQL.Instances.Schema () where
import Data.Has
import Data.HashMap.Strict qualified as Map
import Data.List.NonEmpty qualified as NE
import Data.Text.Casing qualified as C
import Data.Text.Extended
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.Schema.IfMatched
import Hasura.Backends.MSSQL.Types.Insert (BackendInsert (..))
import Hasura.Backends.MSSQL.Types.Internal qualified as MSSQL
import Hasura.Backends.MSSQL.Types.Update (BackendUpdate (..), UpdateOperator (..))
import Hasura.Base.Error
import Hasura.GraphQL.Schema.Backend
import Hasura.GraphQL.Schema.BoolExp
import Hasura.GraphQL.Schema.Build qualified as GSB
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Parser
( FieldParser,
InputFieldsParser,
Kind (..),
MonadParse,
MonadSchema,
Parser,
)
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Select
import Hasura.GraphQL.Schema.Table
import Hasura.GraphQL.Schema.Update qualified as SU
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR
import Hasura.RQL.IR.Insert qualified as IR
import Hasura.RQL.IR.Select qualified as IR
import Hasura.RQL.Types.Backend hiding (BackendInsert)
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization (NamingCase)
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Language.GraphQL.Draft.Syntax qualified as G
----------------------------------------------------------------
-- * BackendSchema instance
instance BackendSchema 'MSSQL where
-- top level parsers
buildTableQueryAndSubscriptionFields = GSB.buildTableQueryAndSubscriptionFields
buildTableRelayQueryFields = msBuildTableRelayQueryFields
buildTableStreamingSubscriptionFields = GSB.buildTableStreamingSubscriptionFields
buildTableInsertMutationFields = GSB.buildTableInsertMutationFields backendInsertParser
buildTableDeleteMutationFields = GSB.buildTableDeleteMutationFields
buildTableUpdateMutationFields = msBuildTableUpdateMutationFields
buildFunctionQueryFields = msBuildFunctionQueryFields
buildFunctionRelayQueryFields = msBuildFunctionRelayQueryFields
buildFunctionMutationFields = msBuildFunctionMutationFields
-- backend extensions
relayExtension = Nothing
nodesAggExtension = Just ()
streamSubscriptionExtension = Nothing
-- table arguments
tableArguments = msTableArgs
mkRelationshipParser = msMkRelationshipParser
-- individual components
columnParser = msColumnParser
scalarSelectionArgumentsParser = msScalarSelectionArgumentsParser
orderByOperators _sourceInfo = msOrderByOperators
comparisonExps = msComparisonExps
countTypeInput = msCountTypeInput
aggregateOrderByCountType = MSSQL.IntegerType
computedField = msComputedField
----------------------------------------------------------------
-- * Top level parsers
msBuildTableRelayQueryFields ::
MonadBuildSchema 'MSSQL r m n =>
SourceInfo 'MSSQL ->
TableName 'MSSQL ->
TableInfo 'MSSQL ->
C.GQLNameIdentifier ->
NESeq (ColumnInfo 'MSSQL) ->
m [a]
msBuildTableRelayQueryFields _sourceName _tableName _tableInfo _gqlName _pkeyColumns =
pure []
backendInsertParser ::
forall m r n.
MonadBuildSchema 'MSSQL r m n =>
SourceInfo 'MSSQL ->
TableInfo 'MSSQL ->
m (InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL)))
backendInsertParser sourceName tableInfo = do
ifMatched <- ifMatchedFieldParser sourceName tableInfo
let _biIdentityColumns = _tciExtraTableMetadata $ _tiCoreInfo tableInfo
pure $ do
_biIfMatched <- ifMatched
pure $ BackendInsert {..}
msBuildTableUpdateMutationFields ::
MonadBuildSchema 'MSSQL r m n =>
Scenario ->
SourceInfo 'MSSQL ->
TableName 'MSSQL ->
TableInfo 'MSSQL ->
C.GQLNameIdentifier ->
m [FieldParser n (AnnotatedUpdateG 'MSSQL (RemoteRelationshipField UnpreparedValue) (UnpreparedValue 'MSSQL))]
msBuildTableUpdateMutationFields scenario sourceName tableName tableInfo gqlName = do
fieldParsers <- runMaybeT do
updatePerms <- MaybeT $ _permUpd <$> tablePermissions tableInfo
let mkBackendUpdate backendUpdateTableInfo =
(fmap . fmap) BackendUpdate $
SU.buildUpdateOperators
(UpdateSet <$> SU.presetColumns updatePerms)
[ UpdateSet <$> SU.setOp,
UpdateInc <$> SU.incOp
]
backendUpdateTableInfo
lift $
GSB.buildTableUpdateMutationFields
mkBackendUpdate
scenario
sourceName
tableName
tableInfo
gqlName
pure . fold @Maybe @[_] $ fieldParsers
{-
NOTE: We currently use 'GSB.buildTableDeleteMutationFields' instead of
this. Should we save it?
msBuildTableDeleteMutationFields ::
MonadBuildSchema 'MSSQL r m n =>
SourceInfo 'MSSQL ->
TableName 'MSSQL ->
TableInfo 'MSSQL ->
G.Name ->
DelPermInfo 'MSSQL ->
Maybe (SelPermInfo 'MSSQL) ->
m [a]
msBuildTableDeleteMutationFields _sourceName _tableName _tableInfo _gqlName _delPerns _selPerms =
pure []
-}
msBuildFunctionQueryFields ::
MonadBuildSchema 'MSSQL r m n =>
SourceInfo 'MSSQL ->
FunctionName 'MSSQL ->
FunctionInfo 'MSSQL ->
TableName 'MSSQL ->
m [a]
msBuildFunctionQueryFields _ _ _ _ =
pure []
msBuildFunctionRelayQueryFields ::
MonadBuildSchema 'MSSQL r m n =>
SourceInfo 'MSSQL ->
FunctionName 'MSSQL ->
FunctionInfo 'MSSQL ->
TableName 'MSSQL ->
NESeq (ColumnInfo 'MSSQL) ->
m [a]
msBuildFunctionRelayQueryFields _sourceName _functionName _functionInfo _tableName _pkeyColumns =
pure []
msBuildFunctionMutationFields ::
MonadBuildSchema 'MSSQL r m n =>
SourceInfo 'MSSQL ->
FunctionName 'MSSQL ->
FunctionInfo 'MSSQL ->
TableName 'MSSQL ->
m [a]
msBuildFunctionMutationFields _ _ _ _ =
pure []
----------------------------------------------------------------
-- * Table arguments
msTableArgs ::
forall r m n.
MonadBuildSchema 'MSSQL r m n =>
SourceInfo 'MSSQL ->
TableInfo 'MSSQL ->
m (InputFieldsParser n (IR.SelectArgsG 'MSSQL (UnpreparedValue 'MSSQL)))
msTableArgs sourceName tableInfo = do
whereParser <- tableWhereArg sourceName tableInfo
orderByParser <- tableOrderByArg sourceName tableInfo
pure do
whereArg <- whereParser
orderByArg <- orderByParser
limitArg <- tableLimitArg
offsetArg <- tableOffsetArg
pure $
IR.SelectArgs
{ IR._saWhere = whereArg,
IR._saOrderBy = orderByArg,
IR._saLimit = limitArg,
IR._saOffset = offsetArg,
-- not supported on MSSQL for now
IR._saDistinct = Nothing
}
msMkRelationshipParser ::
forall r m n.
MonadBuildSchema 'MSSQL r m n =>
SourceInfo 'MSSQL ->
RelInfo 'MSSQL ->
m (Maybe (InputFieldsParser n (Maybe (IR.AnnotatedInsertField 'MSSQL (UnpreparedValue 'MSSQL)))))
msMkRelationshipParser _sourceName _relationshipInfo = do
-- When we support nested inserts, we also need to ensure we limit ourselves
-- to inserting into tables whch supports inserts:
{-
import Hasura.GraphQL.Schema.Mutation qualified as GSB
runMaybeT $ do
let otherTableName = riRTable relationshipInfo
otherTableInfo <- lift $ askTableInfo sourceName otherTableName
guard (supportsInserts otherTableInfo)
-}
return Nothing
----------------------------------------------------------------
-- * Individual components
msColumnParser ::
(MonadSchema n m, MonadError QErr m, MonadReader r m, Has P.MkTypename r) =>
ColumnType 'MSSQL ->
G.Nullability ->
m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
msColumnParser columnType (G.Nullability isNullable) =
peelWithOrigin . fmap (ColumnValue columnType) <$> case columnType of
-- TODO: the mapping here is not consistent with mkMSSQLScalarTypeName. For
-- example, exposing all the float types as a GraphQL Float type is
-- incorrect, similarly exposing all the integer types as a GraphQL Int
ColumnScalar scalarType ->
possiblyNullable scalarType <$> case scalarType of
-- text
MSSQL.CharType -> pure $ ODBC.TextValue <$> P.string
MSSQL.VarcharType -> pure $ ODBC.TextValue <$> P.string
MSSQL.WcharType -> pure $ ODBC.TextValue <$> P.string
MSSQL.WvarcharType -> pure $ ODBC.TextValue <$> P.string
MSSQL.WtextType -> pure $ ODBC.TextValue <$> P.string
MSSQL.TextType -> pure $ ODBC.TextValue <$> P.string
-- integer
MSSQL.IntegerType -> pure $ ODBC.IntValue . fromIntegral <$> P.int
MSSQL.SmallintType -> pure $ ODBC.IntValue . fromIntegral <$> P.int
MSSQL.BigintType -> pure $ ODBC.IntValue . fromIntegral <$> P.int
MSSQL.TinyintType -> pure $ ODBC.IntValue . fromIntegral <$> P.int
-- float
MSSQL.NumericType -> pure $ ODBC.DoubleValue <$> P.float
MSSQL.DecimalType -> pure $ ODBC.DoubleValue <$> P.float
MSSQL.FloatType -> pure $ ODBC.DoubleValue <$> P.float
MSSQL.RealType -> pure $ ODBC.DoubleValue <$> P.float
-- boolean
MSSQL.BitType -> pure $ ODBC.BoolValue <$> P.boolean
_ -> do
name <- MSSQL.mkMSSQLScalarTypeName scalarType
let schemaType = P.TNamed P.NonNullable $ P.Definition name Nothing Nothing P.TIScalar
pure $
P.Parser
{ pType = schemaType,
pParser =
P.valueToJSON (P.toGraphQLType schemaType)
>=> either (P.parseErrorWith ParseFailed . qeError) pure . (MSSQL.parseScalarValue scalarType)
}
ColumnEnumReference enumRef@(EnumReference _ enumValues _) ->
case nonEmpty (Map.toList enumValues) of
Just enumValuesList -> do
enumName <- mkEnumTypeName enumRef
pure $ possiblyNullable MSSQL.VarcharType $ P.enum enumName Nothing (mkEnumValue <$> enumValuesList)
Nothing -> throw400 ValidationFailed "empty enum values"
where
possiblyNullable _scalarType
| isNullable = fmap (fromMaybe ODBC.NullValue) . P.nullable
| otherwise = id
mkEnumValue :: (EnumValue, EnumValueInfo) -> (P.Definition P.EnumValueInfo, ScalarValue 'MSSQL)
mkEnumValue (EnumValue value, EnumValueInfo description) =
( P.Definition value (G.Description <$> description) Nothing P.EnumValueInfo,
ODBC.TextValue $ G.unName value
)
msScalarSelectionArgumentsParser ::
MonadParse n =>
ColumnType 'MSSQL ->
InputFieldsParser n (Maybe (ScalarSelectionArguments 'MSSQL))
msScalarSelectionArgumentsParser _columnType = pure Nothing
msOrderByOperators ::
NamingCase ->
( G.Name,
NonEmpty
( P.Definition P.EnumValueInfo,
(BasicOrderType 'MSSQL, NullsOrderType 'MSSQL)
)
)
msOrderByOperators _tCase =
(Name._order_by,) $
-- NOTE: NamingCase is not being used here as we don't support naming conventions for this DB
NE.fromList
[ ( define Name._asc "in ascending order, nulls first",
(MSSQL.AscOrder, MSSQL.NullsFirst)
),
( define Name._asc_nulls_first "in ascending order, nulls first",
(MSSQL.AscOrder, MSSQL.NullsFirst)
),
( define Name._asc_nulls_last "in ascending order, nulls last",
(MSSQL.AscOrder, MSSQL.NullsLast)
),
( define Name._desc "in descending order, nulls last",
(MSSQL.DescOrder, MSSQL.NullsLast)
),
( define Name._desc_nulls_first "in descending order, nulls first",
(MSSQL.DescOrder, MSSQL.NullsFirst)
),
( define Name._desc_nulls_last "in descending order, nulls last",
(MSSQL.DescOrder, MSSQL.NullsLast)
)
]
where
define name desc = P.Definition name (Just desc) Nothing P.EnumValueInfo
msComparisonExps ::
forall m n r.
( BackendSchema 'MSSQL,
MonadSchema n m,
MonadError QErr m,
MonadReader r m,
Has SchemaOptions r,
Has P.MkTypename r,
Has NamingCase r
) =>
ColumnType 'MSSQL ->
m (Parser 'Input n [ComparisonExp 'MSSQL])
msComparisonExps = P.memoize 'comparisonExps \columnType -> do
-- see Note [Columns in comparison expression are never nullable]
collapseIfNull <- retrieve soDangerousBooleanCollapse
-- parsers used for individual values
typedParser <- columnParser columnType (G.Nullability False)
_nullableTextParser <- columnParser (ColumnScalar @'MSSQL MSSQL.VarcharType) (G.Nullability True)
textParser <- columnParser (ColumnScalar @'MSSQL MSSQL.VarcharType) (G.Nullability False)
let columnListParser = fmap openValueOrigin <$> P.list typedParser
_textListParser = fmap openValueOrigin <$> P.list textParser
-- field info
let name = P.getName typedParser <> Name.__MSSQL_comparison_exp
desc =
G.Description $
"Boolean expression to compare columns of type "
<> P.getName typedParser
<<> ". All fields are combined with logical 'AND'."
-- Naming convention
tCase <- asks getter
pure $
P.object name (Just desc) $
fmap catMaybes $
sequenceA $
concat
[ -- Common ops for all types
equalityOperators
tCase
collapseIfNull
(mkParameter <$> typedParser)
(mkListLiteral <$> columnListParser),
comparisonOperators
tCase
collapseIfNull
(mkParameter <$> typedParser),
-- Ops for String like types
guard (isScalarColumnWhere (`elem` MSSQL.stringTypes) columnType)
*> [ P.fieldOptional
Name.__like
(Just "does the column match the given pattern")
(ALIKE . mkParameter <$> typedParser),
P.fieldOptional
Name.__nlike
(Just "does the column NOT match the given pattern")
(ANLIKE . mkParameter <$> typedParser)
],
-- Ops for Geometry/Geography types
guard (isScalarColumnWhere (`elem` MSSQL.geoTypes) columnType)
*> [ P.fieldOptional
Name.__st_contains
(Just "does the column contain the given value")
(ABackendSpecific . MSSQL.ASTContains . mkParameter <$> typedParser),
P.fieldOptional
Name.__st_equals
(Just "is the column equal to given value (directionality is ignored)")
(ABackendSpecific . MSSQL.ASTEquals . mkParameter <$> typedParser),
P.fieldOptional
Name.__st_intersects
(Just "does the column spatially intersect the given value")
(ABackendSpecific . MSSQL.ASTIntersects . mkParameter <$> typedParser),
P.fieldOptional
Name.__st_overlaps
(Just "does the column 'spatially overlap' (intersect but not completely contain) the given value")
(ABackendSpecific . MSSQL.ASTOverlaps . mkParameter <$> typedParser),
P.fieldOptional
Name.__st_within
(Just "is the column contained in the given value")
(ABackendSpecific . MSSQL.ASTWithin . mkParameter <$> typedParser)
],
-- Ops for Geometry types
guard (isScalarColumnWhere (MSSQL.GeometryType ==) columnType)
*> [ P.fieldOptional
Name.__st_crosses
(Just "does the column cross the given geometry value")
(ABackendSpecific . MSSQL.ASTCrosses . mkParameter <$> typedParser),
P.fieldOptional
Name.__st_touches
(Just "does the column have at least one point in common with the given geometry value")
(ABackendSpecific . MSSQL.ASTTouches . mkParameter <$> typedParser)
]
]
where
mkListLiteral :: [ColumnValue 'MSSQL] -> UnpreparedValue 'MSSQL
mkListLiteral =
UVLiteral . MSSQL.ListExpression . fmap (MSSQL.ValueExpression . cvValue)
msCountTypeInput ::
MonadParse n =>
Maybe (Parser 'Both n (Column 'MSSQL)) ->
InputFieldsParser n (IR.CountDistinct -> CountType 'MSSQL)
msCountTypeInput = \case
Just columnEnum -> do
column <- P.fieldOptional Name._column Nothing columnEnum
pure $ flip mkCountType column
Nothing -> pure $ flip mkCountType Nothing
where
mkCountType :: IR.CountDistinct -> Maybe (Column 'MSSQL) -> CountType 'MSSQL
mkCountType _ Nothing = MSSQL.StarCountable
mkCountType IR.SelectCountDistinct (Just col) = MSSQL.DistinctCountable col
mkCountType IR.SelectCountNonDistinct (Just col) = MSSQL.NonNullFieldCountable col
-- | Computed field parser.
-- Currently unsupported: returns Nothing for now.
msComputedField ::
MonadBuildSchema 'MSSQL r m n =>
SourceInfo 'MSSQL ->
ComputedFieldInfo 'MSSQL ->
TableName 'MSSQL ->
TableInfo 'MSSQL ->
m (Maybe (FieldParser n (AnnotatedField 'MSSQL)))
msComputedField _sourceName _fieldInfo _table _tableInfo = pure Nothing
{-
NOTE: Unused, should we remove?
-- | Remote join field parser.
-- Currently unsupported: returns Nothing for now.
msRemoteRelationshipField ::
MonadBuildSchema 'MSSQL r m n =>
RemoteFieldInfo (DBJoinField 'MSSQL) ->
m (Maybe [FieldParser n (AnnotatedField 'MSSQL)])
msRemoteRelationshipField _remoteFieldInfo = pure Nothing
-}