{-# LANGUAGE TemplateHaskell #-}

-- | Postgres Execute subscription
--
-- Multiplex is an optimization which allows us to group similar queries into a
-- single query, and routing the response rows afterwards. See
-- https://hasura.io/docs/latest/graphql/core/databases/postgres/subscriptions/execution-and-performance.html
-- for more details
--
-- See 'Hasura.Backends.Postgres.Instances.Execute'.
module Hasura.Backends.Postgres.Execute.Subscription
  ( MultiplexedQuery (..),
    QueryParametersInfo (..),
    mkMultiplexedQuery,
    mkStreamingMultiplexedQuery,
    resolveMultiplexedValue,
    validateVariablesTx,
    executeMultiplexedQuery,
    executeStreamingMultiplexedQuery,
    executeQuery,
    SubscriptionType (..),
  )
where

import Control.Lens
import Control.Monad.Writer
import Data.ByteString qualified as B
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashSet qualified as Set
import Data.Semigroup.Generic
import Data.Text.Extended
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Error
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Backends.Postgres.Translate.Column (toTxtValue)
import Hasura.Backends.Postgres.Translate.Select qualified as DS
import Hasura.Backends.Postgres.Translate.Select.Internal.Helpers (customSQLToInnerCTEs, toQuery)
import Hasura.Backends.Postgres.Translate.Types (CustomSQLCTEs (..))
import Hasura.Backends.Postgres.Types.Column
import Hasura.Base.Error
import Hasura.GraphQL.Execute.Subscription.Plan
import Hasura.GraphQL.Parser.Names
import Hasura.Prelude
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Subscription
import Hasura.SQL.Types
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G

----------------------------------------------------------------------------------------------------
-- Variables

subsAlias :: S.TableAlias
subsAlias :: TableAlias
subsAlias = Text -> TableAlias
S.mkTableAlias Text
"_subs"

subsIdentifier :: TableIdentifier
subsIdentifier :: TableIdentifier
subsIdentifier = TableAlias -> TableIdentifier
S.tableAliasToIdentifier TableAlias
subsAlias

resultIdAlias, resultVarsAlias :: S.ColumnAlias
resultIdAlias :: ColumnAlias
resultIdAlias = Text -> ColumnAlias
S.mkColumnAlias Text
"result_id"
resultVarsAlias :: ColumnAlias
resultVarsAlias = Text -> ColumnAlias
S.mkColumnAlias Text
"result_vars"

fldRespAlias :: S.TableAlias
fldRespAlias :: TableAlias
fldRespAlias = Text -> TableAlias
S.mkTableAlias Text
"_fld_resp"

fldRespIdentifier :: TableIdentifier
fldRespIdentifier :: TableIdentifier
fldRespIdentifier = TableAlias -> TableIdentifier
S.tableAliasToIdentifier TableAlias
fldRespAlias

-- | Internal: Used to collect information about various parameters
-- of a subscription field's AST as we resolve them to SQL expressions.
data QueryParametersInfo (b :: BackendType) = QueryParametersInfo
  { forall (b :: BackendType).
QueryParametersInfo b -> HashMap Name (ColumnValue b)
_qpiReusableVariableValues :: HashMap G.Name (ColumnValue b),
    forall (b :: BackendType).
QueryParametersInfo b -> Seq (ColumnValue b)
_qpiSyntheticVariableValues :: Seq (ColumnValue b),
    -- | The session variables that are referenced in the query root fld's AST.
    -- This information is used to determine a cohort's required session
    -- variables
    forall (b :: BackendType).
QueryParametersInfo b -> HashSet SessionVariable
_qpiReferencedSessionVariables :: Set.HashSet SessionVariable
  }
  deriving ((forall x. QueryParametersInfo b -> Rep (QueryParametersInfo b) x)
-> (forall x.
    Rep (QueryParametersInfo b) x -> QueryParametersInfo b)
-> Generic (QueryParametersInfo b)
forall x. Rep (QueryParametersInfo b) x -> QueryParametersInfo b
forall x. QueryParametersInfo b -> Rep (QueryParametersInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (QueryParametersInfo b) x -> QueryParametersInfo b
forall (b :: BackendType) x.
QueryParametersInfo b -> Rep (QueryParametersInfo b) x
$cfrom :: forall (b :: BackendType) x.
QueryParametersInfo b -> Rep (QueryParametersInfo b) x
from :: forall x. QueryParametersInfo b -> Rep (QueryParametersInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (QueryParametersInfo b) x -> QueryParametersInfo b
to :: forall x. Rep (QueryParametersInfo b) x -> QueryParametersInfo b
Generic)
  deriving (NonEmpty (QueryParametersInfo b) -> QueryParametersInfo b
QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
(QueryParametersInfo b
 -> QueryParametersInfo b -> QueryParametersInfo b)
-> (NonEmpty (QueryParametersInfo b) -> QueryParametersInfo b)
-> (forall b.
    Integral b =>
    b -> QueryParametersInfo b -> QueryParametersInfo b)
-> Semigroup (QueryParametersInfo b)
forall b.
Integral b =>
b -> QueryParametersInfo b -> QueryParametersInfo b
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (b :: BackendType).
NonEmpty (QueryParametersInfo b) -> QueryParametersInfo b
forall (b :: BackendType).
QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
forall (b :: BackendType) b.
Integral b =>
b -> QueryParametersInfo b -> QueryParametersInfo b
$c<> :: forall (b :: BackendType).
QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
<> :: QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
$csconcat :: forall (b :: BackendType).
NonEmpty (QueryParametersInfo b) -> QueryParametersInfo b
sconcat :: NonEmpty (QueryParametersInfo b) -> QueryParametersInfo b
$cstimes :: forall (b :: BackendType) b.
Integral b =>
b -> QueryParametersInfo b -> QueryParametersInfo b
stimes :: forall b.
Integral b =>
b -> QueryParametersInfo b -> QueryParametersInfo b
Semigroup, Semigroup (QueryParametersInfo b)
QueryParametersInfo b
Semigroup (QueryParametersInfo b)
-> QueryParametersInfo b
-> (QueryParametersInfo b
    -> QueryParametersInfo b -> QueryParametersInfo b)
-> ([QueryParametersInfo b] -> QueryParametersInfo b)
-> Monoid (QueryParametersInfo b)
[QueryParametersInfo b] -> QueryParametersInfo b
QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (b :: BackendType). Semigroup (QueryParametersInfo b)
forall (b :: BackendType). QueryParametersInfo b
forall (b :: BackendType).
[QueryParametersInfo b] -> QueryParametersInfo b
forall (b :: BackendType).
QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
$cmempty :: forall (b :: BackendType). QueryParametersInfo b
mempty :: QueryParametersInfo b
$cmappend :: forall (b :: BackendType).
QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
mappend :: QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
$cmconcat :: forall (b :: BackendType).
[QueryParametersInfo b] -> QueryParametersInfo b
mconcat :: [QueryParametersInfo b] -> QueryParametersInfo b
Monoid) via (GenericSemigroupMonoid (QueryParametersInfo b))

makeLenses ''QueryParametersInfo

-- | Checks if the provided arguments are valid values for their corresponding types.
-- | Generates SQL of the format "select 'v1'::t1, 'v2'::t2 ..."
validateVariablesTx ::
  forall pgKind f m.
  (Traversable f, MonadTx m, MonadIO m) =>
  f (ColumnValue ('Postgres pgKind)) ->
  m (ValidatedVariables f)
validateVariablesTx :: forall (pgKind :: PostgresKind) (f :: * -> *) (m :: * -> *).
(Traversable f, MonadTx m, MonadIO m) =>
f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
validateVariablesTx f (ColumnValue ('Postgres pgKind))
variableValues = do
  -- no need to test the types when there are no variables to test.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (f (ColumnValue ('Postgres pgKind)) -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f (ColumnValue ('Postgres pgKind))
variableValues) do
    let valSel :: Select
valSel = [ColumnValue ('Postgres pgKind)] -> Select
forall {pgKind :: PostgresKind}.
[ColumnValue ('Postgres pgKind)] -> Select
mkValidationSel ([ColumnValue ('Postgres pgKind)] -> Select)
-> [ColumnValue ('Postgres pgKind)] -> Select
forall a b. (a -> b) -> a -> b
$ f (ColumnValue ('Postgres pgKind))
-> [ColumnValue ('Postgres pgKind)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (ColumnValue ('Postgres pgKind))
variableValues
    PG.Discard () <- TxE QErr Discard -> m Discard
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr Discard -> m Discard) -> TxE QErr Discard -> m Discard
forall a b. (a -> b) -> a -> b
$ (PGTxErr -> QErr) -> Query -> [PrepArg] -> Bool -> TxE QErr Discard
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> [PrepArg] -> Bool -> TxET e m a
PG.rawQE PGTxErr -> QErr
dataExnErrHandler (Builder -> Query
PG.fromBuilder (Builder -> Query) -> Builder -> Query
forall a b. (a -> b) -> a -> b
$ Select -> Builder
forall a. ToSQL a => a -> Builder
toSQL Select
valSel) [] Bool
False
    () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  ValidatedVariables f -> m (ValidatedVariables f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValidatedVariables f -> m (ValidatedVariables f))
-> (f TxtEncodedVal -> ValidatedVariables f)
-> f TxtEncodedVal
-> m (ValidatedVariables f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f TxtEncodedVal -> ValidatedVariables f
forall (f :: * -> *). f TxtEncodedVal -> ValidatedVariables f
ValidatedVariables (f TxtEncodedVal -> m (ValidatedVariables f))
-> f TxtEncodedVal -> m (ValidatedVariables f)
forall a b. (a -> b) -> a -> b
$ (ColumnValue ('Postgres pgKind) -> TxtEncodedVal)
-> f (ColumnValue ('Postgres pgKind)) -> f TxtEncodedVal
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PGScalarValue -> TxtEncodedVal
txtEncodedVal (PGScalarValue -> TxtEncodedVal)
-> (ColumnValue ('Postgres pgKind) -> PGScalarValue)
-> ColumnValue ('Postgres pgKind)
-> TxtEncodedVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnValue ('Postgres pgKind) -> ScalarValue ('Postgres pgKind)
ColumnValue ('Postgres pgKind) -> PGScalarValue
forall (b :: BackendType). ColumnValue b -> ScalarValue b
cvValue) f (ColumnValue ('Postgres pgKind))
variableValues
  where
    mkExtr :: ColumnValue ('Postgres pgKind) -> Extractor
mkExtr = (SQLExp -> Maybe ColumnAlias -> Extractor)
-> Maybe ColumnAlias -> SQLExp -> Extractor
forall a b c. (a -> b -> c) -> b -> a -> c
flip SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor Maybe ColumnAlias
forall a. Maybe a
Nothing (SQLExp -> Extractor)
-> (ColumnValue ('Postgres pgKind) -> SQLExp)
-> ColumnValue ('Postgres pgKind)
-> Extractor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnValue ('Postgres pgKind) -> SQLExp
forall (pgKind :: PostgresKind).
ColumnValue ('Postgres pgKind) -> SQLExp
toTxtValue
    mkValidationSel :: [ColumnValue ('Postgres pgKind)] -> Select
mkValidationSel [ColumnValue ('Postgres pgKind)]
vars =
      Select
S.mkSelect {selExtr :: [Extractor]
S.selExtr = (ColumnValue ('Postgres pgKind) -> Extractor)
-> [ColumnValue ('Postgres pgKind)] -> [Extractor]
forall a b. (a -> b) -> [a] -> [b]
map ColumnValue ('Postgres pgKind) -> Extractor
forall {pgKind :: PostgresKind}.
ColumnValue ('Postgres pgKind) -> Extractor
mkExtr [ColumnValue ('Postgres pgKind)]
vars}
    -- Explicitly look for the class of errors raised when the format of a value
    -- provided for a type is incorrect.
    dataExnErrHandler :: PGTxErr -> QErr
dataExnErrHandler = (PGErrorType -> Bool) -> PGTxErr -> QErr
mkTxErrorHandler (Getting Any PGErrorType (Maybe (PGErrorCode PGDataException))
-> PGErrorType -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any PGErrorType (Maybe (PGErrorCode PGDataException))
Prism' PGErrorType (Maybe (PGErrorCode PGDataException))
_PGDataException)

----------------------------------------------------------------------------------------------------
-- Multiplexed queries

newtype MultiplexedQuery = MultiplexedQuery {MultiplexedQuery -> Query
unMultiplexedQuery :: PG.Query}
  deriving (MultiplexedQuery -> MultiplexedQuery -> Bool
(MultiplexedQuery -> MultiplexedQuery -> Bool)
-> (MultiplexedQuery -> MultiplexedQuery -> Bool)
-> Eq MultiplexedQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MultiplexedQuery -> MultiplexedQuery -> Bool
== :: MultiplexedQuery -> MultiplexedQuery -> Bool
$c/= :: MultiplexedQuery -> MultiplexedQuery -> Bool
/= :: MultiplexedQuery -> MultiplexedQuery -> Bool
Eq, Eq MultiplexedQuery
Eq MultiplexedQuery
-> (Int -> MultiplexedQuery -> Int)
-> (MultiplexedQuery -> Int)
-> Hashable MultiplexedQuery
Int -> MultiplexedQuery -> Int
MultiplexedQuery -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> MultiplexedQuery -> Int
hashWithSalt :: Int -> MultiplexedQuery -> Int
$chash :: MultiplexedQuery -> Int
hash :: MultiplexedQuery -> Int
Hashable)

instance ToTxt MultiplexedQuery where
  toTxt :: MultiplexedQuery -> Text
toTxt = Query -> Text
PG.getQueryText (Query -> Text)
-> (MultiplexedQuery -> Query) -> MultiplexedQuery -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiplexedQuery -> Query
unMultiplexedQuery

toSQLFromItem ::
  ( Backend ('Postgres pgKind),
    DS.PostgresAnnotatedFieldJSON pgKind,
    MonadWriter CustomSQLCTEs m
  ) =>
  S.TableAlias ->
  QueryDB ('Postgres pgKind) Void S.SQLExp ->
  m S.FromItem
toSQLFromItem :: forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind,
 MonadWriter CustomSQLCTEs m) =>
TableAlias -> QueryDB ('Postgres pgKind) Void SQLExp -> m FromItem
toSQLFromItem TableAlias
tableAlias = \case
  QDBSingleRow AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s -> Select -> TableAlias -> FromItem
S.mkSelFromItem (Select -> TableAlias -> FromItem)
-> m Select -> m (TableAlias -> FromItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> m Select
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind,
 MonadWriter CustomSQLCTEs m) =>
JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> m Select
DS.mkSQLSelect JsonAggSelect
JASSingleObject AnnSimpleSelect ('Postgres pgKind)
AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s m (TableAlias -> FromItem) -> m TableAlias -> m FromItem
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TableAlias -> m TableAlias
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TableAlias
tableAlias
  QDBMultipleRows AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s -> Select -> TableAlias -> FromItem
S.mkSelFromItem (Select -> TableAlias -> FromItem)
-> m Select -> m (TableAlias -> FromItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> m Select
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind,
 MonadWriter CustomSQLCTEs m) =>
JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> m Select
DS.mkSQLSelect JsonAggSelect
JASMultipleRows AnnSimpleSelect ('Postgres pgKind)
AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s m (TableAlias -> FromItem) -> m TableAlias -> m FromItem
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TableAlias -> m TableAlias
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TableAlias
tableAlias
  QDBAggregation AnnAggregateSelectG ('Postgres pgKind) Void SQLExp
s -> Select -> TableAlias -> FromItem
S.mkSelFromItem (Select -> TableAlias -> FromItem)
-> m Select -> m (TableAlias -> FromItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnAggregateSelect ('Postgres pgKind) -> m Select
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind,
 MonadWriter CustomSQLCTEs m) =>
AnnAggregateSelect ('Postgres pgKind) -> m Select
DS.mkAggregateSelect AnnAggregateSelect ('Postgres pgKind)
AnnAggregateSelectG ('Postgres pgKind) Void SQLExp
s m (TableAlias -> FromItem) -> m TableAlias -> m FromItem
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TableAlias -> m TableAlias
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TableAlias
tableAlias
  QDBConnection ConnectionSelect ('Postgres pgKind) Void SQLExp
s -> SelectWithG Select -> TableAlias -> FromItem
S.mkSelectWithFromItem (SelectWithG Select -> TableAlias -> FromItem)
-> m (SelectWithG Select) -> m (TableAlias -> FromItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionSelect ('Postgres pgKind) Void SQLExp
-> m (SelectWithG Select)
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind,
 MonadWriter CustomSQLCTEs m) =>
ConnectionSelect ('Postgres pgKind) Void SQLExp
-> m (SelectWithG Select)
DS.mkConnectionSelect ConnectionSelect ('Postgres pgKind) Void SQLExp
s m (TableAlias -> FromItem) -> m TableAlias -> m FromItem
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TableAlias -> m TableAlias
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TableAlias
tableAlias
  QDBStreamMultipleRows AnnSimpleStreamSelectG ('Postgres pgKind) Void SQLExp
s -> Select -> TableAlias -> FromItem
S.mkSelFromItem (Select -> TableAlias -> FromItem)
-> m Select -> m (TableAlias -> FromItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnSimpleStreamSelect ('Postgres pgKind) -> m Select
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind,
 MonadWriter CustomSQLCTEs m) =>
AnnSimpleStreamSelect ('Postgres pgKind) -> m Select
DS.mkStreamSQLSelect AnnSimpleStreamSelect ('Postgres pgKind)
AnnSimpleStreamSelectG ('Postgres pgKind) Void SQLExp
s m (TableAlias -> FromItem) -> m TableAlias -> m FromItem
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TableAlias -> m TableAlias
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TableAlias
tableAlias

mkMultiplexedQuery ::
  ( Backend ('Postgres pgKind),
    DS.PostgresAnnotatedFieldJSON pgKind
  ) =>
  InsOrdHashMap.InsOrdHashMap G.Name (QueryDB ('Postgres pgKind) Void S.SQLExp) ->
  MultiplexedQuery
mkMultiplexedQuery :: forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
-> MultiplexedQuery
mkMultiplexedQuery InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
rootFields =
  Query -> MultiplexedQuery
MultiplexedQuery (Query -> MultiplexedQuery)
-> (SelectWithG TopLevelCTE -> Query)
-> SelectWithG TopLevelCTE
-> MultiplexedQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectWithG TopLevelCTE -> Query
toQuery (SelectWithG TopLevelCTE -> MultiplexedQuery)
-> SelectWithG TopLevelCTE -> MultiplexedQuery
forall a b. (a -> b) -> a -> b
$ SelectWithG TopLevelCTE
selectWith
  where
    select :: Select
select =
      Select
S.mkSelect
        { selExtr :: [Extractor]
S.selExtr =
            -- SELECT _subs.result_id, _fld_resp.root AS result
            [ SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (TableIdentifier -> Identifier -> SQLExp
mkQualifiedIdentifier TableIdentifier
subsIdentifier (Text -> Identifier
Identifier Text
"result_id")) Maybe ColumnAlias
forall a. Maybe a
Nothing,
              SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (TableIdentifier -> Identifier -> SQLExp
mkQualifiedIdentifier TableIdentifier
fldRespIdentifier (Text -> Identifier
Identifier Text
"root")) (ColumnAlias -> Maybe ColumnAlias
forall a. a -> Maybe a
Just (ColumnAlias -> Maybe ColumnAlias)
-> ColumnAlias -> Maybe ColumnAlias
forall a b. (a -> b) -> a -> b
$ Identifier -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias (Identifier -> ColumnAlias) -> Identifier -> ColumnAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"result")
            ],
          selFrom :: Maybe FromExp
S.selFrom =
            FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just
              (FromExp -> Maybe FromExp) -> FromExp -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$ [FromItem] -> FromExp
S.FromExp
                [ JoinExpr -> FromItem
S.FIJoin
                    (JoinExpr -> FromItem) -> JoinExpr -> FromItem
forall a b. (a -> b) -> a -> b
$ FromItem -> JoinType -> FromItem -> JoinCond -> JoinExpr
S.JoinExpr FromItem
subsInputFromItem JoinType
S.LeftOuter FromItem
responseLateralFromItem (BoolExp -> JoinCond
S.JoinOn (BoolExp -> JoinCond) -> BoolExp -> JoinCond
forall a b. (a -> b) -> a -> b
$ Bool -> BoolExp
S.BELit Bool
True)
                ]
        }

    -- multiplexed queries may only contain read only raw queries
    selectWith :: SelectWithG TopLevelCTE
selectWith = [(TableAlias, TopLevelCTE)] -> Select -> SelectWithG TopLevelCTE
forall statement.
[(TableAlias, statement)] -> Select -> SelectWithG statement
S.SelectWith [] Select
select

    -- FROM unnest($1::uuid[], $2::json[]) _subs (result_id, result_vars)
    subsInputFromItem :: FromItem
subsInputFromItem =
      [SQLExp] -> TableAlias -> [ColumnAlias] -> FromItem
S.FIUnnest
        [Int -> SQLExp
S.SEPrep Int
1 SQLExp -> TypeAnn -> SQLExp
`S.SETyAnn` Text -> TypeAnn
S.TypeAnn Text
"uuid[]", Int -> SQLExp
S.SEPrep Int
2 SQLExp -> TypeAnn -> SQLExp
`S.SETyAnn` Text -> TypeAnn
S.TypeAnn Text
"json[]"]
        TableAlias
subsAlias
        [Identifier -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias (Identifier -> ColumnAlias) -> Identifier -> ColumnAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"result_id", Identifier -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias (Identifier -> ColumnAlias) -> Identifier -> ColumnAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"result_vars"]

    ([FromItem]
sqlFrom, CustomSQLCTEs
customSQLCTEs) =
      Writer CustomSQLCTEs [FromItem] -> ([FromItem], CustomSQLCTEs)
forall w a. Writer w a -> (a, w)
runWriter
        (Writer CustomSQLCTEs [FromItem] -> ([FromItem], CustomSQLCTEs))
-> Writer CustomSQLCTEs [FromItem] -> ([FromItem], CustomSQLCTEs)
forall a b. (a -> b) -> a -> b
$ ((Name, QueryDB ('Postgres pgKind) Void SQLExp)
 -> WriterT CustomSQLCTEs Identity FromItem)
-> [(Name, QueryDB ('Postgres pgKind) Void SQLExp)]
-> Writer CustomSQLCTEs [FromItem]
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) -> [a] -> f [b]
traverse
          ( \(Name
fieldAlias, QueryDB ('Postgres pgKind) Void SQLExp
resolvedAST) ->
              TableAlias
-> QueryDB ('Postgres pgKind) Void SQLExp
-> WriterT CustomSQLCTEs Identity FromItem
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind,
 MonadWriter CustomSQLCTEs m) =>
TableAlias -> QueryDB ('Postgres pgKind) Void SQLExp -> m FromItem
toSQLFromItem (Text -> TableAlias
S.mkTableAlias (Text -> TableAlias) -> Text -> TableAlias
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName Name
fieldAlias) QueryDB ('Postgres pgKind) Void SQLExp
resolvedAST
          )
          (InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
-> [(Name, QueryDB ('Postgres pgKind) Void SQLExp)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
rootFields)

    -- LEFT OUTER JOIN LATERAL ( ... ) _fld_resp
    responseLateralFromItem :: FromItem
responseLateralFromItem = Select -> TableAlias -> FromItem
S.mkLateralFromItem Select
selectRootFields TableAlias
fldRespAlias
    selectRootFields :: Select
selectRootFields =
      Select
S.mkSelect
        { selExtr :: [Extractor]
S.selExtr = [SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor SQLExp
rootFieldsJsonAggregate (ColumnAlias -> Maybe ColumnAlias
forall a. a -> Maybe a
Just (ColumnAlias -> Maybe ColumnAlias)
-> ColumnAlias -> Maybe ColumnAlias
forall a b. (a -> b) -> a -> b
$ Identifier -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias (Identifier -> ColumnAlias) -> Identifier -> ColumnAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"root")],
          selCTEs :: [(TableAlias, InnerCTE)]
S.selCTEs = CustomSQLCTEs -> [(TableAlias, InnerCTE)]
customSQLToInnerCTEs CustomSQLCTEs
customSQLCTEs,
          selFrom :: Maybe FromExp
S.selFrom =
            FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just (FromExp -> Maybe FromExp) -> FromExp -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$ [FromItem] -> FromExp
S.FromExp [FromItem]
sqlFrom
        }

    -- json_build_object('field1', field1.root, 'field2', field2.root, ...)
    rootFieldsJsonAggregate :: SQLExp
rootFieldsJsonAggregate = Text -> [SQLExp] -> Maybe OrderByExp -> SQLExp
S.SEFnApp Text
"json_build_object" [SQLExp]
rootFieldsJsonPairs Maybe OrderByExp
forall a. Maybe a
Nothing
    rootFieldsJsonPairs :: [SQLExp]
rootFieldsJsonPairs = ((Name -> [SQLExp]) -> [Name] -> [SQLExp])
-> [Name] -> (Name -> [SQLExp]) -> [SQLExp]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> [SQLExp]) -> [Name] -> [SQLExp]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
-> [Name]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
rootFields) ((Name -> [SQLExp]) -> [SQLExp]) -> (Name -> [SQLExp]) -> [SQLExp]
forall a b. (a -> b) -> a -> b
$ \Name
fieldAlias ->
      [ Text -> SQLExp
S.SELit (Name -> Text
G.unName Name
fieldAlias),
        TableIdentifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Name -> TableIdentifier
aliasToIdentifier Name
fieldAlias) (Text -> Identifier
Identifier Text
"root")
      ]

    mkQualifiedIdentifier :: TableIdentifier -> Identifier -> SQLExp
mkQualifiedIdentifier TableIdentifier
prefix = QIdentifier -> SQLExp
S.SEQIdentifier (QIdentifier -> SQLExp)
-> (Identifier -> QIdentifier) -> Identifier -> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qual -> Identifier -> QIdentifier
S.QIdentifier (TableIdentifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier TableIdentifier
prefix Maybe TypeAnn
forall a. Maybe a
Nothing)
    aliasToIdentifier :: Name -> TableIdentifier
aliasToIdentifier = Text -> TableIdentifier
TableIdentifier (Text -> TableIdentifier)
-> (Name -> Text) -> Name -> TableIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
G.unName

mkStreamingMultiplexedQuery ::
  ( Backend ('Postgres pgKind),
    DS.PostgresAnnotatedFieldJSON pgKind
  ) =>
  (G.Name, (QueryDB ('Postgres pgKind) Void S.SQLExp)) ->
  MultiplexedQuery
mkStreamingMultiplexedQuery :: forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
(Name, QueryDB ('Postgres pgKind) Void SQLExp) -> MultiplexedQuery
mkStreamingMultiplexedQuery (Name
fieldAlias, QueryDB ('Postgres pgKind) Void SQLExp
resolvedAST) =
  Query -> MultiplexedQuery
MultiplexedQuery (Query -> MultiplexedQuery)
-> (SelectWithG TopLevelCTE -> Query)
-> SelectWithG TopLevelCTE
-> MultiplexedQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectWithG TopLevelCTE -> Query
toQuery (SelectWithG TopLevelCTE -> MultiplexedQuery)
-> SelectWithG TopLevelCTE -> MultiplexedQuery
forall a b. (a -> b) -> a -> b
$ SelectWithG TopLevelCTE
selectWith
  where
    selectWith :: SelectWithG TopLevelCTE
selectWith = [(TableAlias, TopLevelCTE)] -> Select -> SelectWithG TopLevelCTE
forall statement.
[(TableAlias, statement)] -> Select -> SelectWithG statement
S.SelectWith [] Select
select

    select :: Select
select =
      Select
S.mkSelect
        { selExtr :: [Extractor]
S.selExtr =
            -- SELECT _subs.result_id, _fld_resp.root, _fld_resp.cursor AS result
            [ SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (TableIdentifier -> Identifier -> SQLExp
mkQualifiedIdentifier TableIdentifier
subsIdentifier (Text -> Identifier
Identifier Text
"result_id")) Maybe ColumnAlias
forall a. Maybe a
Nothing,
              SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (TableIdentifier -> Identifier -> SQLExp
mkQualifiedIdentifier TableIdentifier
fldRespIdentifier (Text -> Identifier
Identifier Text
"root")) (ColumnAlias -> Maybe ColumnAlias
forall a. a -> Maybe a
Just (ColumnAlias -> Maybe ColumnAlias)
-> ColumnAlias -> Maybe ColumnAlias
forall a b. (a -> b) -> a -> b
$ Identifier -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias (Identifier -> ColumnAlias) -> Identifier -> ColumnAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"result"),
              SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (TableIdentifier -> Identifier -> SQLExp
mkQualifiedIdentifier TableIdentifier
fldRespIdentifier (Text -> Identifier
Identifier Text
"cursor")) (ColumnAlias -> Maybe ColumnAlias
forall a. a -> Maybe a
Just (ColumnAlias -> Maybe ColumnAlias)
-> ColumnAlias -> Maybe ColumnAlias
forall a b. (a -> b) -> a -> b
$ Identifier -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias (Identifier -> ColumnAlias) -> Identifier -> ColumnAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"cursor")
            ],
          selFrom :: Maybe FromExp
S.selFrom =
            FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just
              (FromExp -> Maybe FromExp) -> FromExp -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$ [FromItem] -> FromExp
S.FromExp
                [ JoinExpr -> FromItem
S.FIJoin
                    (JoinExpr -> FromItem) -> JoinExpr -> FromItem
forall a b. (a -> b) -> a -> b
$ FromItem -> JoinType -> FromItem -> JoinCond -> JoinExpr
S.JoinExpr FromItem
subsInputFromItem JoinType
S.LeftOuter FromItem
responseLateralFromItem (BoolExp -> JoinCond
S.JoinOn (BoolExp -> JoinCond) -> BoolExp -> JoinCond
forall a b. (a -> b) -> a -> b
$ Bool -> BoolExp
S.BELit Bool
True)
                ]
        }

    -- FROM unnest($1::uuid[], $2::json[]) _subs (result_id, result_vars)
    subsInputFromItem :: FromItem
subsInputFromItem =
      [SQLExp] -> TableAlias -> [ColumnAlias] -> FromItem
S.FIUnnest
        [Int -> SQLExp
S.SEPrep Int
1 SQLExp -> TypeAnn -> SQLExp
`S.SETyAnn` Text -> TypeAnn
S.TypeAnn Text
"uuid[]", Int -> SQLExp
S.SEPrep Int
2 SQLExp -> TypeAnn -> SQLExp
`S.SETyAnn` Text -> TypeAnn
S.TypeAnn Text
"json[]"]
        TableAlias
subsAlias
        [ColumnAlias
resultIdAlias, ColumnAlias
resultVarsAlias]

    -- LEFT OUTER JOIN LATERAL ( ... ) _fld_resp
    responseLateralFromItem :: FromItem
responseLateralFromItem = Select -> TableAlias -> FromItem
S.mkLateralFromItem Select
selectRootFields TableAlias
fldRespAlias

    (FromItem
fromSQL, CustomSQLCTEs
customSQLCTEs) = WriterT CustomSQLCTEs Identity FromItem
-> (FromItem, CustomSQLCTEs)
forall w a. Writer w a -> (a, w)
runWriter (TableAlias
-> QueryDB ('Postgres pgKind) Void SQLExp
-> WriterT CustomSQLCTEs Identity FromItem
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind,
 MonadWriter CustomSQLCTEs m) =>
TableAlias -> QueryDB ('Postgres pgKind) Void SQLExp -> m FromItem
toSQLFromItem (Text -> TableAlias
S.mkTableAlias (Text -> TableAlias) -> Text -> TableAlias
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName Name
fieldAlias) QueryDB ('Postgres pgKind) Void SQLExp
resolvedAST)

    selectRootFields :: Select
selectRootFields =
      Select
S.mkSelect
        { selExtr :: [Extractor]
S.selExtr = [(SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor SQLExp
rootFieldJsonAggregate (ColumnAlias -> Maybe ColumnAlias
forall a. a -> Maybe a
Just (ColumnAlias -> Maybe ColumnAlias)
-> ColumnAlias -> Maybe ColumnAlias
forall a b. (a -> b) -> a -> b
$ Identifier -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias (Identifier -> ColumnAlias) -> Identifier -> ColumnAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"root")), Extractor
cursorExtractor],
          selCTEs :: [(TableAlias, InnerCTE)]
S.selCTEs = CustomSQLCTEs -> [(TableAlias, InnerCTE)]
customSQLToInnerCTEs CustomSQLCTEs
customSQLCTEs,
          selFrom :: Maybe FromExp
S.selFrom =
            FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just (FromExp -> Maybe FromExp) -> FromExp -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$ [FromItem] -> FromExp
S.FromExp [FromItem
fromSQL]
        }

    -- json_build_object('field1', field1.root, 'field2', field2.root, ...)
    rootFieldJsonAggregate :: SQLExp
rootFieldJsonAggregate = Text -> [SQLExp] -> Maybe OrderByExp -> SQLExp
S.SEFnApp Text
"json_build_object" [SQLExp]
rootFieldJsonPair Maybe OrderByExp
forall a. Maybe a
Nothing
    rootFieldJsonPair :: [SQLExp]
rootFieldJsonPair =
      [ Text -> SQLExp
S.SELit (Name -> Text
G.unName Name
fieldAlias),
        TableIdentifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Name -> TableIdentifier
aliasToIdentifier Name
fieldAlias) (Text -> Identifier
Identifier Text
"root")
      ]

    -- to_json("root"."cursor") AS "cursor"
    cursorSQLExp :: SQLExp
cursorSQLExp = Text -> [SQLExp] -> Maybe OrderByExp -> SQLExp
S.SEFnApp Text
"to_json" [TableIdentifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Name -> TableIdentifier
aliasToIdentifier Name
fieldAlias) (Text -> Identifier
Identifier Text
"cursor")] Maybe OrderByExp
forall a. Maybe a
Nothing
    cursorExtractor :: Extractor
cursorExtractor = SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor SQLExp
cursorSQLExp (ColumnAlias -> Maybe ColumnAlias
forall a. a -> Maybe a
Just (ColumnAlias -> Maybe ColumnAlias)
-> ColumnAlias -> Maybe ColumnAlias
forall a b. (a -> b) -> a -> b
$ Identifier -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias (Identifier -> ColumnAlias) -> Identifier -> ColumnAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"cursor")
    mkQualifiedIdentifier :: TableIdentifier -> Identifier -> SQLExp
mkQualifiedIdentifier TableIdentifier
prefix = QIdentifier -> SQLExp
S.SEQIdentifier (QIdentifier -> SQLExp)
-> (Identifier -> QIdentifier) -> Identifier -> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qual -> Identifier -> QIdentifier
S.QIdentifier (TableIdentifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier TableIdentifier
prefix Maybe TypeAnn
forall a. Maybe a
Nothing)
    aliasToIdentifier :: Name -> TableIdentifier
aliasToIdentifier = Text -> TableIdentifier
TableIdentifier (Text -> TableIdentifier)
-> (Name -> Text) -> Name -> TableIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
G.unName

-- | Resolves an 'GR.UnresolvedVal' by converting 'GR.UVPG' values to SQL
-- expressions that refer to the @result_vars@ input object, collecting information
-- about various parameters of the query along the way.
resolveMultiplexedValue ::
  ( MonadState (QueryParametersInfo ('Postgres pgKind)) m,
    MonadError QErr m
  ) =>
  SessionVariables ->
  UnpreparedValue ('Postgres pgKind) ->
  m S.SQLExp
resolveMultiplexedValue :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadState (QueryParametersInfo ('Postgres pgKind)) m,
 MonadError QErr m) =>
SessionVariables -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
resolveMultiplexedValue SessionVariables
allSessionVars = \case
  UVParameter Provenance
provenance ColumnValue ('Postgres pgKind)
colVal -> do
    [Text]
varJsonPath <- case Provenance
provenance of
      FromGraphQL VariableInfo
varInfo -> do
        let varName :: Name
varName = VariableInfo -> Name
forall a. HasName a => a -> Name
getName VariableInfo
varInfo
        ASetter
  (QueryParametersInfo ('Postgres pgKind))
  (QueryParametersInfo ('Postgres pgKind))
  (HashMap Name (ColumnValue ('Postgres pgKind)))
  (HashMap Name (ColumnValue ('Postgres pgKind)))
-> (HashMap Name (ColumnValue ('Postgres pgKind))
    -> HashMap Name (ColumnValue ('Postgres pgKind)))
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter
  (QueryParametersInfo ('Postgres pgKind))
  (QueryParametersInfo ('Postgres pgKind))
  (HashMap Name (ColumnValue ('Postgres pgKind)))
  (HashMap Name (ColumnValue ('Postgres pgKind)))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(HashMap Name (ColumnValue b) -> f (HashMap Name (ColumnValue b)))
-> QueryParametersInfo b -> f (QueryParametersInfo b)
qpiReusableVariableValues ((HashMap Name (ColumnValue ('Postgres pgKind))
  -> HashMap Name (ColumnValue ('Postgres pgKind)))
 -> m ())
-> (HashMap Name (ColumnValue ('Postgres pgKind))
    -> HashMap Name (ColumnValue ('Postgres pgKind)))
-> m ()
forall a b. (a -> b) -> a -> b
$ Name
-> ColumnValue ('Postgres pgKind)
-> HashMap Name (ColumnValue ('Postgres pgKind))
-> HashMap Name (ColumnValue ('Postgres pgKind))
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
varName ColumnValue ('Postgres pgKind)
colVal
        [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"query", Name -> Text
G.unName Name
varName]
      Provenance
_ -> do
        Int
syntheticVarIndex <- Getting Int (QueryParametersInfo ('Postgres pgKind)) Int -> m Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Seq (ColumnValue ('Postgres pgKind))
 -> Const Int (Seq (ColumnValue ('Postgres pgKind))))
-> QueryParametersInfo ('Postgres pgKind)
-> Const Int (QueryParametersInfo ('Postgres pgKind))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Seq (ColumnValue b) -> f (Seq (ColumnValue b)))
-> QueryParametersInfo b -> f (QueryParametersInfo b)
qpiSyntheticVariableValues ((Seq (ColumnValue ('Postgres pgKind))
  -> Const Int (Seq (ColumnValue ('Postgres pgKind))))
 -> QueryParametersInfo ('Postgres pgKind)
 -> Const Int (QueryParametersInfo ('Postgres pgKind)))
-> ((Int -> Const Int Int)
    -> Seq (ColumnValue ('Postgres pgKind))
    -> Const Int (Seq (ColumnValue ('Postgres pgKind))))
-> Getting Int (QueryParametersInfo ('Postgres pgKind)) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq (ColumnValue ('Postgres pgKind)) -> Int)
-> (Int -> Const Int Int)
-> Seq (ColumnValue ('Postgres pgKind))
-> Const Int (Seq (ColumnValue ('Postgres pgKind)))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Seq (ColumnValue ('Postgres pgKind)) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
        ASetter
  (QueryParametersInfo ('Postgres pgKind))
  (QueryParametersInfo ('Postgres pgKind))
  (Seq (ColumnValue ('Postgres pgKind)))
  (Seq (ColumnValue ('Postgres pgKind)))
-> (Seq (ColumnValue ('Postgres pgKind))
    -> Seq (ColumnValue ('Postgres pgKind)))
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter
  (QueryParametersInfo ('Postgres pgKind))
  (QueryParametersInfo ('Postgres pgKind))
  (Seq (ColumnValue ('Postgres pgKind)))
  (Seq (ColumnValue ('Postgres pgKind)))
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Seq (ColumnValue b) -> f (Seq (ColumnValue b)))
-> QueryParametersInfo b -> f (QueryParametersInfo b)
qpiSyntheticVariableValues (Seq (ColumnValue ('Postgres pgKind))
-> ColumnValue ('Postgres pgKind)
-> Seq (ColumnValue ('Postgres pgKind))
forall s a. Snoc s s a a => s -> a -> s
|> ColumnValue ('Postgres pgKind)
colVal)
        [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"synthetic", Int -> Text
forall a. Show a => a -> Text
tshow Int
syntheticVarIndex]
    SQLExp -> m SQLExp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SQLExp -> m SQLExp) -> SQLExp -> m SQLExp
forall a b. (a -> b) -> a -> b
$ CollectableType PGScalarType -> [Text] -> SQLExp
fromResVars (PGScalarType -> CollectableType PGScalarType
forall a. a -> CollectableType a
CollectableTypeScalar (PGScalarType -> CollectableType PGScalarType)
-> PGScalarType -> CollectableType PGScalarType
forall a b. (a -> b) -> a -> b
$ ColumnType ('Postgres pgKind) -> PGScalarType
forall (pgKind :: PostgresKind).
ColumnType ('Postgres pgKind) -> PGScalarType
unsafePGColumnToBackend (ColumnType ('Postgres pgKind) -> PGScalarType)
-> ColumnType ('Postgres pgKind) -> PGScalarType
forall a b. (a -> b) -> a -> b
$ ColumnValue ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ColumnValue b -> ColumnType b
cvType ColumnValue ('Postgres pgKind)
colVal) [Text]
varJsonPath
  UVSessionVar SessionVarType ('Postgres pgKind)
ty SessionVariable
sessVar -> do
    Text
_ <-
      SessionVariable -> SessionVariables -> Maybe Text
getSessionVariableValue SessionVariable
sessVar SessionVariables
allSessionVars
        Maybe Text -> m Text -> m Text
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m Text
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
          Code
NotFound
          (Text
"missing session variable: " Text -> Text -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SessionVariable -> Text
sessionVariableToText SessionVariable
sessVar)
    ASetter
  (QueryParametersInfo ('Postgres pgKind))
  (QueryParametersInfo ('Postgres pgKind))
  (HashSet SessionVariable)
  (HashSet SessionVariable)
-> (HashSet SessionVariable -> HashSet SessionVariable) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter
  (QueryParametersInfo ('Postgres pgKind))
  (QueryParametersInfo ('Postgres pgKind))
  (HashSet SessionVariable)
  (HashSet SessionVariable)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(HashSet SessionVariable -> f (HashSet SessionVariable))
-> QueryParametersInfo b -> f (QueryParametersInfo b)
qpiReferencedSessionVariables (SessionVariable
-> HashSet SessionVariable -> HashSet SessionVariable
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert SessionVariable
sessVar)
    SQLExp -> m SQLExp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SQLExp -> m SQLExp) -> SQLExp -> m SQLExp
forall a b. (a -> b) -> a -> b
$ CollectableType PGScalarType -> [Text] -> SQLExp
fromResVars SessionVarType ('Postgres pgKind)
CollectableType PGScalarType
ty [Text
"session", SessionVariable -> Text
sessionVariableToText SessionVariable
sessVar]
  UVLiteral SQLExpression ('Postgres pgKind)
sqlExp -> SQLExp -> m SQLExp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SQLExpression ('Postgres pgKind)
SQLExp
sqlExp
  UnpreparedValue ('Postgres pgKind)
UVSession -> do
    -- if the entire session is referenced, then add all session vars in referenced vars
    ASetter
  (QueryParametersInfo ('Postgres pgKind))
  (QueryParametersInfo ('Postgres pgKind))
  (HashSet SessionVariable)
  (HashSet SessionVariable)
-> (HashSet SessionVariable -> HashSet SessionVariable) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter
  (QueryParametersInfo ('Postgres pgKind))
  (QueryParametersInfo ('Postgres pgKind))
  (HashSet SessionVariable)
  (HashSet SessionVariable)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(HashSet SessionVariable -> f (HashSet SessionVariable))
-> QueryParametersInfo b -> f (QueryParametersInfo b)
qpiReferencedSessionVariables (HashSet SessionVariable
-> HashSet SessionVariable -> HashSet SessionVariable
forall a b. a -> b -> a
const (HashSet SessionVariable
 -> HashSet SessionVariable -> HashSet SessionVariable)
-> HashSet SessionVariable
-> HashSet SessionVariable
-> HashSet SessionVariable
forall a b. (a -> b) -> a -> b
$ SessionVariables -> HashSet SessionVariable
getSessionVariablesSet SessionVariables
allSessionVars)
    SQLExp -> m SQLExp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SQLExp -> m SQLExp) -> SQLExp -> m SQLExp
forall a b. (a -> b) -> a -> b
$ CollectableType PGScalarType -> [Text] -> SQLExp
fromResVars (PGScalarType -> CollectableType PGScalarType
forall a. a -> CollectableType a
CollectableTypeScalar PGScalarType
PGJSON) [Text
"session"]
  where
    fromResVars :: CollectableType PGScalarType -> [Text] -> SQLExp
fromResVars CollectableType PGScalarType
pgType [Text]
jPath =
      CollectableType PGScalarType -> SQLExp -> SQLExp
addTypeAnnotation CollectableType PGScalarType
pgType
        (SQLExp -> SQLExp) -> SQLExp -> SQLExp
forall a b. (a -> b) -> a -> b
$ SQLOp -> [SQLExp] -> SQLExp
S.SEOpApp
          (Text -> SQLOp
S.SQLOp Text
"#>>")
          [ QIdentifier -> SQLExp
S.SEQIdentifier (QIdentifier -> SQLExp) -> QIdentifier -> SQLExp
forall a b. (a -> b) -> a -> b
$ Qual -> Identifier -> QIdentifier
S.QIdentifier (TableIdentifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier TableIdentifier
subsIdentifier Maybe TypeAnn
forall a. Maybe a
Nothing) (Text -> Identifier
Identifier Text
"result_vars"),
            [SQLExp] -> SQLExp
S.SEArray ([SQLExp] -> SQLExp) -> [SQLExp] -> SQLExp
forall a b. (a -> b) -> a -> b
$ (Text -> SQLExp) -> [Text] -> [SQLExp]
forall a b. (a -> b) -> [a] -> [b]
map Text -> SQLExp
S.SELit [Text]
jPath
          ]
    addTypeAnnotation :: CollectableType PGScalarType -> SQLExp -> SQLExp
addTypeAnnotation CollectableType PGScalarType
pgType =
      (SQLExp -> TypeAnn -> SQLExp) -> TypeAnn -> SQLExp -> SQLExp
forall a b c. (a -> b -> c) -> b -> a -> c
flip SQLExp -> TypeAnn -> SQLExp
S.SETyAnn (CollectableType PGScalarType -> TypeAnn
S.mkTypeAnn CollectableType PGScalarType
pgType) (SQLExp -> SQLExp) -> (SQLExp -> SQLExp) -> SQLExp -> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case CollectableType PGScalarType
pgType of
        CollectableTypeScalar PGScalarType
scalarType -> PGScalarType -> SQLExp -> SQLExp
withConstructorFn PGScalarType
scalarType
        CollectableTypeArray PGScalarType
_ -> SQLExp -> SQLExp
forall a. a -> a
id

----------------------------------------------------------------------------------------------------
-- Execution

executeMultiplexedQuery ::
  (MonadTx m) =>
  MultiplexedQuery ->
  [(CohortId, CohortVariables)] ->
  m [(CohortId, B.ByteString)]
executeMultiplexedQuery :: forall (m :: * -> *).
MonadTx m =>
MultiplexedQuery
-> [(CohortId, CohortVariables)] -> m [(CohortId, ByteString)]
executeMultiplexedQuery (MultiplexedQuery Query
query) [(CohortId, CohortVariables)]
cohorts =
  Query
-> [(CohortId, CohortVariables)] -> m [(CohortId, ByteString)]
forall (m :: * -> *) a.
(MonadTx m, FromRes a) =>
Query -> [(CohortId, CohortVariables)] -> m a
executeQuery Query
query [(CohortId, CohortVariables)]
cohorts

executeStreamingMultiplexedQuery ::
  (MonadTx m) =>
  MultiplexedQuery ->
  [(CohortId, CohortVariables)] ->
  m [(CohortId, B.ByteString, PG.ViaJSON CursorVariableValues)]
executeStreamingMultiplexedQuery :: forall (m :: * -> *).
MonadTx m =>
MultiplexedQuery
-> [(CohortId, CohortVariables)]
-> m [(CohortId, ByteString, ViaJSON CursorVariableValues)]
executeStreamingMultiplexedQuery (MultiplexedQuery Query
query) [(CohortId, CohortVariables)]
cohorts = do
  Query
-> [(CohortId, CohortVariables)]
-> m [(CohortId, ByteString, ViaJSON CursorVariableValues)]
forall (m :: * -> *) a.
(MonadTx m, FromRes a) =>
Query -> [(CohortId, CohortVariables)] -> m a
executeQuery Query
query [(CohortId, CohortVariables)]
cohorts

-- | Internal; used by both 'executeMultiplexedQuery', 'executeStreamingMultiplexedQuery'
-- and 'pgDBSubscriptionExplain'.
executeQuery ::
  (MonadTx m, PG.FromRes a) =>
  PG.Query ->
  [(CohortId, CohortVariables)] ->
  m a
executeQuery :: forall (m :: * -> *) a.
(MonadTx m, FromRes a) =>
Query -> [(CohortId, CohortVariables)] -> m a
executeQuery Query
query [(CohortId, CohortVariables)]
cohorts =
  let ([CohortId]
cohortIds, [CohortVariables]
cohortVars) = [(CohortId, CohortVariables)] -> ([CohortId], [CohortVariables])
forall a b. [(a, b)] -> ([a], [b])
unzip [(CohortId, CohortVariables)]
cohorts
      preparedArgs :: (CohortIdArray, CohortVariablesArray)
preparedArgs = ([CohortId] -> CohortIdArray
CohortIdArray [CohortId]
cohortIds, [CohortVariables] -> CohortVariablesArray
CohortVariablesArray [CohortVariables]
cohortVars)
   in TxE QErr a -> m a
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr a -> m a) -> TxE QErr a -> m a
forall a b. (a -> b) -> a -> b
$ (PGTxErr -> QErr)
-> Query
-> (CohortIdArray, CohortVariablesArray)
-> Bool
-> TxE QErr a
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
PG.withQE PGTxErr -> QErr
defaultTxErrorHandler Query
query (CohortIdArray, CohortVariablesArray)
preparedArgs Bool
True