mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 21:12:09 +03:00
342391f39d
This upgrades the version of Ormolu required by the HGE repository to v0.5.0.1, and reformats all code accordingly. Ormolu v0.5 reformats code that uses infix operators. This is mostly useful, adding newlines and indentation to make it clear which operators are applied first, but in some cases, it's unpleasant. To make this easier on the eyes, I had to do the following: * Add a few fixity declarations (search for `infix`) * Add parentheses to make precedence clear, allowing Ormolu to keep everything on one line * Rename `relevantEq` to `(==~)` in #6651 and set it to `infix 4` * Add a few _.ormolu_ files (thanks to @hallettj for helping me get started), mostly for Autodocodec operators that don't have explicit fixity declarations In general, I think these changes are quite reasonable. They mostly affect indentation. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6675 GitOrigin-RevId: cd47d87f1d089fb0bc9dcbbe7798dbceedcd7d83
423 lines
17 KiB
Haskell
423 lines
17 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.Char qualified as Char
|
|
import Data.Has
|
|
import Data.HashMap.Strict qualified as Map
|
|
import Data.List.NonEmpty qualified as NE
|
|
import Data.Text qualified as T
|
|
import Data.Text.Casing qualified as C
|
|
import Data.Text.Encoding as TE
|
|
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.Base.ErrorMessage (toErrorMessage)
|
|
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.NamingCase
|
|
import Hasura.GraphQL.Schema.Options qualified as Options
|
|
import Hasura.GraphQL.Schema.Parser
|
|
( FieldParser,
|
|
InputFieldsParser,
|
|
Kind (..),
|
|
MonadParse,
|
|
Parser,
|
|
)
|
|
import Hasura.GraphQL.Schema.Parser qualified as P
|
|
import Hasura.GraphQL.Schema.Select
|
|
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.Select qualified as IR
|
|
import Hasura.RQL.Types.Backend hiding (BackendInsert)
|
|
import Hasura.RQL.Types.Column
|
|
import Hasura.RQL.Types.SchemaCache
|
|
import Hasura.RQL.Types.Source
|
|
import Hasura.RQL.Types.SourceCustomization (MkRootFieldName (..))
|
|
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 _ _ _ _ _ _ = pure []
|
|
buildTableStreamingSubscriptionFields = GSB.buildTableStreamingSubscriptionFields
|
|
buildTableInsertMutationFields = GSB.buildTableInsertMutationFields backendInsertParser
|
|
buildTableDeleteMutationFields = GSB.buildTableDeleteMutationFields
|
|
buildTableUpdateMutationFields = msBuildTableUpdateMutationFields
|
|
|
|
buildFunctionQueryFields _ _ _ _ _ = pure []
|
|
buildFunctionRelayQueryFields _ _ _ _ _ _ = pure []
|
|
buildFunctionMutationFields _ _ _ _ _ = pure []
|
|
|
|
-- backend extensions
|
|
relayExtension = Nothing
|
|
nodesAggExtension = Just ()
|
|
streamSubscriptionExtension = Nothing
|
|
|
|
-- 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)
|
|
-}
|
|
mkRelationshipParser _ _ = pure Nothing
|
|
|
|
-- individual components
|
|
columnParser = msColumnParser
|
|
enumParser = msEnumParser
|
|
possiblyNullable = msPossiblyNullable
|
|
scalarSelectionArgumentsParser _ = pure Nothing
|
|
orderByOperators _sourceInfo = msOrderByOperators
|
|
comparisonExps = const msComparisonExps
|
|
countTypeInput = msCountTypeInput
|
|
aggregateOrderByCountType = MSSQL.IntegerType
|
|
computedField _ _ _ _ = pure Nothing
|
|
|
|
instance BackendTableSelectSchema 'MSSQL where
|
|
tableArguments = msTableArgs
|
|
selectTable = defaultSelectTable
|
|
selectTableAggregate = defaultSelectTableAggregate
|
|
tableSelectionSet = defaultTableSelectionSet
|
|
|
|
----------------------------------------------------------------
|
|
|
|
-- * Top level parsers
|
|
|
|
backendInsertParser ::
|
|
forall m r n.
|
|
MonadBuildSchema 'MSSQL r m n =>
|
|
SourceInfo 'MSSQL ->
|
|
TableInfo 'MSSQL ->
|
|
SchemaT r 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 =>
|
|
MkRootFieldName ->
|
|
Scenario ->
|
|
SourceInfo 'MSSQL ->
|
|
TableName 'MSSQL ->
|
|
TableInfo 'MSSQL ->
|
|
C.GQLNameIdentifier ->
|
|
SchemaT r m [FieldParser n (AnnotatedUpdateG 'MSSQL (RemoteRelationshipField UnpreparedValue) (UnpreparedValue 'MSSQL))]
|
|
msBuildTableUpdateMutationFields mkRootFieldName scenario sourceName tableName tableInfo gqlName = do
|
|
roleName <- retrieve scRole
|
|
fieldParsers <- runMaybeT do
|
|
updatePerms <- hoistMaybe $ _permUpd $ getRolePermInfo roleName tableInfo
|
|
let mkBackendUpdate backendUpdateTableInfo =
|
|
(fmap . fmap) BackendUpdate $
|
|
SU.buildUpdateOperators
|
|
(UpdateSet <$> SU.presetColumns updatePerms)
|
|
[ UpdateSet <$> SU.setOp,
|
|
UpdateInc <$> SU.incOp
|
|
]
|
|
backendUpdateTableInfo
|
|
lift $
|
|
GSB.buildTableUpdateMutationFields
|
|
mkBackendUpdate
|
|
mkRootFieldName
|
|
scenario
|
|
sourceName
|
|
tableName
|
|
tableInfo
|
|
gqlName
|
|
pure . fold @Maybe @[_] $ fieldParsers
|
|
|
|
----------------------------------------------------------------
|
|
|
|
-- * Table arguments
|
|
|
|
msTableArgs ::
|
|
forall r m n.
|
|
MonadBuildSchema 'MSSQL r m n =>
|
|
SourceInfo 'MSSQL ->
|
|
TableInfo 'MSSQL ->
|
|
SchemaT r 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
|
|
}
|
|
|
|
----------------------------------------------------------------
|
|
|
|
-- * Individual components
|
|
|
|
msColumnParser ::
|
|
MonadBuildSchema 'MSSQL r m n =>
|
|
ColumnType 'MSSQL ->
|
|
G.Nullability ->
|
|
SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
|
|
msColumnParser columnType nullability = 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 ->
|
|
P.memoizeOn 'msColumnParser (scalarType, nullability) $
|
|
peelWithOrigin . fmap (ColumnValue columnType) . msPossiblyNullable scalarType nullability
|
|
<$> case scalarType of
|
|
-- text
|
|
MSSQL.CharType -> pure $ mkCharValue <$> P.string
|
|
MSSQL.VarcharType -> pure $ mkCharValue <$> 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 P.ParseFailed . toErrorMessage . qeError) pure . (MSSQL.parseScalarValue scalarType)
|
|
}
|
|
ColumnEnumReference (EnumReference tableName enumValues customTableName) ->
|
|
case nonEmpty (Map.toList enumValues) of
|
|
Just enumValuesList ->
|
|
peelWithOrigin . fmap (ColumnValue columnType)
|
|
<$> msEnumParser tableName enumValuesList customTableName nullability
|
|
Nothing -> throw400 ValidationFailed "empty enum values"
|
|
where
|
|
-- CHAR/VARCHAR in MSSQL _can_ represent the full UCS (Universal Coded Character Set),
|
|
-- but might not always if the collation used is not UTF-8 enabled
|
|
-- https://docs.microsoft.com/en-us/sql/t-sql/data-types/char-and-varchar-transact-sql?view=sql-server-ver16
|
|
--
|
|
-- NCHAR/NVARCHAR in MSSQL are always able to represent the full UCS
|
|
-- https://docs.microsoft.com/en-us/sql/t-sql/data-types/nchar-and-nvarchar-transact-sql?view=sql-server-ver16
|
|
--
|
|
-- We'd prefer to encode as CHAR/VARCHAR literals to CHAR/VARCHAR columns, as this
|
|
-- means better index performance, BUT as we don't know what the collation
|
|
-- the column is set to (an example is 'SQL_Latin1_General_CP437_BIN') and thus
|
|
-- what characters are available in order to do this safely.
|
|
--
|
|
-- Therefore, we are conservative and only convert on the HGE side when the
|
|
-- characters are all ASCII and guaranteed to be in the target character
|
|
-- set, if not we pass an NCHAR/NVARCHAR and let MSSQL implicitly convert it.
|
|
|
|
-- resolves https://github.com/hasura/graphql-engine/issues/8735
|
|
mkCharValue :: Text -> ODBC.Value
|
|
mkCharValue txt =
|
|
if T.all Char.isAscii txt
|
|
then ODBC.ByteStringValue (TE.encodeUtf8 txt) -- an ODBC.ByteStringValue becomes a VARCHAR
|
|
else ODBC.TextValue txt -- an ODBC.TextValue becomes an NVARCHAR
|
|
|
|
msEnumParser ::
|
|
MonadBuildSchema 'MSSQL r m n =>
|
|
TableName 'MSSQL ->
|
|
NonEmpty (EnumValue, EnumValueInfo) ->
|
|
Maybe G.Name ->
|
|
G.Nullability ->
|
|
SchemaT r m (Parser 'Both n (ScalarValue 'MSSQL))
|
|
msEnumParser tableName enumValues customTableName nullability = do
|
|
enumName <- mkEnumTypeName @'MSSQL tableName customTableName
|
|
pure $ msPossiblyNullable MSSQL.VarcharType nullability $ P.enum enumName Nothing (mkEnumValue <$> enumValues)
|
|
where
|
|
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
|
|
)
|
|
|
|
msPossiblyNullable ::
|
|
(MonadParse m) =>
|
|
ScalarType 'MSSQL ->
|
|
G.Nullability ->
|
|
Parser 'Both m (ScalarValue 'MSSQL) ->
|
|
Parser 'Both m (ScalarValue 'MSSQL)
|
|
msPossiblyNullable _scalarType (G.Nullability isNullable)
|
|
| isNullable = fmap (fromMaybe ODBC.NullValue) . P.nullable
|
|
| otherwise = id
|
|
|
|
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.
|
|
MonadBuildSchema 'MSSQL r m n =>
|
|
ColumnType 'MSSQL ->
|
|
SchemaT r m (Parser 'Input n [ComparisonExp 'MSSQL])
|
|
msComparisonExps = P.memoize 'comparisonExps \columnType -> do
|
|
-- see Note [Columns in comparison expression are never nullable]
|
|
collapseIfNull <- retrieve Options.soDangerousBooleanCollapse
|
|
|
|
-- parsers used for individual values
|
|
typedParser <- columnParser columnType (G.Nullability False)
|
|
let columnListParser = fmap openValueOrigin <$> P.list typedParser
|
|
|
|
-- 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
|