{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.Server.App
  ( APIResp (JSONResp, RawResp),
    CEConsoleType (..),
    ConsoleRenderer (..),
    MonadVersionAPIWithExtraData (..),
    Handler,
    HandlerCtx (hcReqHeaders, hcAppContext, hcSchemaCache, hcUser),
    HasuraApp (HasuraApp),
    MonadConfigApiHandler (..),
    MonadMetadataApiAuthorization (..),
    AppContext (..),
    boolToText,
    ceConsoleTypeIdentifier,
    configApiGetHandler,
    isAdminSecretSet,
    mkGetHandler,
    mkSpockAction,
    mkWaiApp,
    onlyAdmin,
    renderHtmlTemplate,
    onlyWhenApiEnabled,
  )
where

import Control.Concurrent.Async.Lifted.Safe qualified as LA
import Control.Exception (IOException, throwIO, try)
import Control.Exception.Lifted (ErrorCall (..), catch)
import Control.Monad.Morph (hoist)
import Control.Monad.Stateless
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson hiding (json)
import Data.Aeson qualified as J
import Data.Aeson.Encoding qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Types qualified as J
import Data.ByteString.Builder qualified as BB
import Data.ByteString.Char8 qualified as B8
import Data.ByteString.Char8 qualified as Char8
import Data.ByteString.Lazy qualified as BL
import Data.CaseInsensitive qualified as CI
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as S
import Data.Kind (Type)
import Data.String (fromString)
import Data.Text qualified as T
import Data.Text.Conversions (convertText)
import Data.Text.Extended
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Encoding qualified as TL
import GHC.Stats.Extended qualified as RTS
import Hasura.App.State
import Hasura.Backends.DataConnector.API (openApiSchema)
import Hasura.Backends.DataConnector.Agent.Client (AgentLicenseKey)
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Base.Error
import Hasura.CredentialCache
import Hasura.EncJSON
import Hasura.GraphQL.Execute qualified as E
import Hasura.GraphQL.Execute.Subscription.State qualified as ES
import Hasura.GraphQL.Explain qualified as GE
import Hasura.GraphQL.Logging (MonadExecutionLog, MonadQueryLog)
import Hasura.GraphQL.Transport.HTTP qualified as GH
import Hasura.GraphQL.Transport.HTTP.Protocol qualified as GH
import Hasura.GraphQL.Transport.WSServerApp qualified as WS
import Hasura.GraphQL.Transport.WebSocket qualified as WS
import Hasura.GraphQL.Transport.WebSocket.Server qualified as WS
import Hasura.GraphQL.Transport.WebSocket.Types qualified as WS
import Hasura.HTTP
import Hasura.Logging qualified as L
import Hasura.Metadata.Class
import Hasura.Prelude hiding (get, put)
import Hasura.QueryTags
import Hasura.RQL.DDL.EventTrigger (MonadEventLogCleanup)
import Hasura.RQL.DDL.Schema
import Hasura.RQL.DDL.Schema.Cache.Config
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Endpoint as EP
import Hasura.RQL.Types.Roles (adminRoleName, roleNameToTxt)
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source
import Hasura.Server.API.Config (runGetConfig)
import Hasura.Server.API.Metadata
import Hasura.Server.API.PGDump qualified as PGD
import Hasura.Server.API.Query
import Hasura.Server.API.V2Query qualified as V2Q
import Hasura.Server.AppStateRef
  ( AppStateRef,
    getAppContext,
    getRebuildableSchemaCacheWithVersion,
    getSchemaCache,
    withSchemaCacheReadUpdate,
  )
import Hasura.Server.Auth (AuthMode (..), UserAuthentication (..))
import Hasura.Server.Compression
import Hasura.Server.Init
import Hasura.Server.Limits
import Hasura.Server.Logging
import Hasura.Server.Middleware (corsMiddleware)
import Hasura.Server.OpenAPI (buildOpenAPI)
import Hasura.Server.Rest
import Hasura.Server.Types
import Hasura.Server.Utils
import Hasura.Server.Version
import Hasura.Services
import Hasura.Session (ExtraUserInfo (..), UserInfo (..), UserInfoM, askUserInfo)
import Hasura.Tracing (MonadTrace)
import Hasura.Tracing qualified as Tracing
import Network.HTTP.Types qualified as HTTP
import Network.Mime (defaultMimeLookup)
import Network.Wai.Extended qualified as Wai
import Network.Wai.Handler.WebSockets.Custom qualified as WSC
import System.FilePath (isRelative, joinPath, splitExtension, takeFileName)
import System.Mem (performMajorGC)
import System.Metrics qualified as EKG
import System.Metrics.Json qualified as EKG
import Text.Mustache qualified as M
import Web.Spock.Core ((<//>))
import Web.Spock.Core qualified as Spock

data HandlerCtx = HandlerCtx
  { HandlerCtx -> AppContext
hcAppContext :: AppContext,
    HandlerCtx -> RebuildableSchemaCache
hcSchemaCache :: RebuildableSchemaCache,
    HandlerCtx -> UserInfo
hcUser :: UserInfo,
    HandlerCtx -> [Header]
hcReqHeaders :: [HTTP.Header],
    HandlerCtx -> RequestId
hcRequestId :: RequestId,
    HandlerCtx -> IpAddress
hcSourceIpAddress :: Wai.IpAddress,
    HandlerCtx -> Maybe (CredentialCache AgentLicenseKey)
hcLicenseKeyCache :: Maybe (CredentialCache AgentLicenseKey)
  }

newtype Handler m a = Handler (ReaderT HandlerCtx (ExceptT QErr m) a)
  deriving
    ( (forall a b. (a -> b) -> Handler m a -> Handler m b)
-> (forall a b. a -> Handler m b -> Handler m a)
-> Functor (Handler m)
forall a b. a -> Handler m b -> Handler m a
forall a b. (a -> b) -> Handler m a -> Handler m b
forall (m :: * -> *) a b.
Functor m =>
a -> Handler m b -> Handler m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Handler m a -> Handler m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Handler m a -> Handler m b
fmap :: forall a b. (a -> b) -> Handler m a -> Handler m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Handler m b -> Handler m a
<$ :: forall a b. a -> Handler m b -> Handler m a
Functor,
      Functor (Handler m)
Functor (Handler m)
-> (forall a. a -> Handler m a)
-> (forall a b. Handler m (a -> b) -> Handler m a -> Handler m b)
-> (forall a b c.
    (a -> b -> c) -> Handler m a -> Handler m b -> Handler m c)
-> (forall a b. Handler m a -> Handler m b -> Handler m b)
-> (forall a b. Handler m a -> Handler m b -> Handler m a)
-> Applicative (Handler m)
forall a. a -> Handler m a
forall a b. Handler m a -> Handler m b -> Handler m a
forall a b. Handler m a -> Handler m b -> Handler m b
forall a b. Handler m (a -> b) -> Handler m a -> Handler m b
forall a b c.
(a -> b -> c) -> Handler m a -> Handler m b -> Handler m c
forall {m :: * -> *}. Monad m => Functor (Handler m)
forall (m :: * -> *) a. Monad m => a -> Handler m a
forall (m :: * -> *) a b.
Monad m =>
Handler m a -> Handler m b -> Handler m a
forall (m :: * -> *) a b.
Monad m =>
Handler m a -> Handler m b -> Handler m b
forall (m :: * -> *) a b.
Monad m =>
Handler m (a -> b) -> Handler m a -> Handler m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Handler m a -> Handler m b -> Handler m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> Handler m a
pure :: forall a. a -> Handler m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
Handler m (a -> b) -> Handler m a -> Handler m b
<*> :: forall a b. Handler m (a -> b) -> Handler m a -> Handler m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Handler m a -> Handler m b -> Handler m c
liftA2 :: forall a b c.
(a -> b -> c) -> Handler m a -> Handler m b -> Handler m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
Handler m a -> Handler m b -> Handler m b
*> :: forall a b. Handler m a -> Handler m b -> Handler m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
Handler m a -> Handler m b -> Handler m a
<* :: forall a b. Handler m a -> Handler m b -> Handler m a
Applicative,
      Applicative (Handler m)
Applicative (Handler m)
-> (forall a b. Handler m a -> (a -> Handler m b) -> Handler m b)
-> (forall a b. Handler m a -> Handler m b -> Handler m b)
-> (forall a. a -> Handler m a)
-> Monad (Handler m)
forall a. a -> Handler m a
forall a b. Handler m a -> Handler m b -> Handler m b
forall a b. Handler m a -> (a -> Handler m b) -> Handler m b
forall (m :: * -> *). Monad m => Applicative (Handler m)
forall (m :: * -> *) a. Monad m => a -> Handler m a
forall (m :: * -> *) a b.
Monad m =>
Handler m a -> Handler m b -> Handler m b
forall (m :: * -> *) a b.
Monad m =>
Handler m a -> (a -> Handler m b) -> Handler m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
Handler m a -> (a -> Handler m b) -> Handler m b
>>= :: forall a b. Handler m a -> (a -> Handler m b) -> Handler m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
Handler m a -> Handler m b -> Handler m b
>> :: forall a b. Handler m a -> Handler m b -> Handler m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> Handler m a
return :: forall a. a -> Handler m a
Monad,
      Monad (Handler m)
Monad (Handler m)
-> (forall a. IO a -> Handler m a) -> MonadIO (Handler m)
forall a. IO a -> Handler m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (Handler m)
forall (m :: * -> *) a. MonadIO m => IO a -> Handler m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> Handler m a
liftIO :: forall a. IO a -> Handler m a
MonadIO,
      Monad (Handler m)
Monad (Handler m)
-> (forall a. (a -> Handler m a) -> Handler m a)
-> MonadFix (Handler m)
forall a. (a -> Handler m a) -> Handler m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (Handler m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> Handler m a) -> Handler m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> Handler m a) -> Handler m a
mfix :: forall a. (a -> Handler m a) -> Handler m a
MonadFix,
      MonadBase b,
      MonadBaseControl b,
      MonadReader HandlerCtx,
      MonadError QErr,
      Monad (Handler m)
Handler m (Maybe TraceContext)
Monad (Handler m)
-> (forall a.
    TraceContext
    -> SamplingPolicy -> Text -> Handler m a -> Handler m a)
-> (forall a. SpanId -> Text -> Handler m a -> Handler m a)
-> Handler m (Maybe TraceContext)
-> (TraceMetadata -> Handler m ())
-> MonadTrace (Handler m)
TraceMetadata -> Handler m ()
forall a. SpanId -> Text -> Handler m a -> Handler m a
forall a.
TraceContext
-> SamplingPolicy -> Text -> Handler m a -> Handler m a
forall (m :: * -> *).
Monad m
-> (forall a. TraceContext -> SamplingPolicy -> Text -> m a -> m a)
-> (forall a. SpanId -> Text -> m a -> m a)
-> m (Maybe TraceContext)
-> (TraceMetadata -> m ())
-> MonadTrace m
forall {m :: * -> *}. MonadTrace m => Monad (Handler m)
forall (m :: * -> *).
MonadTrace m =>
Handler m (Maybe TraceContext)
forall (m :: * -> *). MonadTrace m => TraceMetadata -> Handler m ()
forall (m :: * -> *) a.
MonadTrace m =>
SpanId -> Text -> Handler m a -> Handler m a
forall (m :: * -> *) a.
MonadTrace m =>
TraceContext
-> SamplingPolicy -> Text -> Handler m a -> Handler m a
$cnewTraceWith :: forall (m :: * -> *) a.
MonadTrace m =>
TraceContext
-> SamplingPolicy -> Text -> Handler m a -> Handler m a
newTraceWith :: forall a.
TraceContext
-> SamplingPolicy -> Text -> Handler m a -> Handler m a
$cnewSpanWith :: forall (m :: * -> *) a.
MonadTrace m =>
SpanId -> Text -> Handler m a -> Handler m a
newSpanWith :: forall a. SpanId -> Text -> Handler m a -> Handler m a
$ccurrentContext :: forall (m :: * -> *).
MonadTrace m =>
Handler m (Maybe TraceContext)
currentContext :: Handler m (Maybe TraceContext)
$cattachMetadata :: forall (m :: * -> *). MonadTrace m => TraceMetadata -> Handler m ()
attachMetadata :: TraceMetadata -> Handler m ()
MonadTrace,
      Monad (Handler m)
Handler m AppEnv
Monad (Handler m) -> Handler m AppEnv -> HasAppEnv (Handler m)
forall (m :: * -> *). Monad m -> m AppEnv -> HasAppEnv m
forall {m :: * -> *}. HasAppEnv m => Monad (Handler m)
forall (m :: * -> *). HasAppEnv m => Handler m AppEnv
$caskAppEnv :: forall (m :: * -> *). HasAppEnv m => Handler m AppEnv
askAppEnv :: Handler m AppEnv
HasAppEnv,
      Monad (Handler m)
Handler m CacheStaticConfig
Monad (Handler m)
-> Handler m CacheStaticConfig -> HasCacheStaticConfig (Handler m)
forall (m :: * -> *).
Monad m -> m CacheStaticConfig -> HasCacheStaticConfig m
forall {m :: * -> *}. HasCacheStaticConfig m => Monad (Handler m)
forall (m :: * -> *).
HasCacheStaticConfig m =>
Handler m CacheStaticConfig
$caskCacheStaticConfig :: forall (m :: * -> *).
HasCacheStaticConfig m =>
Handler m CacheStaticConfig
askCacheStaticConfig :: Handler m CacheStaticConfig
HasCacheStaticConfig,
      Monad (Handler m)
Monad (Handler m)
-> (FeatureFlag -> Handler m Bool)
-> HasFeatureFlagChecker (Handler m)
FeatureFlag -> Handler m Bool
forall (m :: * -> *).
Monad m -> (FeatureFlag -> m Bool) -> HasFeatureFlagChecker m
forall {m :: * -> *}. HasFeatureFlagChecker m => Monad (Handler m)
forall (m :: * -> *).
HasFeatureFlagChecker m =>
FeatureFlag -> Handler m Bool
$ccheckFlag :: forall (m :: * -> *).
HasFeatureFlagChecker m =>
FeatureFlag -> Handler m Bool
checkFlag :: FeatureFlag -> Handler m Bool
HasFeatureFlagChecker,
      Monad (Handler m)
Handler m ResourceLimits
Monad (Handler m)
-> Handler m ResourceLimits
-> (RequestId -> UserInfo -> ApiLimit -> Handler m ResourceLimits)
-> HasResourceLimits (Handler m)
RequestId -> UserInfo -> ApiLimit -> Handler m ResourceLimits
forall (m :: * -> *).
Monad m
-> m ResourceLimits
-> (RequestId -> UserInfo -> ApiLimit -> m ResourceLimits)
-> HasResourceLimits m
forall {m :: * -> *}. HasResourceLimits m => Monad (Handler m)
forall (m :: * -> *).
HasResourceLimits m =>
Handler m ResourceLimits
forall (m :: * -> *).
HasResourceLimits m =>
RequestId -> UserInfo -> ApiLimit -> Handler m ResourceLimits
$caskHTTPHandlerLimit :: forall (m :: * -> *).
HasResourceLimits m =>
Handler m ResourceLimits
askHTTPHandlerLimit :: Handler m ResourceLimits
$caskGraphqlOperationLimit :: forall (m :: * -> *).
HasResourceLimits m =>
RequestId -> UserInfo -> ApiLimit -> Handler m ResourceLimits
askGraphqlOperationLimit :: RequestId -> UserInfo -> ApiLimit -> Handler m ResourceLimits
HasResourceLimits,
      Monad (Handler m)
Handler m (SourceResolver ('Postgres 'Vanilla))
Handler m (SourceResolver 'MSSQL)
Monad (Handler m)
-> Handler m (SourceResolver ('Postgres 'Vanilla))
-> Handler m (SourceResolver 'MSSQL)
-> MonadResolveSource (Handler m)
forall (m :: * -> *).
Monad m
-> m (SourceResolver ('Postgres 'Vanilla))
-> m (SourceResolver 'MSSQL)
-> MonadResolveSource m
forall {m :: * -> *}. MonadResolveSource m => Monad (Handler m)
forall (m :: * -> *).
MonadResolveSource m =>
Handler m (SourceResolver ('Postgres 'Vanilla))
forall (m :: * -> *).
MonadResolveSource m =>
Handler m (SourceResolver 'MSSQL)
$cgetPGSourceResolver :: forall (m :: * -> *).
MonadResolveSource m =>
Handler m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver :: Handler m (SourceResolver ('Postgres 'Vanilla))
$cgetMSSQLSourceResolver :: forall (m :: * -> *).
MonadResolveSource m =>
Handler m (SourceResolver 'MSSQL)
getMSSQLSourceResolver :: Handler m (SourceResolver 'MSSQL)
MonadResolveSource,
      Monad (Handler m)
Monad (Handler m)
-> (UserInfo
    -> ([Header], IpAddress)
    -> AllowListStatus
    -> SchemaCache
    -> GQLReqUnparsed
    -> RequestId
    -> Handler m (Either QErr GQLReqParsed))
-> (UserInfo
    -> Value
    -> SetGraphqlIntrospectionOptions
    -> Handler m (Either QErr ExecutionStep))
-> (UserInfo
    -> RequestId
    -> [GQLReqUnparsed]
    -> SchemaCache
    -> Handler m (Either QErr ()))
-> MonadGQLExecutionCheck (Handler m)
UserInfo
-> ([Header], IpAddress)
-> AllowListStatus
-> SchemaCache
-> GQLReqUnparsed
-> RequestId
-> Handler m (Either QErr GQLReqParsed)
UserInfo
-> Value
-> SetGraphqlIntrospectionOptions
-> Handler m (Either QErr ExecutionStep)
UserInfo
-> RequestId
-> [GQLReqUnparsed]
-> SchemaCache
-> Handler m (Either QErr ())
forall (m :: * -> *).
Monad m
-> (UserInfo
    -> ([Header], IpAddress)
    -> AllowListStatus
    -> SchemaCache
    -> GQLReqUnparsed
    -> RequestId
    -> m (Either QErr GQLReqParsed))
-> (UserInfo
    -> Value
    -> SetGraphqlIntrospectionOptions
    -> m (Either QErr ExecutionStep))
-> (UserInfo
    -> RequestId
    -> [GQLReqUnparsed]
    -> SchemaCache
    -> m (Either QErr ()))
-> MonadGQLExecutionCheck m
forall {m :: * -> *}. MonadGQLExecutionCheck m => Monad (Handler m)
forall (m :: * -> *).
MonadGQLExecutionCheck m =>
UserInfo
-> ([Header], IpAddress)
-> AllowListStatus
-> SchemaCache
-> GQLReqUnparsed
-> RequestId
-> Handler m (Either QErr GQLReqParsed)
forall (m :: * -> *).
MonadGQLExecutionCheck m =>
UserInfo
-> Value
-> SetGraphqlIntrospectionOptions
-> Handler m (Either QErr ExecutionStep)
forall (m :: * -> *).
MonadGQLExecutionCheck m =>
UserInfo
-> RequestId
-> [GQLReqUnparsed]
-> SchemaCache
-> Handler m (Either QErr ())
$ccheckGQLExecution :: forall (m :: * -> *).
MonadGQLExecutionCheck m =>
UserInfo
-> ([Header], IpAddress)
-> AllowListStatus
-> SchemaCache
-> GQLReqUnparsed
-> RequestId
-> Handler m (Either QErr GQLReqParsed)
checkGQLExecution :: UserInfo
-> ([Header], IpAddress)
-> AllowListStatus
-> SchemaCache
-> GQLReqUnparsed
-> RequestId
-> Handler m (Either QErr GQLReqParsed)
$cexecuteIntrospection :: forall (m :: * -> *).
MonadGQLExecutionCheck m =>
UserInfo
-> Value
-> SetGraphqlIntrospectionOptions
-> Handler m (Either QErr ExecutionStep)
executeIntrospection :: UserInfo
-> Value
-> SetGraphqlIntrospectionOptions
-> Handler m (Either QErr ExecutionStep)
$ccheckGQLBatchedReqs :: forall (m :: * -> *).
MonadGQLExecutionCheck m =>
UserInfo
-> RequestId
-> [GQLReqUnparsed]
-> SchemaCache
-> Handler m (Either QErr ())
checkGQLBatchedReqs :: UserInfo
-> RequestId
-> [GQLReqUnparsed]
-> SchemaCache
-> Handler m (Either QErr ())
E.MonadGQLExecutionCheck,
      Monad (Handler m)
Monad (Handler m)
-> (SourceCache
    -> TriggerLogCleanupConfig -> Handler m (Either QErr EncJSON))
-> (AnyBackend SourceInfo
    -> TriggerName
    -> AutoTriggerLogCleanupConfig
    -> Handler m (Either QErr ()))
-> (Logger Hasura
    -> InsOrdHashMap SourceName BackendSourceMetadata
    -> InsOrdHashMap SourceName BackendSourceMetadata
    -> SchemaCache
    -> Handler m (Either QErr ()))
-> MonadEventLogCleanup (Handler m)
SourceCache
-> TriggerLogCleanupConfig -> Handler m (Either QErr EncJSON)
Logger Hasura
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
-> SchemaCache
-> Handler m (Either QErr ())
AnyBackend SourceInfo
-> TriggerName
-> AutoTriggerLogCleanupConfig
-> Handler m (Either QErr ())
forall (m :: * -> *).
Monad m
-> (SourceCache
    -> TriggerLogCleanupConfig -> m (Either QErr EncJSON))
-> (AnyBackend SourceInfo
    -> TriggerName
    -> AutoTriggerLogCleanupConfig
    -> m (Either QErr ()))
-> (Logger Hasura
    -> InsOrdHashMap SourceName BackendSourceMetadata
    -> InsOrdHashMap SourceName BackendSourceMetadata
    -> SchemaCache
    -> m (Either QErr ()))
-> MonadEventLogCleanup m
forall {m :: * -> *}. MonadEventLogCleanup m => Monad (Handler m)
forall (m :: * -> *).
MonadEventLogCleanup m =>
SourceCache
-> TriggerLogCleanupConfig -> Handler m (Either QErr EncJSON)
forall (m :: * -> *).
MonadEventLogCleanup m =>
Logger Hasura
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
-> SchemaCache
-> Handler m (Either QErr ())
forall (m :: * -> *).
MonadEventLogCleanup m =>
AnyBackend SourceInfo
-> TriggerName
-> AutoTriggerLogCleanupConfig
-> Handler m (Either QErr ())
$crunLogCleaner :: forall (m :: * -> *).
MonadEventLogCleanup m =>
SourceCache
-> TriggerLogCleanupConfig -> Handler m (Either QErr EncJSON)
runLogCleaner :: SourceCache
-> TriggerLogCleanupConfig -> Handler m (Either QErr EncJSON)
$cgenerateCleanupSchedules :: forall (m :: * -> *).
MonadEventLogCleanup m =>
AnyBackend SourceInfo
-> TriggerName
-> AutoTriggerLogCleanupConfig
-> Handler m (Either QErr ())
generateCleanupSchedules :: AnyBackend SourceInfo
-> TriggerName
-> AutoTriggerLogCleanupConfig
-> Handler m (Either QErr ())
$cupdateTriggerCleanupSchedules :: forall (m :: * -> *).
MonadEventLogCleanup m =>
Logger Hasura
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
-> SchemaCache
-> Handler m (Either QErr ())
updateTriggerCleanupSchedules :: Logger Hasura
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
-> SchemaCache
-> Handler m (Either QErr ())
MonadEventLogCleanup,
      Monad (Handler m)
Monad (Handler m)
-> (Logger Hasura -> QueryLog -> Handler m ())
-> MonadQueryLog (Handler m)
Logger Hasura -> QueryLog -> Handler m ()
forall (m :: * -> *).
Monad m -> (Logger Hasura -> QueryLog -> m ()) -> MonadQueryLog m
forall {m :: * -> *}. MonadQueryLog m => Monad (Handler m)
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> Handler m ()
$clogQueryLog :: forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> Handler m ()
logQueryLog :: Logger Hasura -> QueryLog -> Handler m ()
MonadQueryLog,
      Monad (Handler m)
Monad (Handler m)
-> (Logger Hasura -> ExecutionLog -> Handler m ())
-> MonadExecutionLog (Handler m)
Logger Hasura -> ExecutionLog -> Handler m ()
forall (m :: * -> *).
Monad m
-> (Logger Hasura -> ExecutionLog -> m ()) -> MonadExecutionLog m
forall {m :: * -> *}. MonadExecutionLog m => Monad (Handler m)
forall (m :: * -> *).
MonadExecutionLog m =>
Logger Hasura -> ExecutionLog -> Handler m ()
$clogExecutionLog :: forall (m :: * -> *).
MonadExecutionLog m =>
Logger Hasura -> ExecutionLog -> Handler m ()
logExecutionLog :: Logger Hasura -> ExecutionLog -> Handler m ()
MonadExecutionLog,
      Monad (Handler m)
Monad (Handler m)
-> (QueryTagsAttributes
    -> Maybe QueryTagsConfig -> Tagged (Handler m) QueryTagsComment)
-> MonadQueryTags (Handler m)
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (Handler m) QueryTagsComment
forall (m :: * -> *).
Monad m
-> (QueryTagsAttributes
    -> Maybe QueryTagsConfig -> Tagged m QueryTagsComment)
-> MonadQueryTags m
forall {m :: * -> *}. MonadQueryTags m => Monad (Handler m)
forall (m :: * -> *).
MonadQueryTags m =>
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (Handler m) QueryTagsComment
$ccreateQueryTags :: forall (m :: * -> *).
MonadQueryTags m =>
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (Handler m) QueryTagsComment
createQueryTags :: QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (Handler m) QueryTagsComment
MonadQueryTags,
      Monad (Handler m)
Monad (Handler m)
-> (ExecutionPlan
    -> [QueryRootField UnpreparedValue]
    -> Maybe CachedDirective
    -> GQLReqParsed
    -> UserInfo
    -> [Header]
    -> Handler m (Either QErr ([Header], CacheResult)))
-> MonadExecuteQuery (Handler m)
ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> Maybe CachedDirective
-> GQLReqParsed
-> UserInfo
-> [Header]
-> Handler m (Either QErr ([Header], CacheResult))
forall (m :: * -> *).
Monad m
-> (ExecutionPlan
    -> [QueryRootField UnpreparedValue]
    -> Maybe CachedDirective
    -> GQLReqParsed
    -> UserInfo
    -> [Header]
    -> m (Either QErr ([Header], CacheResult)))
-> MonadExecuteQuery m
forall {m :: * -> *}. MonadExecuteQuery m => Monad (Handler m)
forall (m :: * -> *).
MonadExecuteQuery m =>
ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> Maybe CachedDirective
-> GQLReqParsed
-> UserInfo
-> [Header]
-> Handler m (Either QErr ([Header], CacheResult))
$ccacheLookup :: forall (m :: * -> *).
MonadExecuteQuery m =>
ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> Maybe CachedDirective
-> GQLReqParsed
-> UserInfo
-> [Header]
-> Handler m (Either QErr ([Header], CacheResult))
cacheLookup :: ExecutionPlan
-> [QueryRootField UnpreparedValue]
-> Maybe CachedDirective
-> GQLReqParsed
-> UserInfo
-> [Header]
-> Handler m (Either QErr ([Header], CacheResult))
GH.MonadExecuteQuery,
      Monad (Handler m)
Monad (Handler m)
-> (RQLQuery -> HandlerCtx -> Handler m (Either QErr ()))
-> (RQLMetadata -> HandlerCtx -> Handler m (Either QErr ()))
-> (RQLQuery -> HandlerCtx -> Handler m (Either QErr ()))
-> MonadMetadataApiAuthorization (Handler m)
RQLQuery -> HandlerCtx -> Handler m (Either QErr ())
RQLQuery -> HandlerCtx -> Handler m (Either QErr ())
RQLMetadata -> HandlerCtx -> Handler m (Either QErr ())
forall (m :: * -> *).
Monad m
-> (RQLQuery -> HandlerCtx -> m (Either QErr ()))
-> (RQLMetadata -> HandlerCtx -> m (Either QErr ()))
-> (RQLQuery -> HandlerCtx -> m (Either QErr ()))
-> MonadMetadataApiAuthorization m
forall {m :: * -> *}.
MonadMetadataApiAuthorization m =>
Monad (Handler m)
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLMetadata -> HandlerCtx -> Handler m (Either QErr ())
$cauthorizeV1QueryApi :: forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> Handler m (Either QErr ())
authorizeV1QueryApi :: RQLQuery -> HandlerCtx -> Handler m (Either QErr ())
$cauthorizeV1MetadataApi :: forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLMetadata -> HandlerCtx -> Handler m (Either QErr ())
authorizeV1MetadataApi :: RQLMetadata -> HandlerCtx -> Handler m (Either QErr ())
$cauthorizeV2QueryApi :: forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> Handler m (Either QErr ())
authorizeV2QueryApi :: RQLQuery -> HandlerCtx -> Handler m (Either QErr ())
MonadMetadataApiAuthorization,
      Monad (Handler m)
Handler m (Either QErr [ActionLogItem])
Handler m (Either QErr ())
Handler m (Either QErr MetadataDbId)
Handler m (Either QErr CatalogState)
Handler m (Either QErr MetadataWithResourceVersion)
Handler m (Either QErr MetadataResourceVersion)
Monad (Handler m)
-> Handler m (Either QErr MetadataResourceVersion)
-> Handler m (Either QErr MetadataWithResourceVersion)
-> (MetadataResourceVersion
    -> InstanceId
    -> Handler
         m (Either QErr [(MetadataResourceVersion, CacheInvalidations)]))
-> (MetadataResourceVersion
    -> Metadata -> Handler m (Either QErr MetadataResourceVersion))
-> (MetadataResourceVersion
    -> InstanceId -> CacheInvalidations -> Handler m (Either QErr ()))
-> Handler m (Either QErr CatalogState)
-> (CatalogStateType -> Value -> Handler m (Either QErr ()))
-> (MetadataResourceVersion
    -> Handler m (Either QErr (Maybe StoredIntrospection)))
-> (StoredIntrospection
    -> MetadataResourceVersion -> Handler m (Either QErr ()))
-> Handler m (Either QErr MetadataDbId)
-> Handler m (Either QErr ())
-> ([TriggerName] -> Handler m (Either QErr [CronTriggerStats]))
-> ([TriggerName]
    -> Handler m (Either QErr ([CronEvent], [OneOffScheduledEvent])))
-> ([CronEventSeed] -> Handler m (Either QErr ()))
-> (OneOffEvent -> Handler m (Either QErr EventId))
-> (Invocation 'ScheduledType
    -> ScheduledEventType -> Handler m (Either QErr ()))
-> (EventId
    -> ScheduledEventOp
    -> ScheduledEventType
    -> Handler m (Either QErr ()))
-> (ScheduledEventType -> [EventId] -> Handler m (Either QErr Int))
-> Handler m (Either QErr ())
-> (ClearCronEvents -> Handler m (Either QErr ()))
-> (ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> RowsCountOption
    -> Handler
         m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent])))
-> (TriggerName
    -> ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> RowsCountOption
    -> Handler m (Either QErr (WithOptionalTotalCount [CronEvent])))
-> (GetScheduledEventInvocations
    -> Handler
         m
         (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation])))
-> (EventId -> ScheduledEventType -> Handler m (Either QErr ()))
-> (ActionName
    -> SessionVariables
    -> [Header]
    -> Value
    -> Handler m (Either QErr ActionId))
-> Handler m (Either QErr [ActionLogItem])
-> (ActionId -> AsyncActionStatus -> Handler m (Either QErr ()))
-> (ActionId -> Handler m (Either QErr ActionLogResponse))
-> (ActionName -> Handler m (Either QErr ()))
-> (LockedActionIdArray -> Handler m (Either QErr ()))
-> MonadMetadataStorage (Handler m)
[TriggerName] -> Handler m (Either QErr [CronTriggerStats])
[TriggerName]
-> Handler m (Either QErr ([CronEvent], [OneOffScheduledEvent]))
[CronEventSeed] -> Handler m (Either QErr ())
Invocation 'ScheduledType
-> ScheduledEventType -> Handler m (Either QErr ())
EventId -> ScheduledEventType -> Handler m (Either QErr ())
EventId
-> ScheduledEventOp
-> ScheduledEventType
-> Handler m (Either QErr ())
TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> Handler m (Either QErr (WithOptionalTotalCount [CronEvent]))
ClearCronEvents -> Handler m (Either QErr ())
GetScheduledEventInvocations
-> Handler
     m (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> Handler
     m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent]))
ScheduledEventType -> [EventId] -> Handler m (Either QErr Int)
OneOffEvent -> Handler m (Either QErr EventId)
LockedActionIdArray -> Handler m (Either QErr ())
ActionId -> Handler m (Either QErr ActionLogResponse)
ActionId -> AsyncActionStatus -> Handler m (Either QErr ())
ActionName -> Handler m (Either QErr ())
ActionName
-> SessionVariables
-> [Header]
-> Value
-> Handler m (Either QErr ActionId)
CatalogStateType -> Value -> Handler m (Either QErr ())
MetadataResourceVersion
-> Handler m (Either QErr (Maybe StoredIntrospection))
MetadataResourceVersion
-> InstanceId
-> Handler
     m (Either QErr [(MetadataResourceVersion, CacheInvalidations)])
MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> Handler m (Either QErr ())
MetadataResourceVersion
-> Metadata -> Handler m (Either QErr MetadataResourceVersion)
StoredIntrospection
-> MetadataResourceVersion -> Handler m (Either QErr ())
forall (m :: * -> *).
Monad m
-> m (Either QErr MetadataResourceVersion)
-> m (Either QErr MetadataWithResourceVersion)
-> (MetadataResourceVersion
    -> InstanceId
    -> m (Either QErr [(MetadataResourceVersion, CacheInvalidations)]))
-> (MetadataResourceVersion
    -> Metadata -> m (Either QErr MetadataResourceVersion))
-> (MetadataResourceVersion
    -> InstanceId -> CacheInvalidations -> m (Either QErr ()))
-> m (Either QErr CatalogState)
-> (CatalogStateType -> Value -> m (Either QErr ()))
-> (MetadataResourceVersion
    -> m (Either QErr (Maybe StoredIntrospection)))
-> (StoredIntrospection
    -> MetadataResourceVersion -> m (Either QErr ()))
-> m (Either QErr MetadataDbId)
-> m (Either QErr ())
-> ([TriggerName] -> m (Either QErr [CronTriggerStats]))
-> ([TriggerName]
    -> m (Either QErr ([CronEvent], [OneOffScheduledEvent])))
-> ([CronEventSeed] -> m (Either QErr ()))
-> (OneOffEvent -> m (Either QErr EventId))
-> (Invocation 'ScheduledType
    -> ScheduledEventType -> m (Either QErr ()))
-> (EventId
    -> ScheduledEventOp -> ScheduledEventType -> m (Either QErr ()))
-> (ScheduledEventType -> [EventId] -> m (Either QErr Int))
-> m (Either QErr ())
-> (ClearCronEvents -> m (Either QErr ()))
-> (ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> RowsCountOption
    -> m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent])))
-> (TriggerName
    -> ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> RowsCountOption
    -> m (Either QErr (WithOptionalTotalCount [CronEvent])))
-> (GetScheduledEventInvocations
    -> m (Either
            QErr (WithOptionalTotalCount [ScheduledEventInvocation])))
-> (EventId -> ScheduledEventType -> m (Either QErr ()))
-> (ActionName
    -> SessionVariables
    -> [Header]
    -> Value
    -> m (Either QErr ActionId))
-> m (Either QErr [ActionLogItem])
-> (ActionId -> AsyncActionStatus -> m (Either QErr ()))
-> (ActionId -> m (Either QErr ActionLogResponse))
-> (ActionName -> m (Either QErr ()))
-> (LockedActionIdArray -> m (Either QErr ()))
-> MonadMetadataStorage m
forall {m :: * -> *}. MonadMetadataStorage m => Monad (Handler m)
forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr [ActionLogItem])
forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr MetadataDbId)
forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr CatalogState)
forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr MetadataWithResourceVersion)
forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr MetadataResourceVersion)
forall (m :: * -> *).
MonadMetadataStorage m =>
[TriggerName] -> Handler m (Either QErr [CronTriggerStats])
forall (m :: * -> *).
MonadMetadataStorage m =>
[TriggerName]
-> Handler m (Either QErr ([CronEvent], [OneOffScheduledEvent]))
forall (m :: * -> *).
MonadMetadataStorage m =>
[CronEventSeed] -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
Invocation 'ScheduledType
-> ScheduledEventType -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
EventId -> ScheduledEventType -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
EventId
-> ScheduledEventOp
-> ScheduledEventType
-> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> Handler m (Either QErr (WithOptionalTotalCount [CronEvent]))
forall (m :: * -> *).
MonadMetadataStorage m =>
ClearCronEvents -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
GetScheduledEventInvocations
-> Handler
     m (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> Handler
     m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent]))
forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventType -> [EventId] -> Handler m (Either QErr Int)
forall (m :: * -> *).
MonadMetadataStorage m =>
OneOffEvent -> Handler m (Either QErr EventId)
forall (m :: * -> *).
MonadMetadataStorage m =>
LockedActionIdArray -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> Handler m (Either QErr ActionLogResponse)
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> AsyncActionStatus -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName
-> SessionVariables
-> [Header]
-> Value
-> Handler m (Either QErr ActionId)
forall (m :: * -> *).
MonadMetadataStorage m =>
CatalogStateType -> Value -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> Handler m (Either QErr (Maybe StoredIntrospection))
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId
-> Handler
     m (Either QErr [(MetadataResourceVersion, CacheInvalidations)])
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> Handler m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> Metadata -> Handler m (Either QErr MetadataResourceVersion)
forall (m :: * -> *).
MonadMetadataStorage m =>
StoredIntrospection
-> MetadataResourceVersion -> Handler m (Either QErr ())
$cfetchMetadataResourceVersion :: forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr MetadataResourceVersion)
fetchMetadataResourceVersion :: Handler m (Either QErr MetadataResourceVersion)
$cfetchMetadata :: forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr MetadataWithResourceVersion)
fetchMetadata :: Handler m (Either QErr MetadataWithResourceVersion)
$cfetchMetadataNotifications :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId
-> Handler
     m (Either QErr [(MetadataResourceVersion, CacheInvalidations)])
fetchMetadataNotifications :: MetadataResourceVersion
-> InstanceId
-> Handler
     m (Either QErr [(MetadataResourceVersion, CacheInvalidations)])
$csetMetadata :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> Metadata -> Handler m (Either QErr MetadataResourceVersion)
setMetadata :: MetadataResourceVersion
-> Metadata -> Handler m (Either QErr MetadataResourceVersion)
$cnotifySchemaCacheSync :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> Handler m (Either QErr ())
notifySchemaCacheSync :: MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> Handler m (Either QErr ())
$cgetCatalogState :: forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr CatalogState)
getCatalogState :: Handler m (Either QErr CatalogState)
$csetCatalogState :: forall (m :: * -> *).
MonadMetadataStorage m =>
CatalogStateType -> Value -> Handler m (Either QErr ())
setCatalogState :: CatalogStateType -> Value -> Handler m (Either QErr ())
$cfetchSourceIntrospection :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> Handler m (Either QErr (Maybe StoredIntrospection))
fetchSourceIntrospection :: MetadataResourceVersion
-> Handler m (Either QErr (Maybe StoredIntrospection))
$cstoreSourceIntrospection :: forall (m :: * -> *).
MonadMetadataStorage m =>
StoredIntrospection
-> MetadataResourceVersion -> Handler m (Either QErr ())
storeSourceIntrospection :: StoredIntrospection
-> MetadataResourceVersion -> Handler m (Either QErr ())
$cgetMetadataDbUid :: forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr MetadataDbId)
getMetadataDbUid :: Handler m (Either QErr MetadataDbId)
$ccheckMetadataStorageHealth :: forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr ())
checkMetadataStorageHealth :: Handler m (Either QErr ())
$cgetDeprivedCronTriggerStats :: forall (m :: * -> *).
MonadMetadataStorage m =>
[TriggerName] -> Handler m (Either QErr [CronTriggerStats])
getDeprivedCronTriggerStats :: [TriggerName] -> Handler m (Either QErr [CronTriggerStats])
$cgetScheduledEventsForDelivery :: forall (m :: * -> *).
MonadMetadataStorage m =>
[TriggerName]
-> Handler m (Either QErr ([CronEvent], [OneOffScheduledEvent]))
getScheduledEventsForDelivery :: [TriggerName]
-> Handler m (Either QErr ([CronEvent], [OneOffScheduledEvent]))
$cinsertCronEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
[CronEventSeed] -> Handler m (Either QErr ())
insertCronEvents :: [CronEventSeed] -> Handler m (Either QErr ())
$cinsertOneOffScheduledEvent :: forall (m :: * -> *).
MonadMetadataStorage m =>
OneOffEvent -> Handler m (Either QErr EventId)
insertOneOffScheduledEvent :: OneOffEvent -> Handler m (Either QErr EventId)
$cinsertScheduledEventInvocation :: forall (m :: * -> *).
MonadMetadataStorage m =>
Invocation 'ScheduledType
-> ScheduledEventType -> Handler m (Either QErr ())
insertScheduledEventInvocation :: Invocation 'ScheduledType
-> ScheduledEventType -> Handler m (Either QErr ())
$csetScheduledEventOp :: forall (m :: * -> *).
MonadMetadataStorage m =>
EventId
-> ScheduledEventOp
-> ScheduledEventType
-> Handler m (Either QErr ())
setScheduledEventOp :: EventId
-> ScheduledEventOp
-> ScheduledEventType
-> Handler m (Either QErr ())
$cunlockScheduledEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventType -> [EventId] -> Handler m (Either QErr Int)
unlockScheduledEvents :: ScheduledEventType -> [EventId] -> Handler m (Either QErr Int)
$cunlockAllLockedScheduledEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr ())
unlockAllLockedScheduledEvents :: Handler m (Either QErr ())
$cclearFutureCronEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
ClearCronEvents -> Handler m (Either QErr ())
clearFutureCronEvents :: ClearCronEvents -> Handler m (Either QErr ())
$cgetOneOffScheduledEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> Handler
     m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent]))
getOneOffScheduledEvents :: ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> Handler
     m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent]))
$cgetCronEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> Handler m (Either QErr (WithOptionalTotalCount [CronEvent]))
getCronEvents :: TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> Handler m (Either QErr (WithOptionalTotalCount [CronEvent]))
$cgetScheduledEventInvocations :: forall (m :: * -> *).
MonadMetadataStorage m =>
GetScheduledEventInvocations
-> Handler
     m (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
getScheduledEventInvocations :: GetScheduledEventInvocations
-> Handler
     m (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
$cdeleteScheduledEvent :: forall (m :: * -> *).
MonadMetadataStorage m =>
EventId -> ScheduledEventType -> Handler m (Either QErr ())
deleteScheduledEvent :: EventId -> ScheduledEventType -> Handler m (Either QErr ())
$cinsertAction :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName
-> SessionVariables
-> [Header]
-> Value
-> Handler m (Either QErr ActionId)
insertAction :: ActionName
-> SessionVariables
-> [Header]
-> Value
-> Handler m (Either QErr ActionId)
$cfetchUndeliveredActionEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
Handler m (Either QErr [ActionLogItem])
fetchUndeliveredActionEvents :: Handler m (Either QErr [ActionLogItem])
$csetActionStatus :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> AsyncActionStatus -> Handler m (Either QErr ())
setActionStatus :: ActionId -> AsyncActionStatus -> Handler m (Either QErr ())
$cfetchActionResponse :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> Handler m (Either QErr ActionLogResponse)
fetchActionResponse :: ActionId -> Handler m (Either QErr ActionLogResponse)
$cclearActionData :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName -> Handler m (Either QErr ())
clearActionData :: ActionName -> Handler m (Either QErr ())
$csetProcessingActionLogsToPending :: forall (m :: * -> *).
MonadMetadataStorage m =>
LockedActionIdArray -> Handler m (Either QErr ())
setProcessingActionLogsToPending :: LockedActionIdArray -> Handler m (Either QErr ())
MonadMetadataStorage,
      Monad (Handler m)
Handler m Manager
Monad (Handler m)
-> Handler m Manager -> ProvidesNetwork (Handler m)
forall (m :: * -> *). Monad m -> m Manager -> ProvidesNetwork m
forall {m :: * -> *}. ProvidesNetwork m => Monad (Handler m)
forall (m :: * -> *). ProvidesNetwork m => Handler m Manager
$caskHTTPManager :: forall (m :: * -> *). ProvidesNetwork m => Handler m Manager
askHTTPManager :: Handler m Manager
ProvidesNetwork,
      Monad (Handler m)
Handler m (Maybe MaxTime)
Handler m (IO GranularPrometheusMetricsState)
Monad (Handler m)
-> Handler m (Maybe MaxTime)
-> Handler m (IO GranularPrometheusMetricsState)
-> MonadGetPolicies (Handler m)
forall (m :: * -> *).
Monad m
-> m (Maybe MaxTime)
-> m (IO GranularPrometheusMetricsState)
-> MonadGetPolicies m
forall {m :: * -> *}. MonadGetPolicies m => Monad (Handler m)
forall (m :: * -> *).
MonadGetPolicies m =>
Handler m (Maybe MaxTime)
forall (m :: * -> *).
MonadGetPolicies m =>
Handler m (IO GranularPrometheusMetricsState)
$crunGetApiTimeLimit :: forall (m :: * -> *).
MonadGetPolicies m =>
Handler m (Maybe MaxTime)
runGetApiTimeLimit :: Handler m (Maybe MaxTime)
$crunGetPrometheusMetricsGranularity :: forall (m :: * -> *).
MonadGetPolicies m =>
Handler m (IO GranularPrometheusMetricsState)
runGetPrometheusMetricsGranularity :: Handler m (IO GranularPrometheusMetricsState)
MonadGetPolicies
    )

instance MonadTrans Handler where
  lift :: forall (m :: * -> *) a. Monad m => m a -> Handler m a
lift = ReaderT HandlerCtx (ExceptT QErr m) a -> Handler m a
forall (m :: * -> *) a.
ReaderT HandlerCtx (ExceptT QErr m) a -> Handler m a
Handler (ReaderT HandlerCtx (ExceptT QErr m) a -> Handler m a)
-> (m a -> ReaderT HandlerCtx (ExceptT QErr m) a)
-> m a
-> Handler m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT QErr m a -> ReaderT HandlerCtx (ExceptT QErr m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT HandlerCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT QErr m a -> ReaderT HandlerCtx (ExceptT QErr m) a)
-> (m a -> ExceptT QErr m a)
-> m a
-> ReaderT HandlerCtx (ExceptT QErr m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT QErr m a
forall (m :: * -> *) a. Monad m => m a -> ExceptT QErr m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (Monad m) => UserInfoM (Handler m) where
  askUserInfo :: Handler m UserInfo
askUserInfo = (HandlerCtx -> UserInfo) -> Handler m UserInfo
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> UserInfo
hcUser

runHandler :: (HasResourceLimits m, MonadBaseControl IO m) => L.Logger L.Hasura -> HandlerCtx -> Handler m a -> m (Either QErr a)
runHandler :: forall (m :: * -> *) a.
(HasResourceLimits m, MonadBaseControl IO m) =>
Logger Hasura -> HandlerCtx -> Handler m a -> m (Either QErr a)
runHandler Logger Hasura
logger HandlerCtx
ctx (Handler ReaderT HandlerCtx (ExceptT QErr m) a
r) = do
  ResourceLimits
handlerLimit <- m ResourceLimits
forall (m :: * -> *). HasResourceLimits m => m ResourceLimits
askHTTPHandlerLimit
  ExceptT QErr m a -> m (Either QErr a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT HandlerCtx (ExceptT QErr m) a
-> HandlerCtx -> ExceptT QErr m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ResourceLimits
-> forall (m :: * -> *) a.
   (MonadBaseControl IO m, MonadError QErr m) =>
   m a -> m a
runResourceLimits ResourceLimits
handlerLimit ReaderT HandlerCtx (ExceptT QErr m) a
r) HandlerCtx
ctx)
    m (Either QErr a)
-> (ErrorCall -> m (Either QErr a)) -> m (Either QErr a)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \errorCallWithLoc :: ErrorCall
errorCallWithLoc@(ErrorCallWithLocation [Char]
txt [Char]
_) -> do
      IO () -> m ()
forall α. IO α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> forall a (m :: * -> *).
   (ToEngineLog a Hasura, MonadIO m) =>
   a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
L.unLogger Logger Hasura
logger (UnhandledInternalErrorLog -> IO ())
-> UnhandledInternalErrorLog -> IO ()
forall a b. (a -> b) -> a -> b
$ ErrorCall -> UnhandledInternalErrorLog
L.UnhandledInternalErrorLog ErrorCall
errorCallWithLoc
      Either QErr a -> m (Either QErr a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either QErr a -> m (Either QErr a))
-> Either QErr a -> m (Either QErr a)
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Either QErr a
forall (m :: * -> *) a. QErrM m => Text -> Value -> m a
throw500WithDetail Text
"Internal Server Error"
        (Value -> Either QErr a) -> Value -> Either QErr a
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [(Key
"error", [Char] -> Value
forall a. IsString a => [Char] -> a
fromString [Char]
txt)]

data APIResp
  = JSONResp !(HttpResponse EncJSON)
  | RawResp !(HttpResponse BL.ByteString)

-- | API request handlers for different endpoints
data APIHandler m a where
  -- | A simple GET request
  AHGet :: !(Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m void
  -- | A simple POST request that expects a request body from which an 'a' can be extracted
  AHPost :: !(a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
  -- | A general GraphQL request (query or mutation) for which the content of the query
  -- is made available to the handler for authentication.
  -- This is a more specific version of the 'AHPost' constructor.
  AHGraphQLRequest :: !(GH.ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m GH.ReqsText

boolToText :: Bool -> Text
boolToText :: Bool -> Text
boolToText = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true"

isAdminSecretSet :: AuthMode -> Text
isAdminSecretSet :: AuthMode -> Text
isAdminSecretSet AuthMode
AMNoAuth = Bool -> Text
boolToText Bool
False
isAdminSecretSet AuthMode
_ = Bool -> Text
boolToText Bool
True

mkGetHandler :: Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
mkGetHandler :: forall (m :: * -> *).
Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
mkGetHandler = Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall (m :: * -> *) void.
Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m void
AHGet

mkPostHandler :: (a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
mkPostHandler :: forall a (m :: * -> *).
(a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
mkPostHandler = (a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
forall a (m :: * -> *).
(a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
AHPost

mkGQLRequestHandler :: (GH.ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m GH.ReqsText
mkGQLRequestHandler :: forall (m :: * -> *).
(ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
mkGQLRequestHandler = (ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
forall (m :: * -> *).
(ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
AHGraphQLRequest

mkAPIRespHandler :: (Functor m) => (a -> Handler m (HttpResponse EncJSON)) -> (a -> Handler m APIResp)
mkAPIRespHandler :: forall (m :: * -> *) a.
Functor m =>
(a -> Handler m (HttpResponse EncJSON)) -> a -> Handler m APIResp
mkAPIRespHandler = ((Handler m (HttpResponse EncJSON) -> Handler m APIResp)
-> (a -> Handler m (HttpResponse EncJSON))
-> a
-> Handler m APIResp
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Handler m (HttpResponse EncJSON) -> Handler m APIResp)
 -> (a -> Handler m (HttpResponse EncJSON))
 -> a
 -> Handler m APIResp)
-> ((HttpResponse EncJSON -> APIResp)
    -> Handler m (HttpResponse EncJSON) -> Handler m APIResp)
-> (HttpResponse EncJSON -> APIResp)
-> (a -> Handler m (HttpResponse EncJSON))
-> a
-> Handler m APIResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HttpResponse EncJSON -> APIResp)
-> Handler m (HttpResponse EncJSON) -> Handler m APIResp
forall a b. (a -> b) -> Handler m a -> Handler m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) HttpResponse EncJSON -> APIResp
JSONResp

mkGQLAPIRespHandler ::
  (Functor m) =>
  (a -> Handler m (b, (HttpResponse EncJSON))) ->
  (a -> Handler m (b, APIResp))
mkGQLAPIRespHandler :: forall (m :: * -> *) a b.
Functor m =>
(a -> Handler m (b, HttpResponse EncJSON))
-> a -> Handler m (b, APIResp)
mkGQLAPIRespHandler = ((Handler m (b, HttpResponse EncJSON) -> Handler m (b, APIResp))
-> (a -> Handler m (b, HttpResponse EncJSON))
-> a
-> Handler m (b, APIResp)
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Handler m (b, HttpResponse EncJSON) -> Handler m (b, APIResp))
 -> (a -> Handler m (b, HttpResponse EncJSON))
 -> a
 -> Handler m (b, APIResp))
-> ((HttpResponse EncJSON -> APIResp)
    -> Handler m (b, HttpResponse EncJSON) -> Handler m (b, APIResp))
-> (HttpResponse EncJSON -> APIResp)
-> (a -> Handler m (b, HttpResponse EncJSON))
-> a
-> Handler m (b, APIResp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, HttpResponse EncJSON) -> (b, APIResp))
-> Handler m (b, HttpResponse EncJSON) -> Handler m (b, APIResp)
forall a b. (a -> b) -> Handler m a -> Handler m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((b, HttpResponse EncJSON) -> (b, APIResp))
 -> Handler m (b, HttpResponse EncJSON) -> Handler m (b, APIResp))
-> ((HttpResponse EncJSON -> APIResp)
    -> (b, HttpResponse EncJSON) -> (b, APIResp))
-> (HttpResponse EncJSON -> APIResp)
-> Handler m (b, HttpResponse EncJSON)
-> Handler m (b, APIResp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HttpResponse EncJSON -> APIResp)
-> (b, HttpResponse EncJSON) -> (b, APIResp)
forall a b. (a -> b) -> (b, a) -> (b, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) HttpResponse EncJSON -> APIResp
JSONResp

isMetadataEnabled :: AppContext -> Bool
isMetadataEnabled :: AppContext -> Bool
isMetadataEnabled AppContext
ac = API -> HashSet API -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member API
METADATA (HashSet API -> Bool) -> HashSet API -> Bool
forall a b. (a -> b) -> a -> b
$ AppContext -> HashSet API
acEnabledAPIs AppContext
ac

isGraphQLEnabled :: AppContext -> Bool
isGraphQLEnabled :: AppContext -> Bool
isGraphQLEnabled AppContext
ac = API -> HashSet API -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member API
GRAPHQL (HashSet API -> Bool) -> HashSet API -> Bool
forall a b. (a -> b) -> a -> b
$ AppContext -> HashSet API
acEnabledAPIs AppContext
ac

isPGDumpEnabled :: AppContext -> Bool
isPGDumpEnabled :: AppContext -> Bool
isPGDumpEnabled AppContext
ac = API -> HashSet API -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member API
PGDUMP (HashSet API -> Bool) -> HashSet API -> Bool
forall a b. (a -> b) -> a -> b
$ AppContext -> HashSet API
acEnabledAPIs AppContext
ac

isConfigEnabled :: AppContext -> Bool
isConfigEnabled :: AppContext -> Bool
isConfigEnabled AppContext
ac = API -> HashSet API -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member API
CONFIG (HashSet API -> Bool) -> HashSet API -> Bool
forall a b. (a -> b) -> a -> b
$ AppContext -> HashSet API
acEnabledAPIs AppContext
ac

isDeveloperAPIEnabled :: AppContext -> Bool
isDeveloperAPIEnabled :: AppContext -> Bool
isDeveloperAPIEnabled AppContext
ac = API -> HashSet API -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member API
DEVELOPER (HashSet API -> Bool) -> HashSet API -> Bool
forall a b. (a -> b) -> a -> b
$ AppContext -> HashSet API
acEnabledAPIs AppContext
ac

-- {-# SCC parseBody #-}
parseBody :: (FromJSON a, MonadError QErr m) => BL.ByteString -> m (Value, a)
parseBody :: forall a (m :: * -> *).
(FromJSON a, MonadError QErr m) =>
ByteString -> m (Value, a)
parseBody ByteString
reqBody =
  case ByteString -> Either [Char] Value
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode' ByteString
reqBody of
    Left [Char]
e -> Code -> Text -> m (Value, a)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidJSON ([Char] -> Text
T.pack [Char]
e)
    Right Value
jVal -> (Value
jVal,) (a -> (Value, a)) -> m a -> m (Value, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> m a
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue Value
jVal

onlyAdmin :: (MonadError QErr m, MonadReader HandlerCtx m) => m ()
onlyAdmin :: forall (m :: * -> *).
(MonadError QErr m, MonadReader HandlerCtx m) =>
m ()
onlyAdmin = do
  RoleName
uRole <- (HandlerCtx -> RoleName) -> m RoleName
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (UserInfo -> RoleName
_uiRole (UserInfo -> RoleName)
-> (HandlerCtx -> UserInfo) -> HandlerCtx -> RoleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerCtx -> UserInfo
hcUser)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RoleName
uRole RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AccessDenied Text
"You have to be an admin to access this endpoint"

setHeader :: (MonadIO m) => HTTP.Header -> Spock.ActionCtxT ctx m ()
setHeader :: forall (m :: * -> *) ctx.
MonadIO m =>
Header -> ActionCtxT ctx m ()
setHeader (HeaderName
headerName, ByteString
headerValue) =
  Text -> Text -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Text -> Text -> ActionCtxT ctx m ()
Spock.setHeader (ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString
forall s. CI s -> s
CI.original HeaderName
headerName) (ByteString -> Text
bsToTxt ByteString
headerValue)

-- | Typeclass representing the metadata API authorization effect
class (Monad m) => MonadMetadataApiAuthorization m where
  authorizeV1QueryApi ::
    RQLQuery -> HandlerCtx -> m (Either QErr ())

  authorizeV1MetadataApi ::
    RQLMetadata -> HandlerCtx -> m (Either QErr ())

  authorizeV2QueryApi ::
    V2Q.RQLQuery -> HandlerCtx -> m (Either QErr ())

instance (MonadMetadataApiAuthorization m) => MonadMetadataApiAuthorization (ReaderT r m) where
  authorizeV1QueryApi :: RQLQuery -> HandlerCtx -> ReaderT r m (Either QErr ())
authorizeV1QueryApi RQLQuery
q HandlerCtx
hc = m (Either QErr ()) -> ReaderT r m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> ReaderT r m (Either QErr ()))
-> m (Either QErr ()) -> ReaderT r m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ RQLQuery -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> m (Either QErr ())
authorizeV1QueryApi RQLQuery
q HandlerCtx
hc
  authorizeV1MetadataApi :: RQLMetadata -> HandlerCtx -> ReaderT r m (Either QErr ())
authorizeV1MetadataApi RQLMetadata
q HandlerCtx
hc = m (Either QErr ()) -> ReaderT r m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> ReaderT r m (Either QErr ()))
-> m (Either QErr ()) -> ReaderT r m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ RQLMetadata -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLMetadata -> HandlerCtx -> m (Either QErr ())
authorizeV1MetadataApi RQLMetadata
q HandlerCtx
hc
  authorizeV2QueryApi :: RQLQuery -> HandlerCtx -> ReaderT r m (Either QErr ())
authorizeV2QueryApi RQLQuery
q HandlerCtx
hc = m (Either QErr ()) -> ReaderT r m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> ReaderT r m (Either QErr ()))
-> m (Either QErr ()) -> ReaderT r m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ RQLQuery -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> m (Either QErr ())
authorizeV2QueryApi RQLQuery
q HandlerCtx
hc

instance (MonadMetadataApiAuthorization m) => MonadMetadataApiAuthorization (ExceptT e m) where
  authorizeV1QueryApi :: RQLQuery -> HandlerCtx -> ExceptT e m (Either QErr ())
authorizeV1QueryApi RQLQuery
q HandlerCtx
hc = m (Either QErr ()) -> ExceptT e m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> ExceptT e m (Either QErr ()))
-> m (Either QErr ()) -> ExceptT e m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ RQLQuery -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> m (Either QErr ())
authorizeV1QueryApi RQLQuery
q HandlerCtx
hc
  authorizeV1MetadataApi :: RQLMetadata -> HandlerCtx -> ExceptT e m (Either QErr ())
authorizeV1MetadataApi RQLMetadata
q HandlerCtx
hc = m (Either QErr ()) -> ExceptT e m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> ExceptT e m (Either QErr ()))
-> m (Either QErr ()) -> ExceptT e m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ RQLMetadata -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLMetadata -> HandlerCtx -> m (Either QErr ())
authorizeV1MetadataApi RQLMetadata
q HandlerCtx
hc
  authorizeV2QueryApi :: RQLQuery -> HandlerCtx -> ExceptT e m (Either QErr ())
authorizeV2QueryApi RQLQuery
q HandlerCtx
hc = m (Either QErr ()) -> ExceptT e m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> ExceptT e m (Either QErr ()))
-> m (Either QErr ()) -> ExceptT e m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ RQLQuery -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> m (Either QErr ())
authorizeV2QueryApi RQLQuery
q HandlerCtx
hc

instance (MonadMetadataApiAuthorization m) => MonadMetadataApiAuthorization (Tracing.TraceT m) where
  authorizeV1QueryApi :: RQLQuery -> HandlerCtx -> TraceT m (Either QErr ())
authorizeV1QueryApi RQLQuery
q HandlerCtx
hc = m (Either QErr ()) -> TraceT m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> TraceT m (Either QErr ()))
-> m (Either QErr ()) -> TraceT m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ RQLQuery -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> m (Either QErr ())
authorizeV1QueryApi RQLQuery
q HandlerCtx
hc
  authorizeV1MetadataApi :: RQLMetadata -> HandlerCtx -> TraceT m (Either QErr ())
authorizeV1MetadataApi RQLMetadata
q HandlerCtx
hc = m (Either QErr ()) -> TraceT m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> TraceT m (Either QErr ()))
-> m (Either QErr ()) -> TraceT m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ RQLMetadata -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLMetadata -> HandlerCtx -> m (Either QErr ())
authorizeV1MetadataApi RQLMetadata
q HandlerCtx
hc
  authorizeV2QueryApi :: RQLQuery -> HandlerCtx -> TraceT m (Either QErr ())
authorizeV2QueryApi RQLQuery
q HandlerCtx
hc = m (Either QErr ()) -> TraceT m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> TraceT m (Either QErr ()))
-> m (Either QErr ()) -> TraceT m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ RQLQuery -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> m (Either QErr ())
authorizeV2QueryApi RQLQuery
q HandlerCtx
hc

-- | The config API (/v1alpha1/config) handler
class (Monad m) => MonadConfigApiHandler m where
  runConfigApiHandler ::
    AppStateRef impl ->
    Spock.SpockCtxT () m ()

mkSpockAction ::
  forall m a impl.
  ( MonadIO m,
    MonadBaseControl IO m,
    HasAppEnv m,
    FromJSON a,
    UserAuthentication m,
    HttpLog m,
    HasResourceLimits m,
    MonadTrace m
  ) =>
  AppStateRef impl ->
  -- | `QErr` JSON encoder function
  (Bool -> QErr -> Encoding) ->
  -- | `QErr` modifier
  (QErr -> QErr) ->
  APIHandler m a ->
  Spock.ActionT m ()
mkSpockAction :: forall (m :: * -> *) a impl.
(MonadIO m, MonadBaseControl IO m, HasAppEnv m, FromJSON a,
 UserAuthentication m, HttpLog m, HasResourceLimits m,
 MonadTrace m) =>
AppStateRef impl
-> (Bool -> QErr -> Encoding)
-> (QErr -> QErr)
-> APIHandler m a
-> ActionT m ()
mkSpockAction AppStateRef impl
appStateRef Bool -> QErr -> Encoding
qErrEncoder QErr -> QErr
qErrModifier APIHandler m a
apiHandler = do
  AppEnv {Int
Maybe Text
Maybe PGPool
Maybe (CredentialCache AgentLicenseKey)
SamplingPolicy
HostPreference
Manager
TxIsolation
ConnParams
PGPool
Refined NonNegative Seconds
TMVar MetadataResourceVersion
ConnectionOptions
CheckFeatureFlag
ServerMetrics
EventingMode
ReadOnlyMode
MaintenanceMode ()
InstanceId
PrometheusMetrics
ShutdownLatch
LoggingSettings
LockedEventsCtx
WSConnectionInitTimeout
KeepAliveDelay
OptionalInterval
Port
SubscriptionsState
Loggers
appEnvPort :: Port
appEnvHost :: HostPreference
appEnvMetadataDbPool :: PGPool
appEnvIntrospectionDbPool :: Maybe PGPool
appEnvManager :: Manager
appEnvLoggers :: Loggers
appEnvMetadataVersionRef :: TMVar MetadataResourceVersion
appEnvInstanceId :: InstanceId
appEnvEnableMaintenanceMode :: MaintenanceMode ()
appEnvLoggingSettings :: LoggingSettings
appEnvEventingMode :: EventingMode
appEnvEnableReadOnlyMode :: ReadOnlyMode
appEnvServerMetrics :: ServerMetrics
appEnvShutdownLatch :: ShutdownLatch
appEnvMetaVersionRef :: TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: PrometheusMetrics
appEnvTraceSamplingPolicy :: SamplingPolicy
appEnvSubscriptionState :: SubscriptionsState
appEnvLockedEventsCtx :: LockedEventsCtx
appEnvConnParams :: ConnParams
appEnvTxIso :: TxIsolation
appEnvConsoleAssetsDir :: Maybe Text
appEnvConsoleSentryDsn :: Maybe Text
appEnvConnectionOptions :: ConnectionOptions
appEnvWebSocketKeepAlive :: KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: Refined NonNegative Seconds
appEnvSchemaPollInterval :: OptionalInterval
appEnvCheckFeatureFlag :: CheckFeatureFlag
appEnvLicenseKeyCache :: Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: Int
appEnvPort :: AppEnv -> Port
appEnvHost :: AppEnv -> HostPreference
appEnvMetadataDbPool :: AppEnv -> PGPool
appEnvIntrospectionDbPool :: AppEnv -> Maybe PGPool
appEnvManager :: AppEnv -> Manager
appEnvLoggers :: AppEnv -> Loggers
appEnvMetadataVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvInstanceId :: AppEnv -> InstanceId
appEnvEnableMaintenanceMode :: AppEnv -> MaintenanceMode ()
appEnvLoggingSettings :: AppEnv -> LoggingSettings
appEnvEventingMode :: AppEnv -> EventingMode
appEnvEnableReadOnlyMode :: AppEnv -> ReadOnlyMode
appEnvServerMetrics :: AppEnv -> ServerMetrics
appEnvShutdownLatch :: AppEnv -> ShutdownLatch
appEnvMetaVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: AppEnv -> PrometheusMetrics
appEnvTraceSamplingPolicy :: AppEnv -> SamplingPolicy
appEnvSubscriptionState :: AppEnv -> SubscriptionsState
appEnvLockedEventsCtx :: AppEnv -> LockedEventsCtx
appEnvConnParams :: AppEnv -> ConnParams
appEnvTxIso :: AppEnv -> TxIsolation
appEnvConsoleAssetsDir :: AppEnv -> Maybe Text
appEnvConsoleSentryDsn :: AppEnv -> Maybe Text
appEnvConnectionOptions :: AppEnv -> ConnectionOptions
appEnvWebSocketKeepAlive :: AppEnv -> KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: AppEnv -> WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: AppEnv -> Refined NonNegative Seconds
appEnvSchemaPollInterval :: AppEnv -> OptionalInterval
appEnvCheckFeatureFlag :: AppEnv -> CheckFeatureFlag
appEnvLicenseKeyCache :: AppEnv -> Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: AppEnv -> Int
..} <- m AppEnv -> ActionCtxT () m AppEnv
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppEnv
forall (m :: * -> *). HasAppEnv m => m AppEnv
askAppEnv
  AppContext {Environment
HashSet ExperimentalFeature
HashSet API
StreamQueriesOptions
NamingCase
RemoteSchemaPermissions
InferFunctionPermissions
SQLGenCtx
CloseWebsocketsOnMetadataChangeStatus
ApolloFederationStatus
CorsPolicy
AuthMode
MetadataDefaults
ResponseInternalErrorsConfig
OptionalInterval
TelemetryStatus
AllowListStatus
ConsoleStatus
EventEngineCtx
acEnabledAPIs :: AppContext -> HashSet API
acAuthMode :: AuthMode
acSQLGenCtx :: SQLGenCtx
acEnabledAPIs :: HashSet API
acEnableAllowlist :: AllowListStatus
acResponseInternalErrorsConfig :: ResponseInternalErrorsConfig
acEnvironment :: Environment
acRemoteSchemaPermsCtx :: RemoteSchemaPermissions
acFunctionPermsCtx :: InferFunctionPermissions
acExperimentalFeatures :: HashSet ExperimentalFeature
acDefaultNamingConvention :: NamingCase
acMetadataDefaults :: MetadataDefaults
acLiveQueryOptions :: StreamQueriesOptions
acStreamQueryOptions :: StreamQueriesOptions
acCorsPolicy :: CorsPolicy
acConsoleStatus :: ConsoleStatus
acEnableTelemetry :: TelemetryStatus
acEventEngineCtx :: EventEngineCtx
acAsyncActionsFetchInterval :: OptionalInterval
acApolloFederationStatus :: ApolloFederationStatus
acCloseWebsocketsOnMetadataChangeStatus :: CloseWebsocketsOnMetadataChangeStatus
acAuthMode :: AppContext -> AuthMode
acSQLGenCtx :: AppContext -> SQLGenCtx
acEnableAllowlist :: AppContext -> AllowListStatus
acResponseInternalErrorsConfig :: AppContext -> ResponseInternalErrorsConfig
acEnvironment :: AppContext -> Environment
acRemoteSchemaPermsCtx :: AppContext -> RemoteSchemaPermissions
acFunctionPermsCtx :: AppContext -> InferFunctionPermissions
acExperimentalFeatures :: AppContext -> HashSet ExperimentalFeature
acDefaultNamingConvention :: AppContext -> NamingCase
acMetadataDefaults :: AppContext -> MetadataDefaults
acLiveQueryOptions :: AppContext -> StreamQueriesOptions
acStreamQueryOptions :: AppContext -> StreamQueriesOptions
acCorsPolicy :: AppContext -> CorsPolicy
acConsoleStatus :: AppContext -> ConsoleStatus
acEnableTelemetry :: AppContext -> TelemetryStatus
acEventEngineCtx :: AppContext -> EventEngineCtx
acAsyncActionsFetchInterval :: AppContext -> OptionalInterval
acApolloFederationStatus :: AppContext -> ApolloFederationStatus
acCloseWebsocketsOnMetadataChangeStatus :: AppContext -> CloseWebsocketsOnMetadataChangeStatus
..} <- IO AppContext -> ActionCtxT () m AppContext
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppContext -> ActionCtxT () m AppContext)
-> IO AppContext -> ActionCtxT () m AppContext
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
getAppContext AppStateRef impl
appStateRef
  Request
req <- ActionCtxT () m Request
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
Spock.request
  let origHeaders :: [Header]
origHeaders = Request -> [Header]
Wai.requestHeaders Request
req
      ipAddress :: IpAddress
ipAddress = Request -> IpAddress
Wai.getSourceFromFallback Request
req
      pathInfo :: ByteString
pathInfo = Request -> ByteString
Wai.rawPathInfo Request
req

  -- Bytes are actually read from the socket here. Time this.
  (DiffTime
ioWaitTime, ByteString
reqBody) <- ActionCtxT () m ByteString
-> ActionCtxT () m (DiffTime, ByteString)
forall (m :: * -> *) a. MonadIO m => m a -> m (DiffTime, a)
withElapsedTime (ActionCtxT () m ByteString
 -> ActionCtxT () m (DiffTime, ByteString))
-> ActionCtxT () m ByteString
-> ActionCtxT () m (DiffTime, ByteString)
forall a b. (a -> b) -> a -> b
$ IO ByteString -> ActionCtxT () m ByteString
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ActionCtxT () m ByteString)
-> IO ByteString -> ActionCtxT () m ByteString
forall a b. (a -> b) -> a -> b
$ Request -> IO ByteString
Wai.strictRequestBody Request
req

  (RequestId
requestId, [Header]
headers) <- [Header] -> ActionCtxT () m (RequestId, [Header])
forall (m :: * -> *).
MonadIO m =>
[Header] -> m (RequestId, [Header])
getRequestId [Header]
origHeaders
  TraceContext
tracingCtx <- IO TraceContext -> ActionCtxT () m TraceContext
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
    -- B3 TraceIds can have a length of either 64 bits (16 hex chars) or 128 bits
    -- (32 hex chars). For 64-bit TraceIds, we pad them with zeros on the left to
    -- make them 128 bits long.
    let traceIdMaybe :: Maybe TraceId
traceIdMaybe =
          HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-B3-TraceId" [Header]
headers Maybe ByteString -> (ByteString -> Maybe TraceId) -> Maybe TraceId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
rawTraceId ->
            if
              | ByteString -> Int
Char8.length ByteString
rawTraceId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 ->
                  ByteString -> Maybe TraceId
Tracing.traceIdFromHex ByteString
rawTraceId
              | ByteString -> Int
Char8.length ByteString
rawTraceId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 ->
                  ByteString -> Maybe TraceId
Tracing.traceIdFromHex (ByteString -> Maybe TraceId) -> ByteString -> Maybe TraceId
forall a b. (a -> b) -> a -> b
$ Int -> Char -> ByteString
Char8.replicate Int
16 Char
'0' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
rawTraceId
              | Bool
otherwise ->
                  Maybe TraceId
forall a. Maybe a
Nothing

    case Maybe TraceId
traceIdMaybe of
      Just TraceId
traceId -> do
        SpanId
freshSpanId <- IO SpanId
forall (m :: * -> *). MonadIO m => m SpanId
Tracing.randomSpanId
        let parentSpanId :: Maybe SpanId
parentSpanId = ByteString -> Maybe SpanId
Tracing.spanIdFromHex (ByteString -> Maybe SpanId) -> Maybe ByteString -> Maybe SpanId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-B3-SpanId" [Header]
headers
            samplingState :: SamplingState
samplingState = Maybe ByteString -> SamplingState
forall s. (IsString s, Eq s) => Maybe s -> SamplingState
Tracing.samplingStateFromHeader (Maybe ByteString -> SamplingState)
-> Maybe ByteString -> SamplingState
forall a b. (a -> b) -> a -> b
$ HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-B3-Sampled" [Header]
headers
        TraceContext -> IO TraceContext
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceContext -> IO TraceContext)
-> TraceContext -> IO TraceContext
forall a b. (a -> b) -> a -> b
$ TraceId -> SpanId -> Maybe SpanId -> SamplingState -> TraceContext
Tracing.TraceContext TraceId
traceId SpanId
freshSpanId Maybe SpanId
parentSpanId SamplingState
samplingState
      Maybe TraceId
Nothing -> do
        TraceId
freshTraceId <- IO TraceId
forall (m :: * -> *). MonadIO m => m TraceId
Tracing.randomTraceId
        SpanId
freshSpanId <- IO SpanId
forall (m :: * -> *). MonadIO m => m SpanId
Tracing.randomSpanId
        let samplingState :: SamplingState
samplingState = Maybe ByteString -> SamplingState
forall s. (IsString s, Eq s) => Maybe s -> SamplingState
Tracing.samplingStateFromHeader (Maybe ByteString -> SamplingState)
-> Maybe ByteString -> SamplingState
forall a b. (a -> b) -> a -> b
$ HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-B3-Sampled" [Header]
headers
        TraceContext -> IO TraceContext
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceContext -> IO TraceContext)
-> TraceContext -> IO TraceContext
forall a b. (a -> b) -> a -> b
$ TraceId -> SpanId -> Maybe SpanId -> SamplingState -> TraceContext
Tracing.TraceContext TraceId
freshTraceId SpanId
freshSpanId Maybe SpanId
forall a. Maybe a
Nothing SamplingState
samplingState

  let runTrace ::
        forall m1 a1.
        (MonadTrace m1) =>
        m1 a1 ->
        m1 a1
      runTrace :: forall (m1 :: * -> *) a1. MonadTrace m1 => m1 a1 -> m1 a1
runTrace =
        TraceContext -> SamplingPolicy -> Text -> m1 a1 -> m1 a1
forall a. TraceContext -> SamplingPolicy -> Text -> m1 a -> m1 a
forall (m :: * -> *) a.
MonadTrace m =>
TraceContext -> SamplingPolicy -> Text -> m a -> m a
Tracing.newTraceWith TraceContext
tracingCtx SamplingPolicy
appEnvTraceSamplingPolicy ([Char] -> Text
forall a. IsString a => [Char] -> a
fromString (ByteString -> [Char]
B8.unpack ByteString
pathInfo))

  let getInfo :: Maybe ReqsText
-> ActionCtxT
     () m (UserInfo, [Header], HandlerCtx, Bool, ExtraUserInfo)
getInfo Maybe ReqsText
parsedRequest = do
        Either QErr (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo)
authenticationResp <- m (Either QErr (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo))
-> ActionCtxT
     ()
     m
     (Either QErr (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo))
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Logger Hasura
-> Manager
-> [Header]
-> AuthMode
-> Maybe ReqsText
-> m (Either
        QErr (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo))
forall (m :: * -> *).
UserAuthentication m =>
Logger Hasura
-> Manager
-> [Header]
-> AuthMode
-> Maybe ReqsText
-> m (Either
        QErr (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo))
resolveUserInfo (Loggers -> Logger Hasura
_lsLogger Loggers
appEnvLoggers) Manager
appEnvManager [Header]
headers AuthMode
acAuthMode Maybe ReqsText
parsedRequest)
        (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo)
authInfo <- Either QErr (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo)
-> (QErr
    -> ActionCtxT
         () m (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo))
-> ActionCtxT
     () m (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft Either QErr (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo)
authenticationResp (Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> Bool
-> [Header]
-> ExtraUserInfo
-> QErr
-> ActionCtxT
     () m (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo)
forall any ctx.
Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> Bool
-> [Header]
-> ExtraUserInfo
-> QErr
-> ActionCtxT ctx m any
logErrorAndResp Maybe UserInfo
forall a. Maybe a
Nothing RequestId
requestId Request
req (ByteString
reqBody, Maybe Value
forall a. Maybe a
Nothing) Bool
False [Header]
origHeaders (Maybe Text -> ExtraUserInfo
ExtraUserInfo Maybe Text
forall a. Maybe a
Nothing) (QErr
 -> ActionCtxT
      () m (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo))
-> (QErr -> QErr)
-> QErr
-> ActionCtxT
     () m (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QErr -> QErr
qErrModifier)
        let (UserInfo
userInfo, Maybe UTCTime
_, [Header]
authHeaders, ExtraUserInfo
extraUserInfo) = (UserInfo, Maybe UTCTime, [Header], ExtraUserInfo)
authInfo
        AppContext
appContext <- IO AppContext -> ActionCtxT () m AppContext
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppContext -> ActionCtxT () m AppContext)
-> IO AppContext -> ActionCtxT () m AppContext
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
getAppContext AppStateRef impl
appStateRef
        RebuildableSchemaCache
schemaCache <- IO RebuildableSchemaCache -> ActionCtxT () m RebuildableSchemaCache
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RebuildableSchemaCache
 -> ActionCtxT () m RebuildableSchemaCache)
-> IO RebuildableSchemaCache
-> ActionCtxT () m RebuildableSchemaCache
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO RebuildableSchemaCache
forall impl. AppStateRef impl -> IO RebuildableSchemaCache
getRebuildableSchemaCacheWithVersion AppStateRef impl
appStateRef
        (UserInfo, [Header], HandlerCtx, Bool, ExtraUserInfo)
-> ActionCtxT
     () m (UserInfo, [Header], HandlerCtx, Bool, ExtraUserInfo)
forall a. a -> ActionCtxT () m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( UserInfo
userInfo,
            [Header]
authHeaders,
            AppContext
-> RebuildableSchemaCache
-> UserInfo
-> [Header]
-> RequestId
-> IpAddress
-> Maybe (CredentialCache AgentLicenseKey)
-> HandlerCtx
HandlerCtx AppContext
appContext RebuildableSchemaCache
schemaCache UserInfo
userInfo [Header]
headers RequestId
requestId IpAddress
ipAddress Maybe (CredentialCache AgentLicenseKey)
appEnvLicenseKeyCache,
            RoleName -> ResponseInternalErrorsConfig -> Bool
shouldIncludeInternal (UserInfo -> RoleName
_uiRole UserInfo
userInfo) ResponseInternalErrorsConfig
acResponseInternalErrorsConfig,
            ExtraUserInfo
extraUserInfo
          )

  (forall a. m a -> m a) -> ActionT m () -> ActionT m ()
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> ActionCtxT () m b -> ActionCtxT () n b
hoist m a -> m a
forall a. m a -> m a
forall (m1 :: * -> *) a1. MonadTrace m1 => m1 a1 -> m1 a1
runTrace do
    -- Add the request ID to the tracing metadata so that we
    -- can correlate requests and traces
    m () -> ActionT m ()
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ActionT m ()) -> m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ TraceMetadata -> m ()
forall (m :: * -> *). MonadTrace m => TraceMetadata -> m ()
Tracing.attachMetadata [(Text
"request_id", RequestId -> Text
unRequestId RequestId
requestId)]

    (DiffTime
serviceTime, (Either QErr (HttpLogGraphQLInfo, APIResp)
result, UserInfo
userInfo, [Header]
authHeaders, Bool
includeInternal, Maybe Value
queryJSON, ExtraUserInfo
extraUserInfo)) <- ActionCtxT
  ()
  m
  (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
   Bool, Maybe Value, ExtraUserInfo)
-> ActionCtxT
     ()
     m
     (DiffTime,
      (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
       Bool, Maybe Value, ExtraUserInfo))
forall (m :: * -> *) a. MonadIO m => m a -> m (DiffTime, a)
withElapsedTime (ActionCtxT
   ()
   m
   (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
    Bool, Maybe Value, ExtraUserInfo)
 -> ActionCtxT
      ()
      m
      (DiffTime,
       (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
        Bool, Maybe Value, ExtraUserInfo)))
-> ActionCtxT
     ()
     m
     (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
      Bool, Maybe Value, ExtraUserInfo)
-> ActionCtxT
     ()
     m
     (DiffTime,
      (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
       Bool, Maybe Value, ExtraUserInfo))
forall a b. (a -> b) -> a -> b
$ case APIHandler m a
apiHandler of
      -- in the case of a simple get/post we don't have to send the webhook anything
      AHGet Handler m (HttpLogGraphQLInfo, APIResp)
handler -> do
        (UserInfo
userInfo, [Header]
authHeaders, HandlerCtx
handlerState, Bool
includeInternal, ExtraUserInfo
extraUserInfo) <- Maybe ReqsText
-> ActionCtxT
     () m (UserInfo, [Header], HandlerCtx, Bool, ExtraUserInfo)
getInfo Maybe ReqsText
forall a. Maybe a
Nothing
        Either QErr (HttpLogGraphQLInfo, APIResp)
res <- m (Either QErr (HttpLogGraphQLInfo, APIResp))
-> ActionCtxT () m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr (HttpLogGraphQLInfo, APIResp))
 -> ActionCtxT () m (Either QErr (HttpLogGraphQLInfo, APIResp)))
-> m (Either QErr (HttpLogGraphQLInfo, APIResp))
-> ActionCtxT () m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> HandlerCtx
-> Handler m (HttpLogGraphQLInfo, APIResp)
-> m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall (m :: * -> *) a.
(HasResourceLimits m, MonadBaseControl IO m) =>
Logger Hasura -> HandlerCtx -> Handler m a -> m (Either QErr a)
runHandler (Loggers -> Logger Hasura
_lsLogger Loggers
appEnvLoggers) HandlerCtx
handlerState Handler m (HttpLogGraphQLInfo, APIResp)
handler
        (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
 Bool, Maybe Value, ExtraUserInfo)
-> ActionCtxT
     ()
     m
     (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
      Bool, Maybe Value, ExtraUserInfo)
forall a. a -> ActionCtxT () m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QErr (HttpLogGraphQLInfo, APIResp)
res, UserInfo
userInfo, [Header]
authHeaders, Bool
includeInternal, Maybe Value
forall a. Maybe a
Nothing, ExtraUserInfo
extraUserInfo)
      AHPost a -> Handler m (HttpLogGraphQLInfo, APIResp)
handler -> do
        (UserInfo
userInfo, [Header]
authHeaders, HandlerCtx
handlerState, Bool
includeInternal, ExtraUserInfo
extraUserInfo) <- Maybe ReqsText
-> ActionCtxT
     () m (UserInfo, [Header], HandlerCtx, Bool, ExtraUserInfo)
getInfo Maybe ReqsText
forall a. Maybe a
Nothing
        (Value
queryJSON, a
parsedReq) <-
          Except QErr (Value, a) -> Either QErr (Value, a)
forall e a. Except e a -> Either e a
runExcept (ByteString -> Except QErr (Value, a)
forall a (m :: * -> *).
(FromJSON a, MonadError QErr m) =>
ByteString -> m (Value, a)
parseBody ByteString
reqBody) Either QErr (Value, a)
-> (QErr -> ActionCtxT () m (Value, a))
-> ActionCtxT () m (Value, a)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` \QErr
e -> do
            Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> Bool
-> [Header]
-> ExtraUserInfo
-> QErr
-> ActionCtxT () m (Value, a)
forall any ctx.
Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> Bool
-> [Header]
-> ExtraUserInfo
-> QErr
-> ActionCtxT ctx m any
logErrorAndResp (UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
userInfo) RequestId
requestId Request
req (ByteString
reqBody, Maybe Value
forall a. Maybe a
Nothing) Bool
includeInternal [Header]
origHeaders ExtraUserInfo
extraUserInfo (QErr -> QErr
qErrModifier QErr
e)
        Either QErr (HttpLogGraphQLInfo, APIResp)
res <- m (Either QErr (HttpLogGraphQLInfo, APIResp))
-> ActionCtxT () m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr (HttpLogGraphQLInfo, APIResp))
 -> ActionCtxT () m (Either QErr (HttpLogGraphQLInfo, APIResp)))
-> m (Either QErr (HttpLogGraphQLInfo, APIResp))
-> ActionCtxT () m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> HandlerCtx
-> Handler m (HttpLogGraphQLInfo, APIResp)
-> m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall (m :: * -> *) a.
(HasResourceLimits m, MonadBaseControl IO m) =>
Logger Hasura -> HandlerCtx -> Handler m a -> m (Either QErr a)
runHandler (Loggers -> Logger Hasura
_lsLogger Loggers
appEnvLoggers) HandlerCtx
handlerState (Handler m (HttpLogGraphQLInfo, APIResp)
 -> m (Either QErr (HttpLogGraphQLInfo, APIResp)))
-> Handler m (HttpLogGraphQLInfo, APIResp)
-> m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall a b. (a -> b) -> a -> b
$ a -> Handler m (HttpLogGraphQLInfo, APIResp)
handler a
parsedReq
        (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
 Bool, Maybe Value, ExtraUserInfo)
-> ActionCtxT
     ()
     m
     (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
      Bool, Maybe Value, ExtraUserInfo)
forall a. a -> ActionCtxT () m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QErr (HttpLogGraphQLInfo, APIResp)
res, UserInfo
userInfo, [Header]
authHeaders, Bool
includeInternal, Value -> Maybe Value
forall a. a -> Maybe a
Just Value
queryJSON, ExtraUserInfo
extraUserInfo)
      -- in this case we parse the request _first_ and then send the request to the webhook for auth
      AHGraphQLRequest ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp)
handler -> do
        (Value
queryJSON, ReqsText
parsedReq) <-
          Except QErr (Value, ReqsText) -> Either QErr (Value, ReqsText)
forall e a. Except e a -> Either e a
runExcept (ByteString -> Except QErr (Value, ReqsText)
forall a (m :: * -> *).
(FromJSON a, MonadError QErr m) =>
ByteString -> m (Value, a)
parseBody ByteString
reqBody) Either QErr (Value, ReqsText)
-> (QErr -> ActionCtxT () m (Value, ReqsText))
-> ActionCtxT () m (Value, ReqsText)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` \QErr
e -> do
            -- if the request fails to parse, call the webhook without a request body
            -- TODO should we signal this to the webhook somehow?
            (UserInfo
userInfo, [Header]
_, HandlerCtx
_, Bool
_, ExtraUserInfo
extraUserInfo) <- Maybe ReqsText
-> ActionCtxT
     () m (UserInfo, [Header], HandlerCtx, Bool, ExtraUserInfo)
getInfo Maybe ReqsText
forall a. Maybe a
Nothing
            Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> Bool
-> [Header]
-> ExtraUserInfo
-> QErr
-> ActionCtxT () m (Value, ReqsText)
forall any ctx.
Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> Bool
-> [Header]
-> ExtraUserInfo
-> QErr
-> ActionCtxT ctx m any
logErrorAndResp (UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
userInfo) RequestId
requestId Request
req (ByteString
reqBody, Maybe Value
forall a. Maybe a
Nothing) Bool
False [Header]
origHeaders ExtraUserInfo
extraUserInfo (QErr -> QErr
qErrModifier QErr
e)
        (UserInfo
userInfo, [Header]
authHeaders, HandlerCtx
handlerState, Bool
includeInternal, ExtraUserInfo
extraUserInfo) <- Maybe ReqsText
-> ActionCtxT
     () m (UserInfo, [Header], HandlerCtx, Bool, ExtraUserInfo)
getInfo (ReqsText -> Maybe ReqsText
forall a. a -> Maybe a
Just ReqsText
parsedReq)

        Either QErr (HttpLogGraphQLInfo, APIResp)
res <- m (Either QErr (HttpLogGraphQLInfo, APIResp))
-> ActionCtxT () m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr (HttpLogGraphQLInfo, APIResp))
 -> ActionCtxT () m (Either QErr (HttpLogGraphQLInfo, APIResp)))
-> m (Either QErr (HttpLogGraphQLInfo, APIResp))
-> ActionCtxT () m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> HandlerCtx
-> Handler m (HttpLogGraphQLInfo, APIResp)
-> m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall (m :: * -> *) a.
(HasResourceLimits m, MonadBaseControl IO m) =>
Logger Hasura -> HandlerCtx -> Handler m a -> m (Either QErr a)
runHandler (Loggers -> Logger Hasura
_lsLogger Loggers
appEnvLoggers) HandlerCtx
handlerState (Handler m (HttpLogGraphQLInfo, APIResp)
 -> m (Either QErr (HttpLogGraphQLInfo, APIResp)))
-> Handler m (HttpLogGraphQLInfo, APIResp)
-> m (Either QErr (HttpLogGraphQLInfo, APIResp))
forall a b. (a -> b) -> a -> b
$ ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp)
handler ReqsText
parsedReq
        (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
 Bool, Maybe Value, ExtraUserInfo)
-> ActionCtxT
     ()
     m
     (Either QErr (HttpLogGraphQLInfo, APIResp), UserInfo, [Header],
      Bool, Maybe Value, ExtraUserInfo)
forall a. a -> ActionCtxT () m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QErr (HttpLogGraphQLInfo, APIResp)
res, UserInfo
userInfo, [Header]
authHeaders, Bool
includeInternal, Value -> Maybe Value
forall a. a -> Maybe a
Just Value
queryJSON, ExtraUserInfo
extraUserInfo)

    -- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/span-general/#general-identity-attributes
    m () -> ActionT m ()
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ActionT m ()) -> m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ TraceMetadata -> m ()
forall (m :: * -> *). MonadTrace m => TraceMetadata -> m ()
Tracing.attachMetadata [(Text
"enduser.role", RoleName -> Text
roleNameToTxt (RoleName -> Text) -> RoleName -> Text
forall a b. (a -> b) -> a -> b
$ UserInfo -> RoleName
_uiRole UserInfo
userInfo)]

    -- apply the error modifier
    let modResult :: Either QErr (HttpLogGraphQLInfo, APIResp)
modResult = (QErr -> QErr)
-> Either QErr (HttpLogGraphQLInfo, APIResp)
-> Either QErr (HttpLogGraphQLInfo, APIResp)
forall a a' b. (a -> a') -> Either a b -> Either a' b
fmapL QErr -> QErr
qErrModifier Either QErr (HttpLogGraphQLInfo, APIResp)
result

    -- log and return result
    case Either QErr (HttpLogGraphQLInfo, APIResp)
modResult of
      Left QErr
err ->
        Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> Bool
-> [Header]
-> ExtraUserInfo
-> QErr
-> ActionT m ()
forall any ctx.
Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> Bool
-> [Header]
-> ExtraUserInfo
-> QErr
-> ActionCtxT ctx m any
logErrorAndResp (UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
userInfo) RequestId
requestId Request
req (ByteString
reqBody, Maybe Value
queryJSON) Bool
includeInternal [Header]
headers ExtraUserInfo
extraUserInfo QErr
err
      Right (HttpLogGraphQLInfo
httpLogGraphQLInfo, APIResp
res) -> do
        let httpLogMetadata :: HttpLogMetadata m
httpLogMetadata = forall (m :: * -> *).
HttpLog m =>
HttpLogGraphQLInfo -> ExtraUserInfo -> HttpLogMetadata m
buildHttpLogMetadata @m HttpLogGraphQLInfo
httpLogGraphQLInfo ExtraUserInfo
extraUserInfo
        Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> APIResp
-> Maybe (DiffTime, DiffTime)
-> [Header]
-> [Header]
-> HttpLogMetadata m
-> ActionT m ()
forall {m :: * -> *} {ctx} {b}.
(HasAppEnv m, MonadTrace m, HttpLog m, MonadIO m) =>
Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> APIResp
-> Maybe (DiffTime, DiffTime)
-> [Header]
-> [Header]
-> (CommonHttpLogMetadata, ExtraHttpLogMetadata m)
-> ActionCtxT ctx m b
logSuccessAndResp (UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
userInfo) RequestId
requestId Request
req (ByteString
reqBody, Maybe Value
queryJSON) APIResp
res ((DiffTime, DiffTime) -> Maybe (DiffTime, DiffTime)
forall a. a -> Maybe a
Just (DiffTime
ioWaitTime, DiffTime
serviceTime)) [Header]
origHeaders [Header]
authHeaders HttpLogMetadata m
httpLogMetadata
  where
    logErrorAndResp ::
      forall any ctx.
      Maybe UserInfo ->
      RequestId ->
      Wai.Request ->
      (BL.ByteString, Maybe Value) ->
      Bool ->
      [HTTP.Header] ->
      ExtraUserInfo ->
      QErr ->
      Spock.ActionCtxT ctx m any
    logErrorAndResp :: forall any ctx.
Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> Bool
-> [Header]
-> ExtraUserInfo
-> QErr
-> ActionCtxT ctx m any
logErrorAndResp Maybe UserInfo
userInfo RequestId
reqId Request
waiReq (ByteString, Maybe Value)
req Bool
includeInternal [Header]
headers ExtraUserInfo
extraUserInfo QErr
qErr = do
      AppEnv {Int
Maybe Text
Maybe PGPool
Maybe (CredentialCache AgentLicenseKey)
SamplingPolicy
HostPreference
Manager
TxIsolation
ConnParams
PGPool
Refined NonNegative Seconds
TMVar MetadataResourceVersion
ConnectionOptions
CheckFeatureFlag
ServerMetrics
EventingMode
ReadOnlyMode
MaintenanceMode ()
InstanceId
PrometheusMetrics
ShutdownLatch
LoggingSettings
LockedEventsCtx
WSConnectionInitTimeout
KeepAliveDelay
OptionalInterval
Port
SubscriptionsState
Loggers
appEnvPort :: AppEnv -> Port
appEnvHost :: AppEnv -> HostPreference
appEnvMetadataDbPool :: AppEnv -> PGPool
appEnvIntrospectionDbPool :: AppEnv -> Maybe PGPool
appEnvManager :: AppEnv -> Manager
appEnvLoggers :: AppEnv -> Loggers
appEnvMetadataVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvInstanceId :: AppEnv -> InstanceId
appEnvEnableMaintenanceMode :: AppEnv -> MaintenanceMode ()
appEnvLoggingSettings :: AppEnv -> LoggingSettings
appEnvEventingMode :: AppEnv -> EventingMode
appEnvEnableReadOnlyMode :: AppEnv -> ReadOnlyMode
appEnvServerMetrics :: AppEnv -> ServerMetrics
appEnvShutdownLatch :: AppEnv -> ShutdownLatch
appEnvMetaVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: AppEnv -> PrometheusMetrics
appEnvTraceSamplingPolicy :: AppEnv -> SamplingPolicy
appEnvSubscriptionState :: AppEnv -> SubscriptionsState
appEnvLockedEventsCtx :: AppEnv -> LockedEventsCtx
appEnvConnParams :: AppEnv -> ConnParams
appEnvTxIso :: AppEnv -> TxIsolation
appEnvConsoleAssetsDir :: AppEnv -> Maybe Text
appEnvConsoleSentryDsn :: AppEnv -> Maybe Text
appEnvConnectionOptions :: AppEnv -> ConnectionOptions
appEnvWebSocketKeepAlive :: AppEnv -> KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: AppEnv -> WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: AppEnv -> Refined NonNegative Seconds
appEnvSchemaPollInterval :: AppEnv -> OptionalInterval
appEnvCheckFeatureFlag :: AppEnv -> CheckFeatureFlag
appEnvLicenseKeyCache :: AppEnv -> Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: AppEnv -> Int
appEnvPort :: Port
appEnvHost :: HostPreference
appEnvMetadataDbPool :: PGPool
appEnvIntrospectionDbPool :: Maybe PGPool
appEnvManager :: Manager
appEnvLoggers :: Loggers
appEnvMetadataVersionRef :: TMVar MetadataResourceVersion
appEnvInstanceId :: InstanceId
appEnvEnableMaintenanceMode :: MaintenanceMode ()
appEnvLoggingSettings :: LoggingSettings
appEnvEventingMode :: EventingMode
appEnvEnableReadOnlyMode :: ReadOnlyMode
appEnvServerMetrics :: ServerMetrics
appEnvShutdownLatch :: ShutdownLatch
appEnvMetaVersionRef :: TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: PrometheusMetrics
appEnvTraceSamplingPolicy :: SamplingPolicy
appEnvSubscriptionState :: SubscriptionsState
appEnvLockedEventsCtx :: LockedEventsCtx
appEnvConnParams :: ConnParams
appEnvTxIso :: TxIsolation
appEnvConsoleAssetsDir :: Maybe Text
appEnvConsoleSentryDsn :: Maybe Text
appEnvConnectionOptions :: ConnectionOptions
appEnvWebSocketKeepAlive :: KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: Refined NonNegative Seconds
appEnvSchemaPollInterval :: OptionalInterval
appEnvCheckFeatureFlag :: CheckFeatureFlag
appEnvLicenseKeyCache :: Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: Int
..} <- m AppEnv -> ActionCtxT ctx m AppEnv
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT ctx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppEnv
forall (m :: * -> *). HasAppEnv m => m AppEnv
askAppEnv
      let httpLogMetadata :: HttpLogMetadata m
httpLogMetadata = forall (m :: * -> *).
HttpLog m =>
HttpLogGraphQLInfo -> ExtraUserInfo -> HttpLogMetadata m
buildHttpLogMetadata @m HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo ExtraUserInfo
extraUserInfo
          jsonResponse :: ByteString
jsonResponse = Encoding -> ByteString
forall a. Encoding' a -> ByteString
J.encodingToLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> QErr -> Encoding
qErrEncoder Bool
includeInternal QErr
qErr
          contentLength :: Header
contentLength = (HeaderName
"Content-Length", ByteString -> ByteString
B8.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> Builder
BB.int64Dec (Int64 -> Builder) -> Int64 -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
jsonResponse)
          allHeaders :: [Header]
allHeaders = [Header
contentLength, Header
jsonHeader]
      -- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/http/#common-attributes
      m () -> ActionCtxT ctx m ()
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT ctx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ActionCtxT ctx m ()) -> m () -> ActionCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ TraceMetadata -> m ()
forall (m :: * -> *). MonadTrace m => TraceMetadata -> m ()
Tracing.attachMetadata [(Text
"http.response_content_length", ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Header -> ByteString
forall a b. (a, b) -> b
snd Header
contentLength)]
      m () -> ActionCtxT ctx m ()
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT ctx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ActionCtxT ctx m ()) -> m () -> ActionCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata m
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpError (Loggers -> Logger Hasura
_lsLogger Loggers
appEnvLoggers) LoggingSettings
appEnvLoggingSettings Maybe UserInfo
userInfo RequestId
reqId Request
waiReq (ByteString, Maybe Value)
req QErr
qErr [Header]
headers HttpLogMetadata m
httpLogMetadata
      (Header -> ActionCtxT ctx m ()) -> [Header] -> ActionCtxT ctx m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Header -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Header -> ActionCtxT ctx m ()
setHeader [Header]
allHeaders
      Status -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
Spock.setStatus (Status -> ActionCtxT ctx m ()) -> Status -> ActionCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ QErr -> Status
qeStatus QErr
qErr
      ByteString -> ActionCtxT ctx m any
forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
Spock.lazyBytes ByteString
jsonResponse

    logSuccessAndResp :: Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> APIResp
-> Maybe (DiffTime, DiffTime)
-> [Header]
-> [Header]
-> (CommonHttpLogMetadata, ExtraHttpLogMetadata m)
-> ActionCtxT ctx m b
logSuccessAndResp Maybe UserInfo
userInfo RequestId
reqId Request
waiReq (ByteString, Maybe Value)
req APIResp
result Maybe (DiffTime, DiffTime)
qTime [Header]
reqHeaders [Header]
authHdrs (CommonHttpLogMetadata, ExtraHttpLogMetadata m)
httpLoggingMetadata = do
      AppEnv {Int
Maybe Text
Maybe PGPool
Maybe (CredentialCache AgentLicenseKey)
SamplingPolicy
HostPreference
Manager
TxIsolation
ConnParams
PGPool
Refined NonNegative Seconds
TMVar MetadataResourceVersion
ConnectionOptions
CheckFeatureFlag
ServerMetrics
EventingMode
ReadOnlyMode
MaintenanceMode ()
InstanceId
PrometheusMetrics
ShutdownLatch
LoggingSettings
LockedEventsCtx
WSConnectionInitTimeout
KeepAliveDelay
OptionalInterval
Port
SubscriptionsState
Loggers
appEnvPort :: AppEnv -> Port
appEnvHost :: AppEnv -> HostPreference
appEnvMetadataDbPool :: AppEnv -> PGPool
appEnvIntrospectionDbPool :: AppEnv -> Maybe PGPool
appEnvManager :: AppEnv -> Manager
appEnvLoggers :: AppEnv -> Loggers
appEnvMetadataVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvInstanceId :: AppEnv -> InstanceId
appEnvEnableMaintenanceMode :: AppEnv -> MaintenanceMode ()
appEnvLoggingSettings :: AppEnv -> LoggingSettings
appEnvEventingMode :: AppEnv -> EventingMode
appEnvEnableReadOnlyMode :: AppEnv -> ReadOnlyMode
appEnvServerMetrics :: AppEnv -> ServerMetrics
appEnvShutdownLatch :: AppEnv -> ShutdownLatch
appEnvMetaVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: AppEnv -> PrometheusMetrics
appEnvTraceSamplingPolicy :: AppEnv -> SamplingPolicy
appEnvSubscriptionState :: AppEnv -> SubscriptionsState
appEnvLockedEventsCtx :: AppEnv -> LockedEventsCtx
appEnvConnParams :: AppEnv -> ConnParams
appEnvTxIso :: AppEnv -> TxIsolation
appEnvConsoleAssetsDir :: AppEnv -> Maybe Text
appEnvConsoleSentryDsn :: AppEnv -> Maybe Text
appEnvConnectionOptions :: AppEnv -> ConnectionOptions
appEnvWebSocketKeepAlive :: AppEnv -> KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: AppEnv -> WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: AppEnv -> Refined NonNegative Seconds
appEnvSchemaPollInterval :: AppEnv -> OptionalInterval
appEnvCheckFeatureFlag :: AppEnv -> CheckFeatureFlag
appEnvLicenseKeyCache :: AppEnv -> Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: AppEnv -> Int
appEnvPort :: Port
appEnvHost :: HostPreference
appEnvMetadataDbPool :: PGPool
appEnvIntrospectionDbPool :: Maybe PGPool
appEnvManager :: Manager
appEnvLoggers :: Loggers
appEnvMetadataVersionRef :: TMVar MetadataResourceVersion
appEnvInstanceId :: InstanceId
appEnvEnableMaintenanceMode :: MaintenanceMode ()
appEnvLoggingSettings :: LoggingSettings
appEnvEventingMode :: EventingMode
appEnvEnableReadOnlyMode :: ReadOnlyMode
appEnvServerMetrics :: ServerMetrics
appEnvShutdownLatch :: ShutdownLatch
appEnvMetaVersionRef :: TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: PrometheusMetrics
appEnvTraceSamplingPolicy :: SamplingPolicy
appEnvSubscriptionState :: SubscriptionsState
appEnvLockedEventsCtx :: LockedEventsCtx
appEnvConnParams :: ConnParams
appEnvTxIso :: TxIsolation
appEnvConsoleAssetsDir :: Maybe Text
appEnvConsoleSentryDsn :: Maybe Text
appEnvConnectionOptions :: ConnectionOptions
appEnvWebSocketKeepAlive :: KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: Refined NonNegative Seconds
appEnvSchemaPollInterval :: OptionalInterval
appEnvCheckFeatureFlag :: CheckFeatureFlag
appEnvLicenseKeyCache :: Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: Int
..} <- m AppEnv -> ActionCtxT ctx m AppEnv
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT ctx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppEnv
forall (m :: * -> *). HasAppEnv m => m AppEnv
askAppEnv
      let (ByteString
respBytes, [Header]
respHeaders) = case APIResp
result of
            JSONResp (HttpResponse EncJSON
encJson [Header]
h) -> (EncJSON -> ByteString
encJToLBS EncJSON
encJson, Header -> [Header]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Header
jsonHeader [Header] -> [Header] -> [Header]
forall a. Semigroup a => a -> a -> a
<> [Header]
h)
            RawResp (HttpResponse ByteString
rawBytes [Header]
h) -> (ByteString
rawBytes, [Header]
h)
          (ByteString
compressedResp, EncodingType
encodingType) = [Header] -> ByteString -> (ByteString, EncodingType)
compressResponse (Request -> [Header]
Wai.requestHeaders Request
waiReq) ByteString
respBytes
          encodingHeader :: [Header]
encodingHeader = Maybe Header -> [Header]
forall a. Maybe a -> [a]
maybeToList (CompressionType -> Header
contentEncodingHeader (CompressionType -> Header) -> EncodingType -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncodingType
encodingType)
          reqIdHeader :: Header
reqIdHeader = (HeaderName
forall a. IsString a => a
requestIdHeader, Text -> ByteString
txtToBs (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ RequestId -> Text
unRequestId RequestId
reqId)
          contentLength :: Header
contentLength = (HeaderName
"Content-Length", ByteString -> ByteString
B8.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> Builder
BB.int64Dec (Int64 -> Builder) -> Int64 -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
compressedResp)
          allRespHeaders :: [Header]
allRespHeaders = [Header
reqIdHeader, Header
contentLength] [Header] -> [Header] -> [Header]
forall a. Semigroup a => a -> a -> a
<> [Header]
encodingHeader [Header] -> [Header] -> [Header]
forall a. Semigroup a => a -> a -> a
<> [Header]
respHeaders [Header] -> [Header] -> [Header]
forall a. Semigroup a => a -> a -> a
<> [Header]
authHdrs
      -- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/http/#common-attributes
      m () -> ActionCtxT ctx m ()
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT ctx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ActionCtxT ctx m ()) -> m () -> ActionCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ TraceMetadata -> m ()
forall (m :: * -> *). MonadTrace m => TraceMetadata -> m ()
Tracing.attachMetadata [(Text
"http.response_content_length", ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Header -> ByteString
forall a b. (a, b) -> b
snd Header
contentLength)]
      m () -> ActionCtxT ctx m ()
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT ctx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ActionCtxT ctx m ()) -> m () -> ActionCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> EncodingType
-> [Header]
-> (CommonHttpLogMetadata, ExtraHttpLogMetadata m)
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> EncodingType
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpSuccess (Loggers -> Logger Hasura
_lsLogger Loggers
appEnvLoggers) LoggingSettings
appEnvLoggingSettings Maybe UserInfo
userInfo RequestId
reqId Request
waiReq (ByteString, Maybe Value)
req ByteString
respBytes ByteString
compressedResp Maybe (DiffTime, DiffTime)
qTime EncodingType
encodingType [Header]
reqHeaders (CommonHttpLogMetadata, ExtraHttpLogMetadata m)
httpLoggingMetadata
      (Header -> ActionCtxT ctx m ()) -> [Header] -> ActionCtxT ctx m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Header -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Header -> ActionCtxT ctx m ()
setHeader [Header]
allRespHeaders
      ByteString -> ActionCtxT ctx m b
forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
Spock.lazyBytes ByteString
compressedResp

v1QueryHandler ::
  ( MonadIO m,
    MonadError QErr m,
    MonadBaseControl IO m,
    MonadMetadataApiAuthorization m,
    MonadTrace m,
    MonadReader HandlerCtx m,
    MonadMetadataStorage m,
    MonadResolveSource m,
    HasAppEnv m,
    HasCacheStaticConfig m,
    MonadQueryTags m,
    MonadEventLogCleanup m,
    ProvidesNetwork m,
    MonadGetPolicies m,
    UserInfoM m
  ) =>
  ((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache)) -> m EncJSON) ->
  RQLQuery ->
  m (HttpResponse EncJSON)
v1QueryHandler :: forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadBaseControl IO m,
 MonadMetadataApiAuthorization m, MonadTrace m,
 MonadReader HandlerCtx m, MonadMetadataStorage m,
 MonadResolveSource m, HasAppEnv m, HasCacheStaticConfig m,
 MonadQueryTags m, MonadEventLogCleanup m, ProvidesNetwork m,
 MonadGetPolicies m, UserInfoM m) =>
((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
 -> m EncJSON)
-> RQLQuery -> m (HttpResponse EncJSON)
v1QueryHandler (RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
-> m EncJSON
schemaCacheRefUpdater RQLQuery
query = do
  (m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ())
-> (HandlerCtx -> m (Either QErr ())) -> HandlerCtx -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RQLQuery -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> m (Either QErr ())
authorizeV1QueryApi RQLQuery
query) (HandlerCtx -> m ()) -> m HandlerCtx -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m HandlerCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
  RebuildableSchemaCache
schemaCache <- (HandlerCtx -> RebuildableSchemaCache) -> m RebuildableSchemaCache
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> RebuildableSchemaCache
hcSchemaCache
  EncJSON
res <- m EncJSON -> m EncJSON -> Bool -> m EncJSON
forall a. a -> a -> Bool -> a
bool ((EncJSON, RebuildableSchemaCache) -> EncJSON
forall a b. (a, b) -> a
fst ((EncJSON, RebuildableSchemaCache) -> EncJSON)
-> m (EncJSON, RebuildableSchemaCache) -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache)
action RebuildableSchemaCache
schemaCache) ((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
-> m EncJSON
schemaCacheRefUpdater RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache)
action) (Bool -> m EncJSON) -> Bool -> m EncJSON
forall a b. (a -> b) -> a -> b
$ RQLQuery -> Bool
queryModifiesSchemaCache RQLQuery
query
  HttpResponse EncJSON -> m (HttpResponse EncJSON)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpResponse EncJSON -> m (HttpResponse EncJSON))
-> HttpResponse EncJSON -> m (HttpResponse EncJSON)
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse EncJSON
res []
  where
    action :: RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache)
action RebuildableSchemaCache
schemaCache = do
      AppContext
appContext <- (HandlerCtx -> AppContext) -> m AppContext
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> AppContext
hcAppContext
      AppContext
-> RebuildableSchemaCache
-> RQLQuery
-> m (EncJSON, RebuildableSchemaCache)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, HasAppEnv m, HasCacheStaticConfig m,
 MonadTrace m, MonadBaseControl IO m, MonadMetadataStorage m,
 MonadResolveSource m, MonadQueryTags m, MonadEventLogCleanup m,
 ProvidesHasuraServices m, MonadGetPolicies m, UserInfoM m) =>
AppContext
-> RebuildableSchemaCache
-> RQLQuery
-> m (EncJSON, RebuildableSchemaCache)
runQuery
        AppContext
appContext
        RebuildableSchemaCache
schemaCache
        RQLQuery
query

-- | See Note [Explicitly passing AppStateRef]
v1MetadataHandler ::
  ( MonadIO m,
    MonadError QErr m,
    MonadBaseControl IO m,
    MonadReader HandlerCtx m,
    MonadTrace m,
    MonadMetadataStorage m,
    MonadResolveSource m,
    MonadMetadataApiAuthorization m,
    MonadEventLogCleanup m,
    HasAppEnv m,
    HasCacheStaticConfig m,
    HasFeatureFlagChecker m,
    ProvidesNetwork m,
    MonadGetPolicies m,
    UserInfoM m
  ) =>
  ((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache)) -> m EncJSON) ->
  WS.WebsocketCloseOnMetadataChangeAction ->
  RQLMetadata ->
  m (HttpResponse EncJSON)
v1MetadataHandler :: forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadBaseControl IO m,
 MonadReader HandlerCtx m, MonadTrace m, MonadMetadataStorage m,
 MonadResolveSource m, MonadMetadataApiAuthorization m,
 MonadEventLogCleanup m, HasAppEnv m, HasCacheStaticConfig m,
 HasFeatureFlagChecker m, ProvidesNetwork m, MonadGetPolicies m,
 UserInfoM m) =>
((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
 -> m EncJSON)
-> WebsocketCloseOnMetadataChangeAction
-> RQLMetadata
-> m (HttpResponse EncJSON)
v1MetadataHandler (RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
-> m EncJSON
schemaCacheRefUpdater WebsocketCloseOnMetadataChangeAction
closeWebsocketsOnMetadataChangeAction RQLMetadata
query = Text -> m (HttpResponse EncJSON) -> m (HttpResponse EncJSON)
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"Metadata" (m (HttpResponse EncJSON) -> m (HttpResponse EncJSON))
-> m (HttpResponse EncJSON) -> m (HttpResponse EncJSON)
forall a b. (a -> b) -> a -> b
$ do
  (m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ())
-> (HandlerCtx -> m (Either QErr ())) -> HandlerCtx -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RQLMetadata -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLMetadata -> HandlerCtx -> m (Either QErr ())
authorizeV1MetadataApi RQLMetadata
query) (HandlerCtx -> m ()) -> m HandlerCtx -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m HandlerCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
  AppContext
appContext <- (HandlerCtx -> AppContext) -> m AppContext
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> AppContext
hcAppContext
  EncJSON
r <-
    (RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
-> m EncJSON
schemaCacheRefUpdater ((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
 -> m EncJSON)
-> (RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
-> m EncJSON
forall a b. (a -> b) -> a -> b
$ \RebuildableSchemaCache
schemaCache ->
      AppContext
-> RebuildableSchemaCache
-> WebsocketCloseOnMetadataChangeAction
-> RQLMetadata
-> m (EncJSON, RebuildableSchemaCache)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadBaseControl IO m, HasAppEnv m,
 HasCacheStaticConfig m, HasFeatureFlagChecker m, MonadTrace m,
 MonadMetadataStorage m, MonadResolveSource m,
 MonadEventLogCleanup m, ProvidesHasuraServices m,
 MonadGetPolicies m, UserInfoM m) =>
AppContext
-> RebuildableSchemaCache
-> WebsocketCloseOnMetadataChangeAction
-> RQLMetadata
-> m (EncJSON, RebuildableSchemaCache)
runMetadataQuery
        AppContext
appContext
        RebuildableSchemaCache
schemaCache
        WebsocketCloseOnMetadataChangeAction
closeWebsocketsOnMetadataChangeAction
        RQLMetadata
query
  HttpResponse EncJSON -> m (HttpResponse EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpResponse EncJSON -> m (HttpResponse EncJSON))
-> HttpResponse EncJSON -> m (HttpResponse EncJSON)
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse EncJSON
r []

v2QueryHandler ::
  ( MonadIO m,
    MonadError QErr m,
    MonadBaseControl IO m,
    MonadMetadataApiAuthorization m,
    MonadTrace m,
    MonadReader HandlerCtx m,
    MonadMetadataStorage m,
    MonadResolveSource m,
    HasAppEnv m,
    HasCacheStaticConfig m,
    MonadQueryTags m,
    ProvidesNetwork m,
    UserInfoM m
  ) =>
  ((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache)) -> m EncJSON) ->
  V2Q.RQLQuery ->
  m (HttpResponse EncJSON)
v2QueryHandler :: forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadBaseControl IO m,
 MonadMetadataApiAuthorization m, MonadTrace m,
 MonadReader HandlerCtx m, MonadMetadataStorage m,
 MonadResolveSource m, HasAppEnv m, HasCacheStaticConfig m,
 MonadQueryTags m, ProvidesNetwork m, UserInfoM m) =>
((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
 -> m EncJSON)
-> RQLQuery -> m (HttpResponse EncJSON)
v2QueryHandler (RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
-> m EncJSON
schemaCacheRefUpdater RQLQuery
query = Text -> m (HttpResponse EncJSON) -> m (HttpResponse EncJSON)
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"v2 Query" (m (HttpResponse EncJSON) -> m (HttpResponse EncJSON))
-> m (HttpResponse EncJSON) -> m (HttpResponse EncJSON)
forall a b. (a -> b) -> a -> b
$ do
  RebuildableSchemaCache
schemaCache <- (HandlerCtx -> RebuildableSchemaCache) -> m RebuildableSchemaCache
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> RebuildableSchemaCache
hcSchemaCache
  (m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ())
-> (HandlerCtx -> m (Either QErr ())) -> HandlerCtx -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RQLQuery -> HandlerCtx -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataApiAuthorization m =>
RQLQuery -> HandlerCtx -> m (Either QErr ())
authorizeV2QueryApi RQLQuery
query) (HandlerCtx -> m ()) -> m HandlerCtx -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m HandlerCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
  EncJSON
res <-
    m EncJSON -> m EncJSON -> Bool -> m EncJSON
forall a. a -> a -> Bool -> a
bool ((EncJSON, RebuildableSchemaCache) -> EncJSON
forall a b. (a, b) -> a
fst ((EncJSON, RebuildableSchemaCache) -> EncJSON)
-> m (EncJSON, RebuildableSchemaCache) -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache)
dbAction RebuildableSchemaCache
schemaCache) ((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
-> m EncJSON
schemaCacheRefUpdater RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache)
dbAction)
      (Bool -> m EncJSON) -> Bool -> m EncJSON
forall a b. (a -> b) -> a -> b
$ RQLQuery -> Bool
V2Q.queryModifiesSchema RQLQuery
query
  HttpResponse EncJSON -> m (HttpResponse EncJSON)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpResponse EncJSON -> m (HttpResponse EncJSON))
-> HttpResponse EncJSON -> m (HttpResponse EncJSON)
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse EncJSON
res []
  where
    -- Hit postgres
    dbAction :: RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache)
dbAction RebuildableSchemaCache
schemaCache = do
      AppContext
appContext <- (HandlerCtx -> AppContext) -> m AppContext
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> AppContext
hcAppContext
      AppContext
-> RebuildableSchemaCache
-> RQLQuery
-> m (EncJSON, RebuildableSchemaCache)
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, HasAppEnv m,
 HasCacheStaticConfig m, MonadTrace m, MonadMetadataStorage m,
 MonadResolveSource m, MonadQueryTags m, ProvidesHasuraServices m,
 UserInfoM m) =>
AppContext
-> RebuildableSchemaCache
-> RQLQuery
-> m (EncJSON, RebuildableSchemaCache)
V2Q.runQuery
        AppContext
appContext
        RebuildableSchemaCache
schemaCache
        RQLQuery
query

v1Alpha1GQHandler ::
  ( MonadIO m,
    MonadBaseControl IO m,
    E.MonadGQLExecutionCheck m,
    MonadQueryLog m,
    MonadExecutionLog m,
    MonadTrace m,
    HasAppEnv m,
    GH.MonadExecuteQuery m,
    MonadError QErr m,
    MonadReader HandlerCtx m,
    MonadMetadataStorage m,
    MonadQueryTags m,
    HasResourceLimits m,
    ProvidesNetwork m
  ) =>
  E.GraphQLQueryType ->
  GH.GQLBatchedReqs (GH.GQLReq GH.GQLQueryText) ->
  m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1Alpha1GQHandler :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadGQLExecutionCheck m,
 MonadQueryLog m, MonadExecutionLog m, MonadTrace m, HasAppEnv m,
 MonadExecuteQuery m, MonadError QErr m, MonadReader HandlerCtx m,
 MonadMetadataStorage m, MonadQueryTags m, HasResourceLimits m,
 ProvidesNetwork m) =>
GraphQLQueryType
-> ReqsText -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1Alpha1GQHandler GraphQLQueryType
queryType ReqsText
query = do
  AppEnv {Int
Maybe Text
Maybe PGPool
Maybe (CredentialCache AgentLicenseKey)
SamplingPolicy
HostPreference
Manager
TxIsolation
ConnParams
PGPool
Refined NonNegative Seconds
TMVar MetadataResourceVersion
ConnectionOptions
CheckFeatureFlag
ServerMetrics
EventingMode
ReadOnlyMode
MaintenanceMode ()
InstanceId
PrometheusMetrics
ShutdownLatch
LoggingSettings
LockedEventsCtx
WSConnectionInitTimeout
KeepAliveDelay
OptionalInterval
Port
SubscriptionsState
Loggers
appEnvPort :: AppEnv -> Port
appEnvHost :: AppEnv -> HostPreference
appEnvMetadataDbPool :: AppEnv -> PGPool
appEnvIntrospectionDbPool :: AppEnv -> Maybe PGPool
appEnvManager :: AppEnv -> Manager
appEnvLoggers :: AppEnv -> Loggers
appEnvMetadataVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvInstanceId :: AppEnv -> InstanceId
appEnvEnableMaintenanceMode :: AppEnv -> MaintenanceMode ()
appEnvLoggingSettings :: AppEnv -> LoggingSettings
appEnvEventingMode :: AppEnv -> EventingMode
appEnvEnableReadOnlyMode :: AppEnv -> ReadOnlyMode
appEnvServerMetrics :: AppEnv -> ServerMetrics
appEnvShutdownLatch :: AppEnv -> ShutdownLatch
appEnvMetaVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: AppEnv -> PrometheusMetrics
appEnvTraceSamplingPolicy :: AppEnv -> SamplingPolicy
appEnvSubscriptionState :: AppEnv -> SubscriptionsState
appEnvLockedEventsCtx :: AppEnv -> LockedEventsCtx
appEnvConnParams :: AppEnv -> ConnParams
appEnvTxIso :: AppEnv -> TxIsolation
appEnvConsoleAssetsDir :: AppEnv -> Maybe Text
appEnvConsoleSentryDsn :: AppEnv -> Maybe Text
appEnvConnectionOptions :: AppEnv -> ConnectionOptions
appEnvWebSocketKeepAlive :: AppEnv -> KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: AppEnv -> WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: AppEnv -> Refined NonNegative Seconds
appEnvSchemaPollInterval :: AppEnv -> OptionalInterval
appEnvCheckFeatureFlag :: AppEnv -> CheckFeatureFlag
appEnvLicenseKeyCache :: AppEnv -> Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: AppEnv -> Int
appEnvPort :: Port
appEnvHost :: HostPreference
appEnvMetadataDbPool :: PGPool
appEnvIntrospectionDbPool :: Maybe PGPool
appEnvManager :: Manager
appEnvLoggers :: Loggers
appEnvMetadataVersionRef :: TMVar MetadataResourceVersion
appEnvInstanceId :: InstanceId
appEnvEnableMaintenanceMode :: MaintenanceMode ()
appEnvLoggingSettings :: LoggingSettings
appEnvEventingMode :: EventingMode
appEnvEnableReadOnlyMode :: ReadOnlyMode
appEnvServerMetrics :: ServerMetrics
appEnvShutdownLatch :: ShutdownLatch
appEnvMetaVersionRef :: TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: PrometheusMetrics
appEnvTraceSamplingPolicy :: SamplingPolicy
appEnvSubscriptionState :: SubscriptionsState
appEnvLockedEventsCtx :: LockedEventsCtx
appEnvConnParams :: ConnParams
appEnvTxIso :: TxIsolation
appEnvConsoleAssetsDir :: Maybe Text
appEnvConsoleSentryDsn :: Maybe Text
appEnvConnectionOptions :: ConnectionOptions
appEnvWebSocketKeepAlive :: KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: Refined NonNegative Seconds
appEnvSchemaPollInterval :: OptionalInterval
appEnvCheckFeatureFlag :: CheckFeatureFlag
appEnvLicenseKeyCache :: Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: Int
..} <- m AppEnv
forall (m :: * -> *). HasAppEnv m => m AppEnv
askAppEnv
  AppContext {Environment
HashSet ExperimentalFeature
HashSet API
StreamQueriesOptions
NamingCase
RemoteSchemaPermissions
InferFunctionPermissions
SQLGenCtx
CloseWebsocketsOnMetadataChangeStatus
ApolloFederationStatus
CorsPolicy
AuthMode
MetadataDefaults
ResponseInternalErrorsConfig
OptionalInterval
TelemetryStatus
AllowListStatus
ConsoleStatus
EventEngineCtx
acEnabledAPIs :: AppContext -> HashSet API
acAuthMode :: AppContext -> AuthMode
acSQLGenCtx :: AppContext -> SQLGenCtx
acEnableAllowlist :: AppContext -> AllowListStatus
acResponseInternalErrorsConfig :: AppContext -> ResponseInternalErrorsConfig
acEnvironment :: AppContext -> Environment
acRemoteSchemaPermsCtx :: AppContext -> RemoteSchemaPermissions
acFunctionPermsCtx :: AppContext -> InferFunctionPermissions
acExperimentalFeatures :: AppContext -> HashSet ExperimentalFeature
acDefaultNamingConvention :: AppContext -> NamingCase
acMetadataDefaults :: AppContext -> MetadataDefaults
acLiveQueryOptions :: AppContext -> StreamQueriesOptions
acStreamQueryOptions :: AppContext -> StreamQueriesOptions
acCorsPolicy :: AppContext -> CorsPolicy
acConsoleStatus :: AppContext -> ConsoleStatus
acEnableTelemetry :: AppContext -> TelemetryStatus
acEventEngineCtx :: AppContext -> EventEngineCtx
acAsyncActionsFetchInterval :: AppContext -> OptionalInterval
acApolloFederationStatus :: AppContext -> ApolloFederationStatus
acCloseWebsocketsOnMetadataChangeStatus :: AppContext -> CloseWebsocketsOnMetadataChangeStatus
acAuthMode :: AuthMode
acSQLGenCtx :: SQLGenCtx
acEnabledAPIs :: HashSet API
acEnableAllowlist :: AllowListStatus
acResponseInternalErrorsConfig :: ResponseInternalErrorsConfig
acEnvironment :: Environment
acRemoteSchemaPermsCtx :: RemoteSchemaPermissions
acFunctionPermsCtx :: InferFunctionPermissions
acExperimentalFeatures :: HashSet ExperimentalFeature
acDefaultNamingConvention :: NamingCase
acMetadataDefaults :: MetadataDefaults
acLiveQueryOptions :: StreamQueriesOptions
acStreamQueryOptions :: StreamQueriesOptions
acCorsPolicy :: CorsPolicy
acConsoleStatus :: ConsoleStatus
acEnableTelemetry :: TelemetryStatus
acEventEngineCtx :: EventEngineCtx
acAsyncActionsFetchInterval :: OptionalInterval
acApolloFederationStatus :: ApolloFederationStatus
acCloseWebsocketsOnMetadataChangeStatus :: CloseWebsocketsOnMetadataChangeStatus
..} <- (HandlerCtx -> AppContext) -> m AppContext
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> AppContext
hcAppContext
  UserInfo
userInfo <- (HandlerCtx -> UserInfo) -> m UserInfo
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> UserInfo
hcUser
  SchemaCache
schemaCache <- RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache (RebuildableSchemaCache -> SchemaCache)
-> m RebuildableSchemaCache -> m SchemaCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HandlerCtx -> RebuildableSchemaCache) -> m RebuildableSchemaCache
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> RebuildableSchemaCache
hcSchemaCache
  [Header]
reqHeaders <- (HandlerCtx -> [Header]) -> m [Header]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> [Header]
hcReqHeaders
  IpAddress
ipAddress <- (HandlerCtx -> IpAddress) -> m IpAddress
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> IpAddress
hcSourceIpAddress
  RequestId
requestId <- (HandlerCtx -> RequestId) -> m RequestId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> RequestId
hcRequestId
  Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> ResponseInternalErrorsConfig
-> UserInfo
-> IpAddress
-> [Header]
-> GraphQLQueryType
-> ReqsText
-> m (HttpLogGraphQLInfo, HttpResponse 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
-> ResponseInternalErrorsConfig
-> UserInfo
-> IpAddress
-> [Header]
-> GraphQLQueryType
-> ReqsText
-> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
GH.runGQBatched Environment
acEnvironment SQLGenCtx
acSQLGenCtx SchemaCache
schemaCache AllowListStatus
acEnableAllowlist ReadOnlyMode
appEnvEnableReadOnlyMode PrometheusMetrics
appEnvPrometheusMetrics (Loggers -> Logger Hasura
_lsLogger Loggers
appEnvLoggers) Maybe (CredentialCache AgentLicenseKey)
appEnvLicenseKeyCache RequestId
requestId ResponseInternalErrorsConfig
acResponseInternalErrorsConfig UserInfo
userInfo IpAddress
ipAddress [Header]
reqHeaders GraphQLQueryType
queryType ReqsText
query

v1GQHandler ::
  ( MonadIO m,
    MonadBaseControl IO m,
    E.MonadGQLExecutionCheck m,
    MonadQueryLog m,
    MonadExecutionLog m,
    MonadTrace m,
    HasAppEnv m,
    GH.MonadExecuteQuery m,
    MonadError QErr m,
    MonadReader HandlerCtx m,
    MonadMetadataStorage m,
    MonadQueryTags m,
    HasResourceLimits m,
    ProvidesNetwork m
  ) =>
  GH.GQLBatchedReqs (GH.GQLReq GH.GQLQueryText) ->
  m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1GQHandler :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadGQLExecutionCheck m,
 MonadQueryLog m, MonadExecutionLog m, MonadTrace m, HasAppEnv m,
 MonadExecuteQuery m, MonadError QErr m, MonadReader HandlerCtx m,
 MonadMetadataStorage m, MonadQueryTags m, HasResourceLimits m,
 ProvidesNetwork m) =>
ReqsText -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1GQHandler = GraphQLQueryType
-> ReqsText -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadGQLExecutionCheck m,
 MonadQueryLog m, MonadExecutionLog m, MonadTrace m, HasAppEnv m,
 MonadExecuteQuery m, MonadError QErr m, MonadReader HandlerCtx m,
 MonadMetadataStorage m, MonadQueryTags m, HasResourceLimits m,
 ProvidesNetwork m) =>
GraphQLQueryType
-> ReqsText -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1Alpha1GQHandler GraphQLQueryType
E.QueryHasura

v1GQRelayHandler ::
  ( MonadIO m,
    MonadBaseControl IO m,
    E.MonadGQLExecutionCheck m,
    MonadQueryLog m,
    MonadExecutionLog m,
    MonadTrace m,
    HasAppEnv m,
    GH.MonadExecuteQuery m,
    MonadError QErr m,
    MonadReader HandlerCtx m,
    MonadMetadataStorage m,
    MonadQueryTags m,
    HasResourceLimits m,
    ProvidesNetwork m
  ) =>
  GH.GQLBatchedReqs (GH.GQLReq GH.GQLQueryText) ->
  m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1GQRelayHandler :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadGQLExecutionCheck m,
 MonadQueryLog m, MonadExecutionLog m, MonadTrace m, HasAppEnv m,
 MonadExecuteQuery m, MonadError QErr m, MonadReader HandlerCtx m,
 MonadMetadataStorage m, MonadQueryTags m, HasResourceLimits m,
 ProvidesNetwork m) =>
ReqsText -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1GQRelayHandler = GraphQLQueryType
-> ReqsText -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadGQLExecutionCheck m,
 MonadQueryLog m, MonadExecutionLog m, MonadTrace m, HasAppEnv m,
 MonadExecuteQuery m, MonadError QErr m, MonadReader HandlerCtx m,
 MonadMetadataStorage m, MonadQueryTags m, HasResourceLimits m,
 ProvidesNetwork m) =>
GraphQLQueryType
-> ReqsText -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1Alpha1GQHandler GraphQLQueryType
E.QueryRelay

gqlExplainHandler ::
  forall m.
  ( MonadIO m,
    MonadBaseControl IO m,
    MonadError QErr m,
    MonadReader HandlerCtx m,
    MonadMetadataStorage m,
    MonadQueryTags m,
    MonadTrace m
  ) =>
  GE.GQLExplain ->
  m (HttpResponse EncJSON)
gqlExplainHandler :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m,
 MonadReader HandlerCtx m, MonadMetadataStorage m, MonadQueryTags m,
 MonadTrace m) =>
GQLExplain -> m (HttpResponse EncJSON)
gqlExplainHandler GQLExplain
query = do
  m ()
forall (m :: * -> *).
(MonadError QErr m, MonadReader HandlerCtx m) =>
m ()
onlyAdmin
  RebuildableSchemaCache
schemaCache <- (HandlerCtx -> RebuildableSchemaCache) -> m RebuildableSchemaCache
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> RebuildableSchemaCache
hcSchemaCache
  [Header]
reqHeaders <- (HandlerCtx -> [Header]) -> m [Header]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> [Header]
hcReqHeaders
  Maybe (CredentialCache AgentLicenseKey)
licenseKeyCache <- (HandlerCtx -> Maybe (CredentialCache AgentLicenseKey))
-> m (Maybe (CredentialCache AgentLicenseKey))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> Maybe (CredentialCache AgentLicenseKey)
hcLicenseKeyCache
  EncJSON
res <- SchemaCache
-> Maybe (CredentialCache AgentLicenseKey)
-> [Header]
-> GQLExplain
-> m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadMetadataStorage m, MonadQueryTags m, MonadTrace m) =>
SchemaCache
-> Maybe (CredentialCache AgentLicenseKey)
-> [Header]
-> GQLExplain
-> m EncJSON
GE.explainGQLQuery (RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache RebuildableSchemaCache
schemaCache) Maybe (CredentialCache AgentLicenseKey)
licenseKeyCache [Header]
reqHeaders GQLExplain
query
  HttpResponse EncJSON -> m (HttpResponse EncJSON)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpResponse EncJSON -> m (HttpResponse EncJSON))
-> HttpResponse EncJSON -> m (HttpResponse EncJSON)
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse EncJSON
res []

v1Alpha1PGDumpHandler :: (MonadIO m, MonadError QErr m, MonadReader HandlerCtx m) => PGD.PGDumpReqBody -> m APIResp
v1Alpha1PGDumpHandler :: forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadReader HandlerCtx m) =>
PGDumpReqBody -> m APIResp
v1Alpha1PGDumpHandler PGDumpReqBody
b = do
  m ()
forall (m :: * -> *).
(MonadError QErr m, MonadReader HandlerCtx m) =>
m ()
onlyAdmin
  RebuildableSchemaCache
schemaCache <- (HandlerCtx -> RebuildableSchemaCache) -> m RebuildableSchemaCache
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> RebuildableSchemaCache
hcSchemaCache
  let sources :: SourceCache
sources = SchemaCache -> SourceCache
scSources (RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache RebuildableSchemaCache
schemaCache)
      sourceName :: SourceName
sourceName = PGDumpReqBody -> SourceName
PGD.prbSource PGDumpReqBody
b
      sourceConfig :: Maybe PGSourceConfig
sourceConfig = forall (b :: BackendType).
HasTag b =>
AnyBackend SourceInfo -> Maybe (SourceConfig b)
unsafeSourceConfiguration @('Postgres 'Vanilla) (AnyBackend SourceInfo -> Maybe PGSourceConfig)
-> Maybe (AnyBackend SourceInfo) -> Maybe PGSourceConfig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SourceName -> SourceCache -> Maybe (AnyBackend SourceInfo)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SourceName
sourceName SourceCache
sources
  ConnInfo
ci <-
    (PGSourceConfig -> ConnInfo)
-> Maybe PGSourceConfig -> Maybe ConnInfo
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PGSourceConfig -> ConnInfo
_pscConnInfo Maybe PGSourceConfig
sourceConfig
      Maybe ConnInfo -> m ConnInfo -> m ConnInfo
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m ConnInfo
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found")
  ByteString
output <- PGDumpReqBody -> ConnInfo -> m ByteString
forall (m :: * -> *).
(MonadError QErr m, MonadIO m) =>
PGDumpReqBody -> ConnInfo -> m ByteString
PGD.execPGDump PGDumpReqBody
b ConnInfo
ci
  APIResp -> m APIResp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (APIResp -> m APIResp) -> APIResp -> m APIResp
forall a b. (a -> b) -> a -> b
$ HttpResponse ByteString -> APIResp
RawResp (HttpResponse ByteString -> APIResp)
-> HttpResponse ByteString -> APIResp
forall a b. (a -> b) -> a -> b
$ ByteString -> [Header] -> HttpResponse ByteString
forall a. a -> [Header] -> HttpResponse a
HttpResponse ByteString
output [Header
sqlHeader]

consoleAssetsHandler ::
  (MonadIO m, HttpLog m) =>
  L.Logger L.Hasura ->
  LoggingSettings ->
  Text ->
  Text ->
  Spock.ActionT m ()
consoleAssetsHandler :: forall (m :: * -> *).
(MonadIO m, HttpLog m) =>
Logger Hasura -> LoggingSettings -> Text -> Text -> ActionT m ()
consoleAssetsHandler Logger Hasura
logger LoggingSettings
loggingSettings Text
dir Text
path = do
  Request
req <- ActionCtxT () m Request
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
Spock.request
  let reqHeaders :: [Header]
reqHeaders = Request -> [Header]
Wai.requestHeaders Request
req
  -- '..' in paths need not be handed as it is resolved in the url by
  -- spock's routing. we get the expanded path.
  Either IOException ByteString
eFileContents <-
    IO (Either IOException ByteString)
-> ActionCtxT () m (Either IOException ByteString)
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
      (IO (Either IOException ByteString)
 -> ActionCtxT () m (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> ActionCtxT () m (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
try @IOException do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
validFilename (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IOException
userError [Char]
"invalid asset filename"
        [Char] -> IO ByteString
BL.readFile
          ([Char] -> IO ByteString) -> [Char] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
joinPath [Text -> [Char]
T.unpack Text
dir, [Char]
pathStr]
  (IOException -> ActionT m ())
-> (ByteString -> ActionT m ())
-> Either IOException ByteString
-> ActionT m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Header] -> IOException -> ActionT m ()
forall (m :: * -> *) a.
(MonadIO m, HttpLog m) =>
[Header] -> a -> ActionT m ()
onError [Header]
reqHeaders) ByteString -> ActionT m ()
onSuccess Either IOException ByteString
eFileContents
  where
    pathStr :: [Char]
pathStr = Text -> [Char]
T.unpack Text
path
    validFilename :: Bool
validFilename = [Char] -> Bool
isRelative [Char]
pathStr Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
".." Text -> Text -> Bool
`T.isInfixOf` Text
path)
    onSuccess :: ByteString -> ActionT m ()
onSuccess ByteString
c = do
      (Header -> ActionT m ()) -> [Header] -> ActionT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Header -> ActionT m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Header -> ActionCtxT ctx m ()
setHeader [Header]
headers
      ByteString -> ActionT m ()
forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
Spock.lazyBytes ByteString
c
    onError :: (MonadIO m, HttpLog m) => [HTTP.Header] -> a -> Spock.ActionT m ()
    onError :: forall (m :: * -> *) a.
(MonadIO m, HttpLog m) =>
[Header] -> a -> ActionT m ()
onError [Header]
hdrs a
_ = Logger Hasura
-> LoggingSettings -> [Header] -> QErr -> ActionT m ()
forall (m :: * -> *).
(MonadIO m, HttpLog m) =>
Logger Hasura
-> LoggingSettings -> [Header] -> QErr -> ActionT m ()
raiseGenericApiError Logger Hasura
logger LoggingSettings
loggingSettings [Header]
hdrs (QErr -> ActionT m ()) -> QErr -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err404 Code
NotFound (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ Text
"Couldn't find console asset " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path
    -- set gzip header if the filename ends with .gz
    (Text
fileName, [Header]
encHeader) = case [Char] -> ([Char], [Char])
splitExtension ([Char] -> [Char]
takeFileName [Char]
pathStr) of
      ([Char]
v, [Char]
".gz") -> ([Char] -> Text
T.pack [Char]
v, [Header
gzipHeader])
      ([Char], [Char])
_ -> (Text
path, [])
    mimeType :: ByteString
mimeType = Text -> ByteString
defaultMimeLookup Text
fileName
    headers :: [Header]
headers = (HeaderName
"Content-Type", ByteString
mimeType) Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
encHeader

class (Monad m) => ConsoleRenderer m where
  type ConsoleType m :: Type
  renderConsole ::
    Text ->
    AuthMode ->
    TelemetryStatus ->
    Maybe Text ->
    Maybe Text ->
    ConsoleType m ->
    m (Either String Text)

-- TODO(awjchen): This is a kludge that will be removed when the entitlement service is fully implemented.
data CEConsoleType
  = OSSConsole
  | ProLiteConsole

ceConsoleTypeIdentifier :: CEConsoleType -> String
ceConsoleTypeIdentifier :: CEConsoleType -> [Char]
ceConsoleTypeIdentifier = \case
  CEConsoleType
OSSConsole -> [Char]
"oss"
  CEConsoleType
ProLiteConsole -> [Char]
"pro-lite"

instance (ConsoleRenderer m) => ConsoleRenderer (Tracing.TraceT m) where
  type ConsoleType (Tracing.TraceT m) = ConsoleType m
  renderConsole :: Text
-> AuthMode
-> TelemetryStatus
-> Maybe Text
-> Maybe Text
-> ConsoleType (TraceT m)
-> TraceT m (Either [Char] Text)
renderConsole Text
a AuthMode
b TelemetryStatus
c Maybe Text
d Maybe Text
e ConsoleType (TraceT m)
f = m (Either [Char] Text) -> TraceT m (Either [Char] Text)
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either [Char] Text) -> TraceT m (Either [Char] Text))
-> m (Either [Char] Text) -> TraceT m (Either [Char] Text)
forall a b. (a -> b) -> a -> b
$ Text
-> AuthMode
-> TelemetryStatus
-> Maybe Text
-> Maybe Text
-> ConsoleType m
-> m (Either [Char] Text)
forall (m :: * -> *).
ConsoleRenderer m =>
Text
-> AuthMode
-> TelemetryStatus
-> Maybe Text
-> Maybe Text
-> ConsoleType m
-> m (Either [Char] Text)
renderConsole Text
a AuthMode
b TelemetryStatus
c Maybe Text
d Maybe Text
e ConsoleType m
ConsoleType (TraceT m)
f

-- Type class to get any extra [Pair] for the version API
class (Monad m) => MonadVersionAPIWithExtraData m where
  getExtraDataForVersionAPI :: m [J.Pair]

renderHtmlTemplate :: M.Template -> Value -> Either String Text
renderHtmlTemplate :: Template -> Value -> Either [Char] Text
renderHtmlTemplate Template
template Value
jVal =
  Either [Char] Text
-> Either [Char] Text -> Bool -> Either [Char] Text
forall a. a -> a -> Bool -> a
bool ([Char] -> Either [Char] Text
forall a b. a -> Either a b
Left [Char]
errMsg) (Text -> Either [Char] Text
forall a b. b -> Either a b
Right Text
res) (Bool -> Either [Char] Text) -> Bool -> Either [Char] Text
forall a b. (a -> b) -> a -> b
$ [SubstitutionError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SubstitutionError]
errs
  where
    errMsg :: [Char]
errMsg = [Char]
"template rendering failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [SubstitutionError] -> [Char]
forall a. Show a => a -> [Char]
show [SubstitutionError]
errs
    ([SubstitutionError]
errs, Text
res) = Template -> Value -> ([SubstitutionError], Text)
forall k.
ToMustache k =>
Template -> k -> ([SubstitutionError], Text)
M.checkedSubstitute Template
template Value
jVal

-- | Default implementation of the 'MonadConfigApiHandler'
configApiGetHandler ::
  forall m impl.
  ( MonadIO m,
    MonadBaseControl IO m,
    HasAppEnv m,
    UserAuthentication m,
    HttpLog m,
    HasResourceLimits m,
    MonadTrace m
  ) =>
  AppStateRef impl ->
  Spock.SpockCtxT () m ()
configApiGetHandler :: forall (m :: * -> *) impl.
(MonadIO m, MonadBaseControl IO m, HasAppEnv m,
 UserAuthentication m, HttpLog m, HasResourceLimits m,
 MonadTrace m) =>
AppStateRef impl -> SpockCtxT () m ()
configApiGetHandler AppStateRef impl
appStateRef = do
  Path '[] 'Open
-> HVectElim '[] (ActionCtxT () m ()) -> SpockCtxT () m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"v1alpha1/config"
    (HVectElim '[] (ActionCtxT () m ()) -> SpockCtxT () m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isConfigEnabled AppStateRef impl
appStateRef
    (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ do
      AppEnv {Int
Maybe Text
Maybe PGPool
Maybe (CredentialCache AgentLicenseKey)
SamplingPolicy
HostPreference
Manager
TxIsolation
ConnParams
PGPool
Refined NonNegative Seconds
TMVar MetadataResourceVersion
ConnectionOptions
CheckFeatureFlag
ServerMetrics
EventingMode
ReadOnlyMode
MaintenanceMode ()
InstanceId
PrometheusMetrics
ShutdownLatch
LoggingSettings
LockedEventsCtx
WSConnectionInitTimeout
KeepAliveDelay
OptionalInterval
Port
SubscriptionsState
Loggers
appEnvPort :: AppEnv -> Port
appEnvHost :: AppEnv -> HostPreference
appEnvMetadataDbPool :: AppEnv -> PGPool
appEnvIntrospectionDbPool :: AppEnv -> Maybe PGPool
appEnvManager :: AppEnv -> Manager
appEnvLoggers :: AppEnv -> Loggers
appEnvMetadataVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvInstanceId :: AppEnv -> InstanceId
appEnvEnableMaintenanceMode :: AppEnv -> MaintenanceMode ()
appEnvLoggingSettings :: AppEnv -> LoggingSettings
appEnvEventingMode :: AppEnv -> EventingMode
appEnvEnableReadOnlyMode :: AppEnv -> ReadOnlyMode
appEnvServerMetrics :: AppEnv -> ServerMetrics
appEnvShutdownLatch :: AppEnv -> ShutdownLatch
appEnvMetaVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: AppEnv -> PrometheusMetrics
appEnvTraceSamplingPolicy :: AppEnv -> SamplingPolicy
appEnvSubscriptionState :: AppEnv -> SubscriptionsState
appEnvLockedEventsCtx :: AppEnv -> LockedEventsCtx
appEnvConnParams :: AppEnv -> ConnParams
appEnvTxIso :: AppEnv -> TxIsolation
appEnvConsoleAssetsDir :: AppEnv -> Maybe Text
appEnvConsoleSentryDsn :: AppEnv -> Maybe Text
appEnvConnectionOptions :: AppEnv -> ConnectionOptions
appEnvWebSocketKeepAlive :: AppEnv -> KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: AppEnv -> WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: AppEnv -> Refined NonNegative Seconds
appEnvSchemaPollInterval :: AppEnv -> OptionalInterval
appEnvCheckFeatureFlag :: AppEnv -> CheckFeatureFlag
appEnvLicenseKeyCache :: AppEnv -> Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: AppEnv -> Int
appEnvPort :: Port
appEnvHost :: HostPreference
appEnvMetadataDbPool :: PGPool
appEnvIntrospectionDbPool :: Maybe PGPool
appEnvManager :: Manager
appEnvLoggers :: Loggers
appEnvMetadataVersionRef :: TMVar MetadataResourceVersion
appEnvInstanceId :: InstanceId
appEnvEnableMaintenanceMode :: MaintenanceMode ()
appEnvLoggingSettings :: LoggingSettings
appEnvEventingMode :: EventingMode
appEnvEnableReadOnlyMode :: ReadOnlyMode
appEnvServerMetrics :: ServerMetrics
appEnvShutdownLatch :: ShutdownLatch
appEnvMetaVersionRef :: TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: PrometheusMetrics
appEnvTraceSamplingPolicy :: SamplingPolicy
appEnvSubscriptionState :: SubscriptionsState
appEnvLockedEventsCtx :: LockedEventsCtx
appEnvConnParams :: ConnParams
appEnvTxIso :: TxIsolation
appEnvConsoleAssetsDir :: Maybe Text
appEnvConsoleSentryDsn :: Maybe Text
appEnvConnectionOptions :: ConnectionOptions
appEnvWebSocketKeepAlive :: KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: Refined NonNegative Seconds
appEnvSchemaPollInterval :: OptionalInterval
appEnvCheckFeatureFlag :: CheckFeatureFlag
appEnvLicenseKeyCache :: Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: Int
..} <- m AppEnv -> ActionCtxT () m AppEnv
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppEnv
forall (m :: * -> *). HasAppEnv m => m AppEnv
askAppEnv
      AppContext {Environment
HashSet ExperimentalFeature
HashSet API
StreamQueriesOptions
NamingCase
RemoteSchemaPermissions
InferFunctionPermissions
SQLGenCtx
CloseWebsocketsOnMetadataChangeStatus
ApolloFederationStatus
CorsPolicy
AuthMode
MetadataDefaults
ResponseInternalErrorsConfig
OptionalInterval
TelemetryStatus
AllowListStatus
ConsoleStatus
EventEngineCtx
acEnabledAPIs :: AppContext -> HashSet API
acAuthMode :: AppContext -> AuthMode
acSQLGenCtx :: AppContext -> SQLGenCtx
acEnableAllowlist :: AppContext -> AllowListStatus
acResponseInternalErrorsConfig :: AppContext -> ResponseInternalErrorsConfig
acEnvironment :: AppContext -> Environment
acRemoteSchemaPermsCtx :: AppContext -> RemoteSchemaPermissions
acFunctionPermsCtx :: AppContext -> InferFunctionPermissions
acExperimentalFeatures :: AppContext -> HashSet ExperimentalFeature
acDefaultNamingConvention :: AppContext -> NamingCase
acMetadataDefaults :: AppContext -> MetadataDefaults
acLiveQueryOptions :: AppContext -> StreamQueriesOptions
acStreamQueryOptions :: AppContext -> StreamQueriesOptions
acCorsPolicy :: AppContext -> CorsPolicy
acConsoleStatus :: AppContext -> ConsoleStatus
acEnableTelemetry :: AppContext -> TelemetryStatus
acEventEngineCtx :: AppContext -> EventEngineCtx
acAsyncActionsFetchInterval :: AppContext -> OptionalInterval
acApolloFederationStatus :: AppContext -> ApolloFederationStatus
acCloseWebsocketsOnMetadataChangeStatus :: AppContext -> CloseWebsocketsOnMetadataChangeStatus
acAuthMode :: AuthMode
acSQLGenCtx :: SQLGenCtx
acEnabledAPIs :: HashSet API
acEnableAllowlist :: AllowListStatus
acResponseInternalErrorsConfig :: ResponseInternalErrorsConfig
acEnvironment :: Environment
acRemoteSchemaPermsCtx :: RemoteSchemaPermissions
acFunctionPermsCtx :: InferFunctionPermissions
acExperimentalFeatures :: HashSet ExperimentalFeature
acDefaultNamingConvention :: NamingCase
acMetadataDefaults :: MetadataDefaults
acLiveQueryOptions :: StreamQueriesOptions
acStreamQueryOptions :: StreamQueriesOptions
acCorsPolicy :: CorsPolicy
acConsoleStatus :: ConsoleStatus
acEnableTelemetry :: TelemetryStatus
acEventEngineCtx :: EventEngineCtx
acAsyncActionsFetchInterval :: OptionalInterval
acApolloFederationStatus :: ApolloFederationStatus
acCloseWebsocketsOnMetadataChangeStatus :: CloseWebsocketsOnMetadataChangeStatus
..} <- IO AppContext -> ActionCtxT () m AppContext
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppContext -> ActionCtxT () m AppContext)
-> IO AppContext -> ActionCtxT () m AppContext
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
getAppContext AppStateRef impl
appStateRef
      [(FeatureFlag, Text, Bool)]
featureFlagSettings <-
        ((FeatureFlag, Text) -> ActionCtxT () m (FeatureFlag, Text, Bool))
-> [(FeatureFlag, Text)]
-> ActionCtxT () m [(FeatureFlag, Text, Bool)]
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
          (\(FeatureFlag
ff, Text
desc) -> (FeatureFlag
ff,Text
desc,) (Bool -> (FeatureFlag, Text, Bool))
-> ActionCtxT () m Bool
-> ActionCtxT () m (FeatureFlag, Text, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool -> ActionCtxT () m Bool
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CheckFeatureFlag -> FeatureFlag -> IO Bool
runCheckFeatureFlag CheckFeatureFlag
appEnvCheckFeatureFlag FeatureFlag
ff))
          (CheckFeatureFlag -> [(FeatureFlag, Text)]
listKnownFeatureFlags CheckFeatureFlag
appEnvCheckFeatureFlag)
      AppStateRef impl
-> (Bool -> QErr -> Encoding)
-> (QErr -> QErr)
-> APIHandler m ()
-> ActionCtxT () m ()
forall (m :: * -> *) a impl.
(MonadIO m, MonadBaseControl IO m, HasAppEnv m, FromJSON a,
 UserAuthentication m, HttpLog m, HasResourceLimits m,
 MonadTrace m) =>
AppStateRef impl
-> (Bool -> QErr -> Encoding)
-> (QErr -> QErr)
-> APIHandler m a
-> ActionT m ()
mkSpockAction AppStateRef impl
appStateRef Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
        (APIHandler m () -> ActionCtxT () m ())
-> APIHandler m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall (m :: * -> *).
Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
mkGetHandler
        (Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ())
-> Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall a b. (a -> b) -> a -> b
$ do
          Handler m ()
forall (m :: * -> *).
(MonadError QErr m, MonadReader HandlerCtx m) =>
m ()
onlyAdmin
          let res :: ServerConfig
res =
                InferFunctionPermissions
-> RemoteSchemaPermissions
-> AuthMode
-> AllowListStatus
-> StreamQueriesOptions
-> StreamQueriesOptions
-> Maybe Text
-> HashSet ExperimentalFeature
-> HashSet API
-> NamingCase
-> [(FeatureFlag, Text, Bool)]
-> ServerConfig
runGetConfig
                  InferFunctionPermissions
acFunctionPermsCtx
                  RemoteSchemaPermissions
acRemoteSchemaPermsCtx
                  AuthMode
acAuthMode
                  AllowListStatus
acEnableAllowlist
                  StreamQueriesOptions
acLiveQueryOptions
                  StreamQueriesOptions
acStreamQueryOptions
                  Maybe Text
appEnvConsoleAssetsDir
                  HashSet ExperimentalFeature
acExperimentalFeatures
                  HashSet API
acEnabledAPIs
                  NamingCase
acDefaultNamingConvention
                  [(FeatureFlag, Text, Bool)]
featureFlagSettings
          (HttpLogGraphQLInfo, APIResp)
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall a. a -> Handler m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo, HttpResponse EncJSON -> APIResp
JSONResp (HttpResponse EncJSON -> APIResp)
-> HttpResponse EncJSON -> APIResp
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse (ServerConfig -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue ServerConfig
res) [])

data HasuraApp = HasuraApp
  { HasuraApp -> Application
_hapApplication :: !Wai.Application,
    HasuraApp -> AsyncActionSubscriptionState
_hapAsyncActionSubscriptionState :: !ES.AsyncActionSubscriptionState,
    HasuraApp -> IO ()
_hapShutdownWsServer :: !(IO ())
  }

mkWaiApp ::
  forall m impl.
  ( MonadIO m,
    MonadFix m,
    MonadStateless IO m,
    LA.Forall (LA.Pure m),
    ConsoleRenderer m,
    MonadVersionAPIWithExtraData m,
    HttpLog m,
    HasAppEnv m,
    HasCacheStaticConfig m,
    HasFeatureFlagChecker m,
    UserAuthentication m,
    MonadMetadataApiAuthorization m,
    E.MonadGQLExecutionCheck m,
    MonadConfigApiHandler m,
    MonadQueryLog m,
    MonadExecutionLog m,
    WS.MonadWSLog m,
    MonadTrace m,
    GH.MonadExecuteQuery m,
    HasResourceLimits m,
    MonadMetadataStorage m,
    MonadResolveSource m,
    MonadQueryTags m,
    MonadEventLogCleanup m,
    ProvidesNetwork m,
    MonadGetPolicies m
  ) =>
  (AppStateRef impl -> Spock.SpockT m ()) ->
  AppStateRef impl ->
  ConsoleType m ->
  EKG.Store EKG.EmptyMetrics ->
  WS.WSServerEnv impl ->
  m HasuraApp
mkWaiApp :: forall (m :: * -> *) impl.
(MonadIO m, MonadFix m, MonadStateless IO m, Forall (Pure m),
 ConsoleRenderer m, MonadVersionAPIWithExtraData m, HttpLog m,
 HasAppEnv m, HasCacheStaticConfig m, HasFeatureFlagChecker m,
 UserAuthentication m, MonadMetadataApiAuthorization m,
 MonadGQLExecutionCheck m, MonadConfigApiHandler m, MonadQueryLog m,
 MonadExecutionLog m, MonadWSLog m, MonadTrace m,
 MonadExecuteQuery m, HasResourceLimits m, MonadMetadataStorage m,
 MonadResolveSource m, MonadQueryTags m, MonadEventLogCleanup m,
 ProvidesNetwork m, MonadGetPolicies m) =>
(AppStateRef impl -> SpockT m ())
-> AppStateRef impl
-> ConsoleType m
-> Store EmptyMetrics
-> WSServerEnv impl
-> m HasuraApp
mkWaiApp AppStateRef impl -> SpockT m ()
setupHook AppStateRef impl
appStateRef ConsoleType m
consoleType Store EmptyMetrics
ekgStore WSServerEnv impl
wsServerEnv = do
  appEnv :: AppEnv
appEnv@AppEnv {Int
Maybe Text
Maybe PGPool
Maybe (CredentialCache AgentLicenseKey)
SamplingPolicy
HostPreference
Manager
TxIsolation
ConnParams
PGPool
Refined NonNegative Seconds
TMVar MetadataResourceVersion
ConnectionOptions
CheckFeatureFlag
ServerMetrics
EventingMode
ReadOnlyMode
MaintenanceMode ()
InstanceId
PrometheusMetrics
ShutdownLatch
LoggingSettings
LockedEventsCtx
WSConnectionInitTimeout
KeepAliveDelay
OptionalInterval
Port
SubscriptionsState
Loggers
appEnvPort :: AppEnv -> Port
appEnvHost :: AppEnv -> HostPreference
appEnvMetadataDbPool :: AppEnv -> PGPool
appEnvIntrospectionDbPool :: AppEnv -> Maybe PGPool
appEnvManager :: AppEnv -> Manager
appEnvLoggers :: AppEnv -> Loggers
appEnvMetadataVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvInstanceId :: AppEnv -> InstanceId
appEnvEnableMaintenanceMode :: AppEnv -> MaintenanceMode ()
appEnvLoggingSettings :: AppEnv -> LoggingSettings
appEnvEventingMode :: AppEnv -> EventingMode
appEnvEnableReadOnlyMode :: AppEnv -> ReadOnlyMode
appEnvServerMetrics :: AppEnv -> ServerMetrics
appEnvShutdownLatch :: AppEnv -> ShutdownLatch
appEnvMetaVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: AppEnv -> PrometheusMetrics
appEnvTraceSamplingPolicy :: AppEnv -> SamplingPolicy
appEnvSubscriptionState :: AppEnv -> SubscriptionsState
appEnvLockedEventsCtx :: AppEnv -> LockedEventsCtx
appEnvConnParams :: AppEnv -> ConnParams
appEnvTxIso :: AppEnv -> TxIsolation
appEnvConsoleAssetsDir :: AppEnv -> Maybe Text
appEnvConsoleSentryDsn :: AppEnv -> Maybe Text
appEnvConnectionOptions :: AppEnv -> ConnectionOptions
appEnvWebSocketKeepAlive :: AppEnv -> KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: AppEnv -> WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: AppEnv -> Refined NonNegative Seconds
appEnvSchemaPollInterval :: AppEnv -> OptionalInterval
appEnvCheckFeatureFlag :: AppEnv -> CheckFeatureFlag
appEnvLicenseKeyCache :: AppEnv -> Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: AppEnv -> Int
appEnvPort :: Port
appEnvHost :: HostPreference
appEnvMetadataDbPool :: PGPool
appEnvIntrospectionDbPool :: Maybe PGPool
appEnvManager :: Manager
appEnvLoggers :: Loggers
appEnvMetadataVersionRef :: TMVar MetadataResourceVersion
appEnvInstanceId :: InstanceId
appEnvEnableMaintenanceMode :: MaintenanceMode ()
appEnvLoggingSettings :: LoggingSettings
appEnvEventingMode :: EventingMode
appEnvEnableReadOnlyMode :: ReadOnlyMode
appEnvServerMetrics :: ServerMetrics
appEnvShutdownLatch :: ShutdownLatch
appEnvMetaVersionRef :: TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: PrometheusMetrics
appEnvTraceSamplingPolicy :: SamplingPolicy
appEnvSubscriptionState :: SubscriptionsState
appEnvLockedEventsCtx :: LockedEventsCtx
appEnvConnParams :: ConnParams
appEnvTxIso :: TxIsolation
appEnvConsoleAssetsDir :: Maybe Text
appEnvConsoleSentryDsn :: Maybe Text
appEnvConnectionOptions :: ConnectionOptions
appEnvWebSocketKeepAlive :: KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: Refined NonNegative Seconds
appEnvSchemaPollInterval :: OptionalInterval
appEnvCheckFeatureFlag :: CheckFeatureFlag
appEnvLicenseKeyCache :: Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: Int
..} <- m AppEnv
forall (m :: * -> *). HasAppEnv m => m AppEnv
askAppEnv
  Application
spockApp <- ((forall a. m a -> IO a) -> IO Application) -> m Application
forall c. ((forall a. m a -> IO a) -> IO c) -> m c
forall (b :: * -> *) (m :: * -> *) c.
MonadStateless b m =>
((forall a. m a -> b a) -> b c) -> m c
liftWithStateless (((forall a. m a -> IO a) -> IO Application) -> m Application)
-> ((forall a. m a -> IO a) -> IO Application) -> m Application
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
lowerIO ->
    IO Middleware -> IO Application
Spock.spockAsApp
      (IO Middleware -> IO Application)
-> IO Middleware -> IO Application
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> IO a) -> SpockT m () -> IO Middleware
forall (m :: * -> *).
MonadIO m =>
(forall a. m a -> IO a) -> SpockT m () -> IO Middleware
Spock.spockT m a -> IO a
forall a. m a -> IO a
lowerIO
      (SpockT m () -> IO Middleware) -> SpockT m () -> IO Middleware
forall a b. (a -> b) -> a -> b
$ (AppStateRef impl -> SpockT m ())
-> AppStateRef impl
-> AppEnv
-> ConsoleType m
-> Store EmptyMetrics
-> WebsocketCloseOnMetadataChangeAction
-> SpockT m ()
forall (m :: * -> *) impl.
(MonadIO m, MonadFix m, MonadBaseControl IO m, ConsoleRenderer m,
 MonadVersionAPIWithExtraData m, HttpLog m, HasAppEnv m,
 HasCacheStaticConfig m, HasFeatureFlagChecker m,
 UserAuthentication m, MonadMetadataApiAuthorization m,
 MonadGQLExecutionCheck m, MonadConfigApiHandler m, MonadQueryLog m,
 MonadExecutionLog m, MonadTrace m, MonadExecuteQuery m,
 MonadMetadataStorage m, HasResourceLimits m, MonadResolveSource m,
 MonadQueryTags m, MonadEventLogCleanup m, ProvidesNetwork m,
 MonadGetPolicies m) =>
(AppStateRef impl -> SpockT m ())
-> AppStateRef impl
-> AppEnv
-> ConsoleType m
-> Store EmptyMetrics
-> WebsocketCloseOnMetadataChangeAction
-> SpockT m ()
httpApp AppStateRef impl -> SpockT m ()
setupHook AppStateRef impl
appStateRef AppEnv
appEnv ConsoleType m
consoleType Store EmptyMetrics
ekgStore
      (WebsocketCloseOnMetadataChangeAction -> SpockT m ())
-> WebsocketCloseOnMetadataChangeAction -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ WSServer WSConnData -> WebsocketCloseOnMetadataChangeAction
WS.mkCloseWebsocketsOnMetadataChangeAction (WSServerEnv impl -> WSServer WSConnData
forall impl. WSServerEnv impl -> WSServer WSConnData
WS._wseServer WSServerEnv impl
wsServerEnv)

  let wsServerApp :: HasuraServerApp m
wsServerApp = HashSet (EngineLogType Hasura)
-> WSServerEnv impl
-> WSConnectionInitTimeout
-> Maybe (CredentialCache AgentLicenseKey)
-> HasuraServerApp m
forall (m :: * -> *) impl.
(MonadIO m, MonadBaseControl IO m, Forall (Pure m),
 UserAuthentication m, MonadGQLExecutionCheck m, MonadWSLog m,
 MonadQueryLog m, MonadExecutionLog m, MonadExecuteQuery m,
 MonadMetadataStorage m, MonadQueryTags m, HasResourceLimits m,
 ProvidesNetwork m, MonadTrace m, MonadGetPolicies m) =>
HashSet (EngineLogType Hasura)
-> WSServerEnv impl
-> WSConnectionInitTimeout
-> Maybe (CredentialCache AgentLicenseKey)
-> HasuraServerApp m
WS.createWSServerApp (LoggingSettings -> HashSet (EngineLogType Hasura)
_lsEnabledLogTypes LoggingSettings
appEnvLoggingSettings) WSServerEnv impl
wsServerEnv WSConnectionInitTimeout
appEnvWebSocketConnectionInitTimeout Maybe (CredentialCache AgentLicenseKey)
appEnvLicenseKeyCache
      stopWSServer :: IO ()
stopWSServer = WSServerEnv impl -> IO ()
forall impl. WSServerEnv impl -> IO ()
WS.stopWSServerApp WSServerEnv impl
wsServerEnv

  Application
waiApp <- ((forall a. m a -> IO a) -> IO Application) -> m Application
forall c. ((forall a. m a -> IO a) -> IO c) -> m c
forall (b :: * -> *) (m :: * -> *) c.
MonadStateless b m =>
((forall a. m a -> b a) -> b c) -> m c
liftWithStateless (((forall a. m a -> IO a) -> IO Application) -> m Application)
-> ((forall a. m a -> IO a) -> IO Application) -> m Application
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
lowerIO ->
    Application -> IO Application
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Application -> IO Application) -> Application -> IO Application
forall a b. (a -> b) -> a -> b
$ ConnectionOptions
-> (IpAddress -> PendingConnection -> IO ()) -> Middleware
WSC.websocketsOr ConnectionOptions
appEnvConnectionOptions (\IpAddress
ip PendingConnection
conn -> m () -> IO ()
forall a. m a -> IO a
lowerIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ HasuraServerApp m
wsServerApp IpAddress
ip PendingConnection
conn) Application
spockApp

  HasuraApp -> m HasuraApp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HasuraApp -> m HasuraApp) -> HasuraApp -> m HasuraApp
forall a b. (a -> b) -> a -> b
$ Application -> AsyncActionSubscriptionState -> IO () -> HasuraApp
HasuraApp Application
waiApp (SubscriptionsState -> AsyncActionSubscriptionState
ES._ssAsyncActions SubscriptionsState
appEnvSubscriptionState) IO ()
stopWSServer

httpApp ::
  forall m impl.
  ( MonadIO m,
    MonadFix m,
    MonadBaseControl IO m,
    ConsoleRenderer m,
    MonadVersionAPIWithExtraData m,
    HttpLog m,
    HasAppEnv m,
    HasCacheStaticConfig m,
    HasFeatureFlagChecker m,
    UserAuthentication m,
    MonadMetadataApiAuthorization m,
    E.MonadGQLExecutionCheck m,
    MonadConfigApiHandler m,
    MonadQueryLog m,
    MonadExecutionLog m,
    MonadTrace m,
    GH.MonadExecuteQuery m,
    MonadMetadataStorage m,
    HasResourceLimits m,
    MonadResolveSource m,
    MonadQueryTags m,
    MonadEventLogCleanup m,
    ProvidesNetwork m,
    MonadGetPolicies m
  ) =>
  (AppStateRef impl -> Spock.SpockT m ()) ->
  AppStateRef impl ->
  AppEnv ->
  ConsoleType m ->
  EKG.Store EKG.EmptyMetrics ->
  WS.WebsocketCloseOnMetadataChangeAction ->
  Spock.SpockT m ()
httpApp :: forall (m :: * -> *) impl.
(MonadIO m, MonadFix m, MonadBaseControl IO m, ConsoleRenderer m,
 MonadVersionAPIWithExtraData m, HttpLog m, HasAppEnv m,
 HasCacheStaticConfig m, HasFeatureFlagChecker m,
 UserAuthentication m, MonadMetadataApiAuthorization m,
 MonadGQLExecutionCheck m, MonadConfigApiHandler m, MonadQueryLog m,
 MonadExecutionLog m, MonadTrace m, MonadExecuteQuery m,
 MonadMetadataStorage m, HasResourceLimits m, MonadResolveSource m,
 MonadQueryTags m, MonadEventLogCleanup m, ProvidesNetwork m,
 MonadGetPolicies m) =>
(AppStateRef impl -> SpockT m ())
-> AppStateRef impl
-> AppEnv
-> ConsoleType m
-> Store EmptyMetrics
-> WebsocketCloseOnMetadataChangeAction
-> SpockT m ()
httpApp AppStateRef impl -> SpockT m ()
setupHook AppStateRef impl
appStateRef AppEnv {Int
Maybe Text
Maybe PGPool
Maybe (CredentialCache AgentLicenseKey)
SamplingPolicy
HostPreference
Manager
TxIsolation
ConnParams
PGPool
Refined NonNegative Seconds
TMVar MetadataResourceVersion
ConnectionOptions
CheckFeatureFlag
ServerMetrics
EventingMode
ReadOnlyMode
MaintenanceMode ()
InstanceId
PrometheusMetrics
ShutdownLatch
LoggingSettings
LockedEventsCtx
WSConnectionInitTimeout
KeepAliveDelay
OptionalInterval
Port
SubscriptionsState
Loggers
appEnvPort :: AppEnv -> Port
appEnvHost :: AppEnv -> HostPreference
appEnvMetadataDbPool :: AppEnv -> PGPool
appEnvIntrospectionDbPool :: AppEnv -> Maybe PGPool
appEnvManager :: AppEnv -> Manager
appEnvLoggers :: AppEnv -> Loggers
appEnvMetadataVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvInstanceId :: AppEnv -> InstanceId
appEnvEnableMaintenanceMode :: AppEnv -> MaintenanceMode ()
appEnvLoggingSettings :: AppEnv -> LoggingSettings
appEnvEventingMode :: AppEnv -> EventingMode
appEnvEnableReadOnlyMode :: AppEnv -> ReadOnlyMode
appEnvServerMetrics :: AppEnv -> ServerMetrics
appEnvShutdownLatch :: AppEnv -> ShutdownLatch
appEnvMetaVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: AppEnv -> PrometheusMetrics
appEnvTraceSamplingPolicy :: AppEnv -> SamplingPolicy
appEnvSubscriptionState :: AppEnv -> SubscriptionsState
appEnvLockedEventsCtx :: AppEnv -> LockedEventsCtx
appEnvConnParams :: AppEnv -> ConnParams
appEnvTxIso :: AppEnv -> TxIsolation
appEnvConsoleAssetsDir :: AppEnv -> Maybe Text
appEnvConsoleSentryDsn :: AppEnv -> Maybe Text
appEnvConnectionOptions :: AppEnv -> ConnectionOptions
appEnvWebSocketKeepAlive :: AppEnv -> KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: AppEnv -> WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: AppEnv -> Refined NonNegative Seconds
appEnvSchemaPollInterval :: AppEnv -> OptionalInterval
appEnvCheckFeatureFlag :: AppEnv -> CheckFeatureFlag
appEnvLicenseKeyCache :: AppEnv -> Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: AppEnv -> Int
appEnvPort :: Port
appEnvHost :: HostPreference
appEnvMetadataDbPool :: PGPool
appEnvIntrospectionDbPool :: Maybe PGPool
appEnvManager :: Manager
appEnvLoggers :: Loggers
appEnvMetadataVersionRef :: TMVar MetadataResourceVersion
appEnvInstanceId :: InstanceId
appEnvEnableMaintenanceMode :: MaintenanceMode ()
appEnvLoggingSettings :: LoggingSettings
appEnvEventingMode :: EventingMode
appEnvEnableReadOnlyMode :: ReadOnlyMode
appEnvServerMetrics :: ServerMetrics
appEnvShutdownLatch :: ShutdownLatch
appEnvMetaVersionRef :: TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: PrometheusMetrics
appEnvTraceSamplingPolicy :: SamplingPolicy
appEnvSubscriptionState :: SubscriptionsState
appEnvLockedEventsCtx :: LockedEventsCtx
appEnvConnParams :: ConnParams
appEnvTxIso :: TxIsolation
appEnvConsoleAssetsDir :: Maybe Text
appEnvConsoleSentryDsn :: Maybe Text
appEnvConnectionOptions :: ConnectionOptions
appEnvWebSocketKeepAlive :: KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: Refined NonNegative Seconds
appEnvSchemaPollInterval :: OptionalInterval
appEnvCheckFeatureFlag :: CheckFeatureFlag
appEnvLicenseKeyCache :: Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: Int
..} ConsoleType m
consoleType Store EmptyMetrics
ekgStore WebsocketCloseOnMetadataChangeAction
closeWebsocketsOnMetadataChangeAction = do
  -- Additional spock action to run
  AppStateRef impl -> SpockT m ()
setupHook AppStateRef impl
appStateRef

  -- cors middleware
  Middleware -> SpockT m ()
forall (t :: * -> (* -> *) -> * -> *) (m :: * -> *) ctx.
(RouteM t, Monad m) =>
Middleware -> t ctx m ()
Spock.middleware
    (Middleware -> SpockT m ()) -> Middleware -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ IO CorsPolicy -> Middleware
corsMiddleware (AppContext -> CorsPolicy
acCorsPolicy (AppContext -> CorsPolicy) -> IO AppContext -> IO CorsPolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
getAppContext AppStateRef impl
appStateRef)

  -- API Console and Root Dir
  SpockT m ()
serveApiConsole

  -- Local console assets for server and CLI consoles
  SpockT m ()
serveApiConsoleAssets

  -- Health check endpoint with logs
  let healthzAction :: ActionCtxT () m ()
healthzAction = do
        let errorMsg :: Text
errorMsg = Text
"ERROR"
        Bool
isStrict <- Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> ActionCtxT () m (Maybe Bool) -> ActionCtxT () m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionCtxT () m (Maybe Bool)
forall p (m :: * -> *) ctx.
(FromHttpApiData p, MonadIO m) =>
Text -> ActionCtxT ctx m (Maybe p)
Spock.param Text
"strict"
        m (Either QErr ()) -> ActionCtxT () m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Either QErr ())
forall (m :: * -> *). MonadMetadataStorage m => m (Either QErr ())
checkMetadataStorageHealth ActionCtxT () m (Either QErr ())
-> (Either QErr () -> ActionCtxT () m ()) -> ActionCtxT () m ()
forall a b.
ActionCtxT () m a -> (a -> ActionCtxT () m b) -> ActionCtxT () m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left QErr
err -> do
            -- error running the health check
            QErr -> ActionCtxT () m ()
logError QErr
err
            Status -> ActionCtxT () m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
Spock.setStatus Status
HTTP.status500 ActionCtxT () m () -> ActionCtxT () m () -> ActionCtxT () m ()
forall a b.
ActionCtxT () m a -> ActionCtxT () m b -> ActionCtxT () m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ActionCtxT () m ()
forall (m :: * -> *) ctx a. MonadIO m => Text -> ActionCtxT ctx m a
Spock.text Text
errorMsg
          Right ()
_ -> do
            -- metadata storage is healthy
            SchemaCache
sc <- IO SchemaCache -> ActionCtxT () m SchemaCache
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SchemaCache -> ActionCtxT () m SchemaCache)
-> IO SchemaCache -> ActionCtxT () m SchemaCache
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO SchemaCache
forall impl. AppStateRef impl -> IO SchemaCache
getSchemaCache AppStateRef impl
appStateRef
            let isInconsistent :: Bool
isInconsistent = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [InconsistentMetadata] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([InconsistentMetadata] -> Bool) -> [InconsistentMetadata] -> Bool
forall a b. (a -> b) -> a -> b
$ SchemaCache -> [InconsistentMetadata]
scInconsistentObjs SchemaCache
sc
                inconsistenciesMessage :: Text
inconsistenciesMessage = Text
"inconsistent objects in schema"
            (Status
status, Text
responseText) <-
              if
                | (Bool
isInconsistent Bool -> Bool -> Bool
&& Bool
isStrict) -> do
                    -- Inconsistencies exist and strict mode enabled. Report inconsistencies as ERROR with status 500.
                    let message :: Text
message = Text
"ERROR: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inconsistenciesMessage
                    QErr -> ActionCtxT () m ()
logError (QErr -> ActionCtxT () m ()) -> QErr -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err500 Code
InvalidConfiguration Text
message
                    (Status, Text) -> ActionCtxT () m (Status, Text)
forall a. a -> ActionCtxT () m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status
HTTP.status500, Text
message)
                | (Bool
isInconsistent Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isStrict) -> do
                    -- Inconsistencies exist and strict mode disabled. Warn inconsistencies with status 200.
                    let message :: Text
message = Text
"WARN: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inconsistenciesMessage
                    Text -> ActionCtxT () m ()
logSuccess (Text -> ActionCtxT () m ()) -> Text -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.fromStrict Text
message
                    (Status, Text) -> ActionCtxT () m (Status, Text)
forall a. a -> ActionCtxT () m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status
HTTP.status200, Text
message)
                | Bool
otherwise -> do
                    -- No inconsistencies in schema cache, report OK
                    let message :: Text
message = Text
"OK"
                    Text -> ActionCtxT () m ()
logSuccess (Text -> ActionCtxT () m ()) -> Text -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.fromStrict Text
message
                    (Status, Text) -> ActionCtxT () m (Status, Text)
forall a. a -> ActionCtxT () m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status
HTTP.status200, Text
message)

            Status -> ActionCtxT () m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
Spock.setStatus Status
status ActionCtxT () m () -> ActionCtxT () m () -> ActionCtxT () m ()
forall a b.
ActionCtxT () m a -> ActionCtxT () m b -> ActionCtxT () m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ActionCtxT () m ()
forall (m :: * -> *) ctx a. MonadIO m => Text -> ActionCtxT ctx m a
Spock.text Text
responseText

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"healthz" ActionCtxT () m ()
HVectElim '[] (ActionCtxT () m ())
healthzAction

  -- This is an alternative to `healthz` (See issue #6958)
  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"hasura/healthz" ActionCtxT () m ()
HVectElim '[] (ActionCtxT () m ())
healthzAction

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"v1/version" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> ActionCtxT () m ()
logSuccess (Text -> ActionCtxT () m ()) -> Text -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Text
"version: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
forall a b. (ToText a, FromText b) => a -> b
convertText Version
currentVersion
    [Pair]
extraData <- m [Pair] -> ActionCtxT () m [Pair]
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Pair] -> ActionCtxT () m [Pair])
-> m [Pair] -> ActionCtxT () m [Pair]
forall a b. (a -> b) -> a -> b
$ m [Pair]
forall (m :: * -> *). MonadVersionAPIWithExtraData m => m [Pair]
getExtraDataForVersionAPI
    Header -> ActionCtxT () m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Header -> ActionCtxT ctx m ()
setHeader Header
jsonHeader
    ByteString -> ActionCtxT () m ()
forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
Spock.lazyBytes (ByteString -> ActionCtxT () m ())
-> ByteString -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Key
"version" Key -> Version -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Version
currentVersion] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
extraData

  let customEndpointHandler ::
        RestRequest Spock.SpockMethod ->
        Handler m (HttpLogGraphQLInfo, APIResp)
      customEndpointHandler :: RestRequest SpockMethod -> Handler m (HttpLogGraphQLInfo, APIResp)
customEndpointHandler RestRequest SpockMethod
restReq = do
        AppContext {Environment
HashSet ExperimentalFeature
HashSet API
StreamQueriesOptions
NamingCase
RemoteSchemaPermissions
InferFunctionPermissions
SQLGenCtx
CloseWebsocketsOnMetadataChangeStatus
ApolloFederationStatus
CorsPolicy
AuthMode
MetadataDefaults
ResponseInternalErrorsConfig
OptionalInterval
TelemetryStatus
AllowListStatus
ConsoleStatus
EventEngineCtx
acEnabledAPIs :: AppContext -> HashSet API
acAuthMode :: AppContext -> AuthMode
acSQLGenCtx :: AppContext -> SQLGenCtx
acEnableAllowlist :: AppContext -> AllowListStatus
acResponseInternalErrorsConfig :: AppContext -> ResponseInternalErrorsConfig
acEnvironment :: AppContext -> Environment
acRemoteSchemaPermsCtx :: AppContext -> RemoteSchemaPermissions
acFunctionPermsCtx :: AppContext -> InferFunctionPermissions
acExperimentalFeatures :: AppContext -> HashSet ExperimentalFeature
acDefaultNamingConvention :: AppContext -> NamingCase
acMetadataDefaults :: AppContext -> MetadataDefaults
acLiveQueryOptions :: AppContext -> StreamQueriesOptions
acStreamQueryOptions :: AppContext -> StreamQueriesOptions
acCorsPolicy :: AppContext -> CorsPolicy
acConsoleStatus :: AppContext -> ConsoleStatus
acEnableTelemetry :: AppContext -> TelemetryStatus
acEventEngineCtx :: AppContext -> EventEngineCtx
acAsyncActionsFetchInterval :: AppContext -> OptionalInterval
acApolloFederationStatus :: AppContext -> ApolloFederationStatus
acCloseWebsocketsOnMetadataChangeStatus :: AppContext -> CloseWebsocketsOnMetadataChangeStatus
acAuthMode :: AuthMode
acSQLGenCtx :: SQLGenCtx
acEnabledAPIs :: HashSet API
acEnableAllowlist :: AllowListStatus
acResponseInternalErrorsConfig :: ResponseInternalErrorsConfig
acEnvironment :: Environment
acRemoteSchemaPermsCtx :: RemoteSchemaPermissions
acFunctionPermsCtx :: InferFunctionPermissions
acExperimentalFeatures :: HashSet ExperimentalFeature
acDefaultNamingConvention :: NamingCase
acMetadataDefaults :: MetadataDefaults
acLiveQueryOptions :: StreamQueriesOptions
acStreamQueryOptions :: StreamQueriesOptions
acCorsPolicy :: CorsPolicy
acConsoleStatus :: ConsoleStatus
acEnableTelemetry :: TelemetryStatus
acEventEngineCtx :: EventEngineCtx
acAsyncActionsFetchInterval :: OptionalInterval
acApolloFederationStatus :: ApolloFederationStatus
acCloseWebsocketsOnMetadataChangeStatus :: CloseWebsocketsOnMetadataChangeStatus
..} <- IO AppContext -> Handler m AppContext
forall a. IO a -> Handler m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppContext -> Handler m AppContext)
-> IO AppContext -> Handler m AppContext
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
getAppContext AppStateRef impl
appStateRef
        EndpointTrie GQLQueryWithText
endpoints <- IO (EndpointTrie GQLQueryWithText)
-> Handler m (EndpointTrie GQLQueryWithText)
forall a. IO a -> Handler m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EndpointTrie GQLQueryWithText)
 -> Handler m (EndpointTrie GQLQueryWithText))
-> IO (EndpointTrie GQLQueryWithText)
-> Handler m (EndpointTrie GQLQueryWithText)
forall a b. (a -> b) -> a -> b
$ SchemaCache -> EndpointTrie GQLQueryWithText
scEndpoints (SchemaCache -> EndpointTrie GQLQueryWithText)
-> IO SchemaCache -> IO (EndpointTrie GQLQueryWithText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppStateRef impl -> IO SchemaCache
forall impl. AppStateRef impl -> IO SchemaCache
getSchemaCache AppStateRef impl
appStateRef
        SchemaCache
schemaCache <- RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache (RebuildableSchemaCache -> SchemaCache)
-> Handler m RebuildableSchemaCache -> Handler m SchemaCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HandlerCtx -> RebuildableSchemaCache)
-> Handler m RebuildableSchemaCache
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> RebuildableSchemaCache
hcSchemaCache
        RequestId
requestId <- (HandlerCtx -> RequestId) -> Handler m RequestId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> RequestId
hcRequestId
        UserInfo
userInfo <- (HandlerCtx -> UserInfo) -> Handler m UserInfo
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> UserInfo
hcUser
        [Header]
reqHeaders <- (HandlerCtx -> [Header]) -> Handler m [Header]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> [Header]
hcReqHeaders
        IpAddress
ipAddress <- (HandlerCtx -> IpAddress) -> Handler m IpAddress
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HandlerCtx -> IpAddress
hcSourceIpAddress

        RestRequest EndpointMethod
req <-
          RestRequest SpockMethod
restReq RestRequest SpockMethod
-> (RestRequest SpockMethod
    -> Handler m (RestRequest EndpointMethod))
-> Handler m (RestRequest EndpointMethod)
forall a b. a -> (a -> b) -> b
& (SpockMethod -> Handler m EndpointMethod)
-> RestRequest SpockMethod
-> Handler m (RestRequest EndpointMethod)
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) -> RestRequest a -> f (RestRequest b)
traverse \case
            Spock.MethodStandard (Spock.HttpMethod StdMethod
m) -> case StdMethod
m of
              StdMethod
Spock.GET -> EndpointMethod -> Handler m EndpointMethod
forall a. a -> Handler m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EndpointMethod
EP.GET
              StdMethod
Spock.POST -> EndpointMethod -> Handler m EndpointMethod
forall a. a -> Handler m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EndpointMethod
EP.POST
              StdMethod
Spock.PUT -> EndpointMethod -> Handler m EndpointMethod
forall a. a -> Handler m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EndpointMethod
EP.PUT
              StdMethod
Spock.DELETE -> EndpointMethod -> Handler m EndpointMethod
forall a. a -> Handler m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EndpointMethod
EP.DELETE
              StdMethod
Spock.PATCH -> EndpointMethod -> Handler m EndpointMethod
forall a. a -> Handler m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EndpointMethod
EP.PATCH
              StdMethod
other -> Code -> Text -> Handler m EndpointMethod
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
BadRequest (Text -> Handler m EndpointMethod)
-> Text -> Handler m EndpointMethod
forall a b. (a -> b) -> a -> b
$ Text
"Method " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StdMethod -> Text
forall a. Show a => a -> Text
tshow StdMethod
other Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not supported."
            SpockMethod
_ -> Code -> Text -> Handler m EndpointMethod
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
BadRequest (Text -> Handler m EndpointMethod)
-> Text -> Handler m EndpointMethod
forall a b. (a -> b) -> a -> b
$ Text
"Nonstandard method not allowed for REST endpoints"
        (HttpResponse EncJSON -> APIResp)
-> (HttpLogGraphQLInfo, HttpResponse EncJSON)
-> (HttpLogGraphQLInfo, APIResp)
forall a b.
(a -> b) -> (HttpLogGraphQLInfo, a) -> (HttpLogGraphQLInfo, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HttpResponse EncJSON -> APIResp
JSONResp ((HttpLogGraphQLInfo, HttpResponse EncJSON)
 -> (HttpLogGraphQLInfo, APIResp))
-> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON)
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> UserInfo
-> [Header]
-> IpAddress
-> RestRequest EndpointMethod
-> EndpointTrie GQLQueryWithText
-> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadTrace m, MonadBaseControl IO m,
 MonadGQLExecutionCheck m, MonadQueryLog m, MonadExecutionLog m,
 MonadExecuteQuery m, MonadMetadataStorage m, MonadQueryTags m,
 HasResourceLimits m, ProvidesNetwork m) =>
Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> UserInfo
-> [Header]
-> IpAddress
-> RestRequest EndpointMethod
-> EndpointTrie GQLQueryWithText
-> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
runCustomEndpoint Environment
acEnvironment SQLGenCtx
acSQLGenCtx SchemaCache
schemaCache AllowListStatus
acEnableAllowlist ReadOnlyMode
appEnvEnableReadOnlyMode PrometheusMetrics
appEnvPrometheusMetrics (Loggers -> Logger Hasura
_lsLogger Loggers
appEnvLoggers) Maybe (CredentialCache AgentLicenseKey)
appEnvLicenseKeyCache RequestId
requestId UserInfo
userInfo [Header]
reqHeaders IpAddress
ipAddress RestRequest EndpointMethod
req EndpointTrie GQLQueryWithText
endpoints

  -- See Issue #291 for discussion around restified feature
  Path (Append (Append '[] '[]) '[Text]) 'Closed
-> HVectElim (Append (Append '[] '[]) '[Text]) (ActionCtxT () m ())
-> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.hookRouteAll (Path '[] 'Open
"api" Path '[] 'Open -> Path '[] 'Open -> Path (Append '[] '[]) 'Open
forall (as :: [*]) (bs :: [*]) (ps :: PathState).
Path as 'Open -> Path bs ps -> Path (Append as bs) ps
<//> Path '[] 'Open
"rest" Path (Append '[] '[]) 'Open
-> Path '[Text] 'Closed
-> Path (Append (Append '[] '[]) '[Text]) 'Closed
forall (as :: [*]) (bs :: [*]) (ps :: PathState).
Path as 'Open -> Path bs ps -> Path (Append as bs) ps
<//> Path '[Text] 'Closed
Spock.wildcard) (HVectElim (Append (Append '[] '[]) '[Text]) (ActionCtxT () m ())
 -> SpockT m ())
-> HVectElim (Append (Append '[] '[]) '[Text]) (ActionCtxT () m ())
-> SpockT m ()
forall a b. (a -> b) -> a -> b
$ \Text
wildcard -> do
    TraceMetadata
queryParams <- ActionCtxT () m TraceMetadata
forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m TraceMetadata
Spock.params
    ByteString
body <- ActionCtxT () m ByteString
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m ByteString
Spock.body
    SpockMethod
method <- ActionCtxT () m SpockMethod
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m SpockMethod
Spock.reqMethod

    -- This is where we decode the json encoded body args. They
    -- are treated as if they came from query arguments, but allow
    -- us to pass non-scalar values.
    let bodyParams :: [(Text, Value)]
bodyParams = case ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
J.decodeStrict ByteString
body of
          Just (J.Object Object
o) -> (Pair -> (Text, Value)) -> [Pair] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((Key -> Text) -> Pair -> (Text, Value)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Key -> Text
K.toText) ([Pair] -> [(Text, Value)]) -> [Pair] -> [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
o
          Maybe Value
_ -> []
        allParams :: [(Text, Either Text Value)]
allParams = (Text -> Either Text Value)
-> (Text, Text) -> (Text, Either Text Value)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either Text Value
forall a b. a -> Either a b
Left ((Text, Text) -> (Text, Either Text Value))
-> TraceMetadata -> [(Text, Either Text Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TraceMetadata
queryParams [(Text, Either Text Value)]
-> [(Text, Either Text Value)] -> [(Text, Either Text Value)]
forall a. [a] -> [a] -> [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Value -> Either Text Value)
-> (Text, Value) -> (Text, Either Text Value)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Either Text Value
forall a b. b -> Either a b
Right ((Text, Value) -> (Text, Either Text Value))
-> [(Text, Value)] -> [(Text, Either Text Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Value)]
bodyParams

    (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m () -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id (APIHandler m () -> ActionCtxT () m ())
-> APIHandler m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ do
      -- TODO: Are we actually able to use mkGetHandler in this situation? POST handler seems to do some work that we might want to avoid.
      Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall (m :: * -> *).
Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
mkGetHandler (Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ())
-> Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall a b. (a -> b) -> a -> b
$ RestRequest SpockMethod -> Handler m (HttpLogGraphQLInfo, APIResp)
customEndpointHandler (Text
-> SpockMethod
-> [(Text, Either Text Value)]
-> RestRequest SpockMethod
forall method.
Text -> method -> [(Text, Either Text Value)] -> RestRequest method
RestRequest Text
wildcard SpockMethod
method [(Text, Either Text Value)]
allParams)

  -- Note: we create a schema cache updater function, to restrict the access
  -- to 'AppStateRef' inside the request handlers
  let schemaCacheUpdater :: (RebuildableSchemaCache
 -> Handler m (EncJSON, RebuildableSchemaCache))
-> Handler m EncJSON
schemaCacheUpdater = AppStateRef impl
-> Logger Hasura
-> Maybe (TVar Bool)
-> (RebuildableSchemaCache
    -> Handler m (EncJSON, RebuildableSchemaCache))
-> Handler m EncJSON
forall (m :: * -> *) impl a.
(MonadIO m, MonadBaseControl IO m, MonadError QErr m) =>
AppStateRef impl
-> Logger Hasura
-> Maybe (TVar Bool)
-> (RebuildableSchemaCache -> m (a, RebuildableSchemaCache))
-> m a
withSchemaCacheReadUpdate AppStateRef impl
appStateRef Logger Hasura
logger Maybe (TVar Bool)
forall a. Maybe a
Nothing

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.post Path '[] 'Open
"v1/graphql/explain" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isMetadataEnabled AppStateRef impl
appStateRef ActionCtxT () m ()
gqlExplainAction

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.post Path '[] 'Open
"v1alpha1/graphql/explain" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isMetadataEnabled AppStateRef impl
appStateRef ActionCtxT () m ()
gqlExplainAction

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.post Path '[] 'Open
"v1/query" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isMetadataEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m RQLQuery -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
      (APIHandler m RQLQuery -> ActionCtxT () m ())
-> APIHandler m RQLQuery -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ do
        (RQLQuery -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m RQLQuery
forall a (m :: * -> *).
(a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
mkPostHandler ((RQLQuery -> Handler m (HttpLogGraphQLInfo, APIResp))
 -> APIHandler m RQLQuery)
-> (RQLQuery -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m RQLQuery
forall a b. (a -> b) -> a -> b
$ (APIResp -> (HttpLogGraphQLInfo, APIResp))
-> Handler m APIResp -> Handler m (HttpLogGraphQLInfo, APIResp)
forall a b. (a -> b) -> Handler m a -> Handler m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo,) (Handler m APIResp -> Handler m (HttpLogGraphQLInfo, APIResp))
-> (RQLQuery -> Handler m APIResp)
-> RQLQuery
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RQLQuery -> Handler m (HttpResponse EncJSON))
-> RQLQuery -> Handler m APIResp
forall (m :: * -> *) a.
Functor m =>
(a -> Handler m (HttpResponse EncJSON)) -> a -> Handler m APIResp
mkAPIRespHandler (((RebuildableSchemaCache
  -> Handler m (EncJSON, RebuildableSchemaCache))
 -> Handler m EncJSON)
-> RQLQuery -> Handler m (HttpResponse EncJSON)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadBaseControl IO m,
 MonadMetadataApiAuthorization m, MonadTrace m,
 MonadReader HandlerCtx m, MonadMetadataStorage m,
 MonadResolveSource m, HasAppEnv m, HasCacheStaticConfig m,
 MonadQueryTags m, MonadEventLogCleanup m, ProvidesNetwork m,
 MonadGetPolicies m, UserInfoM m) =>
((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
 -> m EncJSON)
-> RQLQuery -> m (HttpResponse EncJSON)
v1QueryHandler (RebuildableSchemaCache
 -> Handler m (EncJSON, RebuildableSchemaCache))
-> Handler m EncJSON
schemaCacheUpdater)

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.post Path '[] 'Open
"v1/metadata" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isMetadataEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m RQLMetadata -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
      (APIHandler m RQLMetadata -> ActionCtxT () m ())
-> APIHandler m RQLMetadata -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (RQLMetadata -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m RQLMetadata
forall a (m :: * -> *).
(a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
mkPostHandler
      ((RQLMetadata -> Handler m (HttpLogGraphQLInfo, APIResp))
 -> APIHandler m RQLMetadata)
-> (RQLMetadata -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m RQLMetadata
forall a b. (a -> b) -> a -> b
$ (APIResp -> (HttpLogGraphQLInfo, APIResp))
-> Handler m APIResp -> Handler m (HttpLogGraphQLInfo, APIResp)
forall a b. (a -> b) -> Handler m a -> Handler m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo,)
      (Handler m APIResp -> Handler m (HttpLogGraphQLInfo, APIResp))
-> (RQLMetadata -> Handler m APIResp)
-> RQLMetadata
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RQLMetadata -> Handler m (HttpResponse EncJSON))
-> RQLMetadata -> Handler m APIResp
forall (m :: * -> *) a.
Functor m =>
(a -> Handler m (HttpResponse EncJSON)) -> a -> Handler m APIResp
mkAPIRespHandler (((RebuildableSchemaCache
  -> Handler m (EncJSON, RebuildableSchemaCache))
 -> Handler m EncJSON)
-> WebsocketCloseOnMetadataChangeAction
-> RQLMetadata
-> Handler m (HttpResponse EncJSON)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadBaseControl IO m,
 MonadReader HandlerCtx m, MonadTrace m, MonadMetadataStorage m,
 MonadResolveSource m, MonadMetadataApiAuthorization m,
 MonadEventLogCleanup m, HasAppEnv m, HasCacheStaticConfig m,
 HasFeatureFlagChecker m, ProvidesNetwork m, MonadGetPolicies m,
 UserInfoM m) =>
((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
 -> m EncJSON)
-> WebsocketCloseOnMetadataChangeAction
-> RQLMetadata
-> m (HttpResponse EncJSON)
v1MetadataHandler (RebuildableSchemaCache
 -> Handler m (EncJSON, RebuildableSchemaCache))
-> Handler m EncJSON
schemaCacheUpdater WebsocketCloseOnMetadataChangeAction
closeWebsocketsOnMetadataChangeAction)

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.post Path '[] 'Open
"v2/query" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isMetadataEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m RQLQuery -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
      (APIHandler m RQLQuery -> ActionCtxT () m ())
-> APIHandler m RQLQuery -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (RQLQuery -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m RQLQuery
forall a (m :: * -> *).
(a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
mkPostHandler
      ((RQLQuery -> Handler m (HttpLogGraphQLInfo, APIResp))
 -> APIHandler m RQLQuery)
-> (RQLQuery -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m RQLQuery
forall a b. (a -> b) -> a -> b
$ (APIResp -> (HttpLogGraphQLInfo, APIResp))
-> Handler m APIResp -> Handler m (HttpLogGraphQLInfo, APIResp)
forall a b. (a -> b) -> Handler m a -> Handler m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo,)
      (Handler m APIResp -> Handler m (HttpLogGraphQLInfo, APIResp))
-> (RQLQuery -> Handler m APIResp)
-> RQLQuery
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RQLQuery -> Handler m (HttpResponse EncJSON))
-> RQLQuery -> Handler m APIResp
forall (m :: * -> *) a.
Functor m =>
(a -> Handler m (HttpResponse EncJSON)) -> a -> Handler m APIResp
mkAPIRespHandler (((RebuildableSchemaCache
  -> Handler m (EncJSON, RebuildableSchemaCache))
 -> Handler m EncJSON)
-> RQLQuery -> Handler m (HttpResponse EncJSON)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadBaseControl IO m,
 MonadMetadataApiAuthorization m, MonadTrace m,
 MonadReader HandlerCtx m, MonadMetadataStorage m,
 MonadResolveSource m, HasAppEnv m, HasCacheStaticConfig m,
 MonadQueryTags m, ProvidesNetwork m, UserInfoM m) =>
((RebuildableSchemaCache -> m (EncJSON, RebuildableSchemaCache))
 -> m EncJSON)
-> RQLQuery -> m (HttpResponse EncJSON)
v2QueryHandler (RebuildableSchemaCache
 -> Handler m (EncJSON, RebuildableSchemaCache))
-> Handler m EncJSON
schemaCacheUpdater)

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.post Path '[] 'Open
"v1alpha1/pg_dump" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isPGDumpEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr)
-> APIHandler m PGDumpReqBody
-> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
      (APIHandler m PGDumpReqBody -> ActionCtxT () m ())
-> APIHandler m PGDumpReqBody -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (PGDumpReqBody -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m PGDumpReqBody
forall a (m :: * -> *).
(a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
mkPostHandler
      ((PGDumpReqBody -> Handler m (HttpLogGraphQLInfo, APIResp))
 -> APIHandler m PGDumpReqBody)
-> (PGDumpReqBody -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m PGDumpReqBody
forall a b. (a -> b) -> a -> b
$ (APIResp -> (HttpLogGraphQLInfo, APIResp))
-> Handler m APIResp -> Handler m (HttpLogGraphQLInfo, APIResp)
forall a b. (a -> b) -> Handler m a -> Handler m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo,)
      (Handler m APIResp -> Handler m (HttpLogGraphQLInfo, APIResp))
-> (PGDumpReqBody -> Handler m APIResp)
-> PGDumpReqBody
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PGDumpReqBody -> Handler m APIResp
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadReader HandlerCtx m) =>
PGDumpReqBody -> m APIResp
v1Alpha1PGDumpHandler

  AppStateRef impl -> SpockT m ()
forall impl. AppStateRef impl -> SpockT m ()
forall (m :: * -> *) impl.
MonadConfigApiHandler m =>
AppStateRef impl -> SpockCtxT () m ()
runConfigApiHandler AppStateRef impl
appStateRef

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.post Path '[] 'Open
"v1alpha1/graphql" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isGraphQLEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m ReqsText -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
GH.encodeGQErr QErr -> QErr
forall a. a -> a
id
      (APIHandler m ReqsText -> ActionCtxT () m ())
-> APIHandler m ReqsText -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
forall (m :: * -> *).
(ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
mkGQLRequestHandler
      ((ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
 -> APIHandler m ReqsText)
-> (ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
forall a b. (a -> b) -> a -> b
$ (ReqsText -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON))
-> ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp)
forall (m :: * -> *) a b.
Functor m =>
(a -> Handler m (b, HttpResponse EncJSON))
-> a -> Handler m (b, APIResp)
mkGQLAPIRespHandler
      ((ReqsText -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON))
 -> ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> (ReqsText
    -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON))
-> ReqsText
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall a b. (a -> b) -> a -> b
$ GraphQLQueryType
-> ReqsText -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadGQLExecutionCheck m,
 MonadQueryLog m, MonadExecutionLog m, MonadTrace m, HasAppEnv m,
 MonadExecuteQuery m, MonadError QErr m, MonadReader HandlerCtx m,
 MonadMetadataStorage m, MonadQueryTags m, HasResourceLimits m,
 ProvidesNetwork m) =>
GraphQLQueryType
-> ReqsText -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1Alpha1GQHandler GraphQLQueryType
E.QueryHasura

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.post Path '[] 'Open
"v1/graphql" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isGraphQLEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m ReqsText -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
GH.encodeGQErr QErr -> QErr
allMod200
      (APIHandler m ReqsText -> ActionCtxT () m ())
-> APIHandler m ReqsText -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
forall (m :: * -> *).
(ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
mkGQLRequestHandler
      ((ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
 -> APIHandler m ReqsText)
-> (ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
forall a b. (a -> b) -> a -> b
$ (ReqsText -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON))
-> ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp)
forall (m :: * -> *) a b.
Functor m =>
(a -> Handler m (b, HttpResponse EncJSON))
-> a -> Handler m (b, APIResp)
mkGQLAPIRespHandler
      ((ReqsText -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON))
 -> ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> (ReqsText
    -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON))
-> ReqsText
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall a b. (a -> b) -> a -> b
$ ReqsText -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadGQLExecutionCheck m,
 MonadQueryLog m, MonadExecutionLog m, MonadTrace m, HasAppEnv m,
 MonadExecuteQuery m, MonadError QErr m, MonadReader HandlerCtx m,
 MonadMetadataStorage m, MonadQueryTags m, HasResourceLimits m,
 ProvidesNetwork m) =>
ReqsText -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1GQHandler

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.post Path '[] 'Open
"v1beta1/relay" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isGraphQLEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m ReqsText -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
GH.encodeGQErr QErr -> QErr
allMod200
      (APIHandler m ReqsText -> ActionCtxT () m ())
-> APIHandler m ReqsText -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
forall (m :: * -> *).
(ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
mkGQLRequestHandler
      ((ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
 -> APIHandler m ReqsText)
-> (ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m ReqsText
forall a b. (a -> b) -> a -> b
$ (ReqsText -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON))
-> ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp)
forall (m :: * -> *) a b.
Functor m =>
(a -> Handler m (b, HttpResponse EncJSON))
-> a -> Handler m (b, APIResp)
mkGQLAPIRespHandler
      ((ReqsText -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON))
 -> ReqsText -> Handler m (HttpLogGraphQLInfo, APIResp))
-> (ReqsText
    -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON))
-> ReqsText
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall a b. (a -> b) -> a -> b
$ ReqsText -> Handler m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadGQLExecutionCheck m,
 MonadQueryLog m, MonadExecutionLog m, MonadTrace m, HasAppEnv m,
 MonadExecuteQuery m, MonadError QErr m, MonadReader HandlerCtx m,
 MonadMetadataStorage m, MonadQueryTags m, HasResourceLimits m,
 ProvidesNetwork m) =>
ReqsText -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
v1GQRelayHandler

  -- This exposes some simple RTS stats when we run with `+RTS -T`. We want
  -- this to be available even when developer APIs are not compiled in, to
  -- support benchmarking.
  -- See: https://hackage.haskell.org/package/base/docs/GHC-Stats.html
  Bool
exposeRtsStats <- IO Bool -> SpockCtxT () m Bool
forall a. IO a -> SpockCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
RTS.getRTSStatsEnabled
  Bool -> SpockT m () -> SpockT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exposeRtsStats (SpockT m () -> SpockT m ()) -> SpockT m () -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"dev/rts_stats" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
      -- This ensures the live_bytes and other counters from GCDetails are fresh:
      IO () -> ActionCtxT () m ()
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
performMajorGC
      RTSStats
stats <- IO RTSStats -> ActionCtxT () m RTSStats
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO RTSStats
RTS.getRTSStats
      RTSStats -> ActionCtxT () m ()
forall a (m :: * -> *) ctx b.
(ToJSON a, MonadIO m) =>
a -> ActionCtxT ctx m b
Spock.json RTSStats
stats

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"dev/ekg" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isDeveloperAPIEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m () -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
      (APIHandler m () -> ActionCtxT () m ())
-> APIHandler m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall (m :: * -> *).
Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
mkGetHandler
      (Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ())
-> Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall a b. (a -> b) -> a -> b
$ do
        Handler m ()
forall (m :: * -> *).
(MonadError QErr m, MonadReader HandlerCtx m) =>
m ()
onlyAdmin
        Sample
respJ <- IO Sample -> Handler m Sample
forall a. IO a -> Handler m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Sample -> Handler m Sample) -> IO Sample -> Handler m Sample
forall a b. (a -> b) -> a -> b
$ Store EmptyMetrics -> IO Sample
forall (metrics :: Symbol -> MetricType -> * -> *).
Store metrics -> IO Sample
EKG.sampleAll Store EmptyMetrics
ekgStore
        (HttpLogGraphQLInfo, APIResp)
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall a. a -> Handler m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo, HttpResponse EncJSON -> APIResp
JSONResp (HttpResponse EncJSON -> APIResp)
-> HttpResponse EncJSON -> APIResp
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse (Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (Value -> EncJSON) -> Value -> EncJSON
forall a b. (a -> b) -> a -> b
$ Sample -> Value
EKG.sampleToJson Sample
respJ) [])

  -- This deprecated endpoint used to show the query plan cache pre-PDV.
  -- Eventually this endpoint can be removed.
  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"dev/plan_cache" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isDeveloperAPIEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m () -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
      (APIHandler m () -> ActionCtxT () m ())
-> APIHandler m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall (m :: * -> *).
Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
mkGetHandler
      (Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ())
-> Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall a b. (a -> b) -> a -> b
$ do
        Handler m ()
forall (m :: * -> *).
(MonadError QErr m, MonadReader HandlerCtx m) =>
m ()
onlyAdmin
        (HttpLogGraphQLInfo, APIResp)
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall a. a -> Handler m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo, HttpResponse EncJSON -> APIResp
JSONResp (HttpResponse EncJSON -> APIResp)
-> HttpResponse EncJSON -> APIResp
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse (Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue Value
J.Null) [])

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"dev/subscriptions" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isDeveloperAPIEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m () -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
      (APIHandler m () -> ActionCtxT () m ())
-> APIHandler m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall (m :: * -> *).
Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
mkGetHandler
      (Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ())
-> Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall a b. (a -> b) -> a -> b
$ do
        Handler m ()
forall (m :: * -> *).
(MonadError QErr m, MonadReader HandlerCtx m) =>
m ()
onlyAdmin
        AppContext
appCtx <- IO AppContext -> Handler m AppContext
forall a. IO a -> Handler m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppContext -> Handler m AppContext)
-> IO AppContext -> Handler m AppContext
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
getAppContext AppStateRef impl
appStateRef
        Value
respJ <- IO Value -> Handler m Value
forall a. IO a -> Handler m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> Handler m Value) -> IO Value -> Handler m Value
forall a b. (a -> b) -> a -> b
$ Bool
-> StreamQueriesOptions
-> StreamQueriesOptions
-> SubscriptionsState
-> IO Value
ES.dumpSubscriptionsState Bool
False (AppContext -> StreamQueriesOptions
acLiveQueryOptions AppContext
appCtx) (AppContext -> StreamQueriesOptions
acStreamQueryOptions AppContext
appCtx) SubscriptionsState
appEnvSubscriptionState
        (HttpLogGraphQLInfo, APIResp)
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall a. a -> Handler m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo, HttpResponse EncJSON -> APIResp
JSONResp (HttpResponse EncJSON -> APIResp)
-> HttpResponse EncJSON -> APIResp
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse (Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue Value
respJ) [])

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"dev/subscriptions/extended" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isDeveloperAPIEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m () -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
      (APIHandler m () -> ActionCtxT () m ())
-> APIHandler m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall (m :: * -> *).
Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
mkGetHandler
      (Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ())
-> Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall a b. (a -> b) -> a -> b
$ do
        Handler m ()
forall (m :: * -> *).
(MonadError QErr m, MonadReader HandlerCtx m) =>
m ()
onlyAdmin
        AppContext
appCtx <- IO AppContext -> Handler m AppContext
forall a. IO a -> Handler m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppContext -> Handler m AppContext)
-> IO AppContext -> Handler m AppContext
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
getAppContext AppStateRef impl
appStateRef
        Value
respJ <- IO Value -> Handler m Value
forall a. IO a -> Handler m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> Handler m Value) -> IO Value -> Handler m Value
forall a b. (a -> b) -> a -> b
$ Bool
-> StreamQueriesOptions
-> StreamQueriesOptions
-> SubscriptionsState
-> IO Value
ES.dumpSubscriptionsState Bool
True (AppContext -> StreamQueriesOptions
acLiveQueryOptions AppContext
appCtx) (AppContext -> StreamQueriesOptions
acStreamQueryOptions AppContext
appCtx) SubscriptionsState
appEnvSubscriptionState
        (HttpLogGraphQLInfo, APIResp)
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall a. a -> Handler m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo, HttpResponse EncJSON -> APIResp
JSONResp (HttpResponse EncJSON -> APIResp)
-> HttpResponse EncJSON -> APIResp
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse (Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue Value
respJ) [])

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"dev/dataconnector/schema" (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
    (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isDeveloperAPIEnabled AppStateRef impl
appStateRef
      (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m () -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
      (APIHandler m () -> ActionCtxT () m ())
-> APIHandler m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall (m :: * -> *).
Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
mkGetHandler
      (Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ())
-> Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall a b. (a -> b) -> a -> b
$ do
        Handler m ()
forall (m :: * -> *).
(MonadError QErr m, MonadReader HandlerCtx m) =>
m ()
onlyAdmin
        (HttpLogGraphQLInfo, APIResp)
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall a. a -> Handler m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo, HttpResponse EncJSON -> APIResp
JSONResp (HttpResponse EncJSON -> APIResp)
-> HttpResponse EncJSON -> APIResp
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse (OpenApi -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue OpenApi
openApiSchema) [])

  Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
"api/swagger/json"
    (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m () -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
    (APIHandler m () -> ActionCtxT () m ())
-> APIHandler m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall (m :: * -> *).
Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
mkGetHandler
    (Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ())
-> Handler m (HttpLogGraphQLInfo, APIResp) -> APIHandler m ()
forall a b. (a -> b) -> a -> b
$ do
      Handler m ()
forall (m :: * -> *).
(MonadError QErr m, MonadReader HandlerCtx m) =>
m ()
onlyAdmin
      SchemaCache
sc <- IO SchemaCache -> Handler m SchemaCache
forall a. IO a -> Handler m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SchemaCache -> Handler m SchemaCache)
-> IO SchemaCache -> Handler m SchemaCache
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO SchemaCache
forall impl. AppStateRef impl -> IO SchemaCache
getSchemaCache AppStateRef impl
appStateRef
      OpenApi
json <- SchemaCache -> Handler m OpenApi
forall (m :: * -> *).
(MonadError QErr m, MonadFix m) =>
SchemaCache -> m OpenApi
buildOpenAPI SchemaCache
sc
      (HttpLogGraphQLInfo, APIResp)
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall a. a -> Handler m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo, HttpResponse EncJSON -> APIResp
JSONResp (HttpResponse EncJSON -> APIResp)
-> HttpResponse EncJSON -> APIResp
forall a b. (a -> b) -> a -> b
$ EncJSON -> [Header] -> HttpResponse EncJSON
forall a. a -> [Header] -> HttpResponse a
HttpResponse (OpenApi -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue OpenApi
json) [])

  [StdMethod] -> (StdMethod -> SpockT m ()) -> SpockT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [StdMethod
Spock.GET, StdMethod
Spock.POST] ((StdMethod -> SpockT m ()) -> SpockT m ())
-> (StdMethod -> SpockT m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ \StdMethod
m -> StdMethod -> ([Text] -> ActionCtxT () m ()) -> SpockT m ()
forall (t :: * -> (* -> *) -> * -> *) (m :: * -> *) ctx.
(RouteM t, Monad m) =>
StdMethod -> ([Text] -> ActionCtxT ctx m ()) -> t ctx m ()
Spock.hookAny StdMethod
m (([Text] -> ActionCtxT () m ()) -> SpockT m ())
-> ([Text] -> ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ \[Text]
_ -> do
    Request
req <- ActionCtxT () m Request
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
Spock.request
    let headers :: [Header]
headers = Request -> [Header]
Wai.requestHeaders Request
req
        qErr :: QErr
qErr = Code -> Text -> QErr
err404 Code
NotFound Text
"resource does not exist"
    Logger Hasura
-> LoggingSettings -> [Header] -> QErr -> ActionCtxT () m ()
forall (m :: * -> *).
(MonadIO m, HttpLog m) =>
Logger Hasura
-> LoggingSettings -> [Header] -> QErr -> ActionT m ()
raiseGenericApiError Logger Hasura
logger LoggingSettings
appEnvLoggingSettings [Header]
headers QErr
qErr
  where
    logger :: Logger Hasura
logger = Loggers -> Logger Hasura
_lsLogger Loggers
appEnvLoggers

    logSuccess :: Text -> ActionCtxT () m ()
logSuccess Text
msg = do
      Request
req <- ActionCtxT () m Request
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
Spock.request
      ByteString
reqBody <- IO ByteString -> ActionCtxT () m ByteString
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ActionCtxT () m ByteString)
-> IO ByteString -> ActionCtxT () m ByteString
forall a b. (a -> b) -> a -> b
$ Request -> IO ByteString
Wai.strictRequestBody Request
req
      let headers :: [Header]
headers = Request -> [Header]
Wai.requestHeaders Request
req
          blMsg :: ByteString
blMsg = Text -> ByteString
TL.encodeUtf8 Text
msg
      (RequestId
reqId, [Header]
_newHeaders) <- [Header] -> ActionCtxT () m (RequestId, [Header])
forall (m :: * -> *).
MonadIO m =>
[Header] -> m (RequestId, [Header])
getRequestId [Header]
headers
      m () -> ActionCtxT () m ()
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ActionCtxT () m ()) -> m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> EncodingType
-> [Header]
-> HttpLogMetadata m
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> EncodingType
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpSuccess Logger Hasura
logger LoggingSettings
appEnvLoggingSettings Maybe UserInfo
forall a. Maybe a
Nothing RequestId
reqId Request
req (ByteString
reqBody, Maybe Value
forall a. Maybe a
Nothing) ByteString
blMsg ByteString
blMsg Maybe (DiffTime, DiffTime)
forall a. Maybe a
Nothing EncodingType
forall a. Maybe a
Nothing [Header]
headers (forall (m :: * -> *). HttpLog m => HttpLogMetadata m
emptyHttpLogMetadata @m)

    logError :: QErr -> ActionCtxT () m ()
logError QErr
err = do
      Request
req <- ActionCtxT () m Request
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
Spock.request
      ByteString
reqBody <- IO ByteString -> ActionCtxT () m ByteString
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ActionCtxT () m ByteString)
-> IO ByteString -> ActionCtxT () m ByteString
forall a b. (a -> b) -> a -> b
$ Request -> IO ByteString
Wai.strictRequestBody Request
req
      let headers :: [Header]
headers = Request -> [Header]
Wai.requestHeaders Request
req
      (RequestId
reqId, [Header]
_newHeaders) <- [Header] -> ActionCtxT () m (RequestId, [Header])
forall (m :: * -> *).
MonadIO m =>
[Header] -> m (RequestId, [Header])
getRequestId [Header]
headers
      m () -> ActionCtxT () m ()
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ActionCtxT () m ()) -> m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata m
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpError Logger Hasura
logger LoggingSettings
appEnvLoggingSettings Maybe UserInfo
forall a. Maybe a
Nothing RequestId
reqId Request
req (ByteString
reqBody, Maybe Value
forall a. Maybe a
Nothing) QErr
err [Header]
headers (forall (m :: * -> *). HttpLog m => HttpLogMetadata m
emptyHttpLogMetadata @m)

    spockAction ::
      forall a.
      (FromJSON a) =>
      (Bool -> QErr -> Encoding) ->
      (QErr -> QErr) ->
      APIHandler m a ->
      Spock.ActionT m ()
    spockAction :: forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
qErrEncoder QErr -> QErr
qErrModifier APIHandler m a
apiHandler = AppStateRef impl
-> (Bool -> QErr -> Encoding)
-> (QErr -> QErr)
-> APIHandler m a
-> ActionCtxT () m ()
forall (m :: * -> *) a impl.
(MonadIO m, MonadBaseControl IO m, HasAppEnv m, FromJSON a,
 UserAuthentication m, HttpLog m, HasResourceLimits m,
 MonadTrace m) =>
AppStateRef impl
-> (Bool -> QErr -> Encoding)
-> (QErr -> QErr)
-> APIHandler m a
-> ActionT m ()
mkSpockAction AppStateRef impl
appStateRef Bool -> QErr -> Encoding
qErrEncoder QErr -> QErr
qErrModifier APIHandler m a
apiHandler

    -- all graphql errors should be of type 200
    allMod200 :: QErr -> QErr
allMod200 QErr
qe = QErr
qe {qeStatus :: Status
qeStatus = Status
HTTP.status200}
    gqlExplainAction :: ActionCtxT () m ()
gqlExplainAction = do
      (Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m GQLExplain -> ActionCtxT () m ()
forall a.
FromJSON a =>
(Bool -> QErr -> Encoding)
-> (QErr -> QErr) -> APIHandler m a -> ActionCtxT () m ()
spockAction Bool -> QErr -> Encoding
encodeQErr QErr -> QErr
forall a. a -> a
id
        (APIHandler m GQLExplain -> ActionCtxT () m ())
-> APIHandler m GQLExplain -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ (GQLExplain -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m GQLExplain
forall a (m :: * -> *).
(a -> Handler m (HttpLogGraphQLInfo, APIResp)) -> APIHandler m a
mkPostHandler
        ((GQLExplain -> Handler m (HttpLogGraphQLInfo, APIResp))
 -> APIHandler m GQLExplain)
-> (GQLExplain -> Handler m (HttpLogGraphQLInfo, APIResp))
-> APIHandler m GQLExplain
forall a b. (a -> b) -> a -> b
$ (APIResp -> (HttpLogGraphQLInfo, APIResp))
-> Handler m APIResp -> Handler m (HttpLogGraphQLInfo, APIResp)
forall a b. (a -> b) -> Handler m a -> Handler m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo,)
        (Handler m APIResp -> Handler m (HttpLogGraphQLInfo, APIResp))
-> (GQLExplain -> Handler m APIResp)
-> GQLExplain
-> Handler m (HttpLogGraphQLInfo, APIResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GQLExplain -> Handler m (HttpResponse EncJSON))
-> GQLExplain -> Handler m APIResp
forall (m :: * -> *) a.
Functor m =>
(a -> Handler m (HttpResponse EncJSON)) -> a -> Handler m APIResp
mkAPIRespHandler GQLExplain -> Handler m (HttpResponse EncJSON)
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m,
 MonadReader HandlerCtx m, MonadMetadataStorage m, MonadQueryTags m,
 MonadTrace m) =>
GQLExplain -> m (HttpResponse EncJSON)
gqlExplainHandler

    serveApiConsole :: SpockT m ()
serveApiConsole = do
      -- redirect / to /console
      Path '[] 'Open -> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get Path '[] 'Open
Spock.root (HVectElim '[] (ActionCtxT () m ()) -> SpockT m ())
-> HVectElim '[] (ActionCtxT () m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ do
        (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled (\AppContext
appCtx -> ConsoleStatus -> Bool
isConsoleEnabled (AppContext -> ConsoleStatus
acConsoleStatus AppContext
appCtx) Bool -> Bool -> Bool
&& AppContext -> Bool
isMetadataEnabled AppContext
appCtx) AppStateRef impl
appStateRef
          (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ Text -> ActionCtxT () m ()
forall (m :: * -> *) ctx a. MonadIO m => Text -> ActionCtxT ctx m a
Spock.redirect Text
"console"

      -- serve console html
      Path (Append '[] '[Text]) 'Closed
-> HVectElim (Append '[] '[Text]) (ActionCtxT () m ())
-> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get (Path '[] 'Open
"console" Path '[] 'Open
-> Path '[Text] 'Closed -> Path (Append '[] '[Text]) 'Closed
forall (as :: [*]) (bs :: [*]) (ps :: PathState).
Path as 'Open -> Path bs ps -> Path (Append as bs) ps
<//> Path '[Text] 'Closed
Spock.wildcard) (HVectElim (Append '[] '[Text]) (ActionCtxT () m ())
 -> SpockT m ())
-> HVectElim (Append '[] '[Text]) (ActionCtxT () m ())
-> SpockT m ()
forall a b. (a -> b) -> a -> b
$ \Text
path -> do
        (AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT () m () -> ActionCtxT () m ()
forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled (\AppContext
appCtx -> ConsoleStatus -> Bool
isConsoleEnabled (AppContext -> ConsoleStatus
acConsoleStatus AppContext
appCtx) Bool -> Bool -> Bool
&& AppContext -> Bool
isMetadataEnabled AppContext
appCtx) AppStateRef impl
appStateRef (ActionCtxT () m () -> ActionCtxT () m ())
-> ActionCtxT () m () -> ActionCtxT () m ()
forall a b. (a -> b) -> a -> b
$ do
          AppContext {Environment
HashSet ExperimentalFeature
HashSet API
StreamQueriesOptions
NamingCase
RemoteSchemaPermissions
InferFunctionPermissions
SQLGenCtx
CloseWebsocketsOnMetadataChangeStatus
ApolloFederationStatus
CorsPolicy
AuthMode
MetadataDefaults
ResponseInternalErrorsConfig
OptionalInterval
TelemetryStatus
AllowListStatus
ConsoleStatus
EventEngineCtx
acEnabledAPIs :: AppContext -> HashSet API
acAuthMode :: AppContext -> AuthMode
acSQLGenCtx :: AppContext -> SQLGenCtx
acEnableAllowlist :: AppContext -> AllowListStatus
acResponseInternalErrorsConfig :: AppContext -> ResponseInternalErrorsConfig
acEnvironment :: AppContext -> Environment
acRemoteSchemaPermsCtx :: AppContext -> RemoteSchemaPermissions
acFunctionPermsCtx :: AppContext -> InferFunctionPermissions
acExperimentalFeatures :: AppContext -> HashSet ExperimentalFeature
acDefaultNamingConvention :: AppContext -> NamingCase
acMetadataDefaults :: AppContext -> MetadataDefaults
acLiveQueryOptions :: AppContext -> StreamQueriesOptions
acStreamQueryOptions :: AppContext -> StreamQueriesOptions
acCorsPolicy :: AppContext -> CorsPolicy
acConsoleStatus :: AppContext -> ConsoleStatus
acEnableTelemetry :: AppContext -> TelemetryStatus
acEventEngineCtx :: AppContext -> EventEngineCtx
acAsyncActionsFetchInterval :: AppContext -> OptionalInterval
acApolloFederationStatus :: AppContext -> ApolloFederationStatus
acCloseWebsocketsOnMetadataChangeStatus :: AppContext -> CloseWebsocketsOnMetadataChangeStatus
acAuthMode :: AuthMode
acSQLGenCtx :: SQLGenCtx
acEnabledAPIs :: HashSet API
acEnableAllowlist :: AllowListStatus
acResponseInternalErrorsConfig :: ResponseInternalErrorsConfig
acEnvironment :: Environment
acRemoteSchemaPermsCtx :: RemoteSchemaPermissions
acFunctionPermsCtx :: InferFunctionPermissions
acExperimentalFeatures :: HashSet ExperimentalFeature
acDefaultNamingConvention :: NamingCase
acMetadataDefaults :: MetadataDefaults
acLiveQueryOptions :: StreamQueriesOptions
acStreamQueryOptions :: StreamQueriesOptions
acCorsPolicy :: CorsPolicy
acConsoleStatus :: ConsoleStatus
acEnableTelemetry :: TelemetryStatus
acEventEngineCtx :: EventEngineCtx
acAsyncActionsFetchInterval :: OptionalInterval
acApolloFederationStatus :: ApolloFederationStatus
acCloseWebsocketsOnMetadataChangeStatus :: CloseWebsocketsOnMetadataChangeStatus
..} <- IO AppContext -> ActionCtxT () m AppContext
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppContext -> ActionCtxT () m AppContext)
-> IO AppContext -> ActionCtxT () m AppContext
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
getAppContext AppStateRef impl
appStateRef
          Request
req <- ActionCtxT () m Request
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
Spock.request
          let headers :: [Header]
headers = Request -> [Header]
Wai.requestHeaders Request
req
          Either [Char] Text
consoleHtml <- m (Either [Char] Text) -> ActionCtxT () m (Either [Char] Text)
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either [Char] Text) -> ActionCtxT () m (Either [Char] Text))
-> m (Either [Char] Text) -> ActionCtxT () m (Either [Char] Text)
forall a b. (a -> b) -> a -> b
$ Text
-> AuthMode
-> TelemetryStatus
-> Maybe Text
-> Maybe Text
-> ConsoleType m
-> m (Either [Char] Text)
forall (m :: * -> *).
ConsoleRenderer m =>
Text
-> AuthMode
-> TelemetryStatus
-> Maybe Text
-> Maybe Text
-> ConsoleType m
-> m (Either [Char] Text)
renderConsole Text
path AuthMode
acAuthMode TelemetryStatus
acEnableTelemetry Maybe Text
appEnvConsoleAssetsDir Maybe Text
appEnvConsoleSentryDsn ConsoleType m
consoleType
          ([Char] -> ActionCtxT () m ())
-> (Text -> ActionCtxT () m ())
-> Either [Char] Text
-> ActionCtxT () m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Logger Hasura
-> LoggingSettings -> [Header] -> QErr -> ActionCtxT () m ()
forall (m :: * -> *).
(MonadIO m, HttpLog m) =>
Logger Hasura
-> LoggingSettings -> [Header] -> QErr -> ActionT m ()
raiseGenericApiError Logger Hasura
logger LoggingSettings
appEnvLoggingSettings [Header]
headers (QErr -> ActionCtxT () m ())
-> ([Char] -> QErr) -> [Char] -> ActionCtxT () m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> QErr
internalError (Text -> QErr) -> ([Char] -> Text) -> [Char] -> QErr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) Text -> ActionCtxT () m ()
forall (m :: * -> *) ctx a. MonadIO m => Text -> ActionCtxT ctx m a
Spock.html Either [Char] Text
consoleHtml

    serveApiConsoleAssets :: SpockT m ()
serveApiConsoleAssets = do
      -- serve static files if consoleAssetsDir is set
      Maybe Text -> (Text -> SpockT m ()) -> SpockT m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Text
appEnvConsoleAssetsDir ((Text -> SpockT m ()) -> SpockT m ())
-> (Text -> SpockT m ()) -> SpockT m ()
forall a b. (a -> b) -> a -> b
$ \Text
dir ->
        Path (Append '[] '[Text]) 'Closed
-> HVectElim (Append '[] '[Text]) (ActionCtxT () m ())
-> SpockT m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
Spock.get (Path '[] 'Open
"console/assets" Path '[] 'Open
-> Path '[Text] 'Closed -> Path (Append '[] '[Text]) 'Closed
forall (as :: [*]) (bs :: [*]) (ps :: PathState).
Path as 'Open -> Path bs ps -> Path (Append as bs) ps
<//> Path '[Text] 'Closed
Spock.wildcard) (HVectElim (Append '[] '[Text]) (ActionCtxT () m ())
 -> SpockT m ())
-> HVectElim (Append '[] '[Text]) (ActionCtxT () m ())
-> SpockT m ()
forall a b. (a -> b) -> a -> b
$ \Text
path -> do
          Logger Hasura
-> LoggingSettings -> Text -> Text -> ActionCtxT () m ()
forall (m :: * -> *).
(MonadIO m, HttpLog m) =>
Logger Hasura -> LoggingSettings -> Text -> Text -> ActionT m ()
consoleAssetsHandler Logger Hasura
logger LoggingSettings
appEnvLoggingSettings Text
dir Text
path

-- an endpoint can be switched ON/OFF dynamically, hence serve the endpoint only
-- when it is enabled else throw HTTP Error 404
onlyWhenApiEnabled ::
  (MonadIO m) =>
  (AppContext -> Bool) ->
  AppStateRef impl ->
  Spock.ActionCtxT ctx m b ->
  Spock.ActionCtxT ctx m b
onlyWhenApiEnabled :: forall (m :: * -> *) impl ctx b.
MonadIO m =>
(AppContext -> Bool)
-> AppStateRef impl -> ActionCtxT ctx m b -> ActionCtxT ctx m b
onlyWhenApiEnabled AppContext -> Bool
isEnabled AppStateRef impl
appStateRef ActionCtxT ctx m b
endpointAction = do
  AppContext
appContext <- IO AppContext -> ActionCtxT ctx m AppContext
forall a. IO a -> ActionCtxT ctx m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppContext -> ActionCtxT ctx m AppContext)
-> IO AppContext -> ActionCtxT ctx m AppContext
forall a b. (a -> b) -> a -> b
$ AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
getAppContext AppStateRef impl
appStateRef
  if (AppContext -> Bool
isEnabled AppContext
appContext)
    then do ActionCtxT ctx m b
endpointAction
    else do
      let qErr :: QErr
qErr = Code -> Text -> QErr
err404 Code
NotFound Text
"resource does not exist"
      Status -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
Spock.setStatus (Status -> ActionCtxT ctx m ()) -> Status -> ActionCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ QErr -> Status
qeStatus QErr
qErr
      Header -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Header -> ActionCtxT ctx m ()
setHeader Header
jsonHeader
      ByteString -> ActionCtxT ctx m b
forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
Spock.lazyBytes (ByteString -> ActionCtxT ctx m b)
-> (Encoding -> ByteString) -> Encoding -> ActionCtxT ctx m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
forall a. Encoding' a -> ByteString
J.encodingToLazyByteString (Encoding -> ActionCtxT ctx m b) -> Encoding -> ActionCtxT ctx m b
forall a b. (a -> b) -> a -> b
$ Bool -> QErr -> Encoding
encodeQErr Bool
False QErr
qErr

raiseGenericApiError ::
  forall m.
  (MonadIO m, HttpLog m) =>
  L.Logger L.Hasura ->
  LoggingSettings ->
  [HTTP.Header] ->
  QErr ->
  Spock.ActionT m ()
raiseGenericApiError :: forall (m :: * -> *).
(MonadIO m, HttpLog m) =>
Logger Hasura
-> LoggingSettings -> [Header] -> QErr -> ActionT m ()
raiseGenericApiError Logger Hasura
logger LoggingSettings
loggingSetting [Header]
headers QErr
qErr = do
  Request
req <- ActionCtxT () m Request
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
Spock.request
  ByteString
reqBody <- IO ByteString -> ActionCtxT () m ByteString
forall a. IO a -> ActionCtxT () m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ActionCtxT () m ByteString)
-> IO ByteString -> ActionCtxT () m ByteString
forall a b. (a -> b) -> a -> b
$ Request -> IO ByteString
Wai.strictRequestBody Request
req
  (RequestId
reqId, [Header]
_newHeaders) <- [Header] -> ActionCtxT () m (RequestId, [Header])
forall (m :: * -> *).
MonadIO m =>
[Header] -> m (RequestId, [Header])
getRequestId ([Header] -> ActionCtxT () m (RequestId, [Header]))
-> [Header] -> ActionCtxT () m (RequestId, [Header])
forall a b. (a -> b) -> a -> b
$ Request -> [Header]
Wai.requestHeaders Request
req
  m () -> ActionT m ()
forall (m :: * -> *) a. Monad m => m a -> ActionCtxT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ActionT m ()) -> m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata m
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpError Logger Hasura
logger LoggingSettings
loggingSetting Maybe UserInfo
forall a. Maybe a
Nothing RequestId
reqId Request
req (ByteString
reqBody, Maybe Value
forall a. Maybe a
Nothing) QErr
qErr [Header]
headers (forall (m :: * -> *). HttpLog m => HttpLogMetadata m
emptyHttpLogMetadata @m)
  Header -> ActionT m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Header -> ActionCtxT ctx m ()
setHeader Header
jsonHeader
  Status -> ActionT m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
Spock.setStatus (Status -> ActionT m ()) -> Status -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ QErr -> Status
qeStatus QErr
qErr
  ByteString -> ActionT m ()
forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
Spock.lazyBytes (ByteString -> ActionT m ()) -> ByteString -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ QErr -> ByteString
forall a. ToJSON a => a -> ByteString
encode QErr
qErr