{-# 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.Backends.MSSQL.Types.Update
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Prelude
import Hasura.QueryTags (QueryTagsComment)
import Hasura.RQL.IR
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.Types.Backend
import Hasura.SQL.Backend
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 (ExceptT QErr IO EncJSON)
executeUpdate :: 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)
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)
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 HashMap ColumnName (UpdateOperator (UnpreparedValue 'MSSQL))
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (HashMap ColumnName (UpdateOperator (UnpreparedValue 'MSSQL))
 -> Bool)
-> HashMap ColumnName (UpdateOperator (UnpreparedValue 'MSSQL))
-> Bool
forall a b. (a -> b) -> a -> b
$ BackendUpdate (UnpreparedValue 'MSSQL)
-> HashMap ColumnName (UpdateOperator (UnpreparedValue 'MSSQL))
forall v. BackendUpdate v -> HashMap ColumnName (UpdateOperator v)
updateOperations (BackendUpdate (UnpreparedValue 'MSSQL)
 -> HashMap ColumnName (UpdateOperator (UnpreparedValue 'MSSQL)))
-> (AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
    -> BackendUpdate (UnpreparedValue 'MSSQL))
-> AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> HashMap ColumnName (UpdateOperator (UnpreparedValue 'MSSQL))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> BackendUpdate (UnpreparedValue 'MSSQL)
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> BackendUpdate b v
_auBackend (AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
 -> HashMap ColumnName (UpdateOperator (UnpreparedValue 'MSSQL)))
-> AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> HashMap ColumnName (UpdateOperator (UnpreparedValue 'MSSQL))
forall a b. (a -> b) -> a -> b
$ AnnotatedUpdateG 'MSSQL Void (UnpreparedValue 'MSSQL)
updateOperation
    then ExceptT QErr IO EncJSON -> m (ExceptT QErr IO EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QErr IO EncJSON -> m (ExceptT QErr IO EncJSON))
-> ExceptT QErr IO EncJSON -> m (ExceptT QErr IO EncJSON)
forall a b. (a -> b) -> a -> b
$ EncJSON -> ExceptT QErr IO EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> ExceptT QErr IO EncJSON)
-> EncJSON -> ExceptT QErr IO 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 ExceptT QErr IO EncJSON -> m (ExceptT QErr IO EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QErr IO EncJSON -> m (ExceptT QErr IO EncJSON))
-> ExceptT QErr IO EncJSON -> m (ExceptT QErr IO EncJSON)
forall a b. (a -> b) -> a -> b
$ (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
mssqlRunReadWrite MSSQLExecCtx
mssqlExecCtx) (AnnotatedUpdate 'MSSQL
-> StringifyNumbers -> QueryTagsComment -> TxET QErr IO 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 ::
  AnnotatedUpdate 'MSSQL ->
  Options.StringifyNumbers ->
  QueryTagsComment ->
  Tx.TxET QErr IO EncJSON
buildUpdateTx :: AnnotatedUpdate 'MSSQL
-> StringifyNumbers -> QueryTagsComment -> TxET QErr IO 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 IO ()
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) -> TxET QErr IO Printer -> TxET QErr IO Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromIr Printer -> TxET QErr IO Printer
forall (m :: * -> *) a. MonadError QErr m => FromIr a -> m a
runFromIr FromIr Printer
updateQuery
  -- Execute UPDATE statement
  (MSSQLTxError -> QErr) -> Query -> TxET QErr IO ()
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 <- FromIr Select -> TxET QErr IO Select
forall (m :: * -> *) a. MonadError QErr m => FromIr a -> m a
runFromIr (FromIr Select -> TxET QErr IO Select)
-> FromIr Select -> TxET QErr IO Select
forall a b. (a -> b) -> a -> b
$ 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 <- FromIr Expression -> TxET QErr IO Expression
forall (m :: * -> *) a. MonadError QErr m => FromIr a -> m a
runFromIr (FromIr Expression -> TxET QErr IO Expression)
-> FromIr Expression -> TxET QErr IO Expression
forall a b. (a -> b) -> a -> b
$ 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 Select) -> With
With (NonEmpty (Aliased Select) -> With)
-> NonEmpty (Aliased Select) -> With
forall a b. (a -> b) -> a -> b
$ Aliased Select -> NonEmpty (Aliased Select)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased Select -> NonEmpty (Aliased Select))
-> Aliased Select -> NonEmpty (Aliased Select)
forall a b. (a -> b) -> a -> b
$ Select -> Text -> Aliased Select
forall a. a -> Text -> Aliased a
Aliased 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 IO (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 IO ()
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 IO () -> TxET QErr IO ()
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 IO () -> TxET QErr IO ())
-> TxET QErr IO () -> TxET QErr IO ()
forall a b. (a -> b) -> a -> b
$
    Code -> Text -> TxET QErr IO ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
PermissionError Text
"check constraint of an update permission has failed"
  EncJSON -> TxET QErr IO EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> TxET QErr IO EncJSON)
-> EncJSON -> TxET QErr IO EncJSON
forall a b. (a -> b) -> a -> b
$ Text -> EncJSON
encJFromText Text
responseText