{-# 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,
    validateVariables,
    executeMultiplexedQuery,
    executeStreamingMultiplexedQuery,
    executeQuery,
    SubscriptionType (..),
  )
where

import Control.Lens
import Data.ByteString qualified as B
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashSet qualified as Set
import Data.Semigroup.Generic
import Data.Text.Extended
import Database.PG.Query qualified as Q
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.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.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Subscription
import Hasura.SQL.Backend
import Hasura.SQL.Types
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G

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

-- | 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
  { QueryParametersInfo b -> HashMap Name (ColumnValue b)
_qpiReusableVariableValues :: HashMap G.Name (ColumnValue b),
    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
    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
$cto :: forall (b :: BackendType) x.
Rep (QueryParametersInfo b) x -> QueryParametersInfo b
$cfrom :: forall (b :: BackendType) x.
QueryParametersInfo b -> Rep (QueryParametersInfo b) x
Generic)
  deriving (b -> QueryParametersInfo b -> QueryParametersInfo b
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
stimes :: b -> QueryParametersInfo b -> QueryParametersInfo b
$cstimes :: forall (b :: BackendType) b.
Integral b =>
b -> QueryParametersInfo b -> QueryParametersInfo b
sconcat :: NonEmpty (QueryParametersInfo b) -> QueryParametersInfo b
$csconcat :: forall (b :: BackendType).
NonEmpty (QueryParametersInfo b) -> QueryParametersInfo b
<> :: QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
$c<> :: forall (b :: BackendType).
QueryParametersInfo 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
mconcat :: [QueryParametersInfo b] -> QueryParametersInfo b
$cmconcat :: forall (b :: BackendType).
[QueryParametersInfo b] -> QueryParametersInfo b
mappend :: QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
$cmappend :: forall (b :: BackendType).
QueryParametersInfo b
-> QueryParametersInfo b -> QueryParametersInfo b
mempty :: QueryParametersInfo b
$cmempty :: forall (b :: BackendType). QueryParametersInfo b
$cp1Monoid :: forall (b :: BackendType). Semigroup (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 ..."
validateVariables ::
  forall pgKind f m.
  (Traversable f, MonadError QErr m, MonadIO m) =>
  PGExecCtx ->
  f (ColumnValue ('Postgres pgKind)) ->
  m (ValidatedVariables f)
validateVariables :: PGExecCtx
-> f (ColumnValue ('Postgres pgKind)) -> m (ValidatedVariables f)
validateVariables PGExecCtx
pgExecCtx 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 (t :: * -> *) a. Foldable t => t a -> [a]
toList f (ColumnValue ('Postgres pgKind))
variableValues
  Q.Discard () <-
    TxET QErr IO Discard -> m Discard
runQueryTx_ (TxET QErr IO Discard -> m Discard)
-> TxET QErr IO Discard -> m Discard
forall a b. (a -> b) -> a -> b
$
      TxET QErr IO Discard -> TxET QErr IO Discard
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxET QErr IO Discard -> TxET QErr IO Discard)
-> TxET QErr IO Discard -> TxET QErr IO Discard
forall a b. (a -> b) -> a -> b
$
        (PGTxErr -> QErr)
-> Query -> [PrepArg] -> Bool -> TxET QErr IO Discard
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> [PrepArg] -> Bool -> TxET e m a
Q.rawQE PGTxErr -> QErr
dataExnErrHandler (Builder -> Query
Q.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
  ValidatedVariables f -> m (ValidatedVariables f)
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 (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) -> 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}
    runQueryTx_ :: TxET QErr IO Discard -> m Discard
runQueryTx_ TxET QErr IO Discard
tx = do
      Either QErr Discard
res <- IO (Either QErr Discard) -> m (Either QErr Discard)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QErr Discard) -> m (Either QErr Discard))
-> IO (Either QErr Discard) -> m (Either QErr Discard)
forall a b. (a -> b) -> a -> b
$ ExceptT QErr IO Discard -> IO (Either QErr Discard)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (PGExecCtx -> TxET QErr IO Discard -> ExceptT QErr IO Discard
forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m) =>
PGExecCtx -> TxET QErr IO a -> m a
runQueryTx PGExecCtx
pgExecCtx TxET QErr IO Discard
tx)
      Either QErr Discard -> m Discard
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither Either QErr Discard
res

    -- 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 :: Q.Query}
  deriving (MultiplexedQuery -> MultiplexedQuery -> Bool
(MultiplexedQuery -> MultiplexedQuery -> Bool)
-> (MultiplexedQuery -> MultiplexedQuery -> Bool)
-> Eq MultiplexedQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiplexedQuery -> MultiplexedQuery -> Bool
$c/= :: MultiplexedQuery -> MultiplexedQuery -> Bool
== :: MultiplexedQuery -> MultiplexedQuery -> Bool
$c== :: MultiplexedQuery -> MultiplexedQuery -> Bool
Eq, Int -> MultiplexedQuery -> Int
MultiplexedQuery -> Int
(Int -> MultiplexedQuery -> Int)
-> (MultiplexedQuery -> Int) -> Hashable MultiplexedQuery
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MultiplexedQuery -> Int
$chash :: MultiplexedQuery -> Int
hashWithSalt :: Int -> MultiplexedQuery -> Int
$chashWithSalt :: Int -> MultiplexedQuery -> Int
Hashable)

instance ToTxt MultiplexedQuery where
  toTxt :: MultiplexedQuery -> Text
toTxt = Query -> Text
Q.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
  ) =>
  S.TableAlias ->
  QueryDB ('Postgres pgKind) Void S.SQLExp ->
  S.FromItem
toSQLFromItem :: TableAlias -> QueryDB ('Postgres pgKind) Void SQLExp -> FromItem
toSQLFromItem = (QueryDB ('Postgres pgKind) Void SQLExp -> TableAlias -> FromItem)
-> TableAlias -> QueryDB ('Postgres pgKind) Void SQLExp -> FromItem
forall a b c. (a -> b -> c) -> b -> a -> c
flip \case
  QDBSingleRow AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s -> Select -> TableAlias -> FromItem
S.mkSelFromItem (Select -> TableAlias -> FromItem)
-> Select -> TableAlias -> FromItem
forall a b. (a -> b) -> a -> b
$ JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Select
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Select
DS.mkSQLSelect JsonAggSelect
JASSingleObject AnnSimpleSelect ('Postgres pgKind)
AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s
  QDBMultipleRows AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s -> Select -> TableAlias -> FromItem
S.mkSelFromItem (Select -> TableAlias -> FromItem)
-> Select -> TableAlias -> FromItem
forall a b. (a -> b) -> a -> b
$ JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Select
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
JsonAggSelect -> AnnSimpleSelect ('Postgres pgKind) -> Select
DS.mkSQLSelect JsonAggSelect
JASMultipleRows AnnSimpleSelect ('Postgres pgKind)
AnnSimpleSelectG ('Postgres pgKind) Void SQLExp
s
  QDBAggregation AnnAggregateSelectG ('Postgres pgKind) Void SQLExp
s -> Select -> TableAlias -> FromItem
S.mkSelFromItem (Select -> TableAlias -> FromItem)
-> Select -> TableAlias -> FromItem
forall a b. (a -> b) -> a -> b
$ AnnAggregateSelect ('Postgres pgKind) -> Select
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
AnnAggregateSelect ('Postgres pgKind) -> Select
DS.mkAggregateSelect AnnAggregateSelect ('Postgres pgKind)
AnnAggregateSelectG ('Postgres pgKind) Void SQLExp
s
  QDBConnection ConnectionSelect ('Postgres pgKind) Void SQLExp
s -> SelectWithG Select -> TableAlias -> FromItem
S.mkSelectWithFromItem (SelectWithG Select -> TableAlias -> FromItem)
-> SelectWithG Select -> TableAlias -> FromItem
forall a b. (a -> b) -> a -> b
$ ConnectionSelect ('Postgres pgKind) Void SQLExp
-> SelectWithG Select
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
ConnectionSelect ('Postgres pgKind) Void SQLExp
-> SelectWithG Select
DS.mkConnectionSelect ConnectionSelect ('Postgres pgKind) Void SQLExp
s
  QDBStreamMultipleRows AnnSimpleStreamSelectG ('Postgres pgKind) Void SQLExp
s -> Select -> TableAlias -> FromItem
S.mkSelFromItem (Select -> TableAlias -> FromItem)
-> Select -> TableAlias -> FromItem
forall a b. (a -> b) -> a -> b
$ AnnSimpleStreamSelect ('Postgres pgKind) -> Select
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
AnnSimpleStreamSelect ('Postgres pgKind) -> Select
DS.mkStreamSQLSelect AnnSimpleStreamSelect ('Postgres pgKind)
AnnSimpleStreamSelectG ('Postgres pgKind) Void SQLExp
s

mkMultiplexedQuery ::
  ( Backend ('Postgres pgKind),
    DS.PostgresAnnotatedFieldJSON pgKind
  ) =>
  OMap.InsOrdHashMap G.Name (QueryDB ('Postgres pgKind) Void S.SQLExp) ->
  MultiplexedQuery
mkMultiplexedQuery :: InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
-> MultiplexedQuery
mkMultiplexedQuery InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
rootFields =
  Query -> MultiplexedQuery
MultiplexedQuery (Query -> MultiplexedQuery)
-> (Select -> Query) -> Select -> MultiplexedQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Query
Q.fromBuilder (Builder -> Query) -> (Select -> Builder) -> Select -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select -> Builder
forall a. ToSQL a => a -> Builder
toSQL (Select -> MultiplexedQuery) -> Select -> MultiplexedQuery
forall a b. (a -> b) -> a -> b
$
    Select
S.mkSelect
      { selExtr :: [Extractor]
S.selExtr =
          -- SELECT _subs.result_id, _fld_resp.root AS result
          [ SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (Identifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Text -> Identifier
Identifier Text
"_subs") (Text -> Identifier
Identifier Text
"result_id")) Maybe ColumnAlias
forall a. Maybe a
Nothing,
            SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (Identifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Text -> Identifier
Identifier Text
"_fld_resp") (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)
              ]
      }
  where
    -- 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[]"]
        (Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias (Identifier -> TableAlias) -> Identifier -> TableAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"_subs")
        [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"]

    -- LEFT OUTER JOIN LATERAL ( ... ) _fld_resp
    responseLateralFromItem :: FromItem
responseLateralFromItem = Select -> TableAlias -> FromItem
S.mkLateralFromItem Select
selectRootFields (Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias (Identifier -> TableAlias) -> Identifier -> TableAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"_fld_resp")
    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")],
          selFrom :: Maybe FromExp
S.selFrom =
            FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just (FromExp -> Maybe FromExp)
-> ([FromItem] -> FromExp) -> [FromItem] -> Maybe FromExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FromItem] -> FromExp
S.FromExp ([FromItem] -> Maybe FromExp) -> [FromItem] -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$
              InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
-> [(Name, QueryDB ('Postgres pgKind) Void SQLExp)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList InsOrdHashMap Name (QueryDB ('Postgres pgKind) Void SQLExp)
rootFields [(Name, QueryDB ('Postgres pgKind) Void SQLExp)]
-> ((Name, QueryDB ('Postgres pgKind) Void SQLExp) -> FromItem)
-> [FromItem]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
fieldAlias, QueryDB ('Postgres pgKind) Void SQLExp
resolvedAST) ->
                TableAlias -> QueryDB ('Postgres pgKind) Void SQLExp -> FromItem
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
TableAlias -> QueryDB ('Postgres pgKind) Void SQLExp -> FromItem
toSQLFromItem (Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias (Identifier -> TableAlias) -> Identifier -> TableAlias
forall a b. (a -> b) -> a -> b
$ Name -> Identifier
aliasToIdentifier Name
fieldAlias) QueryDB ('Postgres pgKind) Void SQLExp
resolvedAST
        }

    -- 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]
OMap.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),
        Identifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Name -> Identifier
aliasToIdentifier Name
fieldAlias) (Text -> Identifier
Identifier Text
"root")
      ]

    mkQualifiedIdentifier :: Identifier -> Identifier -> SQLExp
mkQualifiedIdentifier Identifier
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 (Identifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier Identifier
prefix Maybe TypeAnn
forall a. Maybe a
Nothing)
    aliasToIdentifier :: Name -> Identifier
aliasToIdentifier = Text -> Identifier
Identifier (Text -> Identifier) -> (Name -> Text) -> Name -> Identifier
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 :: (Name, QueryDB ('Postgres pgKind) Void SQLExp) -> MultiplexedQuery
mkStreamingMultiplexedQuery (Name
fieldAlias, QueryDB ('Postgres pgKind) Void SQLExp
resolvedAST) =
  Query -> MultiplexedQuery
MultiplexedQuery (Query -> MultiplexedQuery)
-> (Select -> Query) -> Select -> MultiplexedQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Query
Q.fromBuilder (Builder -> Query) -> (Select -> Builder) -> Select -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select -> Builder
forall a. ToSQL a => a -> Builder
toSQL (Select -> MultiplexedQuery) -> Select -> MultiplexedQuery
forall a b. (a -> b) -> a -> b
$
    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 (Identifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Text -> Identifier
Identifier Text
"_subs") (Text -> Identifier
Identifier Text
"result_id")) Maybe ColumnAlias
forall a. Maybe a
Nothing,
            SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (Identifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Text -> Identifier
Identifier Text
"_fld_resp") (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 (Identifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Text -> Identifier
Identifier Text
"_fld_resp") (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)
              ]
      }
  where
    -- 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[]"]
        (Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias (Identifier -> TableAlias) -> Identifier -> TableAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"_subs")
        [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"]

    -- LEFT OUTER JOIN LATERAL ( ... ) _fld_resp
    responseLateralFromItem :: FromItem
responseLateralFromItem = Select -> TableAlias -> FromItem
S.mkLateralFromItem Select
selectRootFields (Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias (Identifier -> TableAlias) -> Identifier -> TableAlias
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
"_fld_resp")
    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],
          selFrom :: Maybe FromExp
S.selFrom =
            FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just (FromExp -> Maybe FromExp)
-> ([FromItem] -> FromExp) -> [FromItem] -> Maybe FromExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FromItem] -> FromExp
S.FromExp ([FromItem] -> Maybe FromExp) -> [FromItem] -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$
              FromItem -> [FromItem]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FromItem -> [FromItem]) -> FromItem -> [FromItem]
forall a b. (a -> b) -> a -> b
$ TableAlias -> QueryDB ('Postgres pgKind) Void SQLExp -> FromItem
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
TableAlias -> QueryDB ('Postgres pgKind) Void SQLExp -> FromItem
toSQLFromItem (Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias (Identifier -> TableAlias) -> Identifier -> TableAlias
forall a b. (a -> b) -> a -> b
$ Name -> Identifier
aliasToIdentifier Name
fieldAlias) QueryDB ('Postgres pgKind) Void SQLExp
resolvedAST
        }

    -- 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),
        Identifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Name -> Identifier
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" [Identifier -> Identifier -> SQLExp
mkQualifiedIdentifier (Name -> Identifier
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 :: Identifier -> Identifier -> SQLExp
mkQualifiedIdentifier Identifier
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 (Identifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier Identifier
prefix Maybe TypeAnn
forall a. Maybe a
Nothing)
    aliasToIdentifier :: Name -> Identifier
aliasToIdentifier = Text -> Identifier
Identifier (Text -> Identifier) -> (Name -> Text) -> Name -> Identifier
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 :: SessionVariables -> UnpreparedValue ('Postgres pgKind) -> m SQLExp
resolveMultiplexedValue SessionVariables
allSessionVars = \case
  UVParameter Maybe VariableInfo
varM ColumnValue ('Postgres pgKind)
colVal -> do
    [Text]
varJsonPath <- case (VariableInfo -> Name) -> Maybe VariableInfo -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VariableInfo -> Name
forall a. HasName a => a -> Name
getName Maybe VariableInfo
varM of
      Just Name
varName -> do
        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).
Lens' (QueryParametersInfo b) (HashMap Name (ColumnValue 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
Map.insert Name
varName ColumnValue ('Postgres pgKind)
colVal
        [Text] -> m [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"query", Name -> Text
G.unName Name
varName]
      Maybe Name
Nothing -> 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).
Lens' (QueryParametersInfo b) (Seq (ColumnValue 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 (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).
Lens' (QueryParametersInfo b) (Seq (ColumnValue 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 (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 (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).
Lens' (QueryParametersInfo b) (HashSet SessionVariable)
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 (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 (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).
Lens' (QueryParametersInfo b) (HashSet SessionVariable)
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 (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 (Identifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier (Text -> Identifier
Identifier Text
"_subs") 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 :: MultiplexedQuery
-> [(CohortId, CohortVariables)] -> m [(CohortId, ByteString)]
executeMultiplexedQuery (MultiplexedQuery Query
query) [(CohortId, CohortVariables)]
cohorts =
  Query
-> [(CohortId, CohortVariables)] -> m [(CohortId, ByteString)]
forall (m :: * -> *) a.
(MonadTx m, FromRow a) =>
Query -> [(CohortId, CohortVariables)] -> m [a]
executeQuery Query
query [(CohortId, CohortVariables)]
cohorts

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

-- | Internal; used by both 'executeMultiplexedQuery', 'executeStreamingMultiplexedQuery'
-- and 'pgDBSubscriptionExplain'.
executeQuery ::
  (MonadTx m, Q.FromRow a) =>
  Q.Query ->
  [(CohortId, CohortVariables)] ->
  m [a]
executeQuery :: 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 (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, FromRow a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m [a]
Q.listQE PGTxErr -> QErr
defaultTxErrorHandler Query
query (CohortIdArray, CohortVariablesArray)
preparedArgs Bool
True