mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
8a77386fcf
### Description This PR adds the required IR for DB to DB joins, based on @paf31 and @0x777 's `feature/db-to-db` branch. To do so, it also refactors the IR to introduce a new type parameter, `r`, which is used to recursively constructs the `v` parameter of remote QueryDBs. When collecting remote joins, we replace `r` with `Const Void`, indicating at the type level that there cannot be any leftover remote join. Furthermore, this PR refactors IR.Select for readability, moves some code from IR.Root to IR.Select to avoid having to deal with circular dependencies, and makes it compile by adding `error` in all new cases in the execution pipeline. The diff doesn't make it clear, but most of Select.hs is actually unchanged. Declarations have just been reordered by topic, in the following order: - type declarations - instance declarations - type aliases - constructor functions - traverse functions https://github.com/hasura/graphql-engine-mono/pull/1580 Co-authored-by: Phil Freeman <630306+paf31@users.noreply.github.com> GitOrigin-RevId: bbdcb4119cec8bb3fc32f1294f91b8dea0728721
338 lines
12 KiB
Haskell
338 lines
12 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Hasura.Backends.MSSQL.Instances.Execute
|
|
(
|
|
MultiplexedQuery'(..),
|
|
multiplexRootReselect,
|
|
)
|
|
where
|
|
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.Aeson.Extended as J
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Data.HashSet as Set
|
|
import qualified Data.List.NonEmpty as NE
|
|
import qualified Data.Text.Extended as T
|
|
import qualified Database.ODBC.SQLServer as ODBC
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
|
|
import qualified Hasura.RQL.Types.Column as RQL
|
|
import qualified Hasura.SQL.AnyBackend as AB
|
|
|
|
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
|
|
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.Parser
|
|
import Hasura.RQL.IR
|
|
import Hasura.RQL.Types
|
|
import Hasura.Session
|
|
|
|
|
|
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
|
|
|
|
|
|
-- 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
|
|
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
|
|
=> G.Name
|
|
-> 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 -> 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, 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 (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 =
|
|
Select
|
|
{ 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 =
|
|
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 =
|
|
throw500 "mutations are not supported in MSSQL; this should be unreachable"
|
|
|
|
|
|
-- subscription
|
|
|
|
msDBSubscriptionPlan
|
|
:: forall m.
|
|
( MonadError QErr m
|
|
, MonadIO m
|
|
)
|
|
=> UserInfo
|
|
-> SourceName
|
|
-> SourceConfig 'MSSQL
|
|
-> InsOrdHashMap G.Name (QueryDB 'MSSQL (Const Void) (UnpreparedValue 'MSSQL))
|
|
-> m (LiveQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
|
|
msDBSubscriptionPlan UserInfo {_uiSession, _uiRole} _sourceName sourceConfig rootFields = do
|
|
(reselect, prepareState) <- planSubscription rootFields _uiSession
|
|
|
|
cohortVariables <- prepareStateCohortVariables sourceConfig _uiSession prepareState
|
|
let parameterizedPlan = ParameterizedLiveQueryPlan _uiRole $ MultiplexedQuery' reselect
|
|
|
|
pure
|
|
$ LiveQueryPlan parameterizedPlan sourceConfig cohortVariables
|
|
|
|
prepareStateCohortVariables :: (MonadError QErr m, MonadIO 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) =>
|
|
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 (RQL.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 (RQL.cvValue v)) n)
|
|
(freshVars (expNamed <> expSes)) positionalArguments
|
|
|
|
projAll :: [Projection]
|
|
projAll = map ExpressionProjection (expSes <> expNamed <> expPos)
|
|
|
|
canaryQuery = if null projAll
|
|
then Nothing
|
|
else Just $ renderQuery select {
|
|
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)
|
|
(sessField <$> fields)
|
|
)
|
|
"session"
|
|
|
|
sessField :: Text -> JsonFieldSpec
|
|
sessField var = StringField var Nothing
|
|
|
|
sessionReference :: Text -> Aliased Expression
|
|
sessionReference var = Aliased (ColumnExpression (TSQL.FieldName var "session")) var
|
|
|