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

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

import Control.Lens (Traversal', foldOf, to)
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 InsOrdHashMap
import Data.Monoid (Any (..))
import Data.Text qualified as T
import Data.Text.Extended ((<>>))
import Hasura.Backends.DataConnector.Agent.Client (AgentLicenseKey)
import Hasura.Backends.Postgres.Instances.Transport (runPGMutationTransaction)
import Hasura.Base.Error
import Hasura.CredentialCache
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
  ( MonadExecutionLog,
    MonadQueryLog (logQueryLog),
    QueryLog (..),
    QueryLogKind (..),
    statsToAnyBackend,
  )
import Hasura.GraphQL.Namespace
import Hasura.GraphQL.ParameterizedQueryHash
import Hasura.GraphQL.Parser.Directives hiding (cachedDirective)
import Hasura.GraphQL.Transport.Backend
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.GraphQL.Transport.Instances ()
import Hasura.HTTP
  ( HttpResponse (HttpResponse, _hrBody),
    addHttpResponseHeaders,
  )
import Hasura.Logging qualified as L
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ResultCustomization
import Hasura.RQL.Types.SchemaCache
import Hasura.RemoteSchema.SchemaCache
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Server.Init qualified as Init
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 (ReadOnlyMode (..), RequestId (..))
import Hasura.Services
import Hasura.Session (SessionVariable, SessionVariableValue, SessionVariables, UserInfo (..), filterSessionVariables)
import Hasura.Tracing (MonadTrace, attachMetadata)
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
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

-- | Encapsulates a function that stores a query response in the cache.
-- `cacheLookup` decides when such an invitation to store is generated.
newtype ResponseCacher = ResponseCacher {ResponseCacher
-> forall (m :: * -> *).
   (MonadTrace m, MonadIO m) =>
   EncJSON -> m (Either QErr CacheStoreResponse)
runStoreResponse :: forall m. (MonadTrace m, MonadIO m) => EncJSON -> m (Either QErr CacheStoreResponse)}

data CacheStoreResponse
  = -- | Cache storage is unconditional, just
    -- not always available.
    CacheStoreSuccess
  | CacheStoreLimitReached
  | CacheStoreNotEnoughCapacity
  | CacheStoreBackendError String

data CacheResult
  = -- | We have a cached response for this query
    ResponseCached EncJSON
  | -- | We don't have a cached response.  The `ResponseCacher` can be used to
    -- store the response in the cache after a fresh execution.
    ResponseUncached (Maybe ResponseCacher)

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 ::
    -- | How we _would've_ executed the query.  Ideally we'd use this as a
    -- caching key, but it's not serializable... [cont'd]
    EB.ExecutionPlan ->
    -- | Somewhat less processed plan of how we _would've_ executed the query.
    [QueryRootField UnpreparedValue] ->
    -- | `@cached` directive from the query AST
    Maybe CachedDirective ->
    -- | [cont'd] ... which is why we additionally pass serializable structures
    -- from earlier in the query processing pipeline.  This includes the query
    -- AST, which additionally specifies the `@cached` directive with TTL info...
    GQLReqParsed ->
    -- | ... and the `UserInfo`
    UserInfo ->
    -- | Used for remote schemas and actions
    [HTTP.Header] ->
    -- | Non-empty response headers instruct the client to store the response
    -- locally.
    m (Either QErr (HTTP.ResponseHeaders, CacheResult))
  default cacheLookup ::
    (m ~ t n, MonadTrans t, MonadExecuteQuery n) =>
    EB.ExecutionPlan ->
    [QueryRootField UnpreparedValue] ->
    Maybe CachedDirective ->
    GQLReqParsed ->
    UserInfo ->
    [HTTP.Header] ->
    m (Either QErr (HTTP.ResponseHeaders, CacheResult))
  cacheLookup ExecutionPlan
a [QueryRootField UnpreparedValue]
b Maybe CachedDirective
c GQLReqParsed
d UserInfo
e [Header]
f = n (Either QErr ([Header], CacheResult))
-> t n (Either QErr ([Header], CacheResult))
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n (Either QErr ([Header], CacheResult))
 -> t n (Either QErr ([Header], CacheResult)))
-> n (Either QErr ([Header], CacheResult))
-> t n (Either QErr ([Header], CacheResult))
forall a b. (a -> b) -> a -> b
$ ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> Maybe CachedDirective
-> GQLReqParsed
-> UserInfo
-> [Header]
-> n (Either QErr ([Header], CacheResult))
forall (m :: * -> *).
MonadExecuteQuery m =>
ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> Maybe CachedDirective
-> GQLReqParsed
-> UserInfo
-> [Header]
-> m (Either QErr ([Header], CacheResult))
cacheLookup ExecutionPlan
a [QueryRootField UnpreparedValue]
b Maybe CachedDirective
c GQLReqParsed
d UserInfo
e [Header]
f

instance (MonadExecuteQuery m) => MonadExecuteQuery (ReaderT r m)

instance (MonadExecuteQuery m) => MonadExecuteQuery (ExceptT e 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 -> [Header]
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) ->
  m AnnotatedResponse
buildResponseFromParts :: forall (m :: * -> *).
MonadError QErr m =>
QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> m AnnotatedResponse
buildResponseFromParts QueryType
telemType Either
  (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
partsErr =
  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
          { arQueryType :: QueryType
arQueryType = QueryType
telemType,
            arTimeIO :: DiffTime
arTimeIO = InsOrdHashMap RootFieldAlias DiffTime -> DiffTime
forall a. Num a => InsOrdHashMap RootFieldAlias a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((AnnotatedResponsePart -> DiffTime)
-> RootFieldMap AnnotatedResponsePart
-> InsOrdHashMap RootFieldAlias DiffTime
forall a b.
(a -> b)
-> InsOrdHashMap RootFieldAlias a -> InsOrdHashMap RootFieldAlias b
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 m a.
Monoid m =>
(a -> m) -> InsOrdHashMap RootFieldAlias a -> m
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)
-> [Header] -> HttpResponse (Maybe GQResponse, EncJSON)
forall a. a -> [Header] -> HttpResponse a
HttpResponse
                (GQResponse -> Maybe GQResponse
forall a. a -> Maybe a
Just GQResponse
responseData, GQResponse -> EncJSON
encodeGQResp GQResponse
responseData)
                ((AnnotatedResponsePart -> [Header])
-> RootFieldMap AnnotatedResponsePart -> [Header]
forall m a.
Monoid m =>
(a -> m) -> InsOrdHashMap RootFieldAlias a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap AnnotatedResponsePart -> [Header]
arpHeaders RootFieldMap AnnotatedResponsePart
parts)
          }

buildResponse ::
  (MonadError QErr m) =>
  Telem.QueryType ->
  Either (Either GQExecError QErr) a ->
  (a -> AnnotatedResponse) ->
  m AnnotatedResponse
buildResponse :: forall (m :: * -> *) a.
MonadError QErr m =>
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 a. a -> m a
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 a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError QErr
err
  Left (Left GQExecError
err) ->
    AnnotatedResponse -> m AnnotatedResponse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (AnnotatedResponse -> m AnnotatedResponse)
-> AnnotatedResponse -> m AnnotatedResponse
forall a b. (a -> b) -> a -> b
$ 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)
-> [Header] -> HttpResponse (Maybe GQResponse, EncJSON)
forall a. a -> [Header] -> 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 -> Text -> Bool)
unSessVarPred :: Maybe (SessionVariable -> SessionVariableValue -> Bool)}
  deriving (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
$c<> :: SessVarPred -> SessVarPred -> SessVarPred
<> :: SessVarPred -> SessVarPred -> SessVarPred
$csconcat :: NonEmpty SessVarPred -> SessVarPred
sconcat :: NonEmpty SessVarPred -> SessVarPred
$cstimes :: forall b. Integral b => b -> SessVarPred -> SessVarPred
stimes :: forall b. Integral b => b -> 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
$cmempty :: SessVarPred
mempty :: SessVarPred
$cmappend :: SessVarPred -> SessVarPred -> SessVarPred
mappend :: SessVarPred -> SessVarPred -> SessVarPred
$cmconcat :: [SessVarPred] -> SessVarPred
mconcat :: [SessVarPred] -> SessVarPred
Monoid) via (Maybe (SessionVariable -> SessionVariableValue -> Any))

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

runSessVarPred :: SessVarPred -> SessionVariables -> SessionVariables
runSessVarPred :: SessVarPred -> SessionVariables -> SessionVariables
runSessVarPred = (SessionVariable -> Text -> Bool)
-> SessionVariables -> SessionVariables
filterSessionVariables ((SessionVariable -> Text -> Bool)
 -> SessionVariables -> SessionVariables)
-> (SessVarPred -> SessionVariable -> Text -> Bool)
-> SessVarPred
-> SessionVariables
-> SessionVariables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SessionVariable -> Text -> Bool)
-> Maybe (SessionVariable -> Text -> Bool)
-> SessionVariable
-> Text
-> Bool
forall a. a -> Maybe a -> a
fromMaybe (\SessionVariable
_ Text
_ -> Bool
False) (Maybe (SessionVariable -> Text -> Bool)
 -> SessionVariable -> Text -> Bool)
-> (SessVarPred -> Maybe (SessionVariable -> Text -> Bool))
-> SessVarPred
-> SessionVariable
-> Text
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessVarPred -> Maybe (SessionVariable -> Text -> 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 :: forall d.
[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 m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
  RFDB SourceName
_ AnyBackend
  (SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
exists ->
    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 QueryDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
db) -> (RemoteRelationshipField UnpreparedValue -> SessVarPred)
-> (UnpreparedValue b -> SessVarPred)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> SessVarPred
forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> QueryDB b a b -> m
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) a
-> f (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) 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 m a. Monoid m => (a -> m) -> ActionQuery a -> m
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 :: Traversal' RemoteSchemaVariable SessionVariable
_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 a. a -> f a
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 :: forall (bet :: BackendType). 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 -> Text -> Bool) -> SessVarPred
SessVarPred (Maybe (SessionVariable -> Text -> Bool) -> SessVarPred)
-> Maybe (SessionVariable -> Text -> Bool) -> SessVarPred
forall a b. (a -> b) -> a -> b
$ (SessionVariable -> Text -> Bool)
-> Maybe (SessionVariable -> Text -> Bool)
forall a. a -> Maybe a
Just ((SessionVariable -> Text -> Bool)
 -> Maybe (SessionVariable -> Text -> Bool))
-> (SessionVariable -> Text -> Bool)
-> Maybe (SessionVariable -> Text -> Bool)
forall a b. (a -> b) -> a -> b
$ \SessionVariable
sv' Text
_ -> 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
_rselArgs :: [RemoteFieldArgument]
_rselResultCustomizer :: ResultCustomizer
_rselSelection :: SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_rselFieldCall :: NonEmpty FieldCall
_rselRemoteSchema :: RemoteSchemaInfo
_rselArgs :: forall r. RemoteSchemaSelect r -> [RemoteFieldArgument]
_rselResultCustomizer :: forall r. RemoteSchemaSelect r -> ResultCustomizer
_rselSelection :: forall r.
RemoteSchemaSelect r -> SelectionSet r RemoteSchemaVariable
_rselFieldCall :: forall r. RemoteSchemaSelect r -> NonEmpty FieldCall
_rselRemoteSchema :: forall r. RemoteSchemaSelect r -> RemoteSchemaInfo
..} ->
        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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> SelectionSet (RemoteRelationshipField UnpreparedValue) a
-> f (SelectionSet (RemoteRelationshipField UnpreparedValue) 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 ->
        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)
StringifyNumbers
SourceName
SourceConfig b
SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
_rssName :: SourceName
_rssConfig :: SourceConfig b
_rssSelection :: SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
_rssJoinMapping :: HashMap FieldName (ScalarType b, Column b)
_rssStringifyNums :: StringifyNumbers
$sel:_rssName:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt -> SourceName
$sel:_rssConfig:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt -> SourceConfig tgt
$sel:_rssSelection:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt -> SourceRelationshipSelection tgt r vf
$sel:_rssJoinMapping:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt
-> HashMap FieldName (ScalarType tgt, Column tgt)
$sel:_rssStringifyNums:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt -> StringifyNumbers
..} ->
          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 m a.
Monoid m =>
(a -> m)
-> AnnObjectSelectG b (RemoteRelationshipField UnpreparedValue) a
-> m
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 m a.
Monoid m =>
(a -> m)
-> AnnSelectG
     b (AnnFieldG b (RemoteRelationshipField UnpreparedValue)) a
-> m
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 m a.
Monoid m =>
(a -> m)
-> AnnSelectG
     b
     (TableAggregateFieldG b (RemoteRelationshipField UnpreparedValue))
     a
-> m
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,
    E.MonadGQLExecutionCheck m,
    MonadQueryLog m,
    MonadExecutionLog m,
    MonadTrace m,
    MonadExecuteQuery m,
    MonadMetadataStorage m,
    MonadQueryTags m,
    HasResourceLimits m,
    ProvidesNetwork m
  ) =>
  -- TODO: almost all of those arguments come from `AppEnv` and `HandlerCtx`
  -- (including `AppContext`). We could refactor this function to make use of
  -- `HasAppEnv` and `MonadReader HandlerCtx` if the direct dependency is ok.
  -- In turn, cleaning this list of arguments would allow for a cleanup of
  -- `runGQBatched` and `runCustomEndpoint`.
  Env.Environment ->
  SQLGenCtx ->
  SchemaCache ->
  Init.AllowListStatus ->
  ReadOnlyMode ->
  PrometheusMetrics ->
  L.Logger L.Hasura ->
  Maybe (CredentialCache AgentLicenseKey) ->
  RequestId ->
  UserInfo ->
  Wai.IpAddress ->
  [HTTP.Header] ->
  E.GraphQLQueryType ->
  GQLReqUnparsed ->
  m (GQLQueryOperationSuccessLog, HttpResponse (Maybe GQResponse, EncJSON))
runGQ :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m,
 MonadGQLExecutionCheck m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m, MonadExecuteQuery m, MonadMetadataStorage m,
 MonadQueryTags m, HasResourceLimits m, ProvidesNetwork m) =>
Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> UserInfo
-> IpAddress
-> [Header]
-> GraphQLQueryType
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
runGQ Environment
env SQLGenCtx
sqlGenCtx SchemaCache
sc AllowListStatus
enableAL ReadOnlyMode
readOnlyMode PrometheusMetrics
prometheusMetrics Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey RequestId
reqId UserInfo
userInfo IpAddress
ipAddress [Header]
reqHeaders GraphQLQueryType
queryType GQLReqUnparsed
reqUnparsed = do
  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) <- Text
-> m (GQLReqParsed, m AnnotatedResponse -> m AnnotatedResponse,
      SingleOperation)
-> m (GQLReqParsed, m AnnotatedResponse -> m AnnotatedResponse,
      SingleOperation)
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"Parse GraphQL" (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
$ 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
-> ([Header], IpAddress)
-> AllowListStatus
-> SchemaCache
-> GQLReqUnparsed
-> RequestId
-> m (Either QErr GQLReqParsed)
forall (m :: * -> *).
MonadGQLExecutionCheck m =>
UserInfo
-> ([Header], IpAddress)
-> AllowListStatus
-> SchemaCache
-> GQLReqUnparsed
-> RequestId
-> m (Either QErr GQLReqParsed)
E.checkGQLExecution UserInfo
userInfo ([Header]
reqHeaders, IpAddress
ipAddress) AllowListStatus
enableAL SchemaCache
sc GQLReqUnparsed
reqUnparsed RequestId
reqId
          m (Either QErr GQLReqParsed)
-> (Either QErr GQLReqParsed -> m GQLReqParsed) -> m GQLReqParsed
forall a b. m a -> (a -> m b) -> m b
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 a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

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

      -- 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 a. a -> m a
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
getOpNameFromParsedReq GQLReqParsed
reqParsed
      Maybe Name -> (Name -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Name
maybeOperationName ((Name -> m ()) -> m ()) -> (Name -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Name
nm ->
        -- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/instrumentation/graphql/
        TraceMetadata -> m ()
forall (m :: * -> *). MonadTrace m => TraceMetadata -> m ()
attachMetadata [(Text
"graphql.operation.name", Name -> Text
G.unName Name
nm)]
      (ParameterizedQueryHash
parameterizedQueryHash, ResolvedExecutionPlan
execPlan) <-
        Environment
-> Logger Hasura
-> PrometheusMetrics
-> UserInfo
-> SQLGenCtx
-> ReadOnlyMode
-> SchemaCache
-> GraphQLQueryType
-> [Header]
-> GQLReqUnparsed
-> SingleOperation
-> Maybe Name
-> RequestId
-> m (ParameterizedQueryHash, ResolvedExecutionPlan)
forall (m :: * -> *).
(MonadError QErr m, MonadMetadataStorage m, MonadIO m,
 MonadBaseControl IO m, MonadTrace m, MonadGQLExecutionCheck m,
 MonadQueryTags m, ProvidesNetwork m) =>
Environment
-> Logger Hasura
-> PrometheusMetrics
-> UserInfo
-> SQLGenCtx
-> ReadOnlyMode
-> SchemaCache
-> GraphQLQueryType
-> [Header]
-> GQLReqUnparsed
-> SingleOperation
-> Maybe Name
-> RequestId
-> m (ParameterizedQueryHash, ResolvedExecutionPlan)
E.getResolvedExecPlan
          Environment
env
          Logger Hasura
logger
          PrometheusMetrics
prometheusMetrics
          UserInfo
userInfo
          SQLGenCtx
sqlGenCtx
          ReadOnlyMode
readOnlyMode
          SchemaCache
sc
          GraphQLQueryType
queryType
          [Header]
reqHeaders
          GQLReqUnparsed
reqUnparsed
          SingleOperation
queryParts
          Maybe Name
maybeOperationName
          RequestId
reqId

      -- 4. Execute the execution plan producing a 'AnnotatedResponse'.
      AnnotatedResponse
response <- GQLReqParsed
-> (m AnnotatedResponse -> m AnnotatedResponse)
-> ResolvedExecutionPlan
-> m AnnotatedResponse
executePlan GQLReqParsed
reqParsed m AnnotatedResponse -> m AnnotatedResponse
runLimits ResolvedExecutionPlan
execPlan
      (AnnotatedResponse, ParameterizedQueryHash, OperationType)
-> m (AnnotatedResponse, ParameterizedQueryHash, OperationType)
forall a. a -> m a
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 a. IO a -> m a
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 a. a -> m a
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 :: forall a. 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)
InsOrdHashMap.traverseWithKey

    executePlan ::
      GQLReqParsed ->
      (m AnnotatedResponse -> m AnnotatedResponse) ->
      E.ResolvedExecutionPlan ->
      m AnnotatedResponse
    executePlan :: GQLReqParsed
-> (m AnnotatedResponse -> m AnnotatedResponse)
-> ResolvedExecutionPlan
-> m AnnotatedResponse
executePlan GQLReqParsed
reqParsed m AnnotatedResponse -> m AnnotatedResponse
runLimits ResolvedExecutionPlan
execPlan = case ResolvedExecutionPlan
execPlan of
      E.QueryExecutionPlan ExecutionPlan
queryPlans [QueryRootField UnpreparedValue]
asts DirectiveMap
dirMap -> do
        let 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
        -- Attempt to lookup a cached response in the query cache.
        ([Header]
cachingHeaders, CacheResult
cachedValue) <- m (Either QErr ([Header], CacheResult))
-> m ([Header], CacheResult)
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ([Header], CacheResult))
 -> m ([Header], CacheResult))
-> m (Either QErr ([Header], CacheResult))
-> m ([Header], CacheResult)
forall a b. (a -> b) -> a -> b
$ ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> Maybe CachedDirective
-> GQLReqParsed
-> UserInfo
-> [Header]
-> m (Either QErr ([Header], CacheResult))
forall (m :: * -> *).
MonadExecuteQuery m =>
ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> Maybe CachedDirective
-> GQLReqParsed
-> UserInfo
-> [Header]
-> m (Either QErr ([Header], CacheResult))
cacheLookup ExecutionPlan
queryPlans [QueryRootField UnpreparedValue]
asts Maybe CachedDirective
cachedDirective GQLReqParsed
reqParsed UserInfo
userInfo [Header]
reqHeaders
        case CacheResult
cachedValue of
          -- If we get a cache hit, annotate the response with metadata and return it.
          ResponseCached 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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (AnnotatedResponse -> m AnnotatedResponse)
-> AnnotatedResponse -> m AnnotatedResponse
forall a b. (a -> b) -> a -> b
$ 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)
-> [Header] -> HttpResponse (Maybe GQResponse, EncJSON)
forall a. a -> [Header] -> HttpResponse a
HttpResponse (EncJSON -> (Maybe GQResponse, EncJSON)
decodeGQResp EncJSON
cachedResponseData) [Header]
cachingHeaders
                }
          -- If we get a cache miss, we must run the query against the graphql engine.
          ResponseUncached Maybe ResponseCacher
storeResponseM -> 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.
            -- TODO: can this be a `catch` rather than a `runExceptT`?
            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
executeQueryStep
            -- 2. Construct an 'AnnotatedResponse' from the results of all steps in the 'ExecutionPlan'.
            AnnotatedResponse
result <- QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> m AnnotatedResponse
forall (m :: * -> *).
MonadError QErr m =>
QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> m AnnotatedResponse
buildResponseFromParts QueryType
Telem.Query Either
  (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
conclusion
            let response :: HttpResponse (Maybe GQResponse, EncJSON)
response@(HttpResponse (Maybe GQResponse, EncJSON)
responseData [Header]
_) = AnnotatedResponse -> HttpResponse (Maybe GQResponse, EncJSON)
arResponse AnnotatedResponse
result
            -- 3. Cache the 'AnnotatedResponse'.
            case Maybe ResponseCacher
storeResponseM of
              -- No caching intended
              Maybe ResponseCacher
Nothing ->
                -- TODO: we probably don't want to use `cachingHeaders` here.
                -- If no caching was intended, then we shouldn't instruct the
                -- client to cache, either.  The only reason we're passing
                -- headers here is to avoid breaking changes.
                AnnotatedResponse -> m AnnotatedResponse
forall a. a -> m a
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 = [Header]
-> HttpResponse (Maybe GQResponse, EncJSON)
-> HttpResponse (Maybe GQResponse, EncJSON)
forall a. [Header] -> HttpResponse a -> HttpResponse a
addHttpResponseHeaders [Header]
cachingHeaders HttpResponse (Maybe GQResponse, EncJSON)
response}
              -- Caching intended; store result and instruct client through HTTP headers
              Just ResponseCacher {forall (m :: * -> *).
(MonadTrace m, MonadIO m) =>
EncJSON -> m (Either QErr CacheStoreResponse)
runStoreResponse :: ResponseCacher
-> forall (m :: * -> *).
   (MonadTrace m, MonadIO m) =>
   EncJSON -> m (Either QErr CacheStoreResponse)
runStoreResponse :: forall (m :: * -> *).
(MonadTrace m, MonadIO m) =>
EncJSON -> m (Either QErr CacheStoreResponse)
..} -> do
                CacheStoreResponse
cacheStoreRes <- m (Either QErr CacheStoreResponse) -> m CacheStoreResponse
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr CacheStoreResponse) -> m CacheStoreResponse)
-> m (Either QErr CacheStoreResponse) -> m CacheStoreResponse
forall a b. (a -> b) -> a -> b
$ EncJSON -> m (Either QErr CacheStoreResponse)
forall (m :: * -> *).
(MonadTrace m, MonadIO m) =>
EncJSON -> m (Either QErr CacheStoreResponse)
runStoreResponse ((Maybe GQResponse, EncJSON) -> EncJSON
forall a b. (a, b) -> b
snd (Maybe GQResponse, EncJSON)
responseData)
                let headers :: [Header]
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
                      CacheStoreResponse
CacheStoreSuccess -> [Header]
cachingHeaders
                      CacheStoreResponse
CacheStoreLimitReached -> [(HeaderName
"warning", ByteString
"199 - cache-store-size-limit-exceeded")]
                      CacheStoreResponse
CacheStoreNotEnoughCapacity -> [(HeaderName
"warning", ByteString
"199 - cache-store-capacity-exceeded")]
                      CacheStoreBackendError String
_ -> [(HeaderName
"warning", ByteString
"199 - cache-store-error")]
                 in -- 4. Return the response.
                    AnnotatedResponse -> m AnnotatedResponse
forall a. a -> m a
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 = [Header]
-> HttpResponse (Maybe GQResponse, EncJSON)
-> HttpResponse (Maybe GQResponse, EncJSON)
forall a. [Header] -> HttpResponse a -> HttpResponse a
addHttpResponseHeaders [Header]
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),
      ResolvedConnectionTemplate ('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, ResolvedConnectionTemplate ('Postgres 'Vanilla)
resolvedConnectionTemplate, InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla))
pgMutations) -> do
            Either (Either GQExecError QErr) (DiffTime, RootFieldMap EncJSON)
res <-
              -- TODO: can this be a `catch` rather than a `runExceptT`?
              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)
-> ResolvedConnectionTemplate ('Postgres 'Vanilla)
-> InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla))
-> ExceptT QErr m (DiffTime, RootFieldMap EncJSON)
forall (pgKind :: PostgresKind) (m :: * -> *).
(HasTag ('Postgres pgKind), MonadIO m, MonadBaseControl IO m,
 MonadError QErr m, MonadQueryLog m, MonadTrace m) =>
RequestId
-> GQLReqUnparsed
-> UserInfo
-> Logger Hasura
-> SourceConfig ('Postgres pgKind)
-> ResolvedConnectionTemplate ('Postgres pgKind)
-> RootFieldMap (DBStepInfo ('Postgres pgKind))
-> m (DiffTime, RootFieldMap EncJSON)
runPGMutationTransaction RequestId
reqId GQLReqUnparsed
reqUnparsed UserInfo
userInfo Logger Hasura
logger SourceConfig ('Postgres 'Vanilla)
sourceConfig ResolvedConnectionTemplate ('Postgres 'Vanilla)
resolvedConnectionTemplate 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
                    { 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)
-> [Header] -> HttpResponse (Maybe GQResponse, EncJSON)
forall a. a -> [Header] -> 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),
   ResolvedConnectionTemplate ('Postgres 'Vanilla),
   InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla)))
Nothing -> do
            -- TODO: can this be a `catch` rather than a `runExceptT`?
            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
executeMutationStep
            QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> m AnnotatedResponse
forall (m :: * -> *).
MonadError QErr m =>
QueryType
-> Either
     (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
-> m AnnotatedResponse
buildResponseFromParts QueryType
Telem.Mutation Either
  (Either GQExecError QErr) (RootFieldMap AnnotatedResponsePart)
conclusion
      E.SubscriptionExecutionPlan (SubscriptionExecution, Maybe (Endo Value))
_sub ->
        Code -> Text -> m AnnotatedResponse
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload Text
"subscriptions are not supported over HTTP, use websockets instead"

    executeQueryStep ::
      RootFieldAlias ->
      EB.ExecutionStep ->
      ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
    executeQueryStep :: RootFieldAlias
-> ExecutionStep
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
executeQueryStep RootFieldAlias
fieldName = \case
      E.ExecStepDB [Header]
_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) <-
          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 OnBaseMonad (ExecutionMonad b) (ActionResult b)
tx ResolvedConnectionTemplate b
resolvedConnectionTemplate :: EB.DBStepInfo b) ->
              forall (b :: BackendType) (m :: * -> *).
(BackendTransport b, MonadIO m, MonadBaseControl IO m,
 MonadError QErr m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m) =>
RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> SourceConfig b
-> OnBaseMonad
     (ExecutionMonad b) (Maybe (AnyBackend ExecutionStats), EncJSON)
-> Maybe (PreparedQuery b)
-> ResolvedConnectionTemplate b
-> m (DiffTime, EncJSON)
runDBQuery @b RequestId
reqId GQLReqUnparsed
reqUnparsed RootFieldAlias
fieldName UserInfo
userInfo Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey SourceConfig b
sourceConfig ((ActionResult b -> (Maybe (AnyBackend ExecutionStats), EncJSON))
-> OnBaseMonad (ExecutionMonad b) (ActionResult b)
-> OnBaseMonad
     (ExecutionMonad b) (Maybe (AnyBackend ExecutionStats), EncJSON)
forall a b.
(a -> b)
-> OnBaseMonad (ExecutionMonad b) a
-> OnBaseMonad (ExecutionMonad b) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (b :: BackendType).
HasTag b =>
ActionResult b -> (Maybe (AnyBackend ExecutionStats), EncJSON)
statsToAnyBackend @b) OnBaseMonad (ExecutionMonad b) (ActionResult b)
tx) Maybe (PreparedQuery b)
genSql ResolvedConnectionTemplate b
resolvedConnectionTemplate
        EncJSON
finalResponse <-
          RequestId
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> Environment
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> ExceptT QErr m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadQueryTags m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m, ProvidesNetwork m) =>
RequestId
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> Environment
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
RJ.processRemoteJoins RequestId
reqId Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey Environment
env [Header]
reqHeaders UserInfo
userInfo EncJSON
resp Maybe RemoteJoins
remoteJoins GQLReqUnparsed
reqUnparsed
        AnnotatedResponsePart -> ExceptT QErr m AnnotatedResponsePart
forall a. a -> ExceptT QErr m a
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 -> [Header] -> 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
        RootFieldAlias
-> RemoteSchemaInfo
-> ResultCustomizer
-> GQLReqOutgoing
-> Maybe RemoteJoins
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
runRemoteGQ 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 [Header]
_)) <- UserInfo
-> ActionExecutionPlan
-> ExceptT QErr m (DiffTime, (EncJSON, Maybe [Header]))
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m,
 MonadMetadataStorage m) =>
UserInfo
-> ActionExecutionPlan -> m (DiffTime, (EncJSON, Maybe [Header]))
EA.runActionExecution UserInfo
userInfo ActionExecutionPlan
aep
          EncJSON
finalResponse <-
            RequestId
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> Environment
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> ExceptT QErr m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadQueryTags m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m, ProvidesNetwork m) =>
RequestId
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> Environment
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
RJ.processRemoteJoins RequestId
reqId Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey Environment
env [Header]
reqHeaders UserInfo
userInfo EncJSON
resp Maybe RemoteJoins
remoteJoins GQLReqUnparsed
reqUnparsed
          (DiffTime, EncJSON) -> ExceptT QErr m (DiffTime, EncJSON)
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiffTime
time, EncJSON
finalResponse)
        AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a. a -> ExceptT (Either GQExecError QErr) m a
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 -> [Header] -> 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (RootFieldAlias
-> ExecutionStep
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
executeQueryStep RootFieldAlias
fieldName) [ExecutionStep]
lst
        AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a. a -> ExceptT (Either GQExecError QErr) m a
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 -> [Header] -> 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 ::
      RootFieldAlias ->
      EB.ExecutionStep ->
      ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
    executeMutationStep :: RootFieldAlias
-> ExecutionStep
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
executeMutationStep RootFieldAlias
fieldName = \case
      E.ExecStepDB [Header]
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) <-
          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 OnBaseMonad (ExecutionMonad b) (ActionResult b)
tx ResolvedConnectionTemplate b
resolvedConnectionTemplate :: EB.DBStepInfo b) ->
              forall (b :: BackendType) (m :: * -> *).
(BackendTransport b, MonadIO m, MonadBaseControl IO m,
 MonadError QErr m, MonadQueryLog m, MonadTrace m) =>
RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> SourceConfig b
-> OnBaseMonad (ExecutionMonad b) EncJSON
-> Maybe (PreparedQuery b)
-> ResolvedConnectionTemplate b
-> m (DiffTime, EncJSON)
runDBMutation @b RequestId
reqId GQLReqUnparsed
reqUnparsed RootFieldAlias
fieldName UserInfo
userInfo Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey SourceConfig b
sourceConfig ((ActionResult b -> EncJSON)
-> OnBaseMonad (ExecutionMonad b) (ActionResult b)
-> OnBaseMonad (ExecutionMonad b) EncJSON
forall a b.
(a -> b)
-> OnBaseMonad (ExecutionMonad b) a
-> OnBaseMonad (ExecutionMonad b) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ActionResult b -> EncJSON
forall (b :: BackendType). ActionResult b -> EncJSON
EB.arResult OnBaseMonad (ExecutionMonad b) (ActionResult b)
tx) Maybe (PreparedQuery b)
genSql ResolvedConnectionTemplate b
resolvedConnectionTemplate
        EncJSON
finalResponse <-
          RequestId
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> Environment
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> ExceptT QErr m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadQueryTags m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m, ProvidesNetwork m) =>
RequestId
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> Environment
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
RJ.processRemoteJoins RequestId
reqId Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey Environment
env [Header]
reqHeaders UserInfo
userInfo EncJSON
resp Maybe RemoteJoins
remoteJoins GQLReqUnparsed
reqUnparsed
        AnnotatedResponsePart -> ExceptT QErr m AnnotatedResponsePart
forall a. a -> ExceptT QErr m a
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 -> [Header] -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
telemTimeIO_DT Locality
Telem.Local EncJSON
finalResponse [Header]
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
        RootFieldAlias
-> RemoteSchemaInfo
-> ResultCustomizer
-> GQLReqOutgoing
-> Maybe RemoteJoins
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
runRemoteGQ 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 [Header]
hdrs)) <- ExceptT QErr m (DiffTime, (EncJSON, Maybe [Header]))
-> ExceptT
     (Either GQExecError QErr) m (DiffTime, (EncJSON, Maybe [Header]))
forall a. ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
doQErr (ExceptT QErr m (DiffTime, (EncJSON, Maybe [Header]))
 -> ExceptT
      (Either GQExecError QErr) m (DiffTime, (EncJSON, Maybe [Header])))
-> ExceptT QErr m (DiffTime, (EncJSON, Maybe [Header]))
-> ExceptT
     (Either GQExecError QErr) m (DiffTime, (EncJSON, Maybe [Header]))
forall a b. (a -> b) -> a -> b
$ do
          (DiffTime
time, (EncJSON
resp, Maybe [Header]
hdrs)) <- UserInfo
-> ActionExecutionPlan
-> ExceptT QErr m (DiffTime, (EncJSON, Maybe [Header]))
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m,
 MonadMetadataStorage m) =>
UserInfo
-> ActionExecutionPlan -> m (DiffTime, (EncJSON, Maybe [Header]))
EA.runActionExecution UserInfo
userInfo ActionExecutionPlan
aep
          EncJSON
finalResponse <-
            RequestId
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> Environment
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> ExceptT QErr m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadQueryTags m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m, ProvidesNetwork m) =>
RequestId
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> Environment
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
RJ.processRemoteJoins RequestId
reqId Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey Environment
env [Header]
reqHeaders UserInfo
userInfo EncJSON
resp Maybe RemoteJoins
remoteJoins GQLReqUnparsed
reqUnparsed
          (DiffTime, (EncJSON, Maybe [Header]))
-> ExceptT QErr m (DiffTime, (EncJSON, Maybe [Header]))
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiffTime
time, (EncJSON
finalResponse, Maybe [Header]
hdrs))
        AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a. a -> ExceptT (Either GQExecError QErr) m a
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 -> [Header] -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
time Locality
Telem.Empty EncJSON
resp ([Header] -> AnnotatedResponsePart)
-> [Header] -> AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ [Header] -> Maybe [Header] -> [Header]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Header]
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (RootFieldAlias
-> ExecutionStep
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
executeQueryStep RootFieldAlias
fieldName) [ExecutionStep]
lst
        AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a. a -> ExceptT (Either GQExecError QErr) m a
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 -> [Header] -> 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 :: RootFieldAlias
-> RemoteSchemaInfo
-> ResultCustomizer
-> GQLReqOutgoing
-> Maybe RemoteJoins
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
runRemoteGQ RootFieldAlias
fieldName RemoteSchemaInfo
rsi ResultCustomizer
resultCustomizer GQLReqOutgoing
gqlReq Maybe RemoteJoins
remoteJoins = Text
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan (Text
"Remote schema query for root field " Text -> RootFieldAlias -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RootFieldAlias
fieldName) (ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
 -> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart)
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a b. (a -> b) -> a -> b
$ do
      (DiffTime
telemTimeIO_DT, [Header]
remoteResponseHeaders, ByteString
resp) <-
        ExceptT QErr m (DiffTime, [Header], ByteString)
-> ExceptT
     (Either GQExecError QErr) m (DiffTime, [Header], ByteString)
forall a. ExceptT QErr m a -> ExceptT (Either GQExecError QErr) m a
doQErr (ExceptT QErr m (DiffTime, [Header], ByteString)
 -> ExceptT
      (Either GQExecError QErr) m (DiffTime, [Header], ByteString))
-> ExceptT QErr m (DiffTime, [Header], ByteString)
-> ExceptT
     (Either GQExecError QErr) m (DiffTime, [Header], ByteString)
forall a b. (a -> b) -> a -> b
$ Environment
-> UserInfo
-> [Header]
-> ValidatedRemoteSchemaDef
-> GQLReqOutgoing
-> ExceptT QErr m (DiffTime, [Header], ByteString)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadTrace m, ProvidesNetwork m) =>
Environment
-> UserInfo
-> [Header]
-> ValidatedRemoteSchemaDef
-> GQLReqOutgoing
-> m (DiffTime, [Header], ByteString)
E.execRemoteGQ Environment
env UserInfo
userInfo [Header]
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
-> Maybe (CredentialCache AgentLicenseKey)
-> Environment
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> ExceptT QErr m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadQueryTags m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m, ProvidesNetwork m) =>
RequestId
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> Environment
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
RJ.processRemoteJoins
            RequestId
reqId
            Logger Hasura
logger
            Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey
            Environment
env
            [Header]
reqHeaders
            UserInfo
userInfo
            -- TODO: avoid encode and decode here
            (Value -> EncJSON
encJFromOrderedValue Value
value)
            Maybe RemoteJoins
remoteJoins
            GQLReqUnparsed
reqUnparsed
      let filteredHeaders :: [Header]
filteredHeaders = (Header -> Bool) -> [Header] -> [Header]
forall a. (a -> Bool) -> [a] -> [a]
filter ((HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"Set-Cookie") (HeaderName -> Bool) -> (Header -> HeaderName) -> Header -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> HeaderName
forall a b. (a, b) -> a
fst) [Header]
remoteResponseHeaders
      AnnotatedResponsePart
-> ExceptT (Either GQExecError QErr) m AnnotatedResponsePart
forall a. a -> ExceptT (Either GQExecError QErr) m a
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 -> [Header] -> AnnotatedResponsePart
AnnotatedResponsePart DiffTime
telemTimeIO_DT Locality
Telem.Remote EncJSON
finalResponse [Header]
filteredHeaders

    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
        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
          }
        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 :: forall (n :: * -> *) e a.
(MonadIO n, MonadError e n) =>
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 a. n a -> (e -> n a) -> n 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 a b. (a -> b) -> n a -> n b
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 a. a -> n 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 a b. n a -> (a -> n b) -> n b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right a
result ->
          a -> n a
forall a. 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 a. IO a -> n a
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 a. IO a -> n a
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 a. IO a -> n a
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 a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          e -> n a
forall a. 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 a. IO a -> IO a
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 a. IO a -> IO a
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

coalescePostgresMutations ::
  EB.ExecutionPlan ->
  Maybe
    ( SourceConfig ('Postgres 'Vanilla),
      ResolvedConnectionTemplate ('Postgres 'Vanilla),
      InsOrdHashMap RootFieldAlias (EB.DBStepInfo ('Postgres 'Vanilla))
    )
coalescePostgresMutations :: ExecutionPlan
-> Maybe
     (SourceConfig ('Postgres 'Vanilla),
      ResolvedConnectionTemplate ('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, Maybe PostgresResolvedConnectionTemplate
oneResolvedConnectionTemplate, PGSourceConfig
oneSourceConfig) <- case ExecutionPlan -> [ExecutionStep]
forall a. InsOrdHashMap RootFieldAlias a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ExecutionPlan
plan of
    (E.ExecStepDB [Header]
_ AnyBackend DBStepInfo
exists Maybe RemoteJoins
_remoteJoins : [ExecutionStep]
_) ->
      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, Maybe PostgresResolvedConnectionTemplate,
        PGSourceConfig))
-> Maybe
     (SourceName, Maybe PostgresResolvedConnectionTemplate,
      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)
-> ResolvedConnectionTemplate ('Postgres 'Vanilla)
forall (b :: BackendType).
DBStepInfo b -> ResolvedConnectionTemplate b
EB.dbsiResolvedConnectionTemplate 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, Maybe PostgresResolvedConnectionTemplate,
   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 [Header]
_ AnyBackend DBStepInfo
exists Maybe RemoteJoins
remoteJoins -> do
      DBStepInfo ('Postgres 'Vanilla)
dbStepInfo <- 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
        Bool -> Bool -> Bool
&& Maybe PostgresResolvedConnectionTemplate
oneResolvedConnectionTemplate
        Maybe PostgresResolvedConnectionTemplate
-> Maybe PostgresResolvedConnectionTemplate -> Bool
forall a. Eq a => a -> a -> Bool
== DBStepInfo ('Postgres 'Vanilla)
-> ResolvedConnectionTemplate ('Postgres 'Vanilla)
forall (b :: BackendType).
DBStepInfo b -> ResolvedConnectionTemplate b
EB.dbsiResolvedConnectionTemplate DBStepInfo ('Postgres 'Vanilla)
dbStepInfo
      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, Maybe PostgresResolvedConnectionTemplate,
 InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla)))
-> Maybe
     (PGSourceConfig, Maybe PostgresResolvedConnectionTemplate,
      InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla)))
forall a. a -> Maybe a
Just (PGSourceConfig
oneSourceConfig, Maybe PostgresResolvedConnectionTemplate
oneResolvedConnectionTemplate, InsOrdHashMap RootFieldAlias (DBStepInfo ('Postgres 'Vanilla))
mutations)

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

decodeGraphQLResponse :: LBS.ByteString -> Either Text GraphQLResponse
decodeGraphQLResponse :: ByteString -> Either Text GraphQLResponse
decodeGraphQLResponse ByteString
bs = do
  Value
val <- (String -> Text) -> Either String Value -> Either Text Value
forall e1 e2 a. (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft String -> Text
T.pack (Either String Value -> Either Text Value)
-> Either String Value -> Either Text Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Value
JO.eitherDecode ByteString
bs
  Object
valObj <- Value -> Either Text Object
forall s. IsString s => Value -> Either s Object
JO.asObject Value
val
  case Text -> Object -> Maybe Value
JO.lookup Text
"errors" Object
valObj of
    Just (JO.Array Array
errs) -> GraphQLResponse -> Either Text GraphQLResponse
forall a b. b -> Either a b
Right (GraphQLResponse -> Either Text GraphQLResponse)
-> GraphQLResponse -> Either Text GraphQLResponse
forall a b. (a -> b) -> a -> b
$ [Value] -> GraphQLResponse
GraphQLResponseErrors (Vector Value -> [Value]
forall a. Vector a -> [a]
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
_ -> Text -> Either Text GraphQLResponse
forall a b. a -> Either a b
Left Text
"Invalid \"errors\" field in response from remote"
    Maybe Value
Nothing -> do
      Value
dataVal <- Text -> Object -> Maybe Value
JO.lookup Text
"data" Object
valObj Maybe Value -> Either Text Value -> Either Text Value
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> Either Text Value
forall a b. a -> Either a b
Left Text
"Missing \"data\" field in response from remote"
      GraphQLResponse -> Either Text GraphQLResponse
forall a b. b -> Either a b
Right (GraphQLResponse -> Either Text GraphQLResponse)
-> GraphQLResponse -> Either Text 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 :: forall (m :: * -> *).
Monad m =>
RootFieldAlias
-> ResultCustomizer
-> ByteString
-> ExceptT (Either GQExecError QErr) m Value
extractFieldFromResponse RootFieldAlias
fieldName ResultCustomizer
resultCustomizer ByteString
resp = do
  let fieldName' :: Text
fieldName' = Name -> Text
G.unName (Name -> Text) -> Name -> Text
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 Text GraphQLResponse
decodeGraphQLResponse ByteString
resp Either Text GraphQLResponse
-> (Text -> 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` Text -> ExceptT (Either GQExecError QErr) m GraphQLResponse
forall {a} {a}. Text -> 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 a. a -> ExceptT (Either GQExecError QErr) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
d
  Object
dataObj <- Either Text Object
-> (Text -> 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 Text Object
forall s. IsString s => Value -> Either s Object
JO.asObject Value
dataVal) Text -> ExceptT (Either GQExecError QErr) m Object
forall {a} {a}. Text -> 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 (Text -> Object -> Maybe Value
JO.lookup Text
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
$ Text -> ExceptT (Either GQExecError QErr) m Value
forall {a} {a}. Text -> ExceptT (Either a QErr) m a
do400
      (Text -> ExceptT (Either GQExecError QErr) m Value)
-> Text -> ExceptT (Either GQExecError QErr) m Value
forall a b. (a -> b) -> a -> b
$ Text
"expecting key "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldName'
  Value -> ExceptT (Either GQExecError QErr) m Value
forall a. a -> ExceptT (Either GQExecError QErr) m a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
fieldVal
  where
    do400 :: Text -> 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)
-> (Text -> ExceptT QErr m a)
-> Text
-> ExceptT (Either a QErr) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> Text -> ExceptT QErr m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> 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 a. 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
. [Encoding] -> GQExecError
GQExecError ([Encoding] -> GQExecError)
-> ([Value] -> [Encoding]) -> [Value] -> GQExecError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Encoding) -> [Value] -> [Encoding]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding

buildRaw :: (Applicative m) => JO.Value -> m AnnotatedResponsePart
buildRaw :: forall (m :: * -> *).
Applicative m =>
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 a. a -> m a
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 -> [Header] -> 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 a b.
(a -> b)
-> InsOrdHashMap RootFieldAlias a -> InsOrdHashMap RootFieldAlias b
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 a b.
(a -> b) -> InsOrdHashMap Name a -> InsOrdHashMap Name b
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 Text EncJSON -> EncJSON
encJFromInsOrdHashMap (InsOrdHashMap Text EncJSON -> EncJSON)
-> (InsOrdHashMap Name EncJSON -> InsOrdHashMap Text EncJSON)
-> InsOrdHashMap Name EncJSON
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Text)
-> InsOrdHashMap Name EncJSON -> InsOrdHashMap Text EncJSON
forall k' k v.
(Eq k', Hashable k') =>
(k -> k') -> InsOrdHashMap k v -> InsOrdHashMap k' v
InsOrdHashMap.mapKeys Name -> Text
G.unName

-- | Run (execute) a batched GraphQL query (see 'GQLBatchedReqs').
runGQBatched ::
  forall m.
  ( MonadIO m,
    MonadBaseControl IO m,
    MonadError QErr m,
    E.MonadGQLExecutionCheck m,
    MonadQueryLog m,
    MonadExecutionLog m,
    MonadTrace m,
    MonadExecuteQuery m,
    MonadMetadataStorage m,
    MonadQueryTags m,
    HasResourceLimits m,
    ProvidesNetwork m
  ) =>
  Env.Environment ->
  SQLGenCtx ->
  SchemaCache ->
  Init.AllowListStatus ->
  ReadOnlyMode ->
  PrometheusMetrics ->
  L.Logger L.Hasura ->
  Maybe (CredentialCache AgentLicenseKey) ->
  RequestId ->
  ResponseInternalErrorsConfig ->
  UserInfo ->
  Wai.IpAddress ->
  [HTTP.Header] ->
  E.GraphQLQueryType ->
  -- | the batched request with unparsed GraphQL query
  GQLBatchedReqs (GQLReq GQLQueryText) ->
  m (HttpLogGraphQLInfo, HttpResponse EncJSON)
runGQBatched :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m,
 MonadGQLExecutionCheck m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m, MonadExecuteQuery m, MonadMetadataStorage m,
 MonadQueryTags m, HasResourceLimits m, ProvidesNetwork m) =>
Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> ResponseInternalErrorsConfig
-> UserInfo
-> IpAddress
-> [Header]
-> GraphQLQueryType
-> GQLBatchedReqs GQLReqUnparsed
-> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
runGQBatched Environment
env SQLGenCtx
sqlGenCtx SchemaCache
sc AllowListStatus
enableAL ReadOnlyMode
readOnlyMode PrometheusMetrics
prometheusMetrics Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey RequestId
reqId ResponseInternalErrorsConfig
responseErrorsConfig UserInfo
userInfo IpAddress
ipAddress [Header]
reqHdrs GraphQLQueryType
queryType GQLBatchedReqs GQLReqUnparsed
query =
  case GQLBatchedReqs GQLReqUnparsed
query of
    GQLSingleRequest GQLReqUnparsed
req -> do
      (GQLQueryOperationSuccessLog
gqlQueryOperationLog, HttpResponse (Maybe GQResponse, EncJSON)
httpResp) <- Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> UserInfo
-> IpAddress
-> [Header]
-> GraphQLQueryType
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m,
 MonadGQLExecutionCheck m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m, MonadExecuteQuery m, MonadMetadataStorage m,
 MonadQueryTags m, HasResourceLimits m, ProvidesNetwork m) =>
Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> UserInfo
-> IpAddress
-> [Header]
-> GraphQLQueryType
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
runGQ Environment
env SQLGenCtx
sqlGenCtx SchemaCache
sc AllowListStatus
enableAL ReadOnlyMode
readOnlyMode PrometheusMetrics
prometheusMetrics Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey RequestId
reqId UserInfo
userInfo IpAddress
ipAddress [Header]
reqHdrs GraphQLQueryType
queryType GQLReqUnparsed
req
      let httpLoggingGQInfo :: HttpLogGraphQLInfo
httpLoggingGQInfo = (RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> CommonHttpLogMetadata
CommonHttpLogMetadata 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))), (ParameterizedQueryHash -> ParameterizedQueryHashList
PQHSetSingleton (GQLQueryOperationSuccessLog -> ParameterizedQueryHash
gqolParameterizedQueryHash GQLQueryOperationSuccessLog
gqlQueryOperationLog)))
      (HttpLogGraphQLInfo, HttpResponse EncJSON)
-> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpLogGraphQLInfo
httpLoggingGQInfo, (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.
      UserInfo
-> RequestId
-> [GQLReqUnparsed]
-> SchemaCache
-> m (Either QErr ())
forall (m :: * -> *).
MonadGQLExecutionCheck m =>
UserInfo
-> RequestId
-> [GQLReqUnparsed]
-> SchemaCache
-> m (Either QErr ())
E.checkGQLBatchedReqs UserInfo
userInfo RequestId
reqId [GQLReqUnparsed]
reqs SchemaCache
sc m (Either QErr ()) -> (Either QErr () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either QErr () -> (QErr -> m ()) -> m ())
-> (QErr -> m ()) -> Either QErr () -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either QErr () -> (QErr -> m ()) -> m ()
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft QErr -> m ()
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
      let includeInternal :: Bool
includeInternal = RoleName -> ResponseInternalErrorsConfig -> Bool
shouldIncludeInternal (UserInfo -> RoleName
_uiRole UserInfo
userInfo) ResponseInternalErrorsConfig
responseErrorsConfig
          removeHeaders :: [Either QErr (HttpResponse EncJSON)] -> HttpResponse EncJSON
removeHeaders =
            (EncJSON -> [Header] -> HttpResponse EncJSON)
-> [Header] -> EncJSON -> HttpResponse EncJSON
forall a b c. (a -> b -> c) -> b -> a -> c
flip EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> 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 (Encoding -> EncJSON
encJFromJEncoding (Encoding -> EncJSON) -> (QErr -> Encoding) -> QErr -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> QErr -> Encoding
encodeGQErr Bool
includeInternal) HttpResponse EncJSON -> EncJSON
forall a. HttpResponse a -> a
_hrBody)
      [(GQLReqUnparsed,
  Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))]
responses <- [GQLReqUnparsed]
-> (GQLReqUnparsed
    -> m (GQLReqUnparsed,
          Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON)))
-> m [(GQLReqUnparsed,
       Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [GQLReqUnparsed]
reqs \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 a b. (a -> b) -> m a -> m b
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)))
-> m (Either
        QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> m (GQLReqUnparsed,
      Either QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
forall a b. (a -> b) -> a -> b
$ 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)))
-> m (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
-> m (Either
        QErr (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
forall a b. (a -> b) -> a -> b
$ (((GQLQueryOperationSuccessLog,
  HttpResponse (Maybe GQResponse, EncJSON))
 -> (GQLQueryOperationSuccessLog, HttpResponse EncJSON))
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
-> m (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
forall a b. (a -> b) -> m a -> m b
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 a b.
(a -> b)
-> (GQLQueryOperationSuccessLog, a)
-> (GQLQueryOperationSuccessLog, b)
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 a b. (a -> b) -> HttpResponse a -> HttpResponse b
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))
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
-> m (GQLQueryOperationSuccessLog, HttpResponse EncJSON)
forall a b. (a -> b) -> a -> b
$ Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> UserInfo
-> IpAddress
-> [Header]
-> GraphQLQueryType
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m,
 MonadGQLExecutionCheck m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m, MonadExecuteQuery m, MonadMetadataStorage m,
 MonadQueryTags m, HasResourceLimits m, ProvidesNetwork m) =>
Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> UserInfo
-> IpAddress
-> [Header]
-> GraphQLQueryType
-> GQLReqUnparsed
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
runGQ Environment
env SQLGenCtx
sqlGenCtx SchemaCache
sc AllowListStatus
enableAL ReadOnlyMode
readOnlyMode PrometheusMetrics
prometheusMetrics Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey RequestId
reqId UserInfo
userInfo IpAddress
ipAddress [Header]
reqHdrs GraphQLQueryType
queryType GQLReqUnparsed
req
      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
          httpLoggingGQInfo :: HttpLogGraphQLInfo
httpLoggingGQInfo = (RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> CommonHttpLogMetadata
CommonHttpLogMetadata 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))), [ParameterizedQueryHash] -> ParameterizedQueryHashList
PQHSetBatched [ParameterizedQueryHash]
parameterizedQueryHashes)
      (HttpLogGraphQLInfo, HttpResponse EncJSON)
-> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpLogGraphQLInfo
httpLoggingGQInfo, [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 a b. (a -> b) -> Either QErr a -> Either QErr b
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 a. m a -> (QErr -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (Either QErr b -> m (Either QErr b)
forall a. a -> m a
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 a b. (a -> b) -> m a -> m 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