module Hasura.RQL.DML.Update
  ( runUpdate,
  )
where

import Control.Lens ((^?))
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson.Types
import Data.HashMap.Strict qualified as HashMap
import Data.Sequence qualified as DS
import Data.Text.Extended
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.Execute.Mutation
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.Translate.Returning
import Hasura.Backends.Postgres.Types.Table
import Hasura.Backends.Postgres.Types.Update
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.DML.Internal
import Hasura.RQL.DML.Types
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.Update
import Hasura.RQL.IR.Update.Batch
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.SchemaCache
import Hasura.SQL.Types
import Hasura.Session
import Hasura.Table.Cache
import Hasura.Tracing qualified as Tracing

convInc ::
  (QErrM m) =>
  ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
  PGCol ->
  ColumnType ('Postgres 'Vanilla) ->
  Value ->
  m (PGCol, S.SQLExp)
convInc :: forall (m :: * -> *).
QErrM m =>
ValueParser ('Postgres 'Vanilla) m SQLExp
-> PGCol
-> ColumnType ('Postgres 'Vanilla)
-> Value
-> m (PGCol, SQLExp)
convInc ValueParser ('Postgres 'Vanilla) m SQLExp
f PGCol
col ColumnType ('Postgres 'Vanilla)
colType Value
val = do
  SQLExp
prepExp <- ValueParser ('Postgres 'Vanilla) m SQLExp
f (ColumnType ('Postgres 'Vanilla)
-> CollectableType (ColumnType ('Postgres 'Vanilla))
forall a. a -> CollectableType a
CollectableTypeScalar ColumnType ('Postgres 'Vanilla)
colType) Value
val
  (PGCol, SQLExp) -> m (PGCol, SQLExp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PGCol
col, SQLOp -> [SQLExp] -> SQLExp
S.SEOpApp SQLOp
S.incOp [PGCol -> SQLExp
forall a. IsIdentifier a => a -> SQLExp
S.mkSIdenExp PGCol
col, SQLExp
prepExp])

convMul ::
  (QErrM m) =>
  ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
  PGCol ->
  ColumnType ('Postgres 'Vanilla) ->
  Value ->
  m (PGCol, S.SQLExp)
convMul :: forall (m :: * -> *).
QErrM m =>
ValueParser ('Postgres 'Vanilla) m SQLExp
-> PGCol
-> ColumnType ('Postgres 'Vanilla)
-> Value
-> m (PGCol, SQLExp)
convMul ValueParser ('Postgres 'Vanilla) m SQLExp
f PGCol
col ColumnType ('Postgres 'Vanilla)
colType Value
val = do
  SQLExp
prepExp <- ValueParser ('Postgres 'Vanilla) m SQLExp
f (ColumnType ('Postgres 'Vanilla)
-> CollectableType (ColumnType ('Postgres 'Vanilla))
forall a. a -> CollectableType a
CollectableTypeScalar ColumnType ('Postgres 'Vanilla)
colType) Value
val
  (PGCol, SQLExp) -> m (PGCol, SQLExp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PGCol
col, SQLOp -> [SQLExp] -> SQLExp
S.SEOpApp SQLOp
S.mulOp [PGCol -> SQLExp
forall a. IsIdentifier a => a -> SQLExp
S.mkSIdenExp PGCol
col, SQLExp
prepExp])

convSet ::
  (QErrM m) =>
  ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
  PGCol ->
  ColumnType ('Postgres 'Vanilla) ->
  Value ->
  m (PGCol, S.SQLExp)
convSet :: forall (m :: * -> *).
QErrM m =>
ValueParser ('Postgres 'Vanilla) m SQLExp
-> PGCol
-> ColumnType ('Postgres 'Vanilla)
-> Value
-> m (PGCol, SQLExp)
convSet ValueParser ('Postgres 'Vanilla) m SQLExp
f PGCol
col ColumnType ('Postgres 'Vanilla)
colType Value
val = do
  SQLExp
prepExp <- ValueParser ('Postgres 'Vanilla) m SQLExp
f (ColumnType ('Postgres 'Vanilla)
-> CollectableType (ColumnType ('Postgres 'Vanilla))
forall a. a -> CollectableType a
CollectableTypeScalar ColumnType ('Postgres 'Vanilla)
colType) Value
val
  (PGCol, SQLExp) -> m (PGCol, SQLExp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PGCol
col, SQLExp
prepExp)

convDefault :: (Monad m) => PGCol -> ColumnType ('Postgres 'Vanilla) -> () -> m (PGCol, S.SQLExp)
convDefault :: forall (m :: * -> *).
Monad m =>
PGCol -> ColumnType ('Postgres 'Vanilla) -> () -> m (PGCol, SQLExp)
convDefault PGCol
col ColumnType ('Postgres 'Vanilla)
_ ()
_ = (PGCol, SQLExp) -> m (PGCol, SQLExp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PGCol
col, Text -> SQLExp
S.SEUnsafe Text
"DEFAULT")

convOp ::
  (UserInfoM m, QErrM m) =>
  FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
  [PGCol] ->
  UpdPermInfo ('Postgres 'Vanilla) ->
  [(PGCol, a)] ->
  (PGCol -> ColumnType ('Postgres 'Vanilla) -> a -> m (PGCol, S.SQLExp)) ->
  m [(PGCol, S.SQLExp)]
convOp :: forall (m :: * -> *) a.
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [PGCol]
-> UpdPermInfo ('Postgres 'Vanilla)
-> [(PGCol, a)]
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> a -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
convOp FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap [PGCol]
preSetCols UpdPermInfo ('Postgres 'Vanilla)
updPerm [(PGCol, a)]
objs PGCol -> ColumnType ('Postgres 'Vanilla) -> a -> m (PGCol, SQLExp)
conv =
  [(PGCol, a)]
-> ((PGCol, a) -> m (PGCol, SQLExp)) -> m [(PGCol, SQLExp)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(PGCol, a)]
objs (((PGCol, a) -> m (PGCol, SQLExp)) -> m [(PGCol, SQLExp)])
-> ((PGCol, a) -> m (PGCol, SQLExp)) -> m [(PGCol, SQLExp)]
forall a b. (a -> b) -> a -> b
$ \(PGCol
pgCol, a
a) -> do
    -- if column has predefined value then throw error
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PGCol
pgCol PGCol -> [PGCol] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PGCol]
preSetCols) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PGCol -> m ()
forall {m :: * -> *} {t} {b}.
(UserInfoM m, MonadError QErr m, ToTxt t) =>
t -> m b
throwNotUpdErr PGCol
pgCol
    PermType
-> HashSet (Column ('Postgres 'Vanilla))
-> Column ('Postgres 'Vanilla)
-> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
PermType
-> HashSet (Column ('Postgres 'Vanilla))
-> Column ('Postgres 'Vanilla)
-> m ()
checkPermOnCol PermType
PTUpdate HashSet (Column ('Postgres 'Vanilla))
allowedCols Column ('Postgres 'Vanilla)
PGCol
pgCol
    ColumnType ('Postgres 'Vanilla)
colType <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> Column ('Postgres 'Vanilla)
-> Text
-> m (ColumnType ('Postgres 'Vanilla))
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnType backend)
askColumnType FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap Column ('Postgres 'Vanilla)
PGCol
pgCol Text
relWhenPgErr
    (PGCol, SQLExp)
res <- PGCol -> ColumnType ('Postgres 'Vanilla) -> a -> m (PGCol, SQLExp)
conv PGCol
pgCol ColumnType ('Postgres 'Vanilla)
colType a
a
    -- build a set expression's entry
    Text -> m (PGCol, SQLExp) -> m (PGCol, SQLExp)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK (PGCol -> Text
getPGColTxt PGCol
pgCol) (m (PGCol, SQLExp) -> m (PGCol, SQLExp))
-> m (PGCol, SQLExp) -> m (PGCol, SQLExp)
forall a b. (a -> b) -> a -> b
$ (PGCol, SQLExp) -> m (PGCol, SQLExp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PGCol, SQLExp)
res
  where
    allowedCols :: HashSet (Column ('Postgres 'Vanilla))
allowedCols = UpdPermInfo ('Postgres 'Vanilla)
-> HashSet (Column ('Postgres 'Vanilla))
forall (b :: BackendType). UpdPermInfo b -> HashSet (Column b)
upiCols UpdPermInfo ('Postgres 'Vanilla)
updPerm
    relWhenPgErr :: Text
relWhenPgErr = Text
"relationships can't be updated"
    throwNotUpdErr :: t -> m b
throwNotUpdErr t
c = do
      RoleName
roleName <- UserInfo -> RoleName
_uiRole (UserInfo -> RoleName) -> m UserInfo -> m RoleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UserInfo
forall (m :: * -> *). UserInfoM m => m UserInfo
askUserInfo
      Code -> Text -> m b
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported
        (Text -> m b) -> Text -> m b
forall a b. (a -> b) -> a -> b
$ Text
"column "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> t
c
        t -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not updatable"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for role "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
roleName
        RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"; its value is predefined in permission"

validateUpdateQueryWith ::
  (UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
  SessionVariableBuilder m ->
  ValueParser ('Postgres 'Vanilla) m S.SQLExp ->
  UpdateQuery ->
  m (AnnotatedUpdate ('Postgres 'Vanilla))
validateUpdateQueryWith :: forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> UpdateQuery
-> m (AnnotatedUpdate ('Postgres 'Vanilla))
validateUpdateQueryWith SessionVariableBuilder m
sessVarBldr ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr UpdateQuery
uq = do
  let tableName :: QualifiedTable
tableName = UpdateQuery -> QualifiedTable
uqTable UpdateQuery
uq
  TableInfo ('Postgres 'Vanilla)
tableInfo <- Text
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"table" (m (TableInfo ('Postgres 'Vanilla))
 -> m (TableInfo ('Postgres 'Vanilla)))
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
TableName ('Postgres 'Vanilla)
-> m (TableInfo ('Postgres 'Vanilla))
askTableInfoSource TableName ('Postgres 'Vanilla)
QualifiedTable
tableName
  let coreInfo :: TableCoreInfo ('Postgres 'Vanilla)
coreInfo = TableInfo ('Postgres 'Vanilla)
-> TableCoreInfo ('Postgres 'Vanilla)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Vanilla)
tableInfo

  -- If it is view then check if it is updatable
  QualifiedTable
-> (ViewInfo -> Bool) -> Maybe ViewInfo -> Text -> m ()
forall (m :: * -> *).
MonadError QErr m =>
QualifiedTable
-> (ViewInfo -> Bool) -> Maybe ViewInfo -> Text -> m ()
mutableView
    QualifiedTable
tableName
    ViewInfo -> Bool
viIsUpdatable
    (TableCoreInfo ('Postgres 'Vanilla) -> Maybe ViewInfo
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe ViewInfo
_tciViewInfo TableCoreInfo ('Postgres 'Vanilla)
coreInfo)
    Text
"updatable"

  -- Check if the role has update permissions
  UpdPermInfo ('Postgres 'Vanilla)
updPerm <- TableInfo ('Postgres 'Vanilla)
-> m (UpdPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (UpdPermInfo ('Postgres 'Vanilla))
askUpdPermInfo TableInfo ('Postgres 'Vanilla)
tableInfo

  -- Check if all dependent headers are present
  HashSet Text -> m ()
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
HashSet Text -> m ()
validateHeaders (HashSet Text -> m ()) -> HashSet Text -> m ()
forall a b. (a -> b) -> a -> b
$ UpdPermInfo ('Postgres 'Vanilla) -> HashSet Text
forall (b :: BackendType). UpdPermInfo b -> HashSet Text
upiRequiredHeaders UpdPermInfo ('Postgres 'Vanilla)
updPerm

  -- Check if select is allowed
  SelPermInfo ('Postgres 'Vanilla)
selPerm <-
    (Text -> Text)
-> m (SelPermInfo ('Postgres 'Vanilla))
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
selNecessaryMsg)
      (m (SelPermInfo ('Postgres 'Vanilla))
 -> m (SelPermInfo ('Postgres 'Vanilla)))
-> m (SelPermInfo ('Postgres 'Vanilla))
-> m (SelPermInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (SelPermInfo ('Postgres 'Vanilla))
askSelPermInfo TableInfo ('Postgres 'Vanilla)
tableInfo

  let fieldInfoMap :: FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap = TableCoreInfo ('Postgres 'Vanilla)
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo ('Postgres 'Vanilla)
coreInfo
      allCols :: [ColumnInfo ('Postgres 'Vanilla)]
allCols = (StructuredColumnInfo ('Postgres 'Vanilla)
 -> Maybe (ColumnInfo ('Postgres 'Vanilla)))
-> [StructuredColumnInfo ('Postgres 'Vanilla)]
-> [ColumnInfo ('Postgres 'Vanilla)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (StructuredColumnInfo ('Postgres 'Vanilla)
-> Getting
     (First (ColumnInfo ('Postgres 'Vanilla)))
     (StructuredColumnInfo ('Postgres 'Vanilla))
     (ColumnInfo ('Postgres 'Vanilla))
-> Maybe (ColumnInfo ('Postgres 'Vanilla))
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (ColumnInfo ('Postgres 'Vanilla)))
  (StructuredColumnInfo ('Postgres 'Vanilla))
  (ColumnInfo ('Postgres 'Vanilla))
forall (b :: BackendType) (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (ColumnInfo b) (f (ColumnInfo b))
-> p (StructuredColumnInfo b) (f (StructuredColumnInfo b))
_SCIScalarColumn) ([StructuredColumnInfo ('Postgres 'Vanilla)]
 -> [ColumnInfo ('Postgres 'Vanilla)])
-> [StructuredColumnInfo ('Postgres 'Vanilla)]
-> [ColumnInfo ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [StructuredColumnInfo ('Postgres 'Vanilla)]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [StructuredColumnInfo backend]
getCols FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap
      preSetObj :: PreSetColsPartial ('Postgres 'Vanilla)
preSetObj = UpdPermInfo ('Postgres 'Vanilla)
-> PreSetColsPartial ('Postgres 'Vanilla)
forall (b :: BackendType). UpdPermInfo b -> PreSetColsPartial b
upiSet UpdPermInfo ('Postgres 'Vanilla)
updPerm
      preSetCols :: [PGCol]
preSetCols = HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla)) -> [PGCol]
forall k v. HashMap k v -> [k]
HashMap.keys PreSetColsPartial ('Postgres 'Vanilla)
HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla))
preSetObj

  -- convert the object to SQL set expression
  [(PGCol, SQLExp)]
setItems <-
    Text -> m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"$set"
      (m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)])
-> m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [PGCol]
-> UpdPermInfo ('Postgres 'Vanilla)
-> [(PGCol, Value)]
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> Value -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
forall (m :: * -> *) a.
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [PGCol]
-> UpdPermInfo ('Postgres 'Vanilla)
-> [(PGCol, a)]
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> a -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
convOp FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap [PGCol]
preSetCols UpdPermInfo ('Postgres 'Vanilla)
updPerm (HashMap (Column ('Postgres 'Vanilla)) Value
-> [(Column ('Postgres 'Vanilla), Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap (Column ('Postgres 'Vanilla)) Value
 -> [(Column ('Postgres 'Vanilla), Value)])
-> HashMap (Column ('Postgres 'Vanilla)) Value
-> [(Column ('Postgres 'Vanilla), Value)]
forall a b. (a -> b) -> a -> b
$ UpdateQuery -> HashMap (Column ('Postgres 'Vanilla)) Value
uqSet UpdateQuery
uq)
      ((PGCol
  -> ColumnType ('Postgres 'Vanilla) -> Value -> m (PGCol, SQLExp))
 -> m [(PGCol, SQLExp)])
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> Value -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
forall a b. (a -> b) -> a -> b
$ ValueParser ('Postgres 'Vanilla) m SQLExp
-> PGCol
-> ColumnType ('Postgres 'Vanilla)
-> Value
-> m (PGCol, SQLExp)
forall (m :: * -> *).
QErrM m =>
ValueParser ('Postgres 'Vanilla) m SQLExp
-> PGCol
-> ColumnType ('Postgres 'Vanilla)
-> Value
-> m (PGCol, SQLExp)
convSet ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr

  [(PGCol, SQLExp)]
incItems <-
    Text -> m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"$inc"
      (m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)])
-> m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [PGCol]
-> UpdPermInfo ('Postgres 'Vanilla)
-> [(PGCol, Value)]
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> Value -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
forall (m :: * -> *) a.
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [PGCol]
-> UpdPermInfo ('Postgres 'Vanilla)
-> [(PGCol, a)]
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> a -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
convOp FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap [PGCol]
preSetCols UpdPermInfo ('Postgres 'Vanilla)
updPerm (HashMap (Column ('Postgres 'Vanilla)) Value
-> [(Column ('Postgres 'Vanilla), Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap (Column ('Postgres 'Vanilla)) Value
 -> [(Column ('Postgres 'Vanilla), Value)])
-> HashMap (Column ('Postgres 'Vanilla)) Value
-> [(Column ('Postgres 'Vanilla), Value)]
forall a b. (a -> b) -> a -> b
$ UpdateQuery -> HashMap (Column ('Postgres 'Vanilla)) Value
uqInc UpdateQuery
uq)
      ((PGCol
  -> ColumnType ('Postgres 'Vanilla) -> Value -> m (PGCol, SQLExp))
 -> m [(PGCol, SQLExp)])
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> Value -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
forall a b. (a -> b) -> a -> b
$ ValueParser ('Postgres 'Vanilla) m SQLExp
-> PGCol
-> ColumnType ('Postgres 'Vanilla)
-> Value
-> m (PGCol, SQLExp)
forall (m :: * -> *).
QErrM m =>
ValueParser ('Postgres 'Vanilla) m SQLExp
-> PGCol
-> ColumnType ('Postgres 'Vanilla)
-> Value
-> m (PGCol, SQLExp)
convInc ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr

  [(PGCol, SQLExp)]
mulItems <-
    Text -> m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"$mul"
      (m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)])
-> m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [PGCol]
-> UpdPermInfo ('Postgres 'Vanilla)
-> [(PGCol, Value)]
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> Value -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
forall (m :: * -> *) a.
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [PGCol]
-> UpdPermInfo ('Postgres 'Vanilla)
-> [(PGCol, a)]
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> a -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
convOp FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap [PGCol]
preSetCols UpdPermInfo ('Postgres 'Vanilla)
updPerm (HashMap (Column ('Postgres 'Vanilla)) Value
-> [(Column ('Postgres 'Vanilla), Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap (Column ('Postgres 'Vanilla)) Value
 -> [(Column ('Postgres 'Vanilla), Value)])
-> HashMap (Column ('Postgres 'Vanilla)) Value
-> [(Column ('Postgres 'Vanilla), Value)]
forall a b. (a -> b) -> a -> b
$ UpdateQuery -> HashMap (Column ('Postgres 'Vanilla)) Value
uqMul UpdateQuery
uq)
      ((PGCol
  -> ColumnType ('Postgres 'Vanilla) -> Value -> m (PGCol, SQLExp))
 -> m [(PGCol, SQLExp)])
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> Value -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
forall a b. (a -> b) -> a -> b
$ ValueParser ('Postgres 'Vanilla) m SQLExp
-> PGCol
-> ColumnType ('Postgres 'Vanilla)
-> Value
-> m (PGCol, SQLExp)
forall (m :: * -> *).
QErrM m =>
ValueParser ('Postgres 'Vanilla) m SQLExp
-> PGCol
-> ColumnType ('Postgres 'Vanilla)
-> Value
-> m (PGCol, SQLExp)
convMul ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr

  [(PGCol, SQLExp)]
defItems <-
    Text -> m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"$default"
      (m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)])
-> m [(PGCol, SQLExp)] -> m [(PGCol, SQLExp)]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [PGCol]
-> UpdPermInfo ('Postgres 'Vanilla)
-> [(PGCol, ())]
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> () -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
forall (m :: * -> *) a.
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [PGCol]
-> UpdPermInfo ('Postgres 'Vanilla)
-> [(PGCol, a)]
-> (PGCol
    -> ColumnType ('Postgres 'Vanilla) -> a -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
convOp FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap [PGCol]
preSetCols UpdPermInfo ('Postgres 'Vanilla)
updPerm ((,()) (PGCol -> (PGCol, ())) -> [PGCol] -> [(PGCol, ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateQuery -> [PGCol]
uqDefault UpdateQuery
uq) PGCol -> ColumnType ('Postgres 'Vanilla) -> () -> m (PGCol, SQLExp)
forall (m :: * -> *).
Monad m =>
PGCol -> ColumnType ('Postgres 'Vanilla) -> () -> m (PGCol, SQLExp)
convDefault

  -- convert the returning cols into sql returing exp
  Maybe [ColumnInfo ('Postgres 'Vanilla)]
mAnnRetCols <- Maybe [PGCol]
-> ([PGCol] -> m [ColumnInfo ('Postgres 'Vanilla)])
-> m (Maybe [ColumnInfo ('Postgres 'Vanilla)])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe [PGCol]
mRetCols (([PGCol] -> m [ColumnInfo ('Postgres 'Vanilla)])
 -> m (Maybe [ColumnInfo ('Postgres 'Vanilla)]))
-> ([PGCol] -> m [ColumnInfo ('Postgres 'Vanilla)])
-> m (Maybe [ColumnInfo ('Postgres 'Vanilla)])
forall a b. (a -> b) -> a -> b
$ \[PGCol]
retCols ->
    Text
-> m [ColumnInfo ('Postgres 'Vanilla)]
-> m [ColumnInfo ('Postgres 'Vanilla)]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"returning" (m [ColumnInfo ('Postgres 'Vanilla)]
 -> m [ColumnInfo ('Postgres 'Vanilla)])
-> m [ColumnInfo ('Postgres 'Vanilla)]
-> m [ColumnInfo ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> [PGCol]
-> m [ColumnInfo ('Postgres 'Vanilla)]
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> [PGCol]
-> m [ColumnInfo ('Postgres 'Vanilla)]
checkRetCols FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPerm [PGCol]
retCols

  [(PGCol, SQLExp)]
resolvedPreSetItems <-
    HashMap PGCol SQLExp -> [(PGCol, SQLExp)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
      (HashMap PGCol SQLExp -> [(PGCol, SQLExp)])
-> m (HashMap PGCol SQLExp) -> m [(PGCol, SQLExp)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PartialSQLExp ('Postgres 'Vanilla) -> m SQLExp)
-> HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla))
-> m (HashMap PGCol SQLExp)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HashMap PGCol a -> m (HashMap PGCol b)
mapM (SessionVariableBuilder m
-> PartialSQLExp ('Postgres 'Vanilla)
-> m (SQLExpression ('Postgres 'Vanilla))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> PartialSQLExp ('Postgres 'Vanilla)
-> f (SQLExpression ('Postgres 'Vanilla))
convPartialSQLExp SessionVariableBuilder m
sessVarBldr) PreSetColsPartial ('Postgres 'Vanilla)
HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla))
preSetObj

  let setExpItems :: [(PGCol, SQLExp)]
setExpItems =
        [(PGCol, SQLExp)]
resolvedPreSetItems
          [(PGCol, SQLExp)] -> [(PGCol, SQLExp)] -> [(PGCol, SQLExp)]
forall a. [a] -> [a] -> [a]
++ [(PGCol, SQLExp)]
setItems
          [(PGCol, SQLExp)] -> [(PGCol, SQLExp)] -> [(PGCol, SQLExp)]
forall a. [a] -> [a] -> [a]
++ [(PGCol, SQLExp)]
incItems
          [(PGCol, SQLExp)] -> [(PGCol, SQLExp)] -> [(PGCol, SQLExp)]
forall a. [a] -> [a] -> [a]
++ [(PGCol, SQLExp)]
mulItems
          [(PGCol, SQLExp)] -> [(PGCol, SQLExp)] -> [(PGCol, SQLExp)]
forall a. [a] -> [a] -> [a]
++ [(PGCol, SQLExp)]
defItems

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(PGCol, SQLExp)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PGCol, SQLExp)]
setExpItems)
    (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
UnexpectedPayload Text
"atleast one of $set, $inc, $mul has to be present"

  -- convert the where clause
  AnnBoolExp ('Postgres 'Vanilla) SQLExp
annSQLBoolExp <-
    Text
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"where"
      (m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
 -> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> BoolExp ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> ValueParser
     ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> SelPermInfo ('Postgres 'Vanilla)
-> BoolExp ('Postgres 'Vanilla)
-> SessionVariableBuilder m
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> ValueParser
     ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
convBoolExp FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap SelPermInfo ('Postgres 'Vanilla)
selPerm (UpdateQuery -> BoolExp ('Postgres 'Vanilla)
uqWhere UpdateQuery
uq) SessionVariableBuilder m
sessVarBldr FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap ValueParser
  ('Postgres 'Vanilla) m (SQLExpression ('Postgres 'Vanilla))
ValueParser ('Postgres 'Vanilla) m SQLExp
prepValBldr

  AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedUpdFltr <-
    SessionVariableBuilder m
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExpSQL ('Postgres 'Vanilla))
convAnnBoolExpPartialSQL SessionVariableBuilder m
sessVarBldr
      (AnnBoolExpPartialSQL ('Postgres 'Vanilla)
 -> m (AnnBoolExpSQL ('Postgres 'Vanilla)))
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ UpdPermInfo ('Postgres 'Vanilla)
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
forall (b :: BackendType). UpdPermInfo b -> AnnBoolExpPartialSQL b
upiFilter UpdPermInfo ('Postgres 'Vanilla)
updPerm
  AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedUpdCheck <-
    AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
forall a. a -> Maybe a -> a
fromMaybe AnnBoolExp ('Postgres 'Vanilla) SQLExp
forall (backend :: BackendType) field. GBoolExp backend field
gBoolExpTrue
      (Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
 -> AnnBoolExp ('Postgres 'Vanilla) SQLExp)
-> m (Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnnBoolExpPartialSQL ('Postgres 'Vanilla)
 -> m (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
-> Maybe (AnnBoolExpPartialSQL ('Postgres 'Vanilla))
-> m (Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp))
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) -> Maybe a -> f (Maybe b)
traverse
        (SessionVariableBuilder m
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> m (AnnBoolExpSQL ('Postgres 'Vanilla))
forall (f :: * -> *).
Applicative f =>
SessionVariableBuilder f
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
-> f (AnnBoolExpSQL ('Postgres 'Vanilla))
convAnnBoolExpPartialSQL SessionVariableBuilder m
sessVarBldr)
        (UpdPermInfo ('Postgres 'Vanilla)
-> Maybe (AnnBoolExpPartialSQL ('Postgres 'Vanilla))
forall (b :: BackendType).
UpdPermInfo b -> Maybe (AnnBoolExpPartialSQL b)
upiCheck UpdPermInfo ('Postgres 'Vanilla)
updPerm)

  let validateInput :: Maybe (ValidateInput ResolvedWebhook)
validateInput = UpdPermInfo ('Postgres 'Vanilla)
-> Maybe (ValidateInput ResolvedWebhook)
forall (b :: BackendType).
UpdPermInfo b -> Maybe (ValidateInput ResolvedWebhook)
upiValidateInput UpdPermInfo ('Postgres 'Vanilla)
updPerm
  AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp
-> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp
 -> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp))
-> AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp
-> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp)
forall a b. (a -> b) -> a -> b
$ TableName ('Postgres 'Vanilla)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> UpdateVariant ('Postgres 'Vanilla) SQLExp
-> MutationOutputG ('Postgres 'Vanilla) Void SQLExp
-> [ColumnInfo ('Postgres 'Vanilla)]
-> Maybe NamingCase
-> Maybe (ValidateInput ResolvedWebhook)
-> AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) r v.
TableName b
-> AnnBoolExp b v
-> AnnBoolExp b v
-> UpdateVariant b v
-> MutationOutputG b r v
-> [ColumnInfo b]
-> Maybe NamingCase
-> Maybe (ValidateInput ResolvedWebhook)
-> AnnotatedUpdateG b r v
AnnotatedUpdateG
      TableName ('Postgres 'Vanilla)
QualifiedTable
tableName
      AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedUpdFltr
      AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedUpdCheck
      ( UpdateBatch ('Postgres 'Vanilla) UpdateOpExpression SQLExp
-> PgUpdateVariant 'Vanilla SQLExp
forall (pgKind :: PostgresKind) v.
UpdateBatch ('Postgres pgKind) UpdateOpExpression v
-> PgUpdateVariant pgKind v
SingleBatch
          (UpdateBatch ('Postgres 'Vanilla) UpdateOpExpression SQLExp
 -> PgUpdateVariant 'Vanilla SQLExp)
-> UpdateBatch ('Postgres 'Vanilla) UpdateOpExpression SQLExp
-> PgUpdateVariant 'Vanilla SQLExp
forall a b. (a -> b) -> a -> b
$ HashMap (Column ('Postgres 'Vanilla)) (UpdateOpExpression SQLExp)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> UpdateBatch ('Postgres 'Vanilla) UpdateOpExpression SQLExp
forall (b :: BackendType) (updateOperators :: * -> *) v.
HashMap (Column b) (updateOperators v)
-> AnnBoolExp b v -> UpdateBatch b updateOperators v
UpdateBatch
            ([(Column ('Postgres 'Vanilla), UpdateOpExpression SQLExp)]
-> HashMap
     (Column ('Postgres 'Vanilla)) (UpdateOpExpression SQLExp)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Column ('Postgres 'Vanilla), UpdateOpExpression SQLExp)]
 -> HashMap
      (Column ('Postgres 'Vanilla)) (UpdateOpExpression SQLExp))
-> [(Column ('Postgres 'Vanilla), UpdateOpExpression SQLExp)]
-> HashMap
     (Column ('Postgres 'Vanilla)) (UpdateOpExpression SQLExp)
forall a b. (a -> b) -> a -> b
$ (SQLExp -> UpdateOpExpression SQLExp)
-> (PGCol, SQLExp) -> (PGCol, UpdateOpExpression SQLExp)
forall a b. (a -> b) -> (PGCol, a) -> (PGCol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SQLExp -> UpdateOpExpression SQLExp
forall v. v -> UpdateOpExpression v
UpdateSet ((PGCol, SQLExp) -> (PGCol, UpdateOpExpression SQLExp))
-> [(PGCol, SQLExp)] -> [(PGCol, UpdateOpExpression SQLExp)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PGCol, SQLExp)]
setExpItems)
            AnnBoolExp ('Postgres 'Vanilla) SQLExp
annSQLBoolExp
      )
      (Maybe [ColumnInfo ('Postgres 'Vanilla)]
-> MutationOutput ('Postgres 'Vanilla)
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
Maybe [ColumnInfo ('Postgres pgKind)]
-> MutationOutput ('Postgres pgKind)
mkDefaultMutFlds Maybe [ColumnInfo ('Postgres 'Vanilla)]
mAnnRetCols)
      [ColumnInfo ('Postgres 'Vanilla)]
allCols
      Maybe NamingCase
forall a. Maybe a
Nothing
      Maybe (ValidateInput ResolvedWebhook)
validateInput
  where
    mRetCols :: Maybe [PGCol]
mRetCols = UpdateQuery -> Maybe [PGCol]
uqReturning UpdateQuery
uq
    selNecessaryMsg :: Text
selNecessaryMsg =
      Text
"; \"update\" is only allowed if the role "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"has \"select\" permission as \"where\" can't be used "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"without \"select\" permission on the table"

validateUpdateQuery ::
  (QErrM m, UserInfoM m, CacheRM m) =>
  UpdateQuery ->
  m (AnnotatedUpdate ('Postgres 'Vanilla), DS.Seq PG.PrepArg)
validateUpdateQuery :: forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m) =>
UpdateQuery
-> m (AnnotatedUpdate ('Postgres 'Vanilla), Seq PrepArg)
validateUpdateQuery UpdateQuery
query = do
  let source :: SourceName
source = UpdateQuery -> SourceName
uqSource UpdateQuery
query
  HashMap
  (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
tableCache :: TableCache ('Postgres 'Vanilla) <- Maybe
  (HashMap
     (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla)))
-> HashMap
     (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe
   (HashMap
      (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla)))
 -> HashMap
      (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla)))
-> m (Maybe
        (HashMap
           (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))))
-> m (HashMap
        (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName
-> m (Maybe
        (HashMap
           (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))))
forall (b :: BackendType) (m :: * -> *).
(Backend b, CacheRM m) =>
SourceName -> m (Maybe (TableCache b))
askTableCache SourceName
source
  (TableCacheRT
   ('Postgres 'Vanilla)
   m
   (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg)
 -> HashMap
      (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
 -> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp,
       Seq PrepArg))
-> HashMap
     (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
-> TableCacheRT
     ('Postgres 'Vanilla)
     m
     (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg)
-> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp,
      Seq PrepArg)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TableCacheRT
  ('Postgres 'Vanilla)
  m
  (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg)
-> HashMap
     (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
-> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp,
      Seq PrepArg)
forall (b :: BackendType) (m :: * -> *) a.
TableCacheRT b m a -> TableCache b -> m a
runTableCacheRT HashMap
  (TableName ('Postgres 'Vanilla)) (TableInfo ('Postgres 'Vanilla))
tableCache
    (TableCacheRT
   ('Postgres 'Vanilla)
   m
   (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg)
 -> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp,
       Seq PrepArg))
-> TableCacheRT
     ('Postgres 'Vanilla)
     m
     (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg)
-> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp,
      Seq PrepArg)
forall a b. (a -> b) -> a -> b
$ DMLP1T
  (TableCacheRT ('Postgres 'Vanilla) m)
  (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp)
-> TableCacheRT
     ('Postgres 'Vanilla)
     m
     (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg)
forall (m :: * -> *) a. DMLP1T m a -> m (a, Seq PrepArg)
runDMLP1T
    (DMLP1T
   (TableCacheRT ('Postgres 'Vanilla) m)
   (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp)
 -> TableCacheRT
      ('Postgres 'Vanilla)
      m
      (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg))
-> DMLP1T
     (TableCacheRT ('Postgres 'Vanilla) m)
     (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp)
-> TableCacheRT
     ('Postgres 'Vanilla)
     m
     (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg)
forall a b. (a -> b) -> a -> b
$ SessionVariableBuilder
  (DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
-> ValueParser
     ('Postgres 'Vanilla)
     (DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
     SQLExp
-> UpdateQuery
-> DMLP1T
     (TableCacheRT ('Postgres 'Vanilla) m)
     (AnnotatedUpdate ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m
-> ValueParser ('Postgres 'Vanilla) m SQLExp
-> UpdateQuery
-> m (AnnotatedUpdate ('Postgres 'Vanilla))
validateUpdateQueryWith SessionVariableBuilder
  (DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
forall (f :: * -> *). Applicative f => SessionVariableBuilder f
sessVarFromCurrentSetting ((ColumnType ('Postgres 'Vanilla)
 -> Value -> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) SQLExp)
-> ValueParser
     ('Postgres 'Vanilla)
     (DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
     SQLExp
forall (m :: * -> *).
MonadError QErr m =>
(ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> CollectableType (ColumnType ('Postgres 'Vanilla))
-> Value
-> m SQLExp
valueParserWithCollectableType ColumnType ('Postgres 'Vanilla)
-> Value -> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) SQLExp
forall (m :: * -> *).
QErrM m =>
ColumnType ('Postgres 'Vanilla) -> Value -> DMLP1T m SQLExp
binRHSBuilder) UpdateQuery
query

runUpdate ::
  forall m.
  ( QErrM m,
    UserInfoM m,
    CacheRM m,
    MonadBaseControl IO m,
    MonadIO m,
    Tracing.MonadTrace m,
    MetadataM m
  ) =>
  SQLGenCtx ->
  UpdateQuery ->
  m EncJSON
runUpdate :: forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, MonadBaseControl IO m, MonadIO m,
 MonadTrace m, MetadataM m) =>
SQLGenCtx -> UpdateQuery -> m EncJSON
runUpdate SQLGenCtx
sqlGen UpdateQuery
q = do
  PGSourceConfig
sourceConfig <- forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @('Postgres 'Vanilla) (UpdateQuery -> SourceName
uqSource UpdateQuery
q)
  UserInfo
userInfo <- m UserInfo
forall (m :: * -> *). UserInfoM m => m UserInfo
askUserInfo
  let strfyNum :: StringifyNumbers
strfyNum = SQLGenCtx -> StringifyNumbers
stringifyNum SQLGenCtx
sqlGen
  UpdateQuery
-> m (AnnotatedUpdate ('Postgres 'Vanilla), Seq PrepArg)
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m) =>
UpdateQuery
-> m (AnnotatedUpdate ('Postgres 'Vanilla), Seq PrepArg)
validateUpdateQuery UpdateQuery
q
    m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg)
-> ((AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp,
     Seq PrepArg)
    -> m EncJSON)
-> m EncJSON
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PGExecCtx
-> PGExecTxType -> PGExecFrom -> TxET QErr m EncJSON -> m EncJSON
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m,
 UserInfoM m) =>
PGExecCtx -> PGExecTxType -> PGExecFrom -> TxET QErr m a -> m a
runTxWithCtx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
sourceConfig) (TxAccess -> Maybe TxIsolation -> PGExecTxType
Tx TxAccess
PG.ReadWrite Maybe TxIsolation
forall a. Maybe a
Nothing) PGExecFrom
LegacyRQLQuery
    (TxET QErr m EncJSON -> m EncJSON)
-> ((AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp,
     Seq PrepArg)
    -> TxET QErr m EncJSON)
-> (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg)
-> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT QueryTagsComment (TxET QErr m) EncJSON
 -> QueryTagsComment -> TxET QErr m EncJSON)
-> QueryTagsComment
-> ReaderT QueryTagsComment (TxET QErr m) EncJSON
-> TxET QErr m EncJSON
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT QueryTagsComment (TxET QErr m) EncJSON
-> QueryTagsComment -> TxET QErr m EncJSON
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT QueryTagsComment
emptyQueryTagsComment
    (ReaderT QueryTagsComment (TxET QErr m) EncJSON
 -> TxET QErr m EncJSON)
-> ((AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp,
     Seq PrepArg)
    -> ReaderT QueryTagsComment (TxET QErr m) EncJSON)
-> (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp, Seq PrepArg)
-> TxET QErr m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (AnnotatedUpdate ('Postgres 'Vanilla), Seq PrepArg)
-> ReaderT QueryTagsComment (TxET QErr m) EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (AnnotatedUpdate ('Postgres pgKind), Seq PrepArg)
-> m EncJSON
execUpdateQuery StringifyNumbers
strfyNum Maybe NamingCase
forall a. Maybe a
Nothing UserInfo
userInfo