-- | Postgres Execute Mutation
--
-- Generic combinators for translating and excecuting IR mutation statements.
-- Used by the specific mutation modules, e.g. 'Hasura.Backends.Postgres.Execute.Insert'.
--
-- See 'Hasura.Backends.Postgres.Instances.Execute'.
module Hasura.Backends.Postgres.Execute.Mutation
  ( MutateResp (..),
    --
    execDeleteQuery,
    execInsertQuery,
    execUpdateQuery,
    --
    executeMutationOutputQuery,
    mutateAndFetchCols,
  )
where

import Data.Aeson
import Data.Sequence qualified as DS
import Database.PG.Query qualified as Q
import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Backends.Postgres.Translate.Delete
import Hasura.Backends.Postgres.Translate.Insert
import Hasura.Backends.Postgres.Translate.Mutation
import Hasura.Backends.Postgres.Translate.Returning
import Hasura.Backends.Postgres.Translate.Select
import Hasura.Backends.Postgres.Translate.Update
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Schema.NamingCase (NamingCase)
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.Delete
import Hasura.RQL.IR.Insert
import Hasura.RQL.IR.Returning
import Hasura.RQL.IR.Select
import Hasura.RQL.IR.Update
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.SQL.Backend
import Hasura.SQL.Types
import Hasura.Session

data MutateResp (b :: BackendType) a = MutateResp
  { MutateResp b a -> Int
_mrAffectedRows :: Int,
    MutateResp b a -> [ColumnValues b a]
_mrReturningColumns :: [ColumnValues b a]
  }
  deriving ((forall x. MutateResp b a -> Rep (MutateResp b a) x)
-> (forall x. Rep (MutateResp b a) x -> MutateResp b a)
-> Generic (MutateResp b a)
forall x. Rep (MutateResp b a) x -> MutateResp b a
forall x. MutateResp b a -> Rep (MutateResp b a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) a x.
Rep (MutateResp b a) x -> MutateResp b a
forall (b :: BackendType) a x.
MutateResp b a -> Rep (MutateResp b a) x
$cto :: forall (b :: BackendType) a x.
Rep (MutateResp b a) x -> MutateResp b a
$cfrom :: forall (b :: BackendType) a x.
MutateResp b a -> Rep (MutateResp b a) x
Generic)

deriving instance (Backend b, Show a) => Show (MutateResp b a)

deriving instance (Backend b, Eq a) => Eq (MutateResp b a)

instance (Backend b, ToJSON a) => ToJSON (MutateResp b a) where
  toJSON :: MutateResp b a -> Value
toJSON = Options -> MutateResp b a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

instance (Backend b, FromJSON a) => FromJSON (MutateResp b a) where
  parseJSON :: Value -> Parser (MutateResp b a)
parseJSON = Options -> Value -> Parser (MutateResp b a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

data Mutation (b :: BackendType) = Mutation
  { Mutation b -> QualifiedTable
_mTable :: QualifiedTable,
    Mutation b -> (MutationCTE, Seq PrepArg)
_mQuery :: (MutationCTE, DS.Seq Q.PrepArg),
    Mutation b -> MutationOutput b
_mOutput :: MutationOutput b,
    Mutation b -> [ColumnInfo b]
_mCols :: [ColumnInfo b],
    Mutation b -> StringifyNumbers
_mStrfyNum :: Options.StringifyNumbers,
    Mutation b -> Maybe NamingCase
_mNamingConvention :: Maybe NamingCase
  }

mkMutation ::
  UserInfo ->
  QualifiedTable ->
  (MutationCTE, DS.Seq Q.PrepArg) ->
  MutationOutput ('Postgres pgKind) ->
  [ColumnInfo ('Postgres pgKind)] ->
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  Mutation ('Postgres pgKind)
mkMutation :: UserInfo
-> QualifiedTable
-> (MutationCTE, Seq PrepArg)
-> MutationOutput ('Postgres pgKind)
-> [ColumnInfo ('Postgres pgKind)]
-> StringifyNumbers
-> Maybe NamingCase
-> Mutation ('Postgres pgKind)
mkMutation UserInfo
_userInfo QualifiedTable
table (MutationCTE, Seq PrepArg)
query MutationOutput ('Postgres pgKind)
output [ColumnInfo ('Postgres pgKind)]
allCols StringifyNumbers
strfyNum Maybe NamingCase
tCase =
  QualifiedTable
-> (MutationCTE, Seq PrepArg)
-> MutationOutput ('Postgres pgKind)
-> [ColumnInfo ('Postgres pgKind)]
-> StringifyNumbers
-> Maybe NamingCase
-> Mutation ('Postgres pgKind)
forall (b :: BackendType).
QualifiedTable
-> (MutationCTE, Seq PrepArg)
-> MutationOutput b
-> [ColumnInfo b]
-> StringifyNumbers
-> Maybe NamingCase
-> Mutation b
Mutation QualifiedTable
table (MutationCTE, Seq PrepArg)
query MutationOutput ('Postgres pgKind)
output [ColumnInfo ('Postgres pgKind)]
allCols StringifyNumbers
strfyNum Maybe NamingCase
tCase

runMutation ::
  ( MonadTx m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  Mutation ('Postgres pgKind) ->
  m EncJSON
runMutation :: Mutation ('Postgres pgKind) -> m EncJSON
runMutation Mutation ('Postgres pgKind)
mut =
  m EncJSON -> m EncJSON -> Bool -> m EncJSON
forall a. a -> a -> Bool -> a
bool (Mutation ('Postgres pgKind) -> m EncJSON
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
Mutation ('Postgres pgKind) -> m EncJSON
mutateAndReturn Mutation ('Postgres pgKind)
mut) (Mutation ('Postgres pgKind) -> m EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
Mutation ('Postgres pgKind) -> m EncJSON
mutateAndSel Mutation ('Postgres pgKind)
mut) (Bool -> m EncJSON) -> Bool -> m EncJSON
forall a b. (a -> b) -> a -> b
$
    MutationOutputG ('Postgres pgKind) Void SQLExp -> Bool
forall (backend :: BackendType) r a.
MutationOutputG backend r a -> Bool
hasNestedFld (MutationOutputG ('Postgres pgKind) Void SQLExp -> Bool)
-> MutationOutputG ('Postgres pgKind) Void SQLExp -> Bool
forall a b. (a -> b) -> a -> b
$ Mutation ('Postgres pgKind) -> MutationOutput ('Postgres pgKind)
forall (b :: BackendType). Mutation b -> MutationOutput b
_mOutput Mutation ('Postgres pgKind)
mut

mutateAndReturn ::
  ( MonadTx m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  Mutation ('Postgres pgKind) ->
  m EncJSON
mutateAndReturn :: Mutation ('Postgres pgKind) -> m EncJSON
mutateAndReturn (Mutation QualifiedTable
qt (MutationCTE
cte, Seq PrepArg
p) MutationOutput ('Postgres pgKind)
mutationOutput [ColumnInfo ('Postgres pgKind)]
allCols StringifyNumbers
strfyNum Maybe NamingCase
tCase) =
  QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> Maybe Int
-> MutationCTE
-> MutationOutput ('Postgres pgKind)
-> StringifyNumbers
-> Maybe NamingCase
-> [PrepArg]
-> m EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> Maybe Int
-> MutationCTE
-> MutationOutput ('Postgres pgKind)
-> StringifyNumbers
-> Maybe NamingCase
-> [PrepArg]
-> m EncJSON
executeMutationOutputQuery QualifiedTable
qt [ColumnInfo ('Postgres pgKind)]
allCols Maybe Int
forall a. Maybe a
Nothing MutationCTE
cte MutationOutput ('Postgres pgKind)
mutationOutput StringifyNumbers
strfyNum Maybe NamingCase
tCase (Seq PrepArg -> [PrepArg]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq PrepArg
p)

execUpdateQuery ::
  forall pgKind m.
  ( MonadTx m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  UserInfo ->
  (AnnotatedUpdate ('Postgres pgKind), DS.Seq Q.PrepArg) ->
  m EncJSON
execUpdateQuery :: StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (AnnotatedUpdate ('Postgres pgKind), Seq PrepArg)
-> m EncJSON
execUpdateQuery StringifyNumbers
strfyNum Maybe NamingCase
tCase UserInfo
userInfo (AnnotatedUpdate ('Postgres pgKind)
u, Seq PrepArg
p) =
  case UpdateCTE
updateCTE of
    Update TopLevelCTE
singleUpdate -> TopLevelCTE -> m EncJSON
runCTE TopLevelCTE
singleUpdate
    MultiUpdate [TopLevelCTE]
ctes -> [EncJSON] -> EncJSON
encJFromList ([EncJSON] -> EncJSON) -> m [EncJSON] -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TopLevelCTE -> m EncJSON) -> [TopLevelCTE] -> m [EncJSON]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TopLevelCTE -> m EncJSON
runCTE [TopLevelCTE]
ctes
  where
    updateCTE :: UpdateCTE
    updateCTE :: UpdateCTE
updateCTE = AnnotatedUpdate ('Postgres pgKind) -> UpdateCTE
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnotatedUpdate ('Postgres pgKind) -> UpdateCTE
mkUpdateCTE AnnotatedUpdate ('Postgres pgKind)
u

    runCTE :: S.TopLevelCTE -> m EncJSON
    runCTE :: TopLevelCTE -> m EncJSON
runCTE TopLevelCTE
cte =
      Mutation ('Postgres pgKind) -> m EncJSON
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
Mutation ('Postgres pgKind) -> m EncJSON
runMutation
        (UserInfo
-> QualifiedTable
-> (MutationCTE, Seq PrepArg)
-> MutationOutput ('Postgres pgKind)
-> [ColumnInfo ('Postgres pgKind)]
-> StringifyNumbers
-> Maybe NamingCase
-> Mutation ('Postgres pgKind)
forall (pgKind :: PostgresKind).
UserInfo
-> QualifiedTable
-> (MutationCTE, Seq PrepArg)
-> MutationOutput ('Postgres pgKind)
-> [ColumnInfo ('Postgres pgKind)]
-> StringifyNumbers
-> Maybe NamingCase
-> Mutation ('Postgres pgKind)
mkMutation UserInfo
userInfo (AnnotatedUpdateG ('Postgres pgKind) Void SQLExp
-> TableName ('Postgres pgKind)
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> TableName b
_auTable AnnotatedUpdate ('Postgres pgKind)
AnnotatedUpdateG ('Postgres pgKind) Void SQLExp
u) (TopLevelCTE -> MutationCTE
MCCheckConstraint TopLevelCTE
cte, Seq PrepArg
p) (AnnotatedUpdateG ('Postgres pgKind) Void SQLExp
-> MutationOutputG ('Postgres pgKind) Void SQLExp
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> MutationOutputG b r v
_auOutput AnnotatedUpdate ('Postgres pgKind)
AnnotatedUpdateG ('Postgres pgKind) Void SQLExp
u) (AnnotatedUpdateG ('Postgres pgKind) Void SQLExp
-> [ColumnInfo ('Postgres pgKind)]
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> [ColumnInfo b]
_auAllCols AnnotatedUpdate ('Postgres pgKind)
AnnotatedUpdateG ('Postgres pgKind) Void SQLExp
u) StringifyNumbers
strfyNum Maybe NamingCase
tCase)

execDeleteQuery ::
  forall pgKind m.
  ( MonadTx m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  UserInfo ->
  (AnnDel ('Postgres pgKind), DS.Seq Q.PrepArg) ->
  m EncJSON
execDeleteQuery :: StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (AnnDel ('Postgres pgKind), Seq PrepArg)
-> m EncJSON
execDeleteQuery StringifyNumbers
strfyNum Maybe NamingCase
tCase UserInfo
userInfo (AnnDel ('Postgres pgKind)
u, Seq PrepArg
p) =
  Mutation ('Postgres pgKind) -> m EncJSON
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
Mutation ('Postgres pgKind) -> m EncJSON
runMutation
    (UserInfo
-> QualifiedTable
-> (MutationCTE, Seq PrepArg)
-> MutationOutput ('Postgres pgKind)
-> [ColumnInfo ('Postgres pgKind)]
-> StringifyNumbers
-> Maybe NamingCase
-> Mutation ('Postgres pgKind)
forall (pgKind :: PostgresKind).
UserInfo
-> QualifiedTable
-> (MutationCTE, Seq PrepArg)
-> MutationOutput ('Postgres pgKind)
-> [ColumnInfo ('Postgres pgKind)]
-> StringifyNumbers
-> Maybe NamingCase
-> Mutation ('Postgres pgKind)
mkMutation UserInfo
userInfo (AnnDelG ('Postgres pgKind) Void SQLExp
-> TableName ('Postgres pgKind)
forall (b :: BackendType) r v. AnnDelG b r v -> TableName b
_adTable AnnDel ('Postgres pgKind)
AnnDelG ('Postgres pgKind) Void SQLExp
u) (SQLDelete -> MutationCTE
MCDelete SQLDelete
delete, Seq PrepArg
p) (AnnDelG ('Postgres pgKind) Void SQLExp
-> MutationOutputG ('Postgres pgKind) Void SQLExp
forall (b :: BackendType) r v.
AnnDelG b r v -> MutationOutputG b r v
_adOutput AnnDel ('Postgres pgKind)
AnnDelG ('Postgres pgKind) Void SQLExp
u) (AnnDelG ('Postgres pgKind) Void SQLExp
-> [ColumnInfo ('Postgres pgKind)]
forall (b :: BackendType) r v. AnnDelG b r v -> [ColumnInfo b]
_adAllCols AnnDel ('Postgres pgKind)
AnnDelG ('Postgres pgKind) Void SQLExp
u) StringifyNumbers
strfyNum Maybe NamingCase
tCase)
  where
    delete :: SQLDelete
delete = AnnDel ('Postgres pgKind) -> SQLDelete
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnDel ('Postgres pgKind) -> SQLDelete
mkDelete AnnDel ('Postgres pgKind)
u

execInsertQuery ::
  ( MonadTx m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  UserInfo ->
  (InsertQueryP1 ('Postgres pgKind), DS.Seq Q.PrepArg) ->
  m EncJSON
execInsertQuery :: StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (InsertQueryP1 ('Postgres pgKind), Seq PrepArg)
-> m EncJSON
execInsertQuery StringifyNumbers
strfyNum Maybe NamingCase
tCase UserInfo
userInfo (InsertQueryP1 ('Postgres pgKind)
u, Seq PrepArg
p) =
  Mutation ('Postgres pgKind) -> m EncJSON
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
Mutation ('Postgres pgKind) -> m EncJSON
runMutation
    (UserInfo
-> QualifiedTable
-> (MutationCTE, Seq PrepArg)
-> MutationOutput ('Postgres pgKind)
-> [ColumnInfo ('Postgres pgKind)]
-> StringifyNumbers
-> Maybe NamingCase
-> Mutation ('Postgres pgKind)
forall (pgKind :: PostgresKind).
UserInfo
-> QualifiedTable
-> (MutationCTE, Seq PrepArg)
-> MutationOutput ('Postgres pgKind)
-> [ColumnInfo ('Postgres pgKind)]
-> StringifyNumbers
-> Maybe NamingCase
-> Mutation ('Postgres pgKind)
mkMutation UserInfo
userInfo (InsertQueryP1 ('Postgres pgKind) -> TableName ('Postgres pgKind)
forall (b :: BackendType). InsertQueryP1 b -> TableName b
iqp1Table InsertQueryP1 ('Postgres pgKind)
u) (TopLevelCTE -> MutationCTE
MCCheckConstraint TopLevelCTE
insertCTE, Seq PrepArg
p) (InsertQueryP1 ('Postgres pgKind)
-> MutationOutput ('Postgres pgKind)
forall (b :: BackendType). InsertQueryP1 b -> MutationOutput b
iqp1Output InsertQueryP1 ('Postgres pgKind)
u) (InsertQueryP1 ('Postgres pgKind) -> [ColumnInfo ('Postgres pgKind)]
forall (b :: BackendType). InsertQueryP1 b -> [ColumnInfo b]
iqp1AllCols InsertQueryP1 ('Postgres pgKind)
u) StringifyNumbers
strfyNum Maybe NamingCase
tCase)
  where
    insertCTE :: TopLevelCTE
insertCTE = InsertQueryP1 ('Postgres pgKind) -> TopLevelCTE
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
InsertQueryP1 ('Postgres pgKind) -> TopLevelCTE
mkInsertCTE InsertQueryP1 ('Postgres pgKind)
u

{- Note: [Prepared statements in Mutations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The SQL statements we generate for mutations seem to include the actual values
in the statements in some cases which pretty much makes them unfit for reuse
(Handling relationships in the returning clause is the source of this
complexity). Further, `PGConn` has an internal cache which maps a statement to
a 'prepared statement id' on Postgres. As we prepare more and more single-use
SQL statements we end up leaking memory both on graphql-engine and Postgres
till the connection is closed. So a simpler but very crude fix is to not use
prepared statements for mutations. The performance of insert mutations
shouldn't be affected but updates and delete mutations with complex boolean
conditions **might** see some degradation.
-}

mutateAndSel ::
  forall pgKind m.
  ( MonadTx m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  Mutation ('Postgres pgKind) ->
  m EncJSON
mutateAndSel :: Mutation ('Postgres pgKind) -> m EncJSON
mutateAndSel (Mutation QualifiedTable
qt (MutationCTE, Seq PrepArg)
q MutationOutput ('Postgres pgKind)
mutationOutput [ColumnInfo ('Postgres pgKind)]
allCols StringifyNumbers
strfyNum Maybe NamingCase
tCase) = do
  -- Perform mutation and fetch unique columns
  MutateResp Int
_ [ColumnValues ('Postgres pgKind) TxtEncodedVal]
columnVals <- TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
-> m (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
 -> m (MutateResp ('Postgres pgKind) TxtEncodedVal))
-> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
-> m (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall a b. (a -> b) -> a -> b
$ QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> (MutationCTE, Seq PrepArg)
-> StringifyNumbers
-> Maybe NamingCase
-> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> (MutationCTE, Seq PrepArg)
-> StringifyNumbers
-> Maybe NamingCase
-> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
mutateAndFetchCols QualifiedTable
qt [ColumnInfo ('Postgres pgKind)]
allCols (MutationCTE, Seq PrepArg)
q StringifyNumbers
strfyNum Maybe NamingCase
tCase
  Select
select <- QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> [ColumnValues ('Postgres pgKind) TxtEncodedVal]
-> m Select
forall (pgKind :: PostgresKind) (m :: * -> *).
MonadError QErr m =>
QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> [ColumnValues ('Postgres pgKind) TxtEncodedVal]
-> m Select
mkSelectExpFromColumnValues QualifiedTable
qt [ColumnInfo ('Postgres pgKind)]
allCols [ColumnValues ('Postgres pgKind) TxtEncodedVal]
columnVals
  -- Perform select query and fetch returning fields
  QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> Maybe Int
-> MutationCTE
-> MutationOutput ('Postgres pgKind)
-> StringifyNumbers
-> Maybe NamingCase
-> [PrepArg]
-> m EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> Maybe Int
-> MutationCTE
-> MutationOutput ('Postgres pgKind)
-> StringifyNumbers
-> Maybe NamingCase
-> [PrepArg]
-> m EncJSON
executeMutationOutputQuery
    QualifiedTable
qt
    [ColumnInfo ('Postgres pgKind)]
allCols
    Maybe Int
forall a. Maybe a
Nothing
    (Select -> MutationCTE
MCSelectValues Select
select)
    MutationOutput ('Postgres pgKind)
mutationOutput
    StringifyNumbers
strfyNum
    Maybe NamingCase
tCase
    []

withCheckPermission :: (MonadError QErr m) => m (a, Bool) -> m a
withCheckPermission :: m (a, Bool) -> m a
withCheckPermission m (a, Bool)
sqlTx = do
  (a
rawResponse, Bool
checkConstraint) <- m (a, Bool)
sqlTx
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
checkConstraint (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
PermissionError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text
"check constraint of an insert/update permission has failed"
  a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
rawResponse

executeMutationOutputQuery ::
  forall pgKind m.
  ( MonadTx m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  QualifiedTable ->
  [ColumnInfo ('Postgres pgKind)] ->
  Maybe Int ->
  MutationCTE ->
  MutationOutput ('Postgres pgKind) ->
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  -- | Prepared params
  [Q.PrepArg] ->
  m EncJSON
executeMutationOutputQuery :: QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> Maybe Int
-> MutationCTE
-> MutationOutput ('Postgres pgKind)
-> StringifyNumbers
-> Maybe NamingCase
-> [PrepArg]
-> m EncJSON
executeMutationOutputQuery QualifiedTable
qt [ColumnInfo ('Postgres pgKind)]
allCols Maybe Int
preCalAffRows MutationCTE
cte MutationOutput ('Postgres pgKind)
mutOutput StringifyNumbers
strfyNum Maybe NamingCase
tCase [PrepArg]
prepArgs = do
  QueryTagsComment
queryTags <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  let queryTx :: Q.FromRes a => m a
      queryTx :: m a
queryTx = do
        let selectWith :: SelectWith
selectWith = QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> Maybe Int
-> MutationCTE
-> MutationOutput ('Postgres pgKind)
-> StringifyNumbers
-> Maybe NamingCase
-> SelectWith
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> Maybe Int
-> MutationCTE
-> MutationOutput ('Postgres pgKind)
-> StringifyNumbers
-> Maybe NamingCase
-> SelectWith
mkMutationOutputExp QualifiedTable
qt [ColumnInfo ('Postgres pgKind)]
allCols Maybe Int
preCalAffRows MutationCTE
cte MutationOutput ('Postgres pgKind)
mutOutput StringifyNumbers
strfyNum Maybe NamingCase
tCase
            query :: Query
query = Builder -> Query
Q.fromBuilder (Builder -> Query) -> Builder -> Query
forall a b. (a -> b) -> a -> b
$ SelectWith -> Builder
forall a. ToSQL a => a -> Builder
toSQL SelectWith
selectWith
            queryWithQueryTags :: Query
queryWithQueryTags = Query
query {getQueryText :: Text
Q.getQueryText = (Query -> Text
Q.getQueryText Query
query) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (QueryTagsComment -> Text
_unQueryTagsComment QueryTagsComment
queryTags)}
        -- See Note [Prepared statements in Mutations]
        TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx ((PGTxErr -> QErr) -> Query -> [PrepArg] -> Bool -> TxE QErr a
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> [PrepArg] -> Bool -> TxET e m a
Q.rawQE PGTxErr -> QErr
dmlTxErrorHandler Query
queryWithQueryTags [PrepArg]
prepArgs Bool
False)

  if MutationCTE -> Bool
checkPermissionRequired MutationCTE
cte
    then m (EncJSON, Bool) -> m EncJSON
forall (m :: * -> *) a. MonadError QErr m => m (a, Bool) -> m a
withCheckPermission (m (EncJSON, Bool) -> m EncJSON) -> m (EncJSON, Bool) -> m EncJSON
forall a b. (a -> b) -> a -> b
$ (ByteString -> EncJSON) -> (ByteString, Bool) -> (EncJSON, Bool)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> EncJSON
encJFromBS ((ByteString, Bool) -> (EncJSON, Bool))
-> (SingleRow (ByteString, Bool) -> (ByteString, Bool))
-> SingleRow (ByteString, Bool)
-> (EncJSON, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (ByteString, Bool) -> (ByteString, Bool)
forall a. SingleRow a -> a
Q.getRow (SingleRow (ByteString, Bool) -> (EncJSON, Bool))
-> m (SingleRow (ByteString, Bool)) -> m (EncJSON, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (SingleRow (ByteString, Bool))
forall a. FromRes a => m a
queryTx
    else ByteString -> EncJSON
encJFromBS (ByteString -> EncJSON)
-> (SingleRow (Identity ByteString) -> ByteString)
-> SingleRow (Identity ByteString)
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity (Identity ByteString -> ByteString)
-> (SingleRow (Identity ByteString) -> Identity ByteString)
-> SingleRow (Identity ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity ByteString) -> Identity ByteString
forall a. SingleRow a -> a
Q.getRow (SingleRow (Identity ByteString) -> EncJSON)
-> m (SingleRow (Identity ByteString)) -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (SingleRow (Identity ByteString))
forall a. FromRes a => m a
queryTx

mutateAndFetchCols ::
  forall pgKind.
  (Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
  QualifiedTable ->
  [ColumnInfo ('Postgres pgKind)] ->
  (MutationCTE, DS.Seq Q.PrepArg) ->
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  Q.TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
mutateAndFetchCols :: QualifiedTable
-> [ColumnInfo ('Postgres pgKind)]
-> (MutationCTE, Seq PrepArg)
-> StringifyNumbers
-> Maybe NamingCase
-> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
mutateAndFetchCols QualifiedTable
qt [ColumnInfo ('Postgres pgKind)]
cols (MutationCTE
cte, Seq PrepArg
p) StringifyNumbers
strfyNum Maybe NamingCase
tCase = do
  let mutationTx :: Q.FromRes a => Q.TxE QErr a
      mutationTx :: TxE QErr a
mutationTx =
        -- See Note [Prepared statements in Mutations]
        (PGTxErr -> QErr) -> Query -> [PrepArg] -> Bool -> TxE QErr a
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> [PrepArg] -> Bool -> TxET e m a
Q.rawQE PGTxErr -> QErr
dmlTxErrorHandler Query
sqlText (Seq PrepArg -> [PrepArg]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq PrepArg
p) Bool
False

  if MutationCTE -> Bool
checkPermissionRequired MutationCTE
cte
    then TxET QErr IO (MutateResp ('Postgres pgKind) TxtEncodedVal, Bool)
-> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall (m :: * -> *) a. MonadError QErr m => m (a, Bool) -> m a
withCheckPermission (TxET QErr IO (MutateResp ('Postgres pgKind) TxtEncodedVal, Bool)
 -> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal))
-> TxET QErr IO (MutateResp ('Postgres pgKind) TxtEncodedVal, Bool)
-> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall a b. (a -> b) -> a -> b
$ ((AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)
 -> MutateResp ('Postgres pgKind) TxtEncodedVal)
-> (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal), Bool)
-> (MutateResp ('Postgres pgKind) TxtEncodedVal, Bool)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)
-> MutateResp ('Postgres pgKind) TxtEncodedVal
forall a. AltJ a -> a
Q.getAltJ ((AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal), Bool)
 -> (MutateResp ('Postgres pgKind) TxtEncodedVal, Bool))
-> (SingleRow
      (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal), Bool)
    -> (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal), Bool))
-> SingleRow
     (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal), Bool)
-> (MutateResp ('Postgres pgKind) TxtEncodedVal, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow
  (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal), Bool)
-> (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal), Bool)
forall a. SingleRow a -> a
Q.getRow) (SingleRow
   (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal), Bool)
 -> (MutateResp ('Postgres pgKind) TxtEncodedVal, Bool))
-> TxET
     QErr
     IO
     (SingleRow
        (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal), Bool))
-> TxET QErr IO (MutateResp ('Postgres pgKind) TxtEncodedVal, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxET
  QErr
  IO
  (SingleRow
     (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal), Bool))
forall a. FromRes a => TxE QErr a
mutationTx
    else (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)
-> MutateResp ('Postgres pgKind) TxtEncodedVal
forall a. AltJ a -> a
Q.getAltJ (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)
 -> MutateResp ('Postgres pgKind) TxtEncodedVal)
-> (SingleRow
      (Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)))
    -> AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal))
-> SingleRow
     (Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)))
-> MutateResp ('Postgres pgKind) TxtEncodedVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal))
-> AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall a. Identity a -> a
runIdentity (Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal))
 -> AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal))
-> (SingleRow
      (Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)))
    -> Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)))
-> SingleRow
     (Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)))
-> AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow
  (Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)))
-> Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal))
forall a. SingleRow a -> a
Q.getRow) (SingleRow
   (Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal)))
 -> MutateResp ('Postgres pgKind) TxtEncodedVal)
-> TxET
     QErr
     IO
     (SingleRow
        (Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal))))
-> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxET
  QErr
  IO
  (SingleRow
     (Identity (AltJ (MutateResp ('Postgres pgKind) TxtEncodedVal))))
forall a. FromRes a => TxE QErr a
mutationTx
  where
    rawAliasIdentifier :: Text
rawAliasIdentifier = Text
"mutres__" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedTable -> Text
forall a. ToTxt a => QualifiedObject a -> Text
qualifiedObjectToText QualifiedTable
qt
    aliasIdentifier :: Identifier
aliasIdentifier = Text -> Identifier
Identifier Text
rawAliasIdentifier
    tabFrom :: SelectFromG ('Postgres pgKind) SQLExp
tabFrom = FIIdentifier -> SelectFromG ('Postgres pgKind) SQLExp
forall (b :: BackendType) v. FIIdentifier -> SelectFromG b v
FromIdentifier (FIIdentifier -> SelectFromG ('Postgres pgKind) SQLExp)
-> FIIdentifier -> SelectFromG ('Postgres pgKind) SQLExp
forall a b. (a -> b) -> a -> b
$ Text -> FIIdentifier
FIIdentifier Text
rawAliasIdentifier
    tabPerm :: TablePermG b v
tabPerm = AnnBoolExp b v -> Maybe Int -> TablePermG b v
forall (b :: BackendType) v.
AnnBoolExp b v -> Maybe Int -> TablePermG b v
TablePerm AnnBoolExp b v
forall (backend :: BackendType) scalar. AnnBoolExp backend scalar
annBoolExpTrue Maybe Int
forall a. Maybe a
Nothing
    selFlds :: [(FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp)]
selFlds = ((ColumnInfo ('Postgres pgKind)
  -> (FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp))
 -> [ColumnInfo ('Postgres pgKind)]
 -> [(FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp)])
-> [ColumnInfo ('Postgres pgKind)]
-> (ColumnInfo ('Postgres pgKind)
    -> (FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp))
-> [(FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ColumnInfo ('Postgres pgKind)
 -> (FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp))
-> [ColumnInfo ('Postgres pgKind)]
-> [(FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp)]
forall a b. (a -> b) -> [a] -> [b]
map [ColumnInfo ('Postgres pgKind)]
cols ((ColumnInfo ('Postgres pgKind)
  -> (FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp))
 -> [(FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp)])
-> (ColumnInfo ('Postgres pgKind)
    -> (FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp))
-> [(FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp)]
forall a b. (a -> b) -> a -> b
$
      \ColumnInfo ('Postgres pgKind)
ci -> (Backend ('Postgres pgKind) =>
Column ('Postgres pgKind) -> FieldName
forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol @('Postgres pgKind) (Column ('Postgres pgKind) -> FieldName)
-> Column ('Postgres pgKind) -> FieldName
forall a b. (a -> b) -> a -> b
$ ColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres pgKind)
ci, ColumnInfo ('Postgres pgKind)
-> AnnFieldG ('Postgres pgKind) Void SQLExp
forall (backend :: BackendType) r v.
ColumnInfo backend -> AnnFieldG backend r v
mkAnnColumnFieldAsText ColumnInfo ('Postgres pgKind)
ci)

    sqlText :: Query
sqlText = Builder -> Query
Q.fromBuilder (Builder -> Query) -> Builder -> Query
forall a b. (a -> b) -> a -> b
$ SelectWith -> Builder
forall a. ToSQL a => a -> Builder
toSQL SelectWith
selectWith
    selectWith :: SelectWith
selectWith = [(TableAlias, TopLevelCTE)] -> Select -> SelectWith
forall statement.
[(TableAlias, statement)] -> Select -> SelectWithG statement
S.SelectWith [(Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias Identifier
aliasIdentifier, MutationCTE -> TopLevelCTE
getMutationCTE MutationCTE
cte)] Select
select
    select :: Select
select =
      Select
S.mkSelect
        { selExtr :: [Extractor]
S.selExtr =
            SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor SQLExp
extrExp Maybe ColumnAlias
forall a. Maybe a
Nothing Extractor -> [Extractor] -> [Extractor]
forall a. a -> [a] -> [a]
:
            [Extractor] -> [Extractor] -> Bool -> [Extractor]
forall a. a -> a -> Bool -> a
bool [] [SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor SQLExp
checkErrExp Maybe ColumnAlias
forall a. Maybe a
Nothing] (MutationCTE -> Bool
checkPermissionRequired MutationCTE
cte)
        }
    checkErrExp :: SQLExp
checkErrExp = Identifier -> SQLExp
forall a. IsIdentifier a => a -> SQLExp
mkCheckErrorExp Identifier
aliasIdentifier
    extrExp :: SQLExp
extrExp =
      [SQLExp] -> SQLExp
S.applyJsonBuildObj
        [ Text -> SQLExp
S.SELit Text
"affected_rows",
          SQLExp
affRowsSel,
          Text -> SQLExp
S.SELit Text
"returning_columns",
          SQLExp
colSel
        ]

    affRowsSel :: SQLExp
affRowsSel =
      Select -> SQLExp
S.SESelect (Select -> SQLExp) -> Select -> SQLExp
forall a b. (a -> b) -> a -> b
$
        Select
S.mkSelect
          { selExtr :: [Extractor]
S.selExtr = [SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor SQLExp
S.countStar Maybe ColumnAlias
forall a. Maybe a
Nothing],
            selFrom :: Maybe FromExp
S.selFrom = FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just (FromExp -> Maybe FromExp) -> FromExp -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$ [FromItem] -> FromExp
S.FromExp [Identifier -> FromItem
S.FIIdentifier Identifier
aliasIdentifier]
          }
    colSel :: SQLExp
colSel =
      Select -> SQLExp
S.SESelect (Select -> SQLExp) -> Select -> SQLExp
forall a b. (a -> b) -> a -> b
$
        JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Select
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Select
mkSQLSelect JsonAggSelect
JASMultipleRows (AnnSimpleSelect ('Postgres pgKind) -> Select)
-> AnnSimpleSelect ('Postgres pgKind) -> Select
forall a b. (a -> b) -> a -> b
$
          [(FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp)]
-> SelectFromG ('Postgres pgKind) SQLExp
-> TablePermG ('Postgres pgKind) SQLExp
-> SelectArgsG ('Postgres pgKind) SQLExp
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG
     ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp
forall (b :: BackendType) (f :: * -> *) v.
Fields (f v)
-> SelectFromG b v
-> TablePermG b v
-> SelectArgsG b v
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG b f v
AnnSelectG [(FieldName, AnnFieldG ('Postgres pgKind) Void SQLExp)]
selFlds SelectFromG ('Postgres pgKind) SQLExp
tabFrom TablePermG ('Postgres pgKind) SQLExp
forall (b :: BackendType) v. TablePermG b v
tabPerm SelectArgsG ('Postgres pgKind) SQLExp
forall (backend :: BackendType) v. SelectArgsG backend v
noSelectArgs StringifyNumbers
strfyNum Maybe NamingCase
tCase