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

{- | The dedicated mirror-worker role, for a fleet scaled on queue depth apart from the front door.
It runs the same 'Ecluse.Service.runWorker' the proxy role embeds, and serves only the health
probes, so an orchestrator can judge the pod without the process holding a request surface.
-}
module Ecluse.Mirror (
    runMirror,
    mirrorServerConfig,
) where

import Katip (Severity (InfoS))
import UnliftIO (concurrently_)
import UnliftIO.Async (mapConcurrently_)

import Ecluse.Boot (probeServerConfig)
import Ecluse.Config (AppConfig)
import Ecluse.Core.Server.Readiness (Readiness)
import Ecluse.Core.Worker (Liveness)
import Ecluse.Runtime.Env (envLogEnv)
import Ecluse.Runtime.Log (moduleLog)
import Ecluse.Runtime.Server (
    ServerConfig (scCheckLive, scCheckReady),
    probeOnlyApplication,
    raceServerAgainstLoop,
    runWarp,
 )
import Ecluse.Service (ServiceRuntime (..), runWorker)

{- | Run the mirror worker alone. The consume loop and the sync tasks never return, so the
probe server's graceful return on shutdown must cancel them.
-}
runMirror :: ServiceRuntime -> IO ()
runMirror :: ServiceRuntime -> IO ()
runMirror ServiceRuntime
runtime = do
    let env :: Env
env = ServiceRuntime -> Env
svcEnv ServiceRuntime
runtime
        cfg :: ServerConfig
cfg = AppConfig -> IO Readiness -> IO Liveness -> ServerConfig
mirrorServerConfig (ServiceRuntime -> AppConfig
svcAppConfig ServiceRuntime
runtime) (ServiceRuntime -> IO Readiness
svcCheckReady ServiceRuntime
runtime) (ServiceRuntime -> IO Liveness
svcCheckLive ServiceRuntime
runtime)
    LogEnv -> Text -> Severity -> Text -> IO ()
moduleLog (Env -> LogEnv
envLogEnv Env
env) Text
"Ecluse.Mirror" Severity
InfoS Text
"Mirror worker starting up"
    IO () -> IO () -> IO ()
forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
raceServerAgainstLoop
        (LogEnv
-> Text
-> ServerConfig
-> (ServerConfig -> IO Application)
-> IO ()
runWarp (Env -> LogEnv
envLogEnv Env
env) Text
"mirror worker health probes" ServerConfig
cfg ServerConfig -> IO Application
probeOnlyApplication)
        (IO () -> IO () -> IO ()
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m ()
concurrently_ (WorkerPolicies -> Env -> IO ()
runWorker (ServiceRuntime -> WorkerPolicies
svcWorkerPolicies ServiceRuntime
runtime) Env
env) ((IO () -> IO ()) -> [IO ()] -> IO ()
forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
mapConcurrently_ IO () -> IO ()
forall a. a -> a
id (ServiceRuntime -> [IO ()]
svcSyncTasks ServiceRuntime
runtime)))

{- | The dedicated worker's health surface: no mount, the shared @server.port@, and the
consume-loop heartbeat behind @\/livez@ so a stalled worker fails its own liveness check.
-}
mirrorServerConfig :: AppConfig -> IO Readiness -> IO Liveness -> ServerConfig
mirrorServerConfig :: AppConfig -> IO Readiness -> IO Liveness -> ServerConfig
mirrorServerConfig AppConfig
appConfig IO Readiness
checkReady IO Liveness
checkLive =
    (AppConfig -> ServerConfig
probeServerConfig AppConfig
appConfig){scCheckReady = checkReady, scCheckLive = checkLive}