-- | Execution of GraphQL queries over HTTP transport
module Hasura.GraphQL.Transport.HTTP
  ( QueryCacheKey (..),
    MonadExecuteQuery (..),
    CachedDirective (..),
    runGQ,
    runGQBatched,
    coalescePostgresMutations,
    extractFieldFromResponse,
    buildRaw,
    encodeAnnotatedResponseParts,
    encodeEncJSONResults,

    -- * imported from HTTP.Protocol; required by pro
    GQLReq (..),
    GQLReqUnparsed,
    GQLReqParsed,
    GQLExecDoc (..),
    OperationName (..),
    GQLQueryText (..),
    AnnotatedResponsePart (..),
    CacheStoreSuccess (..),
    CacheStoreFailure (..),
    SessVarPred,
    filterVariablesFromQuery,
    runSessVarPred,
  )
where

import Control.Lens (Traversal', foldOf, to)
import Control.Monad.Morph (hoist)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson qualified as J
import Data.Aeson.Ordered qualified as JO
import Data.Bifoldable
import Data.ByteString.Lazy qualified as LBS
import Data.Dependent.Map qualified as DM
import Data.Environment qualified as Env
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.Monoid (Any (..))
import Data.Text qualified as T
import Hasura.Backends.Postgres.Instances.Transport (runPGMutationTransaction)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Execute qualified as E
import Hasura.GraphQL.Execute.Action qualified as EA
import Hasura.GraphQL.Execute.Backend qualified as EB
import Hasura.GraphQL.Execute.RemoteJoin qualified as RJ
import Hasura.GraphQL.Logging
  ( MonadQueryLog (logQueryLog),
    QueryLog (..),
    QueryLogKind (..),
  )
import Hasura.GraphQL.Namespace
import Hasura.GraphQL.ParameterizedQueryHash
import Hasura.GraphQL.Parser.Directives (CachedDirective (..), DirectiveMap, cached)
import Hasura.GraphQL.Transport.Backend
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.GraphQL.Transport.Instances ()
import Hasura.HTTP
import Hasura.Logging qualified as L
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.RQL.IR
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.ResultCustomization
import Hasura.RQL.Types.SchemaCache
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.Server.Init.Config
import Hasura.Server.Limits
import Hasura.Server.Logging
import Hasura.Server.Logging qualified as L
import Hasura.Server.Prometheus
  ( GraphQLRequestMetrics (..),
    PrometheusMetrics (..),
  )
import Hasura.Server.Telemetry.Counters qualified as Telem
import Hasura.Server.Types (RequestId)
import Hasura.Session
import Hasura.Tracing (MonadTrace, TraceT, trace)
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
import Network.Wai.Extended qualified as Wai
import System.Metrics.Prometheus.Counter qualified as Prometheus.Counter
import System.Metrics.Prometheus.Histogram qualified as Prometheus.Histogram

data QueryCacheKey = QueryCacheKey
  { QueryCacheKey -> GQLReqParsed
qckQueryString :: !GQLReqParsed,
    QueryCacheKey -> RoleName
qckUserRole :: !RoleName,
    QueryCacheKey -> SessionVariables
qckSession :: !SessionVariables
  }

instance J.ToJSON QueryCacheKey where
  toJSON :: QueryCacheKey -> Value
toJSON (QueryCacheKey GQLReqParsed
qs RoleName
ur SessionVariables
sess) =
    [Pair] -> Value
J.object [Key
"query_string" Key -> GQLReqParsed -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= GQLReqParsed
qs, Key
"user_role" Key -> RoleName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= RoleName
ur, Key
"session" Key -> SessionVariables -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= SessionVariables
sess]

type CacheStoreResponse = Either CacheStoreFailure CacheStoreSuccess

data CacheStoreSuccess
  = CacheStoreSkipped
  | CacheStoreHit
  deriving (CacheStoreSuccess -> CacheStoreSuccess -> Bool
(CacheStoreSuccess -> CacheStoreSuccess -> Bool)
-> (CacheStoreSuccess -> CacheStoreSuccess -> Bool)
-> Eq CacheStoreSuccess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheStoreSuccess -> CacheStoreSuccess -> Bool
$c/= :: CacheStoreSuccess -> CacheStoreSuccess -> Bool
== :: CacheStoreSuccess -> CacheStoreSuccess -> Bool
$c== :: CacheStoreSuccess -> CacheStoreSuccess -> Bool
Eq, Int -> CacheStoreSuccess -> ShowS
[CacheStoreSuccess] -> ShowS
CacheStoreSuccess -> String
(Int -> CacheStoreSuccess -> ShowS)
-> (CacheStoreSuccess -> String)
-> ([CacheStoreSuccess] -> ShowS)
-> Show CacheStoreSuccess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheStoreSuccess] -> ShowS
$cshowList :: [CacheStoreSuccess] -> ShowS
show :: CacheStoreSuccess -> String
$cshow :: CacheStoreSuccess -> String
showsPrec :: Int -> CacheStoreSuccess -> ShowS
$cshowsPrec :: Int -> CacheStoreSuccess -> ShowS
Show)

data CacheStoreFailure
  = CacheStoreLimitReached
  | CacheStoreNotEnoughCapacity
  | CacheStoreBackendError String
  deriving (CacheStoreFailure -> CacheStoreFailure -> Bool
(CacheStoreFailure -> CacheStoreFailure -> Bool)
-> (CacheStoreFailure -> CacheStoreFailure -> Bool)
-> Eq CacheStoreFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheStoreFailure -> CacheStoreFailure -> Bool
$c/= :: CacheStoreFailure -> CacheStoreFailure -> Bool
== :: CacheStoreFailure -> CacheStoreFailure -> Bool
$c== :: CacheStoreFailure -> CacheStoreFailure -> Bool
Eq, Int -> CacheStoreFailure -> ShowS
[CacheStoreFailure] -> ShowS
CacheStoreFailure -> String
(Int -> CacheStoreFailure -> ShowS)
-> (CacheStoreFailure -> String)
-> ([CacheStoreFailure] -> ShowS)
-> Show CacheStoreFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheStoreFailure] -> ShowS
$cshowList :: [CacheStoreFailure] -> ShowS
show :: CacheStoreFailure -> String
$cshow :: CacheStoreFailure -> String
showsPrec :: Int -> CacheStoreFailure -> ShowS
$cshowsPrec :: Int -> CacheStoreFailure -> ShowS
Show)

class Monad m => MonadExecuteQuery m where
  -- | This method does two things: it looks up a query result in the
  -- server-side cache, if a cache is used, and it additionally returns HTTP
  -- headers that can instruct a client how long a response can be cached
  -- locally (i.e. client-side).
  cacheLookup ::
    -- | Used to check if the elaborated query supports caching
    [RemoteSchemaInfo] ->
    -- | Used to check if actions query supports caching (unsupported if `forward_client_headers` is set)
    [ActionsInfo] ->
    -- | Key that uniquely identifies the result of a query execution
    QueryCacheKey ->
    -- | Cached Directive from GraphQL query AST
    Maybe CachedDirective ->
    -- | HTTP headers to be sent back to the caller for this GraphQL request,
    -- containing e.g. time-to-live information, and a cached value if found and
    -- within time-to-live.  So a return value (non-empty-ttl-headers, Nothing)
    -- represents that we don't have a server-side cache of the query, but that
    -- the client should store it locally.  The value ([], Just json) represents
    -- that the client should not store the response locally, but we do have a
    -- server-side cache value that can be used to avoid query execution.
    TraceT (ExceptT QErr m) (HTTP.ResponseHeaders, Maybe EncJSON)

  -- | Store a json response for a query that we've executed in the cache.  Note
  -- that, as part of this, 'cacheStore' has to decide whether the response is
  -- cacheable.  A very similar decision is also made in 'cacheLookup', since it
  -- has to construct corresponding cache-enabling headers that are sent to the
  -- client.  But note that the HTTP headers influence client-side caching,
  -- whereas 'cacheStore' changes the server-side cache.
  cacheStore ::
    -- | Key under which to store the result of a query execution
    QueryCacheKey ->
    -- | Cached Directive from GraphQL query AST
    Maybe CachedDirective ->
    -- | Result of a query execution
    EncJSON ->
    -- | Always succeeds
    TraceT (ExceptT QErr m) CacheStoreResponse

  default cacheLookup ::
    (m ~ t n, MonadTrans t, MonadExecuteQuery n) =>
    [RemoteSchemaInfo] ->
    [ActionsInfo] ->
    QueryCacheKey ->
    Maybe CachedDirective ->
    TraceT (ExceptT QErr m) (HTTP.ResponseHeaders, Maybe EncJSON)
  cacheLookup [RemoteSchemaInfo]
a [ActionsInfo]
b QueryCacheKey
c Maybe CachedDirective
d = (forall a. ExceptT QErr n a -> ExceptT QErr m a)
-> TraceT (ExceptT QErr n) (ResponseHeaders, Maybe EncJSON)
-> TraceT (ExceptT QErr m) (ResponseHeaders, Maybe EncJSON)
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. n a -> t n a)
-> ExceptT QErr n a -> ExceptT QErr (t n) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. n a -> t n a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (TraceT (ExceptT QErr n) (ResponseHeaders, Maybe EncJSON)
 -> TraceT (ExceptT QErr m) (ResponseHeaders, Maybe EncJSON))
-> TraceT (ExceptT QErr n) (ResponseHeaders, Maybe EncJSON)
-> TraceT (ExceptT QErr m) (ResponseHeaders, Maybe EncJSON)
forall a b. (a -> b) -> a -> b
$ [RemoteSchemaInfo]
-> [ActionsInfo]
-> QueryCacheKey
-> Maybe CachedDirective
-> TraceT (ExceptT QErr n) (ResponseHeaders, Maybe EncJSON)
forall (m :: * -> *).
MonadExecuteQuery m =>
[RemoteSchemaInfo]
-> [ActionsInfo]
-> QueryCacheKey
-> Maybe CachedDirective
-> TraceT (ExceptT QErr m) (ResponseHeaders, Maybe EncJSON)
cacheLookup [RemoteSchemaInfo]
a [ActionsInfo]
b QueryCacheKey
c Maybe CachedDirective
d

  default cacheStore ::
    (m ~ t n, MonadTrans t, MonadExecuteQuery n) =>
    QueryCacheKey ->
    Maybe CachedDirective ->
    EncJSON ->
    TraceT (ExceptT QErr m) CacheStoreResponse
  cacheStore QueryCacheKey
a Maybe CachedDirective
b EncJSON
c = (forall a. ExceptT QErr n a -> ExceptT QErr m a)
-> TraceT (ExceptT QErr n) CacheStoreResponse
-> TraceT (ExceptT QErr m) CacheStoreResponse
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist ((forall a. n a -> t n a)
-> ExceptT QErr n a -> ExceptT QErr (t n) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. n a -> t n a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (TraceT (ExceptT QErr n) CacheStoreResponse
 -> TraceT (ExceptT QErr m) CacheStoreResponse)
-> TraceT (ExceptT QErr n) CacheStoreResponse
-> TraceT (ExceptT QErr m) CacheStoreResponse
forall a b. (a -> b) -> a -> b
$ QueryCacheKey
-> Maybe CachedDirective
-> EncJSON
-> TraceT (ExceptT QErr n) CacheStoreResponse
forall (m :: * -> *).
MonadExecuteQuery m =>
QueryCacheKey
-> Maybe CachedDirective
-> EncJSON
-> TraceT (ExceptT QErr m) CacheStoreResponse
cacheStore QueryCacheKey
a Maybe CachedDirective
b EncJSON
c

instance MonadExecuteQuery m => MonadExecuteQuery (ReaderT r m)

instance MonadExecuteQuery m => MonadExecuteQuery (ExceptT r m)

instance MonadExecuteQuery m => MonadExecuteQuery (TraceT m)

instance MonadExecuteQuery m => MonadExecuteQuery (MetadataStorageT m)

-- | A partial response, e.g. from a remote schema call or postgres
-- postgres query, which we'll assemble into the final response for
-- the client. It is annotated with timing metadata.
data AnnotatedResponsePart = AnnotatedResponsePart
  { AnnotatedResponsePart -> DiffTime
arpTimeIO :: DiffTime,
    AnnotatedResponsePart -> Locality
arpLocality :: Telem.Locality,
    AnnotatedResponsePart -> EncJSON
arpResponse :: EncJSON,
    AnnotatedResponsePart -> ResponseHeaders
arpHeaders :: HTTP.ResponseHeaders
  }

-- | A full response, annotated with timing metadata.
data AnnotatedResponse = AnnotatedResponse
  { AnnotatedResponse -> QueryType
arQueryType :: Telem.QueryType,
    AnnotatedResponse -> DiffTime
arTimeIO :: DiffTime,
    AnnotatedResponse -> Locality
arLocality :: Telem.Locality,
    AnnotatedResponse -> HttpResponse (Maybe GQResponse, EncJSON)
arResponse :: HttpResponse (Maybe GQResponse, EncJSON)
  }

-- | Merge response parts into a full response.
buildResponseFromParts ::
  (MonadError QErr m) =>
  Telem.QueryType ->
  Either (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart) ->
  HTTP.ResponseHeaders ->
  m AnnotatedResponse
buildResponseFromParts :: QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> ResponseHeaders
-> m AnnotatedResponse
buildResponseFromParts QueryType
telemType Either
  (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
partsErr ResponseHeaders
cacheHeaders =
  QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> (RootFieldMap AnnotatedResponsePart -> AnnotatedResponse)
-> m AnnotatedResponse
forall (m :: * -> *) a.
MonadError QErr m =>
QueryType
-> Either (Either GQExecError QErr) a
-> (a -> AnnotatedResponse)
-> m AnnotatedResponse
buildResponse QueryType
telemType Either
  (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
partsErr \RootFieldMap AnnotatedResponsePart
parts ->
    let responseData :: GQResponse
responseData = ByteString -> GQResponse
forall a b. b -> Either a b
Right (ByteString -> GQResponse) -> ByteString -> GQResponse
forall a b. (a -> b) -> a -> b
$ EncJSON -> ByteString
encJToLBS (EncJSON -> ByteString) -> EncJSON -> ByteString
forall a b. (a -> b) -> a -> b
$ RootFieldMap AnnotatedResponsePart -> EncJSON
encodeAnnotatedResponseParts RootFieldMap AnnotatedResponsePart
parts
     in AnnotatedResponse :: QueryType
-> DiffTime
-> Locality
-> HttpResponse (Maybe GQResponse, EncJSON)
-> AnnotatedResponse
AnnotatedResponse
          { arQueryType :: QueryType
arQueryType = QueryType
telemType,
            arTimeIO :: DiffTime
arTimeIO = InsOrdHashMap RootFieldAlias DiffTime -> DiffTime
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((AnnotatedResponsePart -> DiffTime)
-> RootFieldMap AnnotatedResponsePart
-> InsOrdHashMap RootFieldAlias DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnnotatedResponsePart -> DiffTime
arpTimeIO RootFieldMap AnnotatedResponsePart
parts),
            arLocality :: Locality
arLocality = (AnnotatedResponsePart -> Locality)
-> RootFieldMap AnnotatedResponsePart -> Locality
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap AnnotatedResponsePart -> Locality
arpLocality RootFieldMap AnnotatedResponsePart
parts,
            arResponse :: HttpResponse (Maybe GQResponse, EncJSON)
arResponse =
              (Maybe GQResponse, EncJSON)
-> ResponseHeaders -> HttpResponse (Maybe GQResponse, EncJSON)
forall a. a -> ResponseHeaders -> HttpResponse a
HttpResponse
                (GQResponse -> Maybe GQResponse
forall a. a -> Maybe a
Just GQResponse
responseData, GQResponse -> EncJSON
encodeGQResp GQResponse
responseData)
                (ResponseHeaders
cacheHeaders ResponseHeaders -> ResponseHeaders -> ResponseHeaders
forall a. Semigroup a => a -> a -> a
<> (AnnotatedResponsePart -> ResponseHeaders)
-> RootFieldMap AnnotatedResponsePart -> ResponseHeaders
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap AnnotatedResponsePart -> ResponseHeaders
arpHeaders RootFieldMap AnnotatedResponsePart
parts)
          }

buildResponse ::
  (MonadError QErr m) =>
  Telem.QueryType ->
  Either (Either GQExecError QErr) a ->
  (a -> AnnotatedResponse) ->
  m AnnotatedResponse
buildResponse :: QueryType
-> Either (Either GQExecError QErr) a
-> (a -> AnnotatedResponse)
-> m AnnotatedResponse
buildResponse QueryType
telemType Either (Either GQExecError QErr) a
res a -> AnnotatedResponse
f = case Either (Either GQExecError QErr) a
res of
  Right a
a -> AnnotatedResponse -> m AnnotatedResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponse -> m AnnotatedResponse)
-> AnnotatedResponse -> m AnnotatedResponse
forall a b. (a -> b) -> a -> b
$ a -> AnnotatedResponse
f a
a
  Left (Right QErr
err) -> QErr -> m AnnotatedResponse
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError QErr
err
  Left (Left GQExecError
err) ->
    AnnotatedResponse -> m AnnotatedResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponse -> m AnnotatedResponse)
-> AnnotatedResponse -> m AnnotatedResponse
forall a b. (a -> b) -> a -> b
$
      AnnotatedResponse :: QueryType
-> DiffTime
-> Locality
-> HttpResponse (Maybe GQResponse, EncJSON)
-> AnnotatedResponse
AnnotatedResponse
        { arQueryType :: QueryType
arQueryType = QueryType
telemType,
          arTimeIO :: DiffTime
arTimeIO = DiffTime
0,
          arLocality :: Locality
arLocality = Locality
Telem.Remote,
          arResponse :: HttpResponse (Maybe GQResponse, EncJSON)
arResponse =
            (Maybe GQResponse, EncJSON)
-> ResponseHeaders -> HttpResponse (Maybe GQResponse, EncJSON)
forall a. a -> ResponseHeaders -> HttpResponse a
HttpResponse
              (GQResponse -> Maybe GQResponse
forall a. a -> Maybe a
Just (GQExecError -> GQResponse
forall a b. a -> Either a b
Left GQExecError
err), GQResponse -> EncJSON
encodeGQResp (GQResponse -> EncJSON) -> GQResponse -> EncJSON
forall a b. (a -> b) -> a -> b
$ GQExecError -> GQResponse
forall a b. a -> Either a b
Left GQExecError
err)
              []
        }

-- | A predicate on session variables. The 'Monoid' instance makes it simple
-- to combine several predicates disjunctively.
-- | The definition includes `Maybe` which allows us to short-circuit calls like @mempty <> m@ and @m <> mempty@, which
-- otherwise might build up long repeated chains of calls to @\_ _ -> False@.
newtype SessVarPred = SessVarPred {SessVarPred
-> Maybe (SessionVariable -> SessionVariableValue -> Bool)
unSessVarPred :: Maybe (SessionVariable -> SessionVariableValue -> Bool)}
  deriving (b -> SessVarPred -> SessVarPred
NonEmpty SessVarPred -> SessVarPred
SessVarPred -> SessVarPred -> SessVarPred
(SessVarPred -> SessVarPred -> SessVarPred)
-> (NonEmpty SessVarPred -> SessVarPred)
-> (forall b. Integral b => b -> SessVarPred -> SessVarPred)
-> Semigroup SessVarPred
forall b. Integral b => b -> SessVarPred -> SessVarPred
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> SessVarPred -> SessVarPred
$cstimes :: forall b. Integral b => b -> SessVarPred -> SessVarPred
sconcat :: NonEmpty SessVarPred -> SessVarPred
$csconcat :: NonEmpty SessVarPred -> SessVarPred
<> :: SessVarPred -> SessVarPred -> SessVarPred
$c<> :: SessVarPred -> SessVarPred -> SessVarPred
Semigroup, Semigroup SessVarPred
SessVarPred
Semigroup SessVarPred
-> SessVarPred
-> (SessVarPred -> SessVarPred -> SessVarPred)
-> ([SessVarPred] -> SessVarPred)
-> Monoid SessVarPred
[SessVarPred] -> SessVarPred
SessVarPred -> SessVarPred -> SessVarPred
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [SessVarPred] -> SessVarPred
$cmconcat :: [SessVarPred] -> SessVarPred
mappend :: SessVarPred -> SessVarPred -> SessVarPred
$cmappend :: SessVarPred -> SessVarPred -> SessVarPred
mempty :: SessVarPred
$cmempty :: SessVarPred
$cp1Monoid :: Semigroup SessVarPred
Monoid) via (Maybe (SessionVariable -> SessionVariableValue -> Any))

keepAllSessionVariables :: SessVarPred
keepAllSessionVariables :: SessVarPred
keepAllSessionVariables = Maybe (SessionVariable -> SessionVariableValue -> Bool)
-> SessVarPred
SessVarPred (Maybe (SessionVariable -> SessionVariableValue -> Bool)
 -> SessVarPred)
-> Maybe (SessionVariable -> SessionVariableValue -> Bool)
-> SessVarPred
forall a b. (a -> b) -> a -> b
$ (SessionVariable -> SessionVariableValue -> Bool)
-> Maybe (SessionVariable -> SessionVariableValue -> Bool)
forall a. a -> Maybe a
Just ((SessionVariable -> SessionVariableValue -> Bool)
 -> Maybe (SessionVariable -> SessionVariableValue -> Bool))
-> (SessionVariable -> SessionVariableValue -> Bool)
-> Maybe (SessionVariable -> SessionVariableValue -> Bool)
forall a b. (a -> b) -> a -> b
$ \SessionVariable
_ SessionVariableValue
_ -> Bool
True

runSessVarPred :: SessVarPred -> SessionVariables -> SessionVariables
runSessVarPred :: SessVarPred -> SessionVariables -> SessionVariables
runSessVarPred = (SessionVariable -> SessionVariableValue -> Bool)
-> SessionVariables -> SessionVariables
filterSessionVariables ((SessionVariable -> SessionVariableValue -> Bool)
 -> SessionVariables -> SessionVariables)
-> (SessVarPred -> SessionVariable -> SessionVariableValue -> Bool)
-> SessVarPred
-> SessionVariables
-> SessionVariables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SessionVariable -> SessionVariableValue -> Bool)
-> Maybe (SessionVariable -> SessionVariableValue -> Bool)
-> SessionVariable
-> SessionVariableValue
-> Bool
forall a. a -> Maybe a -> a
fromMaybe (\SessionVariable
_ SessionVariableValue
_ -> Bool
False) (Maybe (SessionVariable -> SessionVariableValue -> Bool)
 -> SessionVariable -> SessionVariableValue -> Bool)
-> (SessVarPred
    -> Maybe (SessionVariable -> SessionVariableValue -> Bool))
-> SessVarPred
-> SessionVariable
-> SessionVariableValue
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessVarPred
-> Maybe (SessionVariable -> SessionVariableValue -> Bool)
unSessVarPred

-- | Filter out only those session variables used by the query AST provided
filterVariablesFromQuery ::
  [ RootField
      (QueryDBRoot (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
      (RemoteSchemaRootField (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
      (ActionQuery (RemoteRelationshipField UnpreparedValue))
      d
  ] ->
  SessVarPred
filterVariablesFromQuery :: [RootField
   (QueryDBRoot
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
   (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
   (ActionQuery (RemoteRelationshipField UnpreparedValue))
   d]
-> SessVarPred
filterVariablesFromQuery = (RootField
   (QueryDBRoot
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
   (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
   (ActionQuery (RemoteRelationshipField UnpreparedValue))
   d
 -> SessVarPred)
-> [RootField
      (QueryDBRoot
         (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
      (ActionQuery (RemoteRelationshipField UnpreparedValue))
      d]
-> SessVarPred
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
  RFDB SourceName
_ AnyBackend
  (SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
exists ->
    AnyBackend
  (SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> (forall (b :: BackendType).
    Backend b =>
    SourceConfigWith
      (QueryDBRoot
         (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
      b
    -> SessVarPred)
-> SessVarPred
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend
  (SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
exists \case
      SourceConfigWith SourceConfig b
_ Maybe QueryTagsConfig
_ (QDBR db) -> (RemoteRelationshipField UnpreparedValue -> SessVarPred)
-> (UnpreparedValue b -> SessVarPred)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> SessVarPred
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap RemoteRelationshipField UnpreparedValue -> SessVarPred
remoteFieldPred UnpreparedValue b -> SessVarPred
forall (bet :: BackendType). UnpreparedValue bet -> SessVarPred
toPred QueryDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
db
  RFRemote RemoteSchemaRootField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
remote -> Getting
  SessVarPred
  (RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
  SessVarPred
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> SessVarPred
forall a s. Getting a s a -> s -> a
foldOf ((RemoteSchemaVariable -> Const SessVarPred RemoteSchemaVariable)
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> Const
     SessVarPred
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((RemoteSchemaVariable -> Const SessVarPred RemoteSchemaVariable)
 -> RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> Const
      SessVarPred
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> ((SessVarPred -> Const SessVarPred SessVarPred)
    -> RemoteSchemaVariable -> Const SessVarPred RemoteSchemaVariable)
-> Getting
     SessVarPred
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
     SessVarPred
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SessionVariable -> Const SessVarPred SessionVariable)
-> RemoteSchemaVariable -> Const SessVarPred RemoteSchemaVariable
Traversal' RemoteSchemaVariable SessionVariable
_SessionPresetVariable ((SessionVariable -> Const SessVarPred SessionVariable)
 -> RemoteSchemaVariable -> Const SessVarPred RemoteSchemaVariable)
-> ((SessVarPred -> Const SessVarPred SessVarPred)
    -> SessionVariable -> Const SessVarPred SessionVariable)
-> (SessVarPred -> Const SessVarPred SessVarPred)
-> RemoteSchemaVariable
-> Const SessVarPred RemoteSchemaVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SessionVariable -> SessVarPred)
-> (SessVarPred -> Const SessVarPred SessVarPred)
-> SessionVariable
-> Const SessVarPred SessionVariable
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SessionVariable -> SessVarPred
match) RemoteSchemaRootField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
remote
  RFAction ActionQuery (RemoteRelationshipField UnpreparedValue)
actionQ -> (RemoteRelationshipField UnpreparedValue -> SessVarPred)
-> ActionQuery (RemoteRelationshipField UnpreparedValue)
-> SessVarPred
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap RemoteRelationshipField UnpreparedValue -> SessVarPred
remoteFieldPred ActionQuery (RemoteRelationshipField UnpreparedValue)
actionQ
  RFRaw {} -> SessVarPred
forall a. Monoid a => a
mempty
  RFMulti {} -> SessVarPred
forall a. Monoid a => a
mempty
  where
    _SessionPresetVariable :: Traversal' RemoteSchemaVariable SessionVariable
    _SessionPresetVariable :: (SessionVariable -> f SessionVariable)
-> RemoteSchemaVariable -> f RemoteSchemaVariable
_SessionPresetVariable SessionVariable -> f SessionVariable
f (SessionPresetVariable SessionVariable
a Name
b SessionArgumentPresetInfo
c) =
      (\SessionVariable
a' -> SessionVariable
-> Name -> SessionArgumentPresetInfo -> RemoteSchemaVariable
SessionPresetVariable SessionVariable
a' Name
b SessionArgumentPresetInfo
c) (SessionVariable -> RemoteSchemaVariable)
-> f SessionVariable -> f RemoteSchemaVariable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionVariable -> f SessionVariable
f SessionVariable
a
    _SessionPresetVariable SessionVariable -> f SessionVariable
_ RemoteSchemaVariable
x = RemoteSchemaVariable -> f RemoteSchemaVariable
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteSchemaVariable
x

    toPred :: UnpreparedValue bet -> SessVarPred
    -- if we see a reference to the whole session variables object,
    -- then we need to keep everything:
    toPred :: UnpreparedValue bet -> SessVarPred
toPred UnpreparedValue bet
UVSession = SessVarPred
keepAllSessionVariables
    -- if we only see a specific session variable, we only need to keep that one:
    toPred (UVSessionVar SessionVarType bet
_type SessionVariable
sv) = SessionVariable -> SessVarPred
match SessionVariable
sv
    toPred UnpreparedValue bet
_ = SessVarPred
forall a. Monoid a => a
mempty

    match :: SessionVariable -> SessVarPred
    match :: SessionVariable -> SessVarPred
match SessionVariable
sv = Maybe (SessionVariable -> SessionVariableValue -> Bool)
-> SessVarPred
SessVarPred (Maybe (SessionVariable -> SessionVariableValue -> Bool)
 -> SessVarPred)
-> Maybe (SessionVariable -> SessionVariableValue -> Bool)
-> SessVarPred
forall a b. (a -> b) -> a -> b
$ (SessionVariable -> SessionVariableValue -> Bool)
-> Maybe (SessionVariable -> SessionVariableValue -> Bool)
forall a. a -> Maybe a
Just ((SessionVariable -> SessionVariableValue -> Bool)
 -> Maybe (SessionVariable -> SessionVariableValue -> Bool))
-> (SessionVariable -> SessionVariableValue -> Bool)
-> Maybe (SessionVariable -> SessionVariableValue -> Bool)
forall a b. (a -> b) -> a -> b
$ \SessionVariable
sv' SessionVariableValue
_ -> SessionVariable
sv SessionVariable -> SessionVariable -> Bool
forall a. Eq a => a -> a -> Bool
== SessionVariable
sv'

    remoteFieldPred :: RemoteRelationshipField UnpreparedValue -> SessVarPred
    remoteFieldPred :: RemoteRelationshipField UnpreparedValue -> SessVarPred
remoteFieldPred = \case
      RemoteSchemaField RemoteSchemaSelect {[RemoteFieldArgument]
NonEmpty FieldCall
ResultCustomizer
RemoteSchemaInfo
SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_rselRemoteSchema :: forall r. RemoteSchemaSelect r -> RemoteSchemaInfo
_rselFieldCall :: forall r. RemoteSchemaSelect r -> NonEmpty FieldCall
_rselSelection :: forall r.
RemoteSchemaSelect r -> SelectionSet r RemoteSchemaVariable
_rselResultCustomizer :: forall r. RemoteSchemaSelect r -> ResultCustomizer
_rselArgs :: forall r. RemoteSchemaSelect r -> [RemoteFieldArgument]
_rselRemoteSchema :: RemoteSchemaInfo
_rselFieldCall :: NonEmpty FieldCall
_rselSelection :: SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_rselResultCustomizer :: ResultCustomizer
_rselArgs :: [RemoteFieldArgument]
..} ->
        Getting
  SessVarPred
  (SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
  SessVarPred
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> SessVarPred
forall a s. Getting a s a -> s -> a
foldOf ((RemoteSchemaVariable -> Const SessVarPred RemoteSchemaVariable)
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> Const
     SessVarPred
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((RemoteSchemaVariable -> Const SessVarPred RemoteSchemaVariable)
 -> SelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> Const
      SessVarPred
      (SelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> ((SessVarPred -> Const SessVarPred SessVarPred)
    -> RemoteSchemaVariable -> Const SessVarPred RemoteSchemaVariable)
-> Getting
     SessVarPred
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
     SessVarPred
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SessionVariable -> Const SessVarPred SessionVariable)
-> RemoteSchemaVariable -> Const SessVarPred RemoteSchemaVariable
Traversal' RemoteSchemaVariable SessionVariable
_SessionPresetVariable ((SessionVariable -> Const SessVarPred SessionVariable)
 -> RemoteSchemaVariable -> Const SessVarPred RemoteSchemaVariable)
-> ((SessVarPred -> Const SessVarPred SessVarPred)
    -> SessionVariable -> Const SessVarPred SessionVariable)
-> (SessVarPred -> Const SessVarPred SessVarPred)
-> RemoteSchemaVariable
-> Const SessVarPred RemoteSchemaVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SessionVariable -> SessVarPred)
-> (SessVarPred -> Const SessVarPred SessVarPred)
-> SessionVariable
-> Const SessVarPred SessionVariable
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SessionVariable -> SessVarPred
match) SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_rselSelection
      RemoteSourceField AnyBackend
  (RemoteSourceSelect
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
exists ->
        AnyBackend
  (RemoteSourceSelect
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
-> (forall (b :: BackendType).
    Backend b =>
    RemoteSourceSelect
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
    -> SessVarPred)
-> SessVarPred
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend
  (RemoteSourceSelect
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
exists \RemoteSourceSelect {HashMap FieldName (ScalarType b, Column b)
SourceName
SourceConfig b
SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
$sel:_rssJoinMapping:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt
-> HashMap FieldName (ScalarType tgt, Column tgt)
$sel:_rssSelection:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt -> SourceRelationshipSelection tgt r vf
$sel:_rssConfig:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt -> SourceConfig tgt
$sel:_rssName:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt -> SourceName
_rssJoinMapping :: HashMap FieldName (ScalarType b, Column b)
_rssSelection :: SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
_rssConfig :: SourceConfig b
_rssName :: SourceName
..} ->
          case SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
_rssSelection of
            SourceRelationshipObject AnnObjectSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
obj -> (UnpreparedValue b -> SessVarPred)
-> AnnObjectSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> SessVarPred
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap UnpreparedValue b -> SessVarPred
forall (bet :: BackendType). UnpreparedValue bet -> SessVarPred
toPred AnnObjectSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
obj
            SourceRelationshipArray AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
arr -> (UnpreparedValue b -> SessVarPred)
-> AnnSimpleSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> SessVarPred
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap UnpreparedValue b -> SessVarPred
forall (bet :: BackendType). UnpreparedValue bet -> SessVarPred
toPred AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
arr
            SourceRelationshipArrayAggregate AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
agg -> (UnpreparedValue b -> SessVarPred)
-> AnnAggregateSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> SessVarPred
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap UnpreparedValue b -> SessVarPred
forall (bet :: BackendType). UnpreparedValue bet -> SessVarPred
toPred AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
agg

-- | Run (execute) a single GraphQL query
runGQ ::
  forall m.
  ( MonadIO m,
    MonadBaseControl IO m,
    MonadError QErr m,
    MonadReader E.ExecutionCtx m,
    E.MonadGQLExecutionCheck m,
    MonadQueryLog m,
    MonadTrace m,
    MonadExecuteQuery m,
    MonadMetadataStorage (MetadataStorageT m),
    EB.MonadQueryTags m,
    HasResourceLimits m
  ) =>
  Env.Environment ->
  L.Logger L.Hasura ->
  RequestId ->
  UserInfo ->
  Wai.IpAddress ->
  [HTTP.Header] ->
  E.GraphQLQueryType ->
  GQLReqUnparsed ->
  m (GQLQueryOperationSuccessLog, HttpResponse (Maybe GQResponse, EncJSON))
runGQ :: Environment
-> Logger Hasura
-> RequestId
-> UserInfo
-> IpAddress
-> ResponseHeaders
-> GraphQLQueryType
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
runGQ Environment
env Logger Hasura
logger RequestId
reqId UserInfo
userInfo IpAddress
ipAddress ResponseHeaders
reqHeaders GraphQLQueryType
queryType GQLReqUnparsed
reqUnparsed = do
  E.ExecutionCtx Logger Hasura
_ SQLGenCtx
sqlGenCtx SchemaCache
sc SchemaCacheVer
scVer Manager
httpManager Bool
enableAL ReadOnlyMode
readOnlyMode PrometheusMetrics
prometheusMetrics <- m ExecutionCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
  let gqlMetrics :: GraphQLRequestMetrics
gqlMetrics = PrometheusMetrics -> GraphQLRequestMetrics
pmGraphQLRequestMetrics PrometheusMetrics
prometheusMetrics

  (DiffTime
totalTime, (AnnotatedResponse
response, ParameterizedQueryHash
parameterizedQueryHash, OperationType
gqlOpType)) <- m (AnnotatedResponse, ParameterizedQueryHash, OperationType)
-> m (DiffTime,
      (AnnotatedResponse, ParameterizedQueryHash, OperationType))
forall (m :: * -> *) a. MonadIO m => m a -> m (DiffTime, a)
withElapsedTime (m (AnnotatedResponse, ParameterizedQueryHash, OperationType)
 -> m (DiffTime,
       (AnnotatedResponse, ParameterizedQueryHash, OperationType)))
-> m (AnnotatedResponse, ParameterizedQueryHash, OperationType)
-> m (DiffTime,
      (AnnotatedResponse, ParameterizedQueryHash, OperationType))
forall a b. (a -> b) -> a -> b
$ do
    (GQLReqParsed
reqParsed, m AnnotatedResponse -> m AnnotatedResponse
runLimits, SingleOperation
queryParts) <- GraphQLRequestMetrics
-> Maybe OperationType
-> m (GQLReqParsed, m AnnotatedResponse -> m AnnotatedResponse,
      SingleOperation)
-> m (GQLReqParsed, m AnnotatedResponse -> m AnnotatedResponse,
      SingleOperation)
forall (n :: * -> *) e a.
(MonadIO n, MonadError e n) =>
GraphQLRequestMetrics -> Maybe OperationType -> n a -> n a
observeGQLQueryError GraphQLRequestMetrics
gqlMetrics Maybe OperationType
forall a. Maybe a
Nothing (m (GQLReqParsed, m AnnotatedResponse -> m AnnotatedResponse,
    SingleOperation)
 -> m (GQLReqParsed, m AnnotatedResponse -> m AnnotatedResponse,
       SingleOperation))
-> m (GQLReqParsed, m AnnotatedResponse -> m AnnotatedResponse,
      SingleOperation)
-> m (GQLReqParsed, m AnnotatedResponse -> m AnnotatedResponse,
      SingleOperation)
forall a b. (a -> b) -> a -> b
$ do
      -- 1. Run system authorization on the 'reqUnparsed :: GQLReqUnparsed' query.
      GQLReqParsed
reqParsed <-
        UserInfo
-> (ResponseHeaders, IpAddress)
-> Bool
-> SchemaCache
-> GQLReqUnparsed
-> RequestId
-> m (Either QErr GQLReqParsed)
forall (m :: * -> *).
MonadGQLExecutionCheck m =>
UserInfo
-> (ResponseHeaders, IpAddress)
-> Bool
-> SchemaCache
-> GQLReqUnparsed
-> RequestId
-> m (Either QErr GQLReqParsed)
E.checkGQLExecution UserInfo
userInfo (ResponseHeaders
reqHeaders, IpAddress
ipAddress) Bool
enableAL SchemaCache
sc GQLReqUnparsed
reqUnparsed RequestId
reqId
          m (Either QErr GQLReqParsed)
-> (Either QErr GQLReqParsed -> m GQLReqParsed) -> m GQLReqParsed
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either QErr GQLReqParsed
 -> (QErr -> m GQLReqParsed) -> m GQLReqParsed)
-> (QErr -> m GQLReqParsed)
-> Either QErr GQLReqParsed
-> m GQLReqParsed
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either QErr GQLReqParsed
-> (QErr -> m GQLReqParsed) -> m GQLReqParsed
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft QErr -> m GQLReqParsed
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

      UserInfo -> ApiLimit -> ResourceLimits
operationLimit <- RequestId -> m (UserInfo -> ApiLimit -> ResourceLimits)
forall (m :: * -> *).
HasResourceLimits m =>
RequestId -> m (UserInfo -> ApiLimit -> ResourceLimits)
askGraphqlOperationLimit RequestId
reqId
      let runLimits :: m AnnotatedResponse -> m AnnotatedResponse
runLimits = ResourceLimits
-> forall (m :: * -> *) a.
   (MonadBaseControl IO m, MonadError QErr m) =>
   m a -> m a
runResourceLimits (ResourceLimits
 -> forall (m :: * -> *) a.
    (MonadBaseControl IO m, MonadError QErr m) =>
    m a -> m a)
-> ResourceLimits
-> forall (m :: * -> *) a.
   (MonadBaseControl IO m, MonadError QErr m) =>
   m a -> m a
forall a b. (a -> b) -> a -> b
$ UserInfo -> ApiLimit -> ResourceLimits
operationLimit UserInfo
userInfo (SchemaCache -> ApiLimit
scApiLimits SchemaCache
sc)

      -- 2. Construct the first step of the execution plan from 'reqParsed :: GQLParsed'.
      SingleOperation
queryParts <- GQLReqParsed -> m SingleOperation
forall (m :: * -> *).
MonadError QErr m =>
GQLReqParsed -> m SingleOperation
getSingleOperation GQLReqParsed
reqParsed
      (GQLReqParsed, m AnnotatedResponse -> m AnnotatedResponse,
 SingleOperation)
-> m (GQLReqParsed, m AnnotatedResponse -> m AnnotatedResponse,
      SingleOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return (GQLReqParsed
reqParsed, m AnnotatedResponse -> m AnnotatedResponse
runLimits, SingleOperation
queryParts)

    let gqlOpType :: OperationType
gqlOpType = SingleOperation -> OperationType
forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> OperationType
G._todType SingleOperation
queryParts
    GraphQLRequestMetrics
-> Maybe OperationType
-> m (AnnotatedResponse, ParameterizedQueryHash, OperationType)
-> m (AnnotatedResponse, ParameterizedQueryHash, OperationType)
forall (n :: * -> *) e a.
(MonadIO n, MonadError e n) =>
GraphQLRequestMetrics -> Maybe OperationType -> n a -> n a
observeGQLQueryError GraphQLRequestMetrics
gqlMetrics (OperationType -> Maybe OperationType
forall a. a -> Maybe a
Just OperationType
gqlOpType) (m (AnnotatedResponse, ParameterizedQueryHash, OperationType)
 -> m (AnnotatedResponse, ParameterizedQueryHash, OperationType))
-> m (AnnotatedResponse, ParameterizedQueryHash, OperationType)
-> m (AnnotatedResponse, ParameterizedQueryHash, OperationType)
forall a b. (a -> b) -> a -> b
$ do
      -- 3. Construct the remainder of the execution plan.
      let maybeOperationName :: Maybe Name
maybeOperationName = OperationName -> Name
_unOperationName (OperationName -> Name) -> Maybe OperationName -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GQLReqParsed -> Maybe OperationName
forall a. GQLReq a -> Maybe OperationName
_grOperationName GQLReqParsed
reqParsed
      (ParameterizedQueryHash
parameterizedQueryHash, ResolvedExecutionPlan
execPlan) <-
        Environment
-> Logger Hasura
-> UserInfo
-> SQLGenCtx
-> ReadOnlyMode
-> SchemaCache
-> SchemaCacheVer
-> GraphQLQueryType
-> Manager
-> ResponseHeaders
-> GQLReqUnparsed
-> SingleOperation
-> Maybe Name
-> RequestId
-> m (ParameterizedQueryHash, ResolvedExecutionPlan)
forall (m :: * -> *).
(MonadError QErr m, MonadMetadataStorage (MetadataStorageT m),
 MonadIO m, MonadBaseControl IO m, MonadTrace m,
 MonadGQLExecutionCheck m, MonadQueryTags m) =>
Environment
-> Logger Hasura
-> UserInfo
-> SQLGenCtx
-> ReadOnlyMode
-> SchemaCache
-> SchemaCacheVer
-> GraphQLQueryType
-> Manager
-> ResponseHeaders
-> GQLReqUnparsed
-> SingleOperation
-> Maybe Name
-> RequestId
-> m (ParameterizedQueryHash, ResolvedExecutionPlan)
E.getResolvedExecPlan
          Environment
env
          Logger Hasura
logger
          UserInfo
userInfo
          SQLGenCtx
sqlGenCtx
          ReadOnlyMode
readOnlyMode
          SchemaCache
sc
          SchemaCacheVer
scVer
          GraphQLQueryType
queryType
          Manager
httpManager
          ResponseHeaders
reqHeaders
          GQLReqUnparsed
reqUnparsed
          SingleOperation
queryParts
          Maybe Name
maybeOperationName
          RequestId
reqId

      -- 4. Execute the execution plan producing a 'AnnotatedResponse'.
      AnnotatedResponse
response <- Manager
-> GQLReqParsed
-> (m AnnotatedResponse -> m AnnotatedResponse)
-> ResolvedExecutionPlan
-> m AnnotatedResponse
executePlan Manager
httpManager GQLReqParsed
reqParsed m AnnotatedResponse -> m AnnotatedResponse
runLimits ResolvedExecutionPlan
execPlan
      (AnnotatedResponse, ParameterizedQueryHash, OperationType)
-> m (AnnotatedResponse, ParameterizedQueryHash, OperationType)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnotatedResponse
response, ParameterizedQueryHash
parameterizedQueryHash, OperationType
gqlOpType)

  -- 5. Record telemetry
  DiffTime -> AnnotatedResponse -> m ()
recordTimings DiffTime
totalTime AnnotatedResponse
response

  -- 6. Record Prometheus metrics (query successes)
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ GraphQLRequestMetrics -> DiffTime -> OperationType -> IO ()
recordGQLQuerySuccess GraphQLRequestMetrics
gqlMetrics DiffTime
totalTime OperationType
gqlOpType

  -- 7. Return the response along with logging metadata.
  let requestSize :: Int64
requestSize = ByteString -> Int64
LBS.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode GQLReqUnparsed
reqUnparsed
      responseSize :: Int64
responseSize = ByteString -> Int64
LBS.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ EncJSON -> ByteString
encJToLBS (EncJSON -> ByteString) -> EncJSON -> ByteString
forall a b. (a -> b) -> a -> b
$ (Maybe GQResponse, EncJSON) -> EncJSON
forall a b. (a, b) -> b
snd ((Maybe GQResponse, EncJSON) -> EncJSON)
-> (Maybe GQResponse, EncJSON) -> EncJSON
forall a b. (a -> b) -> a -> b
$ HttpResponse (Maybe GQResponse, EncJSON)
-> (Maybe GQResponse, EncJSON)
forall a. HttpResponse a -> a
_hrBody (HttpResponse (Maybe GQResponse, EncJSON)
 -> (Maybe GQResponse, EncJSON))
-> HttpResponse (Maybe GQResponse, EncJSON)
-> (Maybe GQResponse, EncJSON)
forall a b. (a -> b) -> a -> b
$ AnnotatedResponse -> HttpResponse (Maybe GQResponse, EncJSON)
arResponse (AnnotatedResponse -> HttpResponse (Maybe GQResponse, EncJSON))
-> AnnotatedResponse -> HttpResponse (Maybe GQResponse, EncJSON)
forall a b. (a -> b) -> a -> b
$ AnnotatedResponse
response
  (GQLQueryOperationSuccessLog,
 HttpResponse (Maybe GQResponse, EncJSON))
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( GQLReqUnparsed
-> DiffTime
-> Int64
-> Int64
-> ParameterizedQueryHash
-> GQLQueryOperationSuccessLog
GQLQueryOperationSuccessLog GQLReqUnparsed
reqUnparsed DiffTime
totalTime Int64
responseSize Int64
requestSize ParameterizedQueryHash
parameterizedQueryHash,
      AnnotatedResponse -> HttpResponse (Maybe GQResponse, EncJSON)
arResponse AnnotatedResponse
response
    )
  where
    doQErr :: ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
    doQErr :: ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
doQErr = (QErr -> Either GQExecError QErr)
-> ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT QErr -> Either GQExecError QErr
forall a b. b -> Either a b
Right

    forWithKey :: InsOrdHashMap k a
-> (k -> a -> ExceptT (Either GQExecError QErr) m b)
-> ExceptT (Either GQExecError QErr) m (InsOrdHashMap k b)
forWithKey = ((k -> a -> ExceptT (Either GQExecError QErr) m b)
 -> InsOrdHashMap k a
 -> ExceptT (Either GQExecError QErr) m (InsOrdHashMap k b))
-> InsOrdHashMap k a
-> (k -> a -> ExceptT (Either GQExecError QErr) m b)
-> ExceptT (Either GQExecError QErr) m (InsOrdHashMap k b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> a -> ExceptT (Either GQExecError QErr) m b)
-> InsOrdHashMap k a
-> ExceptT (Either GQExecError QErr) m (InsOrdHashMap k b)
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b)
OMap.traverseWithKey

    executePlan ::
      HTTP.Manager ->
      GQLReqParsed ->
      (m AnnotatedResponse -> m AnnotatedResponse) ->
      E.ResolvedExecutionPlan ->
      m AnnotatedResponse
    executePlan :: Manager
-> GQLReqParsed
-> (m AnnotatedResponse -> m AnnotatedResponse)
-> ResolvedExecutionPlan
-> m AnnotatedResponse
executePlan Manager
httpManager GQLReqParsed
reqParsed m AnnotatedResponse -> m AnnotatedResponse
runLimits ResolvedExecutionPlan
execPlan = case ResolvedExecutionPlan
execPlan of
      E.QueryExecutionPlan ExecutionPlan
queryPlans [QueryRootField UnpreparedValue]
asts DirectiveMap
dirMap -> SessionVariableValue -> m AnnotatedResponse -> m AnnotatedResponse
forall (m :: * -> *) a.
MonadTrace m =>
SessionVariableValue -> m a -> m a
trace SessionVariableValue
"Query" (m AnnotatedResponse -> m AnnotatedResponse)
-> m AnnotatedResponse -> m AnnotatedResponse
forall a b. (a -> b) -> a -> b
$ do
        -- Attempt to lookup a cached response in the query cache.
        -- 'keyedLookup' is a monadic action possibly returning a cache hit.
        -- 'keyedStore' is a function to write a new response to the cache.
        let (m (ResponseHeaders, Maybe EncJSON)
keyedLookup, EncJSON -> m CacheStoreResponse
keyedStore) = GQLReqParsed
-> ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> DirectiveMap
-> (m (ResponseHeaders, Maybe EncJSON),
    EncJSON -> m CacheStoreResponse)
cacheAccess GQLReqParsed
reqParsed ExecutionPlan
queryPlans [QueryRootField UnpreparedValue]
asts DirectiveMap
dirMap
        (ResponseHeaders
cachingHeaders, Maybe EncJSON
cachedValue) <- m (ResponseHeaders, Maybe EncJSON)
keyedLookup
        case (EncJSON -> (Maybe GQResponse, EncJSON))
-> Maybe EncJSON -> Maybe (Maybe GQResponse, EncJSON)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EncJSON -> (Maybe GQResponse, EncJSON)
decodeGQResp Maybe EncJSON
cachedValue of
          -- If we get a cache hit, annotate the response with metadata and return it.
          Just (Maybe GQResponse, EncJSON)
cachedResponseData -> do
            Logger Hasura -> QueryLog -> m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger (QueryLog -> m ()) -> QueryLog -> m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> Maybe (RootFieldAlias, GeneratedQuery)
-> RequestId
-> QueryLogKind
-> QueryLog
QueryLog GQLReqUnparsed
reqUnparsed Maybe (RootFieldAlias, GeneratedQuery)
forall a. Maybe a
Nothing RequestId
reqId QueryLogKind
QueryLogKindCached
            AnnotatedResponse -> m AnnotatedResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponse -> m AnnotatedResponse)
-> AnnotatedResponse -> m AnnotatedResponse
forall a b. (a -> b) -> a -> b
$
              AnnotatedResponse :: QueryType
-> DiffTime
-> Locality
-> HttpResponse (Maybe GQResponse, EncJSON)
-> AnnotatedResponse
AnnotatedResponse
                { arQueryType :: QueryType
arQueryType = QueryType
Telem.Query,
                  arTimeIO :: DiffTime
arTimeIO = DiffTime
0,
                  arLocality :: Locality
arLocality = Locality
Telem.Local,
                  arResponse :: HttpResponse (Maybe GQResponse, EncJSON)
arResponse = (Maybe GQResponse, EncJSON)
-> ResponseHeaders -> HttpResponse (Maybe GQResponse, EncJSON)
forall a. a -> ResponseHeaders -> HttpResponse a
HttpResponse (Maybe GQResponse, EncJSON)
cachedResponseData ResponseHeaders
cachingHeaders
                }
          -- If we get a cache miss, we must run the query against the graphql engine.
          Maybe (Maybe GQResponse, EncJSON)
Nothing -> m AnnotatedResponse -> m AnnotatedResponse
runLimits (m AnnotatedResponse -> m AnnotatedResponse)
-> m AnnotatedResponse -> m AnnotatedResponse
forall a b. (a -> b) -> a -> b
$ do
            -- 1. 'traverse' the 'ExecutionPlan' executing every step.
            Either
  (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
conclusion <- ExceptT
  (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart)
-> m (Either
        (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart)
 -> m (Either
         (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)))
-> ExceptT
     (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart)
-> m (Either
        (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart))
forall a b. (a -> b) -> a -> b
$ ExecutionPlan
-> (RootFieldAlias
    -> ExecutionStep
    -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> ExceptT
     (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart)
forall k a b.
InsOrdHashMap k a
-> (k -> a -> ExceptT (Either GQExecError QErr) m b)
-> ExceptT (Either GQExecError QErr) m (InsOrdHashMap k b)
forWithKey ExecutionPlan
queryPlans ((RootFieldAlias
  -> ExecutionStep
  -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
 -> ExceptT
      (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart))
-> (RootFieldAlias
    -> ExecutionStep
    -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> ExceptT
     (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart)
forall a b. (a -> b) -> a -> b
$ Manager
-> RootFieldAlias
-> ExecutionStep
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
executeQueryStep Manager
httpManager
            -- 2. Construct an 'AnnotatedResponse' from the results of all steps in the 'ExecutionPlan'.
            AnnotatedResponse
result <- QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> ResponseHeaders
-> m AnnotatedResponse
forall (m :: * -> *).
MonadError QErr m =>
QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> ResponseHeaders
-> m AnnotatedResponse
buildResponseFromParts QueryType
Telem.Query Either
  (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
conclusion ResponseHeaders
cachingHeaders
            let response :: HttpResponse (Maybe GQResponse, EncJSON)
response@(HttpResponse (Maybe GQResponse, EncJSON)
responseData ResponseHeaders
_) = AnnotatedResponse -> HttpResponse (Maybe GQResponse, EncJSON)
arResponse AnnotatedResponse
result
            -- 3. Cache the 'AnnotatedResponse'.
            CacheStoreResponse
cacheStoreRes <- EncJSON -> m CacheStoreResponse
keyedStore ((Maybe GQResponse, EncJSON) -> EncJSON
forall a b. (a, b) -> b
snd (Maybe GQResponse, EncJSON)
responseData)
            let headers :: ResponseHeaders
headers = case CacheStoreResponse
cacheStoreRes of
                  -- Note: Warning header format: "Warning: <warn-code> <warn-agent> <warn-text> [warn-date]"
                  -- See: https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Warning
                  Right CacheStoreSuccess
_ -> []
                  (Left CacheStoreFailure
CacheStoreLimitReached) -> [(HeaderName
"warning", ByteString
"199 - cache-store-size-limit-exceeded")]
                  (Left CacheStoreFailure
CacheStoreNotEnoughCapacity) -> [(HeaderName
"warning", ByteString
"199 - cache-store-capacity-exceeded")]
                  (Left (CacheStoreBackendError String
_)) -> [(HeaderName
"warning", ByteString
"199 - cache-store-error")]
             in -- 4. Return the response.
                AnnotatedResponse -> m AnnotatedResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponse -> m AnnotatedResponse)
-> AnnotatedResponse -> m AnnotatedResponse
forall a b. (a -> b) -> a -> b
$ AnnotatedResponse
result {arResponse :: HttpResponse (Maybe GQResponse, EncJSON)
arResponse = ResponseHeaders
-> HttpResponse (Maybe GQResponse, EncJSON)
-> HttpResponse (Maybe GQResponse, EncJSON)
forall a. ResponseHeaders -> HttpResponse a -> HttpResponse a
addHttpResponseHeaders ResponseHeaders
headers HttpResponse (Maybe GQResponse, EncJSON)
response}
      E.MutationExecutionPlan ExecutionPlan
mutationPlans -> m AnnotatedResponse -> m AnnotatedResponse
runLimits (m AnnotatedResponse -> m AnnotatedResponse)
-> m AnnotatedResponse -> m AnnotatedResponse
forall a b. (a -> b) -> a -> b
$ do
        {- Note [Backwards-compatible transaction optimisation]

           For backwards compatibility, we perform the following optimisation: if all mutation steps
           are going to the same source, and that source is Postgres, we group all mutations as a
           transaction. This is a somewhat dangerous beaviour, and we would prefer, in the future,
           to make transactionality explicit rather than implicit and context-dependent.
        -}
        case ExecutionPlan
-> Maybe
     (SourceConfig ('Postgres 'Vanilla),
      InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla)))
coalescePostgresMutations ExecutionPlan
mutationPlans of
          -- we are in the aforementioned case; we circumvent the normal process
          Just (SourceConfig ('Postgres 'Vanilla)
sourceConfig, InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla))
pgMutations) -> do
            Either (Either GQExecError QErr) (DiffTime, RootFieldMap EncJSON)
res <-
              ExceptT
  (Either GQExecError QErr) m (DiffTime, RootFieldMap EncJSON)
-> m (Either
        (Either GQExecError QErr) (DiffTime, RootFieldMap EncJSON))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (Either GQExecError QErr) m (DiffTime, RootFieldMap EncJSON)
 -> m (Either
         (Either GQExecError QErr) (DiffTime, RootFieldMap EncJSON)))
-> ExceptT
     (Either GQExecError QErr) m (DiffTime, RootFieldMap EncJSON)
-> m (Either
        (Either GQExecError QErr) (DiffTime, RootFieldMap EncJSON))
forall a b. (a -> b) -> a -> b
$
                ExceptT QErr m (DiffTime, RootFieldMap EncJSON)
-> ExceptT
     (Either GQExecError QErr) m (DiffTime, RootFieldMap EncJSON)
forall a. ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
doQErr (ExceptT QErr m (DiffTime, RootFieldMap EncJSON)
 -> ExceptT
      (Either GQExecError QErr) m (DiffTime, RootFieldMap EncJSON))
-> ExceptT QErr m (DiffTime, RootFieldMap EncJSON)
-> ExceptT
     (Either GQExecError QErr) m (DiffTime, RootFieldMap EncJSON)
forall a b. (a -> b) -> a -> b
$
                  RequestId
-> GQLReqUnparsed
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres 'Vanilla)
-> InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla))
-> ExceptT QErr m (DiffTime, RootFieldMap EncJSON)
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadIO m, MonadError QErr m, MonadQueryLog m, MonadTrace m) =>
RequestId
-> GQLReqUnparsed
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> RootFieldMap (DBStepInfo ('Postgres pgKind))
-> m (DiffTime, RootFieldMap EncJSON)
runPGMutationTransaction RequestId
reqId GQLReqUnparsed
reqUnparsed UserInfo
userInfo Logger Hasura
logger SourceConfig ('Postgres 'Vanilla)
sourceConfig InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla))
pgMutations
            -- we do not construct response parts since we have only one part
            QueryType
-> Either
     (Either GQExecError QErr) (DiffTime, RootFieldMap EncJSON)
-> ((DiffTime, RootFieldMap EncJSON) -> AnnotatedResponse)
-> m AnnotatedResponse
forall (m :: * -> *) a.
MonadError QErr m =>
QueryType
-> Either (Either GQExecError QErr) a
-> (a -> AnnotatedResponse)
-> m AnnotatedResponse
buildResponse QueryType
Telem.Mutation Either (Either GQExecError QErr) (DiffTime, RootFieldMap EncJSON)
res \(DiffTime
telemTimeIO_DT, RootFieldMap EncJSON
parts) ->
              let responseData :: GQResponse
responseData = ByteString -> GQResponse
forall a b. b -> Either a b
Right (ByteString -> GQResponse) -> ByteString -> GQResponse
forall a b. (a -> b) -> a -> b
$ EncJSON -> ByteString
encJToLBS (EncJSON -> ByteString) -> EncJSON -> ByteString
forall a b. (a -> b) -> a -> b
$ RootFieldMap EncJSON -> EncJSON
encodeEncJSONResults RootFieldMap EncJSON
parts
               in AnnotatedResponse :: QueryType
-> DiffTime
-> Locality
-> HttpResponse (Maybe GQResponse, EncJSON)
-> AnnotatedResponse
AnnotatedResponse
                    { arQueryType :: QueryType
arQueryType = QueryType
Telem.Mutation,
                      arTimeIO :: DiffTime
arTimeIO = DiffTime
telemTimeIO_DT,
                      arLocality :: Locality
arLocality = Locality
Telem.Local,
                      arResponse :: HttpResponse (Maybe GQResponse, EncJSON)
arResponse =
                        (Maybe GQResponse, EncJSON)
-> ResponseHeaders -> HttpResponse (Maybe GQResponse, EncJSON)
forall a. a -> ResponseHeaders -> HttpResponse a
HttpResponse
                          (GQResponse -> Maybe GQResponse
forall a. a -> Maybe a
Just GQResponse
responseData, GQResponse -> EncJSON
encodeGQResp GQResponse
responseData)
                          []
                    }

          -- we are not in the transaction case; proceeding normally
          Maybe
  (SourceConfig ('Postgres 'Vanilla),
   InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla)))
Nothing -> do
            Either
  (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
conclusion <- ExceptT
  (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart)
-> m (Either
        (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart)
 -> m (Either
         (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)))
-> ExceptT
     (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart)
-> m (Either
        (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart))
forall a b. (a -> b) -> a -> b
$ ExecutionPlan
-> (RootFieldAlias
    -> ExecutionStep
    -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> ExceptT
     (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart)
forall k a b.
InsOrdHashMap k a
-> (k -> a -> ExceptT (Either GQExecError QErr) m b)
-> ExceptT (Either GQExecError QErr) m (InsOrdHashMap k b)
forWithKey ExecutionPlan
mutationPlans ((RootFieldAlias
  -> ExecutionStep
  -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
 -> ExceptT
      (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart))
-> (RootFieldAlias
    -> ExecutionStep
    -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> ExceptT
     (Either GQExecError QErr) m (RootFieldMap AnnotatedResponsePart)
forall a b. (a -> b) -> a -> b
$ Manager
-> RootFieldAlias
-> ExecutionStep
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
executeMutationStep Manager
httpManager
            QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> ResponseHeaders
-> m AnnotatedResponse
forall (m :: * -> *).
MonadError QErr m =>
QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> ResponseHeaders
-> m AnnotatedResponse
buildResponseFromParts QueryType
Telem.Mutation Either
  (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
conclusion []
      E.SubscriptionExecutionPlan SubscriptionExecution
_sub ->
        Code -> SessionVariableValue -> m AnnotatedResponse
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400 Code
UnexpectedPayload SessionVariableValue
"subscriptions are not supported over HTTP, use websockets instead"

    executeQueryStep ::
      HTTP.Manager ->
      RootFieldAlias ->
      EB.ExecutionStep ->
      ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
    executeQueryStep :: Manager
-> RootFieldAlias
-> ExecutionStep
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
executeQueryStep Manager
httpManager RootFieldAlias
fieldName = \case
      E.ExecStepDB ResponseHeaders
_headers AnyBackend DBStepInfo
exists Maybe RemoteJoins
remoteJoins -> ExceptT QErr m AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a. ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
doQErr (ExceptT QErr m AnnotatedResponsePart
 -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> ExceptT QErr m AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ do
        (DiffTime
telemTimeIO_DT, EncJSON
resp) <-
          AnyBackend DBStepInfo
-> (forall (b :: BackendType).
    BackendTransport b =>
    DBStepInfo b -> ExceptT QErr m (DiffTime, EncJSON))
-> ExceptT QErr m (DiffTime, EncJSON)
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @BackendTransport
            AnyBackend DBStepInfo
exists
            \(EB.DBStepInfo SourceName
_ SourceConfig b
sourceConfig Maybe (PreparedQuery b)
genSql ExecutionMonad b EncJSON
tx :: EB.DBStepInfo b) ->
              RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig b
-> ExecutionMonad b EncJSON
-> Maybe (PreparedQuery b)
-> ExceptT QErr m (DiffTime, EncJSON)
forall (b :: BackendType) (m :: * -> *).
(BackendTransport b, MonadIO m, MonadError QErr m, MonadQueryLog m,
 MonadTrace m) =>
RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig b
-> ExecutionMonad b EncJSON
-> Maybe (PreparedQuery b)
-> m (DiffTime, EncJSON)
runDBQuery @b RequestId
reqId GQLReqUnparsed
reqUnparsed RootFieldAlias
fieldName UserInfo
userInfo Logger Hasura
logger SourceConfig b
sourceConfig ExecutionMonad b EncJSON
tx Maybe (PreparedQuery b)
genSql
        EncJSON
finalResponse <-
          RequestId
-> Logger Hasura
-> Environment
-> Manager
-> ResponseHeaders
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> ExceptT QErr m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadQueryTags m, MonadQueryLog m,
 MonadTrace m) =>
RequestId
-> Logger Hasura
-> Environment
-> Manager
-> ResponseHeaders
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
RJ.processRemoteJoins RequestId
reqId Logger Hasura
logger Environment
env Manager
httpManager ResponseHeaders
reqHeaders UserInfo
userInfo EncJSON
resp Maybe RemoteJoins
remoteJoins GQLReqUnparsed
reqUnparsed
        AnnotatedResponsePart -> ExceptT QErr m AnnotatedResponsePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponsePart -> ExceptT QErr m AnnotatedResponsePart)
-> AnnotatedResponsePart -> ExceptT QErr m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ DiffTime
-> Locality -> EncJSON -> ResponseHeaders -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
telemTimeIO_DT Locality
Telem.Local EncJSON
finalResponse []
      E.ExecStepRemote RemoteSchemaInfo
rsi ResultCustomizer
resultCustomizer GQLReqOutgoing
gqlReq Maybe RemoteJoins
remoteJoins -> do
        Logger Hasura -> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger (QueryLog -> ExceptT (Either GQExecError QErr) m ())
-> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> Maybe (RootFieldAlias, GeneratedQuery)
-> RequestId
-> QueryLogKind
-> QueryLog
QueryLog GQLReqUnparsed
reqUnparsed Maybe (RootFieldAlias, GeneratedQuery)
forall a. Maybe a
Nothing RequestId
reqId QueryLogKind
QueryLogKindRemoteSchema
        Manager
-> RootFieldAlias
-> RemoteSchemaInfo
-> ResultCustomizer
-> GQLReqOutgoing
-> Maybe RemoteJoins
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
runRemoteGQ Manager
httpManager RootFieldAlias
fieldName RemoteSchemaInfo
rsi ResultCustomizer
resultCustomizer GQLReqOutgoing
gqlReq Maybe RemoteJoins
remoteJoins
      E.ExecStepAction ActionExecutionPlan
aep ActionsInfo
_ Maybe RemoteJoins
remoteJoins -> do
        Logger Hasura -> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger (QueryLog -> ExceptT (Either GQExecError QErr) m ())
-> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> Maybe (RootFieldAlias, GeneratedQuery)
-> RequestId
-> QueryLogKind
-> QueryLog
QueryLog GQLReqUnparsed
reqUnparsed Maybe (RootFieldAlias, GeneratedQuery)
forall a. Maybe a
Nothing RequestId
reqId QueryLogKind
QueryLogKindAction
        (DiffTime
time, EncJSON
resp) <- ExceptT QErr m (DiffTime, EncJSON)
-> ExceptT (Either GQExecError QErr) m (DiffTime, EncJSON)
forall a. ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
doQErr (ExceptT QErr m (DiffTime, EncJSON)
 -> ExceptT (Either GQExecError QErr) m (DiffTime, EncJSON))
-> ExceptT QErr m (DiffTime, EncJSON)
-> ExceptT (Either GQExecError QErr) m (DiffTime, EncJSON)
forall a b. (a -> b) -> a -> b
$ do
          (DiffTime
time, (EncJSON
resp, Maybe ResponseHeaders
_)) <- UserInfo
-> ActionExecutionPlan
-> ExceptT QErr m (DiffTime, (EncJSON, Maybe ResponseHeaders))
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m,
 MonadMetadataStorage (MetadataStorageT m)) =>
UserInfo
-> ActionExecutionPlan
-> m (DiffTime, (EncJSON, Maybe ResponseHeaders))
EA.runActionExecution UserInfo
userInfo ActionExecutionPlan
aep
          EncJSON
finalResponse <-
            RequestId
-> Logger Hasura
-> Environment
-> Manager
-> ResponseHeaders
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> ExceptT QErr m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadQueryTags m, MonadQueryLog m,
 MonadTrace m) =>
RequestId
-> Logger Hasura
-> Environment
-> Manager
-> ResponseHeaders
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
RJ.processRemoteJoins RequestId
reqId Logger Hasura
logger Environment
env Manager
httpManager ResponseHeaders
reqHeaders UserInfo
userInfo EncJSON
resp Maybe RemoteJoins
remoteJoins GQLReqUnparsed
reqUnparsed
          (DiffTime, EncJSON) -> ExceptT QErr m (DiffTime, EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiffTime
time, EncJSON
finalResponse)
        AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponsePart
 -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ DiffTime
-> Locality -> EncJSON -> ResponseHeaders -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
time Locality
Telem.Empty EncJSON
resp []
      E.ExecStepRaw Value
json -> do
        Logger Hasura -> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger (QueryLog -> ExceptT (Either GQExecError QErr) m ())
-> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> Maybe (RootFieldAlias, GeneratedQuery)
-> RequestId
-> QueryLogKind
-> QueryLog
QueryLog GQLReqUnparsed
reqUnparsed Maybe (RootFieldAlias, GeneratedQuery)
forall a. Maybe a
Nothing RequestId
reqId QueryLogKind
QueryLogKindIntrospection
        Value -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall (m :: * -> *).
Applicative m =>
Value -> m AnnotatedResponsePart
buildRaw Value
json
      -- For `ExecStepMulti`, execute all steps and then concat them in a list
      E.ExecStepMulti [ExecutionStep]
lst -> do
        [AnnotatedResponsePart]
_all <- (ExecutionStep
 -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> [ExecutionStep]
-> ExceptT (Either GQExecError QErr) m [AnnotatedResponsePart]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Manager
-> RootFieldAlias
-> ExecutionStep
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
executeQueryStep Manager
httpManager RootFieldAlias
fieldName) [ExecutionStep]
lst
        AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponsePart
 -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ DiffTime
-> Locality -> EncJSON -> ResponseHeaders -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
0 Locality
Telem.Local ([EncJSON] -> EncJSON
encJFromList ((AnnotatedResponsePart -> EncJSON)
-> [AnnotatedResponsePart] -> [EncJSON]
forall a b. (a -> b) -> [a] -> [b]
map AnnotatedResponsePart -> EncJSON
arpResponse [AnnotatedResponsePart]
_all)) []

    executeMutationStep ::
      HTTP.Manager ->
      RootFieldAlias ->
      EB.ExecutionStep ->
      ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
    executeMutationStep :: Manager
-> RootFieldAlias
-> ExecutionStep
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
executeMutationStep Manager
httpManager RootFieldAlias
fieldName = \case
      E.ExecStepDB ResponseHeaders
responseHeaders AnyBackend DBStepInfo
exists Maybe RemoteJoins
remoteJoins -> ExceptT QErr m AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a. ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
doQErr (ExceptT QErr m AnnotatedResponsePart
 -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> ExceptT QErr m AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ do
        (DiffTime
telemTimeIO_DT, EncJSON
resp) <-
          AnyBackend DBStepInfo
-> (forall (b :: BackendType).
    BackendTransport b =>
    DBStepInfo b -> ExceptT QErr m (DiffTime, EncJSON))
-> ExceptT QErr m (DiffTime, EncJSON)
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @BackendTransport
            AnyBackend DBStepInfo
exists
            \(EB.DBStepInfo SourceName
_ SourceConfig b
sourceConfig Maybe (PreparedQuery b)
genSql ExecutionMonad b EncJSON
tx :: EB.DBStepInfo b) ->
              RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig b
-> ExecutionMonad b EncJSON
-> Maybe (PreparedQuery b)
-> ExceptT QErr m (DiffTime, EncJSON)
forall (b :: BackendType) (m :: * -> *).
(BackendTransport b, MonadIO m, MonadError QErr m, MonadQueryLog m,
 MonadTrace m) =>
RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig b
-> ExecutionMonad b EncJSON
-> Maybe (PreparedQuery b)
-> m (DiffTime, EncJSON)
runDBMutation @b RequestId
reqId GQLReqUnparsed
reqUnparsed RootFieldAlias
fieldName UserInfo
userInfo Logger Hasura
logger SourceConfig b
sourceConfig ExecutionMonad b EncJSON
tx Maybe (PreparedQuery b)
genSql
        EncJSON
finalResponse <-
          RequestId
-> Logger Hasura
-> Environment
-> Manager
-> ResponseHeaders
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> ExceptT QErr m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadQueryTags m, MonadQueryLog m,
 MonadTrace m) =>
RequestId
-> Logger Hasura
-> Environment
-> Manager
-> ResponseHeaders
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
RJ.processRemoteJoins RequestId
reqId Logger Hasura
logger Environment
env Manager
httpManager ResponseHeaders
reqHeaders UserInfo
userInfo EncJSON
resp Maybe RemoteJoins
remoteJoins GQLReqUnparsed
reqUnparsed
        AnnotatedResponsePart -> ExceptT QErr m AnnotatedResponsePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponsePart -> ExceptT QErr m AnnotatedResponsePart)
-> AnnotatedResponsePart -> ExceptT QErr m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ DiffTime
-> Locality -> EncJSON -> ResponseHeaders -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
telemTimeIO_DT Locality
Telem.Local EncJSON
finalResponse ResponseHeaders
responseHeaders
      E.ExecStepRemote RemoteSchemaInfo
rsi ResultCustomizer
resultCustomizer GQLReqOutgoing
gqlReq Maybe RemoteJoins
remoteJoins -> do
        Logger Hasura -> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger (QueryLog -> ExceptT (Either GQExecError QErr) m ())
-> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> Maybe (RootFieldAlias, GeneratedQuery)
-> RequestId
-> QueryLogKind
-> QueryLog
QueryLog GQLReqUnparsed
reqUnparsed Maybe (RootFieldAlias, GeneratedQuery)
forall a. Maybe a
Nothing RequestId
reqId QueryLogKind
QueryLogKindRemoteSchema
        Manager
-> RootFieldAlias
-> RemoteSchemaInfo
-> ResultCustomizer
-> GQLReqOutgoing
-> Maybe RemoteJoins
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
runRemoteGQ Manager
httpManager RootFieldAlias
fieldName RemoteSchemaInfo
rsi ResultCustomizer
resultCustomizer GQLReqOutgoing
gqlReq Maybe RemoteJoins
remoteJoins
      E.ExecStepAction ActionExecutionPlan
aep ActionsInfo
_ Maybe RemoteJoins
remoteJoins -> do
        Logger Hasura -> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger (QueryLog -> ExceptT (Either GQExecError QErr) m ())
-> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> Maybe (RootFieldAlias, GeneratedQuery)
-> RequestId
-> QueryLogKind
-> QueryLog
QueryLog GQLReqUnparsed
reqUnparsed Maybe (RootFieldAlias, GeneratedQuery)
forall a. Maybe a
Nothing RequestId
reqId QueryLogKind
QueryLogKindAction
        (DiffTime
time, (EncJSON
resp, Maybe ResponseHeaders
hdrs)) <- ExceptT QErr m (DiffTime, (EncJSON, Maybe ResponseHeaders))
-> ExceptT
     (Either GQExecError QErr)
     m
     (DiffTime, (EncJSON, Maybe ResponseHeaders))
forall a. ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
doQErr (ExceptT QErr m (DiffTime, (EncJSON, Maybe ResponseHeaders))
 -> ExceptT
      (Either GQExecError QErr)
      m
      (DiffTime, (EncJSON, Maybe ResponseHeaders)))
-> ExceptT QErr m (DiffTime, (EncJSON, Maybe ResponseHeaders))
-> ExceptT
     (Either GQExecError QErr)
     m
     (DiffTime, (EncJSON, Maybe ResponseHeaders))
forall a b. (a -> b) -> a -> b
$ do
          (DiffTime
time, (EncJSON
resp, Maybe ResponseHeaders
hdrs)) <- UserInfo
-> ActionExecutionPlan
-> ExceptT QErr m (DiffTime, (EncJSON, Maybe ResponseHeaders))
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m,
 MonadMetadataStorage (MetadataStorageT m)) =>
UserInfo
-> ActionExecutionPlan
-> m (DiffTime, (EncJSON, Maybe ResponseHeaders))
EA.runActionExecution UserInfo
userInfo ActionExecutionPlan
aep
          EncJSON
finalResponse <-
            RequestId
-> Logger Hasura
-> Environment
-> Manager
-> ResponseHeaders
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> ExceptT QErr m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadQueryTags m, MonadQueryLog m,
 MonadTrace m) =>
RequestId
-> Logger Hasura
-> Environment
-> Manager
-> ResponseHeaders
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
RJ.processRemoteJoins RequestId
reqId Logger Hasura
logger Environment
env Manager
httpManager ResponseHeaders
reqHeaders UserInfo
userInfo EncJSON
resp Maybe RemoteJoins
remoteJoins GQLReqUnparsed
reqUnparsed
          (DiffTime, (EncJSON, Maybe ResponseHeaders))
-> ExceptT QErr m (DiffTime, (EncJSON, Maybe ResponseHeaders))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiffTime
time, (EncJSON
finalResponse, Maybe ResponseHeaders
hdrs))
        AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponsePart
 -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ DiffTime
-> Locality -> EncJSON -> ResponseHeaders -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
time Locality
Telem.Empty EncJSON
resp (ResponseHeaders -> AnnotatedResponsePart)
-> ResponseHeaders -> AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ ResponseHeaders -> Maybe ResponseHeaders -> ResponseHeaders
forall a. a -> Maybe a -> a
fromMaybe [] Maybe ResponseHeaders
hdrs
      E.ExecStepRaw Value
json -> do
        Logger Hasura -> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger (QueryLog -> ExceptT (Either GQExecError QErr) m ())
-> QueryLog -> ExceptT (Either GQExecError QErr) m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> Maybe (RootFieldAlias, GeneratedQuery)
-> RequestId
-> QueryLogKind
-> QueryLog
QueryLog GQLReqUnparsed
reqUnparsed Maybe (RootFieldAlias, GeneratedQuery)
forall a. Maybe a
Nothing RequestId
reqId QueryLogKind
QueryLogKindIntrospection
        Value -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall (m :: * -> *).
Applicative m =>
Value -> m AnnotatedResponsePart
buildRaw Value
json
      -- For `ExecStepMulti`, execute all steps and then concat them in a list
      E.ExecStepMulti [ExecutionStep]
lst -> do
        [AnnotatedResponsePart]
_all <- (ExecutionStep
 -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> [ExecutionStep]
-> ExceptT (Either GQExecError QErr) m [AnnotatedResponsePart]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Manager
-> RootFieldAlias
-> ExecutionStep
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
executeQueryStep Manager
httpManager RootFieldAlias
fieldName) [ExecutionStep]
lst
        AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponsePart
 -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ DiffTime
-> Locality -> EncJSON -> ResponseHeaders -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
0 Locality
Telem.Local ([EncJSON] -> EncJSON
encJFromList ((AnnotatedResponsePart -> EncJSON)
-> [AnnotatedResponsePart] -> [EncJSON]
forall a b. (a -> b) -> [a] -> [b]
map AnnotatedResponsePart -> EncJSON
arpResponse [AnnotatedResponsePart]
_all)) []

    runRemoteGQ :: Manager
-> RootFieldAlias
-> RemoteSchemaInfo
-> ResultCustomizer
-> GQLReqOutgoing
-> Maybe RemoteJoins
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
runRemoteGQ Manager
httpManager RootFieldAlias
fieldName RemoteSchemaInfo
rsi ResultCustomizer
resultCustomizer GQLReqOutgoing
gqlReq Maybe RemoteJoins
remoteJoins = do
      (DiffTime
telemTimeIO_DT, ResponseHeaders
remoteResponseHeaders, ByteString
resp) <-
        ExceptT QErr m (DiffTime, ResponseHeaders, ByteString)
-> ExceptT
     (Either GQExecError QErr) m (DiffTime, ResponseHeaders, ByteString)
forall a. ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
doQErr (ExceptT QErr m (DiffTime, ResponseHeaders, ByteString)
 -> ExceptT
      (Either GQExecError QErr)
      m
      (DiffTime, ResponseHeaders, ByteString))
-> ExceptT QErr m (DiffTime, ResponseHeaders, ByteString)
-> ExceptT
     (Either GQExecError QErr) m (DiffTime, ResponseHeaders, ByteString)
forall a b. (a -> b) -> a -> b
$ Environment
-> Manager
-> UserInfo
-> ResponseHeaders
-> ValidatedRemoteSchemaDef
-> GQLReqOutgoing
-> ExceptT QErr m (DiffTime, ResponseHeaders, ByteString)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadTrace m) =>
Environment
-> Manager
-> UserInfo
-> ResponseHeaders
-> ValidatedRemoteSchemaDef
-> GQLReqOutgoing
-> m (DiffTime, ResponseHeaders, ByteString)
E.execRemoteGQ Environment
env Manager
httpManager UserInfo
userInfo ResponseHeaders
reqHeaders (RemoteSchemaInfo -> ValidatedRemoteSchemaDef
rsDef RemoteSchemaInfo
rsi) GQLReqOutgoing
gqlReq
      Value
value <- RootFieldAlias
-> ResultCustomizer
-> ByteString
-> ExceptT (Either GQExecError QErr) m Value
forall (m :: * -> *).
Monad m =>
RootFieldAlias
-> ResultCustomizer
-> ByteString
-> ExceptT (Either GQExecError QErr) m Value
extractFieldFromResponse RootFieldAlias
fieldName ResultCustomizer
resultCustomizer ByteString
resp
      EncJSON
finalResponse <-
        ExceptT QErr m EncJSON
-> ExceptT (Either GQExecError QErr) m EncJSON
forall a. ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
doQErr (ExceptT QErr m EncJSON
 -> ExceptT (Either GQExecError QErr) m EncJSON)
-> ExceptT QErr m EncJSON
-> ExceptT (Either GQExecError QErr) m EncJSON
forall a b. (a -> b) -> a -> b
$
          RequestId
-> Logger Hasura
-> Environment
-> Manager
-> ResponseHeaders
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> ExceptT QErr m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadQueryTags m, MonadQueryLog m,
 MonadTrace m) =>
RequestId
-> Logger Hasura
-> Environment
-> Manager
-> ResponseHeaders
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
RJ.processRemoteJoins
            RequestId
reqId
            Logger Hasura
logger
            Environment
env
            Manager
httpManager
            ResponseHeaders
reqHeaders
            UserInfo
userInfo
            -- TODO: avoid encode and decode here
            (Value -> EncJSON
encJFromOrderedValue Value
value)
            Maybe RemoteJoins
remoteJoins
            GQLReqUnparsed
reqUnparsed
      let filteredHeaders :: ResponseHeaders
filteredHeaders = ((HeaderName, ByteString) -> Bool)
-> ResponseHeaders -> ResponseHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter ((HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"Set-Cookie") (HeaderName -> Bool)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst) ResponseHeaders
remoteResponseHeaders
      AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponsePart
 -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ DiffTime
-> Locality -> EncJSON -> ResponseHeaders -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
telemTimeIO_DT Locality
Telem.Remote EncJSON
finalResponse ResponseHeaders
filteredHeaders

    cacheAccess ::
      GQLReqParsed ->
      EB.ExecutionPlan ->
      [QueryRootField UnpreparedValue] ->
      DirectiveMap ->
      ( m (HTTP.ResponseHeaders, Maybe EncJSON),
        EncJSON -> m CacheStoreResponse
      )
    cacheAccess :: GQLReqParsed
-> ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> DirectiveMap
-> (m (ResponseHeaders, Maybe EncJSON),
    EncJSON -> m CacheStoreResponse)
cacheAccess GQLReqParsed
reqParsed ExecutionPlan
queryPlans [QueryRootField UnpreparedValue]
asts DirectiveMap
dirMap =
      let filteredSessionVars :: SessionVariables
filteredSessionVars = SessVarPred -> SessionVariables -> SessionVariables
runSessVarPred ([QueryRootField UnpreparedValue] -> SessVarPred
forall d.
[RootField
   (QueryDBRoot
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
   (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
   (ActionQuery (RemoteRelationshipField UnpreparedValue))
   d]
-> SessVarPred
filterVariablesFromQuery [QueryRootField UnpreparedValue]
asts) (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo)
          remoteSchemas :: [RemoteSchemaInfo]
remoteSchemas =
            ExecutionPlan -> [ExecutionStep]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems ExecutionPlan
queryPlans [ExecutionStep]
-> (ExecutionStep -> [RemoteSchemaInfo]) -> [RemoteSchemaInfo]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              E.ExecStepDB ResponseHeaders
_headers AnyBackend DBStepInfo
_dbAST Maybe RemoteJoins
remoteJoins -> do
                [RemoteSchemaInfo]
-> (RemoteJoins -> [RemoteSchemaInfo])
-> Maybe RemoteJoins
-> [RemoteSchemaInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((RemoteSchemaJoin -> RemoteSchemaInfo)
-> [RemoteSchemaJoin] -> [RemoteSchemaInfo]
forall a b. (a -> b) -> [a] -> [b]
map RemoteSchemaJoin -> RemoteSchemaInfo
RJ._rsjRemoteSchema ([RemoteSchemaJoin] -> [RemoteSchemaInfo])
-> (RemoteJoins -> [RemoteSchemaJoin])
-> RemoteJoins
-> [RemoteSchemaInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteJoins -> [RemoteSchemaJoin]
RJ.getRemoteSchemaJoins) Maybe RemoteJoins
remoteJoins
              ExecutionStep
_ -> []
          getExecStepActionWithActionInfo :: [ActionsInfo] -> ExecutionStep -> [ActionsInfo]
getExecStepActionWithActionInfo [ActionsInfo]
acc ExecutionStep
execStep = case ExecutionStep
execStep of
            EB.ExecStepAction ActionExecutionPlan
_ ActionsInfo
actionInfo Maybe RemoteJoins
_remoteJoins -> (ActionsInfo
actionInfo ActionsInfo -> [ActionsInfo] -> [ActionsInfo]
forall a. a -> [a] -> [a]
: [ActionsInfo]
acc)
            ExecutionStep
_ -> [ActionsInfo]
acc
          actionsInfo :: [ActionsInfo]
actionsInfo =
            ([ActionsInfo] -> ExecutionStep -> [ActionsInfo])
-> [ActionsInfo] -> [ExecutionStep] -> [ActionsInfo]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [ActionsInfo] -> ExecutionStep -> [ActionsInfo]
getExecStepActionWithActionInfo [] ([ExecutionStep] -> [ActionsInfo])
-> [ExecutionStep] -> [ActionsInfo]
forall a b. (a -> b) -> a -> b
$
              ExecutionPlan -> [ExecutionStep]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems (ExecutionPlan -> [ExecutionStep])
-> ExecutionPlan -> [ExecutionStep]
forall a b. (a -> b) -> a -> b
$
                (ExecutionStep -> Bool) -> ExecutionPlan -> ExecutionPlan
forall v k. (v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.filter
                  ( \case
                      E.ExecStepAction ActionExecutionPlan
_ ActionsInfo
_ Maybe RemoteJoins
_remoteJoins -> Bool
True
                      ExecutionStep
_ -> Bool
False
                  )
                  ExecutionPlan
queryPlans
          cacheKey :: QueryCacheKey
cacheKey = GQLReqParsed -> RoleName -> SessionVariables -> QueryCacheKey
QueryCacheKey GQLReqParsed
reqParsed (UserInfo -> RoleName
_uiRole UserInfo
userInfo) SessionVariables
filteredSessionVars
          cachedDirective :: Maybe CachedDirective
cachedDirective = Identity CachedDirective -> CachedDirective
forall a. Identity a -> a
runIdentity (Identity CachedDirective -> CachedDirective)
-> Maybe (Identity CachedDirective) -> Maybe CachedDirective
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirectiveKey CachedDirective
-> DirectiveMap -> Maybe (Identity CachedDirective)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DM.lookup DirectiveKey CachedDirective
cached DirectiveMap
dirMap
       in ( (ExceptT QErr m ((ResponseHeaders, Maybe EncJSON), TracingMetadata)
 -> m ((ResponseHeaders, Maybe EncJSON), TracingMetadata))
-> TraceT (ExceptT QErr m) (ResponseHeaders, Maybe EncJSON)
-> m (ResponseHeaders, Maybe EncJSON)
forall (n :: * -> *) (m :: * -> *) a b.
MonadTrace n =>
(m (a, TracingMetadata) -> n (b, TracingMetadata))
-> TraceT m a -> n b
Tracing.interpTraceT (m (Either QErr ((ResponseHeaders, Maybe EncJSON), TracingMetadata))
-> m ((ResponseHeaders, Maybe EncJSON), TracingMetadata)
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either
      QErr ((ResponseHeaders, Maybe EncJSON), TracingMetadata))
 -> m ((ResponseHeaders, Maybe EncJSON), TracingMetadata))
-> (ExceptT
      QErr m ((ResponseHeaders, Maybe EncJSON), TracingMetadata)
    -> m (Either
            QErr ((ResponseHeaders, Maybe EncJSON), TracingMetadata)))
-> ExceptT
     QErr m ((ResponseHeaders, Maybe EncJSON), TracingMetadata)
-> m ((ResponseHeaders, Maybe EncJSON), TracingMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT QErr m ((ResponseHeaders, Maybe EncJSON), TracingMetadata)
-> m (Either
        QErr ((ResponseHeaders, Maybe EncJSON), TracingMetadata))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT) (TraceT (ExceptT QErr m) (ResponseHeaders, Maybe EncJSON)
 -> m (ResponseHeaders, Maybe EncJSON))
-> TraceT (ExceptT QErr m) (ResponseHeaders, Maybe EncJSON)
-> m (ResponseHeaders, Maybe EncJSON)
forall a b. (a -> b) -> a -> b
$
              [RemoteSchemaInfo]
-> [ActionsInfo]
-> QueryCacheKey
-> Maybe CachedDirective
-> TraceT (ExceptT QErr m) (ResponseHeaders, Maybe EncJSON)
forall (m :: * -> *).
MonadExecuteQuery m =>
[RemoteSchemaInfo]
-> [ActionsInfo]
-> QueryCacheKey
-> Maybe CachedDirective
-> TraceT (ExceptT QErr m) (ResponseHeaders, Maybe EncJSON)
cacheLookup [RemoteSchemaInfo]
remoteSchemas [ActionsInfo]
actionsInfo QueryCacheKey
cacheKey Maybe CachedDirective
cachedDirective,
            (ExceptT QErr m (CacheStoreResponse, TracingMetadata)
 -> m (CacheStoreResponse, TracingMetadata))
-> TraceT (ExceptT QErr m) CacheStoreResponse
-> m CacheStoreResponse
forall (n :: * -> *) (m :: * -> *) a b.
MonadTrace n =>
(m (a, TracingMetadata) -> n (b, TracingMetadata))
-> TraceT m a -> n b
Tracing.interpTraceT (m (Either QErr (CacheStoreResponse, TracingMetadata))
-> m (CacheStoreResponse, TracingMetadata)
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr (CacheStoreResponse, TracingMetadata))
 -> m (CacheStoreResponse, TracingMetadata))
-> (ExceptT QErr m (CacheStoreResponse, TracingMetadata)
    -> m (Either QErr (CacheStoreResponse, TracingMetadata)))
-> ExceptT QErr m (CacheStoreResponse, TracingMetadata)
-> m (CacheStoreResponse, TracingMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT QErr m (CacheStoreResponse, TracingMetadata)
-> m (Either QErr (CacheStoreResponse, TracingMetadata))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT)
              (TraceT (ExceptT QErr m) CacheStoreResponse
 -> m CacheStoreResponse)
-> (EncJSON -> TraceT (ExceptT QErr m) CacheStoreResponse)
-> EncJSON
-> m CacheStoreResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryCacheKey
-> Maybe CachedDirective
-> EncJSON
-> TraceT (ExceptT QErr m) CacheStoreResponse
forall (m :: * -> *).
MonadExecuteQuery m =>
QueryCacheKey
-> Maybe CachedDirective
-> EncJSON
-> TraceT (ExceptT QErr m) CacheStoreResponse
cacheStore QueryCacheKey
cacheKey Maybe CachedDirective
cachedDirective
          )

    recordTimings :: DiffTime -> AnnotatedResponse -> m ()
    recordTimings :: DiffTime -> AnnotatedResponse -> m ()
recordTimings DiffTime
totalTime AnnotatedResponse
result = do
      RequestDimensions -> RequestTimings -> m ()
forall (m :: * -> *).
MonadIO m =>
RequestDimensions -> RequestTimings -> m ()
Telem.recordTimingMetric
        RequestDimensions :: QueryType -> Locality -> Transport -> RequestDimensions
Telem.RequestDimensions
          { $sel:telemTransport:RequestDimensions :: Transport
telemTransport = Transport
Telem.HTTP,
            $sel:telemQueryType:RequestDimensions :: QueryType
telemQueryType = AnnotatedResponse -> QueryType
arQueryType AnnotatedResponse
result,
            $sel:telemLocality:RequestDimensions :: Locality
telemLocality = AnnotatedResponse -> Locality
arLocality AnnotatedResponse
result
          }
        RequestTimings :: Seconds -> Seconds -> RequestTimings
Telem.RequestTimings
          { $sel:telemTimeIO:RequestTimings :: Seconds
telemTimeIO = DiffTime -> Seconds
forall x y. (Duration x, Duration y) => x -> y
convertDuration (DiffTime -> Seconds) -> DiffTime -> Seconds
forall a b. (a -> b) -> a -> b
$ AnnotatedResponse -> DiffTime
arTimeIO AnnotatedResponse
result,
            $sel:telemTimeTot:RequestTimings :: Seconds
telemTimeTot = DiffTime -> Seconds
forall x y. (Duration x, Duration y) => x -> y
convertDuration DiffTime
totalTime
          }

    -- Catch, record, and re-throw errors.
    observeGQLQueryError ::
      forall n e a.
      ( MonadIO n,
        MonadError e n
      ) =>
      GraphQLRequestMetrics ->
      Maybe G.OperationType ->
      n a ->
      n a
    observeGQLQueryError :: GraphQLRequestMetrics -> Maybe OperationType -> n a -> n a
observeGQLQueryError GraphQLRequestMetrics
gqlMetrics Maybe OperationType
mOpType n a
action =
      n (Either e a) -> (e -> n (Either e a)) -> n (Either e a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ((a -> Either e a) -> n a -> n (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either e a
forall a b. b -> Either a b
Right n a
action) (Either e a -> n (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> n (Either e a))
-> (e -> Either e a) -> e -> n (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left) n (Either e a) -> (Either e a -> n a) -> n a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right a
result ->
          a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
        Left e
err -> do
          case Maybe OperationType
mOpType of
            Maybe OperationType
Nothing ->
              IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> IO () -> n ()
forall a b. (a -> b) -> a -> b
$ Counter -> IO ()
Prometheus.Counter.inc (GraphQLRequestMetrics -> Counter
gqlRequestsUnknownFailure GraphQLRequestMetrics
gqlMetrics)
            Just OperationType
opType -> case OperationType
opType of
              OperationType
G.OperationTypeQuery ->
                IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> IO () -> n ()
forall a b. (a -> b) -> a -> b
$ Counter -> IO ()
Prometheus.Counter.inc (GraphQLRequestMetrics -> Counter
gqlRequestsQueryFailure GraphQLRequestMetrics
gqlMetrics)
              OperationType
G.OperationTypeMutation ->
                IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> IO () -> n ()
forall a b. (a -> b) -> a -> b
$ Counter -> IO ()
Prometheus.Counter.inc (GraphQLRequestMetrics -> Counter
gqlRequestsMutationFailure GraphQLRequestMetrics
gqlMetrics)
              OperationType
G.OperationTypeSubscription ->
                -- We do not collect metrics for subscriptions at the request level.
                () -> n ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          e -> n a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
err

    -- Tally and record execution times for successful GraphQL requests.
    recordGQLQuerySuccess ::
      GraphQLRequestMetrics -> DiffTime -> G.OperationType -> IO ()
    recordGQLQuerySuccess :: GraphQLRequestMetrics -> DiffTime -> OperationType -> IO ()
recordGQLQuerySuccess GraphQLRequestMetrics
gqlMetrics DiffTime
totalTime = \case
      OperationType
G.OperationTypeQuery -> IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Counter -> IO ()
Prometheus.Counter.inc (GraphQLRequestMetrics -> Counter
gqlRequestsQuerySuccess GraphQLRequestMetrics
gqlMetrics)
        Histogram -> Double -> IO ()
Prometheus.Histogram.observe (GraphQLRequestMetrics -> Histogram
gqlExecutionTimeSecondsQuery GraphQLRequestMetrics
gqlMetrics) (DiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac DiffTime
totalTime)
      OperationType
G.OperationTypeMutation -> IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Counter -> IO ()
Prometheus.Counter.inc (GraphQLRequestMetrics -> Counter
gqlRequestsMutationSuccess GraphQLRequestMetrics
gqlMetrics)
        Histogram -> Double -> IO ()
Prometheus.Histogram.observe (GraphQLRequestMetrics -> Histogram
gqlExecutionTimeSecondsMutation GraphQLRequestMetrics
gqlMetrics) (DiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac DiffTime
totalTime)
      OperationType
G.OperationTypeSubscription ->
        -- We do not collect metrics for subscriptions at the request level.
        -- Furthermore, we do not serve GraphQL subscriptions over HTTP.
        () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

coalescePostgresMutations ::
  EB.ExecutionPlan ->
  Maybe
    ( SourceConfig ('Postgres 'Vanilla),
      InsOrdHashMap RootFieldAlias (EB.DBStepInfo ('Postgres 'Vanilla))
    )
coalescePostgresMutations :: ExecutionPlan
-> Maybe
     (SourceConfig ('Postgres 'Vanilla),
      InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla)))
coalescePostgresMutations ExecutionPlan
plan = do
  -- we extract the name and config of the first mutation root, if any
  (SourceName
oneSourceName, PGSourceConfig
oneSourceConfig) <- case ExecutionPlan -> [ExecutionStep]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ExecutionPlan
plan of
    (E.ExecStepDB ResponseHeaders
_ AnyBackend DBStepInfo
exists Maybe RemoteJoins
_remoteJoins : [ExecutionStep]
_) ->
      AnyBackend DBStepInfo -> Maybe (DBStepInfo ('Postgres 'Vanilla))
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend @('Postgres 'Vanilla) AnyBackend DBStepInfo
exists Maybe (DBStepInfo ('Postgres 'Vanilla))
-> (DBStepInfo ('Postgres 'Vanilla)
    -> (SourceName, PGSourceConfig))
-> Maybe (SourceName, PGSourceConfig)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \DBStepInfo ('Postgres 'Vanilla)
dbsi ->
        ( DBStepInfo ('Postgres 'Vanilla) -> SourceName
forall (b :: BackendType). DBStepInfo b -> SourceName
EB.dbsiSourceName DBStepInfo ('Postgres 'Vanilla)
dbsi,
          DBStepInfo ('Postgres 'Vanilla)
-> SourceConfig ('Postgres 'Vanilla)
forall (b :: BackendType). DBStepInfo b -> SourceConfig b
EB.dbsiSourceConfig DBStepInfo ('Postgres 'Vanilla)
dbsi
        )
    [ExecutionStep]
_ -> Maybe (SourceName, PGSourceConfig)
forall a. Maybe a
Nothing
  -- we then test whether all mutations are going to that same first source
  -- and that it is Postgres
  InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla))
mutations <- ExecutionPlan
-> (ExecutionStep -> Maybe (DBStepInfo ('Postgres 'Vanilla)))
-> Maybe
     (InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ExecutionPlan
plan \case
    E.ExecStepDB ResponseHeaders
_ AnyBackend DBStepInfo
exists Maybe RemoteJoins
remoteJoins -> do
      DBStepInfo ('Postgres 'Vanilla)
dbStepInfo <- AnyBackend DBStepInfo -> Maybe (DBStepInfo ('Postgres 'Vanilla))
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend @('Postgres 'Vanilla) AnyBackend DBStepInfo
exists
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SourceName
oneSourceName SourceName -> SourceName -> Bool
forall a. Eq a => a -> a -> Bool
== DBStepInfo ('Postgres 'Vanilla) -> SourceName
forall (b :: BackendType). DBStepInfo b -> SourceName
EB.dbsiSourceName DBStepInfo ('Postgres 'Vanilla)
dbStepInfo Bool -> Bool -> Bool
&& Maybe RemoteJoins -> Bool
forall a. Maybe a -> Bool
isNothing Maybe RemoteJoins
remoteJoins
      DBStepInfo ('Postgres 'Vanilla)
-> Maybe (DBStepInfo ('Postgres 'Vanilla))
forall a. a -> Maybe a
Just DBStepInfo ('Postgres 'Vanilla)
dbStepInfo
    ExecutionStep
_ -> Maybe (DBStepInfo ('Postgres 'Vanilla))
forall a. Maybe a
Nothing
  (PGSourceConfig,
 InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla)))
-> Maybe
     (PGSourceConfig,
      InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla)))
forall a. a -> Maybe a
Just (PGSourceConfig
oneSourceConfig, InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla))
mutations)

data GraphQLResponse
  = GraphQLResponseErrors [J.Value]
  | GraphQLResponseData JO.Value

decodeGraphQLResponse :: LBS.ByteString -> Either Text GraphQLResponse
decodeGraphQLResponse :: ByteString -> Either SessionVariableValue GraphQLResponse
decodeGraphQLResponse ByteString
bs = do
  Value
val <- (String -> SessionVariableValue)
-> Either String Value -> Either SessionVariableValue Value
forall e1 e2 a. (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft String -> SessionVariableValue
T.pack (Either String Value -> Either SessionVariableValue Value)
-> Either String Value -> Either SessionVariableValue Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Value
JO.eitherDecode ByteString
bs
  Object
valObj <- Value -> Either SessionVariableValue Object
forall s. IsString s => Value -> Either s Object
JO.asObject Value
val
  case SessionVariableValue -> Object -> Maybe Value
JO.lookup SessionVariableValue
"errors" Object
valObj of
    Just (JO.Array Array
errs) -> GraphQLResponse -> Either SessionVariableValue GraphQLResponse
forall a b. b -> Either a b
Right (GraphQLResponse -> Either SessionVariableValue GraphQLResponse)
-> GraphQLResponse -> Either SessionVariableValue GraphQLResponse
forall a b. (a -> b) -> a -> b
$ [Value] -> GraphQLResponse
GraphQLResponseErrors (Vector Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Vector Value -> [Value]
forall a b. (a -> b) -> a -> b
$ Value -> Value
JO.fromOrdered (Value -> Value) -> Array -> Vector Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array
errs)
    Just Value
_ -> SessionVariableValue -> Either SessionVariableValue GraphQLResponse
forall a b. a -> Either a b
Left SessionVariableValue
"Invalid \"errors\" field in response from remote"
    Maybe Value
Nothing -> do
      Value
dataVal <- SessionVariableValue -> Object -> Maybe Value
JO.lookup SessionVariableValue
"data" Object
valObj Maybe Value
-> Either SessionVariableValue Value
-> Either SessionVariableValue Value
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` SessionVariableValue -> Either SessionVariableValue Value
forall a b. a -> Either a b
Left SessionVariableValue
"Missing \"data\" field in response from remote"
      GraphQLResponse -> Either SessionVariableValue GraphQLResponse
forall a b. b -> Either a b
Right (GraphQLResponse -> Either SessionVariableValue GraphQLResponse)
-> GraphQLResponse -> Either SessionVariableValue GraphQLResponse
forall a b. (a -> b) -> a -> b
$ Value -> GraphQLResponse
GraphQLResponseData Value
dataVal

extractFieldFromResponse ::
  forall m.
  Monad m =>
  RootFieldAlias ->
  ResultCustomizer ->
  LBS.ByteString ->
  ExceptT (Either GQExecError QErr) m JO.Value
extractFieldFromResponse :: RootFieldAlias
-> ResultCustomizer
-> ByteString
-> ExceptT (Either GQExecError QErr) m Value
extractFieldFromResponse RootFieldAlias
fieldName ResultCustomizer
resultCustomizer ByteString
resp = do
  let fieldName' :: SessionVariableValue
fieldName' = Name -> SessionVariableValue
G.unName (Name -> SessionVariableValue) -> Name -> SessionVariableValue
forall a b. (a -> b) -> a -> b
$ RootFieldAlias -> Name
_rfaAlias RootFieldAlias
fieldName
  Value
dataVal <-
    ResultCustomizer -> Value -> Value
applyResultCustomizer ResultCustomizer
resultCustomizer
      (Value -> Value)
-> ExceptT (Either GQExecError QErr) m Value
-> ExceptT (Either GQExecError QErr) m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        GraphQLResponse
graphQLResponse <- ByteString -> Either SessionVariableValue GraphQLResponse
decodeGraphQLResponse ByteString
resp Either SessionVariableValue GraphQLResponse
-> (SessionVariableValue
    -> ExceptT (Either GQExecError QErr) m GraphQLResponse)
-> ExceptT (Either GQExecError QErr) m GraphQLResponse
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` SessionVariableValue
-> ExceptT (Either GQExecError QErr) m GraphQLResponse
forall a a. SessionVariableValue -> ExceptT (Either a QErr) m a
do400
        case GraphQLResponse
graphQLResponse of
          GraphQLResponseErrors [Value]
errs -> [Value] -> ExceptT (Either GQExecError QErr) m Value
forall b a. [Value] -> ExceptT (Either GQExecError b) m a
doGQExecError [Value]
errs
          GraphQLResponseData Value
d -> Value -> ExceptT (Either GQExecError QErr) m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
d
  Object
dataObj <- Either SessionVariableValue Object
-> (SessionVariableValue
    -> ExceptT (Either GQExecError QErr) m Object)
-> ExceptT (Either GQExecError QErr) m Object
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft (Value -> Either SessionVariableValue Object
forall s. IsString s => Value -> Either s Object
JO.asObject Value
dataVal) SessionVariableValue -> ExceptT (Either GQExecError QErr) m Object
forall a a. SessionVariableValue -> ExceptT (Either a QErr) m a
do400
  Value
fieldVal <-
    Maybe Value
-> ExceptT (Either GQExecError QErr) m Value
-> ExceptT (Either GQExecError QErr) m Value
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (SessionVariableValue -> Object -> Maybe Value
JO.lookup SessionVariableValue
fieldName' Object
dataObj) (ExceptT (Either GQExecError QErr) m Value
 -> ExceptT (Either GQExecError QErr) m Value)
-> ExceptT (Either GQExecError QErr) m Value
-> ExceptT (Either GQExecError QErr) m Value
forall a b. (a -> b) -> a -> b
$
      SessionVariableValue -> ExceptT (Either GQExecError QErr) m Value
forall a a. SessionVariableValue -> ExceptT (Either a QErr) m a
do400 (SessionVariableValue -> ExceptT (Either GQExecError QErr) m Value)
-> SessionVariableValue
-> ExceptT (Either GQExecError QErr) m Value
forall a b. (a -> b) -> a -> b
$ SessionVariableValue
"expecting key " SessionVariableValue
-> SessionVariableValue -> SessionVariableValue
forall a. Semigroup a => a -> a -> a
<> SessionVariableValue
fieldName'
  Value -> ExceptT (Either GQExecError QErr) m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
fieldVal
  where
    do400 :: SessionVariableValue -> ExceptT (Either a QErr) m a
do400 = (QErr -> Either a QErr)
-> ExceptT QErr m a -> ExceptT (Either a QErr) m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT QErr -> Either a QErr
forall a b. b -> Either a b
Right (ExceptT QErr m a -> ExceptT (Either a QErr) m a)
-> (SessionVariableValue -> ExceptT QErr m a)
-> SessionVariableValue
-> ExceptT (Either a QErr) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> SessionVariableValue -> ExceptT QErr m a
forall (m :: * -> *) a.
QErrM m =>
Code -> SessionVariableValue -> m a
throw400 Code
RemoteSchemaError
    doGQExecError :: [Value] -> ExceptT (Either GQExecError b) m a
doGQExecError = (GQExecError -> Either GQExecError b)
-> ExceptT GQExecError m a -> ExceptT (Either GQExecError b) m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT GQExecError -> Either GQExecError b
forall a b. a -> Either a b
Left (ExceptT GQExecError m a -> ExceptT (Either GQExecError b) m a)
-> ([Value] -> ExceptT GQExecError m a)
-> [Value]
-> ExceptT (Either GQExecError b) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQExecError -> ExceptT GQExecError m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQExecError -> ExceptT GQExecError m a)
-> ([Value] -> GQExecError) -> [Value] -> ExceptT GQExecError m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> GQExecError
GQExecError

buildRaw :: Applicative m => JO.Value -> m AnnotatedResponsePart
buildRaw :: Value -> m AnnotatedResponsePart
buildRaw Value
json = do
  let obj :: EncJSON
obj = Value -> EncJSON
encJFromOrderedValue Value
json
      telemTimeIO_DT :: DiffTime
telemTimeIO_DT = DiffTime
0
  AnnotatedResponsePart -> m AnnotatedResponsePart
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedResponsePart -> m AnnotatedResponsePart)
-> AnnotatedResponsePart -> m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ DiffTime
-> Locality -> EncJSON -> ResponseHeaders -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
telemTimeIO_DT Locality
Telem.Local EncJSON
obj []

encodeAnnotatedResponseParts :: RootFieldMap AnnotatedResponsePart -> EncJSON
encodeAnnotatedResponseParts :: RootFieldMap AnnotatedResponsePart -> EncJSON
encodeAnnotatedResponseParts = RootFieldMap EncJSON -> EncJSON
encodeEncJSONResults (RootFieldMap EncJSON -> EncJSON)
-> (RootFieldMap AnnotatedResponsePart -> RootFieldMap EncJSON)
-> RootFieldMap AnnotatedResponsePart
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnnotatedResponsePart -> EncJSON)
-> RootFieldMap AnnotatedResponsePart -> RootFieldMap EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnnotatedResponsePart -> EncJSON
arpResponse

encodeEncJSONResults :: RootFieldMap EncJSON -> EncJSON
encodeEncJSONResults :: RootFieldMap EncJSON -> EncJSON
encodeEncJSONResults =
  InsOrdHashMap Name EncJSON -> EncJSON
encNameMap (InsOrdHashMap Name EncJSON -> EncJSON)
-> (RootFieldMap EncJSON -> InsOrdHashMap Name EncJSON)
-> RootFieldMap EncJSON
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamespacedField EncJSON -> EncJSON)
-> InsOrdHashMap Name (NamespacedField EncJSON)
-> InsOrdHashMap Name EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((EncJSON -> EncJSON)
-> (InsOrdHashMap Name EncJSON -> EncJSON)
-> NamespacedField EncJSON
-> EncJSON
forall a b.
(a -> b) -> (InsOrdHashMap Name a -> b) -> NamespacedField a -> b
namespacedField EncJSON -> EncJSON
forall a. a -> a
id InsOrdHashMap Name EncJSON -> EncJSON
encNameMap) (InsOrdHashMap Name (NamespacedField EncJSON)
 -> InsOrdHashMap Name EncJSON)
-> (RootFieldMap EncJSON
    -> InsOrdHashMap Name (NamespacedField EncJSON))
-> RootFieldMap EncJSON
-> InsOrdHashMap Name EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RootFieldMap EncJSON
-> InsOrdHashMap Name (NamespacedField EncJSON)
forall a. RootFieldMap a -> NamespacedFieldMap a
unflattenNamespaces
  where
    encNameMap :: InsOrdHashMap Name EncJSON -> EncJSON
encNameMap = InsOrdHashMap SessionVariableValue EncJSON -> EncJSON
encJFromInsOrdHashMap (InsOrdHashMap SessionVariableValue EncJSON -> EncJSON)
-> (InsOrdHashMap Name EncJSON
    -> InsOrdHashMap SessionVariableValue EncJSON)
-> InsOrdHashMap Name EncJSON
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> SessionVariableValue)
-> InsOrdHashMap Name EncJSON
-> InsOrdHashMap SessionVariableValue EncJSON
forall k' k v.
(Eq k', Hashable k') =>
(k -> k') -> InsOrdHashMap k v -> InsOrdHashMap k' v
OMap.mapKeys Name -> SessionVariableValue
G.unName

-- | Run (execute) a batched GraphQL query (see 'GQLBatchedReqs').
runGQBatched ::
  forall m.
  ( MonadIO m,
    MonadBaseControl IO m,
    MonadError QErr m,
    MonadReader E.ExecutionCtx m,
    E.MonadGQLExecutionCheck m,
    MonadQueryLog m,
    MonadTrace m,
    MonadExecuteQuery m,
    HttpLog m,
    MonadMetadataStorage (MetadataStorageT m),
    EB.MonadQueryTags m,
    HasResourceLimits m
  ) =>
  Env.Environment ->
  L.Logger L.Hasura ->
  RequestId ->
  ResponseInternalErrorsConfig ->
  UserInfo ->
  Wai.IpAddress ->
  [HTTP.Header] ->
  E.GraphQLQueryType ->
  -- | the batched request with unparsed GraphQL query
  GQLBatchedReqs (GQLReq GQLQueryText) ->
  m (HttpLogMetadata m, HttpResponse EncJSON)
runGQBatched :: Environment
-> Logger Hasura
-> RequestId
-> ResponseInternalErrorsConfig
-> UserInfo
-> IpAddress
-> ResponseHeaders
-> GraphQLQueryType
-> GQLBatchedReqs GQLReqUnparsed
-> m (HttpLogMetadata m, HttpResponse EncJSON)
runGQBatched Environment
env Logger Hasura
logger RequestId
reqId ResponseInternalErrorsConfig
responseErrorsConfig UserInfo
userInfo IpAddress
ipAddress ResponseHeaders
reqHdrs GraphQLQueryType
queryType GQLBatchedReqs GQLReqUnparsed
query =
  case GQLBatchedReqs GQLReqUnparsed
query of
    GQLSingleRequest GQLReqUnparsed
req -> do
      (GQLQueryOperationSuccessLog
gqlQueryOperationLog, HttpResponse (Maybe GQResponse, EncJSON)
httpResp) <- Environment
-> Logger Hasura
-> RequestId
-> UserInfo
-> IpAddress
-> ResponseHeaders
-> GraphQLQueryType
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m,
 MonadReader ExecutionCtx m, MonadGQLExecutionCheck m,
 MonadQueryLog m, MonadTrace m, MonadExecuteQuery m,
 MonadMetadataStorage (MetadataStorageT m), MonadQueryTags m,
 HasResourceLimits m) =>
Environment
-> Logger Hasura
-> RequestId
-> UserInfo
-> IpAddress
-> ResponseHeaders
-> GraphQLQueryType
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
runGQ Environment
env Logger Hasura
logger RequestId
reqId UserInfo
userInfo IpAddress
ipAddress ResponseHeaders
reqHdrs GraphQLQueryType
queryType GQLReqUnparsed
req
      let httpLoggingMetadata :: HttpLogMetadata m
httpLoggingMetadata = ParameterizedQueryHashList
-> RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> HttpLogMetadata m
forall (m :: * -> *).
HttpLog m =>
ParameterizedQueryHashList
-> RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> HttpLogMetadata m
buildHttpLogMetadata @m (ParameterizedQueryHash -> ParameterizedQueryHashList
PQHSetSingleton (GQLQueryOperationSuccessLog -> ParameterizedQueryHash
gqolParameterizedQueryHash GQLQueryOperationSuccessLog
gqlQueryOperationLog)) RequestMode
L.RequestModeSingle (GQLBatchedReqs GQLBatchQueryOperationLog
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
forall a. a -> Maybe a
Just (GQLBatchQueryOperationLog
-> GQLBatchedReqs GQLBatchQueryOperationLog
forall a. a -> GQLBatchedReqs a
GQLSingleRequest (GQLQueryOperationSuccessLog -> GQLBatchQueryOperationLog
GQLQueryOperationSuccess GQLQueryOperationSuccessLog
gqlQueryOperationLog)))
      (HttpLogMetadata m, HttpResponse EncJSON)
-> m (HttpLogMetadata m, HttpResponse EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpLogMetadata m
httpLoggingMetadata, (Maybe GQResponse, EncJSON) -> EncJSON
forall a b. (a, b) -> b
snd ((Maybe GQResponse, EncJSON) -> EncJSON)
-> HttpResponse (Maybe GQResponse, EncJSON) -> HttpResponse EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HttpResponse (Maybe GQResponse, EncJSON)
httpResp)
    GQLBatchedReqs [GQLReqUnparsed]
reqs -> do
      -- It's unclear what we should do if we receive multiple
      -- responses with distinct headers, so just do the simplest thing
      -- in this case, and don't forward any.
      let includeInternal :: Bool
includeInternal = RoleName -> ResponseInternalErrorsConfig -> Bool
shouldIncludeInternal (UserInfo -> RoleName
_uiRole UserInfo
userInfo) ResponseInternalErrorsConfig
responseErrorsConfig
          removeHeaders :: [Either QErr (HttpResponse EncJSON)] -> HttpResponse EncJSON
removeHeaders =
            (EncJSON -> ResponseHeaders -> HttpResponse EncJSON)
-> ResponseHeaders -> EncJSON -> HttpResponse EncJSON
forall a b c. (a -> b -> c) -> b -> a -> c
flip EncJSON -> ResponseHeaders -> HttpResponse EncJSON
forall a. a -> ResponseHeaders -> HttpResponse a
HttpResponse []
              (EncJSON -> HttpResponse EncJSON)
-> ([Either QErr (HttpResponse EncJSON)] -> EncJSON)
-> [Either QErr (HttpResponse EncJSON)]
-> HttpResponse EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EncJSON] -> EncJSON
encJFromList
              ([EncJSON] -> EncJSON)
-> ([Either QErr (HttpResponse EncJSON)] -> [EncJSON])
-> [Either QErr (HttpResponse EncJSON)]
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either QErr (HttpResponse EncJSON) -> EncJSON)
-> [Either QErr (HttpResponse EncJSON)] -> [EncJSON]
forall a b. (a -> b) -> [a] -> [b]
map ((QErr -> EncJSON)
-> (HttpResponse EncJSON -> EncJSON)
-> Either QErr (HttpResponse EncJSON)
-> EncJSON
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (Value -> EncJSON) -> (QErr -> Value) -> QErr -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> QErr -> Value
encodeGQErr Bool
includeInternal) HttpResponse EncJSON -> EncJSON
forall a. HttpResponse a -> a
_hrBody)
      [(GQLReqUnparsed,
  Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))]
responses <- (GQLReqUnparsed
 -> m (GQLReqUnparsed,
       Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)))
-> [GQLReqUnparsed]
-> m [(GQLReqUnparsed,
       Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\GQLReqUnparsed
req -> (Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
 -> (GQLReqUnparsed,
     Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)))
-> m (Either
        QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> m (GQLReqUnparsed,
      Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GQLReqUnparsed
req,) (m (Either
      QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
 -> m (GQLReqUnparsed,
       Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)))
-> (GQLReqUnparsed
    -> m (Either
            QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)))
-> GQLReqUnparsed
-> m (GQLReqUnparsed,
      Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
-> m (Either
        QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
forall b. m b -> m (Either QErr b)
try (m (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
 -> m (Either
         QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)))
-> (GQLReqUnparsed
    -> m (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> GQLReqUnparsed
-> m (Either
        QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((GQLQueryOperationSuccessLog,
  HttpResponse (Maybe GQResponse, EncJSON))
 -> (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
-> m (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((GQLQueryOperationSuccessLog,
   HttpResponse (Maybe GQResponse, EncJSON))
  -> (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
 -> m (GQLQueryOperationSuccessLog,
       HttpResponse (Maybe GQResponse, EncJSON))
 -> m (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> (((Maybe GQResponse, EncJSON) -> EncJSON)
    -> (GQLQueryOperationSuccessLog,
        HttpResponse (Maybe GQResponse, EncJSON))
    -> (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> ((Maybe GQResponse, EncJSON) -> EncJSON)
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
-> m (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HttpResponse (Maybe GQResponse, EncJSON) -> HttpResponse EncJSON)
-> (GQLQueryOperationSuccessLog,
    HttpResponse (Maybe GQResponse, EncJSON))
-> (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HttpResponse (Maybe GQResponse, EncJSON) -> HttpResponse EncJSON)
 -> (GQLQueryOperationSuccessLog,
     HttpResponse (Maybe GQResponse, EncJSON))
 -> (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> (((Maybe GQResponse, EncJSON) -> EncJSON)
    -> HttpResponse (Maybe GQResponse, EncJSON)
    -> HttpResponse EncJSON)
-> ((Maybe GQResponse, EncJSON) -> EncJSON)
-> (GQLQueryOperationSuccessLog,
    HttpResponse (Maybe GQResponse, EncJSON))
-> (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe GQResponse, EncJSON) -> EncJSON)
-> HttpResponse (Maybe GQResponse, EncJSON) -> HttpResponse EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Maybe GQResponse, EncJSON) -> EncJSON
forall a b. (a, b) -> b
snd (m (GQLQueryOperationSuccessLog,
    HttpResponse (Maybe GQResponse, EncJSON))
 -> m (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> (GQLReqUnparsed
    -> m (GQLQueryOperationSuccessLog,
          HttpResponse (Maybe GQResponse, EncJSON)))
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment
-> Logger Hasura
-> RequestId
-> UserInfo
-> IpAddress
-> ResponseHeaders
-> GraphQLQueryType
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m,
 MonadReader ExecutionCtx m, MonadGQLExecutionCheck m,
 MonadQueryLog m, MonadTrace m, MonadExecuteQuery m,
 MonadMetadataStorage (MetadataStorageT m), MonadQueryTags m,
 HasResourceLimits m) =>
Environment
-> Logger Hasura
-> RequestId
-> UserInfo
-> IpAddress
-> ResponseHeaders
-> GraphQLQueryType
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
runGQ Environment
env Logger Hasura
logger RequestId
reqId UserInfo
userInfo IpAddress
ipAddress ResponseHeaders
reqHdrs GraphQLQueryType
queryType (GQLReqUnparsed
 -> m (GQLReqUnparsed,
       Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)))
-> GQLReqUnparsed
-> m (GQLReqUnparsed,
      Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
req) [GQLReqUnparsed]
reqs
      let requestsOperationLogs :: [GQLQueryOperationSuccessLog]
requestsOperationLogs = ((GQLQueryOperationSuccessLog, HttpResponse EncJSON)
 -> GQLQueryOperationSuccessLog)
-> [(GQLQueryOperationSuccessLog, HttpResponse EncJSON)]
-> [GQLQueryOperationSuccessLog]
forall a b. (a -> b) -> [a] -> [b]
map (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
-> GQLQueryOperationSuccessLog
forall a b. (a, b) -> a
fst ([(GQLQueryOperationSuccessLog, HttpResponse EncJSON)]
 -> [GQLQueryOperationSuccessLog])
-> [(GQLQueryOperationSuccessLog, HttpResponse EncJSON)]
-> [GQLQueryOperationSuccessLog]
forall a b. (a -> b) -> a -> b
$ [Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)]
-> [(GQLQueryOperationSuccessLog, HttpResponse EncJSON)]
forall a b. [Either a b] -> [b]
rights ([Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)]
 -> [(GQLQueryOperationSuccessLog, HttpResponse EncJSON)])
-> [Either
      QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)]
-> [(GQLQueryOperationSuccessLog, HttpResponse EncJSON)]
forall a b. (a -> b) -> a -> b
$ ((GQLReqUnparsed,
  Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
 -> Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> [(GQLReqUnparsed,
     Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))]
-> [Either
      QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)]
forall a b. (a -> b) -> [a] -> [b]
map (GQLReqUnparsed,
 Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
forall a b. (a, b) -> b
snd [(GQLReqUnparsed,
  Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))]
responses
          batchOperationLogs :: [GQLBatchQueryOperationLog]
batchOperationLogs =
            ((GQLReqUnparsed,
  Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
 -> GQLBatchQueryOperationLog)
-> [(GQLReqUnparsed,
     Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))]
-> [GQLBatchQueryOperationLog]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \(GQLReqUnparsed
req, Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
resp) ->
                  case Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
resp of
                    Left QErr
err -> GQLQueryOperationErrorLog -> GQLBatchQueryOperationLog
GQLQueryOperationError (GQLQueryOperationErrorLog -> GQLBatchQueryOperationLog)
-> GQLQueryOperationErrorLog -> GQLBatchQueryOperationLog
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed -> QErr -> GQLQueryOperationErrorLog
GQLQueryOperationErrorLog GQLReqUnparsed
req QErr
err
                    Right (GQLQueryOperationSuccessLog
successOpLog, HttpResponse EncJSON
_) -> GQLQueryOperationSuccessLog -> GQLBatchQueryOperationLog
GQLQueryOperationSuccess GQLQueryOperationSuccessLog
successOpLog
              )
              [(GQLReqUnparsed,
  Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))]
responses
          parameterizedQueryHashes :: [ParameterizedQueryHash]
parameterizedQueryHashes = (GQLQueryOperationSuccessLog -> ParameterizedQueryHash)
-> [GQLQueryOperationSuccessLog] -> [ParameterizedQueryHash]
forall a b. (a -> b) -> [a] -> [b]
map GQLQueryOperationSuccessLog -> ParameterizedQueryHash
gqolParameterizedQueryHash [GQLQueryOperationSuccessLog]
requestsOperationLogs
          httpLoggingMetadata :: HttpLogMetadata m
httpLoggingMetadata = ParameterizedQueryHashList
-> RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> HttpLogMetadata m
forall (m :: * -> *).
HttpLog m =>
ParameterizedQueryHashList
-> RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> HttpLogMetadata m
buildHttpLogMetadata @m ([ParameterizedQueryHash] -> ParameterizedQueryHashList
PQHSetBatched [ParameterizedQueryHash]
parameterizedQueryHashes) RequestMode
L.RequestModeBatched (GQLBatchedReqs GQLBatchQueryOperationLog
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
forall a. a -> Maybe a
Just ([GQLBatchQueryOperationLog]
-> GQLBatchedReqs GQLBatchQueryOperationLog
forall a. [a] -> GQLBatchedReqs a
GQLBatchedReqs [GQLBatchQueryOperationLog]
batchOperationLogs))
      (HttpLogMetadata m, HttpResponse EncJSON)
-> m (HttpLogMetadata m, HttpResponse EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpLogMetadata m
httpLoggingMetadata, [Either QErr (HttpResponse EncJSON)] -> HttpResponse EncJSON
removeHeaders (((GQLReqUnparsed,
  Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
 -> Either QErr (HttpResponse EncJSON))
-> [(GQLReqUnparsed,
     Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))]
-> [Either QErr (HttpResponse EncJSON)]
forall a b. (a -> b) -> [a] -> [b]
map ((((GQLQueryOperationSuccessLog, HttpResponse EncJSON)
 -> HttpResponse EncJSON)
-> Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
-> Either QErr (HttpResponse EncJSON)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
-> HttpResponse EncJSON
forall a b. (a, b) -> b
snd) (Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
 -> Either QErr (HttpResponse EncJSON))
-> ((GQLReqUnparsed,
     Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
    -> Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> (GQLReqUnparsed,
    Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> Either QErr (HttpResponse EncJSON)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GQLReqUnparsed,
 Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
forall a b. (a, b) -> b
snd) [(GQLReqUnparsed,
  Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))]
responses))
  where
    try :: m b -> m (Either QErr b)
try = (m (Either QErr b)
 -> (QErr -> m (Either QErr b)) -> m (Either QErr b))
-> (QErr -> m (Either QErr b))
-> m (Either QErr b)
-> m (Either QErr b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip m (Either QErr b)
-> (QErr -> m (Either QErr b)) -> m (Either QErr b)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (Either QErr b -> m (Either QErr b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QErr b -> m (Either QErr b))
-> (QErr -> Either QErr b) -> QErr -> m (Either QErr b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QErr -> Either QErr b
forall a b. a -> Either a b
Left) (m (Either QErr b) -> m (Either QErr b))
-> (m b -> m (Either QErr b)) -> m b -> m (Either QErr b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Either QErr b) -> m b -> m (Either QErr b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either QErr b
forall a b. b -> Either a b
Right