{- | The per-request context the serve path reads through, and the handler monad
over it.

Mount dispatch matches a request to one 'MountBinding' -- a mount's __complete__
ecosystem wiring -- then runs the route's handler in 'Handler', a reader over a
'RequestCtx' pairing that binding with the request runtime 'ServeRuntime'. A handler
reads its per-mount dependencies (the classifier, the packument-serve dependencies,
the error renderer, the path prefix) and the shared runtime from that one context,
rather than taking them as explicit arguments threaded down the pipeline.

'ServeRuntime' is the __runtime interface__ the serve path is closed over: the two
data-plane HTTP managers, the metadata cache, the mirror queue, and the abstract
metric- and tracing-recording ports. It holds precisely what the pipeline needs to
serve a request and nothing more; the application's composition root constructs it
(wiring the concrete OpenTelemetry-backed ports), and a test constructs it over
doubles. Logging is __not__ a field: a handler logs through the ambient @katip@
context, which the dispatch boundary establishes (with the structured-log scribes and
the trace-correlation @dd@ object) when it runs the handler.

'RequestCtx' is a concrete record with plain accessors ('ctxRuntime', 'ctxMount'). The
handler monad layers over @katip@'s logging context, so a structured log call composes
uniformly across the serve path.
-}
module Ecluse.Core.Server.Context (
    -- * Request runtime
    ServeRuntime (..),

    -- * Packument-serve dependencies
    PackumentDeps (..),

    -- * Publish-serve dependencies
    PublishDeps (..),

    -- * Mount binding
    MountBinding (..),

    -- * Per-request context
    RequestCtx (..),

    -- * The handler monad
    Handler,
    runHandler,
) where

import Data.Aeson (Value)
import Data.IP (IPRange)
import Data.Time (UTCTime)
import Katip (Katip, KatipContext, LogEnv, SimpleLogPayload)
import Katip.Monadic (KatipContextT, runKatipContextT)
import Network.HTTP.Client (Manager, Request)
import UnliftIO (MonadUnliftIO)

import Ecluse.Core.Credential (Secret)
import Ecluse.Core.Package (InvalidEntry, PackageName, Scope)
import Ecluse.Core.Package.Integrity (MinIntegrity, MinTrustedIntegrity)
import Ecluse.Core.Package.Merge (MergePlan, SourceId)
import Ecluse.Core.Queue (MirrorQueue)
import Ecluse.Core.Registry (PublishRelayResponse, UrlFormationError)
import Ecluse.Core.Registry.Metadata (MetadataClient, MetadataError)
import Ecluse.Core.Rules (PreparedRule)
import Ecluse.Core.Security (Limits, TarballHostGate, TarballHostPolicy)
import Ecluse.Core.Server.Admission (ServeAdmission)
import Ecluse.Core.Server.Cache (MetadataCache)
import Ecluse.Core.Server.Metadata (ManifestCaching)
import Ecluse.Core.Server.Response (HelpMessage, MountRenderer)
import Ecluse.Core.Server.Route (Classifier)
import Ecluse.Core.Telemetry.Metrics qualified as Metric
import Ecluse.Core.Telemetry.Record (MetricsPort)
import Ecluse.Core.Telemetry.Span (TracingPort)

{- | The runtime backends the serve path is closed over: exactly the effectful
capabilities a request needs to fetch, gate, serve, and record. A record of concrete
handles and abstract ports (the Handle pattern), assembled by the composition root and
read by every handler through the 'RequestCtx'.

The two HTTP managers carry the per-origin split: the public manager serves the
untrusted public-upstream and artifact egress, the private manager the trusted
private-upstream path. Both are the validating TLS manager (registry egress is
https-only by construction; certificate validation authenticates the host), so the
split is in credential handling and the @dist.tarball@ host gate's trust, not the
manager. The metadata cache and mirror queue are the shared data-plane handles. The
metric and tracing ports are the abstract recording interfaces
("Ecluse.Core.Telemetry.Record", "Ecluse.Core.Telemetry.Span"); the application supplies
their OpenTelemetry-backed implementations, so the serve path records without naming a
telemetry backend. There is no log field: handlers log through the ambient @katip@
context.
-}
data ServeRuntime = ServeRuntime
    { ServeRuntime -> ServeAdmission
srAdmission :: ServeAdmission
    {- ^ The process-wide brief-wait bound around metadata materialisation
    ("Ecluse.Core.Server.Admission"). A private tarball hit and the artifact
    streaming pump stay outside it; packument work and a tarball miss's public
    metadata gate acquire a slot, waiting briefly for one under load.
    -}
    , ServeRuntime -> Manager
srPublicManager :: Manager
    {- ^ The validating-TLS data-plane manager for the __untrusted__ public-upstream
    metadata fetch and every artifact stream.
    -}
    , ServeRuntime -> Manager
srPrivateManager :: Manager
    {- ^ The manager for the __trusted__ private upstream. The same validating TLS
    manager; the private origin differs in credential handling, not in the manager.
    -}
    , ServeRuntime -> MetadataCache
srMetadataCache :: MetadataCache
    {- ^ The short-TTL, size-bounded metadata cache shared by the serve paths
    (see "Ecluse.Core.Server.Cache").
    -}
    , ServeRuntime -> MirrorQueue
srQueue :: MirrorQueue
    {- ^ The mirror-queue handle: the durable, best-effort hand-off from the serve
    path to the mirror worker.
    -}
    , ServeRuntime -> MetricsPort
srMetrics :: MetricsPort
    -- ^ The metric-recording port the serve path emits the @ecluse.*@ catalogue through.
    , ServeRuntime -> TracingPort
srTracing :: TracingPort
    -- ^ The tracing port the serve path opens its hand-added domain spans through.
    }

{- | The per-mount inputs the serve handlers need beyond the request runtime
'ServeRuntime': the two upstream endpoints, the mount's externally-visible base URL,
the mirror-target endpoint, its resolved rule policy, the edge auth token, the
wall-clock source, and the operator help message.

These are a mount-level concern, resolved at the composition root (a separate
concern) and carried on the mount's 'MountBinding'; a handler reads exactly what it
needs to decide and serve from the 'RequestCtx' it runs in. Both the packument and
the tarball paths share these deps -- the tarball path additionally gates one
version and enqueues a mirror job to 'pdMirrorTarget' -- so the name is retained for
continuity rather than narrowed to one route.
-}
data PackumentDeps = PackumentDeps
    { PackumentDeps -> Text
pdPrivateBaseUrl :: Text
    -- ^ The private upstream base URL; under @passthrough@, reads forward the client's credential.
    , PackumentDeps -> Text
pdPublicBaseUrl :: Text
    -- ^ The public upstream base URL; reads are anonymous (no client credential).
    , PackumentDeps -> Text
pdMountBaseUrl :: Text
    {- ^ The mount's externally-visible base URL, under which served @dist.tarball@
    URLs are rewritten so artifacts are fetched back through the gate.
    -}
    , PackumentDeps -> Text
pdMirrorTarget :: Text
    {- ^ The mount's mirror-target endpoint -- where the demand-driven mirror worker
    publishes an approved artifact. Carried on the enqueued
    'Ecluse.Core.Queue.MirrorJob' as its publish destination; the serve path never reads
    or writes it itself.
    -}
    , PackumentDeps -> [PreparedRule]
pdRules :: [PreparedRule]
    {- ^ The mount's resolved rule set as the engine's prepared runtime rules
    ("Ecluse.Core.Rules.PreparedRule"), evaluated against every public version. The
    built-in rules run directly; an effectful rule carries a resilience policy. The
    composition root 'prepare's it (and logs its boot order) once.
    -}
    , PackumentDeps -> TarballHostPolicy
pdTarballHostPolicy :: TarballHostPolicy
    {- ^ Whether a tarball may be fetched from a @dist.tarball@ host that differs
    from the upstream that served the packument
    ('Ecluse.Core.Security.SameHostAsPackument' by default, the secure reading of the
    host allowlist; relaxed to 'Ecluse.Core.Security.AnyAllowlistedHost' by
    @ECLUSE_RESPECT_UPSTREAM_TARBALL_HOST@).
    -}
    , PackumentDeps -> [IPRange]
pdAdditionalBlockedRanges :: [IPRange]
    {- ^ The operator-configured ranges (@ECLUSE_ADDITIONAL_BLOCKED_RANGES@) extending the
    fixed literal internal-range block when gating an honoured artifact location
    ('Ecluse.Core.Security.tarballHostAllowed'), the cheap pure defence-in-depth that
    complements the host allowlist. Empty by default.
    -}
    , PackumentDeps -> TarballHostGate
pdTarballHostGate :: TarballHostGate
    {- ^ The mount-constant inputs to the per-request tarball-host gate
    ('Ecluse.Core.Security.TarballHostGate'): the lowered upstream allowlist and the bare
    private and public upstream hosts, extracted __once__ at the composition root from
    the base URLs above. The hot artifact path reads these fields rather than rebuilding
    the allowlist set and re-parsing the base URLs on every request (only the dynamic
    public @dist.tarball@ host is parsed per request).

    __Invariant__: this is a cached projection of 'pdPrivateBaseUrl', 'pdPublicBaseUrl',
    and 'pdMirrorTarget'; whoever changes one of those after construction must re-derive
    it via 'Ecluse.Core.Security.tarballHostGate' or the gate goes stale. The composition
    root builds the deps once, so production never does; a test that record-updates a URL
    field must rebuild the gate (the serve-path test harness does this centrally).
    -}
    , PackumentDeps -> Limits
pdLimits :: Limits
    {- ^ The response-bound budget enforced on every upstream metadata fetch and
    decode (@ECLUSE_MAX_RESPONSE_BYTES@\/@ECLUSE_MAX_VERSION_COUNT@\/@ECLUSE_MAX_NESTING_DEPTH@):
    the body-size, version-count, and JSON-nesting ceilings of
    'Ecluse.Core.Security.Limits'. The data plane reads the metadata body through
    'Ecluse.Core.Security.boundedRead' against @maxBodyBytes@, checks
    'Ecluse.Core.Security.checkNestingDepth' at the JSON-decode boundary, and
    'Ecluse.Core.Security.checkVersionCount' after projection; a breach degrades the
    contribution to nothing (the fail-closed parse-failure path), so a pathological
    upstream document is refused, never partially served (security.md invariant 4).
    -}
    , PackumentDeps -> Maybe Secret
pdInboundToken :: Maybe Secret
    {- ^ The optional inbound token a client must present (@ECLUSE_AUTH_TOKEN@);
    'Nothing' leaves the edge open (the network layer guards it).
    -}
    , PackumentDeps -> IO UTCTime
pdNow :: IO UTCTime
    {- ^ The wall-clock "now" for the rules' 'Ecluse.Core.Rules.Types.EvalContext'.
    Injected so the time-sensitive age gate is deterministic under test.
    -}
    , PackumentDeps -> Maybe HelpMessage
pdHelp :: Maybe HelpMessage
    -- ^ The operator help message appended to every denial body, if configured.
    , PackumentDeps -> MinIntegrity
pdMinIntegrity :: MinIntegrity
    {- ^ The minimum integrity algorithm a __public__ (untrusted) version's digest must
    meet to be admitted (the global @ECLUSE_MIN_PUBLIC_INTEGRITY@ floor, default SHA-256).
    The public gate refuses a version whose strongest digest is below this; it is
    __hard-floored at SHA-256__ and never lowerable (see "Ecluse.Core.Package.Integrity").
    The trusted private path consults 'pdMinTrustedIntegrity' instead.
    -}
    , PackumentDeps -> MinTrustedIntegrity
pdMinTrustedIntegrity :: MinTrustedIntegrity
    -- ^ The minimum integrity hash required for a trusted upstream dependency.
    , PackumentDeps
-> TracingPort
-> MetricsPort
-> Upstream
-> ManifestCaching
-> (PackageName -> MetadataError -> IO ())
-> (PackageName -> [InvalidEntry] -> IO ())
-> (PackageName -> IO ())
-> Limits
-> Manager
-> Text
-> Maybe Secret
-> MetadataClient
pdNewMetadataClient ::
        TracingPort ->
        MetricsPort ->
        Metric.Upstream ->
        ManifestCaching ->
        (PackageName -> MetadataError -> IO ()) ->
        (PackageName -> [InvalidEntry] -> IO ()) ->
        (PackageName -> IO ()) ->
        Limits ->
        Manager ->
        Text ->
        Maybe Secret ->
        MetadataClient
    {- ^ Build a per-request metadata client for one origin, given the per-fetch
    parameters. The composition root closes over the ecosystem's raw fetch
    primitives; the pipeline supplies only the per-request runtime parameters.
    -}
    , PackumentDeps
-> Limits
-> Manager
-> Text
-> Maybe Secret
-> PackageName
-> Text
-> Either UrlFormationError Request
pdBuildArtifactRequestByFile :: Limits -> Manager -> Text -> Maybe Secret -> PackageName -> Text -> Either UrlFormationError Request
    {- ^ Build an artifact request by conventional filename path for the private
    (trusted) leg.
    -}
    , PackumentDeps
-> Limits
-> Manager
-> Text
-> Maybe Secret
-> Text
-> Either UrlFormationError Request
pdBuildArtifactRequestByUrl :: Limits -> Manager -> Text -> Maybe Secret -> Text -> Either UrlFormationError Request
    -- ^ Build an artifact request by authoritative URL for the public leg.
    , PackumentDeps
-> Text -> Map SourceId Value -> MergePlan -> Value -> Value
pdAssemble :: Text -> Map SourceId Value -> MergePlan -> Value -> Value
    {- ^ Assemble the served document from a merge plan and the raw source
    documents: rebuild the plan-owned keys onto the base document from the winning
    sources, rewriting each surviving version's artifact URL under the given mount
    base in the same pass.
    -}
    }

{- | The per-mount inputs the first-party publish handler needs: the publication
target endpoint, the publish-scope allow-list (the anti-shadowing guard), the
optional static fallback credential, the edge token, the response-bound budget, and
the operator help message.

The mere __presence__ of these deps is the publish path's opt-in: a mount carries a
'PublishDeps' only when a publication target is configured, so the binding's
@bindingPublishDeps@ being 'Nothing' is exactly the "no publication target ⇒ a
@PUT \/{pkg}@ is @405 Method Not Allowed@" rule, modelled in the type rather than
re-derived at the handler (see
@docs\/architecture\/registry-model.md@ → "Publishing first-party packages").

The credential posture is __passthrough__, symmetric with the private-upstream read
under @passthrough@: the publisher's own forwarded token is what reaches the
publication target, the static 'pubStaticToken' only a fallback for a client that
sends none. Écluse mints no token of its own here -- unlike the mirror target -- so this
record carries no 'Ecluse.Core.Credential.CredentialProvider' (see
@docs\/architecture\/access-model.md@ → "Publishing: the publication target").
-}
data PublishDeps = PublishDeps
    { PublishDeps -> Text
pubTargetUrl :: Text
    {- ^ The publication target endpoint (@ECLUSE_PUBLICATION_TARGET@) a client
    @npm publish@ is relayed to. The package path is appended to it.
    -}
    , PublishDeps -> [Scope]
pubScopes :: [Scope]
    {- ^ The configured publish-scope allow-list (@ECLUSE_PUBLISH_SCOPES@) -- the
    anti-shadowing guard. A publish whose package name is not within one of these
    scopes is refused __before any upstream write__, so a client cannot publish a name
    that shadows an existing public package (a dependency-confusion vector). Never
    empty when a publication target is configured (config validation rejects that).
    -}
    , PublishDeps -> Maybe Secret
pubStaticToken :: Maybe Secret
    {- ^ The static fallback credential (@ECLUSE_PUBLICATION_TARGET_TOKEN@) forwarded to the
    publication target __only when the client sends no token of its own__. The default
    model is passthrough -- the publisher's own token -- so this is 'Nothing' on the
    common path.
    -}
    , PublishDeps -> Maybe Secret
pubInboundToken :: Maybe Secret
    {- ^ The optional inbound edge token a client must present (@ECLUSE_AUTH_TOKEN@),
    the same gate the read paths apply; 'Nothing' leaves the edge open.
    -}
    , PublishDeps -> Limits
pubLimits :: Limits
    {- ^ The response-bound budget enforced on the publication target's response,
    carried for symmetry with the read paths.
    -}
    , PublishDeps -> Maybe HelpMessage
pubHelp :: Maybe HelpMessage
    -- ^ The operator help message appended to a publish denial, if configured.
    , PublishDeps
-> Limits
-> Manager
-> Text
-> Maybe Secret
-> PackageName
-> ByteString
-> IO (Either UrlFormationError PublishRelayResponse)
pubRelayPublish :: Limits -> Manager -> Text -> Maybe Secret -> PackageName -> ByteString -> IO (Either UrlFormationError PublishRelayResponse)
    -- ^ Relay a publish document to the publication target, returning its response.
    , PublishDeps -> Text -> Maybe PackageName
pubCanonicaliseName :: Text -> Maybe PackageName
    {- ^ Canonicalise a raw package-name string to a 'PackageName', or 'Nothing' if
    it cannot be parsed. Used by the body-name agreement guard.
    -}
    }

{- | A mount: a path prefix bound to a registry, carrying that registry's
__complete__ ecosystem wiring. Dispatch matches a request's leading path segments
to 'bindingPrefix', strips them, and routes the remainder through the rest of the
binding.

The prefix is a 'NonEmpty' list of segments (@"npm" :| []@ for a @\/npm@ mount):
every registry is path-mounted, so a root mount -- which would force a URL change
on every consumer the day a second ecosystem is added -- is __unrepresentable__
rather than merely discouraged. Bundling the classifier, serve dependencies, and
renderer into one record means a mount cannot be half-wired: there is no default
to fall back to.
-}
data MountBinding = MountBinding
    { MountBinding -> NonEmpty Text
bindingPrefix :: NonEmpty Text
    -- ^ The leading path segments this mount is served under; never empty.
    , MountBinding -> Classifier
bindingClassifier :: Classifier
    -- ^ The ecosystem path grammar mapping this mount's native path to an 'Ecluse.Core.Server.Route.Route'.
    , MountBinding -> Maybe PackumentDeps
bindingPackumentDeps :: Maybe PackumentDeps
    {- ^ The packument-serve dependencies, when wired; 'Nothing' leaves the
    packument route recognised-but-unserved (the @501@ stub).
    -}
    , MountBinding -> Maybe PublishDeps
bindingPublishDeps :: Maybe PublishDeps
    {- ^ The first-party publish dependencies, when a publication target is
    configured; 'Nothing' is the opt-out -- a @PUT \/{pkg}@ is then @405@ (no implicit
    write path).
    -}
    , MountBinding -> MountRenderer
bindingRenderer :: MountRenderer
    {- ^ This mount's renderer for error\/denial bodies -- the ecosystem surface an
    in-mount @403@\/@404@\/@501@ is shaped into.
    -}
    }

{- | The context one request is served through: the request runtime 'ServeRuntime'
paired with the 'MountBinding' the request matched. A concrete record with plain
accessors -- 'ctxRuntime' and 'ctxMount' -- so a handler reads the shared runtime and its
per-mount wiring from one place rather than as explicit arguments.

Dispatch builds it once per request; the handler reads it through the 'Handler' reader.
-}
data RequestCtx = RequestCtx
    { RequestCtx -> ServeRuntime
ctxRuntime :: ServeRuntime
    -- ^ The request runtime -- the data-plane managers, the caches and queue, the recording ports.
    , RequestCtx -> MountBinding
ctxMount :: MountBinding
    -- ^ The mount the request matched, carrying its complete ecosystem wiring.
    }

{- | The request hot path's monad: a reader over the per-request 'RequestCtx'
layered on @katip@'s logging context.

A @newtype@ over @'ReaderT' 'RequestCtx' ('KatipContextT' 'IO')@ so its instances
are this module's to control and call sites name one concrete monad. The derived
instances give reader access to the context ('MonadReader' 'RequestCtx'), arbitrary
effects ('MonadIO'), the unlift capability ('MonadUnliftIO') the serve path's
@concurrently@\/@bracket@ need, and the @katip@ classes ('Katip', 'KatipContext')
so a structured log call composes through the ambient context the dispatch boundary
establishes.

The @katip@ base is a reader, never a 'StateT', so logging context behaves
correctly across the serve path's concurrent fetches (see
@docs\/architecture\/technology-stack.md@ → "Key Decisions").
-}
newtype Handler a = Handler
    { forall a. Handler a -> ReaderT RequestCtx (KatipContextT IO) a
unHandler :: ReaderT RequestCtx (KatipContextT IO) a
    }
    deriving newtype
        ( (forall a b. (a -> b) -> Handler a -> Handler b)
-> (forall a b. a -> Handler b -> Handler a) -> Functor Handler
forall a b. a -> Handler b -> Handler a
forall a b. (a -> b) -> Handler a -> Handler b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Handler a -> Handler b
fmap :: forall a b. (a -> b) -> Handler a -> Handler b
$c<$ :: forall a b. a -> Handler b -> Handler a
<$ :: forall a b. a -> Handler b -> Handler a
Functor
        , Functor Handler
Functor Handler =>
(forall a. a -> Handler a)
-> (forall a b. Handler (a -> b) -> Handler a -> Handler b)
-> (forall a b c.
    (a -> b -> c) -> Handler a -> Handler b -> Handler c)
-> (forall a b. Handler a -> Handler b -> Handler b)
-> (forall a b. Handler a -> Handler b -> Handler a)
-> Applicative Handler
forall a. a -> Handler a
forall a b. Handler a -> Handler b -> Handler a
forall a b. Handler a -> Handler b -> Handler b
forall a b. Handler (a -> b) -> Handler a -> Handler b
forall a b c. (a -> b -> c) -> Handler a -> Handler b -> Handler 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 a. a -> Handler a
pure :: forall a. a -> Handler a
$c<*> :: forall a b. Handler (a -> b) -> Handler a -> Handler b
<*> :: forall a b. Handler (a -> b) -> Handler a -> Handler b
$cliftA2 :: forall a b c. (a -> b -> c) -> Handler a -> Handler b -> Handler c
liftA2 :: forall a b c. (a -> b -> c) -> Handler a -> Handler b -> Handler c
$c*> :: forall a b. Handler a -> Handler b -> Handler b
*> :: forall a b. Handler a -> Handler b -> Handler b
$c<* :: forall a b. Handler a -> Handler b -> Handler a
<* :: forall a b. Handler a -> Handler b -> Handler a
Applicative
        , Applicative Handler
Applicative Handler =>
(forall a b. Handler a -> (a -> Handler b) -> Handler b)
-> (forall a b. Handler a -> Handler b -> Handler b)
-> (forall a. a -> Handler a)
-> Monad Handler
forall a. a -> Handler a
forall a b. Handler a -> Handler b -> Handler b
forall a b. Handler a -> (a -> Handler b) -> Handler 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 a b. Handler a -> (a -> Handler b) -> Handler b
>>= :: forall a b. Handler a -> (a -> Handler b) -> Handler b
$c>> :: forall a b. Handler a -> Handler b -> Handler b
>> :: forall a b. Handler a -> Handler b -> Handler b
$creturn :: forall a. a -> Handler a
return :: forall a. a -> Handler a
Monad
        , Monad Handler
Monad Handler => (forall a. IO a -> Handler a) -> MonadIO Handler
forall a. IO a -> Handler a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Handler a
liftIO :: forall a. IO a -> Handler a
MonadIO
        , MonadReader RequestCtx
        , MonadIO Handler
MonadIO Handler =>
(forall b. ((forall a. Handler a -> IO a) -> IO b) -> Handler b)
-> MonadUnliftIO Handler
forall b. ((forall a. Handler a -> IO a) -> IO b) -> Handler b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall b. ((forall a. Handler a -> IO a) -> IO b) -> Handler b
withRunInIO :: forall b. ((forall a. Handler a -> IO a) -> IO b) -> Handler b
MonadUnliftIO
        , MonadIO Handler
Handler LogEnv
MonadIO Handler =>
Handler LogEnv
-> (forall a. (LogEnv -> LogEnv) -> Handler a -> Handler a)
-> Katip Handler
forall a. (LogEnv -> LogEnv) -> Handler a -> Handler a
forall (m :: * -> *).
MonadIO m =>
m LogEnv -> (forall a. (LogEnv -> LogEnv) -> m a -> m a) -> Katip m
$cgetLogEnv :: Handler LogEnv
getLogEnv :: Handler LogEnv
$clocalLogEnv :: forall a. (LogEnv -> LogEnv) -> Handler a -> Handler a
localLogEnv :: forall a. (LogEnv -> LogEnv) -> Handler a -> Handler a
Katip
        , Katip Handler
Handler Namespace
Handler LogContexts
Katip Handler =>
Handler LogContexts
-> (forall a.
    (LogContexts -> LogContexts) -> Handler a -> Handler a)
-> Handler Namespace
-> (forall a. (Namespace -> Namespace) -> Handler a -> Handler a)
-> KatipContext Handler
forall a. (Namespace -> Namespace) -> Handler a -> Handler a
forall a. (LogContexts -> LogContexts) -> Handler a -> Handler a
forall (m :: * -> *).
Katip m =>
m LogContexts
-> (forall a. (LogContexts -> LogContexts) -> m a -> m a)
-> m Namespace
-> (forall a. (Namespace -> Namespace) -> m a -> m a)
-> KatipContext m
$cgetKatipContext :: Handler LogContexts
getKatipContext :: Handler LogContexts
$clocalKatipContext :: forall a. (LogContexts -> LogContexts) -> Handler a -> Handler a
localKatipContext :: forall a. (LogContexts -> LogContexts) -> Handler a -> Handler a
$cgetKatipNamespace :: Handler Namespace
getKatipNamespace :: Handler Namespace
$clocalKatipNamespace :: forall a. (Namespace -> Namespace) -> Handler a -> Handler a
localKatipNamespace :: forall a. (Namespace -> Namespace) -> Handler a -> Handler a
KatipContext
        )

{- | Run a 'Handler' against the 'RequestCtx' dispatch built for the request and the
@katip@ logging environment and initial context the dispatch boundary supplies,
yielding the underlying 'IO' action the server's continuation runs in. This is the
boundary where the serve path's 'Handler' code is discharged to 'IO'.

The 'LogEnv' (the structured-log scribes) and the initial context payload are passed
in rather than read from the runtime, so the application owns the log stream and the
trace-correlation @dd@ enrichment: it resolves the @dd@ object for the request and
hands it here as the initial context, so every line a handler emits carries @dd@ for
trace-to-log correlation. A handler narrows the namespace or adds package\/version\/rule
context with @katip@'s combinators on top as it logs.
-}
runHandler :: LogEnv -> SimpleLogPayload -> RequestCtx -> Handler a -> IO a
runHandler :: forall a.
LogEnv -> SimpleLogPayload -> RequestCtx -> Handler a -> IO a
runHandler LogEnv
logEnv SimpleLogPayload
initialContext RequestCtx
ctx Handler a
action =
    LogEnv
-> SimpleLogPayload -> Namespace -> KatipContextT IO a -> IO a
forall c (m :: * -> *) a.
LogItem c =>
LogEnv -> c -> Namespace -> KatipContextT m a -> m a
runKatipContextT LogEnv
logEnv SimpleLogPayload
initialContext Namespace
forall a. Monoid a => a
mempty (ReaderT RequestCtx (KatipContextT IO) a
-> RequestCtx -> KatipContextT IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Handler a -> ReaderT RequestCtx (KatipContextT IO) a
forall a. Handler a -> ReaderT RequestCtx (KatipContextT IO) a
unHandler Handler a
action) RequestCtx
ctx)