{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Postgres Instances Execute
--
-- This module implements the needed functionality for implementing a 'BackendExecute'
-- instance for Postgres, which defines an interface for translating a root field into
-- an execution plan and interacting with a database.
--
-- This module includes the Postgres implementation of queries, mutations, and more.
module Hasura.Backends.Postgres.Instances.Execute
  ( PreparedSql (..),
    pgDBQueryPlanSimple,
  )
where

import Control.Monad.Trans.Control qualified as MT
import Data.Aeson qualified as J
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.IntMap qualified as IntMap
import Data.Sequence qualified as Seq
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Connection.MonadTx
import Hasura.Backends.Postgres.Execute.ConnectionTemplate (QueryContext (..), QueryOperationType (..))
import Hasura.Backends.Postgres.Execute.Insert (convertToSQLTransaction, validateInsertInput, validateInsertRows)
import Hasura.Backends.Postgres.Execute.Mutation qualified as PGE
import Hasura.Backends.Postgres.Execute.Prepare
  ( PlanningSt (..),
    PrepArgMap,
    initPlanningSt,
    prepareWithPlan,
    prepareWithoutPlan,
    withUserVars,
  )
import Hasura.Backends.Postgres.Execute.Subscription qualified as PGL
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types qualified as Postgres
import Hasura.Backends.Postgres.SQL.Value qualified as Postgres
import Hasura.Backends.Postgres.Translate.Select (PostgresAnnotatedFieldJSON)
import Hasura.Backends.Postgres.Translate.Select qualified as DS
import Hasura.Backends.Postgres.Types.Function qualified as Postgres
import Hasura.Backends.Postgres.Types.Update qualified as Postgres
import Hasura.Base.Error (QErr)
import Hasura.EncJSON (EncJSON, encJFromJValue)
import Hasura.Function.Cache
import Hasura.GraphQL.Execute.Backend
  ( BackendExecute (..),
    DBStepInfo (..),
    ExplainPlan (..),
    OnBaseMonad (..),
    convertRemoteSourceRelationship,
    withNoStatistics,
  )
import Hasura.GraphQL.Execute.Subscription.Plan
  ( CohortId,
    CohortVariables,
    ParameterizedSubscriptionQueryPlan (..),
    SubscriptionQueryPlan (..),
    SubscriptionQueryPlanExplanation (..),
    mkCohortVariables,
    newCohortId,
  )
import Hasura.GraphQL.Namespace
  ( RootFieldAlias (..),
    RootFieldMap,
  )
import Hasura.GraphQL.Namespace qualified as G
import Hasura.GraphQL.Parser.Variable qualified as G
import Hasura.Logging qualified as L
import Hasura.Prelude
import Hasura.QueryTags
  ( QueryTagsComment (..),
    emptyQueryTagsComment,
  )
import Hasura.RQL.IR
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
  ( ColumnType (..),
    ColumnValue (..),
    ciName,
  )
import Hasura.RQL.Types.Common
  ( FieldName (..),
    JsonAggSelect (..),
    SourceName,
  )
import Hasura.RQL.Types.Permission (ValidateInput (..), ValidateInputHttpDefinition (..))
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Session (UserInfo (..))
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Types qualified as HTTP

data PreparedSql = PreparedSql
  { PreparedSql -> Query
_psQuery :: PG.Query,
    PreparedSql -> PrepArgMap
_psPrepArgs :: PrepArgMap
  }
  deriving (Int -> PreparedSql -> ShowS
[PreparedSql] -> ShowS
PreparedSql -> String
(Int -> PreparedSql -> ShowS)
-> (PreparedSql -> String)
-> ([PreparedSql] -> ShowS)
-> Show PreparedSql
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PreparedSql -> ShowS
showsPrec :: Int -> PreparedSql -> ShowS
$cshow :: PreparedSql -> String
show :: PreparedSql -> String
$cshowList :: [PreparedSql] -> ShowS
showList :: [PreparedSql] -> ShowS
Show)

instance
  ( Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind
  ) =>
  BackendExecute ('Postgres pgKind)
  where
  type PreparedQuery ('Postgres pgKind) = PreparedSql
  type MultiplexedQuery ('Postgres pgKind) = PGL.MultiplexedQuery
  type ExecutionMonad ('Postgres pgKind) = PG.TxET QErr

  mkDBQueryPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadQueryTags m,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> m (DBStepInfo ('Postgres pgKind))
mkDBQueryPlan = UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> m (DBStepInfo ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> m (DBStepInfo ('Postgres pgKind))
pgDBQueryPlan
  mkDBMutationPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadQueryTags m,
 MonadReader QueryTagsComment m, MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> MutationDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> Maybe (HashMap Name (Value Variable))
-> m (DBStepInfo ('Postgres pgKind))
mkDBMutationPlan = Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> MutationDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> Maybe (HashMap Name (Value Variable))
-> m (DBStepInfo ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, MonadIO m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind, MonadReader QueryTagsComment m,
 MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> MutationDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> Maybe (HashMap Name (Value Variable))
-> m (DBStepInfo ('Postgres pgKind))
pgDBMutationPlan
  mkLiveQuerySubscriptionPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> Maybe Name
-> RootFieldMap
     (QueryDB
        ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
mkLiveQuerySubscriptionPlan = UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> Maybe Name
-> RootFieldMap
     (QueryDB
        ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, MonadIO m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> Maybe Name
-> RootFieldMap
     (QueryDB
        ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
pgDBLiveQuerySubscriptionPlan
  mkDBStreamingSubscriptionPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> (RootFieldAlias,
    QueryDB
      ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
mkDBStreamingSubscriptionPlan = UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> (RootFieldAlias,
    QueryDB
      ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, MonadIO m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> (RootFieldAlias,
    QueryDB
      ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
pgDBStreamingSubscriptionPlan
  mkDBQueryExplain :: forall (m :: * -> *).
MonadError QErr m =>
RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> m (AnyBackend DBStepInfo)
mkDBQueryExplain = RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> m (AnyBackend DBStepInfo)
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind) =>
RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> m (AnyBackend DBStepInfo)
pgDBQueryExplain
  mkSubscriptionExplain :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
SubscriptionQueryPlan
  ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind))
-> m SubscriptionQueryPlanExplanation
mkSubscriptionExplain = SubscriptionQueryPlan
  ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind))
-> m SubscriptionQueryPlanExplanation
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
SubscriptionQueryPlan
  ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind))
-> m SubscriptionQueryPlanExplanation
pgDBSubscriptionExplain
  mkDBRemoteRelationshipPlan :: forall (m :: * -> *).
(MonadError QErr m, MonadQueryTags m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> NonEmpty Object
-> HashMap
     FieldName
     (Column ('Postgres pgKind), ScalarType ('Postgres pgKind))
-> FieldName
-> (FieldName,
    SourceRelationshipSelection
      ('Postgres pgKind) Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo ('Postgres pgKind))
mkDBRemoteRelationshipPlan = UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> NonEmpty Object
-> HashMap
     FieldName
     (Column ('Postgres pgKind), ScalarType ('Postgres pgKind))
-> FieldName
-> (FieldName,
    SourceRelationshipSelection
      ('Postgres pgKind) Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> NonEmpty Object
-> HashMap
     FieldName
     (Column ('Postgres pgKind), ScalarType ('Postgres pgKind))
-> FieldName
-> (FieldName,
    SourceRelationshipSelection
      ('Postgres pgKind) Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo ('Postgres pgKind))
pgDBRemoteRelationshipPlan

-- query

pgDBQueryPlan ::
  forall pgKind m.
  ( MonadError QErr m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  UserInfo ->
  SourceName ->
  SourceConfig ('Postgres pgKind) ->
  QueryDB ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  m (DBStepInfo ('Postgres pgKind))
pgDBQueryPlan :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> m (DBStepInfo ('Postgres pgKind))
pgDBQueryPlan UserInfo
userInfo SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
qrf [Header]
reqHeaders Maybe Name
operationName = do
  (QueryDB ('Postgres pgKind) Void SQLExp
preparedQuery, PlanningSt {_psPrepped :: PlanningSt -> PrepArgMap
_psPrepped = PrepArgMap
planVals}) <-
    (StateT PlanningSt m (QueryDB ('Postgres pgKind) Void SQLExp)
 -> PlanningSt
 -> m (QueryDB ('Postgres pgKind) Void SQLExp, PlanningSt))
-> PlanningSt
-> StateT PlanningSt m (QueryDB ('Postgres pgKind) Void SQLExp)
-> m (QueryDB ('Postgres pgKind) Void SQLExp, PlanningSt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT PlanningSt m (QueryDB ('Postgres pgKind) Void SQLExp)
-> PlanningSt
-> m (QueryDB ('Postgres pgKind) Void SQLExp, PlanningSt)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT PlanningSt
initPlanningSt (StateT PlanningSt m (QueryDB ('Postgres pgKind) Void SQLExp)
 -> m (QueryDB ('Postgres pgKind) Void SQLExp, PlanningSt))
-> StateT PlanningSt m (QueryDB ('Postgres pgKind) Void SQLExp)
-> m (QueryDB ('Postgres pgKind) Void SQLExp, PlanningSt)
forall a b. (a -> b) -> a -> b
$ (UnpreparedValue ('Postgres pgKind) -> StateT PlanningSt m SQLExp)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StateT PlanningSt m (QueryDB ('Postgres pgKind) Void 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)
-> QueryDB ('Postgres pgKind) Void a
-> f (QueryDB ('Postgres pgKind) Void b)
traverse (UserInfo
-> UnpreparedValue ('Postgres pgKind) -> StateT PlanningSt m SQLExp
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadState PlanningSt m, MonadError QErr m) =>
UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
prepareWithPlan UserInfo
userInfo) QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
qrf

  QueryTagsComment
queryTagsComment <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  Maybe PostgresResolvedConnectionTemplate
resolvedConnectionTemplate <-
    let connectionTemplateResolver :: Maybe ConnectionTemplateResolver
connectionTemplateResolver =
          ConnectionTemplateConfig -> Maybe ConnectionTemplateResolver
connectionTemplateConfigResolver (PGSourceConfig -> ConnectionTemplateConfig
_pscConnectionTemplateConfig SourceConfig ('Postgres pgKind)
PGSourceConfig
sourceConfig)
        queryContext :: Maybe QueryContext
queryContext =
          QueryContext -> Maybe QueryContext
forall a. a -> Maybe a
Just
            (QueryContext -> Maybe QueryContext)
-> QueryContext -> Maybe QueryContext
forall a b. (a -> b) -> a -> b
$ Maybe Name -> QueryOperationType -> QueryContext
QueryContext Maybe Name
operationName
            (QueryOperationType -> QueryContext)
-> QueryOperationType -> QueryContext
forall a b. (a -> b) -> a -> b
$ OperationType -> QueryOperationType
QueryOperationType OperationType
G.OperationTypeQuery
     in Maybe ConnectionTemplateResolver
-> UserInfo
-> [Header]
-> Maybe QueryContext
-> m (Maybe PostgresResolvedConnectionTemplate)
forall (m :: * -> *).
MonadError QErr m =>
Maybe ConnectionTemplateResolver
-> UserInfo
-> [Header]
-> Maybe QueryContext
-> m (Maybe PostgresResolvedConnectionTemplate)
applyConnectionTemplateResolverNonAdmin Maybe ConnectionTemplateResolver
connectionTemplateResolver UserInfo
userInfo [Header]
reqHeaders Maybe QueryContext
queryContext
  let preparedSQLWithQueryTags :: PreparedSql
preparedSQLWithQueryTags = PreparedSql -> QueryTagsComment -> PreparedSql
appendPreparedSQLWithQueryTags (PrepArgMap -> QueryDB ('Postgres pgKind) Void SQLExp -> PreparedSql
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
PrepArgMap -> QueryDB ('Postgres pgKind) Void SQLExp -> PreparedSql
irToRootFieldPlan PrepArgMap
planVals QueryDB ('Postgres pgKind) Void SQLExp
preparedQuery) QueryTagsComment
queryTagsComment
  let (OnBaseMonad (TxET QErr) EncJSON
action, Maybe PreparedSql
preparedSQL) = UserInfo
-> PreparedSql
-> (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
mkCurPlanTx UserInfo
userInfo PreparedSql
preparedSQLWithQueryTags

  DBStepInfo ('Postgres pgKind) -> m (DBStepInfo ('Postgres pgKind))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DBStepInfo ('Postgres pgKind)
 -> m (DBStepInfo ('Postgres pgKind)))
-> DBStepInfo ('Postgres pgKind)
-> m (DBStepInfo ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> OnBaseMonad (ExecutionMonad b) (ActionResult b)
-> ResolvedConnectionTemplate b
-> DBStepInfo b
DBStepInfo @('Postgres pgKind) SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig Maybe (PreparedQuery ('Postgres pgKind))
Maybe PreparedSql
preparedSQL ((EncJSON -> ActionResult ('Postgres pgKind))
-> OnBaseMonad (TxET QErr) EncJSON
-> OnBaseMonad (TxET QErr) (ActionResult ('Postgres pgKind))
forall a b.
(a -> b) -> OnBaseMonad (TxET QErr) a -> OnBaseMonad (TxET QErr) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EncJSON -> ActionResult ('Postgres pgKind)
forall (b :: BackendType). EncJSON -> ActionResult b
withNoStatistics OnBaseMonad (TxET QErr) EncJSON
action) Maybe PostgresResolvedConnectionTemplate
ResolvedConnectionTemplate ('Postgres pgKind)
resolvedConnectionTemplate

-- | Used by the @dc-postgres-agent to compile a query.
pgDBQueryPlanSimple ::
  (MonadError QErr m) =>
  UserInfo ->
  QueryTagsComment ->
  QueryDB ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla)) ->
  m (OnBaseMonad (PG.TxET QErr) EncJSON, Maybe PreparedSql)
pgDBQueryPlanSimple :: forall (m :: * -> *).
MonadError QErr m =>
UserInfo
-> QueryTagsComment
-> QueryDB
     ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
-> m (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
pgDBQueryPlanSimple UserInfo
userInfo QueryTagsComment
queryTagsComment QueryDB
  ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
query = do
  (QueryDB ('Postgres 'Vanilla) Void SQLExp
preparedQuery, PlanningSt {_psPrepped :: PlanningSt -> PrepArgMap
_psPrepped = PrepArgMap
planVals}) <-
    (StateT PlanningSt m (QueryDB ('Postgres 'Vanilla) Void SQLExp)
 -> PlanningSt
 -> m (QueryDB ('Postgres 'Vanilla) Void SQLExp, PlanningSt))
-> PlanningSt
-> StateT PlanningSt m (QueryDB ('Postgres 'Vanilla) Void SQLExp)
-> m (QueryDB ('Postgres 'Vanilla) Void SQLExp, PlanningSt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT PlanningSt m (QueryDB ('Postgres 'Vanilla) Void SQLExp)
-> PlanningSt
-> m (QueryDB ('Postgres 'Vanilla) Void SQLExp, PlanningSt)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT PlanningSt
initPlanningSt (StateT PlanningSt m (QueryDB ('Postgres 'Vanilla) Void SQLExp)
 -> m (QueryDB ('Postgres 'Vanilla) Void SQLExp, PlanningSt))
-> StateT PlanningSt m (QueryDB ('Postgres 'Vanilla) Void SQLExp)
-> m (QueryDB ('Postgres 'Vanilla) Void SQLExp, PlanningSt)
forall a b. (a -> b) -> a -> b
$ (UnpreparedValue ('Postgres 'Vanilla)
 -> StateT PlanningSt m SQLExp)
-> QueryDB
     ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
-> StateT PlanningSt m (QueryDB ('Postgres 'Vanilla) Void 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)
-> QueryDB ('Postgres 'Vanilla) Void a
-> f (QueryDB ('Postgres 'Vanilla) Void b)
traverse (UserInfo
-> UnpreparedValue ('Postgres 'Vanilla)
-> StateT PlanningSt m SQLExp
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadState PlanningSt m, MonadError QErr m) =>
UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
prepareWithPlan UserInfo
userInfo) QueryDB
  ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
query
  let preparedSQLWithQueryTags :: PreparedSql
preparedSQLWithQueryTags =
        PreparedSql -> QueryTagsComment -> PreparedSql
appendPreparedSQLWithQueryTags (PrepArgMap
-> QueryDB ('Postgres 'Vanilla) Void SQLExp -> PreparedSql
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
PrepArgMap -> QueryDB ('Postgres pgKind) Void SQLExp -> PreparedSql
irToRootFieldPlan PrepArgMap
planVals QueryDB ('Postgres 'Vanilla) Void SQLExp
preparedQuery) QueryTagsComment
queryTagsComment
  let (OnBaseMonad (TxET QErr) EncJSON
action, Maybe PreparedSql
preparedSQL) = UserInfo
-> PreparedSql
-> (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
mkCurPlanTx UserInfo
userInfo PreparedSql
preparedSQLWithQueryTags
  (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
-> m (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OnBaseMonad (TxET QErr) EncJSON
action, Maybe PreparedSql
preparedSQL)

pgDBQueryExplain ::
  forall pgKind m.
  ( MonadError QErr m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind
  ) =>
  RootFieldAlias ->
  UserInfo ->
  SourceName ->
  SourceConfig ('Postgres pgKind) ->
  QueryDB ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  m (AB.AnyBackend DBStepInfo)
pgDBQueryExplain :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind) =>
RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> m (AnyBackend DBStepInfo)
pgDBQueryExplain RootFieldAlias
fieldName UserInfo
userInfo SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
rootSelection [Header]
reqHeaders Maybe Name
operationName = do
  QueryDB ('Postgres pgKind) Void SQLExp
preparedQuery <- (UnpreparedValue ('Postgres pgKind) -> m SQLExp)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (QueryDB ('Postgres pgKind) Void 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)
-> QueryDB ('Postgres pgKind) Void a
-> f (QueryDB ('Postgres pgKind) Void b)
traverse (UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadError QErr m =>
UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
prepareWithoutPlan UserInfo
userInfo) QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
rootSelection
  let PreparedSql Query
querySQL PrepArgMap
_ = PrepArgMap -> QueryDB ('Postgres pgKind) Void SQLExp -> PreparedSql
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
PrepArgMap -> QueryDB ('Postgres pgKind) Void SQLExp -> PreparedSql
irToRootFieldPlan PrepArgMap
forall a. Monoid a => a
mempty QueryDB ('Postgres pgKind) Void SQLExp
preparedQuery
      textSQL :: Text
textSQL = Query -> Text
PG.getQueryText Query
querySQL
      -- CAREFUL!: an `EXPLAIN ANALYZE` here would actually *execute* this
      -- query, maybe resulting in privilege escalation:
      withExplain :: Text
withExplain = Text
"EXPLAIN " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textSQL
  let action :: OnBaseMonad (TxET QErr) (ActionResult ('Postgres pgKind))
action = (forall (m :: * -> *).
 (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 TxET QErr m (ActionResult ('Postgres pgKind)))
-> OnBaseMonad (TxET QErr) (ActionResult ('Postgres pgKind))
forall (t :: (* -> *) -> * -> *) a.
(forall (m :: * -> *).
 (Functor (t m), MonadIO m, MonadBaseControl IO m, MonadTrace m,
  MonadError QErr m) =>
 t m a)
-> OnBaseMonad t a
OnBaseMonad do
        (PGTxErr -> QErr)
-> Query -> () -> Bool -> TxET QErr m [Identity Text]
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
PG.withQE PGTxErr -> QErr
dmlTxErrorHandler (Text -> Query
PG.fromText Text
withExplain) () Bool
True TxET QErr m [Identity Text]
-> ([Identity Text] -> ActionResult ('Postgres pgKind))
-> TxET QErr m (ActionResult ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Identity Text]
planList ->
          EncJSON -> ActionResult ('Postgres pgKind)
forall (b :: BackendType). EncJSON -> ActionResult b
withNoStatistics (EncJSON -> ActionResult ('Postgres pgKind))
-> EncJSON -> ActionResult ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$ ExplainPlan -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (ExplainPlan -> EncJSON) -> ExplainPlan -> EncJSON
forall a b. (a -> b) -> a -> b
$ RootFieldAlias -> Maybe Text -> Maybe [Text] -> ExplainPlan
ExplainPlan RootFieldAlias
fieldName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
textSQL) ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ (Identity Text -> Text) -> [Identity Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Identity Text -> Text
forall a. Identity a -> a
runIdentity [Identity Text]
planList)
  Maybe PostgresResolvedConnectionTemplate
resolvedConnectionTemplate <-
    let connectionTemplateResolver :: Maybe ConnectionTemplateResolver
connectionTemplateResolver =
          ConnectionTemplateConfig -> Maybe ConnectionTemplateResolver
connectionTemplateConfigResolver (PGSourceConfig -> ConnectionTemplateConfig
_pscConnectionTemplateConfig SourceConfig ('Postgres pgKind)
PGSourceConfig
sourceConfig)
        queryContext :: Maybe QueryContext
queryContext =
          QueryContext -> Maybe QueryContext
forall a. a -> Maybe a
Just
            (QueryContext -> Maybe QueryContext)
-> QueryContext -> Maybe QueryContext
forall a b. (a -> b) -> a -> b
$ Maybe Name -> QueryOperationType -> QueryContext
QueryContext Maybe Name
operationName
            (QueryOperationType -> QueryContext)
-> QueryOperationType -> QueryContext
forall a b. (a -> b) -> a -> b
$ OperationType -> QueryOperationType
QueryOperationType OperationType
G.OperationTypeQuery
     in Maybe ConnectionTemplateResolver
-> UserInfo
-> [Header]
-> Maybe QueryContext
-> m (Maybe PostgresResolvedConnectionTemplate)
forall (m :: * -> *).
MonadError QErr m =>
Maybe ConnectionTemplateResolver
-> UserInfo
-> [Header]
-> Maybe QueryContext
-> m (Maybe PostgresResolvedConnectionTemplate)
applyConnectionTemplateResolverNonAdmin Maybe ConnectionTemplateResolver
connectionTemplateResolver UserInfo
userInfo [Header]
reqHeaders Maybe QueryContext
queryContext
  AnyBackend DBStepInfo -> m (AnyBackend DBStepInfo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (AnyBackend DBStepInfo -> m (AnyBackend DBStepInfo))
-> AnyBackend DBStepInfo -> m (AnyBackend DBStepInfo)
forall a b. (a -> b) -> a -> b
$ DBStepInfo ('Postgres pgKind) -> AnyBackend DBStepInfo
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
    (DBStepInfo ('Postgres pgKind) -> AnyBackend DBStepInfo)
-> DBStepInfo ('Postgres pgKind) -> AnyBackend DBStepInfo
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> OnBaseMonad (ExecutionMonad b) (ActionResult b)
-> ResolvedConnectionTemplate b
-> DBStepInfo b
DBStepInfo @('Postgres pgKind) SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig Maybe (PreparedQuery ('Postgres pgKind))
Maybe PreparedSql
forall a. Maybe a
Nothing OnBaseMonad (TxET QErr) (ActionResult ('Postgres pgKind))
OnBaseMonad
  (ExecutionMonad ('Postgres pgKind))
  (ActionResult ('Postgres pgKind))
action Maybe PostgresResolvedConnectionTemplate
ResolvedConnectionTemplate ('Postgres pgKind)
resolvedConnectionTemplate

pgDBSubscriptionExplain ::
  ( MonadError QErr m,
    MonadIO m,
    MT.MonadBaseControl IO m
  ) =>
  SubscriptionQueryPlan ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)) ->
  m SubscriptionQueryPlanExplanation
pgDBSubscriptionExplain :: forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
SubscriptionQueryPlan
  ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind))
-> m SubscriptionQueryPlanExplanation
pgDBSubscriptionExplain SubscriptionQueryPlan
  ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind))
plan = do
  let parameterizedPlan :: ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
parameterizedPlan = SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> ParameterizedSubscriptionQueryPlan
     ('Postgres pgKind) MultiplexedQuery
forall (b :: BackendType) q.
SubscriptionQueryPlan b q -> ParameterizedSubscriptionQueryPlan b q
_sqpParameterizedPlan SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
SubscriptionQueryPlan
  ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind))
plan
      pgExecCtx :: PGExecCtx
pgExecCtx = PGSourceConfig -> PGExecCtx
_pscExecCtx (PGSourceConfig -> PGExecCtx) -> PGSourceConfig -> PGExecCtx
forall a b. (a -> b) -> a -> b
$ SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> SourceConfig ('Postgres pgKind)
forall (b :: BackendType) q.
SubscriptionQueryPlan b q -> SourceConfig b
_sqpSourceConfig SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
SubscriptionQueryPlan
  ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind))
plan
      queryText :: Text
queryText = Query -> Text
PG.getQueryText (Query -> Text)
-> (MultiplexedQuery -> Query) -> MultiplexedQuery -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiplexedQuery -> Query
PGL.unMultiplexedQuery (MultiplexedQuery -> Text) -> MultiplexedQuery -> Text
forall a b. (a -> b) -> a -> b
$ ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
-> MultiplexedQuery
forall (b :: BackendType) q.
ParameterizedSubscriptionQueryPlan b q -> q
_plqpQuery ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
parameterizedPlan
      -- CAREFUL!: an `EXPLAIN ANALYZE` here would actually *execute* this
      -- query, maybe resulting in privilege escalation:
      explainQuery :: Query
explainQuery = Text -> Query
PG.fromText (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"EXPLAIN " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
queryText
      resolvedConnectionTemplate :: ResolvedConnectionTemplate ('Postgres pgKind)
resolvedConnectionTemplate = SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> ResolvedConnectionTemplate ('Postgres pgKind)
forall (b :: BackendType) q.
SubscriptionQueryPlan b q -> ResolvedConnectionTemplate b
_sqpResolvedConnectionTemplate SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
SubscriptionQueryPlan
  ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind))
plan
  CohortId
cohortId <- m CohortId
forall (m :: * -> *). MonadIO m => m CohortId
newCohortId
  [Text]
explanationLines <-
    m (Either QErr [Text]) -> m [Text]
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM
      (m (Either QErr [Text]) -> m [Text])
-> m (Either QErr [Text]) -> m [Text]
forall a b. (a -> b) -> a -> b
$ ExceptT QErr m [Text] -> m (Either QErr [Text])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
      (ExceptT QErr m [Text] -> m (Either QErr [Text]))
-> ExceptT QErr m [Text] -> m (Either QErr [Text])
forall a b. (a -> b) -> a -> b
$ PGExecCtx -> PGExecCtxInfo -> RunTx
_pecRunTx PGExecCtx
pgExecCtx (PGExecTxType -> PGExecFrom -> PGExecCtxInfo
PGExecCtxInfo (TxAccess -> Maybe TxIsolation -> PGExecTxType
Tx TxAccess
PG.ReadOnly Maybe TxIsolation
forall a. Maybe a
Nothing) (Maybe PostgresResolvedConnectionTemplate -> PGExecFrom
GraphQLQuery Maybe PostgresResolvedConnectionTemplate
ResolvedConnectionTemplate ('Postgres pgKind)
resolvedConnectionTemplate))
      (TxET QErr m [Text] -> ExceptT QErr m [Text])
-> TxET QErr m [Text] -> ExceptT QErr m [Text]
forall a b. (a -> b) -> a -> b
$ (Identity Text -> Text) -> [Identity Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Identity Text -> Text
forall a. Identity a -> a
runIdentity
      ([Identity Text] -> [Text])
-> TxET QErr m [Identity Text] -> TxET QErr m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query
-> [(CohortId, CohortVariables)] -> TxET QErr m [Identity Text]
forall (m :: * -> *) a.
(MonadTx m, FromRes a) =>
Query -> [(CohortId, CohortVariables)] -> m a
PGL.executeQuery Query
explainQuery [(CohortId
cohortId, SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> CohortVariables
forall (b :: BackendType) q.
SubscriptionQueryPlan b q -> CohortVariables
_sqpVariables SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
SubscriptionQueryPlan
  ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind))
plan)]
  SubscriptionQueryPlanExplanation
-> m SubscriptionQueryPlanExplanation
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubscriptionQueryPlanExplanation
 -> m SubscriptionQueryPlanExplanation)
-> SubscriptionQueryPlanExplanation
-> m SubscriptionQueryPlanExplanation
forall a b. (a -> b) -> a -> b
$ Text
-> [Text] -> CohortVariables -> SubscriptionQueryPlanExplanation
SubscriptionQueryPlanExplanation Text
queryText [Text]
explanationLines (CohortVariables -> SubscriptionQueryPlanExplanation)
-> CohortVariables -> SubscriptionQueryPlanExplanation
forall a b. (a -> b) -> a -> b
$ SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> CohortVariables
forall (b :: BackendType) q.
SubscriptionQueryPlan b q -> CohortVariables
_sqpVariables SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
SubscriptionQueryPlan
  ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind))
plan

-- mutation

convertDelete ::
  forall pgKind m.
  ( MonadError QErr m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m,
    MonadIO m,
    Tracing.MonadTrace m
  ) =>
  Env.Environment ->
  HTTP.Manager ->
  L.Logger L.Hasura ->
  UserInfo ->
  IR.AnnDelG ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  Options.StringifyNumbers ->
  [HTTP.Header] ->
  Maybe (HashMap G.Name (G.Value G.Variable)) ->
  m (OnBaseMonad (PG.TxET QErr) EncJSON)
convertDelete :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind, MonadReader QueryTagsComment m,
 MonadIO m, MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> AnnDelG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> [Header]
-> Maybe (HashMap Name (Value Variable))
-> m (OnBaseMonad (TxET QErr) EncJSON)
convertDelete Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
deleteOperation StringifyNumbers
stringifyNum [Header]
reqHeaders Maybe (HashMap Name (Value Variable))
selSetArguments = do
  Maybe (ValidateInput ResolvedWebhook)
-> (ValidateInput ResolvedWebhook -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> Maybe (ValidateInput ResolvedWebhook)
forall (b :: BackendType) r v.
AnnDelG b r v -> Maybe (ValidateInput ResolvedWebhook)
_adValidateInput AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
deleteOperation) ((ValidateInput ResolvedWebhook -> m ()) -> m ())
-> (ValidateInput ResolvedWebhook -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(VIHttp ValidateInputHttpDefinition {Bool
[HeaderConf]
Timeout
ResolvedWebhook
_vihdUrl :: ResolvedWebhook
_vihdHeaders :: [HeaderConf]
_vihdTimeout :: Timeout
_vihdForwardClientHeaders :: Bool
_vihdUrl :: forall webhook. ValidateInputHttpDefinition webhook -> webhook
_vihdHeaders :: forall webhook. ValidateInputHttpDefinition webhook -> [HeaderConf]
_vihdTimeout :: forall webhook. ValidateInputHttpDefinition webhook -> Timeout
_vihdForwardClientHeaders :: forall webhook. ValidateInputHttpDefinition webhook -> Bool
..}) -> do
    Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> ResolvedWebhook
-> [HeaderConf]
-> Timeout
-> Bool
-> [Header]
-> AnnDelG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> Maybe (HashMap Name (Value Variable))
-> m ()
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadError QErr m, MonadIO m, MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> ResolvedWebhook
-> [HeaderConf]
-> Timeout
-> Bool
-> [Header]
-> AnnDelG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> Maybe (HashMap Name (Value Variable))
-> m ()
PGE.validateDeleteMutation Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo ResolvedWebhook
_vihdUrl [HeaderConf]
_vihdHeaders Timeout
_vihdTimeout Bool
_vihdForwardClientHeaders [Header]
reqHeaders AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
deleteOperation Maybe (HashMap Name (Value Variable))
selSetArguments
  QueryTagsComment
queryTags <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  AnnDelG ('Postgres pgKind) Void SQLExp
preparedDelete <- (UnpreparedValue ('Postgres pgKind) -> m SQLExp)
-> AnnDelG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (AnnDelG ('Postgres pgKind) Void 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)
-> AnnDelG ('Postgres pgKind) Void a
-> f (AnnDelG ('Postgres pgKind) Void b)
traverse (UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadError QErr m =>
UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
prepareWithoutPlan UserInfo
userInfo) AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
deleteOperation
  OnBaseMonad (TxET QErr) EncJSON
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (OnBaseMonad (TxET QErr) EncJSON
 -> m (OnBaseMonad (TxET QErr) EncJSON))
-> OnBaseMonad (TxET QErr) EncJSON
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
 (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 TxET QErr m EncJSON)
-> OnBaseMonad (TxET QErr) EncJSON
forall (t :: (* -> *) -> * -> *) a.
(forall (m :: * -> *).
 (Functor (t m), MonadIO m, MonadBaseControl IO m, MonadTrace m,
  MonadError QErr m) =>
 t m a)
-> OnBaseMonad t a
OnBaseMonad
    ((forall (m :: * -> *).
  (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
   MonadTrace m, MonadError QErr m) =>
  TxET QErr m EncJSON)
 -> OnBaseMonad (TxET QErr) EncJSON)
-> (forall (m :: * -> *).
    (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
     MonadTrace m, MonadError QErr m) =>
    TxET QErr m EncJSON)
-> OnBaseMonad (TxET QErr) 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
queryTags
    (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
-> (AnnDel ('Postgres pgKind), 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
-> (AnnDel ('Postgres pgKind), Seq PrepArg)
-> m EncJSON
PGE.execDeleteQuery StringifyNumbers
stringifyNum (AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> Maybe NamingCase
forall (b :: BackendType) r v. AnnDelG b r v -> Maybe NamingCase
_adNamingConvention AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
deleteOperation) UserInfo
userInfo (AnnDel ('Postgres pgKind)
AnnDelG ('Postgres pgKind) Void SQLExp
preparedDelete, Seq PrepArg
forall a. Seq a
Seq.empty)

convertUpdate ::
  forall pgKind m.
  ( MonadError QErr m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m,
    MonadIO m,
    Tracing.MonadTrace m
  ) =>
  Env.Environment ->
  HTTP.Manager ->
  L.Logger L.Hasura ->
  UserInfo ->
  IR.AnnotatedUpdateG ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  Options.StringifyNumbers ->
  [HTTP.Header] ->
  Maybe (HashMap G.Name (G.Value G.Variable)) ->
  m (OnBaseMonad (PG.TxET QErr) EncJSON)
convertUpdate :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind, MonadReader QueryTagsComment m,
 MonadIO m, MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> AnnotatedUpdateG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> [Header]
-> Maybe (HashMap Name (Value Variable))
-> m (OnBaseMonad (TxET QErr) EncJSON)
convertUpdate Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
updateOperation StringifyNumbers
stringifyNum [Header]
reqHeaders Maybe (HashMap Name (Value Variable))
selSetArguments = do
  Maybe (ValidateInput ResolvedWebhook)
-> (ValidateInput ResolvedWebhook -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> Maybe (ValidateInput ResolvedWebhook)
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> Maybe (ValidateInput ResolvedWebhook)
_auValidateInput AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
updateOperation) ((ValidateInput ResolvedWebhook -> m ()) -> m ())
-> (ValidateInput ResolvedWebhook -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(VIHttp ValidateInputHttpDefinition {Bool
[HeaderConf]
Timeout
ResolvedWebhook
_vihdUrl :: forall webhook. ValidateInputHttpDefinition webhook -> webhook
_vihdHeaders :: forall webhook. ValidateInputHttpDefinition webhook -> [HeaderConf]
_vihdTimeout :: forall webhook. ValidateInputHttpDefinition webhook -> Timeout
_vihdForwardClientHeaders :: forall webhook. ValidateInputHttpDefinition webhook -> Bool
_vihdUrl :: ResolvedWebhook
_vihdHeaders :: [HeaderConf]
_vihdTimeout :: Timeout
_vihdForwardClientHeaders :: Bool
..}) -> do
    Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> ResolvedWebhook
-> [HeaderConf]
-> Timeout
-> Bool
-> [Header]
-> AnnotatedUpdateG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> Maybe (HashMap Name (Value Variable))
-> m ()
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> ResolvedWebhook
-> [HeaderConf]
-> Timeout
-> Bool
-> [Header]
-> AnnotatedUpdateG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> Maybe (HashMap Name (Value Variable))
-> m ()
PGE.validateUpdateMutation Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo ResolvedWebhook
_vihdUrl [HeaderConf]
_vihdHeaders Timeout
_vihdTimeout Bool
_vihdForwardClientHeaders [Header]
reqHeaders AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
updateOperation Maybe (HashMap Name (Value Variable))
selSetArguments
  QueryTagsComment
queryTags <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  AnnotatedUpdateG ('Postgres pgKind) Void SQLExp
preparedUpdate <- (UnpreparedValue ('Postgres pgKind) -> m SQLExp)
-> AnnotatedUpdateG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (AnnotatedUpdateG ('Postgres pgKind) Void 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)
-> AnnotatedUpdateG ('Postgres pgKind) Void a
-> f (AnnotatedUpdateG ('Postgres pgKind) Void b)
traverse (UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadError QErr m =>
UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
prepareWithoutPlan UserInfo
userInfo) AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
updateOperation
  if PgUpdateVariant pgKind (UnpreparedValue ('Postgres pgKind)) -> Bool
forall (b :: PostgresKind) v. PgUpdateVariant b v -> Bool
Postgres.updateVariantIsEmpty (PgUpdateVariant pgKind (UnpreparedValue ('Postgres pgKind))
 -> Bool)
-> PgUpdateVariant pgKind (UnpreparedValue ('Postgres pgKind))
-> Bool
forall a b. (a -> b) -> a -> b
$ AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> UpdateVariant
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> UpdateVariant b v
IR._auUpdateVariant AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
updateOperation
    then OnBaseMonad (TxET QErr) EncJSON
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OnBaseMonad (TxET QErr) EncJSON
 -> m (OnBaseMonad (TxET QErr) EncJSON))
-> OnBaseMonad (TxET QErr) EncJSON
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
 (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 TxET QErr m EncJSON)
-> OnBaseMonad (TxET QErr) EncJSON
forall (t :: (* -> *) -> * -> *) a.
(forall (m :: * -> *).
 (Functor (t m), MonadIO m, MonadBaseControl IO m, MonadTrace m,
  MonadError QErr m) =>
 t m a)
-> OnBaseMonad t a
OnBaseMonad ((forall (m :: * -> *).
  (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
   MonadTrace m, MonadError QErr m) =>
  TxET QErr m EncJSON)
 -> OnBaseMonad (TxET QErr) EncJSON)
-> (forall (m :: * -> *).
    (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
     MonadTrace m, MonadError QErr m) =>
    TxET QErr m EncJSON)
-> OnBaseMonad (TxET QErr) EncJSON
forall a b. (a -> b) -> a -> b
$ EncJSON -> TxET QErr m EncJSON
forall a. a -> TxET QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> TxET QErr m EncJSON) -> EncJSON -> TxET QErr m EncJSON
forall a b. (a -> b) -> a -> b
$ MutationOutput ('Postgres pgKind) -> EncJSON
forall (backend :: BackendType). MutationOutput backend -> EncJSON
IR.buildEmptyMutResp (MutationOutput ('Postgres pgKind) -> EncJSON)
-> MutationOutput ('Postgres pgKind) -> EncJSON
forall a b. (a -> b) -> a -> b
$ AnnotatedUpdateG ('Postgres pgKind) Void SQLExp
-> MutationOutputG ('Postgres pgKind) Void SQLExp
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> MutationOutputG b r v
IR._auOutput AnnotatedUpdateG ('Postgres pgKind) Void SQLExp
preparedUpdate
    else
      OnBaseMonad (TxET QErr) EncJSON
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (OnBaseMonad (TxET QErr) EncJSON
 -> m (OnBaseMonad (TxET QErr) EncJSON))
-> OnBaseMonad (TxET QErr) EncJSON
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
 (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 TxET QErr m EncJSON)
-> OnBaseMonad (TxET QErr) EncJSON
forall (t :: (* -> *) -> * -> *) a.
(forall (m :: * -> *).
 (Functor (t m), MonadIO m, MonadBaseControl IO m, MonadTrace m,
  MonadError QErr m) =>
 t m a)
-> OnBaseMonad t a
OnBaseMonad
        ((forall (m :: * -> *).
  (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
   MonadTrace m, MonadError QErr m) =>
  TxET QErr m EncJSON)
 -> OnBaseMonad (TxET QErr) EncJSON)
-> (forall (m :: * -> *).
    (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
     MonadTrace m, MonadError QErr m) =>
    TxET QErr m EncJSON)
-> OnBaseMonad (TxET QErr) 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
queryTags
        (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
-> (AnnotatedUpdate ('Postgres pgKind), 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
PGE.execUpdateQuery StringifyNumbers
stringifyNum (AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> Maybe NamingCase
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> Maybe NamingCase
_auNamingConvention AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
updateOperation) UserInfo
userInfo (AnnotatedUpdate ('Postgres pgKind)
AnnotatedUpdateG ('Postgres pgKind) Void SQLExp
preparedUpdate, Seq PrepArg
forall a. Seq a
Seq.empty)

convertInsert ::
  forall pgKind m.
  ( MonadError QErr m,
    MonadIO m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m,
    Tracing.MonadTrace m
  ) =>
  Env.Environment ->
  HTTP.Manager ->
  L.Logger L.Hasura ->
  UserInfo ->
  IR.AnnotatedInsert ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  Options.StringifyNumbers ->
  [HTTP.Header] ->
  m (OnBaseMonad (PG.TxET QErr) EncJSON)
convertInsert :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, MonadIO m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind, MonadReader QueryTagsComment m,
 MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> AnnotatedInsert
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> [Header]
-> m (OnBaseMonad (TxET QErr) EncJSON)
convertInsert Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo AnnotatedInsert
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
insertOperation StringifyNumbers
stringifyNum [Header]
reqHeaders = do
  -- Validate insert data
  (()
_, InsOrdHashMap
  QualifiedTable
  ([AnnotatedInsertRow
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
   ValidateInput ResolvedWebhook)
res) <- (StateT
   (InsOrdHashMap
      QualifiedTable
      ([AnnotatedInsertRow
          ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
       ValidateInput ResolvedWebhook))
   m
   ()
 -> InsOrdHashMap
      QualifiedTable
      ([AnnotatedInsertRow
          ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
       ValidateInput ResolvedWebhook)
 -> m ((),
       InsOrdHashMap
         QualifiedTable
         ([AnnotatedInsertRow
             ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
          ValidateInput ResolvedWebhook)))
-> InsOrdHashMap
     QualifiedTable
     ([AnnotatedInsertRow
         ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
      ValidateInput ResolvedWebhook)
-> StateT
     (InsOrdHashMap
        QualifiedTable
        ([AnnotatedInsertRow
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
         ValidateInput ResolvedWebhook))
     m
     ()
-> m ((),
      InsOrdHashMap
        QualifiedTable
        ([AnnotatedInsertRow
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
         ValidateInput ResolvedWebhook))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  (InsOrdHashMap
     QualifiedTable
     ([AnnotatedInsertRow
         ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
      ValidateInput ResolvedWebhook))
  m
  ()
-> InsOrdHashMap
     QualifiedTable
     ([AnnotatedInsertRow
         ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
      ValidateInput ResolvedWebhook)
-> m ((),
      InsOrdHashMap
        QualifiedTable
        ([AnnotatedInsertRow
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
         ValidateInput ResolvedWebhook))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT InsOrdHashMap
  QualifiedTable
  ([AnnotatedInsertRow
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
   ValidateInput ResolvedWebhook)
forall k v. InsOrdHashMap k v
InsOrdHashMap.empty (StateT
   (InsOrdHashMap
      QualifiedTable
      ([AnnotatedInsertRow
          ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
       ValidateInput ResolvedWebhook))
   m
   ()
 -> m ((),
       InsOrdHashMap
         QualifiedTable
         ([AnnotatedInsertRow
             ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
          ValidateInput ResolvedWebhook)))
-> StateT
     (InsOrdHashMap
        QualifiedTable
        ([AnnotatedInsertRow
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
         ValidateInput ResolvedWebhook))
     m
     ()
-> m ((),
      InsOrdHashMap
        QualifiedTable
        ([AnnotatedInsertRow
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
         ValidateInput ResolvedWebhook))
forall a b. (a -> b) -> a -> b
$ Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> MultiObjectInsert
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> StateT
     (InsOrdHashMap
        QualifiedTable
        ([AnnotatedInsertRow
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
         ValidateInput ResolvedWebhook))
     m
     ()
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadError QErr m, MonadIO m, MonadTrace m,
 MonadState (InsertValidationPayloadMap pgKind) m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> MultiObjectInsert
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> m ()
validateInsertInput Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo (AnnotatedInsert
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> MultiObjectInsert
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
IR._aiData AnnotatedInsert
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
insertOperation) [Header]
reqHeaders
  InsOrdHashMap
  QualifiedTable
  ([AnnotatedInsertRow
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
   ValidateInput ResolvedWebhook)
-> (([AnnotatedInsertRow
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
     ValidateInput ResolvedWebhook)
    -> m ())
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ InsOrdHashMap
  QualifiedTable
  ([AnnotatedInsertRow
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
   ValidateInput ResolvedWebhook)
res ((([AnnotatedInsertRow
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
   ValidateInput ResolvedWebhook)
  -> m ())
 -> m ())
-> (([AnnotatedInsertRow
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))],
     ValidateInput ResolvedWebhook)
    -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ \([AnnotatedInsertRow
   ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]
rows, VIHttp ValidateInputHttpDefinition {Bool
[HeaderConf]
Timeout
ResolvedWebhook
_vihdUrl :: forall webhook. ValidateInputHttpDefinition webhook -> webhook
_vihdHeaders :: forall webhook. ValidateInputHttpDefinition webhook -> [HeaderConf]
_vihdTimeout :: forall webhook. ValidateInputHttpDefinition webhook -> Timeout
_vihdForwardClientHeaders :: forall webhook. ValidateInputHttpDefinition webhook -> Bool
_vihdUrl :: ResolvedWebhook
_vihdHeaders :: [HeaderConf]
_vihdTimeout :: Timeout
_vihdForwardClientHeaders :: Bool
..}) -> do
    Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> ResolvedWebhook
-> [HeaderConf]
-> Timeout
-> Bool
-> [Header]
-> [AnnotatedInsertRow
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]
-> m ()
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadError QErr m, MonadIO m, MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> ResolvedWebhook
-> [HeaderConf]
-> Timeout
-> Bool
-> [Header]
-> [AnnotatedInsertRow
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]
-> m ()
validateInsertRows Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo ResolvedWebhook
_vihdUrl [HeaderConf]
_vihdHeaders Timeout
_vihdTimeout Bool
_vihdForwardClientHeaders [Header]
reqHeaders [AnnotatedInsertRow
   ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]
rows
  QueryTagsComment
queryTags <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  AnnotatedInsert ('Postgres pgKind) Void SQLExp
preparedInsert <- (UnpreparedValue ('Postgres pgKind) -> m SQLExp)
-> AnnotatedInsert
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (AnnotatedInsert ('Postgres pgKind) Void 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)
-> AnnotatedInsert ('Postgres pgKind) Void a
-> f (AnnotatedInsert ('Postgres pgKind) Void b)
traverse (UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadError QErr m =>
UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
prepareWithoutPlan UserInfo
userInfo) AnnotatedInsert
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
insertOperation
  OnBaseMonad (TxET QErr) EncJSON
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (OnBaseMonad (TxET QErr) EncJSON
 -> m (OnBaseMonad (TxET QErr) EncJSON))
-> OnBaseMonad (TxET QErr) EncJSON
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
 (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 TxET QErr m EncJSON)
-> OnBaseMonad (TxET QErr) EncJSON
forall (t :: (* -> *) -> * -> *) a.
(forall (m :: * -> *).
 (Functor (t m), MonadIO m, MonadBaseControl IO m, MonadTrace m,
  MonadError QErr m) =>
 t m a)
-> OnBaseMonad t a
OnBaseMonad
    ((forall (m :: * -> *).
  (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
   MonadTrace m, MonadError QErr m) =>
  TxET QErr m EncJSON)
 -> OnBaseMonad (TxET QErr) EncJSON)
-> (forall (m :: * -> *).
    (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
     MonadTrace m, MonadError QErr m) =>
    TxET QErr m EncJSON)
-> OnBaseMonad (TxET QErr) 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
queryTags
    (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
$ AnnotatedInsert ('Postgres pgKind) Void SQLExp
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> ReaderT QueryTagsComment (TxET QErr m) EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, MonadIO m, MonadTrace m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
AnnotatedInsert ('Postgres pgKind) Void SQLExp
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m EncJSON
convertToSQLTransaction AnnotatedInsert ('Postgres pgKind) Void SQLExp
preparedInsert UserInfo
userInfo Seq PrepArg
forall a. Seq a
Seq.empty StringifyNumbers
stringifyNum (AnnotatedInsert
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> Maybe NamingCase
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> Maybe NamingCase
_aiNamingConvention AnnotatedInsert
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
insertOperation)

-- | A pared-down version of 'Query.convertQuerySelSet', for use in execution of
-- special case of SQL function mutations (see 'MDBFunction').
convertFunction ::
  forall pgKind m.
  ( MonadError QErr m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  UserInfo ->
  JsonAggSelect ->
  -- | VOLATILE function as 'SelectExp'
  IR.AnnSimpleSelectG ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  m (OnBaseMonad (PG.TxET QErr) EncJSON)
convertFunction :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> JsonAggSelect
-> AnnSimpleSelectG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (OnBaseMonad (TxET QErr) EncJSON)
convertFunction UserInfo
userInfo JsonAggSelect
jsonAggSelect AnnSimpleSelectG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
unpreparedQuery = do
  QueryTagsComment
queryTags <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  -- Transform the RQL AST into a prepared SQL query
  (AnnSelectG
  ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp
preparedQuery, PlanningSt {_psPrepped :: PlanningSt -> PrepArgMap
_psPrepped = PrepArgMap
planVals}) <-
    (StateT
   PlanningSt
   m
   (AnnSelectG
      ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp)
 -> PlanningSt
 -> m (AnnSelectG
         ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp,
       PlanningSt))
-> PlanningSt
-> StateT
     PlanningSt
     m
     (AnnSelectG
        ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp)
-> m (AnnSelectG
        ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp,
      PlanningSt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  PlanningSt
  m
  (AnnSelectG
     ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp)
-> PlanningSt
-> m (AnnSelectG
        ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp,
      PlanningSt)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT PlanningSt
initPlanningSt
      (StateT
   PlanningSt
   m
   (AnnSelectG
      ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp)
 -> m (AnnSelectG
         ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp,
       PlanningSt))
-> StateT
     PlanningSt
     m
     (AnnSelectG
        ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp)
-> m (AnnSelectG
        ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp,
      PlanningSt)
forall a b. (a -> b) -> a -> b
$ (UnpreparedValue ('Postgres pgKind) -> StateT PlanningSt m SQLExp)
-> AnnSimpleSelectG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StateT
     PlanningSt
     m
     (AnnSelectG
        ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) 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)
-> AnnSelectG
     ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) a
-> f (AnnSelectG
        ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) b)
traverse (UserInfo
-> UnpreparedValue ('Postgres pgKind) -> StateT PlanningSt m SQLExp
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadState PlanningSt m, MonadError QErr m) =>
UserInfo -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
prepareWithPlan UserInfo
userInfo) AnnSimpleSelectG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
unpreparedQuery
  let queryResultFn :: AnnSelectG
  ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp
-> QueryDB ('Postgres pgKind) Void SQLExp
queryResultFn =
        case JsonAggSelect
jsonAggSelect of
          JsonAggSelect
JASMultipleRows -> AnnSelectG
  ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp
-> QueryDB ('Postgres pgKind) Void SQLExp
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
QDBMultipleRows
          JsonAggSelect
JASSingleObject -> AnnSelectG
  ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp
-> QueryDB ('Postgres pgKind) Void SQLExp
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
QDBSingleRow
  let preparedSQLWithQueryTags :: PreparedSql
preparedSQLWithQueryTags = PreparedSql -> QueryTagsComment -> PreparedSql
appendPreparedSQLWithQueryTags (PrepArgMap -> QueryDB ('Postgres pgKind) Void SQLExp -> PreparedSql
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
PrepArgMap -> QueryDB ('Postgres pgKind) Void SQLExp -> PreparedSql
irToRootFieldPlan PrepArgMap
planVals (QueryDB ('Postgres pgKind) Void SQLExp -> PreparedSql)
-> QueryDB ('Postgres pgKind) Void SQLExp -> PreparedSql
forall a b. (a -> b) -> a -> b
$ AnnSelectG
  ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp
-> QueryDB ('Postgres pgKind) Void SQLExp
queryResultFn AnnSelectG
  ('Postgres pgKind) (AnnFieldG ('Postgres pgKind) Void) SQLExp
preparedQuery) QueryTagsComment
queryTags
  OnBaseMonad (TxET QErr) EncJSON
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (OnBaseMonad (TxET QErr) EncJSON
 -> m (OnBaseMonad (TxET QErr) EncJSON))
-> OnBaseMonad (TxET QErr) EncJSON
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall a b. (a -> b) -> a -> b
$! (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
-> OnBaseMonad (TxET QErr) EncJSON
forall a b. (a, b) -> a
fst
    ((OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
 -> OnBaseMonad (TxET QErr) EncJSON)
-> (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
-> OnBaseMonad (TxET QErr) EncJSON
forall a b. (a -> b) -> a -> b
$ UserInfo
-> PreparedSql
-> (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
mkCurPlanTx UserInfo
userInfo PreparedSql
preparedSQLWithQueryTags -- forget (Maybe PreparedSql)

pgDBMutationPlan ::
  forall pgKind m.
  ( MonadError QErr m,
    MonadIO m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m,
    Tracing.MonadTrace m
  ) =>
  Env.Environment ->
  HTTP.Manager ->
  L.Logger L.Hasura ->
  UserInfo ->
  Options.StringifyNumbers ->
  SourceName ->
  SourceConfig ('Postgres pgKind) ->
  MutationDB ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  Maybe (HashMap G.Name (G.Value G.Variable)) ->
  m (DBStepInfo ('Postgres pgKind))
pgDBMutationPlan :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, MonadIO m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind, MonadReader QueryTagsComment m,
 MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> MutationDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> Maybe (HashMap Name (Value Variable))
-> m (DBStepInfo ('Postgres pgKind))
pgDBMutationPlan Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo StringifyNumbers
stringifyNum SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig MutationDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
mrf [Header]
reqHeaders Maybe Name
operationName Maybe (HashMap Name (Value Variable))
selSetArguments = do
  Maybe PostgresResolvedConnectionTemplate
resolvedConnectionTemplate <-
    let connectionTemplateResolver :: Maybe ConnectionTemplateResolver
connectionTemplateResolver =
          ConnectionTemplateConfig -> Maybe ConnectionTemplateResolver
connectionTemplateConfigResolver (PGSourceConfig -> ConnectionTemplateConfig
_pscConnectionTemplateConfig SourceConfig ('Postgres pgKind)
PGSourceConfig
sourceConfig)
        queryContext :: Maybe QueryContext
queryContext =
          QueryContext -> Maybe QueryContext
forall a. a -> Maybe a
Just
            (QueryContext -> Maybe QueryContext)
-> QueryContext -> Maybe QueryContext
forall a b. (a -> b) -> a -> b
$ Maybe Name -> QueryOperationType -> QueryContext
QueryContext Maybe Name
operationName
            (QueryOperationType -> QueryContext)
-> QueryOperationType -> QueryContext
forall a b. (a -> b) -> a -> b
$ OperationType -> QueryOperationType
QueryOperationType OperationType
G.OperationTypeMutation
     in Maybe ConnectionTemplateResolver
-> UserInfo
-> [Header]
-> Maybe QueryContext
-> m (Maybe PostgresResolvedConnectionTemplate)
forall (m :: * -> *).
MonadError QErr m =>
Maybe ConnectionTemplateResolver
-> UserInfo
-> [Header]
-> Maybe QueryContext
-> m (Maybe PostgresResolvedConnectionTemplate)
applyConnectionTemplateResolverNonAdmin Maybe ConnectionTemplateResolver
connectionTemplateResolver UserInfo
userInfo [Header]
reqHeaders Maybe QueryContext
queryContext
  Maybe PostgresResolvedConnectionTemplate
-> OnBaseMonad (TxET QErr) EncJSON -> DBStepInfo ('Postgres pgKind)
go Maybe PostgresResolvedConnectionTemplate
resolvedConnectionTemplate (OnBaseMonad (TxET QErr) EncJSON -> DBStepInfo ('Postgres pgKind))
-> m (OnBaseMonad (TxET QErr) EncJSON)
-> m (DBStepInfo ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case MutationDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
mrf of
    MDBInsert AnnotatedInsert
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s -> Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> AnnotatedInsert
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> [Header]
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, MonadIO m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind, MonadReader QueryTagsComment m,
 MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> AnnotatedInsert
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> [Header]
-> m (OnBaseMonad (TxET QErr) EncJSON)
convertInsert Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo AnnotatedInsert
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s StringifyNumbers
stringifyNum [Header]
reqHeaders
    MDBUpdate AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s -> Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> AnnotatedUpdateG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> [Header]
-> Maybe (HashMap Name (Value Variable))
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind, MonadReader QueryTagsComment m,
 MonadIO m, MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> AnnotatedUpdateG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> [Header]
-> Maybe (HashMap Name (Value Variable))
-> m (OnBaseMonad (TxET QErr) EncJSON)
convertUpdate Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s StringifyNumbers
stringifyNum [Header]
reqHeaders Maybe (HashMap Name (Value Variable))
selSetArguments
    MDBDelete AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s -> Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> AnnDelG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> [Header]
-> Maybe (HashMap Name (Value Variable))
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind, MonadReader QueryTagsComment m,
 MonadIO m, MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> AnnDelG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> [Header]
-> Maybe (HashMap Name (Value Variable))
-> m (OnBaseMonad (TxET QErr) EncJSON)
convertDelete Environment
env Manager
manager Logger Hasura
logger UserInfo
userInfo AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s StringifyNumbers
stringifyNum [Header]
reqHeaders Maybe (HashMap Name (Value Variable))
selSetArguments
    MDBFunction JsonAggSelect
returnsSet AnnSimpleSelectG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s -> UserInfo
-> JsonAggSelect
-> AnnSimpleSelectG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (OnBaseMonad (TxET QErr) EncJSON)
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> JsonAggSelect
-> AnnSimpleSelectG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (OnBaseMonad (TxET QErr) EncJSON)
convertFunction UserInfo
userInfo JsonAggSelect
returnsSet AnnSimpleSelectG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s
  where
    go :: Maybe PostgresResolvedConnectionTemplate
-> OnBaseMonad (TxET QErr) EncJSON -> DBStepInfo ('Postgres pgKind)
go Maybe PostgresResolvedConnectionTemplate
resolvedConnectionTemplate OnBaseMonad (TxET QErr) EncJSON
v =
      DBStepInfo
        { dbsiSourceName :: SourceName
dbsiSourceName = SourceName
sourceName,
          dbsiSourceConfig :: SourceConfig ('Postgres pgKind)
dbsiSourceConfig = SourceConfig ('Postgres pgKind)
sourceConfig,
          dbsiPreparedQuery :: Maybe (PreparedQuery ('Postgres pgKind))
dbsiPreparedQuery = Maybe (PreparedQuery ('Postgres pgKind))
Maybe PreparedSql
forall a. Maybe a
Nothing,
          dbsiAction :: OnBaseMonad
  (ExecutionMonad ('Postgres pgKind))
  (ActionResult ('Postgres pgKind))
dbsiAction = (EncJSON -> ActionResult ('Postgres pgKind))
-> OnBaseMonad (TxET QErr) EncJSON
-> OnBaseMonad (TxET QErr) (ActionResult ('Postgres pgKind))
forall a b.
(a -> b) -> OnBaseMonad (TxET QErr) a -> OnBaseMonad (TxET QErr) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EncJSON -> ActionResult ('Postgres pgKind)
forall (b :: BackendType). EncJSON -> ActionResult b
withNoStatistics OnBaseMonad (TxET QErr) EncJSON
v,
          dbsiResolvedConnectionTemplate :: ResolvedConnectionTemplate ('Postgres pgKind)
dbsiResolvedConnectionTemplate = Maybe PostgresResolvedConnectionTemplate
ResolvedConnectionTemplate ('Postgres pgKind)
resolvedConnectionTemplate
        }

-- subscription

pgDBLiveQuerySubscriptionPlan ::
  forall pgKind m.
  ( MonadError QErr m,
    MonadIO m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  UserInfo ->
  SourceName ->
  SourceConfig ('Postgres pgKind) ->
  Maybe G.Name ->
  RootFieldMap (QueryDB ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  m (SubscriptionQueryPlan ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
pgDBLiveQuerySubscriptionPlan :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, MonadIO m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> Maybe Name
-> RootFieldMap
     (QueryDB
        ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
pgDBLiveQuerySubscriptionPlan UserInfo
userInfo SourceName
_sourceName SourceConfig ('Postgres pgKind)
sourceConfig Maybe Name
namespace RootFieldMap
  (QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
unpreparedAST [Header]
reqHeaders Maybe Name
operationName = do
  (InsOrdHashMap
  RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp)
preparedAST, PGL.QueryParametersInfo {HashMap Name (ColumnValue ('Postgres pgKind))
Seq (ColumnValue ('Postgres pgKind))
HashSet SessionVariable
_qpiReusableVariableValues :: HashMap Name (ColumnValue ('Postgres pgKind))
_qpiSyntheticVariableValues :: Seq (ColumnValue ('Postgres pgKind))
_qpiReferencedSessionVariables :: HashSet SessionVariable
_qpiReusableVariableValues :: forall (b :: BackendType).
QueryParametersInfo b -> HashMap Name (ColumnValue b)
_qpiSyntheticVariableValues :: forall (b :: BackendType).
QueryParametersInfo b -> Seq (ColumnValue b)
_qpiReferencedSessionVariables :: forall (b :: BackendType).
QueryParametersInfo b -> HashSet SessionVariable
..}) <-
    (StateT
   (QueryParametersInfo ('Postgres pgKind))
   m
   (InsOrdHashMap
      RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp))
 -> QueryParametersInfo ('Postgres pgKind)
 -> m (InsOrdHashMap
         RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp),
       QueryParametersInfo ('Postgres pgKind)))
-> QueryParametersInfo ('Postgres pgKind)
-> StateT
     (QueryParametersInfo ('Postgres pgKind))
     m
     (InsOrdHashMap
        RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp))
-> m (InsOrdHashMap
        RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp),
      QueryParametersInfo ('Postgres pgKind))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  (QueryParametersInfo ('Postgres pgKind))
  m
  (InsOrdHashMap
     RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp))
-> QueryParametersInfo ('Postgres pgKind)
-> m (InsOrdHashMap
        RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp),
      QueryParametersInfo ('Postgres pgKind))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT QueryParametersInfo ('Postgres pgKind)
forall a. Monoid a => a
mempty
      (StateT
   (QueryParametersInfo ('Postgres pgKind))
   m
   (InsOrdHashMap
      RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp))
 -> m (InsOrdHashMap
         RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp),
       QueryParametersInfo ('Postgres pgKind)))
-> StateT
     (QueryParametersInfo ('Postgres pgKind))
     m
     (InsOrdHashMap
        RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp))
-> m (InsOrdHashMap
        RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp),
      QueryParametersInfo ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ RootFieldMap
  (QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> (QueryDB
      ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
    -> StateT
         (QueryParametersInfo ('Postgres pgKind))
         m
         (QueryDB ('Postgres pgKind) Void SQLExp))
-> StateT
     (QueryParametersInfo ('Postgres pgKind))
     m
     (InsOrdHashMap
        RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for RootFieldMap
  (QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
unpreparedAST
      ((QueryDB
    ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
  -> StateT
       (QueryParametersInfo ('Postgres pgKind))
       m
       (QueryDB ('Postgres pgKind) Void SQLExp))
 -> StateT
      (QueryParametersInfo ('Postgres pgKind))
      m
      (InsOrdHashMap
         RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp)))
-> (QueryDB
      ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
    -> StateT
         (QueryParametersInfo ('Postgres pgKind))
         m
         (QueryDB ('Postgres pgKind) Void SQLExp))
-> StateT
     (QueryParametersInfo ('Postgres pgKind))
     m
     (InsOrdHashMap
        RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp))
forall a b. (a -> b) -> a -> b
$ (UnpreparedValue ('Postgres pgKind)
 -> StateT (QueryParametersInfo ('Postgres pgKind)) m SQLExp)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StateT
     (QueryParametersInfo ('Postgres pgKind))
     m
     (QueryDB ('Postgres pgKind) Void 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)
-> QueryDB ('Postgres pgKind) Void a
-> f (QueryDB ('Postgres pgKind) Void b)
traverse (SessionVariables
-> UnpreparedValue ('Postgres pgKind)
-> StateT (QueryParametersInfo ('Postgres pgKind)) m SQLExp
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadState (QueryParametersInfo ('Postgres pgKind)) m,
 MonadError QErr m) =>
SessionVariables -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
PGL.resolveMultiplexedValue (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo))
  QueryTagsComment
subscriptionQueryTagsComment <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  let multiplexedQuery :: MultiplexedQuery
multiplexedQuery = InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
-> MultiplexedQuery
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
-> MultiplexedQuery
PGL.mkMultiplexedQuery (InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
 -> MultiplexedQuery)
-> InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
-> MultiplexedQuery
forall a b. (a -> b) -> a -> b
$ (RootFieldAlias -> Name)
-> InsOrdHashMap
     RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp)
-> InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
forall k' k v.
(Eq k', Hashable k') =>
(k -> k') -> InsOrdHashMap k v -> InsOrdHashMap k' v
InsOrdHashMap.mapKeys RootFieldAlias -> Name
_rfaAlias InsOrdHashMap
  RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp)
preparedAST
      multiplexedQueryWithQueryTags :: MultiplexedQuery
multiplexedQueryWithQueryTags =
        MultiplexedQuery
multiplexedQuery {unMultiplexedQuery :: Query
PGL.unMultiplexedQuery = Query -> QueryTagsComment -> Query
appendSQLWithQueryTags (MultiplexedQuery -> Query
PGL.unMultiplexedQuery MultiplexedQuery
multiplexedQuery) QueryTagsComment
subscriptionQueryTagsComment}
      roleName :: RoleName
roleName = UserInfo -> RoleName
_uiRole UserInfo
userInfo
      parameterizedPlan :: ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
parameterizedPlan = RoleName
-> MultiplexedQuery
-> ParameterizedSubscriptionQueryPlan
     ('Postgres pgKind) MultiplexedQuery
forall (b :: BackendType) q.
RoleName -> q -> ParameterizedSubscriptionQueryPlan b q
ParameterizedSubscriptionQueryPlan RoleName
roleName MultiplexedQuery
multiplexedQueryWithQueryTags

  Maybe PostgresResolvedConnectionTemplate
resolvedConnectionTemplate <-
    let connectionTemplateResolver :: Maybe ConnectionTemplateResolver
connectionTemplateResolver =
          ConnectionTemplateConfig -> Maybe ConnectionTemplateResolver
connectionTemplateConfigResolver (PGSourceConfig -> ConnectionTemplateConfig
_pscConnectionTemplateConfig SourceConfig ('Postgres pgKind)
PGSourceConfig
sourceConfig)
        queryContext :: Maybe QueryContext
queryContext =
          QueryContext -> Maybe QueryContext
forall a. a -> Maybe a
Just
            (QueryContext -> Maybe QueryContext)
-> QueryContext -> Maybe QueryContext
forall a b. (a -> b) -> a -> b
$ Maybe Name -> QueryOperationType -> QueryContext
QueryContext Maybe Name
operationName
            (QueryOperationType -> QueryContext)
-> QueryOperationType -> QueryContext
forall a b. (a -> b) -> a -> b
$ OperationType -> QueryOperationType
QueryOperationType OperationType
G.OperationTypeSubscription
     in Maybe ConnectionTemplateResolver
-> UserInfo
-> [Header]
-> Maybe QueryContext
-> m (Maybe PostgresResolvedConnectionTemplate)
forall (m :: * -> *).
MonadError QErr m =>
Maybe ConnectionTemplateResolver
-> UserInfo
-> [Header]
-> Maybe QueryContext
-> m (Maybe PostgresResolvedConnectionTemplate)
applyConnectionTemplateResolverNonAdmin Maybe ConnectionTemplateResolver
connectionTemplateResolver UserInfo
userInfo [Header]
reqHeaders Maybe QueryContext
queryContext

  -- Cohort Id: Used for validating the multiplexed query. See @'testMultiplexedQueryTx'.
  -- It is disposed when the subscriber is added to existing cohort.
  CohortId
cohortId <- m CohortId
forall (m :: * -> *). MonadIO m => m CohortId
newCohortId

  let pgExecCtxInfo :: PGExecCtxInfo
pgExecCtxInfo = PGExecTxType -> PGExecFrom -> PGExecCtxInfo
PGExecCtxInfo (TxAccess -> Maybe TxIsolation -> PGExecTxType
Tx TxAccess
PG.ReadOnly Maybe TxIsolation
forall a. Maybe a
Nothing) (Maybe PostgresResolvedConnectionTemplate -> PGExecFrom
GraphQLQuery Maybe PostgresResolvedConnectionTemplate
resolvedConnectionTemplate)
  CohortVariables
cohortVariables <- m (Either QErr CohortVariables) -> m CohortVariables
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr CohortVariables) -> m CohortVariables)
-> m (Either QErr CohortVariables) -> m CohortVariables
forall a b. (a -> b) -> a -> b
$ IO (Either QErr CohortVariables) -> m (Either QErr CohortVariables)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QErr CohortVariables)
 -> m (Either QErr CohortVariables))
-> IO (Either QErr CohortVariables)
-> m (Either QErr CohortVariables)
forall a b. (a -> b) -> a -> b
$ ExceptT QErr IO CohortVariables -> IO (Either QErr CohortVariables)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr IO CohortVariables
 -> IO (Either QErr CohortVariables))
-> ExceptT QErr IO CohortVariables
-> IO (Either QErr CohortVariables)
forall a b. (a -> b) -> a -> b
$ PGExecCtx -> PGExecCtxInfo -> RunTx
_pecRunTx (PGSourceConfig -> PGExecCtx
_pscExecCtx SourceConfig ('Postgres pgKind)
PGSourceConfig
sourceConfig) PGExecCtxInfo
pgExecCtxInfo do
    -- We need to ensure that the values provided for variables are correct according to Postgres.
    -- Without this check an invalid value for a variable for one instance of the subscription will
    -- take down the entire multiplexed query.
    ValidatedCursorVariables
validatedQueryVars <- HashMap Name (ColumnValue ('Postgres pgKind))
-> TxET QErr IO ValidatedCursorVariables
forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadTx m, MonadIO m) =>
f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
PGL.validateVariablesTx HashMap Name (ColumnValue ('Postgres pgKind))
_qpiReusableVariableValues
    ValidatedVariables []
validatedSyntheticVars <- [ColumnValue ('Postgres pgKind)]
-> TxET QErr IO (ValidatedVariables [])
forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadTx m, MonadIO m) =>
f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
PGL.validateVariablesTx ([ColumnValue ('Postgres pgKind)]
 -> TxET QErr IO (ValidatedVariables []))
-> [ColumnValue ('Postgres pgKind)]
-> TxET QErr IO (ValidatedVariables [])
forall a b. (a -> b) -> a -> b
$ Seq (ColumnValue ('Postgres pgKind))
-> [ColumnValue ('Postgres pgKind)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (ColumnValue ('Postgres pgKind))
_qpiSyntheticVariableValues
    let cohortVariables :: CohortVariables
cohortVariables =
          HashSet SessionVariable
-> SessionVariables
-> ValidatedCursorVariables
-> ValidatedVariables []
-> ValidatedCursorVariables
-> CohortVariables
mkCohortVariables
            HashSet SessionVariable
_qpiReferencedSessionVariables
            (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo)
            ValidatedCursorVariables
validatedQueryVars
            ValidatedVariables []
validatedSyntheticVars
            ValidatedCursorVariables
forall a. Monoid a => a
mempty -- live query subscriptions don't use the streaming cursor variables

    -- Test the multiplexed query. Without this test if the query fails, the subscription will
    -- take down the entier multiplexed query affecting all subscribers.
    MultiplexedQuery -> CohortId -> CohortVariables -> TxET QErr IO ()
forall (m :: * -> *).
MonadTx m =>
MultiplexedQuery -> CohortId -> CohortVariables -> m ()
testMultiplexedQueryTx MultiplexedQuery
multiplexedQueryWithQueryTags CohortId
cohortId CohortVariables
cohortVariables
    CohortVariables -> TxET QErr IO CohortVariables
forall a. a -> TxET QErr IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CohortVariables
cohortVariables

  SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> m (SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
 -> m (SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery))
-> SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> m (SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery)
forall a b. (a -> b) -> a -> b
$ ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
-> SourceConfig ('Postgres pgKind)
-> CohortId
-> ResolvedConnectionTemplate ('Postgres pgKind)
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
forall (b :: BackendType) q.
ParameterizedSubscriptionQueryPlan b q
-> SourceConfig b
-> CohortId
-> ResolvedConnectionTemplate b
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan b q
SubscriptionQueryPlan ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
parameterizedPlan SourceConfig ('Postgres pgKind)
sourceConfig CohortId
cohortId Maybe PostgresResolvedConnectionTemplate
ResolvedConnectionTemplate ('Postgres pgKind)
resolvedConnectionTemplate CohortVariables
cohortVariables Maybe Name
namespace

pgDBStreamingSubscriptionPlan ::
  forall pgKind m.
  ( MonadError QErr m,
    MonadIO m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  UserInfo ->
  SourceName ->
  SourceConfig ('Postgres pgKind) ->
  (RootFieldAlias, (QueryDB ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  m (SubscriptionQueryPlan ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
pgDBStreamingSubscriptionPlan :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, MonadIO m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> (RootFieldAlias,
    QueryDB
      ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> [Header]
-> Maybe Name
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
pgDBStreamingSubscriptionPlan UserInfo
userInfo SourceName
_sourceName SourceConfig ('Postgres pgKind)
sourceConfig (RootFieldAlias
rootFieldAlias, QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
unpreparedAST) [Header]
reqHeaders Maybe Name
operationName = do
  (QueryDB ('Postgres pgKind) Void SQLExp
preparedAST, PGL.QueryParametersInfo {HashMap Name (ColumnValue ('Postgres pgKind))
Seq (ColumnValue ('Postgres pgKind))
HashSet SessionVariable
_qpiReusableVariableValues :: forall (b :: BackendType).
QueryParametersInfo b -> HashMap Name (ColumnValue b)
_qpiSyntheticVariableValues :: forall (b :: BackendType).
QueryParametersInfo b -> Seq (ColumnValue b)
_qpiReferencedSessionVariables :: forall (b :: BackendType).
QueryParametersInfo b -> HashSet SessionVariable
_qpiReusableVariableValues :: HashMap Name (ColumnValue ('Postgres pgKind))
_qpiSyntheticVariableValues :: Seq (ColumnValue ('Postgres pgKind))
_qpiReferencedSessionVariables :: HashSet SessionVariable
..}) <-
    (StateT
   (QueryParametersInfo ('Postgres pgKind))
   m
   (QueryDB ('Postgres pgKind) Void SQLExp)
 -> QueryParametersInfo ('Postgres pgKind)
 -> m (QueryDB ('Postgres pgKind) Void SQLExp,
       QueryParametersInfo ('Postgres pgKind)))
-> QueryParametersInfo ('Postgres pgKind)
-> StateT
     (QueryParametersInfo ('Postgres pgKind))
     m
     (QueryDB ('Postgres pgKind) Void SQLExp)
-> m (QueryDB ('Postgres pgKind) Void SQLExp,
      QueryParametersInfo ('Postgres pgKind))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  (QueryParametersInfo ('Postgres pgKind))
  m
  (QueryDB ('Postgres pgKind) Void SQLExp)
-> QueryParametersInfo ('Postgres pgKind)
-> m (QueryDB ('Postgres pgKind) Void SQLExp,
      QueryParametersInfo ('Postgres pgKind))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT QueryParametersInfo ('Postgres pgKind)
forall a. Monoid a => a
mempty
      (StateT
   (QueryParametersInfo ('Postgres pgKind))
   m
   (QueryDB ('Postgres pgKind) Void SQLExp)
 -> m (QueryDB ('Postgres pgKind) Void SQLExp,
       QueryParametersInfo ('Postgres pgKind)))
-> StateT
     (QueryParametersInfo ('Postgres pgKind))
     m
     (QueryDB ('Postgres pgKind) Void SQLExp)
-> m (QueryDB ('Postgres pgKind) Void SQLExp,
      QueryParametersInfo ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ (UnpreparedValue ('Postgres pgKind)
 -> StateT (QueryParametersInfo ('Postgres pgKind)) m SQLExp)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StateT
     (QueryParametersInfo ('Postgres pgKind))
     m
     (QueryDB ('Postgres pgKind) Void 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)
-> QueryDB ('Postgres pgKind) Void a
-> f (QueryDB ('Postgres pgKind) Void b)
traverse (SessionVariables
-> UnpreparedValue ('Postgres pgKind)
-> StateT (QueryParametersInfo ('Postgres pgKind)) m SQLExp
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadState (QueryParametersInfo ('Postgres pgKind)) m,
 MonadError QErr m) =>
SessionVariables -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
PGL.resolveMultiplexedValue (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo)) QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
unpreparedAST
  QueryTagsComment
subscriptionQueryTagsComment <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  let multiplexedQuery :: MultiplexedQuery
multiplexedQuery = (Name, QueryDB ('Postgres pgKind) Void SQLExp) -> MultiplexedQuery
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
(Name, QueryDB ('Postgres pgKind) Void SQLExp) -> MultiplexedQuery
PGL.mkStreamingMultiplexedQuery (RootFieldAlias -> Name
G._rfaAlias RootFieldAlias
rootFieldAlias, QueryDB ('Postgres pgKind) Void SQLExp
preparedAST)
      multiplexedQueryWithQueryTags :: MultiplexedQuery
multiplexedQueryWithQueryTags =
        MultiplexedQuery
multiplexedQuery {unMultiplexedQuery :: Query
PGL.unMultiplexedQuery = Query -> QueryTagsComment -> Query
appendSQLWithQueryTags (MultiplexedQuery -> Query
PGL.unMultiplexedQuery MultiplexedQuery
multiplexedQuery) QueryTagsComment
subscriptionQueryTagsComment}
      roleName :: RoleName
roleName = UserInfo -> RoleName
_uiRole UserInfo
userInfo
      parameterizedPlan :: ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
parameterizedPlan = RoleName
-> MultiplexedQuery
-> ParameterizedSubscriptionQueryPlan
     ('Postgres pgKind) MultiplexedQuery
forall (b :: BackendType) q.
RoleName -> q -> ParameterizedSubscriptionQueryPlan b q
ParameterizedSubscriptionQueryPlan RoleName
roleName MultiplexedQuery
multiplexedQueryWithQueryTags

  Maybe PostgresResolvedConnectionTemplate
resolvedConnectionTemplate <-
    let connectionTemplateResolver :: Maybe ConnectionTemplateResolver
connectionTemplateResolver =
          ConnectionTemplateConfig -> Maybe ConnectionTemplateResolver
connectionTemplateConfigResolver (PGSourceConfig -> ConnectionTemplateConfig
_pscConnectionTemplateConfig SourceConfig ('Postgres pgKind)
PGSourceConfig
sourceConfig)
        queryContext :: Maybe QueryContext
queryContext =
          QueryContext -> Maybe QueryContext
forall a. a -> Maybe a
Just
            (QueryContext -> Maybe QueryContext)
-> QueryContext -> Maybe QueryContext
forall a b. (a -> b) -> a -> b
$ Maybe Name -> QueryOperationType -> QueryContext
QueryContext Maybe Name
operationName
            (QueryOperationType -> QueryContext)
-> QueryOperationType -> QueryContext
forall a b. (a -> b) -> a -> b
$ OperationType -> QueryOperationType
QueryOperationType OperationType
G.OperationTypeSubscription
     in Maybe ConnectionTemplateResolver
-> UserInfo
-> [Header]
-> Maybe QueryContext
-> m (Maybe PostgresResolvedConnectionTemplate)
forall (m :: * -> *).
MonadError QErr m =>
Maybe ConnectionTemplateResolver
-> UserInfo
-> [Header]
-> Maybe QueryContext
-> m (Maybe PostgresResolvedConnectionTemplate)
applyConnectionTemplateResolverNonAdmin Maybe ConnectionTemplateResolver
connectionTemplateResolver UserInfo
userInfo [Header]
reqHeaders Maybe QueryContext
queryContext

  -- Cohort Id: Used for validating the multiplexed query. See @'testMultiplexedQueryTx'.
  -- It is disposed when the subscriber is added to existing cohort.
  CohortId
cohortId <- m CohortId
forall (m :: * -> *). MonadIO m => m CohortId
newCohortId

  let pgExecCtxInfo :: PGExecCtxInfo
pgExecCtxInfo = PGExecTxType -> PGExecFrom -> PGExecCtxInfo
PGExecCtxInfo (TxAccess -> Maybe TxIsolation -> PGExecTxType
Tx TxAccess
PG.ReadOnly Maybe TxIsolation
forall a. Maybe a
Nothing) (Maybe PostgresResolvedConnectionTemplate -> PGExecFrom
GraphQLQuery Maybe PostgresResolvedConnectionTemplate
resolvedConnectionTemplate)
  CohortVariables
cohortVariables <- m (Either QErr CohortVariables) -> m CohortVariables
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr CohortVariables) -> m CohortVariables)
-> m (Either QErr CohortVariables) -> m CohortVariables
forall a b. (a -> b) -> a -> b
$ IO (Either QErr CohortVariables) -> m (Either QErr CohortVariables)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QErr CohortVariables)
 -> m (Either QErr CohortVariables))
-> IO (Either QErr CohortVariables)
-> m (Either QErr CohortVariables)
forall a b. (a -> b) -> a -> b
$ ExceptT QErr IO CohortVariables -> IO (Either QErr CohortVariables)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr IO CohortVariables
 -> IO (Either QErr CohortVariables))
-> ExceptT QErr IO CohortVariables
-> IO (Either QErr CohortVariables)
forall a b. (a -> b) -> a -> b
$ PGExecCtx -> PGExecCtxInfo -> RunTx
_pecRunTx (PGSourceConfig -> PGExecCtx
_pscExecCtx SourceConfig ('Postgres pgKind)
PGSourceConfig
sourceConfig) PGExecCtxInfo
pgExecCtxInfo do
    -- We need to ensure that the values provided for variables are correct according to Postgres.
    -- Without this check an invalid value for a variable for one instance of the subscription will
    -- take down the entire multiplexed query.
    ValidatedCursorVariables
validatedQueryVars <- HashMap Name (ColumnValue ('Postgres pgKind))
-> TxET QErr IO ValidatedCursorVariables
forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadTx m, MonadIO m) =>
f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
PGL.validateVariablesTx HashMap Name (ColumnValue ('Postgres pgKind))
_qpiReusableVariableValues
    ValidatedVariables []
validatedSyntheticVars <- [ColumnValue ('Postgres pgKind)]
-> TxET QErr IO (ValidatedVariables [])
forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadTx m, MonadIO m) =>
f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
PGL.validateVariablesTx ([ColumnValue ('Postgres pgKind)]
 -> TxET QErr IO (ValidatedVariables []))
-> [ColumnValue ('Postgres pgKind)]
-> TxET QErr IO (ValidatedVariables [])
forall a b. (a -> b) -> a -> b
$ Seq (ColumnValue ('Postgres pgKind))
-> [ColumnValue ('Postgres pgKind)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (ColumnValue ('Postgres pgKind))
_qpiSyntheticVariableValues
    ValidatedCursorVariables
validatedCursorVars <- HashMap Name (ColumnValue ('Postgres pgKind))
-> TxET QErr IO ValidatedCursorVariables
forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadTx m, MonadIO m) =>
f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
PGL.validateVariablesTx (HashMap Name (ColumnValue ('Postgres pgKind))
 -> TxET QErr IO ValidatedCursorVariables)
-> HashMap Name (ColumnValue ('Postgres pgKind))
-> TxET QErr IO ValidatedCursorVariables
forall a b. (a -> b) -> a -> b
$ QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> HashMap Name (ColumnValue ('Postgres pgKind))
forall {b :: BackendType} {r} {v}.
(XStreamingSubscription b ~ ()) =>
QueryDB b r v -> HashMap Name (ColumnValue b)
getCursorVars QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
unpreparedAST
    let cohortVariables :: CohortVariables
cohortVariables =
          HashSet SessionVariable
-> SessionVariables
-> ValidatedCursorVariables
-> ValidatedVariables []
-> ValidatedCursorVariables
-> CohortVariables
mkCohortVariables
            HashSet SessionVariable
_qpiReferencedSessionVariables
            (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo)
            ValidatedCursorVariables
validatedQueryVars
            ValidatedVariables []
validatedSyntheticVars
            ValidatedCursorVariables
validatedCursorVars

    -- Test the multiplexed query. Without this test if the query fails, the subscription will
    -- take down the entier multiplexed query affecting all subscribers.
    MultiplexedQuery -> CohortId -> CohortVariables -> TxET QErr IO ()
forall (m :: * -> *).
MonadTx m =>
MultiplexedQuery -> CohortId -> CohortVariables -> m ()
testMultiplexedQueryTx MultiplexedQuery
multiplexedQueryWithQueryTags CohortId
cohortId CohortVariables
cohortVariables
    CohortVariables -> TxET QErr IO CohortVariables
forall a. a -> TxET QErr IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CohortVariables
cohortVariables

  SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> m (SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
 -> m (SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery))
-> SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> m (SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery)
forall a b. (a -> b) -> a -> b
$ ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
-> SourceConfig ('Postgres pgKind)
-> CohortId
-> ResolvedConnectionTemplate ('Postgres pgKind)
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
forall (b :: BackendType) q.
ParameterizedSubscriptionQueryPlan b q
-> SourceConfig b
-> CohortId
-> ResolvedConnectionTemplate b
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan b q
SubscriptionQueryPlan ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
parameterizedPlan SourceConfig ('Postgres pgKind)
sourceConfig CohortId
cohortId Maybe PostgresResolvedConnectionTemplate
ResolvedConnectionTemplate ('Postgres pgKind)
resolvedConnectionTemplate CohortVariables
cohortVariables (Maybe Name
 -> SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery)
-> Maybe Name
-> SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
forall a b. (a -> b) -> a -> b
$ RootFieldAlias -> Maybe Name
_rfaNamespace RootFieldAlias
rootFieldAlias
  where
    getCursorVars :: QueryDB b r v -> HashMap Name (ColumnValue b)
getCursorVars QueryDB b r v
qdb =
      case QueryDB b r v
qdb of
        QDBStreamMultipleRows (IR.AnnSelectStreamG () Fields (AnnFieldG b r v)
_ SelectFromG b v
_ TablePermG b v
_ SelectStreamArgsG b v
args StringifyNumbers
_) ->
          let cursorArg :: StreamCursorItem b
cursorArg = SelectStreamArgsG b v -> StreamCursorItem b
forall (b :: BackendType) v.
SelectStreamArgsG b v -> StreamCursorItem b
IR._ssaCursorArg SelectStreamArgsG b v
args
              colInfo :: ColumnInfo b
colInfo = StreamCursorItem b -> ColumnInfo b
forall (b :: BackendType). StreamCursorItem b -> ColumnInfo b
IR._sciColInfo StreamCursorItem b
cursorArg
           in Name -> ColumnValue b -> HashMap Name (ColumnValue b)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (ColumnInfo b -> Name
forall (b :: BackendType). ColumnInfo b -> Name
ciName ColumnInfo b
colInfo) (StreamCursorItem b -> ColumnValue b
forall (b :: BackendType). StreamCursorItem b -> ColumnValue b
IR._sciInitialValue StreamCursorItem b
cursorArg)
        QueryDB b r v
_ -> HashMap Name (ColumnValue b)
forall a. Monoid a => a
mempty

-- | Test a multiplexed query in a transaction.
testMultiplexedQueryTx ::
  (MonadTx m) =>
  PGL.MultiplexedQuery ->
  CohortId ->
  CohortVariables ->
  m ()
testMultiplexedQueryTx :: forall (m :: * -> *).
MonadTx m =>
MultiplexedQuery -> CohortId -> CohortVariables -> m ()
testMultiplexedQueryTx (PGL.MultiplexedQuery Query
query) CohortId
cohortId CohortVariables
cohortVariables = do
  -- Run the query and discard the results
  -- NOTE: Adding `LIMIT 1` to the root selection of the query would make
  -- executing the query faster. However, it is not preferred due to the following
  -- reasons:
  -- Multiplex query validation is required for queries involving any SQL functions,
  -- computed fields and SQL functions as root fields, as the functions are bound to
  -- raise run-time SQL exception resulting in error response for all subscribers in a cohort.
  -- a. In case of computed fields, applying `LIMIT 1` to the base table selection will
  --    enforce SQL function to evaluate only on one row. There's a possibility of SQL exception
  --    on evaluating function on other rows.
  -- b. In case of SQL functions as root fields, applying `LIMIT 1` to the base SQL function selection
  --    don't have any performance impact as the limit is applied on the function result.
  PG.Discard () <- Query -> [(CohortId, CohortVariables)] -> m Discard
forall (m :: * -> *) a.
(MonadTx m, FromRes a) =>
Query -> [(CohortId, CohortVariables)] -> m a
PGL.executeQuery Query
query [(CohortId
cohortId, CohortVariables
cohortVariables)]
  () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- turn the current plan into a transaction
mkCurPlanTx ::
  UserInfo ->
  PreparedSql ->
  (OnBaseMonad (PG.TxET QErr) EncJSON, Maybe PreparedSql)
mkCurPlanTx :: UserInfo
-> PreparedSql
-> (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
mkCurPlanTx UserInfo
userInfo ps :: PreparedSql
ps@(PreparedSql Query
q PrepArgMap
prepMap) =
  -- generate the SQL and prepared vars or the bytestring
  let args :: PrepArgMap
args = SessionVariables -> PrepArgMap -> PrepArgMap
withUserVars (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo) PrepArgMap
prepMap
      -- WARNING: this quietly assumes the intmap keys are contiguous
      prepArgs :: [PrepArg]
prepArgs = (PrepArg, PGScalarValue) -> PrepArg
forall a b. (a, b) -> a
fst ((PrepArg, PGScalarValue) -> PrepArg)
-> [(PrepArg, PGScalarValue)] -> [PrepArg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrepArgMap -> [(PrepArg, PGScalarValue)]
forall a. IntMap a -> [a]
IntMap.elems PrepArgMap
args
   in (,PreparedSql -> Maybe PreparedSql
forall a. a -> Maybe a
Just PreparedSql
ps) (OnBaseMonad (TxET QErr) EncJSON
 -> (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql))
-> OnBaseMonad (TxET QErr) EncJSON
-> (OnBaseMonad (TxET QErr) EncJSON, Maybe PreparedSql)
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
 (Functor (TxET QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 TxET QErr m EncJSON)
-> OnBaseMonad (TxET QErr) EncJSON
forall (t :: (* -> *) -> * -> *) a.
(forall (m :: * -> *).
 (Functor (t m), MonadIO m, MonadBaseControl IO m, MonadTrace m,
  MonadError QErr m) =>
 t m a)
-> OnBaseMonad t a
OnBaseMonad do
        -- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/database/#connection-level-attributes
        TraceMetadata -> TxET QErr m ()
forall (m :: * -> *). MonadTrace m => TraceMetadata -> m ()
Tracing.attachMetadata [(Text
"db.system", Text
"postgresql")]
        Identity EncJSON -> EncJSON
forall a. Identity a -> a
runIdentity
          (Identity EncJSON -> EncJSON)
-> (SingleRow (Identity EncJSON) -> Identity EncJSON)
-> SingleRow (Identity EncJSON)
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity EncJSON) -> Identity EncJSON
forall a. SingleRow a -> a
PG.getRow
          (SingleRow (Identity EncJSON) -> EncJSON)
-> TxET QErr m (SingleRow (Identity EncJSON))
-> TxET QErr m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> [PrepArg]
-> Bool
-> TxET QErr m (SingleRow (Identity EncJSON))
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> [PrepArg] -> Bool -> TxET e m a
PG.rawQE PGTxErr -> QErr
dmlTxErrorHandler Query
q [PrepArg]
prepArgs Bool
True

-- convert a query from an intermediate representation to... another
irToRootFieldPlan ::
  ( Backend ('Postgres pgKind),
    DS.PostgresAnnotatedFieldJSON pgKind
  ) =>
  PrepArgMap ->
  QueryDB ('Postgres pgKind) Void S.SQLExp ->
  PreparedSql
irToRootFieldPlan :: forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
PrepArgMap -> QueryDB ('Postgres pgKind) Void SQLExp -> PreparedSql
irToRootFieldPlan PrepArgMap
prepped = \case
  QDBMultipleRows AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s -> (AnnSimpleSelectG ('Postgres pgKind) Void SQLExp -> Query)
-> AnnSimpleSelectG ('Postgres pgKind) Void SQLExp -> PreparedSql
forall t. (t -> Query) -> t -> PreparedSql
mkPreparedSql (JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Query
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Query
DS.selectQuerySQL JsonAggSelect
JASMultipleRows) AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s
  QDBSingleRow AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s -> (AnnSimpleSelectG ('Postgres pgKind) Void SQLExp -> Query)
-> AnnSimpleSelectG ('Postgres pgKind) Void SQLExp -> PreparedSql
forall t. (t -> Query) -> t -> PreparedSql
mkPreparedSql (JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Query
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Query
DS.selectQuerySQL JsonAggSelect
JASSingleObject) AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s
  QDBAggregation AnnAggregateSelectG ('Postgres pgKind) Void SQLExp
s -> (AnnAggregateSelectG ('Postgres pgKind) Void SQLExp -> Query)
-> AnnAggregateSelectG ('Postgres pgKind) Void SQLExp
-> PreparedSql
forall t. (t -> Query) -> t -> PreparedSql
mkPreparedSql AnnAggregateSelect ('Postgres pgKind) -> Query
AnnAggregateSelectG ('Postgres pgKind) Void SQLExp -> Query
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
AnnAggregateSelect ('Postgres pgKind) -> Query
DS.selectAggregateQuerySQL AnnAggregateSelectG ('Postgres pgKind) Void SQLExp
s
  QDBConnection ConnectionSelect ('Postgres pgKind) Void SQLExp
s -> (ConnectionSelect ('Postgres pgKind) Void SQLExp -> Query)
-> ConnectionSelect ('Postgres pgKind) Void SQLExp -> PreparedSql
forall t. (t -> Query) -> t -> PreparedSql
mkPreparedSql ConnectionSelect ('Postgres pgKind) Void SQLExp -> Query
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
ConnectionSelect ('Postgres pgKind) Void SQLExp -> Query
DS.connectionSelectQuerySQL ConnectionSelect ('Postgres pgKind) Void SQLExp
s
  QDBStreamMultipleRows AnnSimpleStreamSelectG ('Postgres pgKind) Void SQLExp
s -> (AnnSimpleStreamSelectG ('Postgres pgKind) Void SQLExp -> Query)
-> AnnSimpleStreamSelectG ('Postgres pgKind) Void SQLExp
-> PreparedSql
forall t. (t -> Query) -> t -> PreparedSql
mkPreparedSql AnnSimpleStreamSelect ('Postgres pgKind) -> Query
AnnSimpleStreamSelectG ('Postgres pgKind) Void SQLExp -> Query
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
AnnSimpleStreamSelect ('Postgres pgKind) -> Query
DS.selectStreamQuerySQL AnnSimpleStreamSelectG ('Postgres pgKind) Void SQLExp
s
  where
    mkPreparedSql :: (t -> PG.Query) -> t -> PreparedSql
    mkPreparedSql :: forall t. (t -> Query) -> t -> PreparedSql
mkPreparedSql t -> Query
f t
simpleSel =
      Query -> PrepArgMap -> PreparedSql
PreparedSql (t -> Query
f t
simpleSel) PrepArgMap
prepped

-- Append Query Tags to the Prepared SQL
appendPreparedSQLWithQueryTags :: PreparedSql -> QueryTagsComment -> PreparedSql
appendPreparedSQLWithQueryTags :: PreparedSql -> QueryTagsComment -> PreparedSql
appendPreparedSQLWithQueryTags PreparedSql
preparedSQL QueryTagsComment
queryTags =
  PreparedSql
preparedSQL {_psQuery :: Query
_psQuery = Query -> QueryTagsComment -> Query
appendSQLWithQueryTags Query
query QueryTagsComment
queryTags}
  where
    query :: Query
query = PreparedSql -> Query
_psQuery PreparedSql
preparedSQL

appendSQLWithQueryTags :: PG.Query -> QueryTagsComment -> PG.Query
appendSQLWithQueryTags :: Query -> QueryTagsComment -> Query
appendSQLWithQueryTags Query
query QueryTagsComment
queryTags = Query
query {getQueryText :: Text
PG.getQueryText = Text
queryText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QueryTagsComment -> Text
_unQueryTagsComment QueryTagsComment
queryTags}
  where
    queryText :: Text
queryText = Query -> Text
PG.getQueryText Query
query

--------------------------------------------------------------------------------
-- Remote Relationships (e.g. DB-to-DB Joins, remote schema joins, etc.)
--------------------------------------------------------------------------------

-- | Construct an action (i.e. 'DBStepInfo') which can marshal some remote
-- relationship information into a form that Postgres can query against.
pgDBRemoteRelationshipPlan ::
  forall pgKind m.
  ( MonadError QErr m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind
  ) =>
  UserInfo ->
  SourceName ->
  SourceConfig ('Postgres pgKind) ->
  -- | List of json objects, each of which becomes a row of the table.
  NonEmpty J.Object ->
  -- | The above objects have this schema
  --
  -- XXX: What is this for/what does this mean?
  HashMap FieldName (Column ('Postgres pgKind), ScalarType ('Postgres pgKind)) ->
  -- | This is a field name from the lhs that *has* to be selected in the
  -- response along with the relationship.
  FieldName ->
  (FieldName, IR.SourceRelationshipSelection ('Postgres pgKind) Void UnpreparedValue) ->
  [HTTP.Header] ->
  Maybe G.Name ->
  Options.StringifyNumbers ->
  m (DBStepInfo ('Postgres pgKind))
pgDBRemoteRelationshipPlan :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> NonEmpty Object
-> HashMap
     FieldName
     (Column ('Postgres pgKind), ScalarType ('Postgres pgKind))
-> FieldName
-> (FieldName,
    SourceRelationshipSelection
      ('Postgres pgKind) Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo ('Postgres pgKind))
pgDBRemoteRelationshipPlan UserInfo
userInfo SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig NonEmpty Object
lhs HashMap
  FieldName
  (Column ('Postgres pgKind), ScalarType ('Postgres pgKind))
lhsSchema FieldName
argumentId (FieldName,
 SourceRelationshipSelection
   ('Postgres pgKind) Void UnpreparedValue)
relationship [Header]
reqHeaders Maybe Name
operationName StringifyNumbers
stringifyNumbers = do
  -- NOTE: 'QueryTags' currently cannot support remote relationship queries.
  --
  -- In the future if we want to add support we'll need to add a new type of
  -- metadata (e.g. 'ParameterizedQueryHash' doesn't make sense here) and find
  -- a root field name that makes sense to attach to it.
  (ReaderT QueryTagsComment m (DBStepInfo ('Postgres pgKind))
 -> QueryTagsComment -> m (DBStepInfo ('Postgres pgKind)))
-> QueryTagsComment
-> ReaderT QueryTagsComment m (DBStepInfo ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT QueryTagsComment m (DBStepInfo ('Postgres pgKind))
-> QueryTagsComment -> m (DBStepInfo ('Postgres pgKind))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT QueryTagsComment
emptyQueryTagsComment (ReaderT QueryTagsComment m (DBStepInfo ('Postgres pgKind))
 -> m (DBStepInfo ('Postgres pgKind)))
-> ReaderT QueryTagsComment m (DBStepInfo ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> ReaderT QueryTagsComment m (DBStepInfo ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> [Header]
-> Maybe Name
-> m (DBStepInfo ('Postgres pgKind))
pgDBQueryPlan UserInfo
userInfo SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
rootSelection [Header]
reqHeaders Maybe Name
operationName
  where
    coerceToColumn :: FieldName -> PGCol
coerceToColumn = Text -> PGCol
Postgres.unsafePGCol (Text -> PGCol) -> (FieldName -> Text) -> FieldName -> PGCol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
getFieldNameTxt
    joinColumnMapping :: HashMap PGCol (PGCol, PGScalarType)
joinColumnMapping = (FieldName -> PGCol)
-> HashMap FieldName (PGCol, PGScalarType)
-> HashMap PGCol (PGCol, PGScalarType)
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys FieldName -> PGCol
coerceToColumn HashMap
  FieldName
  (Column ('Postgres pgKind), ScalarType ('Postgres pgKind))
HashMap FieldName (PGCol, PGScalarType)
lhsSchema

    rowsArgument :: UnpreparedValue ('Postgres pgKind)
    rowsArgument :: UnpreparedValue ('Postgres pgKind)
rowsArgument =
      Provenance
-> ColumnValue ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
Provenance -> ColumnValue b -> UnpreparedValue b
UVParameter Provenance
FreshVar
        (ColumnValue ('Postgres pgKind)
 -> UnpreparedValue ('Postgres pgKind))
-> ColumnValue ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$ ColumnType ('Postgres pgKind)
-> ScalarValue ('Postgres pgKind) -> ColumnValue ('Postgres pgKind)
forall (b :: BackendType).
ColumnType b -> ScalarValue b -> ColumnValue b
ColumnValue (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
Postgres.PGJSONB)
        (ScalarValue ('Postgres pgKind) -> ColumnValue ('Postgres pgKind))
-> ScalarValue ('Postgres pgKind) -> ColumnValue ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$ JSONB -> PGScalarValue
Postgres.PGValJSONB
        (JSONB -> PGScalarValue) -> JSONB -> PGScalarValue
forall a b. (a -> b) -> a -> b
$ Value -> JSONB
PG.JSONB
        (Value -> JSONB) -> Value -> JSONB
forall a b. (a -> b) -> a -> b
$ NonEmpty Object -> Value
forall a. ToJSON a => a -> Value
J.toJSON NonEmpty Object
lhs
    jsonToRecordSet :: IR.SelectFromG ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))

    recordSetDefinitionList :: [(PGCol, PGScalarType)]
recordSetDefinitionList =
      (FieldName -> PGCol
coerceToColumn FieldName
argumentId, PGScalarType
Postgres.PGBigInt) (PGCol, PGScalarType)
-> [(PGCol, PGScalarType)] -> [(PGCol, PGScalarType)]
forall a. a -> [a] -> [a]
: HashMap PGCol PGScalarType -> [(PGCol, PGScalarType)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (((PGCol, PGScalarType) -> PGScalarType)
-> HashMap PGCol (PGCol, PGScalarType)
-> HashMap PGCol PGScalarType
forall a b. (a -> b) -> HashMap PGCol a -> HashMap PGCol b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PGCol, PGScalarType) -> PGScalarType
forall a b. (a, b) -> b
snd HashMap PGCol (PGCol, PGScalarType)
joinColumnMapping)
    jsonToRecordSet :: SelectFromG ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
jsonToRecordSet =
      FunctionName ('Postgres pgKind)
-> FunctionArgsExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> Maybe
     [(Column ('Postgres pgKind), ScalarType ('Postgres pgKind))]
-> SelectFromG
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) v.
FunctionName b
-> FunctionArgsExp b v
-> Maybe [(Column b, ScalarType b)]
-> SelectFromG b v
IR.FromFunction
        (SchemaName -> FunctionName -> QualifiedObject FunctionName
forall a. SchemaName -> a -> QualifiedObject a
Postgres.QualifiedObject SchemaName
"pg_catalog" (FunctionName -> QualifiedObject FunctionName)
-> FunctionName -> QualifiedObject FunctionName
forall a b. (a -> b) -> a -> b
$ Text -> FunctionName
Postgres.FunctionName Text
"jsonb_to_recordset")
        ([ArgumentExp (UnpreparedValue ('Postgres pgKind))]
-> HashMap Text (ArgumentExp (UnpreparedValue ('Postgres pgKind)))
-> FunctionArgsExpG
     (ArgumentExp (UnpreparedValue ('Postgres pgKind)))
forall a. [a] -> HashMap Text a -> FunctionArgsExpG a
FunctionArgsExp [UnpreparedValue ('Postgres pgKind)
-> ArgumentExp (UnpreparedValue ('Postgres pgKind))
forall a. a -> ArgumentExp a
Postgres.AEInput UnpreparedValue ('Postgres pgKind)
rowsArgument] HashMap Text (ArgumentExp (UnpreparedValue ('Postgres pgKind)))
forall a. Monoid a => a
mempty)
        ([(PGCol, PGScalarType)] -> Maybe [(PGCol, PGScalarType)]
forall a. a -> Maybe a
Just [(PGCol, PGScalarType)]
recordSetDefinitionList)

    rootSelection :: QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
rootSelection =
      HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
-> SelectFromG
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> Column ('Postgres pgKind)
-> ColumnType ('Postgres pgKind)
-> (FieldName,
    SourceRelationshipSelection
      ('Postgres pgKind) Void UnpreparedValue)
-> StringifyNumbers
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType).
Backend b =>
HashMap (Column b) (Column b)
-> SelectFromG b (UnpreparedValue b)
-> Column b
-> ColumnType b
-> (FieldName, SourceRelationshipSelection b Void UnpreparedValue)
-> StringifyNumbers
-> QueryDB b Void (UnpreparedValue b)
convertRemoteSourceRelationship
        ((PGCol, PGScalarType) -> PGCol
forall a b. (a, b) -> a
fst ((PGCol, PGScalarType) -> PGCol)
-> HashMap PGCol (PGCol, PGScalarType) -> HashMap PGCol PGCol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap PGCol (PGCol, PGScalarType)
joinColumnMapping)
        SelectFromG ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
jsonToRecordSet
        (Text -> PGCol
Postgres.unsafePGCol (Text -> PGCol) -> Text -> PGCol
forall a b. (a -> b) -> a -> b
$ FieldName -> Text
getFieldNameTxt FieldName
argumentId)
        (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
Postgres.PGBigInt)
        (FieldName,
 SourceRelationshipSelection
   ('Postgres pgKind) Void UnpreparedValue)
relationship
        StringifyNumbers
stringifyNumbers