{-# OPTIONS_HADDOCK ignore-exports #-}

-- | Responsible for translating and building an MSSQL execution plan for
--   update mutations.
--
--   This module is used by "Hasura.Backends.MSSQL.Instances.Execute".
module Hasura.Backends.MSSQL.Execute.Update
  ( executeUpdate,
  )
where

import Database.MSSQL.Transaction qualified as Tx
import Hasura.Backends.MSSQL.Connection
import Hasura.Backends.MSSQL.Execute.QueryTags
import Hasura.Backends.MSSQL.FromIr as TSQL
import Hasura.Backends.MSSQL.FromIr.Constants (tempTableNameUpdated)
import Hasura.Backends.MSSQL.FromIr.Expression (fromGBoolExp)
import Hasura.Backends.MSSQL.FromIr.MutationResponse
import Hasura.Backends.MSSQL.FromIr.SelectIntoTempTable qualified as TSQL
import Hasura.Backends.MSSQL.FromIr.Update qualified as TSQL
import Hasura.Backends.MSSQL.Plan
import Hasura.Backends.MSSQL.SQL.Error
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.Prelude
import Hasura.QueryTags (QueryTagsComment)
import Hasura.RQL.IR
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.IR.Update.Batch qualified as IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.Session

-- | Executes an Update IR AST and return results as JSON.
executeUpdate ::
  (MonadError QErr m, MonadReader QueryTagsComment m) =>
  UserInfo ->
  Options.StringifyNumbers ->
  SourceConfig 'MSSQL ->
  AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL) ->
  m (OnBaseMonad (ExceptT QErr) EncJSON)
executeUpdate :: 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)
updateOperation = do
  QueryTagsComment
queryTags <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  let mssqlExecCtx :: MSSQLExecCtx
mssqlExecCtx = (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig)
  AnnotatedUpdateG 'MSSQL Void Expression
preparedUpdate <- (UnpreparedValue 'MSSQL -> m Expression)
-> AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (AnnotatedUpdateG 'MSSQL Void Expression)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> AnnotatedUpdateG 'MSSQL Void a
-> f (AnnotatedUpdateG 'MSSQL Void b)
traverse (SessionVariables -> UnpreparedValue 'MSSQL -> m Expression
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables -> UnpreparedValue 'MSSQL -> m Expression
prepareValueQuery (SessionVariables -> UnpreparedValue 'MSSQL -> m Expression)
-> SessionVariables -> UnpreparedValue 'MSSQL -> m Expression
forall a b. (a -> b) -> a -> b
$ UserInfo -> SessionVariables
_uiSession UserInfo
userInfo) AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
updateOperation
  if UpdateBatch 'MSSQL UpdateOperator (UnpreparedValue 'MSSQL) -> Bool
forall (b :: BackendType) (updateOperators :: * -> *) v.
UpdateBatch b updateOperators v -> Bool
IR.updateBatchIsEmpty (UpdateBatch 'MSSQL UpdateOperator (UnpreparedValue 'MSSQL)
 -> Bool)
-> UpdateBatch 'MSSQL UpdateOperator (UnpreparedValue 'MSSQL)
-> Bool
forall a b. (a -> b) -> a -> b
$ AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> UpdateVariant 'MSSQL (UnpreparedValue 'MSSQL)
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> UpdateVariant b v
_auUpdateVariant AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
updateOperation
    then OnBaseMonad (ExceptT QErr) EncJSON
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OnBaseMonad (ExceptT QErr) EncJSON
 -> m (OnBaseMonad (ExceptT QErr) EncJSON))
-> OnBaseMonad (ExceptT QErr) EncJSON
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
 (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 ExceptT QErr m EncJSON)
-> OnBaseMonad (ExceptT QErr) EncJSON
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 EncJSON)
 -> OnBaseMonad (ExceptT QErr) EncJSON)
-> (forall (m :: * -> *).
    (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
     MonadTrace m, MonadError QErr m) =>
    ExceptT QErr m EncJSON)
-> OnBaseMonad (ExceptT QErr) EncJSON
forall a b. (a -> b) -> a -> b
$ EncJSON -> ExceptT QErr m EncJSON
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> ExceptT QErr m EncJSON)
-> EncJSON -> ExceptT QErr m EncJSON
forall a b. (a -> b) -> a -> b
$ MutationOutput 'MSSQL -> EncJSON
forall (backend :: BackendType). MutationOutput backend -> EncJSON
IR.buildEmptyMutResp (MutationOutput 'MSSQL -> EncJSON)
-> MutationOutput 'MSSQL -> EncJSON
forall a b. (a -> b) -> a -> b
$ AnnotatedUpdateG 'MSSQL Void Expression
-> MutationOutputG 'MSSQL Void Expression
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> MutationOutputG b r v
_auOutput AnnotatedUpdateG 'MSSQL Void Expression
preparedUpdate
    else OnBaseMonad (ExceptT QErr) EncJSON
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OnBaseMonad (ExceptT QErr) EncJSON
 -> m (OnBaseMonad (ExceptT QErr) EncJSON))
-> OnBaseMonad (ExceptT QErr) EncJSON
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
 (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 ExceptT QErr m EncJSON)
-> OnBaseMonad (ExceptT QErr) EncJSON
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 EncJSON)
 -> OnBaseMonad (ExceptT QErr) EncJSON)
-> (forall (m :: * -> *).
    (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
     MonadTrace m, MonadError QErr m) =>
    ExceptT QErr m EncJSON)
-> OnBaseMonad (ExceptT QErr) EncJSON
forall a b. (a -> b) -> a -> b
$ (MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadWrite MSSQLExecCtx
mssqlExecCtx) (AnnotatedUpdate 'MSSQL
-> StringifyNumbers -> QueryTagsComment -> TxET QErr m EncJSON
forall (m :: * -> *).
MonadIO m =>
AnnotatedUpdate 'MSSQL
-> StringifyNumbers -> QueryTagsComment -> TxET QErr m EncJSON
buildUpdateTx AnnotatedUpdate 'MSSQL
AnnotatedUpdateG 'MSSQL Void Expression
preparedUpdate StringifyNumbers
stringifyNum QueryTagsComment
queryTags)

-- | Converts an Update IR AST to a transaction of three update sql statements.
--
-- A GraphQL update mutation does two things:
--
-- 1. Update rows in a table according to some predicate
-- 2. (Potentially) returns the updated rows (including relationships) as JSON
--
-- In order to complete these 2 things we need 3 SQL statements:
--
-- 1. @SELECT INTO <temp_table> WHERE <false>@ - creates a temporary table
--    with the same schema as the original table in which we'll store the updated rows
--    from the table we are deleting
-- 2. @UPDATE SET FROM with OUTPUT@ - updates the rows from the table and inserts the
--   updated rows to the temporary table from (1)
-- 3. @SELECT@ - constructs the @returning@ query from the temporary table, including
--   relationships with other tables.
buildUpdateTx ::
  (MonadIO m) =>
  AnnotatedUpdate 'MSSQL ->
  Options.StringifyNumbers ->
  QueryTagsComment ->
  Tx.TxET QErr m EncJSON
buildUpdateTx :: forall (m :: * -> *).
MonadIO m =>
AnnotatedUpdate 'MSSQL
-> StringifyNumbers -> QueryTagsComment -> TxET QErr m EncJSON
buildUpdateTx AnnotatedUpdate 'MSSQL
updateOperation StringifyNumbers
stringifyNum QueryTagsComment
queryTags = do
  let withAlias :: Text
withAlias = Text
"with_alias"
      createInsertedTempTableQuery :: Query
createInsertedTempTableQuery =
        Printer -> Query
toQueryFlat
          (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$ SelectIntoTempTable -> Printer
TQ.fromSelectIntoTempTable
          (SelectIntoTempTable -> Printer) -> SelectIntoTempTable -> Printer
forall a b. (a -> b) -> a -> b
$ TempTableName
-> TableName
-> [ColumnInfo 'MSSQL]
-> SITTConstraints
-> SelectIntoTempTable
TSQL.toSelectIntoTempTable TempTableName
tempTableNameUpdated (AnnotatedUpdateG 'MSSQL Void Expression -> TableName 'MSSQL
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> TableName b
_auTable AnnotatedUpdate 'MSSQL
AnnotatedUpdateG 'MSSQL Void Expression
updateOperation) (AnnotatedUpdateG 'MSSQL Void Expression -> [ColumnInfo 'MSSQL]
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> [ColumnInfo b]
_auAllCols AnnotatedUpdate 'MSSQL
AnnotatedUpdateG 'MSSQL Void Expression
updateOperation) SITTConstraints
RemoveConstraints
  -- Create a temp table
  (MSSQLTxError -> QErr) -> Query -> TxET QErr m ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Query
createInsertedTempTableQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)
  let updateQuery :: FromIr Printer
updateQuery = Update -> Printer
TQ.fromUpdate (Update -> Printer) -> FromIr Update -> FromIr Printer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnotatedUpdate 'MSSQL -> FromIr Update
TSQL.fromUpdate AnnotatedUpdate 'MSSQL
updateOperation
  Query
updateQueryValidated <- Printer -> Query
toQueryFlat (Printer -> Query)
-> (QueryWithDDL Printer -> Printer)
-> QueryWithDDL Printer
-> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryWithDDL Printer -> Printer
forall a. QueryWithDDL a -> a
qwdQuery (QueryWithDDL Printer -> Query)
-> TxET QErr m (QueryWithDDL Printer) -> TxET QErr m Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromIr Printer -> TxET QErr m (QueryWithDDL Printer)
forall (m :: * -> *) a.
MonadError QErr m =>
FromIr a -> m (QueryWithDDL a)
runFromIrErrorOnCTEs FromIr Printer
updateQuery

  -- Execute UPDATE statement
  (MSSQLTxError -> QErr) -> Query -> TxET QErr m ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
mutationMSSQLTxErrorHandler (Query
updateQueryValidated Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)
  Select
mutationOutputSelect <- QueryWithDDL Select -> Select
forall a. QueryWithDDL a -> a
qwdQuery (QueryWithDDL Select -> Select)
-> TxET QErr m (QueryWithDDL Select) -> TxET QErr m Select
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromIr Select -> TxET QErr m (QueryWithDDL Select)
forall (m :: * -> *).
MonadError QErr m =>
FromIr Select -> m (QueryWithDDL Select)
runFromIrUseCTEs (StringifyNumbers
-> Text -> MutationOutputG 'MSSQL Void Expression -> FromIr Select
mkMutationOutputSelect StringifyNumbers
stringifyNum Text
withAlias (MutationOutputG 'MSSQL Void Expression -> FromIr Select)
-> MutationOutputG 'MSSQL Void Expression -> FromIr Select
forall a b. (a -> b) -> a -> b
$ AnnotatedUpdateG 'MSSQL Void Expression
-> MutationOutputG 'MSSQL Void Expression
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> MutationOutputG b r v
_auOutput AnnotatedUpdate 'MSSQL
AnnotatedUpdateG 'MSSQL Void Expression
updateOperation)
  let checkCondition :: AnnBoolExp 'MSSQL Expression
checkCondition = AnnotatedUpdateG 'MSSQL Void Expression
-> AnnBoolExp 'MSSQL Expression
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> AnnBoolExp b v
_auCheck AnnotatedUpdate 'MSSQL
AnnotatedUpdateG 'MSSQL Void Expression
updateOperation

  -- The check constraint is translated to boolean expression
  Expression
checkBoolExp <- QueryWithDDL Expression -> Expression
forall a. QueryWithDDL a -> a
qwdQuery (QueryWithDDL Expression -> Expression)
-> TxET QErr m (QueryWithDDL Expression) -> TxET QErr m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromIr Expression -> TxET QErr m (QueryWithDDL Expression)
forall (m :: * -> *) a.
MonadError QErr m =>
FromIr a -> m (QueryWithDDL a)
runFromIrErrorOnCTEs (ReaderT EntityAlias FromIr Expression
-> EntityAlias -> FromIr Expression
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (AnnBoolExp 'MSSQL Expression
-> ReaderT EntityAlias FromIr Expression
fromGBoolExp AnnBoolExp 'MSSQL Expression
checkCondition) (Text -> EntityAlias
EntityAlias Text
withAlias))

  let withSelect :: Select
withSelect =
        Select
emptySelect
          { $sel:selectProjections:Select :: [Projection]
selectProjections = [Projection
StarProjection],
            $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 TempTableName -> From
FromTempTable (Aliased TempTableName -> From) -> Aliased TempTableName -> From
forall a b. (a -> b) -> a -> b
$ TempTableName -> Text -> Aliased TempTableName
forall a. a -> Text -> Aliased a
Aliased TempTableName
tempTableNameUpdated Text
"updated_alias"
          }
      mutationOutputCheckConstraintSelect :: Select
mutationOutputCheckConstraintSelect = Text -> Select -> Expression -> Select
selectMutationOutputAndCheckCondition Text
withAlias Select
mutationOutputSelect Expression
checkBoolExp
      finalSelect :: Select
finalSelect = Select
mutationOutputCheckConstraintSelect {$sel:selectWith:Select :: Maybe With
selectWith = With -> Maybe With
forall a. a -> Maybe a
Just (With -> Maybe With) -> With -> Maybe With
forall a b. (a -> b) -> a -> b
$ NonEmpty (Aliased CTEBody) -> With
With (NonEmpty (Aliased CTEBody) -> With)
-> NonEmpty (Aliased CTEBody) -> With
forall a b. (a -> b) -> a -> b
$ Aliased CTEBody -> NonEmpty (Aliased CTEBody)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased CTEBody -> NonEmpty (Aliased CTEBody))
-> Aliased CTEBody -> NonEmpty (Aliased CTEBody)
forall a b. (a -> b) -> a -> b
$ CTEBody -> Text -> Aliased CTEBody
forall a. a -> Text -> Aliased a
Aliased (Select -> CTEBody
CTESelect Select
withSelect) Text
withAlias}

  -- Execute SELECT query to fetch mutation response and check constraint result
  let finalSelectQuery :: Query
finalSelectQuery = Printer -> Query
toQueryFlat (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$ Select -> Printer
TQ.fromSelect Select
finalSelect
  (Text
responseText, Int
checkConditionInt) <- (MSSQLTxError -> QErr) -> Query -> TxET QErr m (Text, Int)
forall (m :: * -> *) a e.
(MonadIO m, FromRow a) =>
(MSSQLTxError -> e) -> Query -> TxET e m a
Tx.singleRowQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Query
finalSelectQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)
  -- Drop the temp table
  (MSSQLTxError -> QErr) -> Query -> TxET QErr m ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Printer -> Query
toQueryFlat (TempTableName -> Printer
dropTempTableQuery TempTableName
tempTableNameUpdated) Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)
  -- Raise an exception if the check condition is not met
  Bool -> TxET QErr m () -> TxET QErr m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
checkConditionInt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0 :: Int))
    (TxET QErr m () -> TxET QErr m ())
-> TxET QErr m () -> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> TxET QErr m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
PermissionError Text
"check constraint of an insert/update permission has failed"
  EncJSON -> TxET QErr m EncJSON
forall a. a -> TxET QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> TxET QErr m EncJSON) -> EncJSON -> TxET QErr m EncJSON
forall a b. (a -> b) -> a -> b
$ Text -> EncJSON
encJFromText Text
responseText