module Hasura.RQL.DML.Insert
  ( runInsert,
  )
where

import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson.Types
import Data.HashMap.Strict qualified as HM
import Data.HashSet qualified as HS
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.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.Insert
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Hasura.Server.Types
import Hasura.Session
import Hasura.Tracing qualified as Tracing

convObj ::
  (UserInfoM m, QErrM m) =>
  (ColumnType ('Postgres 'Vanilla) -> Value -> m S.SQLExp) ->
  HM.HashMap PGCol S.SQLExp ->
  HM.HashMap PGCol S.SQLExp ->
  FieldInfoMap (FieldInfo ('Postgres 'Vanilla)) ->
  InsObj ('Postgres 'Vanilla) ->
  m ([PGCol], [S.SQLExp])
convObj :: (ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> HashMap PGCol SQLExp
-> HashMap PGCol SQLExp
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> InsObj ('Postgres 'Vanilla)
-> m ([PGCol], [SQLExp])
convObj ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp
prepFn HashMap PGCol SQLExp
defInsVals HashMap PGCol SQLExp
setInsVals FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap InsObj ('Postgres 'Vanilla)
insObj = do
  HashMap PGCol SQLExp
inpInsVals <- ((PGCol -> Value -> m SQLExp)
 -> HashMap PGCol Value -> m (HashMap PGCol SQLExp))
-> HashMap PGCol Value
-> (PGCol -> Value -> m SQLExp)
-> m (HashMap PGCol SQLExp)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (PGCol -> Value -> m SQLExp)
-> HashMap PGCol Value -> m (HashMap PGCol SQLExp)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HM.traverseWithKey InsObj ('Postgres 'Vanilla)
HashMap PGCol Value
insObj ((PGCol -> Value -> m SQLExp) -> m (HashMap PGCol SQLExp))
-> (PGCol -> Value -> m SQLExp) -> m (HashMap PGCol SQLExp)
forall a b. (a -> b) -> a -> b
$ \PGCol
c Value
val -> do
    let relWhenPGErr :: Text
relWhenPGErr = Text
"relationships can't be inserted"
    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
c Text
relWhenPGErr
    -- if column has predefined value then throw error
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PGCol
c 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
throwNotInsErr PGCol
c
    -- Encode aeson's value into prepared value
    Text -> m SQLExp -> m SQLExp
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK (PGCol -> Text
getPGColTxt PGCol
c) (m SQLExp -> m SQLExp) -> m SQLExp -> m SQLExp
forall a b. (a -> b) -> a -> b
$ ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp
prepFn ColumnType ('Postgres 'Vanilla)
colType Value
val
  let insVals :: HashMap PGCol SQLExp
insVals = HashMap PGCol SQLExp
-> HashMap PGCol SQLExp -> HashMap PGCol SQLExp
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union HashMap PGCol SQLExp
setInsVals HashMap PGCol SQLExp
inpInsVals
      sqlExps :: [SQLExp]
sqlExps = HashMap PGCol SQLExp -> [SQLExp]
forall k v. HashMap k v -> [v]
HM.elems (HashMap PGCol SQLExp -> [SQLExp])
-> HashMap PGCol SQLExp -> [SQLExp]
forall a b. (a -> b) -> a -> b
$ HashMap PGCol SQLExp
-> HashMap PGCol SQLExp -> HashMap PGCol SQLExp
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union HashMap PGCol SQLExp
insVals HashMap PGCol SQLExp
defInsVals
      inpCols :: [PGCol]
inpCols = HashMap PGCol SQLExp -> [PGCol]
forall k v. HashMap k v -> [k]
HM.keys HashMap PGCol SQLExp
inpInsVals

  ([PGCol], [SQLExp]) -> m ([PGCol], [SQLExp])
forall (m :: * -> *) a. Monad m => a -> m a
return ([PGCol]
inpCols, [SQLExp]
sqlExps)
  where
    preSetCols :: [PGCol]
preSetCols = HashMap PGCol SQLExp -> [PGCol]
forall k v. HashMap k v -> [k]
HM.keys HashMap PGCol SQLExp
setInsVals

    throwNotInsErr :: t -> m b
throwNotInsErr 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 insertable"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for role " Text -> RoleName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RoleName
roleName

validateInpCols :: (MonadError QErr m) => [PGCol] -> [PGCol] -> m ()
validateInpCols :: [PGCol] -> [PGCol] -> m ()
validateInpCols [PGCol]
inpCols [PGCol]
updColsPerm = [PGCol] -> (PGCol -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PGCol]
inpCols ((PGCol -> m ()) -> m ()) -> (PGCol -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \PGCol
inpCol ->
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PGCol
inpCol PGCol -> [PGCol] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PGCol]
updColsPerm) (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
ValidationFailed (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text
"column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PGCol
inpCol PGCol -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not updatable"

buildConflictClause ::
  (UserInfoM m, QErrM m) =>
  SessionVariableBuilder m ->
  TableInfo ('Postgres 'Vanilla) ->
  [PGCol] ->
  OnConflict ->
  m (OnConflictClause ('Postgres 'Vanilla) S.SQLExp)
buildConflictClause :: SessionVariableBuilder m
-> TableInfo ('Postgres 'Vanilla)
-> [PGCol]
-> OnConflict
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
buildConflictClause SessionVariableBuilder m
sessVarBldr TableInfo ('Postgres 'Vanilla)
tableInfo [PGCol]
inpCols (OnConflict Maybe ConstraintOn
mTCol Maybe ConstraintName
mTCons ConflictAction
act) =
  case (Maybe ConstraintOn
mTCol, Maybe ConstraintName
mTCons, ConflictAction
act) of
    (Maybe ConstraintOn
Nothing, Maybe ConstraintName
Nothing, ConflictAction
CAIgnore) -> OnConflictClause ('Postgres 'Vanilla) SQLExp
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. Monad m => a -> m a
return (OnConflictClause ('Postgres 'Vanilla) SQLExp
 -> m (OnConflictClause ('Postgres 'Vanilla) SQLExp))
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ Maybe (ConflictTarget ('Postgres 'Vanilla))
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
Maybe (ConflictTarget b) -> OnConflictClause b v
OCCDoNothing Maybe (ConflictTarget ('Postgres 'Vanilla))
forall a. Maybe a
Nothing
    (Just ConstraintOn
col, Maybe ConstraintName
Nothing, ConflictAction
CAIgnore) -> do
      ConstraintOn -> m ()
validateCols ConstraintOn
col
      OnConflictClause ('Postgres 'Vanilla) SQLExp
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. Monad m => a -> m a
return (OnConflictClause ('Postgres 'Vanilla) SQLExp
 -> m (OnConflictClause ('Postgres 'Vanilla) SQLExp))
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ Maybe (ConflictTarget ('Postgres 'Vanilla))
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
Maybe (ConflictTarget b) -> OnConflictClause b v
OCCDoNothing (Maybe (ConflictTarget ('Postgres 'Vanilla))
 -> OnConflictClause ('Postgres 'Vanilla) SQLExp)
-> Maybe (ConflictTarget ('Postgres 'Vanilla))
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
forall a b. (a -> b) -> a -> b
$ ConflictTarget ('Postgres 'Vanilla)
-> Maybe (ConflictTarget ('Postgres 'Vanilla))
forall a. a -> Maybe a
Just (ConflictTarget ('Postgres 'Vanilla)
 -> Maybe (ConflictTarget ('Postgres 'Vanilla)))
-> ConflictTarget ('Postgres 'Vanilla)
-> Maybe (ConflictTarget ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ [Column ('Postgres 'Vanilla)]
-> ConflictTarget ('Postgres 'Vanilla)
forall (b :: BackendType). [Column b] -> ConflictTarget b
CTColumn ([Column ('Postgres 'Vanilla)]
 -> ConflictTarget ('Postgres 'Vanilla))
-> [Column ('Postgres 'Vanilla)]
-> ConflictTarget ('Postgres 'Vanilla)
forall a b. (a -> b) -> a -> b
$ ConstraintOn -> [PGCol]
getPGCols ConstraintOn
col
    (Maybe ConstraintOn
Nothing, Just ConstraintName
cons, ConflictAction
CAIgnore) -> do
      ConstraintName -> m ()
validateConstraint ConstraintName
cons
      OnConflictClause ('Postgres 'Vanilla) SQLExp
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. Monad m => a -> m a
return (OnConflictClause ('Postgres 'Vanilla) SQLExp
 -> m (OnConflictClause ('Postgres 'Vanilla) SQLExp))
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ Maybe (ConflictTarget ('Postgres 'Vanilla))
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
Maybe (ConflictTarget b) -> OnConflictClause b v
OCCDoNothing (Maybe (ConflictTarget ('Postgres 'Vanilla))
 -> OnConflictClause ('Postgres 'Vanilla) SQLExp)
-> Maybe (ConflictTarget ('Postgres 'Vanilla))
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
forall a b. (a -> b) -> a -> b
$ ConflictTarget ('Postgres 'Vanilla)
-> Maybe (ConflictTarget ('Postgres 'Vanilla))
forall a. a -> Maybe a
Just (ConflictTarget ('Postgres 'Vanilla)
 -> Maybe (ConflictTarget ('Postgres 'Vanilla)))
-> ConflictTarget ('Postgres 'Vanilla)
-> Maybe (ConflictTarget ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ ConstraintName ('Postgres 'Vanilla)
-> ConflictTarget ('Postgres 'Vanilla)
forall (b :: BackendType). ConstraintName b -> ConflictTarget b
CTConstraint ConstraintName ('Postgres 'Vanilla)
ConstraintName
cons
    (Maybe ConstraintOn
Nothing, Maybe ConstraintName
Nothing, ConflictAction
CAUpdate) ->
      Code -> Text -> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
        Code
UnexpectedPayload
        Text
"Expecting 'constraint' or 'constraint_on' when the 'action' is 'update'"
    (Just ConstraintOn
col, Maybe ConstraintName
Nothing, ConflictAction
CAUpdate) -> do
      ConstraintOn -> m ()
validateCols ConstraintOn
col
      (AnnBoolExpPartialSQL ('Postgres 'Vanilla)
updFltr, HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla))
preSet) <- m (AnnBoolExpPartialSQL ('Postgres 'Vanilla),
   HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla)))
getUpdPerm
      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)
updFltr
      HashMap PGCol SQLExp
resolvedPreSet <- (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) HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla))
preSet
      OnConflictClause ('Postgres 'Vanilla) SQLExp
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. Monad m => a -> m a
return (OnConflictClause ('Postgres 'Vanilla) SQLExp
 -> m (OnConflictClause ('Postgres 'Vanilla) SQLExp))
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ OnConflictClauseData ('Postgres 'Vanilla) SQLExp
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
OnConflictClauseData b v -> OnConflictClause b v
OCCUpdate (OnConflictClauseData ('Postgres 'Vanilla) SQLExp
 -> OnConflictClause ('Postgres 'Vanilla) SQLExp)
-> OnConflictClauseData ('Postgres 'Vanilla) SQLExp
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
forall a b. (a -> b) -> a -> b
$ ConflictTarget ('Postgres 'Vanilla)
-> [Column ('Postgres 'Vanilla)]
-> PreSetColsG ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> OnConflictClauseData ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
ConflictTarget b
-> [Column b]
-> PreSetColsG b v
-> AnnBoolExp b v
-> OnConflictClauseData b v
OnConflictClauseData ([Column ('Postgres 'Vanilla)]
-> ConflictTarget ('Postgres 'Vanilla)
forall (b :: BackendType). [Column b] -> ConflictTarget b
CTColumn ([Column ('Postgres 'Vanilla)]
 -> ConflictTarget ('Postgres 'Vanilla))
-> [Column ('Postgres 'Vanilla)]
-> ConflictTarget ('Postgres 'Vanilla)
forall a b. (a -> b) -> a -> b
$ ConstraintOn -> [PGCol]
getPGCols ConstraintOn
col) [Column ('Postgres 'Vanilla)]
[PGCol]
inpCols PreSetColsG ('Postgres 'Vanilla) SQLExp
HashMap PGCol SQLExp
resolvedPreSet AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedUpdFltr
    (Maybe ConstraintOn
Nothing, Just ConstraintName
cons, ConflictAction
CAUpdate) -> do
      ConstraintName -> m ()
validateConstraint ConstraintName
cons
      (AnnBoolExpPartialSQL ('Postgres 'Vanilla)
updFltr, HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla))
preSet) <- m (AnnBoolExpPartialSQL ('Postgres 'Vanilla),
   HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla)))
getUpdPerm
      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)
updFltr
      HashMap PGCol SQLExp
resolvedPreSet <- (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) HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla))
preSet
      OnConflictClause ('Postgres 'Vanilla) SQLExp
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. Monad m => a -> m a
return (OnConflictClause ('Postgres 'Vanilla) SQLExp
 -> m (OnConflictClause ('Postgres 'Vanilla) SQLExp))
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall a b. (a -> b) -> a -> b
$ OnConflictClauseData ('Postgres 'Vanilla) SQLExp
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
OnConflictClauseData b v -> OnConflictClause b v
OCCUpdate (OnConflictClauseData ('Postgres 'Vanilla) SQLExp
 -> OnConflictClause ('Postgres 'Vanilla) SQLExp)
-> OnConflictClauseData ('Postgres 'Vanilla) SQLExp
-> OnConflictClause ('Postgres 'Vanilla) SQLExp
forall a b. (a -> b) -> a -> b
$ ConflictTarget ('Postgres 'Vanilla)
-> [Column ('Postgres 'Vanilla)]
-> PreSetColsG ('Postgres 'Vanilla) SQLExp
-> AnnBoolExp ('Postgres 'Vanilla) SQLExp
-> OnConflictClauseData ('Postgres 'Vanilla) SQLExp
forall (b :: BackendType) v.
ConflictTarget b
-> [Column b]
-> PreSetColsG b v
-> AnnBoolExp b v
-> OnConflictClauseData b v
OnConflictClauseData (ConstraintName ('Postgres 'Vanilla)
-> ConflictTarget ('Postgres 'Vanilla)
forall (b :: BackendType). ConstraintName b -> ConflictTarget b
CTConstraint ConstraintName ('Postgres 'Vanilla)
ConstraintName
cons) [Column ('Postgres 'Vanilla)]
[PGCol]
inpCols PreSetColsG ('Postgres 'Vanilla) SQLExp
HashMap PGCol SQLExp
resolvedPreSet AnnBoolExp ('Postgres 'Vanilla) SQLExp
resolvedUpdFltr
    (Just ConstraintOn
_, Just ConstraintName
_, ConflictAction
_) ->
      Code -> Text -> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
        Code
UnexpectedPayload
        Text
"'constraint' and 'constraint_on' cannot be set at a time"
  where
    coreInfo :: TableCoreInfo ('Postgres 'Vanilla)
coreInfo = TableInfo ('Postgres 'Vanilla)
-> TableCoreInfo ('Postgres 'Vanilla)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Vanilla)
tableInfo
    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
    -- toSQLBool = toSQLBoolExp (S.mkQual $ _tciName coreInfo)

    validateCols :: ConstraintOn -> m ()
validateCols ConstraintOn
c = do
      let targetcols :: [PGCol]
targetcols = ConstraintOn -> [PGCol]
getPGCols ConstraintOn
c
      m [ColumnType ('Postgres 'Vanilla)] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [ColumnType ('Postgres 'Vanilla)] -> m ())
-> m [ColumnType ('Postgres 'Vanilla)] -> m ()
forall a b. (a -> b) -> a -> b
$
        Text
-> m [ColumnType ('Postgres 'Vanilla)]
-> m [ColumnType ('Postgres 'Vanilla)]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"constraint_on" (m [ColumnType ('Postgres 'Vanilla)]
 -> m [ColumnType ('Postgres 'Vanilla)])
-> m [ColumnType ('Postgres 'Vanilla)]
-> m [ColumnType ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$
          [PGCol]
-> (PGCol -> m (ColumnType ('Postgres 'Vanilla)))
-> m [ColumnType ('Postgres 'Vanilla)]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [PGCol]
targetcols ((PGCol -> m (ColumnType ('Postgres 'Vanilla)))
 -> m [ColumnType ('Postgres 'Vanilla)])
-> (PGCol -> m (ColumnType ('Postgres 'Vanilla)))
-> m [ColumnType ('Postgres 'Vanilla)]
forall a b. (a -> b) -> a -> b
$
            \PGCol
pgCol -> 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
""

    validateConstraint :: ConstraintName -> m ()
validateConstraint ConstraintName
c = do
      let tableConsNames :: [ConstraintName]
tableConsNames =
            [ConstraintName]
-> (NonEmpty (UniqueConstraint ('Postgres 'Vanilla))
    -> [ConstraintName])
-> Maybe (NonEmpty (UniqueConstraint ('Postgres 'Vanilla)))
-> [ConstraintName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (NonEmpty ConstraintName -> [ConstraintName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty ConstraintName -> [ConstraintName])
-> (NonEmpty (UniqueConstraint ('Postgres 'Vanilla))
    -> NonEmpty ConstraintName)
-> NonEmpty (UniqueConstraint ('Postgres 'Vanilla))
-> [ConstraintName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqueConstraint ('Postgres 'Vanilla) -> ConstraintName)
-> NonEmpty (UniqueConstraint ('Postgres 'Vanilla))
-> NonEmpty ConstraintName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Constraint ('Postgres 'Vanilla) -> ConstraintName
forall (b :: BackendType). Constraint b -> ConstraintName b
_cName (Constraint ('Postgres 'Vanilla) -> ConstraintName)
-> (UniqueConstraint ('Postgres 'Vanilla)
    -> Constraint ('Postgres 'Vanilla))
-> UniqueConstraint ('Postgres 'Vanilla)
-> ConstraintName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueConstraint ('Postgres 'Vanilla)
-> Constraint ('Postgres 'Vanilla)
forall (b :: BackendType). UniqueConstraint b -> Constraint b
_ucConstraint)) (TableCoreInfo ('Postgres 'Vanilla)
-> Maybe (NonEmpty (UniqueConstraint ('Postgres 'Vanilla)))
forall (b :: BackendType) f.
(Eq (Column b), Hashable (Column b)) =>
TableCoreInfoG b f (ColumnInfo b)
-> Maybe (NonEmpty (UniqueConstraint b))
tciUniqueOrPrimaryKeyConstraints TableCoreInfo ('Postgres 'Vanilla)
coreInfo)
      Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"constraint" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ConstraintName
c ConstraintName -> [ConstraintName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ConstraintName]
tableConsNames) (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
Unexpected (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            Text
"constraint " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConstraintName -> Text
getConstraintTxt ConstraintName
c
              Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableCoreInfo ('Postgres 'Vanilla)
-> TableName ('Postgres 'Vanilla)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciName TableCoreInfo ('Postgres 'Vanilla)
coreInfo
              QualifiedTable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"

    getUpdPerm :: m (AnnBoolExpPartialSQL ('Postgres 'Vanilla),
   HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla)))
getUpdPerm = do
      UpdPermInfo ('Postgres 'Vanilla)
upi <- 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
      let updFiltr :: AnnBoolExpPartialSQL ('Postgres 'Vanilla)
updFiltr = UpdPermInfo ('Postgres 'Vanilla)
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
forall (b :: BackendType). UpdPermInfo b -> AnnBoolExpPartialSQL b
upiFilter UpdPermInfo ('Postgres 'Vanilla)
upi
          preSet :: PreSetColsPartial ('Postgres 'Vanilla)
preSet = UpdPermInfo ('Postgres 'Vanilla)
-> PreSetColsPartial ('Postgres 'Vanilla)
forall (b :: BackendType). UpdPermInfo b -> PreSetColsPartial b
upiSet UpdPermInfo ('Postgres 'Vanilla)
upi
          updCols :: [PGCol]
updCols = HashSet PGCol -> [PGCol]
forall a. HashSet a -> [a]
HS.toList (HashSet PGCol -> [PGCol]) -> HashSet PGCol -> [PGCol]
forall a b. (a -> b) -> a -> b
$ UpdPermInfo ('Postgres 'Vanilla)
-> HashSet (Column ('Postgres 'Vanilla))
forall (b :: BackendType). UpdPermInfo b -> HashSet (Column b)
upiCols UpdPermInfo ('Postgres 'Vanilla)
upi
      [PGCol] -> [PGCol] -> m ()
forall (m :: * -> *).
MonadError QErr m =>
[PGCol] -> [PGCol] -> m ()
validateInpCols [PGCol]
inpCols [PGCol]
updCols
      (AnnBoolExpPartialSQL ('Postgres 'Vanilla),
 HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla)))
-> m (AnnBoolExpPartialSQL ('Postgres 'Vanilla),
      HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla)))
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnBoolExpPartialSQL ('Postgres 'Vanilla)
updFiltr, PreSetColsPartial ('Postgres 'Vanilla)
HashMap PGCol (PartialSQLExp ('Postgres 'Vanilla))
preSet)

convInsertQuery ::
  (UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
  (Value -> m [InsObj ('Postgres 'Vanilla)]) ->
  SessionVariableBuilder m ->
  (ColumnType ('Postgres 'Vanilla) -> Value -> m S.SQLExp) ->
  InsertQuery ->
  m (InsertQueryP1 ('Postgres 'Vanilla))
convInsertQuery :: (Value -> m [InsObj ('Postgres 'Vanilla)])
-> SessionVariableBuilder m
-> (ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> InsertQuery
-> m (InsertQueryP1 ('Postgres 'Vanilla))
convInsertQuery Value -> m [InsObj ('Postgres 'Vanilla)]
objsParser SessionVariableBuilder m
sessVarBldr ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp
prepFn (InsertQuery QualifiedTable
tableName SourceName
_ Value
val Maybe OnConflict
oC Maybe [PGCol]
mRetCols) = do
  [HashMap PGCol Value]
insObjs <- Value -> m [InsObj ('Postgres 'Vanilla)]
objsParser Value
val

  -- Get the current table information
  TableInfo ('Postgres 'Vanilla)
tableInfo <- 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 table is view then check if it is insertable
  QualifiedTable
-> (ViewInfo -> Bool) -> Maybe ViewInfo -> Text -> m ()
forall (m :: * -> *).
MonadError QErr m =>
QualifiedTable
-> (ViewInfo -> Bool) -> Maybe ViewInfo -> Text -> m ()
mutableView
    QualifiedTable
tableName
    ViewInfo -> Bool
viIsInsertable
    (TableCoreInfo ('Postgres 'Vanilla) -> Maybe ViewInfo
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe ViewInfo
_tciViewInfo TableCoreInfo ('Postgres 'Vanilla)
coreInfo)
    Text
"insertable"

  -- Check if the role has insert permissions
  InsPermInfo ('Postgres 'Vanilla)
insPerm <- TableInfo ('Postgres 'Vanilla)
-> m (InsPermInfo ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
TableInfo ('Postgres 'Vanilla)
-> m (InsPermInfo ('Postgres 'Vanilla))
askInsPermInfo TableInfo ('Postgres 'Vanilla)
tableInfo
  Maybe (UpdPermInfo ('Postgres 'Vanilla))
updPerm <- Lens'
  (RolePermInfo ('Postgres 'Vanilla))
  (Maybe (UpdPermInfo ('Postgres 'Vanilla)))
-> TableInfo ('Postgres 'Vanilla)
-> m (Maybe (UpdPermInfo ('Postgres 'Vanilla)))
forall (m :: * -> *) c.
UserInfoM m =>
Lens' (RolePermInfo ('Postgres 'Vanilla)) (Maybe c)
-> TableInfo ('Postgres 'Vanilla) -> m (Maybe c)
askPermInfo forall (b :: BackendType).
Lens' (RolePermInfo b) (Maybe (UpdPermInfo b))
Lens'
  (RolePermInfo ('Postgres 'Vanilla))
  (Maybe (UpdPermInfo ('Postgres 'Vanilla)))
permUpd 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
$ InsPermInfo ('Postgres 'Vanilla) -> HashSet Text
forall (b :: BackendType). InsPermInfo b -> HashSet Text
ipiRequiredHeaders InsPermInfo ('Postgres 'Vanilla)
insPerm

  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
      setInsVals :: PreSetColsPartial ('Postgres 'Vanilla)
setInsVals = InsPermInfo ('Postgres 'Vanilla)
-> PreSetColsPartial ('Postgres 'Vanilla)
forall (b :: BackendType). InsPermInfo b -> PreSetColsPartial b
ipiSet InsPermInfo ('Postgres 'Vanilla)
insPerm

  -- 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 -> do
    -- Check if select is allowed only if you specify returning
    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

    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

  let mutOutput :: MutationOutput ('Postgres 'Vanilla)
mutOutput = 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

  let defInsVals :: HashMap PGCol SQLExp
defInsVals =
        [(PGCol, SQLExp)] -> HashMap PGCol SQLExp
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
          [ (ColumnInfo ('Postgres 'Vanilla) -> Column ('Postgres 'Vanilla)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres 'Vanilla)
column, SQLExp
S.columnDefaultValue)
            | ColumnInfo ('Postgres 'Vanilla)
column <- FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> [ColumnInfo ('Postgres 'Vanilla)]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [ColumnInfo backend]
getCols FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap,
              ColumnMutability -> Bool
_cmIsInsertable (ColumnInfo ('Postgres 'Vanilla) -> ColumnMutability
forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciMutability ColumnInfo ('Postgres 'Vanilla)
column)
          ]
      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
      insCols :: [PGCol]
insCols = HashMap PGCol SQLExp -> [PGCol]
forall k v. HashMap k v -> [k]
HM.keys HashMap PGCol SQLExp
defInsVals

  HashMap PGCol SQLExp
resolvedPreSet <- (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))
setInsVals

  [([PGCol], [SQLExp])]
insTuples <- Text -> m [([PGCol], [SQLExp])] -> m [([PGCol], [SQLExp])]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"objects" (m [([PGCol], [SQLExp])] -> m [([PGCol], [SQLExp])])
-> m [([PGCol], [SQLExp])] -> m [([PGCol], [SQLExp])]
forall a b. (a -> b) -> a -> b
$
    [HashMap PGCol Value]
-> (HashMap PGCol Value -> m ([PGCol], [SQLExp]))
-> m [([PGCol], [SQLExp])]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [HashMap PGCol Value]
insObjs ((HashMap PGCol Value -> m ([PGCol], [SQLExp]))
 -> m [([PGCol], [SQLExp])])
-> (HashMap PGCol Value -> m ([PGCol], [SQLExp]))
-> m [([PGCol], [SQLExp])]
forall a b. (a -> b) -> a -> b
$ \HashMap PGCol Value
obj ->
      (ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> HashMap PGCol SQLExp
-> HashMap PGCol SQLExp
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> InsObj ('Postgres 'Vanilla)
-> m ([PGCol], [SQLExp])
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
(ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> HashMap PGCol SQLExp
-> HashMap PGCol SQLExp
-> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
-> InsObj ('Postgres 'Vanilla)
-> m ([PGCol], [SQLExp])
convObj ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp
prepFn HashMap PGCol SQLExp
defInsVals HashMap PGCol SQLExp
resolvedPreSet FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
fieldInfoMap InsObj ('Postgres 'Vanilla)
HashMap PGCol Value
obj
  let sqlExps :: [[SQLExp]]
sqlExps = (([PGCol], [SQLExp]) -> [SQLExp])
-> [([PGCol], [SQLExp])] -> [[SQLExp]]
forall a b. (a -> b) -> [a] -> [b]
map ([PGCol], [SQLExp]) -> [SQLExp]
forall a b. (a, b) -> b
snd [([PGCol], [SQLExp])]
insTuples
      inpCols :: [PGCol]
inpCols = HashSet PGCol -> [PGCol]
forall a. HashSet a -> [a]
HS.toList (HashSet PGCol -> [PGCol]) -> HashSet PGCol -> [PGCol]
forall a b. (a -> b) -> a -> b
$ [PGCol] -> HashSet PGCol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([PGCol] -> HashSet PGCol) -> [PGCol] -> HashSet PGCol
forall a b. (a -> b) -> a -> b
$ (([PGCol], [SQLExp]) -> [PGCol])
-> [([PGCol], [SQLExp])] -> [PGCol]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([PGCol], [SQLExp]) -> [PGCol]
forall a b. (a, b) -> a
fst [([PGCol], [SQLExp])]
insTuples

  AnnBoolExp ('Postgres 'Vanilla) SQLExp
insCheck <- 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
forall (f :: * -> *). Applicative f => SessionVariableBuilder f
sessVarFromCurrentSetting (InsPermInfo ('Postgres 'Vanilla)
-> AnnBoolExpPartialSQL ('Postgres 'Vanilla)
forall (b :: BackendType). InsPermInfo b -> AnnBoolExpPartialSQL b
ipiCheck InsPermInfo ('Postgres 'Vanilla)
insPerm)
  Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
updCheck <- (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
forall (f :: * -> *). Applicative f => SessionVariableBuilder f
sessVarFromCurrentSetting) (UpdPermInfo ('Postgres 'Vanilla)
-> Maybe (AnnBoolExpPartialSQL ('Postgres 'Vanilla))
forall (b :: BackendType).
UpdPermInfo b -> Maybe (AnnBoolExpPartialSQL b)
upiCheck (UpdPermInfo ('Postgres 'Vanilla)
 -> Maybe (AnnBoolExpPartialSQL ('Postgres 'Vanilla)))
-> Maybe (UpdPermInfo ('Postgres 'Vanilla))
-> Maybe (AnnBoolExpPartialSQL ('Postgres 'Vanilla))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (UpdPermInfo ('Postgres 'Vanilla))
updPerm)

  Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp)
conflictClause <- Text
-> m (Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp))
-> m (Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"on_conflict" (m (Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp))
 -> m (Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp)))
-> m (Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp))
-> m (Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp))
forall a b. (a -> b) -> a -> b
$
    Maybe OnConflict
-> (OnConflict -> m (OnConflictClause ('Postgres 'Vanilla) SQLExp))
-> m (Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe OnConflict
oC ((OnConflict -> m (OnConflictClause ('Postgres 'Vanilla) SQLExp))
 -> m (Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp)))
-> (OnConflict -> m (OnConflictClause ('Postgres 'Vanilla) SQLExp))
-> m (Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp))
forall a b. (a -> b) -> a -> b
$ \OnConflict
c -> do
      RoleName
role <- m RoleName
forall (m :: * -> *). UserInfoM m => m RoleName
askCurRole
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RoleName -> TableInfo ('Postgres 'Vanilla) -> Bool
isTabUpdatable RoleName
role TableInfo ('Postgres 'Vanilla)
tableInfo) (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
PermissionDenied (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
          Text
"upsert is not allowed for role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
role
            RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" since update permissions are not defined"
      SessionVariableBuilder m
-> TableInfo ('Postgres 'Vanilla)
-> [PGCol]
-> OnConflict
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
SessionVariableBuilder m
-> TableInfo ('Postgres 'Vanilla)
-> [PGCol]
-> OnConflict
-> m (OnConflictClause ('Postgres 'Vanilla) SQLExp)
buildConflictClause SessionVariableBuilder m
sessVarBldr TableInfo ('Postgres 'Vanilla)
tableInfo [PGCol]
inpCols OnConflict
c
  InsertQueryP1 ('Postgres 'Vanilla)
-> m (InsertQueryP1 ('Postgres 'Vanilla))
forall (m :: * -> *) a. Monad m => a -> m a
return (InsertQueryP1 ('Postgres 'Vanilla)
 -> m (InsertQueryP1 ('Postgres 'Vanilla)))
-> InsertQueryP1 ('Postgres 'Vanilla)
-> m (InsertQueryP1 ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$
    TableName ('Postgres 'Vanilla)
-> [Column ('Postgres 'Vanilla)]
-> [[SQLExpression ('Postgres 'Vanilla)]]
-> Maybe
     (OnConflictClause
        ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
-> (AnnBoolExpSQL ('Postgres 'Vanilla),
    Maybe (AnnBoolExpSQL ('Postgres 'Vanilla)))
-> MutationOutput ('Postgres 'Vanilla)
-> [ColumnInfo ('Postgres 'Vanilla)]
-> InsertQueryP1 ('Postgres 'Vanilla)
forall (b :: BackendType).
TableName b
-> [Column b]
-> [[SQLExpression b]]
-> Maybe (OnConflictClause b (SQLExpression b))
-> (AnnBoolExpSQL b, Maybe (AnnBoolExpSQL b))
-> MutationOutput b
-> [ColumnInfo b]
-> InsertQueryP1 b
InsertQueryP1
      TableName ('Postgres 'Vanilla)
QualifiedTable
tableName
      [Column ('Postgres 'Vanilla)]
[PGCol]
insCols
      [[SQLExpression ('Postgres 'Vanilla)]]
[[SQLExp]]
sqlExps
      Maybe
  (OnConflictClause
     ('Postgres 'Vanilla) (SQLExpression ('Postgres 'Vanilla)))
Maybe (OnConflictClause ('Postgres 'Vanilla) SQLExp)
conflictClause
      (AnnBoolExpSQL ('Postgres 'Vanilla)
AnnBoolExp ('Postgres 'Vanilla) SQLExp
insCheck, Maybe (AnnBoolExpSQL ('Postgres 'Vanilla))
Maybe (AnnBoolExp ('Postgres 'Vanilla) SQLExp)
updCheck)
      MutationOutput ('Postgres 'Vanilla)
mutOutput
      [ColumnInfo ('Postgres 'Vanilla)]
allCols
  where
    selNecessaryMsg :: Text
selNecessaryMsg =
      Text
"; \"returning\" can only be used if the role has "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"select\" permission on the table"

convInsQ ::
  (QErrM m, UserInfoM m, CacheRM m) =>
  InsertQuery ->
  m (InsertQueryP1 ('Postgres 'Vanilla), DS.Seq Q.PrepArg)
convInsQ :: InsertQuery -> m (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
convInsQ InsertQuery
query = do
  let source :: SourceName
source = InsertQuery -> SourceName
iqSource InsertQuery
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
   (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
 -> (SourceName,
     HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
 -> m (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg))
-> (SourceName,
    HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> TableCacheRT
     ('Postgres 'Vanilla)
     m
     (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
-> m (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TableCacheRT
  ('Postgres 'Vanilla)
  m
  (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
-> (SourceName,
    HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla)))
-> m (InsertQueryP1 ('Postgres 'Vanilla), 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
   (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
 -> m (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg))
-> TableCacheRT
     ('Postgres 'Vanilla)
     m
     (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
-> m (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
forall a b. (a -> b) -> a -> b
$
    DMLP1T
  (TableCacheRT ('Postgres 'Vanilla) m)
  (InsertQueryP1 ('Postgres 'Vanilla))
-> TableCacheRT
     ('Postgres 'Vanilla)
     m
     (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
forall (m :: * -> *) a. DMLP1T m a -> m (a, Seq PrepArg)
runDMLP1T (DMLP1T
   (TableCacheRT ('Postgres 'Vanilla) m)
   (InsertQueryP1 ('Postgres 'Vanilla))
 -> TableCacheRT
      ('Postgres 'Vanilla)
      m
      (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg))
-> DMLP1T
     (TableCacheRT ('Postgres 'Vanilla) m)
     (InsertQueryP1 ('Postgres 'Vanilla))
-> TableCacheRT
     ('Postgres 'Vanilla)
     m
     (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
forall a b. (a -> b) -> a -> b
$
      (Value
 -> DMLP1T
      (TableCacheRT ('Postgres 'Vanilla) m)
      [InsObj ('Postgres 'Vanilla)])
-> SessionVariableBuilder
     (DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
-> (ColumnType ('Postgres 'Vanilla)
    -> Value -> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) SQLExp)
-> InsertQuery
-> DMLP1T
     (TableCacheRT ('Postgres 'Vanilla) m)
     (InsertQueryP1 ('Postgres 'Vanilla))
forall (m :: * -> *).
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
(Value -> m [InsObj ('Postgres 'Vanilla)])
-> SessionVariableBuilder m
-> (ColumnType ('Postgres 'Vanilla) -> Value -> m SQLExp)
-> InsertQuery
-> m (InsertQueryP1 ('Postgres 'Vanilla))
convInsertQuery
        (Text
-> DMLP1T
     (TableCacheRT ('Postgres 'Vanilla) m) [HashMap PGCol Value]
-> DMLP1T
     (TableCacheRT ('Postgres 'Vanilla) m) [HashMap PGCol Value]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"objects" (DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) [HashMap PGCol Value]
 -> DMLP1T
      (TableCacheRT ('Postgres 'Vanilla) m) [HashMap PGCol Value])
-> (Value
    -> DMLP1T
         (TableCacheRT ('Postgres 'Vanilla) m) [HashMap PGCol Value])
-> Value
-> DMLP1T
     (TableCacheRT ('Postgres 'Vanilla) m) [HashMap PGCol Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value
-> DMLP1T
     (TableCacheRT ('Postgres 'Vanilla) m) [HashMap PGCol Value]
forall (m :: * -> *).
(UserInfoM m, QErrM m) =>
Value -> m [InsObj ('Postgres 'Vanilla)]
decodeInsObjs)
        SessionVariableBuilder
  (DMLP1T (TableCacheRT ('Postgres 'Vanilla) m))
forall (f :: * -> *). Applicative f => SessionVariableBuilder f
sessVarFromCurrentSetting
        ColumnType ('Postgres 'Vanilla)
-> Value -> DMLP1T (TableCacheRT ('Postgres 'Vanilla) m) SQLExp
forall (m :: * -> *).
QErrM m =>
ColumnType ('Postgres 'Vanilla) -> Value -> DMLP1T m SQLExp
binRHSBuilder
        InsertQuery
query

runInsert ::
  forall m.
  ( QErrM m,
    UserInfoM m,
    CacheRM m,
    HasServerConfigCtx m,
    MonadIO m,
    Tracing.MonadTrace m,
    MonadBaseControl IO m,
    MetadataM m
  ) =>
  InsertQuery ->
  m EncJSON
runInsert :: InsertQuery -> m EncJSON
runInsert InsertQuery
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) (InsertQuery -> SourceName
iqSource InsertQuery
q)
  UserInfo
userInfo <- m UserInfo
forall (m :: * -> *). UserInfoM m => m UserInfo
askUserInfo
  (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
res <- InsertQuery -> m (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m) =>
InsertQuery -> m (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
convInsQ InsertQuery
q
  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
  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)
-> TxET QErr m EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$
    (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)
-> ReaderT QueryTagsComment (TxET QErr m) EncJSON
-> TxET QErr m EncJSON
forall a b. (a -> b) -> a -> b
$ StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
-> ReaderT QueryTagsComment (TxET QErr m) EncJSON
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (InsertQueryP1 ('Postgres pgKind), Seq PrepArg)
-> m EncJSON
execInsertQuery StringifyNumbers
strfyNum Maybe NamingCase
forall a. Maybe a
Nothing UserInfo
userInfo (InsertQueryP1 ('Postgres 'Vanilla), Seq PrepArg)
res

decodeInsObjs :: (UserInfoM m, QErrM m) => Value -> m [InsObj ('Postgres 'Vanilla)]
decodeInsObjs :: Value -> m [InsObj ('Postgres 'Vanilla)]
decodeInsObjs Value
v = do
  [HashMap PGCol Value]
objs <- Value -> m [HashMap PGCol Value]
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue Value
v
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([HashMap PGCol Value] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HashMap PGCol Value]
objs) (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
"objects should not be empty"
  [HashMap PGCol Value] -> m [HashMap PGCol Value]
forall (m :: * -> *) a. Monad m => a -> m a
return [HashMap PGCol Value]
objs