module Hasura.GraphQL.Execute
  ( EB.ExecutionStep (..),
    ResolvedExecutionPlan (..),
    ET.GraphQLQueryType (..),
    getResolvedExecPlan,
    makeGQLContext,
    execRemoteGQ,
    SubscriptionExecution (..),
    buildSubscriptionPlan,
    ExecutionCtx (..),
    EC.MonadGQLExecutionCheck (..),
    checkQueryInAllowlist,
    MultiplexedSubscriptionQueryPlan (..),
    SubscriptionQueryPlan (..),
    SourceSubscription (..),
  )
where

import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson qualified as J
import Data.Containers.ListUtils (nubOrd)
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashSet qualified as HS
import Data.Tagged qualified as Tagged
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Context qualified as C
import Hasura.GraphQL.Execute.Action qualified as EA
import Hasura.GraphQL.Execute.Backend qualified as EB
import Hasura.GraphQL.Execute.Common qualified as EC
import Hasura.GraphQL.Execute.Mutation qualified as EM
import Hasura.GraphQL.Execute.Query qualified as EQ
import Hasura.GraphQL.Execute.RemoteJoin qualified as RJ
import Hasura.GraphQL.Execute.Resolve qualified as ER
import Hasura.GraphQL.Execute.Subscription.Plan qualified as ES
import Hasura.GraphQL.Execute.Types qualified as ET
import Hasura.GraphQL.Namespace
import Hasura.GraphQL.ParameterizedQueryHash
import Hasura.GraphQL.Parser.Directives
import Hasura.GraphQL.RemoteServer (execRemoteGQ)
import Hasura.GraphQL.Schema.Parser (runParse, toQErr)
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.Logging qualified as L
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Subscription
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.Server.Prometheus (PrometheusMetrics)
import Hasura.Server.Types (ReadOnlyMode (..), RequestId (..))
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Types qualified as HTTP

-- | Execution context
data ExecutionCtx = ExecutionCtx
  { ExecutionCtx -> Logger Hasura
_ecxLogger :: L.Logger L.Hasura,
    ExecutionCtx -> SQLGenCtx
_ecxSqlGenCtx :: SQLGenCtx,
    ExecutionCtx -> SchemaCache
_ecxSchemaCache :: SchemaCache,
    ExecutionCtx -> SchemaCacheVer
_ecxSchemaCacheVer :: SchemaCacheVer,
    ExecutionCtx -> Manager
_ecxHttpManager :: HTTP.Manager,
    ExecutionCtx -> Bool
_ecxEnableAllowList :: Bool,
    ExecutionCtx -> ReadOnlyMode
_ecxReadOnlyMode :: ReadOnlyMode,
    ExecutionCtx -> PrometheusMetrics
_ecxPrometheusMetrics :: PrometheusMetrics
  }

-- | Construct a single step of an execution plan.
makeGQLContext ::
  UserInfo ->
  SchemaCache ->
  ET.GraphQLQueryType ->
  C.GQLContext
makeGQLContext :: UserInfo -> SchemaCache -> GraphQLQueryType -> GQLContext
makeGQLContext UserInfo
userInfo SchemaCache
sc GraphQLQueryType
queryType =
  case RoleName
-> HashMap RoleName (RoleContext GQLContext)
-> Maybe (RoleContext GQLContext)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup RoleName
role HashMap RoleName (RoleContext GQLContext)
contextMap of
    Maybe (RoleContext GQLContext)
Nothing -> GQLContext
defaultContext
    Just (C.RoleContext GQLContext
frontend Maybe GQLContext
backend) ->
      case UserInfo -> BackendOnlyFieldAccess
_uiBackendOnlyFieldAccess UserInfo
userInfo of
        BackendOnlyFieldAccess
BOFAAllowed -> GQLContext -> Maybe GQLContext -> GQLContext
forall a. a -> Maybe a -> a
fromMaybe GQLContext
frontend Maybe GQLContext
backend
        BackendOnlyFieldAccess
BOFADisallowed -> GQLContext
frontend
  where
    role :: RoleName
role = UserInfo -> RoleName
_uiRole UserInfo
userInfo

    contextMap :: HashMap RoleName (RoleContext GQLContext)
contextMap =
      case GraphQLQueryType
queryType of
        GraphQLQueryType
ET.QueryHasura -> SchemaCache -> HashMap RoleName (RoleContext GQLContext)
scGQLContext SchemaCache
sc
        GraphQLQueryType
ET.QueryRelay -> SchemaCache -> HashMap RoleName (RoleContext GQLContext)
scRelayContext SchemaCache
sc

    defaultContext :: GQLContext
defaultContext =
      case GraphQLQueryType
queryType of
        GraphQLQueryType
ET.QueryHasura -> SchemaCache -> GQLContext
scUnauthenticatedGQLContext SchemaCache
sc
        GraphQLQueryType
ET.QueryRelay -> SchemaCache -> GQLContext
scUnauthenticatedRelayContext SchemaCache
sc

-- The graphql query is resolved into a sequence of execution operations
data ResolvedExecutionPlan
  = -- | query execution; remote schemas and introspection possible
    QueryExecutionPlan EB.ExecutionPlan [IR.QueryRootField IR.UnpreparedValue] DirectiveMap
  | -- | mutation execution; only __typename introspection supported
    MutationExecutionPlan EB.ExecutionPlan
  | -- | either action query or live query execution; remote schemas and introspection not supported
    SubscriptionExecutionPlan SubscriptionExecution

newtype MultiplexedSubscriptionQueryPlan (b :: BackendType)
  = MultiplexedSubscriptionQueryPlan (ES.SubscriptionQueryPlan b (EB.MultiplexedQuery b))

newtype SubscriptionQueryPlan = SubscriptionQueryPlan (AB.AnyBackend MultiplexedSubscriptionQueryPlan)

data SourceSubscription
  = SSLivequery !(HashSet ActionId) !(ActionLogResponseMap -> ExceptT QErr IO (SourceName, SubscriptionQueryPlan))
  | SSStreaming !RootFieldAlias !(SourceName, SubscriptionQueryPlan)

-- | The comprehensive subscription plan. We only support either
-- 1. Fields with only async action queries with no associated relationships
--    or
-- 2. Source database query fields from same source and also can be mixed with async
--    action query fields whose relationships are defined to tables in the source
data SubscriptionExecution
  = SEAsyncActionsWithNoRelationships !(RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
  | SEOnSourceDB !SourceSubscription

buildSubscriptionPlan ::
  forall m.
  (MonadError QErr m, EB.MonadQueryTags m, MonadIO m, MonadBaseControl IO m) =>
  UserInfo ->
  RootFieldMap (IR.QueryRootField IR.UnpreparedValue) ->
  ParameterizedQueryHash ->
  m SubscriptionExecution
buildSubscriptionPlan :: UserInfo
-> RootFieldMap (QueryRootField UnpreparedValue)
-> ParameterizedQueryHash
-> m SubscriptionExecution
buildSubscriptionPlan UserInfo
userInfo RootFieldMap (QueryRootField UnpreparedValue)
rootFields ParameterizedQueryHash
parameterizedQueryHash = do
  ((RootFieldMap
  (Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
liveQueryOnSourceFields, RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)
noRelationActionFields), RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
streamingFields) <- (((RootFieldMap
     (Either
        (ActionId,
         (PGSourceConfig,
          AsyncActionQuerySourceExecution
            (UnpreparedValue ('Postgres 'Vanilla))))
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
   RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
  RootFieldMap
    (SourceName,
     AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
 -> (RootFieldAlias, QueryRootField UnpreparedValue)
 -> m ((RootFieldMap
          (Either
             (ActionId,
              (PGSourceConfig,
               AsyncActionQuerySourceExecution
                 (UnpreparedValue ('Postgres 'Vanilla))))
             (SourceName,
              AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
        RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
       RootFieldMap
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))))
-> ((RootFieldMap
       (Either
          (ActionId,
           (PGSourceConfig,
            AsyncActionQuerySourceExecution
              (UnpreparedValue ('Postgres 'Vanilla))))
          (SourceName,
           AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
     RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
    RootFieldMap
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> [(RootFieldAlias, QueryRootField UnpreparedValue)]
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ((RootFieldMap
    (Either
       (ActionId,
        (PGSourceConfig,
         AsyncActionQuerySourceExecution
           (UnpreparedValue ('Postgres 'Vanilla))))
       (SourceName,
        AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
  RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
 RootFieldMap
   (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> (RootFieldAlias, QueryRootField UnpreparedValue)
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
go ((RootFieldMap
  (Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall a. Monoid a => a
mempty, RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)
forall a. Monoid a => a
mempty), RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
forall a. Monoid a => a
mempty) (RootFieldMap (QueryRootField UnpreparedValue)
-> [(RootFieldAlias, QueryRootField UnpreparedValue)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList RootFieldMap (QueryRootField UnpreparedValue)
rootFields)

  if
      | RootFieldMap
  (Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RootFieldMap
  (Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
liveQueryOnSourceFields Bool -> Bool -> Bool
&& RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
streamingFields ->
        SubscriptionExecution -> m SubscriptionExecution
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubscriptionExecution -> m SubscriptionExecution)
-> SubscriptionExecution -> m SubscriptionExecution
forall a b. (a -> b) -> a -> b
$ RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)
-> SubscriptionExecution
SEAsyncActionsWithNoRelationships RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)
noRelationActionFields
      | RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)
noRelationActionFields -> do
        if
            | RootFieldMap
  (Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RootFieldMap
  (Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
liveQueryOnSourceFields -> do
              case RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> [(RootFieldAlias,
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
streamingFields of
                [] -> Text -> m SubscriptionExecution
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"empty selset for subscription"
                [(RootFieldAlias
rootFieldName, (SourceName
sourceName, AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
exists))] -> do
                  SubscriptionQueryPlan
subscriptionPlan <- AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
-> (forall (b :: BackendType).
    BackendExecute b =>
    SourceConfigWith (QueryDBRoot Void UnpreparedValue) b
    -> m SubscriptionQueryPlan)
-> m SubscriptionQueryPlan
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @EB.BackendExecute
                    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
exists
                    \(IR.SourceConfigWith SourceConfig b
sourceConfig Maybe QueryTagsConfig
queryTagsConfig (IR.QDBR QueryDB b Void (UnpreparedValue b)
qdb) :: IR.SourceConfigWith db b) -> do
                      let subscriptionQueryTagsAttributes :: QueryTagsAttributes
subscriptionQueryTagsAttributes = QueryTags -> QueryTagsAttributes
encodeQueryTags (QueryTags -> QueryTagsAttributes)
-> QueryTags -> QueryTagsAttributes
forall a b. (a -> b) -> a -> b
$ LivequeryMetadata -> QueryTags
QTLiveQuery (LivequeryMetadata -> QueryTags) -> LivequeryMetadata -> QueryTags
forall a b. (a -> b) -> a -> b
$ RootFieldAlias -> ParameterizedQueryHash -> LivequeryMetadata
LivequeryMetadata RootFieldAlias
rootFieldName ParameterizedQueryHash
parameterizedQueryHash
                          queryTagsComment :: QueryTagsComment
queryTagsComment = Tagged m QueryTagsComment -> QueryTagsComment
forall k (s :: k) b. Tagged s b -> b
Tagged.untag (Tagged m QueryTagsComment -> QueryTagsComment)
-> Tagged m QueryTagsComment -> QueryTagsComment
forall a b. (a -> b) -> a -> b
$ QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged m QueryTagsComment
forall (m :: * -> *).
MonadQueryTags m =>
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged m QueryTagsComment
EB.createQueryTags @m QueryTagsAttributes
subscriptionQueryTagsAttributes Maybe QueryTagsConfig
queryTagsConfig
                      AnyBackend MultiplexedSubscriptionQueryPlan
-> SubscriptionQueryPlan
SubscriptionQueryPlan (AnyBackend MultiplexedSubscriptionQueryPlan
 -> SubscriptionQueryPlan)
-> (SubscriptionQueryPlan b (MultiplexedQuery b)
    -> AnyBackend MultiplexedSubscriptionQueryPlan)
-> SubscriptionQueryPlan b (MultiplexedQuery b)
-> SubscriptionQueryPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiplexedSubscriptionQueryPlan b
-> AnyBackend MultiplexedSubscriptionQueryPlan
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (MultiplexedSubscriptionQueryPlan b
 -> AnyBackend MultiplexedSubscriptionQueryPlan)
-> (SubscriptionQueryPlan b (MultiplexedQuery b)
    -> MultiplexedSubscriptionQueryPlan b)
-> SubscriptionQueryPlan b (MultiplexedQuery b)
-> AnyBackend MultiplexedSubscriptionQueryPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubscriptionQueryPlan b (MultiplexedQuery b)
-> MultiplexedSubscriptionQueryPlan b
forall (b :: BackendType).
SubscriptionQueryPlan b (MultiplexedQuery b)
-> MultiplexedSubscriptionQueryPlan b
MultiplexedSubscriptionQueryPlan
                        (SubscriptionQueryPlan b (MultiplexedQuery b)
 -> SubscriptionQueryPlan)
-> m (SubscriptionQueryPlan b (MultiplexedQuery b))
-> m SubscriptionQueryPlan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  QueryTagsComment m (SubscriptionQueryPlan b (MultiplexedQuery b))
-> QueryTagsComment
-> m (SubscriptionQueryPlan b (MultiplexedQuery b))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                          ( UserInfo
-> SourceName
-> SourceConfig b
-> (RootFieldAlias, QueryDB b Void (UnpreparedValue b))
-> ReaderT
     QueryTagsComment m (SubscriptionQueryPlan b (MultiplexedQuery b))
forall (b :: BackendType) (m :: * -> *).
(BackendExecute b, MonadError QErr m, MonadIO m,
 MonadBaseControl IO m, MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig b
-> (RootFieldAlias, QueryDB b Void (UnpreparedValue b))
-> m (SubscriptionQueryPlan b (MultiplexedQuery b))
EB.mkDBStreamingSubscriptionPlan
                              UserInfo
userInfo
                              SourceName
sourceName
                              SourceConfig b
sourceConfig
                              (RootFieldAlias
rootFieldName, QueryDB b Void (UnpreparedValue b)
qdb)
                          )
                          QueryTagsComment
queryTagsComment
                  SubscriptionExecution -> m SubscriptionExecution
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubscriptionExecution -> m SubscriptionExecution)
-> SubscriptionExecution -> m SubscriptionExecution
forall a b. (a -> b) -> a -> b
$
                    SourceSubscription -> SubscriptionExecution
SEOnSourceDB (SourceSubscription -> SubscriptionExecution)
-> SourceSubscription -> SubscriptionExecution
forall a b. (a -> b) -> a -> b
$
                      RootFieldAlias
-> (SourceName, SubscriptionQueryPlan) -> SourceSubscription
SSStreaming RootFieldAlias
rootFieldName ((SourceName, SubscriptionQueryPlan) -> SourceSubscription)
-> (SourceName, SubscriptionQueryPlan) -> SourceSubscription
forall a b. (a -> b) -> a -> b
$ (SourceName
sourceName, SubscriptionQueryPlan
subscriptionPlan)
                [(RootFieldAlias,
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))]
_ -> Code -> Text -> m SubscriptionExecution
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"exactly one root field is allowed for streaming subscriptions"
            | RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
streamingFields -> do
              let allActionIds :: HashSet ActionId
allActionIds = [ActionId] -> HashSet ActionId
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([ActionId] -> HashSet ActionId) -> [ActionId] -> HashSet ActionId
forall a b. (a -> b) -> a -> b
$ ((ActionId,
  (PGSourceConfig,
   AsyncActionQuerySourceExecution
     (UnpreparedValue ('Postgres 'Vanilla))))
 -> ActionId)
-> [(ActionId,
     (PGSourceConfig,
      AsyncActionQuerySourceExecution
        (UnpreparedValue ('Postgres 'Vanilla))))]
-> [ActionId]
forall a b. (a -> b) -> [a] -> [b]
map (ActionId,
 (PGSourceConfig,
  AsyncActionQuerySourceExecution
    (UnpreparedValue ('Postgres 'Vanilla))))
-> ActionId
forall a b. (a, b) -> a
fst ([(ActionId,
   (PGSourceConfig,
    AsyncActionQuerySourceExecution
      (UnpreparedValue ('Postgres 'Vanilla))))]
 -> [ActionId])
-> [(ActionId,
     (PGSourceConfig,
      AsyncActionQuerySourceExecution
        (UnpreparedValue ('Postgres 'Vanilla))))]
-> [ActionId]
forall a b. (a -> b) -> a -> b
$ [Either
   (ActionId,
    (PGSourceConfig,
     AsyncActionQuerySourceExecution
       (UnpreparedValue ('Postgres 'Vanilla))))
   (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))]
-> [(ActionId,
     (PGSourceConfig,
      AsyncActionQuerySourceExecution
        (UnpreparedValue ('Postgres 'Vanilla))))]
forall a b. [Either a b] -> [a]
lefts ([Either
    (ActionId,
     (PGSourceConfig,
      AsyncActionQuerySourceExecution
        (UnpreparedValue ('Postgres 'Vanilla))))
    (SourceName,
     AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))]
 -> [(ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))])
-> [Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))]
-> [(ActionId,
     (PGSourceConfig,
      AsyncActionQuerySourceExecution
        (UnpreparedValue ('Postgres 'Vanilla))))]
forall a b. (a -> b) -> a -> b
$ RootFieldMap
  (Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> [Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RootFieldMap
  (Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
liveQueryOnSourceFields
              SubscriptionExecution -> m SubscriptionExecution
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubscriptionExecution -> m SubscriptionExecution)
-> SubscriptionExecution -> m SubscriptionExecution
forall a b. (a -> b) -> a -> b
$
                SourceSubscription -> SubscriptionExecution
SEOnSourceDB (SourceSubscription -> SubscriptionExecution)
-> SourceSubscription -> SubscriptionExecution
forall a b. (a -> b) -> a -> b
$
                  HashSet ActionId
-> (ActionLogResponseMap
    -> ExceptT QErr IO (SourceName, SubscriptionQueryPlan))
-> SourceSubscription
SSLivequery HashSet ActionId
allActionIds ((ActionLogResponseMap
  -> ExceptT QErr IO (SourceName, SubscriptionQueryPlan))
 -> SourceSubscription)
-> (ActionLogResponseMap
    -> ExceptT QErr IO (SourceName, SubscriptionQueryPlan))
-> SourceSubscription
forall a b. (a -> b) -> a -> b
$ \ActionLogResponseMap
actionLogMap -> do
                    RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
sourceSubFields <- RootFieldMap
  (Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> (Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
    -> ExceptT
         QErr
         IO
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> ExceptT
     QErr
     IO
     (RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for RootFieldMap
  (Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
liveQueryOnSourceFields ((Either
    (ActionId,
     (PGSourceConfig,
      AsyncActionQuerySourceExecution
        (UnpreparedValue ('Postgres 'Vanilla))))
    (SourceName,
     AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
  -> ExceptT
       QErr
       IO
       (SourceName,
        AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
 -> ExceptT
      QErr
      IO
      (RootFieldMap
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))))
-> (Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
    -> ExceptT
         QErr
         IO
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> ExceptT
     QErr
     IO
     (RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall a b. (a -> b) -> a -> b
$ \case
                      Right (SourceName,
 AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
x -> (SourceName,
 AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> ExceptT
     QErr
     IO
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceName,
 AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
x
                      Left (ActionId
actionId, (PGSourceConfig
srcConfig, AsyncActionQuerySourceExecution
  (UnpreparedValue ('Postgres 'Vanilla))
dbExecution)) -> do
                        let sourceName :: SourceName
sourceName = AsyncActionQuerySourceExecution
  (UnpreparedValue ('Postgres 'Vanilla))
-> SourceName
forall v. AsyncActionQuerySourceExecution v -> SourceName
EA._aaqseSource AsyncActionQuerySourceExecution
  (UnpreparedValue ('Postgres 'Vanilla))
dbExecution
                        ActionLogResponse
actionLogResponse <-
                          ActionId -> ActionLogResponseMap -> Maybe ActionLogResponse
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup ActionId
actionId ActionLogResponseMap
actionLogMap
                            Maybe ActionLogResponse
-> ExceptT QErr IO ActionLogResponse
-> ExceptT QErr IO ActionLogResponse
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> ExceptT QErr IO ActionLogResponse
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"unexpected: cannot lookup action_id in the map"
                        let selectAST :: AnnSimpleSelectG
  ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
selectAST = AsyncActionQuerySourceExecution
  (UnpreparedValue ('Postgres 'Vanilla))
-> ActionLogResponse
-> AnnSimpleSelectG
     ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
forall v.
AsyncActionQuerySourceExecution v
-> ActionLogResponse
-> AnnSimpleSelectG ('Postgres 'Vanilla) Void v
EA._aaqseSelectBuilder AsyncActionQuerySourceExecution
  (UnpreparedValue ('Postgres 'Vanilla))
dbExecution (ActionLogResponse
 -> AnnSimpleSelectG
      ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla)))
-> ActionLogResponse
-> AnnSimpleSelectG
     ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ ActionLogResponse
actionLogResponse
                            queryDB :: QueryDB
  ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
queryDB = case AsyncActionQuerySourceExecution
  (UnpreparedValue ('Postgres 'Vanilla))
-> JsonAggSelect
forall v. AsyncActionQuerySourceExecution v -> JsonAggSelect
EA._aaqseJsonAggSelect AsyncActionQuerySourceExecution
  (UnpreparedValue ('Postgres 'Vanilla))
dbExecution of
                              JsonAggSelect
JASMultipleRows -> AnnSimpleSelectG
  ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
-> QueryDB
     ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
IR.QDBMultipleRows AnnSimpleSelectG
  ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
selectAST
                              JsonAggSelect
JASSingleObject -> AnnSimpleSelectG
  ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
-> QueryDB
     ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
IR.QDBSingleRow AnnSimpleSelectG
  ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
selectAST
                        (SourceName,
 AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> ExceptT
     QErr
     IO
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SourceName,
  AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
 -> ExceptT
      QErr
      IO
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> ExceptT
     QErr
     IO
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
forall a b. (a -> b) -> a -> b
$ (SourceName
sourceName, SourceConfigWith
  (QueryDBRoot Void UnpreparedValue) ('Postgres 'Vanilla)
-> AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceConfigWith
   (QueryDBRoot Void UnpreparedValue) ('Postgres 'Vanilla)
 -> AnyBackend
      (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> SourceConfigWith
     (QueryDBRoot Void UnpreparedValue) ('Postgres 'Vanilla)
-> AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
forall a b. (a -> b) -> a -> b
$ SourceConfig ('Postgres 'Vanilla)
-> Maybe QueryTagsConfig
-> QueryDBRoot Void UnpreparedValue ('Postgres 'Vanilla)
-> SourceConfigWith
     (QueryDBRoot Void UnpreparedValue) ('Postgres 'Vanilla)
forall (db :: BackendType -> *) (b :: BackendType).
SourceConfig b
-> Maybe QueryTagsConfig -> db b -> SourceConfigWith db b
IR.SourceConfigWith PGSourceConfig
SourceConfig ('Postgres 'Vanilla)
srcConfig Maybe QueryTagsConfig
forall a. Maybe a
Nothing (QueryDB
  ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
-> QueryDBRoot Void UnpreparedValue ('Postgres 'Vanilla)
forall r (v :: BackendType -> *) (b :: BackendType).
QueryDB b r (v b) -> QueryDBRoot r v b
IR.QDBR QueryDB
  ('Postgres 'Vanilla) Void (UnpreparedValue ('Postgres 'Vanilla))
queryDB))

                    case RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> [(RootFieldAlias,
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
sourceSubFields of
                      [] -> Text -> ExceptT QErr IO (SourceName, SubscriptionQueryPlan)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"empty selset for subscription"
                      ((RootFieldAlias
rootFieldName, (SourceName,
 AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
sub) : [(RootFieldAlias,
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))]
_) -> (SourceName,
 AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> RootFieldMap
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> RootFieldAlias
-> ExceptT QErr IO (SourceName, SubscriptionQueryPlan)
forall (b :: BackendType -> *).
(SourceName, AnyBackend (SourceConfigWith b))
-> RootFieldMap
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> RootFieldAlias
-> ExceptT QErr IO (SourceName, SubscriptionQueryPlan)
buildAction (SourceName,
 AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
sub RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
sourceSubFields RootFieldAlias
rootFieldName
            | Bool
otherwise -> Code -> Text -> m SubscriptionExecution
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"streaming and livequery subscriptions cannot be executed in the same subscription"
      | Bool
otherwise ->
        Code -> Text -> m SubscriptionExecution
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
          Code
NotSupported
          Text
"async action queries with no relationships aren't expected to mix with normal source database queries"
  where
    go ::
      ( ( RootFieldMap
            ( Either
                (ActionId, (PGSourceConfig, EA.AsyncActionQuerySourceExecution (IR.UnpreparedValue ('Postgres 'Vanilla))))
                (SourceName, AB.AnyBackend (IR.SourceConfigWith (IR.QueryDBRoot Void IR.UnpreparedValue)))
            ),
          RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)
        ),
        RootFieldMap (SourceName, AB.AnyBackend (IR.SourceConfigWith (IR.QueryDBRoot Void IR.UnpreparedValue)))
      ) ->
      (RootFieldAlias, IR.QueryRootField IR.UnpreparedValue) ->
      m
        ( ( RootFieldMap
              ( Either
                  (ActionId, (PGSourceConfig, EA.AsyncActionQuerySourceExecution (IR.UnpreparedValue ('Postgres 'Vanilla))))
                  (SourceName, AB.AnyBackend (IR.SourceConfigWith (IR.QueryDBRoot Void IR.UnpreparedValue)))
              ),
            RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)
          ),
          RootFieldMap (SourceName, AB.AnyBackend (IR.SourceConfigWith (IR.QueryDBRoot Void IR.UnpreparedValue)))
        )
    go :: ((RootFieldMap
    (Either
       (ActionId,
        (PGSourceConfig,
         AsyncActionQuerySourceExecution
           (UnpreparedValue ('Postgres 'Vanilla))))
       (SourceName,
        AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
  RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
 RootFieldMap
   (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> (RootFieldAlias, QueryRootField UnpreparedValue)
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
go ((RootFieldMap
   (Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
 RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
accLiveQueryFields, RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
accStreamingFields) (RootFieldAlias
gName, QueryRootField UnpreparedValue
field) = case QueryRootField UnpreparedValue
field of
      IR.RFRemote RemoteSchemaRootField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_ -> Code
-> Text
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"subscription to remote server is not supported"
      IR.RFRaw Value
_ -> Code
-> Text
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Introspection not supported over subscriptions"
      IR.RFMulti [QueryRootField UnpreparedValue]
_ -> Code
-> Text
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"not supported over subscriptions"
      IR.RFDB SourceName
src AnyBackend
  (SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
e -> do
        let subscriptionType :: SubscriptionType
subscriptionType =
              case AnyBackend
  (SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> Maybe
     (SourceConfigWith
        (QueryDBRoot
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
        ('Postgres 'Vanilla))
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend @('Postgres 'Vanilla) AnyBackend
  (SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
e of
                Just (IR.SourceConfigWith SourceConfig ('Postgres 'Vanilla)
_ Maybe QueryTagsConfig
_ (IR.QDBR (IR.QDBStreamMultipleRows AnnSimpleStreamSelectG
  ('Postgres 'Vanilla)
  (RemoteRelationshipField UnpreparedValue)
  (UnpreparedValue ('Postgres 'Vanilla))
_))) -> SubscriptionType
Streaming
                Maybe
  (SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
     ('Postgres 'Vanilla))
_ -> SubscriptionType
LiveQuery
        AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
newQDB <- AnyBackend
  (SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> (forall (b :: BackendType).
    BackendExecute b =>
    SourceConfigWith
      (QueryDBRoot
         (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
      b
    -> m (SourceConfigWith (QueryDBRoot Void UnpreparedValue) b))
-> m (AnyBackend
        (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
forall (c :: BackendType -> Constraint) (i :: BackendType -> *)
       (j :: BackendType -> *) (f :: * -> *).
(AllBackendsSatisfy c, Functor f) =>
AnyBackend i
-> (forall (b :: BackendType). c b => i b -> f (j b))
-> f (AnyBackend j)
AB.traverseBackend @EB.BackendExecute AnyBackend
  (SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
e \(IR.SourceConfigWith SourceConfig b
srcConfig Maybe QueryTagsConfig
queryTagsConfig (IR.QDBR QueryDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
qdb)) -> do
          let (QueryDB b Void (UnpreparedValue b)
newQDB, Maybe RemoteJoins
remoteJoins) = QueryDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> (QueryDB b Void (UnpreparedValue b), Maybe RemoteJoins)
forall (b :: BackendType).
Backend b =>
QueryDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> (QueryDB b Void (UnpreparedValue b), Maybe RemoteJoins)
RJ.getRemoteJoinsQueryDB QueryDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
qdb
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe RemoteJoins -> Bool
forall a. Maybe a -> Bool
isNothing Maybe RemoteJoins
remoteJoins) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Remote relationships are not allowed in subscriptions"
          SourceConfigWith (QueryDBRoot Void UnpreparedValue) b
-> m (SourceConfigWith (QueryDBRoot Void UnpreparedValue) b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceConfigWith (QueryDBRoot Void UnpreparedValue) b
 -> m (SourceConfigWith (QueryDBRoot Void UnpreparedValue) b))
-> SourceConfigWith (QueryDBRoot Void UnpreparedValue) b
-> m (SourceConfigWith (QueryDBRoot Void UnpreparedValue) b)
forall a b. (a -> b) -> a -> b
$ SourceConfig b
-> Maybe QueryTagsConfig
-> QueryDBRoot Void UnpreparedValue b
-> SourceConfigWith (QueryDBRoot Void UnpreparedValue) b
forall (db :: BackendType -> *) (b :: BackendType).
SourceConfig b
-> Maybe QueryTagsConfig -> db b -> SourceConfigWith db b
IR.SourceConfigWith SourceConfig b
srcConfig Maybe QueryTagsConfig
queryTagsConfig (QueryDB b Void (UnpreparedValue b)
-> QueryDBRoot Void UnpreparedValue b
forall r (v :: BackendType -> *) (b :: BackendType).
QueryDB b r (v b) -> QueryDBRoot r v b
IR.QDBR QueryDB b Void (UnpreparedValue b)
newQDB)
        case SubscriptionType
subscriptionType of
          SubscriptionType
Streaming -> ((RootFieldMap
    (Either
       (ActionId,
        (PGSourceConfig,
         AsyncActionQuerySourceExecution
           (UnpreparedValue ('Postgres 'Vanilla))))
       (SourceName,
        AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
  RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
 RootFieldMap
   (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((RootFieldMap
   (Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
 RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
accLiveQueryFields, RootFieldAlias
-> (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> RootFieldMap
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> RootFieldMap
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert RootFieldAlias
gName (SourceName
src, AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
newQDB) RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
accStreamingFields)
          SubscriptionType
LiveQuery -> ((RootFieldMap
    (Either
       (ActionId,
        (PGSourceConfig,
         AsyncActionQuerySourceExecution
           (UnpreparedValue ('Postgres 'Vanilla))))
       (SourceName,
        AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
  RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
 RootFieldMap
   (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((RootFieldMap
     (Either
        (ActionId,
         (PGSourceConfig,
          AsyncActionQuerySourceExecution
            (UnpreparedValue ('Postgres 'Vanilla))))
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
   RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
  RootFieldMap
    (SourceName,
     AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
 -> m ((RootFieldMap
          (Either
             (ActionId,
              (PGSourceConfig,
               AsyncActionQuerySourceExecution
                 (UnpreparedValue ('Postgres 'Vanilla))))
             (SourceName,
              AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
        RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
       RootFieldMap
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))))
-> ((RootFieldMap
       (Either
          (ActionId,
           (PGSourceConfig,
            AsyncActionQuerySourceExecution
              (UnpreparedValue ('Postgres 'Vanilla))))
          (SourceName,
           AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
     RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
    RootFieldMap
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall a b. (a -> b) -> a -> b
$ ((RootFieldMap
   (Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
 -> RootFieldMap
      (Either
         (ActionId,
          (PGSourceConfig,
           AsyncActionQuerySourceExecution
             (UnpreparedValue ('Postgres 'Vanilla))))
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))))
-> (RootFieldMap
      (Either
         (ActionId,
          (PGSourceConfig,
           AsyncActionQuerySourceExecution
             (UnpreparedValue ('Postgres 'Vanilla))))
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
    RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
-> (RootFieldMap
      (Either
         (ActionId,
          (PGSourceConfig,
           AsyncActionQuerySourceExecution
             (UnpreparedValue ('Postgres 'Vanilla))))
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
    RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (RootFieldAlias
-> Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> RootFieldMap
     (Either
        (ActionId,
         (PGSourceConfig,
          AsyncActionQuerySourceExecution
            (UnpreparedValue ('Postgres 'Vanilla))))
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> RootFieldMap
     (Either
        (ActionId,
         (PGSourceConfig,
          AsyncActionQuerySourceExecution
            (UnpreparedValue ('Postgres 'Vanilla))))
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert RootFieldAlias
gName ((SourceName,
 AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
forall a b. b -> Either a b
Right (SourceName
src, AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
newQDB))) (RootFieldMap
   (Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
 RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
accLiveQueryFields, RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
accStreamingFields)
      IR.RFAction QueryActionRoot UnpreparedValue
action -> do
        let (ActionQuery Void
noRelsDBAST, Maybe RemoteJoins
remoteJoins) = QueryActionRoot UnpreparedValue
-> (ActionQuery Void, Maybe RemoteJoins)
RJ.getRemoteJoinsActionQuery QueryActionRoot UnpreparedValue
action
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe RemoteJoins -> Bool
forall a. Maybe a -> Bool
isNothing Maybe RemoteJoins
remoteJoins) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Remote relationships are not allowed in subscriptions"
        case ActionQuery Void
noRelsDBAST of
          IR.AQAsync AnnActionAsyncQuery ('Postgres 'Vanilla) Void
q -> do
            let actionId :: ActionId
actionId = AnnActionAsyncQuery ('Postgres 'Vanilla) Void -> ActionId
forall (b :: BackendType) r. AnnActionAsyncQuery b r -> ActionId
IR._aaaqActionId AnnActionAsyncQuery ('Postgres 'Vanilla) Void
q
            case UserInfo
-> AnnActionAsyncQuery ('Postgres 'Vanilla) Void
-> AsyncActionQueryExecution (UnpreparedValue ('Postgres 'Vanilla))
EA.resolveAsyncActionQuery UserInfo
userInfo AnnActionAsyncQuery ('Postgres 'Vanilla) Void
q of
              EA.AAQENoRelationships ActionLogResponse -> Either QErr EncJSON
respMaker ->
                ((RootFieldMap
    (Either
       (ActionId,
        (PGSourceConfig,
         AsyncActionQuerySourceExecution
           (UnpreparedValue ('Postgres 'Vanilla))))
       (SourceName,
        AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
  RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
 RootFieldMap
   (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((RootFieldMap
     (Either
        (ActionId,
         (PGSourceConfig,
          AsyncActionQuerySourceExecution
            (UnpreparedValue ('Postgres 'Vanilla))))
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
   RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
  RootFieldMap
    (SourceName,
     AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
 -> m ((RootFieldMap
          (Either
             (ActionId,
              (PGSourceConfig,
               AsyncActionQuerySourceExecution
                 (UnpreparedValue ('Postgres 'Vanilla))))
             (SourceName,
              AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
        RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
       RootFieldMap
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))))
-> ((RootFieldMap
       (Either
          (ActionId,
           (PGSourceConfig,
            AsyncActionQuerySourceExecution
              (UnpreparedValue ('Postgres 'Vanilla))))
          (SourceName,
           AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
     RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
    RootFieldMap
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall a b. (a -> b) -> a -> b
$ ((RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)
 -> RootFieldMap
      (ActionId, ActionLogResponse -> Either QErr EncJSON))
-> (RootFieldMap
      (Either
         (ActionId,
          (PGSourceConfig,
           AsyncActionQuerySourceExecution
             (UnpreparedValue ('Postgres 'Vanilla))))
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
    RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
-> (RootFieldMap
      (Either
         (ActionId,
          (PGSourceConfig,
           AsyncActionQuerySourceExecution
             (UnpreparedValue ('Postgres 'Vanilla))))
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
    RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (RootFieldAlias
-> (ActionId, ActionLogResponse -> Either QErr EncJSON)
-> RootFieldMap
     (ActionId, ActionLogResponse -> Either QErr EncJSON)
-> RootFieldMap
     (ActionId, ActionLogResponse -> Either QErr EncJSON)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert RootFieldAlias
gName (ActionId
actionId, ActionLogResponse -> Either QErr EncJSON
respMaker)) (RootFieldMap
   (Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
 RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
accLiveQueryFields, RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
accStreamingFields)
              EA.AAQEOnSourceDB SourceConfig ('Postgres 'Vanilla)
srcConfig AsyncActionQuerySourceExecution
  (UnpreparedValue ('Postgres 'Vanilla))
dbExecution ->
                ((RootFieldMap
    (Either
       (ActionId,
        (PGSourceConfig,
         AsyncActionQuerySourceExecution
           (UnpreparedValue ('Postgres 'Vanilla))))
       (SourceName,
        AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
  RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
 RootFieldMap
   (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((RootFieldMap
     (Either
        (ActionId,
         (PGSourceConfig,
          AsyncActionQuerySourceExecution
            (UnpreparedValue ('Postgres 'Vanilla))))
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
   RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
  RootFieldMap
    (SourceName,
     AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
 -> m ((RootFieldMap
          (Either
             (ActionId,
              (PGSourceConfig,
               AsyncActionQuerySourceExecution
                 (UnpreparedValue ('Postgres 'Vanilla))))
             (SourceName,
              AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
        RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
       RootFieldMap
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))))
-> ((RootFieldMap
       (Either
          (ActionId,
           (PGSourceConfig,
            AsyncActionQuerySourceExecution
              (UnpreparedValue ('Postgres 'Vanilla))))
          (SourceName,
           AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
     RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
    RootFieldMap
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall a b. (a -> b) -> a -> b
$ ((RootFieldMap
   (Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
 -> RootFieldMap
      (Either
         (ActionId,
          (PGSourceConfig,
           AsyncActionQuerySourceExecution
             (UnpreparedValue ('Postgres 'Vanilla))))
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))))
-> (RootFieldMap
      (Either
         (ActionId,
          (PGSourceConfig,
           AsyncActionQuerySourceExecution
             (UnpreparedValue ('Postgres 'Vanilla))))
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
    RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
-> (RootFieldMap
      (Either
         (ActionId,
          (PGSourceConfig,
           AsyncActionQuerySourceExecution
             (UnpreparedValue ('Postgres 'Vanilla))))
         (SourceName,
          AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
    RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (RootFieldAlias
-> Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> RootFieldMap
     (Either
        (ActionId,
         (PGSourceConfig,
          AsyncActionQuerySourceExecution
            (UnpreparedValue ('Postgres 'Vanilla))))
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
-> RootFieldMap
     (Either
        (ActionId,
         (PGSourceConfig,
          AsyncActionQuerySourceExecution
            (UnpreparedValue ('Postgres 'Vanilla))))
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert RootFieldAlias
gName ((ActionId,
 (PGSourceConfig,
  AsyncActionQuerySourceExecution
    (UnpreparedValue ('Postgres 'Vanilla))))
-> Either
     (ActionId,
      (PGSourceConfig,
       AsyncActionQuerySourceExecution
         (UnpreparedValue ('Postgres 'Vanilla))))
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
forall a b. a -> Either a b
Left (ActionId
actionId, (PGSourceConfig
SourceConfig ('Postgres 'Vanilla)
srcConfig, AsyncActionQuerySourceExecution
  (UnpreparedValue ('Postgres 'Vanilla))
dbExecution)))) (RootFieldMap
   (Either
      (ActionId,
       (PGSourceConfig,
        AsyncActionQuerySourceExecution
          (UnpreparedValue ('Postgres 'Vanilla))))
      (SourceName,
       AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
 RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON))
accLiveQueryFields, RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
accStreamingFields)
          IR.AQQuery AnnActionExecution Void
_ -> Code
-> Text
-> m ((RootFieldMap
         (Either
            (ActionId,
             (PGSourceConfig,
              AsyncActionQuerySourceExecution
                (UnpreparedValue ('Postgres 'Vanilla))))
            (SourceName,
             AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))),
       RootFieldMap (ActionId, ActionLogResponse -> Either QErr EncJSON)),
      RootFieldMap
        (SourceName,
         AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"query actions cannot be run as a subscription"

    buildAction ::
      (SourceName, AB.AnyBackend (IR.SourceConfigWith b)) ->
      RootFieldMap
        (SourceName, AB.AnyBackend (IR.SourceConfigWith (IR.QueryDBRoot Void IR.UnpreparedValue))) ->
      RootFieldAlias ->
      ExceptT QErr IO (SourceName, SubscriptionQueryPlan)
    buildAction :: (SourceName, AnyBackend (SourceConfigWith b))
-> RootFieldMap
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> RootFieldAlias
-> ExceptT QErr IO (SourceName, SubscriptionQueryPlan)
buildAction (SourceName
sourceName, AnyBackend (SourceConfigWith b)
exists) RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
allFields RootFieldAlias
rootFieldName = do
      SubscriptionQueryPlan
subscriptionPlan <- AnyBackend (SourceConfigWith b)
-> (forall (b :: BackendType).
    BackendExecute b =>
    SourceConfigWith b b -> ExceptT QErr IO SubscriptionQueryPlan)
-> ExceptT QErr IO SubscriptionQueryPlan
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @EB.BackendExecute
        AnyBackend (SourceConfigWith b)
exists
        \(IR.SourceConfigWith SourceConfig b
sourceConfig Maybe QueryTagsConfig
queryTagsConfig b b
_ :: IR.SourceConfigWith db b) -> do
          InsOrdHashMap RootFieldAlias (QueryDB b Void (UnpreparedValue b))
qdbs <- ((SourceName,
  AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
 -> ExceptT QErr IO (QueryDB b Void (UnpreparedValue b)))
-> RootFieldMap
     (SourceName,
      AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> ExceptT
     QErr
     IO
     (InsOrdHashMap RootFieldAlias (QueryDB b Void (UnpreparedValue b)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SourceName
-> (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> ExceptT QErr IO (QueryDB b Void (UnpreparedValue b))
forall (b :: BackendType) (m1 :: * -> *).
(Backend b, MonadError QErr m1) =>
SourceName
-> (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> m1 (QueryDB b Void (UnpreparedValue b))
checkField @b SourceName
sourceName) RootFieldMap
  (SourceName,
   AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
allFields
          let subscriptionQueryTagsAttributes :: QueryTagsAttributes
subscriptionQueryTagsAttributes = QueryTags -> QueryTagsAttributes
encodeQueryTags (QueryTags -> QueryTagsAttributes)
-> QueryTags -> QueryTagsAttributes
forall a b. (a -> b) -> a -> b
$ LivequeryMetadata -> QueryTags
QTLiveQuery (LivequeryMetadata -> QueryTags) -> LivequeryMetadata -> QueryTags
forall a b. (a -> b) -> a -> b
$ RootFieldAlias -> ParameterizedQueryHash -> LivequeryMetadata
LivequeryMetadata RootFieldAlias
rootFieldName ParameterizedQueryHash
parameterizedQueryHash
          let queryTagsComment :: QueryTagsComment
queryTagsComment = Tagged m QueryTagsComment -> QueryTagsComment
forall k (s :: k) b. Tagged s b -> b
Tagged.untag (Tagged m QueryTagsComment -> QueryTagsComment)
-> Tagged m QueryTagsComment -> QueryTagsComment
forall a b. (a -> b) -> a -> b
$ QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged m QueryTagsComment
forall (m :: * -> *).
MonadQueryTags m =>
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged m QueryTagsComment
EB.createQueryTags @m QueryTagsAttributes
subscriptionQueryTagsAttributes Maybe QueryTagsConfig
queryTagsConfig
          AnyBackend MultiplexedSubscriptionQueryPlan
-> SubscriptionQueryPlan
SubscriptionQueryPlan (AnyBackend MultiplexedSubscriptionQueryPlan
 -> SubscriptionQueryPlan)
-> (SubscriptionQueryPlan b (MultiplexedQuery b)
    -> AnyBackend MultiplexedSubscriptionQueryPlan)
-> SubscriptionQueryPlan b (MultiplexedQuery b)
-> SubscriptionQueryPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiplexedSubscriptionQueryPlan b
-> AnyBackend MultiplexedSubscriptionQueryPlan
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (MultiplexedSubscriptionQueryPlan b
 -> AnyBackend MultiplexedSubscriptionQueryPlan)
-> (SubscriptionQueryPlan b (MultiplexedQuery b)
    -> MultiplexedSubscriptionQueryPlan b)
-> SubscriptionQueryPlan b (MultiplexedQuery b)
-> AnyBackend MultiplexedSubscriptionQueryPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubscriptionQueryPlan b (MultiplexedQuery b)
-> MultiplexedSubscriptionQueryPlan b
forall (b :: BackendType).
SubscriptionQueryPlan b (MultiplexedQuery b)
-> MultiplexedSubscriptionQueryPlan b
MultiplexedSubscriptionQueryPlan
            (SubscriptionQueryPlan b (MultiplexedQuery b)
 -> SubscriptionQueryPlan)
-> ExceptT QErr IO (SubscriptionQueryPlan b (MultiplexedQuery b))
-> ExceptT QErr IO SubscriptionQueryPlan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  QueryTagsComment
  (ExceptT QErr IO)
  (SubscriptionQueryPlan b (MultiplexedQuery b))
-> QueryTagsComment
-> ExceptT QErr IO (SubscriptionQueryPlan b (MultiplexedQuery b))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (UserInfo
-> SourceName
-> SourceConfig b
-> Maybe Name
-> InsOrdHashMap
     RootFieldAlias (QueryDB b Void (UnpreparedValue b))
-> ReaderT
     QueryTagsComment
     (ExceptT QErr IO)
     (SubscriptionQueryPlan b (MultiplexedQuery b))
forall (b :: BackendType) (m :: * -> *).
(BackendExecute b, MonadError QErr m, MonadIO m,
 MonadBaseControl IO m, MonadReader QueryTagsComment m) =>
UserInfo
-> SourceName
-> SourceConfig b
-> Maybe Name
-> RootFieldMap (QueryDB b Void (UnpreparedValue b))
-> m (SubscriptionQueryPlan b (MultiplexedQuery b))
EB.mkLiveQuerySubscriptionPlan UserInfo
userInfo SourceName
sourceName SourceConfig b
sourceConfig (RootFieldAlias -> Maybe Name
_rfaNamespace RootFieldAlias
rootFieldName) InsOrdHashMap RootFieldAlias (QueryDB b Void (UnpreparedValue b))
qdbs) QueryTagsComment
queryTagsComment
      (SourceName, SubscriptionQueryPlan)
-> ExceptT QErr IO (SourceName, SubscriptionQueryPlan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceName
sourceName, SubscriptionQueryPlan
subscriptionPlan)

    checkField ::
      forall b m1.
      (Backend b, MonadError QErr m1) =>
      SourceName ->
      (SourceName, AB.AnyBackend (IR.SourceConfigWith (IR.QueryDBRoot Void IR.UnpreparedValue))) ->
      m1 (IR.QueryDB b Void (IR.UnpreparedValue b))
    checkField :: SourceName
-> (SourceName,
    AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue)))
-> m1 (QueryDB b Void (UnpreparedValue b))
checkField SourceName
sourceName (SourceName
src, AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
exists)
      | SourceName
sourceName SourceName -> SourceName -> Bool
forall a. Eq a => a -> a -> Bool
/= SourceName
src = Code -> Text -> m1 (QueryDB b Void (UnpreparedValue b))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"all fields of a subscription must be from the same source"
      | Bool
otherwise = case AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
-> Maybe (SourceConfigWith (QueryDBRoot Void UnpreparedValue) b)
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend AnyBackend (SourceConfigWith (QueryDBRoot Void UnpreparedValue))
exists of
        Maybe (SourceConfigWith (QueryDBRoot Void UnpreparedValue) b)
Nothing -> Text -> m1 (QueryDB b Void (UnpreparedValue b))
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"internal error: two sources share the same name but are tied to different backends"
        Just (IR.SourceConfigWith SourceConfig b
_ Maybe QueryTagsConfig
_ (IR.QDBR QueryDB b Void (UnpreparedValue b)
qdb)) -> QueryDB b Void (UnpreparedValue b)
-> m1 (QueryDB b Void (UnpreparedValue b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryDB b Void (UnpreparedValue b)
qdb

checkQueryInAllowlist ::
  (MonadError QErr m) =>
  Bool ->
  AllowlistMode ->
  UserInfo ->
  GQLReqParsed ->
  SchemaCache ->
  m ()
checkQueryInAllowlist :: Bool
-> AllowlistMode -> UserInfo -> GQLReqParsed -> SchemaCache -> m ()
checkQueryInAllowlist Bool
allowlistEnabled AllowlistMode
allowlistMode UserInfo
userInfo GQLReqParsed
req SchemaCache
schemaCache =
  -- only for non-admin roles
  -- check if query is in allowlist
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
allowlistEnabled Bool -> Bool -> Bool
&& RoleName
role RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
/= RoleName
adminRoleName) do
    let query :: ExecutableDocument Name
query = [ExecutableDefinition Name] -> ExecutableDocument Name
forall var. [ExecutableDefinition var] -> ExecutableDocument var
G.ExecutableDocument ([ExecutableDefinition Name] -> ExecutableDocument Name)
-> (GQLExecDoc -> [ExecutableDefinition Name])
-> GQLExecDoc
-> ExecutableDocument Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLExecDoc -> [ExecutableDefinition Name]
unGQLExecDoc (GQLExecDoc -> ExecutableDocument Name)
-> GQLExecDoc -> ExecutableDocument Name
forall a b. (a -> b) -> a -> b
$ GQLReqParsed -> GQLExecDoc
forall a. GQLReq a -> a
_grQuery GQLReqParsed
req
        allowlist :: InlinedAllowlist
allowlist = SchemaCache -> InlinedAllowlist
scAllowlist SchemaCache
schemaCache
        allowed :: Bool
allowed = InlinedAllowlist
-> AllowlistMode -> RoleName -> ExecutableDocument Name -> Bool
allowlistAllowsQuery InlinedAllowlist
allowlist AllowlistMode
allowlistMode RoleName
role ExecutableDocument Name
query
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowed (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      (QErr -> QErr) -> m () -> m ()
forall (m :: * -> *) a. QErrM m => (QErr -> QErr) -> m a -> m a
modifyQErr QErr -> QErr
modErr (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed Text
"query is not allowed"
  where
    role :: RoleName
role = UserInfo -> RoleName
_uiRole UserInfo
userInfo
    modErr :: QErr -> QErr
modErr QErr
e =
      let msg :: Text
msg = Text
"query is not in any of the allowlists"
       in QErr
e {qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal (Value -> QErrExtra) -> Value -> QErrExtra
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
J.object [Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Text -> Value
J.String Text
msg]}

-- | Construct a 'ResolvedExecutionPlan' from a 'GQLReqParsed' and a
-- bunch of metadata.
{-# INLINEABLE getResolvedExecPlan #-}
getResolvedExecPlan ::
  forall m.
  ( MonadError QErr m,
    MonadMetadataStorage (MetadataStorageT m),
    MonadIO m,
    MonadBaseControl IO m,
    Tracing.MonadTrace m,
    EC.MonadGQLExecutionCheck m,
    EB.MonadQueryTags m
  ) =>
  Env.Environment ->
  L.Logger L.Hasura ->
  UserInfo ->
  SQLGenCtx ->
  ReadOnlyMode ->
  SchemaCache ->
  SchemaCacheVer ->
  ET.GraphQLQueryType ->
  HTTP.Manager ->
  [HTTP.Header] ->
  GQLReqUnparsed ->
  SingleOperation -> -- the first step of the execution plan
  Maybe G.Name ->
  RequestId ->
  m (ParameterizedQueryHash, ResolvedExecutionPlan)
getResolvedExecPlan :: Environment
-> Logger Hasura
-> UserInfo
-> SQLGenCtx
-> ReadOnlyMode
-> SchemaCache
-> SchemaCacheVer
-> GraphQLQueryType
-> Manager
-> [Header]
-> GQLReqUnparsed
-> SingleOperation
-> Maybe Name
-> RequestId
-> m (ParameterizedQueryHash, ResolvedExecutionPlan)
getResolvedExecPlan
  Environment
env
  Logger Hasura
logger
  UserInfo
userInfo
  SQLGenCtx
sqlGenCtx
  ReadOnlyMode
readOnlyMode
  SchemaCache
sc
  SchemaCacheVer
_scVer
  GraphQLQueryType
queryType
  Manager
httpManager
  [Header]
reqHeaders
  GQLReqUnparsed
reqUnparsed
  SingleOperation
queryParts -- the first step of the execution plan
  Maybe Name
maybeOperationName
  RequestId
reqId = do
    let gCtx :: GQLContext
gCtx = UserInfo -> SchemaCache -> GraphQLQueryType -> GQLContext
makeGQLContext UserInfo
userInfo SchemaCache
sc GraphQLQueryType
queryType

    -- Construct the full 'ResolvedExecutionPlan' from the 'queryParts :: SingleOperation'.
    (ParameterizedQueryHash
parameterizedQueryHash, ResolvedExecutionPlan
resolvedExecPlan) <-
      case SingleOperation
queryParts of
        G.TypedOperationDefinition OperationType
G.OperationTypeQuery Maybe Name
_ [VariableDefinition]
varDefs [Directive Name]
directives SelectionSet NoFragments Name
inlinedSelSet -> do
          (ExecutionPlan
executionPlan, [QueryRootField UnpreparedValue]
queryRootFields, DirectiveMap
dirMap, ParameterizedQueryHash
parameterizedQueryHash) <-
            Environment
-> Logger Hasura
-> GQLContext
-> UserInfo
-> Manager
-> [Header]
-> [Directive Name]
-> SelectionSet NoFragments Name
-> [VariableDefinition]
-> GQLReqUnparsed
-> SetGraphqlIntrospectionOptions
-> RequestId
-> Maybe Name
-> m (ExecutionPlan, [QueryRootField UnpreparedValue],
      DirectiveMap, ParameterizedQueryHash)
forall (m :: * -> *).
(MonadError QErr m, MonadGQLExecutionCheck m, MonadQueryTags m) =>
Environment
-> Logger Hasura
-> GQLContext
-> UserInfo
-> Manager
-> [Header]
-> [Directive Name]
-> SelectionSet NoFragments Name
-> [VariableDefinition]
-> GQLReqUnparsed
-> SetGraphqlIntrospectionOptions
-> RequestId
-> Maybe Name
-> m (ExecutionPlan, [QueryRootField UnpreparedValue],
      DirectiveMap, ParameterizedQueryHash)
EQ.convertQuerySelSet
              Environment
env
              Logger Hasura
logger
              GQLContext
gCtx
              UserInfo
userInfo
              Manager
httpManager
              [Header]
reqHeaders
              [Directive Name]
directives
              SelectionSet NoFragments Name
inlinedSelSet
              [VariableDefinition]
varDefs
              GQLReqUnparsed
reqUnparsed
              (SchemaCache -> SetGraphqlIntrospectionOptions
scSetGraphqlIntrospectionOptions SchemaCache
sc)
              RequestId
reqId
              Maybe Name
maybeOperationName
          (ParameterizedQueryHash, ResolvedExecutionPlan)
-> m (ParameterizedQueryHash, ResolvedExecutionPlan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParameterizedQueryHash
parameterizedQueryHash, ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> DirectiveMap
-> ResolvedExecutionPlan
QueryExecutionPlan ExecutionPlan
executionPlan [QueryRootField UnpreparedValue]
queryRootFields DirectiveMap
dirMap)
        G.TypedOperationDefinition OperationType
G.OperationTypeMutation Maybe Name
_ [VariableDefinition]
varDefs [Directive Name]
directives SelectionSet NoFragments Name
inlinedSelSet -> do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ReadOnlyMode
readOnlyMode ReadOnlyMode -> ReadOnlyMode -> Bool
forall a. Eq a => a -> a -> Bool
== ReadOnlyMode
ReadOnlyModeEnabled) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Mutations are not allowed when read-only mode is enabled"
          (ExecutionPlan
executionPlan, ParameterizedQueryHash
parameterizedQueryHash) <-
            Environment
-> Logger Hasura
-> GQLContext
-> SQLGenCtx
-> UserInfo
-> Manager
-> [Header]
-> [Directive Name]
-> SelectionSet NoFragments Name
-> [VariableDefinition]
-> GQLReqUnparsed
-> SetGraphqlIntrospectionOptions
-> RequestId
-> Maybe Name
-> m (ExecutionPlan, ParameterizedQueryHash)
forall (m :: * -> *).
(MonadTrace m, MonadIO m, MonadError QErr m,
 MonadMetadataStorage (MetadataStorageT m),
 MonadGQLExecutionCheck m, MonadQueryTags m) =>
Environment
-> Logger Hasura
-> GQLContext
-> SQLGenCtx
-> UserInfo
-> Manager
-> [Header]
-> [Directive Name]
-> SelectionSet NoFragments Name
-> [VariableDefinition]
-> GQLReqUnparsed
-> SetGraphqlIntrospectionOptions
-> RequestId
-> Maybe Name
-> m (ExecutionPlan, ParameterizedQueryHash)
EM.convertMutationSelectionSet
              Environment
env
              Logger Hasura
logger
              GQLContext
gCtx
              SQLGenCtx
sqlGenCtx
              UserInfo
userInfo
              Manager
httpManager
              [Header]
reqHeaders
              [Directive Name]
directives
              SelectionSet NoFragments Name
inlinedSelSet
              [VariableDefinition]
varDefs
              GQLReqUnparsed
reqUnparsed
              (SchemaCache -> SetGraphqlIntrospectionOptions
scSetGraphqlIntrospectionOptions SchemaCache
sc)
              RequestId
reqId
              Maybe Name
maybeOperationName
          (ParameterizedQueryHash, ResolvedExecutionPlan)
-> m (ParameterizedQueryHash, ResolvedExecutionPlan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParameterizedQueryHash
parameterizedQueryHash, ExecutionPlan -> ResolvedExecutionPlan
MutationExecutionPlan ExecutionPlan
executionPlan)
        G.TypedOperationDefinition OperationType
G.OperationTypeSubscription Maybe Name
_ [VariableDefinition]
varDefs [Directive Name]
directives SelectionSet NoFragments Name
inlinedSelSet -> do
          ([Directive Variable]
normalizedDirectives, SelectionSet NoFragments Variable
normalizedSelectionSet) <-
            [VariableDefinition]
-> VariableValues
-> [Directive Name]
-> SelectionSet NoFragments Name
-> m ([Directive Variable], SelectionSet NoFragments Variable)
forall (m :: * -> *) (fragments :: * -> *).
(MonadError QErr m, Traversable fragments) =>
[VariableDefinition]
-> VariableValues
-> [Directive Name]
-> SelectionSet fragments Name
-> m ([Directive Variable], SelectionSet fragments Variable)
ER.resolveVariables
              [VariableDefinition]
varDefs
              (VariableValues -> Maybe VariableValues -> VariableValues
forall a. a -> Maybe a -> a
fromMaybe VariableValues
forall a. Monoid a => a
mempty (GQLReqUnparsed -> Maybe VariableValues
forall a. GQLReq a -> Maybe VariableValues
_grVariables GQLReqUnparsed
reqUnparsed))
              [Directive Name]
directives
              SelectionSet NoFragments Name
inlinedSelSet
          ParserFn (RootFieldMap (QueryRootField UnpreparedValue))
subscriptionParser <- GQLContext
-> Maybe (ParserFn (RootFieldMap (QueryRootField UnpreparedValue)))
C.gqlSubscriptionParser GQLContext
gCtx Maybe (ParserFn (RootFieldMap (QueryRootField UnpreparedValue)))
-> m (ParserFn (RootFieldMap (QueryRootField UnpreparedValue)))
-> m (ParserFn (RootFieldMap (QueryRootField UnpreparedValue)))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code
-> Text
-> m (ParserFn (RootFieldMap (QueryRootField UnpreparedValue)))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed Text
"no subscriptions exist"
          RootFieldMap (QueryRootField UnpreparedValue)
unpreparedAST <- Either QErr (RootFieldMap (QueryRootField UnpreparedValue))
-> m (RootFieldMap (QueryRootField UnpreparedValue))
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either QErr (RootFieldMap (QueryRootField UnpreparedValue))
 -> m (RootFieldMap (QueryRootField UnpreparedValue)))
-> Either QErr (RootFieldMap (QueryRootField UnpreparedValue))
-> m (RootFieldMap (QueryRootField UnpreparedValue))
forall a b. (a -> b) -> a -> b
$ ParserFn (RootFieldMap (QueryRootField UnpreparedValue))
subscriptionParser SelectionSet NoFragments Variable
normalizedSelectionSet
          let parameterizedQueryHash :: ParameterizedQueryHash
parameterizedQueryHash = SelectionSet NoFragments Variable -> ParameterizedQueryHash
calculateParameterizedQueryHash SelectionSet NoFragments Variable
normalizedSelectionSet
          -- Process directives on the subscription
          DirectiveMap
dirMap <-
            Either ParseError DirectiveMap -> m DirectiveMap
forall (m :: * -> *) a.
MonadError QErr m =>
Either ParseError a -> m a
toQErr (Either ParseError DirectiveMap -> m DirectiveMap)
-> Either ParseError DirectiveMap -> m DirectiveMap
forall a b. (a -> b) -> a -> b
$ Parse DirectiveMap -> Either ParseError DirectiveMap
forall (m :: * -> *) a. MonadError ParseError m => Parse a -> m a
runParse ([Directive Any Parse]
-> DirectiveLocation -> [Directive Variable] -> Parse DirectiveMap
forall origin (m :: * -> *).
MonadParse m =>
[Directive origin m]
-> DirectiveLocation -> [Directive Variable] -> m DirectiveMap
parseDirectives [Directive Any Parse]
forall (m :: * -> *) origin. MonadParse m => [Directive origin m]
customDirectives (ExecutableDirectiveLocation -> DirectiveLocation
G.DLExecutable ExecutableDirectiveLocation
G.EDLSUBSCRIPTION) [Directive Variable]
normalizedDirectives)

          -- A subscription should have exactly one root field.
          -- However, for testing purposes, we may allow several root fields; we check for this by
          -- looking for directive "_multiple_top_level_fields" on the subscription. THIS IS NOT A
          -- SUPPORTED FEATURE. We might remove it in the future without warning. DO NOT USE THIS.
          Bool
allowMultipleRootFields <- DirectiveMap -> DirectiveKey () -> (Maybe () -> m Bool) -> m Bool
forall a (m :: * -> *) b.
DirectiveMap -> DirectiveKey a -> (Maybe a -> m b) -> m b
withDirective DirectiveMap
dirMap DirectiveKey ()
multipleRootFields ((Maybe () -> m Bool) -> m Bool) -> (Maybe () -> m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (Maybe () -> Bool) -> Maybe () -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe () -> Bool
forall a. Maybe a -> Bool
isJust
          case SelectionSet NoFragments Name
inlinedSelSet of
            [] -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"empty selset for subscription"
            [Selection NoFragments Name
_] -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            SelectionSet NoFragments Name
_ ->
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
allowMultipleRootFields Bool -> Bool -> Bool
&& RootFieldMap (QueryRootField UnpreparedValue) -> Bool
forall a. RootFieldMap a -> Bool
isSingleNamespace RootFieldMap (QueryRootField UnpreparedValue)
unpreparedAST) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed Text
"subscriptions must select one top level field"
          SubscriptionExecution
subscriptionPlan <- UserInfo
-> RootFieldMap (QueryRootField UnpreparedValue)
-> ParameterizedQueryHash
-> m SubscriptionExecution
forall (m :: * -> *).
(MonadError QErr m, MonadQueryTags m, MonadIO m,
 MonadBaseControl IO m) =>
UserInfo
-> RootFieldMap (QueryRootField UnpreparedValue)
-> ParameterizedQueryHash
-> m SubscriptionExecution
buildSubscriptionPlan UserInfo
userInfo RootFieldMap (QueryRootField UnpreparedValue)
unpreparedAST ParameterizedQueryHash
parameterizedQueryHash
          (ParameterizedQueryHash, ResolvedExecutionPlan)
-> m (ParameterizedQueryHash, ResolvedExecutionPlan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParameterizedQueryHash
parameterizedQueryHash, SubscriptionExecution -> ResolvedExecutionPlan
SubscriptionExecutionPlan SubscriptionExecution
subscriptionPlan)
    -- the parameterized query hash is calculated here because it is used in multiple
    -- places and instead of calculating it separately, this is a common place to calculate
    -- the parameterized query hash and then thread it to the required places
    (ParameterizedQueryHash, ResolvedExecutionPlan)
-> m (ParameterizedQueryHash, ResolvedExecutionPlan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ParameterizedQueryHash, ResolvedExecutionPlan)
 -> m (ParameterizedQueryHash, ResolvedExecutionPlan))
-> (ParameterizedQueryHash, ResolvedExecutionPlan)
-> m (ParameterizedQueryHash, ResolvedExecutionPlan)
forall a b. (a -> b) -> a -> b
$ (ParameterizedQueryHash
parameterizedQueryHash, ResolvedExecutionPlan
resolvedExecPlan)

-- | Even when directive _multiple_top_level_fields is given, we can't allow
-- fields within differently-aliased namespaces.
-- This is because the namespace is added to the result by wrapping
-- the bytestring response we get back from the DB.
isSingleNamespace :: RootFieldMap a -> Bool
isSingleNamespace :: RootFieldMap a -> Bool
isSingleNamespace RootFieldMap a
fieldMap =
  case [Maybe Name] -> [Maybe Name]
forall a. Ord a => [a] -> [a]
nubOrd (RootFieldAlias -> Maybe Name
_rfaNamespace (RootFieldAlias -> Maybe Name) -> [RootFieldAlias] -> [Maybe Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RootFieldMap a -> [RootFieldAlias]
forall k v. InsOrdHashMap k v -> [k]
OMap.keys RootFieldMap a
fieldMap) of
    [Maybe Name
_] -> Bool
True
    [Maybe Name]
_ -> Bool
False