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

import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson.Types
import Data.HashMap.Strict qualified as M
import Data.HashMap.Strict qualified as Map
import Data.Sequence qualified as DS
import Data.Text.Extended
import Database.PG.Query qualified as Q
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.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Hasura.SQL.Types
import Hasura.Server.Types
import Hasura.Session
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 :: 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 (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 :: 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 (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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return (PGCol
col, SQLExp
prepExp)

convDefault :: (Monad m) => PGCol -> ColumnType ('Postgres 'Vanilla) -> () -> m (PGCol, S.SQLExp)
convDefault :: PGCol -> ColumnType ('Postgres 'Vanilla) -> () -> m (PGCol, SQLExp)
convDefault PGCol
col ColumnType ('Postgres 'Vanilla)
_ ()
_ = (PGCol, SQLExp) -> m (PGCol, SQLExp)
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 :: 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 (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 (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 :: 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 = FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [ColumnInfo ('Postgres 'Vanilla)]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [ColumnInfo 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]
M.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 PGCol Value -> [(PGCol, Value)]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap PGCol Value -> [(PGCol, Value)])
-> HashMap PGCol Value -> [(PGCol, Value)]
forall a b. (a -> b) -> a -> b
$ UpdateQuery -> UpdVals ('Postgres 'Vanilla)
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 PGCol Value -> [(PGCol, Value)]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap PGCol Value -> [(PGCol, Value)])
-> HashMap PGCol Value -> [(PGCol, Value)]
forall a b. (a -> b) -> a -> b
$ UpdateQuery -> UpdVals ('Postgres 'Vanilla)
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 PGCol Value -> [(PGCol, Value)]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap PGCol Value -> [(PGCol, Value)])
-> HashMap PGCol Value -> [(PGCol, Value)]
forall a b. (a -> b) -> a -> b
$ UpdateQuery -> UpdVals ('Postgres 'Vanilla)
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)]
M.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)
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 (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
-> TableName ('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
-> TableName ('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 TableName ('Postgres 'Vanilla)
QualifiedTable
tableName 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)
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)

  AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp
-> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp)
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)
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> BackendUpdate ('Postgres 'Vanilla) SQLExp
-> MutationOutputG ('Postgres 'Vanilla) Void SQLExp
-> [ColumnInfo ('Postgres 'Vanilla)]
-> Maybe NamingCase
-> AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp
forall (b :: BackendType) r v.
TableName b
-> (AnnBoolExp b v, AnnBoolExp b v)
-> AnnBoolExp b v
-> BackendUpdate b v
-> MutationOutputG b r v
-> [ColumnInfo b]
-> Maybe NamingCase
-> AnnotatedUpdateG b r v
AnnotatedUpdateG
      TableName ('Postgres 'Vanilla)
QualifiedTable
tableName
      (AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedUpdFltr, AnnBoolExp ('Postgres 'Vanilla) SQLExp
annSQLBoolExp)
      AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedUpdCheck
      (HashMap PGCol (UpdateOpExpression SQLExp)
-> BackendUpdate 'Vanilla SQLExp
forall (pgKind :: PostgresKind) v.
HashMap PGCol (UpdateOpExpression v) -> BackendUpdate pgKind v
BackendUpdate (HashMap PGCol (UpdateOpExpression SQLExp)
 -> BackendUpdate 'Vanilla SQLExp)
-> HashMap PGCol (UpdateOpExpression SQLExp)
-> BackendUpdate 'Vanilla SQLExp
forall a b. (a -> b) -> a -> b
$ [(PGCol, UpdateOpExpression SQLExp)]
-> HashMap PGCol (UpdateOpExpression SQLExp)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(PGCol, UpdateOpExpression SQLExp)]
 -> HashMap PGCol (UpdateOpExpression SQLExp))
-> [(PGCol, UpdateOpExpression SQLExp)]
-> HashMap PGCol (UpdateOpExpression SQLExp)
forall a b. (a -> b) -> a -> b
$ (SQLExp -> UpdateOpExpression SQLExp)
-> (PGCol, SQLExp) -> (PGCol, UpdateOpExpression SQLExp)
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)
      (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
  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 Q.PrepArg)
validateUpdateQuery :: UpdateQuery
-> m (AnnotatedUpdate ('Postgres 'Vanilla), Seq PrepArg)
validateUpdateQuery UpdateQuery
query = do
  let source :: SourceName
source = UpdateQuery -> SourceName
uqSource UpdateQuery
query
  tableCache :: TableCache ('Postgres 'Vanilla) <- Maybe (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla))
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
 -> HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> m (Maybe
        (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla))))
-> m (HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName -> m (Maybe (TableCache ('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)
 -> (SourceName,
     HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
 -> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp,
       Seq PrepArg))
-> (SourceName,
    HashMap QualifiedTable (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)
-> (SourceName,
    HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> m (AnnotatedUpdateG ('Postgres 'Vanilla) Void SQLExp,
      Seq PrepArg)
forall (b :: BackendType) (m :: * -> *) a.
TableCacheRT b m a -> (SourceName, TableCache b) -> m a
runTableCacheRT (SourceName
source, TableCache ('Postgres 'Vanilla)
HashMap QualifiedTable (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,
    HasServerConfigCtx m,
    MonadBaseControl IO m,
    MonadIO m,
    Tracing.MonadTrace m,
    MetadataM m
  ) =>
  UpdateQuery ->
  m EncJSON
runUpdate :: UpdateQuery -> m EncJSON
runUpdate UpdateQuery
q = do
  PGSourceConfig
sourceConfig <- SourceName -> m (SourceConfig ('Postgres 'Vanilla))
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
  StringifyNumbers
strfyNum <- SQLGenCtx -> StringifyNumbers
stringifyNum (SQLGenCtx -> StringifyNumbers)
-> (ServerConfigCtx -> SQLGenCtx)
-> ServerConfigCtx
-> StringifyNumbers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerConfigCtx -> SQLGenCtx
_sccSQLGenCtx (ServerConfigCtx -> StringifyNumbers)
-> m ServerConfigCtx -> m StringifyNumbers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
  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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PGExecCtx -> TxAccess -> TxET QErr m EncJSON -> m EncJSON
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m,
 UserInfoM m) =>
PGExecCtx -> TxAccess -> TxET QErr m a -> m a
runTxWithCtx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
sourceConfig) TxAccess
Q.ReadWrite
      (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