{-# 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 (..),
  )
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 Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.IntMap qualified as IntMap
import Data.Sequence qualified as Seq
import Database.PG.Query qualified as Q
import Hasura.Backends.Postgres.Connection.MonadTx
import Hasura.Backends.Postgres.Execute.Insert (convertToSQLTransaction)
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 (PGSourceConfig (..), dmlTxErrorHandler)
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types qualified as PG
import Hasura.Backends.Postgres.SQL.Value qualified as PG
import Hasura.Backends.Postgres.Translate.Select (PostgresAnnotatedFieldJSON)
import Hasura.Backends.Postgres.Translate.Select qualified as DS
import Hasura.Backends.Postgres.Types.Function qualified as PG
import Hasura.Backends.Postgres.Types.Update qualified as BackendUpdate
import Hasura.Base.Error (QErr)
import Hasura.EncJSON (EncJSON, encJFromBS, encJFromJValue)
import Hasura.GraphQL.Execute.Backend
  ( BackendExecute (..),
    DBStepInfo (..),
    ExplainPlan (..),
    convertRemoteSourceRelationship,
  )
import Hasura.GraphQL.Execute.Subscription.Plan
  ( ParameterizedSubscriptionQueryPlan (..),
    SubscriptionQueryPlan (..),
    SubscriptionQueryPlanExplanation (..),
    mkCohortVariables,
    newCohortId,
  )
import Hasura.GraphQL.Namespace
  ( RootFieldAlias (..),
    RootFieldMap,
  )
import Hasura.GraphQL.Namespace qualified as G
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Prelude
import Hasura.QueryTags
  ( QueryTagsComment (..),
    emptyQueryTagsComment,
  )
import Hasura.RQL.IR
import Hasura.RQL.IR.Delete qualified as IR
import Hasura.RQL.IR.Insert qualified as IR
import Hasura.RQL.IR.Returning qualified as IR
import Hasura.RQL.IR.Select qualified as IR
import Hasura.RQL.IR.Update qualified as IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
  ( ColumnType (..),
    ColumnValue (..),
    ciName,
  )
import Hasura.RQL.Types.Common
  ( FieldName (..),
    JsonAggSelect (..),
    SourceName,
  )
import Hasura.RQL.Types.Function
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.Session (UserInfo (..))
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G

data PreparedSql = PreparedSql
  { PreparedSql -> Query
_psQuery :: Q.Query,
    PreparedSql -> PrepArgMap
_psPrepArgs :: PrepArgMap
  }

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) = Tracing.TraceT (Q.TxET QErr IO)

  mkDBQueryPlan :: UserInfo
-> Environment
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
mkDBQueryPlan = UserInfo
-> Environment
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> Environment
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
pgDBQueryPlan
  mkDBMutationPlan :: UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> MutationDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
mkDBMutationPlan = UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> MutationDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> MutationDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
pgDBMutationPlan
  mkLiveQuerySubscriptionPlan :: UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> Maybe Name
-> RootFieldMap
     (QueryDB
        ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
mkLiveQuerySubscriptionPlan = UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> Maybe Name
-> RootFieldMap
     (QueryDB
        ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> 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)))
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
pgDBLiveQuerySubscriptionPlan
  mkDBStreamingSubscriptionPlan :: UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> (RootFieldAlias,
    QueryDB
      ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
mkDBStreamingSubscriptionPlan = UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> (RootFieldAlias,
    QueryDB
      ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> 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)))
-> m (SubscriptionQueryPlan
        ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
pgDBStreamingSubscriptionPlan
  mkDBQueryExplain :: RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (AnyBackend DBStepInfo)
mkDBQueryExplain = RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> 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))
-> m (AnyBackend DBStepInfo)
pgDBQueryExplain
  mkSubscriptionExplain :: 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 :: UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> NonEmpty Object
-> HashMap
     FieldName
     (Column ('Postgres pgKind), ScalarType ('Postgres pgKind))
-> FieldName
-> (FieldName,
    SourceRelationshipSelection
      ('Postgres pgKind) Void UnpreparedValue)
-> 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)
-> 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)
-> m (DBStepInfo ('Postgres pgKind))
pgDBRemoteRelationshipPlan

-- query

pgDBQueryPlan ::
  forall pgKind m.
  ( MonadError QErr m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  UserInfo ->
  Env.Environment ->
  SourceName ->
  SourceConfig ('Postgres pgKind) ->
  QueryDB ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  m (DBStepInfo ('Postgres pgKind))
pgDBQueryPlan :: UserInfo
-> Environment
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
pgDBQueryPlan UserInfo
userInfo Environment
_env SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
qrf = do
  (QueryDB ('Postgres pgKind) Void SQLExp
preparedQuery, PlanningSt Int
_ PlanVariables
_ 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)
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
  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 (TraceT (TxET QErr IO) EncJSON
action, Maybe PreparedSql
preparedSQL) = UserInfo
-> PreparedSql
-> (TraceT (TxET QErr IO) EncJSON, Maybe PreparedSql)
mkCurPlanTx UserInfo
userInfo PreparedSql
preparedSQLWithQueryTags
  DBStepInfo ('Postgres pgKind) -> m (DBStepInfo ('Postgres pgKind))
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
$ SourceName
-> SourceConfig ('Postgres pgKind)
-> Maybe (PreparedQuery ('Postgres pgKind))
-> ExecutionMonad ('Postgres pgKind) EncJSON
-> DBStepInfo ('Postgres pgKind)
forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> ExecutionMonad b EncJSON
-> DBStepInfo b
DBStepInfo @('Postgres pgKind) SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig Maybe (PreparedQuery ('Postgres pgKind))
Maybe PreparedSql
preparedSQL TraceT (TxET QErr IO) EncJSON
ExecutionMonad ('Postgres pgKind) EncJSON
action

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)) ->
  m (AB.AnyBackend DBStepInfo)
pgDBQueryExplain :: RootFieldAlias
-> UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (AnyBackend DBStepInfo)
pgDBQueryExplain RootFieldAlias
fieldName UserInfo
userInfo SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
rootSelection = 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)
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
Q.getQueryText Query
querySQL
      -- CAREFUL!: an `EXPLAIN ANALYZE` here would actually *execute* this
      -- query, maybe resulting in privilege escalation:
      withExplain :: Text
withExplain = Text
"EXPLAIN (FORMAT TEXT) " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textSQL
  let action :: TraceT (TxET QErr IO) EncJSON
action =
        TxE QErr EncJSON -> TraceT (TxET QErr IO) EncJSON
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr EncJSON -> TraceT (TxET QErr IO) EncJSON)
-> TxE QErr EncJSON -> TraceT (TxET QErr IO) EncJSON
forall a b. (a -> b) -> a -> b
$
          (PGTxErr -> QErr)
-> Query -> () -> Bool -> TxET QErr IO [Identity Text]
forall (m :: * -> *) a r e.
(MonadIO m, FromRow a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m [a]
Q.listQE PGTxErr -> QErr
dmlTxErrorHandler (Text -> Query
Q.fromText Text
withExplain) () Bool
True TxET QErr IO [Identity Text]
-> ([Identity Text] -> EncJSON) -> TxE QErr EncJSON
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Identity Text]
planList ->
            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)
  AnyBackend DBStepInfo -> m (AnyBackend DBStepInfo)
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
$
      SourceName
-> SourceConfig ('Postgres pgKind)
-> Maybe (PreparedQuery ('Postgres pgKind))
-> ExecutionMonad ('Postgres pgKind) EncJSON
-> DBStepInfo ('Postgres pgKind)
forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> ExecutionMonad b EncJSON
-> DBStepInfo b
DBStepInfo @('Postgres pgKind) SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig Maybe (PreparedQuery ('Postgres pgKind))
forall a. Maybe a
Nothing TraceT (TxET QErr IO) EncJSON
ExecutionMonad ('Postgres pgKind) EncJSON
action

pgDBSubscriptionExplain ::
  ( MonadError QErr m,
    MonadIO m,
    MT.MonadBaseControl IO m
  ) =>
  SubscriptionQueryPlan ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)) ->
  m SubscriptionQueryPlanExplanation
pgDBSubscriptionExplain :: 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
Q.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
Q.fromText (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"EXPLAIN (FORMAT TEXT) " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
queryText
  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
-> TxAccess -> TxET QErr m [Text] -> ExceptT QErr m [Text]
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
PGExecCtx -> TxAccess -> TxET QErr m a -> ExceptT QErr m a
runTx PGExecCtx
pgExecCtx TxAccess
Q.ReadOnly (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, FromRow 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 (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
  ) =>
  UserInfo ->
  IR.AnnDelG ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  Options.StringifyNumbers ->
  m (Tracing.TraceT (Q.TxET QErr IO) EncJSON)
convertDelete :: UserInfo
-> AnnDelG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> m (TraceT (TxET QErr IO) EncJSON)
convertDelete UserInfo
userInfo AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
deleteOperation StringifyNumbers
stringifyNum = do
  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)
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
  TraceT (TxET QErr IO) EncJSON -> m (TraceT (TxET QErr IO) EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceT (TxET QErr IO) EncJSON
 -> m (TraceT (TxET QErr IO) EncJSON))
-> TraceT (TxET QErr IO) EncJSON
-> m (TraceT (TxET QErr IO) EncJSON)
forall a b. (a -> b) -> a -> b
$ (ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
 -> QueryTagsComment -> TraceT (TxET QErr IO) EncJSON)
-> QueryTagsComment
-> ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
-> TraceT (TxET QErr IO) EncJSON
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
-> QueryTagsComment -> TraceT (TxET QErr IO) EncJSON
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT QueryTagsComment
queryTags (ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
 -> TraceT (TxET QErr IO) EncJSON)
-> ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
-> TraceT (TxET QErr IO) EncJSON
forall a b. (a -> b) -> a -> b
$ StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (AnnDel ('Postgres pgKind), Seq PrepArg)
-> ReaderT QueryTagsComment (TraceT (TxET QErr IO)) 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
  ) =>
  UserInfo ->
  IR.AnnotatedUpdateG ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  Options.StringifyNumbers ->
  m (Tracing.TraceT (Q.TxET QErr IO) EncJSON)
convertUpdate :: UserInfo
-> AnnotatedUpdateG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> m (TraceT (TxET QErr IO) EncJSON)
convertUpdate UserInfo
userInfo AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
updateOperation StringifyNumbers
stringifyNum = do
  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)
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 BackendUpdate pgKind (UnpreparedValue ('Postgres pgKind)) -> Bool
forall (pgKind :: PostgresKind) v. BackendUpdate pgKind v -> Bool
BackendUpdate.isEmpty (BackendUpdate pgKind (UnpreparedValue ('Postgres pgKind)) -> Bool)
-> BackendUpdate pgKind (UnpreparedValue ('Postgres pgKind))
-> Bool
forall a b. (a -> b) -> a -> b
$ AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> BackendUpdate
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> BackendUpdate b v
IR._auBackend AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
updateOperation
    then TraceT (TxET QErr IO) EncJSON -> m (TraceT (TxET QErr IO) EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceT (TxET QErr IO) EncJSON
 -> m (TraceT (TxET QErr IO) EncJSON))
-> TraceT (TxET QErr IO) EncJSON
-> m (TraceT (TxET QErr IO) EncJSON)
forall a b. (a -> b) -> a -> b
$ EncJSON -> TraceT (TxET QErr IO) EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> TraceT (TxET QErr IO) EncJSON)
-> EncJSON -> TraceT (TxET QErr IO) 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
      TraceT (TxET QErr IO) EncJSON -> m (TraceT (TxET QErr IO) EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceT (TxET QErr IO) EncJSON
 -> m (TraceT (TxET QErr IO) EncJSON))
-> TraceT (TxET QErr IO) EncJSON
-> m (TraceT (TxET QErr IO) EncJSON)
forall a b. (a -> b) -> a -> b
$
        (ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
 -> QueryTagsComment -> TraceT (TxET QErr IO) EncJSON)
-> QueryTagsComment
-> ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
-> TraceT (TxET QErr IO) EncJSON
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
-> QueryTagsComment -> TraceT (TxET QErr IO) EncJSON
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT QueryTagsComment
queryTags (ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
 -> TraceT (TxET QErr IO) EncJSON)
-> ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
-> TraceT (TxET QErr IO) EncJSON
forall a b. (a -> b) -> a -> b
$
          StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (AnnotatedUpdate ('Postgres pgKind), Seq PrepArg)
-> ReaderT QueryTagsComment (TraceT (TxET QErr IO)) 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,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  UserInfo ->
  IR.AnnotatedInsert ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  Options.StringifyNumbers ->
  m (Tracing.TraceT (Q.TxET QErr IO) EncJSON)
convertInsert :: UserInfo
-> AnnotatedInsert
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> m (TraceT (TxET QErr IO) EncJSON)
convertInsert UserInfo
userInfo AnnotatedInsert
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
insertOperation StringifyNumbers
stringifyNum = do
  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)
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
  TraceT (TxET QErr IO) EncJSON -> m (TraceT (TxET QErr IO) EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceT (TxET QErr IO) EncJSON
 -> m (TraceT (TxET QErr IO) EncJSON))
-> TraceT (TxET QErr IO) EncJSON
-> m (TraceT (TxET QErr IO) EncJSON)
forall a b. (a -> b) -> a -> b
$ (ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
 -> QueryTagsComment -> TraceT (TxET QErr IO) EncJSON)
-> QueryTagsComment
-> ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
-> TraceT (TxET QErr IO) EncJSON
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
-> QueryTagsComment -> TraceT (TxET QErr IO) EncJSON
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT QueryTagsComment
queryTags (ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
 -> TraceT (TxET QErr IO) EncJSON)
-> ReaderT QueryTagsComment (TraceT (TxET QErr IO)) EncJSON
-> TraceT (TxET QErr IO) EncJSON
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert ('Postgres pgKind) Void SQLExp
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> ReaderT QueryTagsComment (TraceT (TxET QErr IO)) 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 (Tracing.TraceT (Q.TxET QErr IO) EncJSON)
convertFunction :: UserInfo
-> JsonAggSelect
-> AnnSimpleSelectG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (TraceT (TxET QErr IO) 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 Int
_ PlanVariables
_ 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)
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
  TraceT (TxET QErr IO) EncJSON -> m (TraceT (TxET QErr IO) EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (TraceT (TxET QErr IO) EncJSON
 -> m (TraceT (TxET QErr IO) EncJSON))
-> TraceT (TxET QErr IO) EncJSON
-> m (TraceT (TxET QErr IO) EncJSON)
forall a b. (a -> b) -> a -> b
$! (TraceT (TxET QErr IO) EncJSON, Maybe PreparedSql)
-> TraceT (TxET QErr IO) EncJSON
forall a b. (a, b) -> a
fst
    ((TraceT (TxET QErr IO) EncJSON, Maybe PreparedSql)
 -> TraceT (TxET QErr IO) EncJSON)
-> (TraceT (TxET QErr IO) EncJSON, Maybe PreparedSql)
-> TraceT (TxET QErr IO) EncJSON
forall a b. (a -> b) -> a -> b
$ UserInfo
-> PreparedSql
-> (TraceT (TxET QErr IO) EncJSON, Maybe PreparedSql)
mkCurPlanTx UserInfo
userInfo PreparedSql
preparedSQLWithQueryTags -- forget (Maybe PreparedSql)

pgDBMutationPlan ::
  forall pgKind m.
  ( MonadError QErr m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  UserInfo ->
  Options.StringifyNumbers ->
  SourceName ->
  SourceConfig ('Postgres pgKind) ->
  MutationDB ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)) ->
  m (DBStepInfo ('Postgres pgKind))
pgDBMutationPlan :: UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> MutationDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
pgDBMutationPlan UserInfo
userInfo StringifyNumbers
stringifyNum SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig MutationDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
mrf = do
  TraceT (TxET QErr IO) EncJSON -> DBStepInfo ('Postgres pgKind)
go (TraceT (TxET QErr IO) EncJSON -> DBStepInfo ('Postgres pgKind))
-> m (TraceT (TxET QErr IO) 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 -> UserInfo
-> AnnotatedInsert
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> m (TraceT (TxET QErr IO) EncJSON)
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> AnnotatedInsert
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> m (TraceT (TxET QErr IO) EncJSON)
convertInsert UserInfo
userInfo AnnotatedInsert
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s StringifyNumbers
stringifyNum
    MDBUpdate AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s -> UserInfo
-> AnnotatedUpdateG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> m (TraceT (TxET QErr IO) EncJSON)
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> AnnotatedUpdateG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> m (TraceT (TxET QErr IO) EncJSON)
convertUpdate UserInfo
userInfo AnnotatedUpdateG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s StringifyNumbers
stringifyNum
    MDBDelete AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s -> UserInfo
-> AnnDelG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> m (TraceT (TxET QErr IO) EncJSON)
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> AnnDelG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> StringifyNumbers
-> m (TraceT (TxET QErr IO) EncJSON)
convertDelete UserInfo
userInfo AnnDelG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s StringifyNumbers
stringifyNum
    MDBFunction JsonAggSelect
returnsSet AnnSimpleSelectG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s -> UserInfo
-> JsonAggSelect
-> AnnSimpleSelectG
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (TraceT (TxET QErr IO) 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 (TraceT (TxET QErr IO) EncJSON)
convertFunction UserInfo
userInfo JsonAggSelect
returnsSet AnnSimpleSelectG
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
s
  where
    go :: TraceT (TxET QErr IO) EncJSON -> DBStepInfo ('Postgres pgKind)
go TraceT (TxET QErr IO) EncJSON
v = SourceName
-> SourceConfig ('Postgres pgKind)
-> Maybe (PreparedQuery ('Postgres pgKind))
-> ExecutionMonad ('Postgres pgKind) EncJSON
-> DBStepInfo ('Postgres pgKind)
forall (b :: BackendType).
SourceName
-> SourceConfig b
-> Maybe (PreparedQuery b)
-> ExecutionMonad b EncJSON
-> DBStepInfo b
DBStepInfo @('Postgres pgKind) SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig Maybe (PreparedQuery ('Postgres pgKind))
forall a. Maybe a
Nothing TraceT (TxET QErr IO) EncJSON
ExecutionMonad ('Postgres pgKind) EncJSON
v

-- 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))) ->
  m (SubscriptionQueryPlan ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
pgDBLiveQuerySubscriptionPlan :: UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> Maybe Name
-> RootFieldMap
     (QueryDB
        ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> 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 = do
  (InsOrdHashMap
  RootFieldAlias (QueryDB ('Postgres pgKind) Void SQLExp)
preparedAST, PGL.QueryParametersInfo {Seq (ColumnValue ('Postgres pgKind))
HashMap Name (ColumnValue ('Postgres pgKind))
HashSet SessionVariable
_qpiReferencedSessionVariables :: forall (b :: BackendType).
QueryParametersInfo b -> HashSet SessionVariable
_qpiSyntheticVariableValues :: forall (b :: BackendType).
QueryParametersInfo b -> Seq (ColumnValue b)
_qpiReusableVariableValues :: forall (b :: BackendType).
QueryParametersInfo b -> HashMap Name (ColumnValue b)
_qpiReferencedSessionVariables :: HashSet SessionVariable
_qpiSyntheticVariableValues :: Seq (ColumnValue ('Postgres pgKind))
_qpiReusableVariableValues :: HashMap Name (ColumnValue ('Postgres pgKind))
..}) <-
    (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)
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
OMap.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

  -- 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.
  ValidatedVariables (HashMap Name)
validatedQueryVars <- PGExecCtx
-> HashMap Name (ColumnValue ('Postgres pgKind))
-> m (ValidatedVariables (HashMap Name))
forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadError QErr m, MonadIO m) =>
PGExecCtx
-> f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
PGL.validateVariables (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) HashMap Name (ColumnValue ('Postgres pgKind))
_qpiReusableVariableValues
  ValidatedVariables []
validatedSyntheticVars <- PGExecCtx
-> [ColumnValue ('Postgres pgKind)] -> m (ValidatedVariables [])
forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadError QErr m, MonadIO m) =>
PGExecCtx
-> f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
PGL.validateVariables (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) ([ColumnValue ('Postgres pgKind)] -> m (ValidatedVariables []))
-> [ColumnValue ('Postgres pgKind)] -> m (ValidatedVariables [])
forall a b. (a -> b) -> a -> b
$ Seq (ColumnValue ('Postgres pgKind))
-> [ColumnValue ('Postgres pgKind)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (ColumnValue ('Postgres pgKind))
_qpiSyntheticVariableValues

  -- TODO validatedQueryVars validatedSyntheticVars
  let cohortVariables :: CohortVariables
cohortVariables =
        HashSet SessionVariable
-> SessionVariables
-> ValidatedVariables (HashMap Name)
-> ValidatedVariables []
-> ValidatedVariables (HashMap Name)
-> CohortVariables
mkCohortVariables
          HashSet SessionVariable
_qpiReferencedSessionVariables
          (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo)
          ValidatedVariables (HashMap Name)
validatedQueryVars
          ValidatedVariables []
validatedSyntheticVars
          ValidatedVariables (HashMap Name)
forall a. Monoid a => a
mempty -- live query subscriptions don't use the streaming cursor variables
  SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> m (SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery)
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)
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
forall (b :: BackendType) q.
ParameterizedSubscriptionQueryPlan b q
-> SourceConfig b
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan b q
SubscriptionQueryPlan ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
parameterizedPlan SourceConfig ('Postgres pgKind)
sourceConfig 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)))) ->
  m (SubscriptionQueryPlan ('Postgres pgKind) (MultiplexedQuery ('Postgres pgKind)))
pgDBStreamingSubscriptionPlan :: UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> (RootFieldAlias,
    QueryDB
      ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind)))
-> 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) = do
  (QueryDB ('Postgres pgKind) Void SQLExp
preparedAST, PGL.QueryParametersInfo {Seq (ColumnValue ('Postgres pgKind))
HashMap Name (ColumnValue ('Postgres pgKind))
HashSet SessionVariable
_qpiReferencedSessionVariables :: HashSet SessionVariable
_qpiSyntheticVariableValues :: Seq (ColumnValue ('Postgres pgKind))
_qpiReusableVariableValues :: HashMap Name (ColumnValue ('Postgres pgKind))
_qpiReferencedSessionVariables :: forall (b :: BackendType).
QueryParametersInfo b -> HashSet SessionVariable
_qpiSyntheticVariableValues :: forall (b :: BackendType).
QueryParametersInfo b -> Seq (ColumnValue b)
_qpiReusableVariableValues :: forall (b :: BackendType).
QueryParametersInfo b -> HashMap Name (ColumnValue b)
..}) <-
    (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)
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

  -- 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.
  ValidatedVariables (HashMap Name)
validatedQueryVars <- PGExecCtx
-> HashMap Name (ColumnValue ('Postgres pgKind))
-> m (ValidatedVariables (HashMap Name))
forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadError QErr m, MonadIO m) =>
PGExecCtx
-> f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
PGL.validateVariables (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) HashMap Name (ColumnValue ('Postgres pgKind))
_qpiReusableVariableValues
  ValidatedVariables []
validatedSyntheticVars <- PGExecCtx
-> [ColumnValue ('Postgres pgKind)] -> m (ValidatedVariables [])
forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadError QErr m, MonadIO m) =>
PGExecCtx
-> f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
PGL.validateVariables (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) ([ColumnValue ('Postgres pgKind)] -> m (ValidatedVariables []))
-> [ColumnValue ('Postgres pgKind)] -> m (ValidatedVariables [])
forall a b. (a -> b) -> a -> b
$ Seq (ColumnValue ('Postgres pgKind))
-> [ColumnValue ('Postgres pgKind)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (ColumnValue ('Postgres pgKind))
_qpiSyntheticVariableValues
  ValidatedVariables (HashMap Name)
validatedCursorVars <- PGExecCtx
-> HashMap Name (ColumnValue ('Postgres pgKind))
-> m (ValidatedVariables (HashMap Name))
forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadError QErr m, MonadIO m) =>
PGExecCtx
-> f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
PGL.validateVariables (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
SourceConfig ('Postgres pgKind)
sourceConfig) (HashMap Name (ColumnValue ('Postgres pgKind))
 -> m (ValidatedVariables (HashMap Name)))
-> HashMap Name (ColumnValue ('Postgres pgKind))
-> m (ValidatedVariables (HashMap Name))
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
-> ValidatedVariables (HashMap Name)
-> ValidatedVariables []
-> ValidatedVariables (HashMap Name)
-> CohortVariables
mkCohortVariables
          HashSet SessionVariable
_qpiReferencedSessionVariables
          (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo)
          ValidatedVariables (HashMap Name)
validatedQueryVars
          ValidatedVariables []
validatedSyntheticVars
          ValidatedVariables (HashMap Name)
validatedCursorVars

  SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
-> m (SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery)
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)
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan ('Postgres pgKind) MultiplexedQuery
forall (b :: BackendType) q.
ParameterizedSubscriptionQueryPlan b q
-> SourceConfig b
-> CohortVariables
-> Maybe Name
-> SubscriptionQueryPlan b q
SubscriptionQueryPlan ParameterizedSubscriptionQueryPlan
  ('Postgres pgKind) MultiplexedQuery
parameterizedPlan SourceConfig ('Postgres pgKind)
sourceConfig 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
Map.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

-- turn the current plan into a transaction
mkCurPlanTx ::
  UserInfo ->
  PreparedSql ->
  (Tracing.TraceT (Q.TxET QErr IO) EncJSON, Maybe PreparedSql)
mkCurPlanTx :: UserInfo
-> PreparedSql
-> (TraceT (TxET QErr IO) 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) (TraceT (TxET QErr IO) EncJSON
 -> (TraceT (TxET QErr IO) EncJSON, Maybe PreparedSql))
-> TraceT (TxET QErr IO) EncJSON
-> (TraceT (TxET QErr IO) EncJSON, Maybe PreparedSql)
forall a b. (a -> b) -> a -> b
$
        Text
-> TraceT (TxET QErr IO) EncJSON -> TraceT (TxET QErr IO) EncJSON
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
Tracing.trace Text
"Postgres" (TraceT (TxET QErr IO) EncJSON -> TraceT (TxET QErr IO) EncJSON)
-> TraceT (TxET QErr IO) EncJSON -> TraceT (TxET QErr IO) EncJSON
forall a b. (a -> b) -> a -> b
$ TxE QErr EncJSON -> TraceT (TxET QErr IO) EncJSON
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr EncJSON -> TraceT (TxET QErr IO) EncJSON)
-> TxE QErr EncJSON -> TraceT (TxET QErr IO) EncJSON
forall a b. (a -> b) -> a -> b
$ Query -> [PrepArg] -> TxE QErr EncJSON
asSingleRowJsonResp Query
q [PrepArg]
prepArgs

-- | This function is generally used on the result of 'selectQuerySQL',
-- 'selectAggregateQuerySQL' or 'connectionSelectSQL' to run said query and get
-- back the resulting JSON.
asSingleRowJsonResp ::
  Q.Query ->
  [Q.PrepArg] ->
  Q.TxE QErr EncJSON
asSingleRowJsonResp :: Query -> [PrepArg] -> TxE QErr EncJSON
asSingleRowJsonResp Query
query [PrepArg]
args =
  ByteString -> EncJSON
encJFromBS (ByteString -> EncJSON)
-> (SingleRow (Identity ByteString) -> ByteString)
-> SingleRow (Identity ByteString)
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity (Identity ByteString -> ByteString)
-> (SingleRow (Identity ByteString) -> Identity ByteString)
-> SingleRow (Identity ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleRow (Identity ByteString) -> Identity ByteString
forall a. SingleRow a -> a
Q.getRow
    (SingleRow (Identity ByteString) -> EncJSON)
-> TxET QErr IO (SingleRow (Identity ByteString))
-> TxE QErr EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PGTxErr -> QErr)
-> Query
-> [PrepArg]
-> Bool
-> TxET QErr IO (SingleRow (Identity ByteString))
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> [PrepArg] -> Bool -> TxET e m a
Q.rawQE PGTxErr -> QErr
dmlTxErrorHandler Query
query [PrepArg]
args 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 :: 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 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 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 -> Q.Query) -> t -> PreparedSql
    mkPreparedSql :: (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 :: Q.Query -> QueryTagsComment -> Q.Query
appendSQLWithQueryTags :: Query -> QueryTagsComment -> Query
appendSQLWithQueryTags Query
query QueryTagsComment
queryTags = Query
query {getQueryText :: Text
Q.getQueryText = Text
queryText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QueryTagsComment -> Text
_unQueryTagsComment QueryTagsComment
queryTags}
  where
    queryText :: Text
queryText = Query -> Text
Q.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) ->
  m (DBStepInfo ('Postgres pgKind))
pgDBRemoteRelationshipPlan :: UserInfo
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> NonEmpty Object
-> HashMap
     FieldName
     (Column ('Postgres pgKind), ScalarType ('Postgres pgKind))
-> FieldName
-> (FieldName,
    SourceRelationshipSelection
      ('Postgres pgKind) Void UnpreparedValue)
-> 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 = 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
-> Environment
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> ReaderT QueryTagsComment m (DBStepInfo ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadError QErr m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
UserInfo
-> Environment
-> SourceName
-> SourceConfig ('Postgres pgKind)
-> QueryDB
     ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
-> m (DBStepInfo ('Postgres pgKind))
pgDBQueryPlan UserInfo
userInfo Environment
Env.emptyEnvironment SourceName
sourceName SourceConfig ('Postgres pgKind)
sourceConfig QueryDB
  ('Postgres pgKind) Void (UnpreparedValue ('Postgres pgKind))
rootSelection
  where
    coerceToColumn :: FieldName -> PGCol
coerceToColumn = Text -> PGCol
PG.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 =
      Maybe VariableInfo
-> ColumnValue ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
Maybe VariableInfo -> ColumnValue b -> UnpreparedValue b
UVParameter Maybe VariableInfo
forall a. Maybe a
Nothing (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
PG.PGJSONB) (ScalarValue ('Postgres pgKind) -> ColumnValue ('Postgres pgKind))
-> ScalarValue ('Postgres pgKind) -> ColumnValue ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$
          JSONB -> PGScalarValue
PG.PGValJSONB (JSONB -> PGScalarValue) -> JSONB -> PGScalarValue
forall a b. (a -> b) -> a -> b
$ Value -> JSONB
Q.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
PG.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)]
Map.toList (((PGCol, PGScalarType) -> PGScalarType)
-> HashMap PGCol (PGCol, PGScalarType)
-> HashMap PGCol PGScalarType
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
PG.QualifiedObject SchemaName
"pg_catalog" (FunctionName -> QualifiedObject FunctionName)
-> FunctionName -> QualifiedObject FunctionName
forall a b. (a -> b) -> a -> b
$ Text -> FunctionName
PG.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
PG.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)
-> 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)
-> 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
PG.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
PG.PGBigInt)
        (FieldName,
 SourceRelationshipSelection
   ('Postgres pgKind) Void UnpreparedValue)
relationship