{-# 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 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.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.Schema.Options qualified as Options
import Hasura.Prelude
import Hasura.QueryTags (QueryTagsComment)
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend as RQLTypes
import Hasura.RQL.Types.Column qualified as RQLColumn
import Hasura.RQL.Types.Common as RQLTypes
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
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 :: UserInfo
-> Environment
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (DBStepInfo 'MSSQL)
mkDBQueryPlan = UserInfo
-> Environment
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (DBStepInfo 'MSSQL)
forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> Environment
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (DBStepInfo 'MSSQL)
msDBQueryPlan
  mkDBMutationPlan :: UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig 'MSSQL
-> MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (DBStepInfo 'MSSQL)
mkDBMutationPlan = UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig 'MSSQL
-> MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (DBStepInfo 'MSSQL)
forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig 'MSSQL
-> MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (DBStepInfo 'MSSQL)
msDBMutationPlan
  mkLiveQuerySubscriptionPlan :: UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> Maybe Name
-> RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
mkLiveQuerySubscriptionPlan = UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> Maybe Name
-> RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> 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))
-> m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
msDBLiveQuerySubscriptionPlan
  mkDBStreamingSubscriptionPlan :: UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> (RootFieldAlias, QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
mkDBStreamingSubscriptionPlan UserInfo
_ SourceName
_ SourceConfig 'MSSQL
_ (RootFieldAlias, QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
_ = 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 :: RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (AnyBackend DBStepInfo)
mkDBQueryExplain = RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (AnyBackend DBStepInfo)
forall (m :: * -> *).
MonadError QErr m =>
RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (AnyBackend DBStepInfo)
msDBQueryExplain
  mkSubscriptionExplain :: 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 :: UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> NonEmpty Object
-> HashMap FieldName (Column 'MSSQL, ScalarType 'MSSQL)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
-> m (DBStepInfo 'MSSQL)
mkDBRemoteRelationshipPlan =
    UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> NonEmpty Object
-> HashMap FieldName (Column 'MSSQL, ScalarType 'MSSQL)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
-> 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)
-> 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 ->
  Env.Environment ->
  SourceName ->
  SourceConfig 'MSSQL ->
  QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL) ->
  m (DBStepInfo 'MSSQL)
msDBQueryPlan :: UserInfo
-> Environment
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (DBStepInfo 'MSSQL)
msDBQueryPlan UserInfo
userInfo Environment
_env SourceName
sourceName SourceConfig 'MSSQL
sourceConfig QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
qrf = do
  let sessionVariables :: SessionVariables
sessionVariables = UserInfo -> SessionVariables
_uiSession UserInfo
userInfo
  Select
statement <- SessionVariables
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL) -> m Select
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL) -> m 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 (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
$ SourceName
-> SourceConfig 'MSSQL
-> Maybe (PreparedQuery 'MSSQL)
-> ExecutionMonad 'MSSQL EncJSON
-> DBStepInfo 'MSSQL
forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> ExecutionMonad b EncJSON
-> DBStepInfo b
DBStepInfo @'MSSQL SourceName
sourceName SourceConfig 'MSSQL
sourceConfig (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
queryString) (Printer -> ExceptT QErr IO EncJSON
runSelectQuery Printer
printer)
  where
    runSelectQuery :: Printer -> ExceptT QErr IO EncJSON
    runSelectQuery :: Printer -> ExceptT QErr IO EncJSON
runSelectQuery Printer
queryPrinter = do
      let queryTx :: TxET QErr IO EncJSON
queryTx = Text -> EncJSON
encJFromText (Text -> EncJSON) -> TxET QErr IO Text -> TxET QErr IO EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MSSQLTxError -> QErr) -> Query -> TxET QErr IO 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 -> TxET QErr IO EncJSON -> ExceptT QErr IO EncJSON
MSSQLExecCtx
-> forall (m :: * -> *) a.
   (MonadIO m, MonadBaseControl IO m) =>
   TxET QErr m a -> ExceptT QErr m a
mssqlRunReadOnly (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig) TxET QErr IO EncJSON
queryTx

runShowplan ::
  MonadIO m =>
  ODBC.Query ->
  Tx.TxET QErr m [Text]
runShowplan :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
texts

msDBQueryExplain ::
  MonadError QErr m =>
  RootFieldAlias ->
  UserInfo ->
  SourceName ->
  SourceConfig 'MSSQL ->
  QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL) ->
  m (AB.AnyBackend DBStepInfo)
msDBQueryExplain :: RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (AnyBackend DBStepInfo)
msDBQueryExplain RootFieldAlias
fieldName UserInfo
userInfo SourceName
sourceName SourceConfig 'MSSQL
sourceConfig QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL)
qrf = do
  let sessionVariables :: SessionVariables
sessionVariables = UserInfo -> SessionVariables
_uiSession UserInfo
userInfo
  Select
statement <- SessionVariables
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL) -> m Select
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables
-> QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL) -> m 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 :: ExceptT QErr IO EncJSON
odbcQuery =
        MSSQLExecCtx -> TxET QErr IO EncJSON -> ExceptT QErr IO EncJSON
MSSQLExecCtx
-> forall (m :: * -> *) a.
   (MonadIO m, MonadBaseControl IO m) =>
   TxET QErr m a -> ExceptT QErr m a
mssqlRunReadOnly
          (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig)
          do
            [Text]
showplan <- Query -> TxET QErr IO [Text]
forall (m :: * -> *). MonadIO m => Query -> TxET QErr m [Text]
runShowplan Query
query
            EncJSON -> TxET QErr IO EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              ( 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 (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
$
      SourceName
-> SourceConfig 'MSSQL
-> Maybe (PreparedQuery 'MSSQL)
-> ExecutionMonad 'MSSQL EncJSON
-> DBStepInfo 'MSSQL
forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> ExecutionMonad b EncJSON
-> DBStepInfo b
DBStepInfo @'MSSQL SourceName
sourceName SourceConfig 'MSSQL
sourceConfig Maybe (PreparedQuery 'MSSQL)
forall a. Maybe a
Nothing ExceptT QErr IO EncJSON
ExecutionMonad 'MSSQL EncJSON
odbcQuery

msDBSubscriptionExplain ::
  (MonadIO m, MonadBaseControl IO m, MonadError QErr m) =>
  SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL) ->
  m SubscriptionQueryPlanExplanation
msDBSubscriptionExplain :: SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL)
-> m SubscriptionQueryPlanExplanation
msDBSubscriptionExplain (SubscriptionQueryPlan ParameterizedSubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL)
plan SourceConfig 'MSSQL
sourceConfig 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
dummyCohortId, 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 -> TxET QErr m [Text] -> ExceptT QErr m [Text]
MSSQLExecCtx
-> forall (m :: * -> *) a.
   (MonadIO m, MonadBaseControl IO m) =>
   TxET QErr m a -> ExceptT QErr m a
mssqlRunReadOnly MSSQLExecCtx
mssqlExecCtx) (Query -> TxET QErr m [Text]
forall (m :: * -> *). MonadIO m => Query -> TxET QErr m [Text]
runShowplan Query
query)
  SubscriptionQueryPlanExplanation
-> m SubscriptionQueryPlanExplanation
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 :: forall a. a -> Text -> Aliased a
Aliased
              { $sel:aliasedThing:Aliased :: FieldName
aliasedThing =
                  FieldName :: Text -> Text -> FieldName
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 :: forall a. a -> Text -> Aliased a
Aliased
              { $sel:aliasedThing:Aliased :: Expression
aliasedThing =
                  FieldName -> Expression
ColumnExpression
                    ( FieldName :: Text -> Text -> FieldName
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 :: forall a. a -> Text -> Aliased a
Aliased
              { $sel:aliasedThing:Aliased :: OpenJson
aliasedThing =
                  OpenJson :: Expression -> Maybe (NonEmpty JsonFieldSpec) -> OpenJson
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. [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 :: JoinSource -> JoinAlias -> Join
Join
            { $sel:joinSource:Join :: JoinSource
joinSource = Reselect -> JoinSource
JoinReselect Reselect
rootReselect,
              $sel:joinJoinAlias:Join :: JoinAlias
joinJoinAlias =
                JoinAlias :: Text -> Maybe Text -> JoinAlias
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 :: JsonCardinality -> Root -> ForJson
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
  ) =>
  UserInfo ->
  Options.StringifyNumbers ->
  SourceName ->
  SourceConfig 'MSSQL ->
  MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL) ->
  m (DBStepInfo 'MSSQL)
msDBMutationPlan :: UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig 'MSSQL
-> MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (DBStepInfo 'MSSQL)
msDBMutationPlan UserInfo
userInfo StringifyNumbers
stringifyNum SourceName
sourceName SourceConfig 'MSSQL
sourceConfig MutationDB 'MSSQL Void (UnpreparedValue 'MSSQL)
mrf = do
  ExceptT QErr IO EncJSON -> DBStepInfo 'MSSQL
go (ExceptT QErr IO EncJSON -> DBStepInfo 'MSSQL)
-> m (ExceptT QErr IO 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 (ExceptT QErr IO EncJSON)
forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (ExceptT QErr IO 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 (ExceptT QErr IO EncJSON)
forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnDelG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (ExceptT QErr IO 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 (ExceptT QErr IO EncJSON)
forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (ExceptT QErr IO EncJSON)
executeUpdate UserInfo
userInfo StringifyNumbers
stringifyNum SourceConfig 'MSSQL
sourceConfig AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
annUpdate
    MDBFunction {} -> Code -> Text -> m (ExceptT QErr IO EncJSON)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"function mutations are not supported in MSSQL"
  where
    go :: ExceptT QErr IO EncJSON -> DBStepInfo 'MSSQL
go ExceptT QErr IO EncJSON
v = SourceName
-> SourceConfig 'MSSQL
-> Maybe (PreparedQuery 'MSSQL)
-> ExecutionMonad 'MSSQL EncJSON
-> DBStepInfo 'MSSQL
forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> ExecutionMonad b EncJSON
-> DBStepInfo b
DBStepInfo @'MSSQL SourceName
sourceName SourceConfig 'MSSQL
sourceConfig Maybe (PreparedQuery 'MSSQL)
forall a. Maybe a
Nothing ExceptT QErr IO EncJSON
ExecutionMonad 'MSSQL 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)) ->
  m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
msDBLiveQuerySubscriptionPlan :: UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> Maybe Name
-> RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
-> m (SubscriptionQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
msDBLiveQuerySubscriptionPlan UserInfo {SessionVariables
_uiSession :: SessionVariables
_uiSession :: UserInfo -> SessionVariables
_uiSession, RoleName
_uiRole :: UserInfo -> RoleName
_uiRole :: RoleName
_uiRole} SourceName
_sourceName SourceConfig 'MSSQL
sourceConfig Maybe Name
namespace RootFieldMap (QueryDB 'MSSQL Void (UnpreparedValue 'MSSQL))
rootFields = 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
OMap.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 (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
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan 'MSSQL MultiplexedQuery'
forall (b :: BackendType) q.
ParameterizedSubscriptionQueryPlan b q
-> SourceConfig b
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan b q
SubscriptionQueryPlan ParameterizedSubscriptionQueryPlan 'MSSQL MultiplexedQuery'
parameterizedPlan SourceConfig 'MSSQL
sourceConfig CohortVariables
cohortVariables Maybe Name
namespace

prepareStateCohortVariables :: (MonadError QErr m, MonadIO m, MonadBaseControl IO m) => SourceConfig 'MSSQL -> SessionVariables -> PrepareState -> m CohortVariables
prepareStateCohortVariables :: SourceConfig 'MSSQL
-> SessionVariables -> PrepareState -> m CohortVariables
prepareStateCohortVariables SourceConfig 'MSSQL
sourceConfig SessionVariables
session PrepareState
prepState = do
  (ValidatedQueryVariables
namedVars, ValidatedSyntheticVariables
posVars) <- SourceConfig 'MSSQL
-> SessionVariables
-> PrepareState
-> m (ValidatedQueryVariables, ValidatedSyntheticVariables)
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
SourceConfig 'MSSQL
-> SessionVariables
-> PrepareState
-> m (ValidatedQueryVariables, ValidatedSyntheticVariables)
validateVariables SourceConfig 'MSSQL
sourceConfig SessionVariables
session PrepareState
prepState
  let PrepareState {HashSet SessionVariable
sessionVariables :: PrepareState -> HashSet SessionVariable
sessionVariables :: HashSet SessionVariable
sessionVariables} = PrepareState
prepState
  CohortVariables -> m CohortVariables
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
-> ValidatedQueryVariables
-> ValidatedSyntheticVariables
-> ValidatedQueryVariables
-> CohortVariables
mkCohortVariables
      HashSet SessionVariable
sessionVariables
      SessionVariables
session
      ValidatedQueryVariables
namedVars
      ValidatedSyntheticVariables
posVars
      ValidatedQueryVariables
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 :: SourceConfig 'MSSQL
-> SessionVariables
-> PrepareState
-> m (ValidatedQueryVariables, ValidatedSyntheticVariables)
validateVariables SourceConfig 'MSSQL
sourceConfig SessionVariables
sessionVariableValues PrepareState
prepState = do
  let PrepareState {HashSet SessionVariable
sessionVariables :: HashSet SessionVariable
sessionVariables :: PrepareState -> HashSet SessionVariable
sessionVariables, HashMap Name (ColumnValue 'MSSQL)
namedArguments :: PrepareState -> HashMap Name (ColumnValue 'MSSQL)
namedArguments :: HashMap Name (ColumnValue 'MSSQL)
namedArguments, [ColumnValue 'MSSQL]
positionalArguments :: PrepareState -> [ColumnValue 'MSSQL]
positionalArguments :: [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)]
Map.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 (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 (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
onJust
    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 -> TxET QErr m [[Value]] -> ExceptT QErr m [[Value]]
MSSQLExecCtx
-> forall (m :: * -> *) a.
   (MonadIO m, MonadBaseControl IO m) =>
   TxET QErr m a -> ExceptT QErr m a
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
    )

  (ValidatedQueryVariables, ValidatedSyntheticVariables)
-> m (ValidatedQueryVariables, ValidatedSyntheticVariables)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( HashMap Name TxtEncodedVal -> ValidatedQueryVariables
forall (f :: * -> *). f TxtEncodedVal -> ValidatedVariables f
ValidatedVariables (HashMap Name TxtEncodedVal -> ValidatedQueryVariables)
-> HashMap Name TxtEncodedVal -> ValidatedQueryVariables
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 :: [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 (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 (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 (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) ->
  m (DBStepInfo 'MSSQL)
msDBRemoteRelationshipPlan :: UserInfo
-> SourceName
-> SourceConfig 'MSSQL
-> NonEmpty Object
-> HashMap FieldName (Column 'MSSQL, ScalarType 'MSSQL)
-> FieldName
-> (FieldName,
    SourceRelationshipSelection 'MSSQL Void UnpreparedValue)
-> 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 = do
  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 :: ExceptT QErr IO EncJSON
odbcQuery = Printer -> ExceptT QErr IO EncJSON
runSelectQuery Printer
printer

  DBStepInfo 'MSSQL -> m (DBStepInfo 'MSSQL)
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
$ SourceName
-> SourceConfig 'MSSQL
-> Maybe (PreparedQuery 'MSSQL)
-> ExecutionMonad 'MSSQL EncJSON
-> DBStepInfo 'MSSQL
forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> ExecutionMonad b EncJSON
-> DBStepInfo b
DBStepInfo @'MSSQL SourceName
sourceName SourceConfig 'MSSQL
sourceConfig (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
queryString) ExceptT QErr IO EncJSON
ExecutionMonad 'MSSQL EncJSON
odbcQuery
  where
    runSelectQuery :: Printer -> ExceptT QErr IO EncJSON
    runSelectQuery :: Printer -> ExceptT QErr IO EncJSON
runSelectQuery Printer
queryPrinter = do
      let queryTx :: TxET QErr IO EncJSON
queryTx = Text -> EncJSON
encJFromText (Text -> EncJSON) -> TxET QErr IO Text -> TxET QErr IO EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MSSQLTxError -> QErr) -> Query -> TxET QErr IO 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 -> TxET QErr IO EncJSON -> ExceptT QErr IO EncJSON
MSSQLExecCtx
-> forall (m :: * -> *) a.
   (MonadIO m, MonadBaseControl IO m) =>
   TxET QErr m a -> ExceptT QErr m a
mssqlRunReadOnly (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig) TxET QErr IO EncJSON
queryTx