-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | The composition root: the single record every effectful component is reached through, and
the one place backend choice is resolved. Each handle it holds is an opaque record of functions
whose closures already capture their backend's private state, so no cloud SDK appears here and
nothing downstream inspects which backend it got. That is what keeps an adapter from importing
back into this module. It also carries the @http-client@ 'Manager' the data plane shares. The
single-process proxy and the split deployment both wire up here and nowhere else. Consumers
read it through a projection: 'serveRuntimeOf' per request, 'workerRuntimeOf' for the worker.
-}
module Ecluse.Runtime.Env (
    -- * Composition root
    Env (..),
    newEnvWithAdmission,
    withEnvWithAdmission,

    -- * Runtime projections
    serveRuntimeOf,
    workerRuntimeOf,

    -- * Worker heartbeat (re-exported from "Ecluse.Core.Worker")
    WorkerHeartbeat,
    newWorkerHeartbeat,
    recordPoll,
    lastPoll,
) where

import Katip (LogEnv, katipAddContext)
import Network.HTTP.Client (Manager)

import Ecluse.Core.Queue (MirrorQueue)
import Ecluse.Core.Server.Admission (ServeAdmission)
import Ecluse.Core.Server.Admission.Meter (MemoryMeter)
import Ecluse.Core.Server.Cache (MetadataCache)
import Ecluse.Core.Server.Context (ServeRuntime (..))
import Ecluse.Core.Worker (WorkerHeartbeat, WorkerPolicies, WorkerRuntime (..), lastPoll, newWorkerHeartbeat, recordPoll)
import Ecluse.Runtime.Log (DdContext)
import Ecluse.Runtime.Telemetry (Telemetry)
import Ecluse.Runtime.Telemetry.Correlation (ddIdentityFromEnvironment, ddPayloadNow)
import Ecluse.Runtime.Telemetry.Instruments (Metrics, metricsPortOf, newMetrics, workerMetricsPortOf)
import Ecluse.Runtime.Telemetry.Tracing (tracingPortOf, workerTracingPortOf)

-- | The composition-root record from which the whole effectful shell is reached.
data Env = Env
    { Env -> ServeAdmission
envServeAdmission :: ServeAdmission
    {- ^ The process-wide brief-wait bound for metadata-bearing serve work
    ("Ecluse.Core.Server.Admission"). Every mount shares this one aggregate cap and waiting room.
    -}
    , Env -> MemoryMeter
envMemoryMeter :: MemoryMeter
    -- ^ The process-wide memory budget every serving mount pays into.
    , Env -> MirrorQueue
envQueue :: MirrorQueue
    {- ^ The mirror-queue handle: the durable hand-off from the request path to the
    mirror worker.
    -}
    , Env -> Manager
envManager :: Manager
    {- ^ The shared validating-TLS 'Manager' for the __untrusted__ data plane. Egress is https-only,
    so certificate validation authenticates the host a @dist.tarball@ names.
    -}
    , Env -> Manager
envPrivateManager :: Manager
    {- ^ The 'Manager' for the __trusted__ private upstream, held to the same https-only
    requirement. The split stays because credential handling differs.
    -}
    , Env -> MetadataCache
envMetadataCache :: MetadataCache
    -- ^ Selected-version and assembled retention with transient full-read coalescing.
    , Env -> LogEnv
envLogEnv :: LogEnv
    {- ^ The @katip@ logging environment (see "Ecluse.Runtime.Log"): the structured-log stream
    every layer attaches context to. Its stdout scribe and format are chosen at startup.
    -}
    , Env -> Telemetry
envTelemetry :: Telemetry
    {- ^ The OpenTelemetry handle ("Ecluse.Runtime.Telemetry") that emits spans and metrics.
    It is an inert no-op unless @ECLUSE_OBSERVABILITY__TELEMETRY@ is set.
    -}
    , Env -> Metrics
envMetrics :: Metrics
    {- ^ The @ecluse.*@ metric instruments ("Ecluse.Runtime.Telemetry.Instruments"), built once
    from 'envTelemetry'. They are inert when telemetry is off, so a layer records unconditionally.
    -}
    , Env -> DdContext
envDdContext :: DdContext
    {- ^ The resolved @dd@ log identity (@service@\/@env@\/@version@, see
    "Ecluse.Runtime.Telemetry.Correlation"). Each log line adds the active span's trace\/span ids.
    -}
    , Env -> WorkerHeartbeat
envWorkerHeartbeat :: WorkerHeartbeat
    {- ^ The time of the mirror worker's last successful poll ("Ecluse.Core.Worker"). The liveness
    probe reads it, so a stalled worker shows up in health, separately from HTTP readiness.
    -}
    }

{- | Assemble an 'Env' from its built handles and the two data-plane 'Manager's, one per origin.
The caller supplies each handle and owns its lifetime, so assembly opens no socket itself.
-}
newEnvWithAdmission :: ServeAdmission -> MemoryMeter -> MirrorQueue -> Manager -> Manager -> MetadataCache -> LogEnv -> Telemetry -> WorkerHeartbeat -> IO Env
newEnvWithAdmission :: ServeAdmission
-> MemoryMeter
-> MirrorQueue
-> Manager
-> Manager
-> MetadataCache
-> LogEnv
-> Telemetry
-> WorkerHeartbeat
-> IO Env
newEnvWithAdmission ServeAdmission
admission MemoryMeter
meter MirrorQueue
queue Manager
manager Manager
privateManager MetadataCache
metadataCache LogEnv
logEnv Telemetry
telemetry WorkerHeartbeat
heartbeat = do
    metrics <- Telemetry -> IO Metrics
newMetrics Telemetry
telemetry
    -- The dd log identity comes from the (already-normalised) OTEL_* environment, the
    -- same precedence table the exporter uses, so logs and traces share one identity.
    ddContext <- ddIdentityFromEnvironment
    pure
        Env
            { envServeAdmission = admission
            , envMemoryMeter = meter
            , envQueue = queue
            , envManager = manager
            , envPrivateManager = privateManager
            , envMetadataCache = metadataCache
            , envLogEnv = logEnv
            , envTelemetry = telemetry
            , envMetrics = metrics
            , envDdContext = ddContext
            , envWorkerHeartbeat = heartbeat
            }

{- | Assemble an 'Env' and run an action in its scope, the scope the server and worker run in.
The root borrows every resource it holds, so it has nothing to release and needs no bracket.
-}
withEnvWithAdmission ::
    (MonadIO m) =>
    ServeAdmission ->
    MemoryMeter ->
    MirrorQueue ->
    Manager ->
    Manager ->
    MetadataCache ->
    LogEnv ->
    Telemetry ->
    WorkerHeartbeat ->
    (Env -> m a) ->
    m a
withEnvWithAdmission :: forall (m :: * -> *) a.
MonadIO m =>
ServeAdmission
-> MemoryMeter
-> MirrorQueue
-> Manager
-> Manager
-> MetadataCache
-> LogEnv
-> Telemetry
-> WorkerHeartbeat
-> (Env -> m a)
-> m a
withEnvWithAdmission ServeAdmission
admission MemoryMeter
meter MirrorQueue
queue Manager
manager Manager
privateManager MetadataCache
metadataCache LogEnv
logEnv Telemetry
telemetry WorkerHeartbeat
heartbeat Env -> m a
action = do
    env <- IO Env -> m Env
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ServeAdmission
-> MemoryMeter
-> MirrorQueue
-> Manager
-> Manager
-> MetadataCache
-> LogEnv
-> Telemetry
-> WorkerHeartbeat
-> IO Env
newEnvWithAdmission ServeAdmission
admission MemoryMeter
meter MirrorQueue
queue Manager
manager Manager
privateManager MetadataCache
metadataCache LogEnv
logEnv Telemetry
telemetry WorkerHeartbeat
heartbeat)
    action env

{- | Project the 'ServeRuntime' the serve path closes over, built per request at dispatch.
The core pipeline reads its backends through it without depending on this application 'Env'.
-}
serveRuntimeOf :: Env -> ServeRuntime
serveRuntimeOf :: Env -> ServeRuntime
serveRuntimeOf Env
env =
    ServeRuntime
        { srAdmission :: ServeAdmission
srAdmission = Env -> ServeAdmission
envServeAdmission Env
env
        , srMemoryMeter :: MemoryMeter
srMemoryMeter = Env -> MemoryMeter
envMemoryMeter Env
env
        , srPublicManager :: Manager
srPublicManager = Env -> Manager
envManager Env
env
        , srPrivateManager :: Manager
srPrivateManager = Env -> Manager
envPrivateManager Env
env
        , srMetadataCache :: MetadataCache
srMetadataCache = Env -> MetadataCache
envMetadataCache Env
env
        , srQueue :: MirrorQueue
srQueue = Env -> MirrorQueue
envQueue Env
env
        , srMetrics :: MetricsPort
srMetrics = Metrics -> MetricsPort
metricsPortOf (Env -> Metrics
envMetrics Env
env)
        , srTracing :: TracingPort
srTracing = Telemetry -> TracingPort
tracingPortOf (Env -> Telemetry
envTelemetry Env
env)
        }

{- | Project the 'WorkerRuntime' the mirror worker closes over. 'WorkerPolicies' is an argument
because it derives from the served mounts, and the worker re-runs it through the serve gate.
-}
workerRuntimeOf :: WorkerPolicies -> Env -> WorkerRuntime
workerRuntimeOf :: WorkerPolicies -> Env -> WorkerRuntime
workerRuntimeOf WorkerPolicies
policies Env
env =
    WorkerRuntime
        { wrQueue :: MirrorQueue
wrQueue = Env -> MirrorQueue
envQueue Env
env
        , wrManager :: Manager
wrManager = Env -> Manager
envManager Env
env
        , wrHeartbeat :: WorkerHeartbeat
wrHeartbeat = Env -> WorkerHeartbeat
envWorkerHeartbeat Env
env
        , wrMetrics :: WorkerMetricsPort
wrMetrics = Metrics -> WorkerMetricsPort
workerMetricsPortOf (Env -> Metrics
envMetrics Env
env)
        , wrTracing :: WorkerTracingPort
wrTracing = Telemetry -> WorkerTracingPort
workerTracingPortOf (Env -> Telemetry
envTelemetry Env
env)
        , wrInjectTraceContext :: forall (m :: * -> *) a. (KatipContext m, MonadIO m) => m a -> m a
wrInjectTraceContext = \m a
action -> do
            dd <- IO SimpleLogPayload -> m SimpleLogPayload
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SimpleLogPayload -> m SimpleLogPayload)
-> IO SimpleLogPayload -> m SimpleLogPayload
forall a b. (a -> b) -> a -> b
$ DdContext -> IO SimpleLogPayload
forall (m :: * -> *). MonadIO m => DdContext -> m SimpleLogPayload
ddPayloadNow (Env -> DdContext
envDdContext Env
env)
            katipAddContext dd action
        , wrPolicies :: WorkerPolicies
wrPolicies = WorkerPolicies
policies
        }