mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
0e65932355
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2691 Co-authored-by: Abby Sassel <3883855+sassela@users.noreply.github.com> Co-authored-by: Rakesh Emmadi <12475069+rakeshkky@users.noreply.github.com> GitOrigin-RevId: 8b66cc30e8e036ee56a5267c1d2f308155951ae9
667 lines
26 KiB
Haskell
667 lines
26 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Hasura.Backends.MSSQL.Instances.Execute
|
|
( MultiplexedQuery' (..),
|
|
multiplexRootReselect,
|
|
)
|
|
where
|
|
|
|
import Control.Monad.Trans.Control (MonadBaseControl)
|
|
import Control.Monad.Validate qualified as V
|
|
import Data.Aeson.Extended qualified as J
|
|
import Data.HashMap.Strict qualified as Map
|
|
import Data.HashMap.Strict.InsOrd qualified as OMap
|
|
import Data.HashSet qualified as Set
|
|
import Data.List.NonEmpty qualified as NE
|
|
import Data.Text.Extended qualified as T
|
|
import Database.MSSQL.Transaction qualified as Tx
|
|
import Database.ODBC.Internal qualified as ODBCI
|
|
import Database.ODBC.SQLServer qualified as ODBC
|
|
import Hasura.Backends.MSSQL.Connection
|
|
import Hasura.Backends.MSSQL.FromIr as TSQL
|
|
import Hasura.Backends.MSSQL.Plan
|
|
import Hasura.Backends.MSSQL.SQL.Value (txtEncodedColVal)
|
|
import Hasura.Backends.MSSQL.ToQuery as TQ
|
|
import Hasura.Backends.MSSQL.Types as TSQL
|
|
import Hasura.Base.Error
|
|
import Hasura.EncJSON
|
|
import Hasura.GraphQL.Execute.Backend
|
|
import Hasura.GraphQL.Execute.LiveQuery.Plan
|
|
import Hasura.GraphQL.Namespace (RootFieldAlias (..), RootFieldMap)
|
|
import Hasura.GraphQL.Parser
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.IR
|
|
import Hasura.RQL.IR qualified as IR
|
|
import Hasura.RQL.Types
|
|
import Hasura.RQL.Types qualified as RQLTypes
|
|
import Hasura.RQL.Types.Column qualified as RQLColumn
|
|
import Hasura.SQL.AnyBackend qualified as AB
|
|
import Hasura.Session
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
instance BackendExecute 'MSSQL where
|
|
type PreparedQuery 'MSSQL = Text
|
|
type MultiplexedQuery 'MSSQL = MultiplexedQuery'
|
|
type ExecutionMonad 'MSSQL = ExceptT QErr IO
|
|
|
|
mkDBQueryPlan = msDBQueryPlan
|
|
mkDBMutationPlan = msDBMutationPlan
|
|
mkDBSubscriptionPlan = msDBSubscriptionPlan
|
|
mkDBQueryExplain = msDBQueryExplain
|
|
mkLiveQueryExplain = msDBLiveQueryExplain
|
|
|
|
-- NOTE: Currently unimplemented!.
|
|
--
|
|
-- This function is just a stub for future implementation; for now it just
|
|
-- throws a 500 error.
|
|
mkDBRemoteRelationshipPlan =
|
|
msDBRemoteRelationshipPlan
|
|
|
|
-- Multiplexed query
|
|
|
|
newtype MultiplexedQuery' = MultiplexedQuery' Reselect
|
|
|
|
instance T.ToTxt MultiplexedQuery' where
|
|
toTxt (MultiplexedQuery' reselect) = T.toTxt $ toQueryPretty $ fromReselect reselect
|
|
|
|
-- Query
|
|
|
|
msDBQueryPlan ::
|
|
forall m.
|
|
( MonadError QErr m
|
|
) =>
|
|
UserInfo ->
|
|
SourceName ->
|
|
SourceConfig 'MSSQL ->
|
|
QueryDB 'MSSQL (Const Void) (UnpreparedValue 'MSSQL) ->
|
|
m (DBStepInfo 'MSSQL)
|
|
msDBQueryPlan userInfo sourceName sourceConfig qrf = do
|
|
-- TODO (naveen): Append Query Tags to the query
|
|
let sessionVariables = _uiSession userInfo
|
|
statement <- planQuery sessionVariables qrf
|
|
let printer = fromSelect statement
|
|
queryString = ODBC.renderQuery $ toQueryPretty printer
|
|
pool = _mscConnectionPool sourceConfig
|
|
odbcQuery = encJFromText <$> runJSONPathQuery pool (toQueryFlat printer)
|
|
pure $ DBStepInfo @'MSSQL sourceName sourceConfig (Just queryString) odbcQuery
|
|
|
|
runShowplan ::
|
|
ODBC.Query -> ODBC.Connection -> IO [Text]
|
|
runShowplan query conn = do
|
|
ODBC.exec conn "SET SHOWPLAN_TEXT ON"
|
|
texts <- ODBC.query conn query
|
|
ODBC.exec conn "SET SHOWPLAN_TEXT OFF"
|
|
-- we don't need to use 'finally' here - if an exception occurs,
|
|
-- the connection is removed from the resource pool in 'withResource'.
|
|
pure texts
|
|
|
|
msDBQueryExplain ::
|
|
MonadError QErr m =>
|
|
RootFieldAlias ->
|
|
UserInfo ->
|
|
SourceName ->
|
|
SourceConfig 'MSSQL ->
|
|
QueryDB 'MSSQL (Const Void) (UnpreparedValue 'MSSQL) ->
|
|
m (AB.AnyBackend DBStepInfo)
|
|
msDBQueryExplain fieldName userInfo sourceName sourceConfig qrf = do
|
|
let sessionVariables = _uiSession userInfo
|
|
statement <- planQuery sessionVariables qrf
|
|
let query = toQueryPretty (fromSelect statement)
|
|
queryString = ODBC.renderQuery query
|
|
pool = _mscConnectionPool sourceConfig
|
|
odbcQuery =
|
|
withMSSQLPool
|
|
pool
|
|
( \conn -> liftIO do
|
|
showplan <- runShowplan query conn
|
|
pure
|
|
( encJFromJValue $
|
|
ExplainPlan
|
|
fieldName
|
|
(Just queryString)
|
|
(Just showplan)
|
|
)
|
|
)
|
|
pure $
|
|
AB.mkAnyBackend $
|
|
DBStepInfo @'MSSQL sourceName sourceConfig Nothing odbcQuery
|
|
|
|
msDBLiveQueryExplain ::
|
|
(MonadIO m, MonadBaseControl IO m, MonadError QErr m) =>
|
|
LiveQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL) ->
|
|
m LiveQueryPlanExplanation
|
|
msDBLiveQueryExplain (LiveQueryPlan plan sourceConfig variables _) = do
|
|
let (MultiplexedQuery' reselect) = _plqpQuery plan
|
|
query = toQueryPretty $ fromSelect $ multiplexRootReselect [(dummyCohortId, variables)] reselect
|
|
pool = _mscConnectionPool sourceConfig
|
|
explainInfo <- withMSSQLPool pool (liftIO . runShowplan query)
|
|
pure $ LiveQueryPlanExplanation (T.toTxt query) explainInfo variables
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Producing the correct SQL-level list comprehension to multiplex a query
|
|
|
|
-- Problem description:
|
|
--
|
|
-- Generate a query that repeats the same query N times but with
|
|
-- certain slots replaced:
|
|
--
|
|
-- [ Select x y | (x,y) <- [..] ]
|
|
--
|
|
|
|
multiplexRootReselect ::
|
|
[(CohortId, CohortVariables)] ->
|
|
TSQL.Reselect ->
|
|
TSQL.Select
|
|
multiplexRootReselect variables rootReselect =
|
|
emptySelect
|
|
{ selectTop = NoTop,
|
|
selectProjections =
|
|
[ FieldNameProjection
|
|
Aliased
|
|
{ aliasedThing =
|
|
TSQL.FieldName
|
|
{ fieldNameEntity = rowAlias,
|
|
fieldName = resultIdAlias
|
|
},
|
|
aliasedAlias = resultIdAlias
|
|
},
|
|
ExpressionProjection
|
|
Aliased
|
|
{ aliasedThing =
|
|
ColumnExpression
|
|
( TSQL.FieldName
|
|
{ fieldNameEntity = resultAlias,
|
|
fieldName = TSQL.jsonFieldName
|
|
}
|
|
),
|
|
aliasedAlias = resultAlias
|
|
}
|
|
],
|
|
selectFrom =
|
|
Just $
|
|
FromOpenJson
|
|
Aliased
|
|
{ aliasedThing =
|
|
OpenJson
|
|
{ openJsonExpression =
|
|
ValueExpression (ODBC.TextValue $ lbsToTxt $ J.encode variables),
|
|
openJsonWith =
|
|
Just $
|
|
NE.fromList
|
|
[ UuidField resultIdAlias (Just $ IndexPath RootPath 0),
|
|
JsonField resultVarsAlias (Just $ IndexPath RootPath 1)
|
|
]
|
|
},
|
|
aliasedAlias = rowAlias
|
|
},
|
|
selectJoins =
|
|
[ Join
|
|
{ joinSource = JoinReselect rootReselect,
|
|
joinJoinAlias =
|
|
JoinAlias
|
|
{ joinAliasEntity = resultAlias,
|
|
joinAliasField = Just TSQL.jsonFieldName
|
|
}
|
|
}
|
|
],
|
|
selectWhere = Where mempty,
|
|
selectFor =
|
|
JsonFor ForJson {jsonCardinality = JsonArray, jsonRoot = NoRoot},
|
|
selectOrderBy = Nothing,
|
|
selectOffset = Nothing
|
|
}
|
|
|
|
-- mutation
|
|
|
|
msDBMutationPlan ::
|
|
forall m.
|
|
( MonadError QErr m
|
|
) =>
|
|
UserInfo ->
|
|
Bool ->
|
|
SourceName ->
|
|
SourceConfig 'MSSQL ->
|
|
MutationDB 'MSSQL (Const Void) (UnpreparedValue 'MSSQL) ->
|
|
m (DBStepInfo 'MSSQL)
|
|
msDBMutationPlan userInfo stringifyNum sourceName sourceConfig mrf = do
|
|
go <$> case mrf of
|
|
MDBInsert annInsert -> executeInsert userInfo stringifyNum sourceConfig annInsert
|
|
MDBDelete annDelete -> executeDelete userInfo stringifyNum sourceConfig annDelete
|
|
MDBFunction {} -> throw400 NotSupported "function mutations are not supported in MSSQL"
|
|
where
|
|
go v = DBStepInfo @'MSSQL sourceName sourceConfig Nothing v
|
|
|
|
-- | Execution of a MSSQL insert mutation broadly involves two steps.
|
|
--
|
|
-- -- insert_table(objects: [
|
|
-- -- {column1: value1, column2: value2},
|
|
-- -- {column1: value3, column2: value4}
|
|
-- -- ]
|
|
-- -- ){
|
|
-- -- affected_rows
|
|
-- -- returning {
|
|
-- -- column1
|
|
-- -- column2
|
|
-- -- }
|
|
-- -- }
|
|
-- --
|
|
-- Step 1: Inserting rows into the table
|
|
-- --
|
|
-- -- a. Generate an SQL Insert statement from the GraphQL insert mutation with OUTPUT expression to return
|
|
-- -- primary key column values after insertion.
|
|
-- -- b. Before insert, Set IDENTITY_INSERT to ON if any insert row contains atleast one identity column.
|
|
-- --
|
|
-- -- SET IDENTITY_INSERT some_table ON;
|
|
-- -- INSERT INTO some_table (column1, column2) OUTPUT INSERTED.pkey_column1, INSERTED.pkey_column2 VALUES (value1, value2), (value3, value4);
|
|
-- --
|
|
-- Step 2: Generation of the mutation response
|
|
-- --
|
|
-- -- An SQL statement is generated and when executed it returns the mutation selection set containing 'affected_rows' and 'returning' field values.
|
|
-- -- The statement is generated with multiple sub select queries explained below:
|
|
-- --
|
|
-- -- a. A SQL Select statement to fetch only inserted rows from the table using primary key column values fetched from
|
|
-- -- Step 1 in the WHERE clause
|
|
-- --
|
|
-- -- <table_select> :=
|
|
-- -- SELECT * FROM some_table WHERE (pkey_column1 = value1 AND pkey_column2 = value2) OR (pkey_column1 = value3 AND pkey_column2 = value4)
|
|
-- --
|
|
-- -- The above select statement is referred through a common table expression - "WITH [with_alias] AS (<table_select>)"
|
|
-- --
|
|
-- -- b. The 'affected_rows' field value is obtained by using COUNT aggregation and the 'returning' field selection set is translated to
|
|
-- -- a SQL select statement using @'mkSQLSelect'.
|
|
-- --
|
|
-- -- <mutation_output_select> :=
|
|
-- -- SELECT (SELECT COUNT(*) FROM [with_alias]) AS [affected_rows], (select_from_returning) AS [returning] FOR JSON PATH, INCLUDE_NULL_VALUES, WITHOUT_ARRAY_WRAPPER
|
|
-- --
|
|
-- -- c. Evaluate the check constraint using CASE expression. We use SUM aggregation to check if any inserted row has failed the check constraint.
|
|
-- --
|
|
-- -- <check_constraint_select> :=
|
|
-- -- SELECT SUM(CASE WHEN <check_boolean_expression> THEN 0 ELSE 1 END) FROM [with_alias]
|
|
-- --
|
|
-- -- d. The final select statement look like
|
|
-- --
|
|
-- -- WITH "with_alias" AS (<table_select>)
|
|
-- -- SELECT (<mutation_output_select>) AS [mutation_response], (<check_constraint_select>) AS [check_constraint_select]
|
|
-- --
|
|
-- -- When executed, the above statement returns a single row with mutation response as a string value and check constraint result as an integer value.
|
|
executeInsert ::
|
|
MonadError QErr m =>
|
|
UserInfo ->
|
|
Bool ->
|
|
SourceConfig 'MSSQL ->
|
|
AnnInsert 'MSSQL (Const Void) (UnpreparedValue 'MSSQL) ->
|
|
m (ExceptT QErr IO EncJSON)
|
|
executeInsert userInfo stringifyNum sourceConfig annInsert = do
|
|
-- Convert the leaf values from @'UnpreparedValue' to sql @'Expression'
|
|
insert <- traverse (prepareValueQuery sessionVariables) annInsert
|
|
let insertTx = buildInsertTx insert
|
|
pure $ withMSSQLPool pool $ Tx.runTxE fromMSSQLTxError insertTx
|
|
where
|
|
sessionVariables = _uiSession userInfo
|
|
pool = _mscConnectionPool sourceConfig
|
|
table = _aiTableName $ _aiData annInsert
|
|
withSelectTableAlias = "t_" <> tableName table
|
|
withAlias = "with_alias"
|
|
|
|
buildInsertTx :: AnnInsert 'MSSQL (Const Void) Expression -> Tx.TxET QErr IO EncJSON
|
|
buildInsertTx insert = do
|
|
let identityColumns = _mssqlIdentityColumns $ _aiExtraInsertData $ _aiData insert
|
|
insertColumns = concatMap (map fst . getInsertColumns) $ _aiInsObj $ _aiData insert
|
|
|
|
-- Set identity insert to ON if insert object contains identity columns
|
|
when (any (`elem` identityColumns) insertColumns) $
|
|
Tx.unitQueryE fromMSSQLTxError $
|
|
toQueryFlat $
|
|
TQ.fromSetIdentityInsert $
|
|
SetIdentityInsert (_aiTableName $ _aiData insert) SetON
|
|
|
|
-- Generate the INSERT query
|
|
let insertQuery = toQueryFlat $ TQ.fromInsert $ TSQL.fromInsert insert
|
|
fromODBCException e =
|
|
(err400 MSSQLError "insert query exception") {qeInternal = Just (ExtraInternal $ odbcExceptionToJSONValue e)}
|
|
|
|
-- Execute the INSERT query and fetch the primary key values
|
|
primaryKeyValues <- Tx.buildGenericTxE fromODBCException $ \conn -> ODBCI.query conn (ODBC.renderQuery insertQuery)
|
|
let withSelect = generateWithSelect primaryKeyValues
|
|
-- WITH [with_alias] AS (select_query)
|
|
withExpression = With $ pure $ Aliased withSelect withAlias
|
|
|
|
mutationOutputSelect <- mkMutationOutputSelect stringifyNum withAlias $ _aiOutput insert
|
|
let (checkCondition, _) = _aiCheckCond $ _aiData insert
|
|
|
|
-- The check constraint is translated to boolean expression
|
|
checkBoolExp <-
|
|
V.runValidate (runFromIr $ runReaderT (fromGBoolExp checkCondition) (EntityAlias withAlias))
|
|
`onLeft` (throw500 . tshow)
|
|
|
|
-- SELECT (<mutation_output_select>) AS [mutation_response], (<check_constraint_select>) AS [check_constraint_select]
|
|
let mutationOutputCheckConstraintSelect = selectMutationOutputAndCheckCondition mutationOutputSelect checkBoolExp
|
|
|
|
-- WITH "with_alias" AS (<table_select>)
|
|
-- SELECT (<mutation_output_select>) AS [mutation_response], (<check_constraint_select>) AS [check_constraint_select]
|
|
finalSelect = mutationOutputCheckConstraintSelect {selectWith = Just withExpression}
|
|
|
|
(responseText, checkConditionInt) <- Tx.singleRowQueryE fromMSSQLTxError (toQueryFlat $ TQ.fromSelect finalSelect)
|
|
unless (checkConditionInt == (0 :: Int)) $
|
|
throw400 PermissionError "check constraint of an insert permission has failed"
|
|
pure $ encJFromText responseText
|
|
|
|
columnFieldExpression :: ODBCI.Column -> Expression
|
|
columnFieldExpression column =
|
|
ColumnExpression $ TSQL.FieldName (ODBCI.columnName column) withSelectTableAlias
|
|
|
|
generateWithSelect :: [[(ODBCI.Column, ODBC.Value)]] -> Select
|
|
generateWithSelect pkeyValues =
|
|
emptySelect
|
|
{ selectProjections = [StarProjection],
|
|
selectFrom = Just $ FromQualifiedTable $ Aliased table withSelectTableAlias,
|
|
selectWhere = whereExpression
|
|
}
|
|
where
|
|
-- WHERE (column1 = value1 AND column2 = value2) OR (column1 = value3 AND column2 = value4)
|
|
whereExpression =
|
|
let mkColumnEqExpression (column, value) =
|
|
OpExpression EQ' (columnFieldExpression column) (ValueExpression value)
|
|
in Where $ pure $ OrExpression $ map (AndExpression . map mkColumnEqExpression) pkeyValues
|
|
|
|
generateCheckConstraintSelect :: Expression -> Select
|
|
generateCheckConstraintSelect checkBoolExp =
|
|
let zeroValue = ValueExpression $ ODBC.IntValue 0
|
|
oneValue = ValueExpression $ ODBC.IntValue 1
|
|
caseExpression = ConditionalExpression checkBoolExp zeroValue oneValue
|
|
sumAggregate = OpAggregate "SUM" [caseExpression]
|
|
in emptySelect
|
|
{ selectProjections = [AggregateProjection (Aliased sumAggregate "check")],
|
|
selectFrom = Just $ TSQL.FromIdentifier withAlias
|
|
}
|
|
|
|
selectMutationOutputAndCheckCondition :: Select -> Expression -> Select
|
|
selectMutationOutputAndCheckCondition mutationOutputSelect checkBoolExp =
|
|
let mutationOutputProjection =
|
|
ExpressionProjection $ Aliased (SelectExpression mutationOutputSelect) "mutation_response"
|
|
checkConstraintProjection =
|
|
ExpressionProjection $ Aliased (SelectExpression (generateCheckConstraintSelect checkBoolExp)) "check_constraint_select"
|
|
in emptySelect {selectProjections = [mutationOutputProjection, checkConstraintProjection]}
|
|
|
|
-- Delete
|
|
|
|
-- | Executes a Delete IR AST and return results as JSON.
|
|
executeDelete ::
|
|
MonadError QErr m =>
|
|
UserInfo ->
|
|
Bool ->
|
|
SourceConfig 'MSSQL ->
|
|
AnnDelG 'MSSQL (Const Void) (UnpreparedValue 'MSSQL) ->
|
|
m (ExceptT QErr IO EncJSON)
|
|
executeDelete userInfo stringifyNum sourceConfig deleteOperation = do
|
|
preparedDelete <- traverse (prepareValueQuery $ _uiSession userInfo) deleteOperation
|
|
let pool = _mscConnectionPool sourceConfig
|
|
pure $ withMSSQLPool pool $ Tx.runTxE fromMSSQLTxError (buildDeleteTx preparedDelete stringifyNum)
|
|
|
|
-- | Converts a Delete IR AST to a transaction of three delete sql statements.
|
|
--
|
|
-- A GraphQL delete mutation does two things:
|
|
--
|
|
-- 1. Deletes rows in a table according to some predicate
|
|
-- 2. (Potentially) returns the deleted rows (including relationships) as JSON
|
|
--
|
|
-- In order to complete these 2 things we need 3 SQL statements:
|
|
--
|
|
-- 1. SELECT INTO <temp_table> WHERE <false> - creates a temporary table
|
|
-- with the same schema as the original table in which we'll store the deleted rows
|
|
-- from the table we are deleting
|
|
-- 2. DELETE FROM with OUTPUT - deletes the rows from the table and inserts the
|
|
-- deleted rows to the temporary table from (1)
|
|
-- 3. SELECT - constructs the @returning@ query from the temporary table, including
|
|
-- relationships with other tables.
|
|
buildDeleteTx ::
|
|
AnnDel 'MSSQL ->
|
|
Bool ->
|
|
Tx.TxET QErr IO EncJSON
|
|
buildDeleteTx deleteOperation stringifyNum = do
|
|
let tempTableName = TSQL.TempTableName "deleted"
|
|
withAlias = "with_alias"
|
|
createTempTableQuery = toQueryFlat $ TQ.fromSelectIntoTempTable $ TSQL.toSelectIntoTempTable tempTableName deleteOperation
|
|
-- Create a temp table
|
|
Tx.unitQueryE fromMSSQLTxError createTempTableQuery
|
|
let deleteQuery = TQ.fromDelete tempTableName <$> TSQL.fromDelete deleteOperation
|
|
deleteQueryValidated <- toQueryFlat <$> V.runValidate (runFromIr deleteQuery) `onLeft` (throw500 . tshow)
|
|
-- Execute DELETE statement
|
|
Tx.unitQueryE fromMSSQLTxError deleteQueryValidated
|
|
mutationOutputSelect <- mkMutationOutputSelect stringifyNum withAlias $ dqp1Output deleteOperation
|
|
let withSelect =
|
|
emptySelect
|
|
{ selectProjections = [StarProjection],
|
|
selectFrom = Just $ FromTempTable $ Aliased tempTableName "deleted_alias"
|
|
}
|
|
finalMutationOutputSelect = mutationOutputSelect {selectWith = Just $ With $ pure $ Aliased withSelect withAlias}
|
|
mutationOutputSelectQuery = toQueryFlat $ TQ.fromSelect finalMutationOutputSelect
|
|
-- Execute SELECT query and fetch mutation response
|
|
encJFromText <$> Tx.singleRowQueryE fromMSSQLTxError mutationOutputSelectQuery
|
|
|
|
-- | Generate a SQL SELECT statement which outputs the mutation response
|
|
--
|
|
-- For multi row inserts:
|
|
-- SELECT (SELECT COUNT(*) FROM [with_alias]) AS [affected_rows], (select_from_returning) AS [returning] FOR JSON PATH, INCLUDE_NULL_VALUES, WITHOUT_ARRAY_WRAPPER
|
|
--
|
|
-- For single row insert: the selection set is translated to SQL query using @'mkSQLSelect'
|
|
mkMutationOutputSelect ::
|
|
(MonadError QErr m) =>
|
|
Bool ->
|
|
Text ->
|
|
MutationOutputG 'MSSQL (Const Void) Expression ->
|
|
m Select
|
|
mkMutationOutputSelect stringifyNum withAlias = \case
|
|
IR.MOutMultirowFields multiRowFields -> do
|
|
projections <- forM multiRowFields $ \(fieldName, field') -> do
|
|
let mkProjection = ExpressionProjection . flip Aliased (getFieldNameTxt fieldName) . SelectExpression
|
|
mkProjection <$> case field' of
|
|
IR.MCount -> pure $ countSelect withAlias
|
|
IR.MExp t -> pure $ textSelect t
|
|
IR.MRet returningFields -> mkSelect stringifyNum withAlias JASMultipleRows returningFields
|
|
let forJson = JsonFor $ ForJson JsonSingleton NoRoot
|
|
pure emptySelect {selectFor = forJson, selectProjections = projections}
|
|
IR.MOutSinglerowObject singleRowField -> mkSelect stringifyNum withAlias JASSingleObject singleRowField
|
|
|
|
mkSelect ::
|
|
MonadError QErr m =>
|
|
Bool ->
|
|
Text ->
|
|
JsonAggSelect ->
|
|
Fields (AnnFieldG 'MSSQL (Const Void) Expression) ->
|
|
m Select
|
|
mkSelect stringifyNum withAlias jsonAggSelect annFields = do
|
|
let annSelect = IR.AnnSelectG annFields (IR.FromIdentifier withAlias) IR.noTablePermissions IR.noSelectArgs stringifyNum
|
|
V.runValidate (runFromIr $ mkSQLSelect jsonAggSelect annSelect) `onLeft` (throw500 . tshow)
|
|
|
|
-- SELECT COUNT(*) AS "count" FROM [with_alias]
|
|
countSelect :: Text -> Select
|
|
countSelect withAlias =
|
|
let countProjection = AggregateProjection $ Aliased (CountAggregate StarCountable) "count"
|
|
in emptySelect
|
|
{ selectProjections = [countProjection],
|
|
selectFrom = Just $ TSQL.FromIdentifier withAlias
|
|
}
|
|
|
|
-- SELECT '<text-value>' AS "exp"
|
|
textSelect :: Text -> Select
|
|
textSelect t =
|
|
let textProjection = ExpressionProjection $ Aliased (ValueExpression (ODBC.TextValue t)) "exp"
|
|
in emptySelect {selectProjections = [textProjection]}
|
|
|
|
-- subscription
|
|
|
|
msDBSubscriptionPlan ::
|
|
forall m.
|
|
( MonadError QErr m,
|
|
MonadIO m,
|
|
MonadBaseControl IO m
|
|
) =>
|
|
UserInfo ->
|
|
SourceName ->
|
|
SourceConfig 'MSSQL ->
|
|
Maybe G.Name ->
|
|
RootFieldMap (QueryDB 'MSSQL (Const Void) (UnpreparedValue 'MSSQL)) ->
|
|
m (LiveQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
|
|
msDBSubscriptionPlan UserInfo {_uiSession, _uiRole} _sourceName sourceConfig namespace rootFields = do
|
|
(reselect, prepareState) <- planSubscription (OMap.mapKeys _rfaAlias rootFields) _uiSession
|
|
cohortVariables <- prepareStateCohortVariables sourceConfig _uiSession prepareState
|
|
let parameterizedPlan = ParameterizedLiveQueryPlan _uiRole $ MultiplexedQuery' reselect
|
|
|
|
pure $
|
|
LiveQueryPlan parameterizedPlan sourceConfig cohortVariables namespace
|
|
|
|
prepareStateCohortVariables :: (MonadError QErr m, MonadIO m, MonadBaseControl IO m) => SourceConfig 'MSSQL -> SessionVariables -> PrepareState -> m CohortVariables
|
|
prepareStateCohortVariables sourceConfig session prepState = do
|
|
(namedVars, posVars) <- validateVariables sourceConfig session prepState
|
|
let PrepareState {sessionVariables} = prepState
|
|
pure $
|
|
mkCohortVariables
|
|
sessionVariables
|
|
session
|
|
namedVars
|
|
posVars
|
|
|
|
-- | Ensure that the set of variables (with value instantiations) that occur in
|
|
-- a (RQL) query produce a well-formed and executable (SQL) query when
|
|
-- considered in isolation.
|
|
--
|
|
-- This helps avoiding cascading failures in multiplexed queries.
|
|
--
|
|
-- c.f. https://github.com/hasura/graphql-engine-mono/issues/1210.
|
|
validateVariables ::
|
|
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
|
|
SourceConfig 'MSSQL ->
|
|
SessionVariables ->
|
|
PrepareState ->
|
|
m (ValidatedQueryVariables, ValidatedSyntheticVariables)
|
|
validateVariables sourceConfig sessionVariableValues prepState = do
|
|
let PrepareState {sessionVariables, namedArguments, positionalArguments} = prepState
|
|
|
|
-- We generate a single 'canary' query in the form:
|
|
--
|
|
-- SELECT ... [session].[x-hasura-foo] as [x-hasura-foo], ... as a, ... as b, ...
|
|
-- FROM OPENJSON('...')
|
|
-- WITH ([x-hasura-foo] NVARCHAR(MAX)) as [session]
|
|
--
|
|
-- where 'a', 'b', etc. are aliases given to positional arguments.
|
|
-- Named arguments and session variables are aliased to themselves.
|
|
--
|
|
-- The idea being that if the canary query succeeds we can be
|
|
-- reasonably confident that adding these variables to a query being
|
|
-- polled will not crash the poller.
|
|
|
|
occSessionVars =
|
|
filterSessionVariables
|
|
(\k _ -> Set.member k sessionVariables)
|
|
sessionVariableValues
|
|
|
|
expSes, expNamed, expPos :: [Aliased Expression]
|
|
expSes = sessionReference <$> getSessionVariables occSessionVars
|
|
expNamed =
|
|
map
|
|
( \(n, v) -> Aliased (ValueExpression (RQLColumn.cvValue v)) (G.unName n)
|
|
)
|
|
$ Map.toList $ namedArguments
|
|
|
|
-- For positional args we need to be a bit careful not to capture names
|
|
-- from expNamed and expSes (however unlikely)
|
|
expPos =
|
|
zipWith
|
|
(\n v -> Aliased (ValueExpression (RQLColumn.cvValue v)) n)
|
|
(freshVars (expNamed <> expSes))
|
|
positionalArguments
|
|
|
|
projAll :: [Projection]
|
|
projAll = map ExpressionProjection (expSes <> expNamed <> expPos)
|
|
|
|
canaryQuery =
|
|
if null projAll
|
|
then Nothing
|
|
else
|
|
Just $
|
|
renderQuery
|
|
emptySelect
|
|
{ selectProjections = projAll,
|
|
selectFrom = sessionOpenJson occSessionVars
|
|
}
|
|
|
|
onJust
|
|
canaryQuery
|
|
( \q -> do
|
|
_ :: [[ODBC.Value]] <- withMSSQLPool (_mscConnectionPool sourceConfig) (`ODBC.query` q)
|
|
pure ()
|
|
)
|
|
|
|
pure
|
|
( ValidatedVariables $ txtEncodedColVal <$> namedArguments,
|
|
ValidatedVariables $ txtEncodedColVal <$> positionalArguments
|
|
)
|
|
where
|
|
renderQuery :: Select -> ODBC.Query
|
|
renderQuery = toQueryFlat . fromSelect
|
|
|
|
freshVars :: [Aliased a] -> [Text]
|
|
freshVars boundNames = filter (not . (`elem` map aliasedAlias boundNames)) chars
|
|
|
|
-- Infinite list of expression aliases.
|
|
chars :: [Text]
|
|
chars = [y T.<>> x | y <- [""] <|> chars, x <- ['a' .. 'z']]
|
|
|
|
sessionOpenJson :: SessionVariables -> Maybe From
|
|
sessionOpenJson occSessionVars =
|
|
nonEmpty (getSessionVariables occSessionVars)
|
|
<&> \fields ->
|
|
FromOpenJson $
|
|
Aliased
|
|
( OpenJson
|
|
(ValueExpression $ ODBC.TextValue $ lbsToTxt $ J.encode occSessionVars)
|
|
(pure (sessField <$> fields))
|
|
)
|
|
"session"
|
|
|
|
sessField :: Text -> JsonFieldSpec
|
|
sessField var = StringField var Nothing
|
|
|
|
sessionReference :: Text -> Aliased Expression
|
|
sessionReference var = Aliased (ColumnExpression (TSQL.FieldName var "session")) var
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Remote Relationships (e.g. DB-to-DB Joins, remote schema joins, etc.)
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Construct an action (i.e. 'DBStepInfo') which can marshal some remote
|
|
-- relationship information into a form that SQL Server can query against.
|
|
--
|
|
-- XXX: Currently unimplemented; the Postgres implementation uses
|
|
-- @jsonb_to_recordset@ to query the remote relationship, however this
|
|
-- functionality doesn't exist in SQL Server.
|
|
--
|
|
-- NOTE: The following typeclass constraints will be necessary when implementing
|
|
-- this function for real:
|
|
--
|
|
-- @
|
|
-- MonadQueryTags m
|
|
-- Backend 'MSSQL
|
|
-- @
|
|
msDBRemoteRelationshipPlan ::
|
|
forall m.
|
|
( MonadError QErr m
|
|
) =>
|
|
UserInfo ->
|
|
SourceName ->
|
|
SourceConfig 'MSSQL ->
|
|
-- | List of json objects, each of which becomes a row of the table.
|
|
NonEmpty J.Object ->
|
|
-- | The above objects have this schema
|
|
--
|
|
-- XXX: What is this for/what does this mean?
|
|
HashMap RQLTypes.FieldName (RQLTypes.Column 'MSSQL, RQLTypes.ScalarType 'MSSQL) ->
|
|
-- | This is a field name from the lhs that *has* to be selected in the
|
|
-- response along with the relationship.
|
|
RQLTypes.FieldName ->
|
|
(RQLTypes.FieldName, SourceRelationshipSelection 'MSSQL (Const Void) UnpreparedValue) ->
|
|
m (DBStepInfo 'MSSQL)
|
|
msDBRemoteRelationshipPlan _userInfo _sourceName _sourceConfig _lhs _lhsSchema _argumentId _relationship = do
|
|
throw500 "mkDBRemoteRelationshipPlan: SQL Server (MSSQL) does not currently support generalized joins."
|