{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | MSSQL Instances Execute
--
-- Defines a 'BackendExecute' type class instance for MSSQL.
--
-- This module implements the needed functionality for implementing a 'BackendExecute'
-- instance for MSSQL, which defines an interface for translating a root field into an execution plan
-- and interacting with a database.
--
-- This module includes the MSSQL implementation of queries, mutations, and more.
module Hasura.Backends.MSSQL.Instances.Execute
  ( MultiplexedQuery' (..),
    multiplexRootReselect,
  )
where

import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson.Extended qualified as J
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
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.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.Connection
import Hasura.Backends.MSSQL.Execute.Delete
import Hasura.Backends.MSSQL.Execute.Insert
import Hasura.Backends.MSSQL.Execute.QueryTags
import Hasura.Backends.MSSQL.Execute.Update
import Hasura.Backends.MSSQL.FromIr.Constants (jsonFieldName)
import Hasura.Backends.MSSQL.Plan
import Hasura.Backends.MSSQL.SQL.Error
import Hasura.Backends.MSSQL.SQL.Value (txtEncodedColVal)
import Hasura.Backends.MSSQL.ToQuery as TQ
import Hasura.Backends.MSSQL.Types.Internal as TSQL
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Execute.Backend
import Hasura.GraphQL.Execute.Subscription.Plan
import Hasura.GraphQL.Namespace (RootFieldAlias (..), RootFieldMap)
import Hasura.GraphQL.Parser.Variable qualified as G
import Hasura.Logging qualified as L
import Hasura.Prelude
import Hasura.QueryTags (QueryTagsComment)
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend as RQLTypes
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column qualified as RQLColumn
import Hasura.RQL.Types.Common as RQLTypes
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Client as HTTP
import Network.HTTP.Types qualified as HTTP

instance BackendExecute 'MSSQL where
  type PreparedQuery 'MSSQL = Text
  type MultiplexedQuery 'MSSQL = MultiplexedQuery'
  type ExecutionMonad 'MSSQL = ExceptT QErr

  mkDBQueryPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadQueryTags m,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> m (DBStepInfo 'MSSQL)
mkDBQueryPlan = UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> m (DBStepInfo 'MSSQL)
forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> m (DBStepInfo 'MSSQL)
msDBQueryPlan
  mkDBMutationPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadQueryTags m,
 MonadReader QueryTagsComment m, MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig 'MSSQL
-> MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> Maybe (HashMap Name (Value Variable))
-> m (DBStepInfo 'MSSQL)
mkDBMutationPlan = Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig 'MSSQL
-> MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> Maybe (HashMap Name (Value Variable))
-> m (DBStepInfo 'MSSQL)
forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig 'MSSQL
-> MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> Maybe (HashMap Name (Value Variable))
-> m (DBStepInfo 'MSSQL)
msDBMutationPlan
  mkLiveQuerySubscriptionPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> Maybe Name
-> RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
mkLiveQuerySubscriptionPlan = UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> Maybe Name
-> RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> Maybe Name
-> RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
msDBLiveQuerySubscriptionPlan
  mkDBStreamingSubscriptionPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> (RootFieldAlias, QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
mkDBStreamingSubscriptionPlan UserInfo
_ SourceName
_ SourceConfig 'MSSQL
_ (RootFieldAlias, QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
_ [Header]
_ Maybe Name
_ = Text -> m (SubscriptionQueryPlan 'MSSQL MultiplexedQuery')
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"Streaming subscriptions are not supported for MS-SQL sources yet"
  mkDBQueryExplain :: forall (m :: * -> *).
MonadError QErr m =>
RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> m (AnyBackend DBStepInfo)
mkDBQueryExplain = RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> m (AnyBackend DBStepInfo)
forall (m :: * -> *).
MonadError QErr m =>
RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> m (AnyBackend DBStepInfo)
msDBQueryExplain
  mkSubscriptionExplain :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL)
-> m SubscriptionQueryPlanExplanation
mkSubscriptionExplain = SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL)
-> m SubscriptionQueryPlanExplanation
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m) =>
SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL)
-> m SubscriptionQueryPlanExplanation
msDBSubscriptionExplain

  mkDBRemoteRelationshipPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadQueryTags m) =>
UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> NonEmpty Object
-> HashMap FieldName (Column 'MSSQL, ScalarType 'MSSQL)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo 'MSSQL)
mkDBRemoteRelationshipPlan =
    UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> NonEmpty Object
-> HashMap FieldName (Column 'MSSQL, ScalarType 'MSSQL)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo 'MSSQL)
forall (m :: * -> *).
MonadError QErr m =>
UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> NonEmpty Object
-> HashMap FieldName (Column 'MSSQL, ScalarType 'MSSQL)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo 'MSSQL)
msDBRemoteRelationshipPlan

-- * Multiplexed query

data MultiplexedQuery' = MultiplexedQuery'
  { MultiplexedQuery' -> Reselect
reselect :: Reselect,
    MultiplexedQuery' -> QueryTagsComment
subscriptionQueryTagsComment :: QueryTagsComment
  }

instance T.ToTxt MultiplexedQuery' where
  toTxt :: MultiplexedQuery' -> Text
toTxt (MultiplexedQuery' Reselect
reselect QueryTagsComment
queryTags) =
    Query -> Text
forall a. ToTxt a => a -> Text
T.toTxt (Query -> Text) -> Query -> Text
forall a b. (a -> b) -> a -> b
$ Printer -> Query
toQueryPretty (Reselect -> Printer
fromReselect Reselect
reselect) Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags

-- * Query

msDBQueryPlan ::
  forall m.
  ( MonadError QErr m,
    MonadReader QueryTagsComment m
  ) =>
  UserInfo ->
  SourceName ->
  SourceConfig 'MSSQL ->
  QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  m (DBStepInfo 'MSSQL)
msDBQueryPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> m (DBStepInfo 'MSSQL)
msDBQueryPlan UserInfo
userInfo SourceName
sourceName SourceConfig 'MSSQL
sourceConfig QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
qrf [Header]
_ Maybe Name
_ = do
  let sessionVariables :: SessionVariables
sessionVariables = UserInfo -> SessionVariables
_uiSession UserInfo
userInfo
  QueryWithDDL {[TempTableDDL]
qwdBeforeSteps :: [TempTableDDL]
$sel:qwdBeforeSteps:QueryWithDDL :: forall a. QueryWithDDL a -> [TempTableDDL]
qwdBeforeSteps, [TempTableDDL]
qwdAfterSteps :: [TempTableDDL]
$sel:qwdAfterSteps:QueryWithDDL :: forall a. QueryWithDDL a -> [TempTableDDL]
qwdAfterSteps, $sel:qwdQuery:QueryWithDDL :: forall a. QueryWithDDL a -> a
qwdQuery = Select
statement} <- SessionVariables
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (QueryWithDDL Select)
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (QueryWithDDL Select)
planQuery SessionVariables
sessionVariables QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
qrf
  QueryTagsComment
queryTags <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask

  -- Append Query tags comment to the select statement
  let printer :: Printer
printer = Select -> Printer
fromSelect Select
statement Printer -> QueryTagsComment -> Printer
`withQueryTagsPrinter` QueryTagsComment
queryTags
      queryString :: Text
queryString = Query -> Text
ODBC.renderQuery (Printer -> Query
toQueryPretty Printer
printer)

  DBStepInfo 'MSSQL -> m (DBStepInfo 'MSSQL)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DBStepInfo 'MSSQL -> m (DBStepInfo 'MSSQL))
-> DBStepInfo 'MSSQL -> m (DBStepInfo 'MSSQL)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> OnBaseMonad (ExecutionMonad b) (ActionResult b)
-> ResolvedConnectionTemplate b
-> DBStepInfo b
DBStepInfo @'MSSQL SourceName
sourceName SourceConfig 'MSSQL
sourceConfig (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
queryString) (Printer
-> [TempTableDDL]
-> [TempTableDDL]
-> OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
runSelectQuery Printer
printer [TempTableDDL]
qwdBeforeSteps [TempTableDDL]
qwdAfterSteps) ()
  where
    runSelectQuery :: Printer
-> [TempTableDDL]
-> [TempTableDDL]
-> OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
runSelectQuery Printer
queryPrinter [TempTableDDL]
beforeSteps [TempTableDDL]
afterSteps = (forall (m :: * -> *).
 (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 ExceptT QErr m (ActionResult 'MSSQL))
-> OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
forall (t :: (* -> *) -> * -> *) a.
(forall (m :: * -> *).
 (Functor (t m), MonadIO m, MonadBaseControl IO m, MonadTrace m,
  MonadError QErr m) =>
 t m a)
-> OnBaseMonad t a
OnBaseMonad do
      let queryTx :: TxET QErr m EncJSON
queryTx = do
            let executeStep :: TempTableDDL -> TxET QErr m ()
executeStep = (MSSQLTxError -> QErr) -> Query -> TxET QErr m ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Query -> TxET QErr m ())
-> (TempTableDDL -> Query) -> TempTableDDL -> TxET QErr m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer -> Query
toQueryFlat (Printer -> Query)
-> (TempTableDDL -> Printer) -> TempTableDDL -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TempTableDDL -> Printer
TQ.fromTempTableDDL
            (TempTableDDL -> TxET QErr m ())
-> [TempTableDDL] -> TxET QErr m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ TempTableDDL -> TxET QErr m ()
executeStep [TempTableDDL]
beforeSteps
            EncJSON
result <- Text -> EncJSON
encJFromText (Text -> EncJSON) -> TxET QErr m Text -> TxET QErr m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MSSQLTxError -> QErr) -> Query -> TxET QErr m Text
forall (m :: * -> *) a e.
(MonadIO m, FromRow a) =>
(MSSQLTxError -> e) -> Query -> TxET e m a
Tx.singleRowQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Printer -> Query
toQueryFlat Printer
queryPrinter)
            (TempTableDDL -> TxET QErr m ())
-> [TempTableDDL] -> TxET QErr m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ TempTableDDL -> TxET QErr m ()
executeStep [TempTableDDL]
afterSteps
            EncJSON -> TxET QErr m EncJSON
forall a. a -> TxET QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
result
      MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadOnly (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig) ((EncJSON -> ActionResult 'MSSQL)
-> TxET QErr m EncJSON -> TxET QErr m (ActionResult 'MSSQL)
forall a b. (a -> b) -> TxET QErr m a -> TxET QErr m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EncJSON -> ActionResult 'MSSQL
forall (b :: BackendType). EncJSON -> ActionResult b
withNoStatistics TxET QErr m EncJSON
queryTx)

runShowplan ::
  (MonadIO m) =>
  ODBC.Query ->
  Tx.TxET QErr m [Text]
runShowplan :: forall (m :: * -> *). MonadIO m => Query -> TxET QErr m [Text]
runShowplan Query
query = (MSSQLTxError -> QErr)
-> TxET MSSQLTxError m [Text] -> TxET QErr m [Text]
forall (m :: * -> *) e1 e2 a.
Monad m =>
(e1 -> e2) -> TxET e1 m a -> TxET e2 m a
Tx.withTxET MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler do
  Query -> TxT m ()
forall (m :: * -> *). MonadIO m => Query -> TxT m ()
Tx.unitQuery Query
"SET SHOWPLAN_TEXT ON"
  [Text]
texts <- Query -> TxET MSSQLTxError m [Text]
forall a (m :: * -> *).
(MonadIO m, FromRow a) =>
Query -> TxT m [a]
Tx.multiRowQuery Query
query
  Query -> TxT m ()
forall (m :: * -> *). MonadIO m => Query -> TxT m ()
Tx.unitQuery Query
"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'.
  [Text] -> TxET MSSQLTxError m [Text]
forall a. a -> TxET MSSQLTxError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
texts

msDBQueryExplain ::
  (MonadError QErr m) =>
  RootFieldAlias ->
  UserInfo ->
  SourceName ->
  SourceConfig 'MSSQL ->
  QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  m (AB.AnyBackend DBStepInfo)
msDBQueryExplain :: forall (m :: * -> *).
MonadError QErr m =>
RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> m (AnyBackend DBStepInfo)
msDBQueryExplain RootFieldAlias
fieldName UserInfo
userInfo SourceName
sourceName SourceConfig 'MSSQL
sourceConfig QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
qrf [Header]
_ Maybe Name
_ = do
  let sessionVariables :: SessionVariables
sessionVariables = UserInfo -> SessionVariables
_uiSession UserInfo
userInfo
  Select
statement <- QueryWithDDL Select -> Select
forall a. QueryWithDDL a -> a
qwdQuery (QueryWithDDL Select -> Select)
-> m (QueryWithDDL Select) -> m Select
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionVariables
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (QueryWithDDL Select)
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (QueryWithDDL Select)
planQuery SessionVariables
sessionVariables QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
qrf
  let query :: Query
query = Printer -> Query
toQueryPretty (Select -> Printer
fromSelect Select
statement)
      queryString :: Text
queryString = Query -> Text
ODBC.renderQuery Query
query
      odbcQuery :: OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
odbcQuery = (forall (m :: * -> *).
 (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 ExceptT QErr m (ActionResult 'MSSQL))
-> OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
forall (t :: (* -> *) -> * -> *) a.
(forall (m :: * -> *).
 (Functor (t m), MonadIO m, MonadBaseControl IO m, MonadTrace m,
  MonadError QErr m) =>
 t m a)
-> OnBaseMonad t a
OnBaseMonad
        ((forall (m :: * -> *).
  (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
   MonadTrace m, MonadError QErr m) =>
  ExceptT QErr m (ActionResult 'MSSQL))
 -> OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL))
-> (forall (m :: * -> *).
    (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
     MonadTrace m, MonadError QErr m) =>
    ExceptT QErr m (ActionResult 'MSSQL))
-> OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
forall a b. (a -> b) -> a -> b
$ MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadOnly
          (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig)
          do
            [Text]
showplan <- Query -> TxET QErr m [Text]
forall (m :: * -> *). MonadIO m => Query -> TxET QErr m [Text]
runShowplan Query
query
            ActionResult 'MSSQL -> TxET QErr m (ActionResult 'MSSQL)
forall a. a -> TxET QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (ActionResult 'MSSQL -> TxET QErr m (ActionResult 'MSSQL))
-> ActionResult 'MSSQL -> TxET QErr m (ActionResult 'MSSQL)
forall a b. (a -> b) -> a -> b
$ EncJSON -> ActionResult 'MSSQL
forall (b :: BackendType). EncJSON -> ActionResult b
withNoStatistics
              (EncJSON -> ActionResult 'MSSQL) -> EncJSON -> ActionResult 'MSSQL
forall a b. (a -> b) -> a -> b
$ ExplainPlan -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue
              (ExplainPlan -> EncJSON) -> ExplainPlan -> EncJSON
forall a b. (a -> b) -> a -> b
$ RootFieldAlias -> Maybe Text -> Maybe [Text] -> ExplainPlan
ExplainPlan
                RootFieldAlias
fieldName
                (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
queryString)
                ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
showplan)
  AnyBackend DBStepInfo -> m (AnyBackend DBStepInfo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (AnyBackend DBStepInfo -> m (AnyBackend DBStepInfo))
-> AnyBackend DBStepInfo -> m (AnyBackend DBStepInfo)
forall a b. (a -> b) -> a -> b
$ DBStepInfo 'MSSQL -> AnyBackend DBStepInfo
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
    (DBStepInfo 'MSSQL -> AnyBackend DBStepInfo)
-> DBStepInfo 'MSSQL -> AnyBackend DBStepInfo
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> OnBaseMonad (ExecutionMonad b) (ActionResult b)
-> ResolvedConnectionTemplate b
-> DBStepInfo b
DBStepInfo @'MSSQL SourceName
sourceName SourceConfig 'MSSQL
sourceConfig Maybe Text
Maybe (PreparedQuery 'MSSQL)
forall a. Maybe a
Nothing OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
OnBaseMonad (ExecutionMonad 'MSSQL) (ActionResult 'MSSQL)
odbcQuery ()

msDBSubscriptionExplain ::
  (MonadIO m, MonadBaseControl IO m, MonadError QErr m) =>
  SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL) ->
  m SubscriptionQueryPlanExplanation
msDBSubscriptionExplain :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m) =>
SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL)
-> m SubscriptionQueryPlanExplanation
msDBSubscriptionExplain (SubscriptionQueryPlan ParameterizedSubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL)
plan SourceConfig 'MSSQL
sourceConfig CohortId
cohortId ResolvedConnectionTemplate 'MSSQL
_dynamicConnection CohortVariables
variables Maybe Name
_) = do
  let (MultiplexedQuery' Reselect
reselect QueryTagsComment
_queryTags) = ParameterizedSubscriptionQueryPlan 'MSSQL MultiplexedQuery'
-> MultiplexedQuery'
forall (b :: BackendType) q.
ParameterizedSubscriptionQueryPlan b q -> q
_plqpQuery ParameterizedSubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL)
ParameterizedSubscriptionQueryPlan 'MSSQL MultiplexedQuery'
plan
      query :: Query
query = Printer -> Query
toQueryPretty (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$ Select -> Printer
fromSelect (Select -> Printer) -> Select -> Printer
forall a b. (a -> b) -> a -> b
$ [(CohortId, CohortVariables)] -> Reselect -> Select
multiplexRootReselect [(CohortId
cohortId, CohortVariables
variables)] Reselect
reselect
      mssqlExecCtx :: MSSQLExecCtx
mssqlExecCtx = (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig)
  [Text]
explainInfo <- m (Either QErr [Text]) -> m [Text]
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr [Text]) -> m [Text])
-> m (Either QErr [Text]) -> m [Text]
forall a b. (a -> b) -> a -> b
$ ExceptT QErr m [Text] -> m (Either QErr [Text])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m [Text] -> m (Either QErr [Text]))
-> ExceptT QErr m [Text] -> m (Either QErr [Text])
forall a b. (a -> b) -> a -> b
$ (MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadOnly MSSQLExecCtx
mssqlExecCtx) (Query -> TxET QErr m [Text]
forall (m :: * -> *). MonadIO m => Query -> TxET QErr m [Text]
runShowplan Query
query)
  SubscriptionQueryPlanExplanation
-> m SubscriptionQueryPlanExplanation
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubscriptionQueryPlanExplanation
 -> m SubscriptionQueryPlanExplanation)
-> SubscriptionQueryPlanExplanation
-> m SubscriptionQueryPlanExplanation
forall a b. (a -> b) -> a -> b
$ Text
-> [Text] -> CohortVariables -> SubscriptionQueryPlanExplanation
SubscriptionQueryPlanExplanation (Query -> Text
forall a. ToTxt a => a -> Text
T.toTxt Query
query) [Text]
explainInfo CohortVariables
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) <- [..] ]
--
-- Caution: Be aware that this query has a @FOR JSON@ clause at the top-level
-- and hence its results may be split up across multiple rows. Use
-- 'Database.MSSQL.Transaction.forJsonQueryE' to handle this.
multiplexRootReselect ::
  [(CohortId, CohortVariables)] ->
  TSQL.Reselect ->
  TSQL.Select
multiplexRootReselect :: [(CohortId, CohortVariables)] -> Reselect -> Select
multiplexRootReselect [(CohortId, CohortVariables)]
variables Reselect
rootReselect =
  Select
emptySelect
    { $sel:selectTop:Select :: Top
selectTop = Top
NoTop,
      $sel:selectProjections:Select :: [Projection]
selectProjections =
        [ Aliased FieldName -> Projection
FieldNameProjection
            Aliased
              { $sel:aliasedThing:Aliased :: FieldName
aliasedThing =
                  TSQL.FieldName
                    { $sel:fieldNameEntity:FieldName :: Text
fieldNameEntity = Text
rowAlias,
                      $sel:fieldName:FieldName :: Text
fieldName = Text
resultIdAlias
                    },
                $sel:aliasedAlias:Aliased :: Text
aliasedAlias = Text
resultIdAlias
              },
          Aliased Expression -> Projection
ExpressionProjection
            Aliased
              { $sel:aliasedThing:Aliased :: Expression
aliasedThing =
                  FieldName -> Expression
ColumnExpression
                    ( TSQL.FieldName
                        { $sel:fieldNameEntity:FieldName :: Text
fieldNameEntity = Text
resultAlias,
                          $sel:fieldName:FieldName :: Text
fieldName = Text
jsonFieldName
                        }
                    ),
                $sel:aliasedAlias:Aliased :: Text
aliasedAlias = Text
resultAlias
              }
        ],
      $sel:selectFrom:Select :: Maybe From
selectFrom =
        From -> Maybe From
forall a. a -> Maybe a
Just
          (From -> Maybe From) -> From -> Maybe From
forall a b. (a -> b) -> a -> b
$ Aliased OpenJson -> From
FromOpenJson
            Aliased
              { $sel:aliasedThing:Aliased :: OpenJson
aliasedThing =
                  OpenJson
                    { $sel:openJsonExpression:OpenJson :: Expression
openJsonExpression =
                        Value -> Expression
ValueExpression (Text -> Value
ODBC.TextValue (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
lbsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ [(CohortId, CohortVariables)] -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode [(CohortId, CohortVariables)]
variables),
                      $sel:openJsonWith:OpenJson :: Maybe (NonEmpty JsonFieldSpec)
openJsonWith =
                        NonEmpty JsonFieldSpec -> Maybe (NonEmpty JsonFieldSpec)
forall a. a -> Maybe a
Just
                          (NonEmpty JsonFieldSpec -> Maybe (NonEmpty JsonFieldSpec))
-> NonEmpty JsonFieldSpec -> Maybe (NonEmpty JsonFieldSpec)
forall a b. (a -> b) -> a -> b
$ [JsonFieldSpec] -> NonEmpty JsonFieldSpec
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList
                            [ ScalarType -> DataLength -> Text -> Maybe JsonPath -> JsonFieldSpec
ScalarField ScalarType
GuidType DataLength
DataLengthUnspecified Text
resultIdAlias (JsonPath -> Maybe JsonPath
forall a. a -> Maybe a
Just (JsonPath -> Maybe JsonPath) -> JsonPath -> Maybe JsonPath
forall a b. (a -> b) -> a -> b
$ JsonPath -> Integer -> JsonPath
IndexPath JsonPath
RootPath Integer
0),
                              Text -> Maybe JsonPath -> JsonFieldSpec
JsonField Text
resultVarsAlias (JsonPath -> Maybe JsonPath
forall a. a -> Maybe a
Just (JsonPath -> Maybe JsonPath) -> JsonPath -> Maybe JsonPath
forall a b. (a -> b) -> a -> b
$ JsonPath -> Integer -> JsonPath
IndexPath JsonPath
RootPath Integer
1)
                            ]
                    },
                $sel:aliasedAlias:Aliased :: Text
aliasedAlias = Text
rowAlias
              },
      $sel:selectJoins:Select :: [Join]
selectJoins =
        [ Join
            { $sel:joinSource:Join :: JoinSource
joinSource = Reselect -> JoinSource
JoinReselect Reselect
rootReselect,
              $sel:joinWhere:Join :: Where
joinWhere = Where
forall a. Monoid a => a
mempty,
              $sel:joinJoinAlias:Join :: JoinAlias
joinJoinAlias =
                JoinAlias
                  { $sel:joinAliasEntity:JoinAlias :: Text
joinAliasEntity = Text
resultAlias,
                    $sel:joinAliasField:JoinAlias :: Maybe Text
joinAliasField = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
jsonFieldName
                  }
            }
        ],
      $sel:selectWhere:Select :: Where
selectWhere = [Expression] -> Where
Where [Expression]
forall a. Monoid a => a
mempty,
      $sel:selectFor:Select :: For
selectFor =
        ForJson -> For
JsonFor ForJson {$sel:jsonCardinality:ForJson :: JsonCardinality
jsonCardinality = JsonCardinality
JsonArray, $sel:jsonRoot:ForJson :: Root
jsonRoot = Root
NoRoot},
      $sel:selectOrderBy:Select :: Maybe (NonEmpty OrderBy)
selectOrderBy = Maybe (NonEmpty OrderBy)
forall a. Maybe a
Nothing,
      $sel:selectOffset:Select :: Maybe Expression
selectOffset = Maybe Expression
forall a. Maybe a
Nothing
    }

-- * Mutation

msDBMutationPlan ::
  forall m.
  ( MonadError QErr m,
    MonadReader QueryTagsComment m
  ) =>
  Env.Environment ->
  HTTP.Manager ->
  L.Logger L.Hasura ->
  UserInfo ->
  Options.StringifyNumbers ->
  SourceName ->
  SourceConfig 'MSSQL ->
  MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  Maybe (HashMap G.Name (G.Value G.Variable)) ->
  m (DBStepInfo 'MSSQL)
msDBMutationPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig 'MSSQL
-> MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> [Header]
-> Maybe Name
-> Maybe (HashMap Name (Value Variable))
-> m (DBStepInfo 'MSSQL)
msDBMutationPlan Environment
_env Manager
_manager Logger Hasura
_logger UserInfo
userInfo StringifyNumbers
stringifyNum SourceName
sourceName SourceConfig 'MSSQL
sourceConfig MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
mrf [Header]
_headers Maybe Name
_gName Maybe (HashMap Name (Value Variable))
_maybeSelSetArgs = do
  OnBaseMonad (ExceptT QErr) EncJSON -> DBStepInfo 'MSSQL
go (OnBaseMonad (ExceptT QErr) EncJSON -> DBStepInfo 'MSSQL)
-> m (OnBaseMonad (ExceptT QErr) EncJSON) -> m (DBStepInfo 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
mrf of
    MDBInsert AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
annInsert -> UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
executeInsert UserInfo
userInfo StringifyNumbers
stringifyNum SourceConfig 'MSSQL
sourceConfig AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
annInsert
    MDBDelete AnnDelG 'MSSQL Void (UnpreparedValue 'MSSQL)
annDelete -> UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnDelG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnDelG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
executeDelete UserInfo
userInfo StringifyNumbers
stringifyNum SourceConfig 'MSSQL
sourceConfig AnnDelG 'MSSQL Void (UnpreparedValue 'MSSQL)
annDelete
    MDBUpdate AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
annUpdate -> UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
executeUpdate UserInfo
userInfo StringifyNumbers
stringifyNum SourceConfig 'MSSQL
sourceConfig AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
annUpdate
    MDBFunction {} -> Code -> Text -> m (OnBaseMonad (ExceptT QErr) EncJSON)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"function mutations are not supported in MSSQL"
  where
    go :: OnBaseMonad (ExceptT QErr) EncJSON -> DBStepInfo 'MSSQL
go OnBaseMonad (ExceptT QErr) EncJSON
v = forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> OnBaseMonad (ExecutionMonad b) (ActionResult b)
-> ResolvedConnectionTemplate b
-> DBStepInfo b
DBStepInfo @'MSSQL SourceName
sourceName SourceConfig 'MSSQL
sourceConfig Maybe Text
Maybe (PreparedQuery 'MSSQL)
forall a. Maybe a
Nothing ((EncJSON -> ActionResult 'MSSQL)
-> OnBaseMonad (ExceptT QErr) EncJSON
-> OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
forall a b.
(a -> b)
-> OnBaseMonad (ExceptT QErr) a -> OnBaseMonad (ExceptT QErr) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EncJSON -> ActionResult 'MSSQL
forall (b :: BackendType). EncJSON -> ActionResult b
withNoStatistics OnBaseMonad (ExceptT QErr) EncJSON
v) ()

-- * Subscription

msDBLiveQuerySubscriptionPlan ::
  forall m.
  ( MonadError QErr m,
    MonadIO m,
    MonadBaseControl IO m,
    MonadReader QueryTagsComment m
  ) =>
  UserInfo ->
  SourceName ->
  SourceConfig 'MSSQL ->
  Maybe G.Name ->
  RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
msDBLiveQuerySubscriptionPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> Maybe Name
-> RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
msDBLiveQuerySubscriptionPlan UserInfo {SessionVariables
_uiSession :: UserInfo -> SessionVariables
_uiSession :: SessionVariables
_uiSession, RoleName
_uiRole :: RoleName
_uiRole :: UserInfo -> RoleName
_uiRole} SourceName
_sourceName SourceConfig 'MSSQL
sourceConfig Maybe Name
namespace RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
rootFields [Header]
_ Maybe Name
_ = do
  (Reselect
reselect, PrepareState
prepareState) <- InsOrdHashMap Name (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> SessionVariables -> m (Reselect, PrepareState)
forall (m :: * -> *).
MonadError QErr m =>
InsOrdHashMap Name (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> SessionVariables -> m (Reselect, PrepareState)
planSubscription ((RootFieldAlias -> Name)
-> RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> InsOrdHashMap
     Name (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
forall k' k v.
(Eq k', Hashable k') =>
(k -> k') -> InsOrdHashMap k v -> InsOrdHashMap k' v
InsOrdHashMap.mapKeys RootFieldAlias -> Name
_rfaAlias RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
rootFields) SessionVariables
_uiSession
  CohortVariables
cohortVariables <- SourceConfig 'MSSQL
-> SessionVariables -> PrepareState -> m CohortVariables
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
SourceConfig 'MSSQL
-> SessionVariables -> PrepareState -> m CohortVariables
prepareStateCohortVariables SourceConfig 'MSSQL
sourceConfig SessionVariables
_uiSession PrepareState
prepareState
  QueryTagsComment
queryTags <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  let parameterizedPlan :: ParameterizedSubscriptionQueryPlan 'MSSQL MultiplexedQuery'
parameterizedPlan = RoleName
-> MultiplexedQuery'
-> ParameterizedSubscriptionQueryPlan 'MSSQL MultiplexedQuery'
forall (b :: BackendType) q.
RoleName -> q -> ParameterizedSubscriptionQueryPlan b q
ParameterizedSubscriptionQueryPlan RoleName
_uiRole (MultiplexedQuery'
 -> ParameterizedSubscriptionQueryPlan 'MSSQL MultiplexedQuery')
-> MultiplexedQuery'
-> ParameterizedSubscriptionQueryPlan 'MSSQL MultiplexedQuery'
forall a b. (a -> b) -> a -> b
$ (Reselect -> QueryTagsComment -> MultiplexedQuery'
MultiplexedQuery' Reselect
reselect QueryTagsComment
queryTags)
  SubscriptionQueryPlan 'MSSQL MultiplexedQuery'
-> m (SubscriptionQueryPlan 'MSSQL MultiplexedQuery')
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (SubscriptionQueryPlan 'MSSQL MultiplexedQuery'
 -> m (SubscriptionQueryPlan 'MSSQL MultiplexedQuery'))
-> SubscriptionQueryPlan 'MSSQL MultiplexedQuery'
-> m (SubscriptionQueryPlan 'MSSQL MultiplexedQuery')
forall a b. (a -> b) -> a -> b
$ ParameterizedSubscriptionQueryPlan 'MSSQL MultiplexedQuery'
-> SourceConfig 'MSSQL
-> CohortId
-> ResolvedConnectionTemplate 'MSSQL
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan 'MSSQL MultiplexedQuery'
forall (b :: BackendType) q.
ParameterizedSubscriptionQueryPlan b q
-> SourceConfig b
-> CohortId
-> ResolvedConnectionTemplate b
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan b q
SubscriptionQueryPlan ParameterizedSubscriptionQueryPlan 'MSSQL MultiplexedQuery'
parameterizedPlan SourceConfig 'MSSQL
sourceConfig CohortId
dummyCohortId () CohortVariables
cohortVariables Maybe Name
namespace

prepareStateCohortVariables ::
  (MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
  SourceConfig 'MSSQL ->
  SessionVariables ->
  PrepareState ->
  m CohortVariables
prepareStateCohortVariables :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
SourceConfig 'MSSQL
-> SessionVariables -> PrepareState -> m CohortVariables
prepareStateCohortVariables SourceConfig 'MSSQL
sourceConfig SessionVariables
session PrepareState
prepState = do
  (ValidatedCursorVariables
namedVars, ValidatedSyntheticVariables
posVars) <- SourceConfig 'MSSQL
-> SessionVariables
-> PrepareState
-> m (ValidatedCursorVariables, ValidatedSyntheticVariables)
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
SourceConfig 'MSSQL
-> SessionVariables
-> PrepareState
-> m (ValidatedCursorVariables, ValidatedSyntheticVariables)
validateVariables SourceConfig 'MSSQL
sourceConfig SessionVariables
session PrepareState
prepState
  let PrepareState {HashSet SessionVariable
sessionVariables :: HashSet SessionVariable
sessionVariables :: PrepareState -> HashSet SessionVariable
sessionVariables} = PrepareState
prepState
  CohortVariables -> m CohortVariables
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (CohortVariables -> m CohortVariables)
-> CohortVariables -> m CohortVariables
forall a b. (a -> b) -> a -> b
$ HashSet SessionVariable
-> SessionVariables
-> ValidatedCursorVariables
-> ValidatedSyntheticVariables
-> ValidatedCursorVariables
-> CohortVariables
mkCohortVariables
      HashSet SessionVariable
sessionVariables
      SessionVariables
session
      ValidatedCursorVariables
namedVars
      ValidatedSyntheticVariables
posVars
      ValidatedCursorVariables
forall a. Monoid a => a
mempty -- streaming cursor variables are kept empty because streaming subscriptions aren't yet supported for MS-SQL

-- | 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 :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
SourceConfig 'MSSQL
-> SessionVariables
-> PrepareState
-> m (ValidatedCursorVariables, ValidatedSyntheticVariables)
validateVariables SourceConfig 'MSSQL
sourceConfig SessionVariables
sessionVariableValues PrepareState
prepState = do
  let PrepareState {HashSet SessionVariable
sessionVariables :: PrepareState -> HashSet SessionVariable
sessionVariables :: HashSet SessionVariable
sessionVariables, HashMap Name (ColumnValue 'MSSQL)
namedArguments :: HashMap Name (ColumnValue 'MSSQL)
namedArguments :: PrepareState -> HashMap Name (ColumnValue 'MSSQL)
namedArguments, [ColumnValue 'MSSQL]
positionalArguments :: [ColumnValue 'MSSQL]
positionalArguments :: PrepareState -> [ColumnValue 'MSSQL]
positionalArguments} = PrepareState
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 :: SessionVariables
occSessionVars =
        (SessionVariable -> Text -> Bool)
-> SessionVariables -> SessionVariables
filterSessionVariables
          (\SessionVariable
k Text
_ -> SessionVariable -> HashSet SessionVariable -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
Set.member SessionVariable
k HashSet SessionVariable
sessionVariables)
          SessionVariables
sessionVariableValues

      expSes, expNamed, expPos :: [Aliased Expression]
      expSes :: [Aliased Expression]
expSes = Text -> Aliased Expression
sessionReference (Text -> Aliased Expression) -> [Text] -> [Aliased Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionVariables -> [Text]
getSessionVariables SessionVariables
occSessionVars
      expNamed :: [Aliased Expression]
expNamed =
        ((Name, ColumnValue 'MSSQL) -> Aliased Expression)
-> [(Name, ColumnValue 'MSSQL)] -> [Aliased Expression]
forall a b. (a -> b) -> [a] -> [b]
map
          ( \(Name
n, ColumnValue 'MSSQL
v) -> Expression -> Text -> Aliased Expression
forall a. a -> Text -> Aliased a
Aliased (Value -> Expression
ValueExpression (ColumnValue 'MSSQL -> ScalarValue 'MSSQL
forall (b :: BackendType). ColumnValue b -> ScalarValue b
RQLColumn.cvValue ColumnValue 'MSSQL
v)) (Name -> Text
G.unName Name
n)
          )
          ([(Name, ColumnValue 'MSSQL)] -> [Aliased Expression])
-> [(Name, ColumnValue 'MSSQL)] -> [Aliased Expression]
forall a b. (a -> b) -> a -> b
$ HashMap Name (ColumnValue 'MSSQL) -> [(Name, ColumnValue 'MSSQL)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
          (HashMap Name (ColumnValue 'MSSQL) -> [(Name, ColumnValue 'MSSQL)])
-> HashMap Name (ColumnValue 'MSSQL)
-> [(Name, ColumnValue 'MSSQL)]
forall a b. (a -> b) -> a -> b
$ HashMap Name (ColumnValue 'MSSQL)
namedArguments

      -- For positional args we need to be a bit careful not to capture names
      -- from expNamed and expSes (however unlikely)
      expPos :: [Aliased Expression]
expPos =
        (Text -> ColumnValue 'MSSQL -> Aliased Expression)
-> [Text] -> [ColumnValue 'MSSQL] -> [Aliased Expression]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          (\Text
n ColumnValue 'MSSQL
v -> Expression -> Text -> Aliased Expression
forall a. a -> Text -> Aliased a
Aliased (Value -> Expression
ValueExpression (ColumnValue 'MSSQL -> ScalarValue 'MSSQL
forall (b :: BackendType). ColumnValue b -> ScalarValue b
RQLColumn.cvValue ColumnValue 'MSSQL
v)) Text
n)
          ([Aliased Expression] -> [Text]
forall a. [Aliased a] -> [Text]
freshVars ([Aliased Expression]
expNamed [Aliased Expression]
-> [Aliased Expression] -> [Aliased Expression]
forall a. Semigroup a => a -> a -> a
<> [Aliased Expression]
expSes))
          [ColumnValue 'MSSQL]
positionalArguments

      projAll :: [Projection]
      projAll :: [Projection]
projAll = (Aliased Expression -> Projection)
-> [Aliased Expression] -> [Projection]
forall a b. (a -> b) -> [a] -> [b]
map Aliased Expression -> Projection
ExpressionProjection ([Aliased Expression]
expSes [Aliased Expression]
-> [Aliased Expression] -> [Aliased Expression]
forall a. Semigroup a => a -> a -> a
<> [Aliased Expression]
expNamed [Aliased Expression]
-> [Aliased Expression] -> [Aliased Expression]
forall a. Semigroup a => a -> a -> a
<> [Aliased Expression]
expPos)

      canaryQuery :: Maybe Query
canaryQuery =
        if [Projection] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Projection]
projAll
          then Maybe Query
forall a. Maybe a
Nothing
          else
            Query -> Maybe Query
forall a. a -> Maybe a
Just
              (Query -> Maybe Query) -> Query -> Maybe Query
forall a b. (a -> b) -> a -> b
$ Select -> Query
renderQuery
                Select
emptySelect
                  { $sel:selectProjections:Select :: [Projection]
selectProjections = [Projection]
projAll,
                    $sel:selectFrom:Select :: Maybe From
selectFrom = SessionVariables -> Maybe From
sessionOpenJson SessionVariables
occSessionVars
                  }

  Maybe Query -> (Query -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_
    Maybe Query
canaryQuery
    ( \Query
q -> do
        [[Value]]
_ :: [[ODBC.Value]] <- m (Either QErr [[Value]]) -> m [[Value]]
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr [[Value]]) -> m [[Value]])
-> m (Either QErr [[Value]]) -> m [[Value]]
forall a b. (a -> b) -> a -> b
$ ExceptT QErr m [[Value]] -> m (Either QErr [[Value]])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m [[Value]] -> m (Either QErr [[Value]]))
-> ExceptT QErr m [[Value]] -> m (Either QErr [[Value]])
forall a b. (a -> b) -> a -> b
$ MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadOnly (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig) ((MSSQLTxError -> QErr) -> Query -> TxET QErr m [[Value]]
forall (m :: * -> *) a e.
(MonadIO m, FromRow a) =>
(MSSQLTxError -> e) -> Query -> TxET e m [a]
Tx.multiRowQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler Query
q)
        () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    )

  (ValidatedCursorVariables, ValidatedSyntheticVariables)
-> m (ValidatedCursorVariables, ValidatedSyntheticVariables)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( HashMap Name TxtEncodedVal -> ValidatedCursorVariables
forall (f :: * -> *). f TxtEncodedVal -> ValidatedVariables f
ValidatedVariables (HashMap Name TxtEncodedVal -> ValidatedCursorVariables)
-> HashMap Name TxtEncodedVal -> ValidatedCursorVariables
forall a b. (a -> b) -> a -> b
$ ColumnValue 'MSSQL -> TxtEncodedVal
txtEncodedColVal (ColumnValue 'MSSQL -> TxtEncodedVal)
-> HashMap Name (ColumnValue 'MSSQL) -> HashMap Name TxtEncodedVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Name (ColumnValue 'MSSQL)
namedArguments,
      [TxtEncodedVal] -> ValidatedSyntheticVariables
forall (f :: * -> *). f TxtEncodedVal -> ValidatedVariables f
ValidatedVariables ([TxtEncodedVal] -> ValidatedSyntheticVariables)
-> [TxtEncodedVal] -> ValidatedSyntheticVariables
forall a b. (a -> b) -> a -> b
$ ColumnValue 'MSSQL -> TxtEncodedVal
txtEncodedColVal (ColumnValue 'MSSQL -> TxtEncodedVal)
-> [ColumnValue 'MSSQL] -> [TxtEncodedVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColumnValue 'MSSQL]
positionalArguments
    )
  where
    renderQuery :: Select -> ODBC.Query
    renderQuery :: Select -> Query
renderQuery = Printer -> Query
toQueryFlat (Printer -> Query) -> (Select -> Printer) -> Select -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select -> Printer
fromSelect

    freshVars :: [Aliased a] -> [Text]
    freshVars :: forall a. [Aliased a] -> [Text]
freshVars [Aliased a]
boundNames = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Aliased a -> Text) -> [Aliased a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Aliased a -> Text
forall a. Aliased a -> Text
aliasedAlias [Aliased a]
boundNames)) [Text]
chars

    -- Infinite list of expression aliases.
    chars :: [Text]
    chars :: [Text]
chars = [Text
y Text -> Char -> Text
forall t. ToTxt t => Text -> t -> Text
T.<>> Char
x | Text
y <- [Text
""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text]
chars, Char
x <- [Char
'a' .. Char
'z']]

    sessionOpenJson :: SessionVariables -> Maybe From
    sessionOpenJson :: SessionVariables -> Maybe From
sessionOpenJson SessionVariables
occSessionVars =
      [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (SessionVariables -> [Text]
getSessionVariables SessionVariables
occSessionVars)
        Maybe (NonEmpty Text) -> (NonEmpty Text -> From) -> Maybe From
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \NonEmpty Text
fields ->
          Aliased OpenJson -> From
FromOpenJson
            (Aliased OpenJson -> From) -> Aliased OpenJson -> From
forall a b. (a -> b) -> a -> b
$ OpenJson -> Text -> Aliased OpenJson
forall a. a -> Text -> Aliased a
Aliased
              ( Expression -> Maybe (NonEmpty JsonFieldSpec) -> OpenJson
OpenJson
                  (Value -> Expression
ValueExpression (Value -> Expression) -> Value -> Expression
forall a b. (a -> b) -> a -> b
$ Text -> Value
ODBC.TextValue (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
lbsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ SessionVariables -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode SessionVariables
occSessionVars)
                  (NonEmpty JsonFieldSpec -> Maybe (NonEmpty JsonFieldSpec)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> JsonFieldSpec
sessField (Text -> JsonFieldSpec) -> NonEmpty Text -> NonEmpty JsonFieldSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Text
fields))
              )
              Text
"session"

    sessField :: Text -> JsonFieldSpec
    sessField :: Text -> JsonFieldSpec
sessField Text
var = Text -> Maybe JsonPath -> JsonFieldSpec
StringField Text
var Maybe JsonPath
forall a. Maybe a
Nothing

    sessionReference :: Text -> Aliased Expression
    sessionReference :: Text -> Aliased Expression
sessionReference Text
var = Expression -> Text -> Aliased Expression
forall a. a -> Text -> Aliased a
Aliased (FieldName -> Expression
ColumnExpression (Text -> Text -> FieldName
TSQL.FieldName Text
var Text
"session")) Text
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 Void UnpreparedValue) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  Options.StringifyNumbers ->
  m (DBStepInfo 'MSSQL)
msDBRemoteRelationshipPlan :: forall (m :: * -> *).
MonadError QErr m =>
UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> NonEmpty Object
-> HashMap FieldName (Column 'MSSQL, ScalarType 'MSSQL)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo 'MSSQL)
msDBRemoteRelationshipPlan UserInfo
userInfo SourceName
sourceName SourceConfig 'MSSQL
sourceConfig NonEmpty Object
lhs HashMap FieldName (Column 'MSSQL, ScalarType 'MSSQL)
lhsSchema FieldName
argumentId (FieldName,
 SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
relationship [Header]
_headers Maybe Name
_gName StringifyNumbers
_stringifyNumbers = do
  -- `stringifyNumbers` is not currently handled in any SQL Server operation
  Select
statement <- SessionVariables
-> NonEmpty Object
-> HashMap FieldName (ColumnName, ScalarType)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
-> m Select
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables
-> NonEmpty Object
-> HashMap FieldName (ColumnName, ScalarType)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
-> m Select
planSourceRelationship (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo) NonEmpty Object
lhs HashMap FieldName (Column 'MSSQL, ScalarType 'MSSQL)
HashMap FieldName (ColumnName, ScalarType)
lhsSchema FieldName
argumentId (FieldName,
 SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
relationship

  let printer :: Printer
printer = Select -> Printer
fromSelect Select
statement
      queryString :: Text
queryString = Query -> Text
ODBC.renderQuery (Query -> Text) -> Query -> Text
forall a b. (a -> b) -> a -> b
$ Printer -> Query
toQueryPretty Printer
printer
      odbcQuery :: OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
odbcQuery = Printer -> OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
runSelectQuery Printer
printer

  DBStepInfo 'MSSQL -> m (DBStepInfo 'MSSQL)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DBStepInfo 'MSSQL -> m (DBStepInfo 'MSSQL))
-> DBStepInfo 'MSSQL -> m (DBStepInfo 'MSSQL)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> OnBaseMonad (ExecutionMonad b) (ActionResult b)
-> ResolvedConnectionTemplate b
-> DBStepInfo b
DBStepInfo @'MSSQL SourceName
sourceName SourceConfig 'MSSQL
sourceConfig (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
queryString) OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
OnBaseMonad (ExecutionMonad 'MSSQL) (ActionResult 'MSSQL)
odbcQuery ()
  where
    runSelectQuery :: Printer -> OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
runSelectQuery Printer
queryPrinter = (forall (m :: * -> *).
 (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 ExceptT QErr m (ActionResult 'MSSQL))
-> OnBaseMonad (ExceptT QErr) (ActionResult 'MSSQL)
forall (t :: (* -> *) -> * -> *) a.
(forall (m :: * -> *).
 (Functor (t m), MonadIO m, MonadBaseControl IO m, MonadTrace m,
  MonadError QErr m) =>
 t m a)
-> OnBaseMonad t a
OnBaseMonad do
      let queryTx :: TxET QErr m EncJSON
queryTx = Text -> EncJSON
encJFromText (Text -> EncJSON) -> TxET QErr m Text -> TxET QErr m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MSSQLTxError -> QErr) -> Query -> TxET QErr m Text
forall (m :: * -> *) a e.
(MonadIO m, FromRow a) =>
(MSSQLTxError -> e) -> Query -> TxET e m a
Tx.singleRowQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Printer -> Query
toQueryFlat Printer
queryPrinter)
      MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadOnly (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig) ((EncJSON -> ActionResult 'MSSQL)
-> TxET QErr m EncJSON -> TxET QErr m (ActionResult 'MSSQL)
forall a b. (a -> b) -> TxET QErr m a -> TxET QErr m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EncJSON -> ActionResult 'MSSQL
forall (b :: BackendType). EncJSON -> ActionResult b
withNoStatistics TxET QErr m EncJSON
queryTx)