{-# OPTIONS_HADDOCK ignore-exports #-}

-- | Responsible for translating and building an MSSQL execution plan for
--   delete mutations.
--
--   This module is used by "Hasura.Backends.MSSQL.Instances.Execute".
module Hasura.Backends.MSSQL.Execute.Delete
  ( executeDelete,
  )
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 (tempTableNameDeleted)
import Hasura.Backends.MSSQL.FromIr.Delete qualified as TSQL
import Hasura.Backends.MSSQL.FromIr.MutationResponse
import Hasura.Backends.MSSQL.FromIr.SelectIntoTempTable 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.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.Session

-- | Executes a Delete IR AST and return results as JSON.
executeDelete ::
  (MonadError QErr m, MonadReader QueryTagsComment m) =>
  UserInfo ->
  Options.StringifyNumbers ->
  SourceConfig 'MSSQL ->
  AnnDelG 'MSSQL Void (UnpreparedValue 'MSSQL) ->
  m (OnBaseMonad (ExceptT QErr) EncJSON)
executeDelete :: 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)
deleteOperation = do
  QueryTagsComment
queryTags <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  AnnDelG 'MSSQL Void Expression
preparedDelete <- (UnpreparedValue 'MSSQL -> m Expression)
-> AnnDelG 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (AnnDelG '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) -> AnnDelG 'MSSQL Void a -> f (AnnDelG '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) AnnDelG 'MSSQL Void (UnpreparedValue 'MSSQL)
deleteOperation
  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 (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig) (AnnDel 'MSSQL
-> StringifyNumbers -> QueryTagsComment -> TxET QErr m EncJSON
forall (m :: * -> *).
MonadIO m =>
AnnDel 'MSSQL
-> StringifyNumbers -> QueryTagsComment -> TxET QErr m EncJSON
buildDeleteTx AnnDel 'MSSQL
AnnDelG 'MSSQL Void Expression
preparedDelete StringifyNumbers
stringifyNum QueryTagsComment
queryTags)

-- | Converts a Delete IR AST to a transaction of three delete sql statements.
--
-- A GraphQL delete mutation does two things:
--
-- 1. Deletes rows in a table according to some predicate
-- 2. (Potentially) returns the deleted 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 deleted rows
--    from the table we are deleting
-- 2. @DELETE FROM with OUTPUT@ - deletes the rows from the table and inserts the
--   deleted rows to the temporary table from (1)
-- 3. @SELECT@ - constructs the @returning@ query from the temporary table, including
--   relationships with other tables.
buildDeleteTx ::
  (MonadIO m) =>
  AnnDel 'MSSQL ->
  Options.StringifyNumbers ->
  QueryTagsComment ->
  Tx.TxET QErr m EncJSON
buildDeleteTx :: forall (m :: * -> *).
MonadIO m =>
AnnDel 'MSSQL
-> StringifyNumbers -> QueryTagsComment -> TxET QErr m EncJSON
buildDeleteTx AnnDel 'MSSQL
deleteOperation 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
tempTableNameDeleted (AnnDelG 'MSSQL Void Expression -> TableName 'MSSQL
forall (b :: BackendType) r v. AnnDelG b r v -> TableName b
_adTable AnnDel 'MSSQL
AnnDelG 'MSSQL Void Expression
deleteOperation) (AnnDelG 'MSSQL Void Expression -> [ColumnInfo 'MSSQL]
forall (b :: BackendType) r v. AnnDelG b r v -> [ColumnInfo b]
_adAllCols AnnDel 'MSSQL
AnnDelG 'MSSQL Void Expression
deleteOperation) 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 deleteQuery :: FromIr Printer
deleteQuery = Delete -> Printer
TQ.fromDelete (Delete -> Printer) -> FromIr Delete -> FromIr Printer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnDel 'MSSQL -> FromIr Delete
TSQL.fromDelete AnnDel 'MSSQL
deleteOperation
  Query
deleteQueryValidated <- 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
deleteQuery

  -- Execute DELETE statement
  (MSSQLTxError -> QErr) -> Query -> TxET QErr m ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
mutationMSSQLTxErrorHandler (Query
deleteQueryValidated 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
$ AnnDelG 'MSSQL Void Expression
-> MutationOutputG 'MSSQL Void Expression
forall (b :: BackendType) r v.
AnnDelG b r v -> MutationOutputG b r v
_adOutput AnnDel 'MSSQL
AnnDelG 'MSSQL Void Expression
deleteOperation)

  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
tempTableNameDeleted Text
"deleted_alias"
          }
      finalMutationOutputSelect :: Select
finalMutationOutputSelect = Select
mutationOutputSelect {$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}
      mutationOutputSelectQuery :: Query
mutationOutputSelectQuery = Printer -> Query
toQueryFlat (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$ Select -> Printer
TQ.fromSelect Select
finalMutationOutputSelect

  -- Execute SELECT query and fetch mutation response
  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 (Query
mutationOutputSelectQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)

  -- delete the temporary table
  let dropDeletedTempTableQuery :: Query
dropDeletedTempTableQuery = Printer -> Query
toQueryFlat (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$ TempTableName -> Printer
dropTempTableQuery TempTableName
tempTableNameDeleted
  (MSSQLTxError -> QErr) -> Query -> TxET QErr m ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Query
dropDeletedTempTableQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)
  -- return results
  EncJSON -> TxET QErr m EncJSON
forall a. a -> TxET QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
result