{-# 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.Schema.Options qualified as Options
import Hasura.Prelude
import Hasura.QueryTags (QueryTagsComment)
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend
import Hasura.SQL.Backend
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 (ExceptT QErr IO EncJSON)
executeDelete :: 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)
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)
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
  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 (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig) (AnnDel 'MSSQL
-> StringifyNumbers -> QueryTagsComment -> TxET QErr IO 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 ::
  AnnDel 'MSSQL ->
  Options.StringifyNumbers ->
  QueryTagsComment ->
  Tx.TxET QErr IO EncJSON
buildDeleteTx :: AnnDel 'MSSQL
-> StringifyNumbers -> QueryTagsComment -> TxET QErr IO 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 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 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) -> 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
deleteQuery
  -- Execute DELETE statement
  (MSSQLTxError -> QErr) -> Query -> TxET QErr IO ()
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 <- 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
$ 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 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}
      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 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 (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 IO ()
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 IO EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
result