module Ecluse.Dredger (
    runDredger,
    dredgerApplication,
) where

import Katip (Severity (InfoS), logFM, ls)
import Katip.Monadic (runKatipContextT)
import Network.Wai (Application)

import Ecluse.Boot (BootEnv (..))
import Ecluse.Config (AppConfig (cfgPort))
import Ecluse.Log (moduleField)
import Ecluse.Server (ServerConfig (scCheckReady, scDrain, scPort), mkServerConfig, probeApplication, runWarp, serverMiddleware)

{- | The WAI application for the Dredger worker mode.
It exposes liveness and readiness probes.
-}
dredgerApplication :: ServerConfig -> IO Application
dredgerApplication :: ServerConfig -> IO Application
dredgerApplication ServerConfig
cfg = Application -> IO Application
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerConfig -> Middleware
serverMiddleware ServerConfig
cfg (DrainSignal -> IO Bool -> IO Bool -> Application
probeApplication (ServerConfig -> DrainSignal
scDrain ServerConfig
cfg) (ServerConfig -> IO Bool
scCheckReady ServerConfig
cfg) (Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)))

{- | The entry point for the Dredger worker mode.
Dredger runs as a standalone HTTP server that only exposes liveness and readiness
probes. Its actual worker loop will clean up upstream mirrors.
-}
runDredger :: BootEnv -> IO ()
runDredger :: BootEnv -> IO ()
runDredger BootEnv
bootEnv = do
    let logEnv :: LogEnv
logEnv = BootEnv -> LogEnv
beLogEnv BootEnv
bootEnv
        port :: Int
port = AppConfig -> Int
cfgPort (BootEnv -> AppConfig
beConfig BootEnv
bootEnv)
        cfg :: ServerConfig
cfg = ([MountBinding] -> ServerConfig
mkServerConfig []){scPort = port}

    LogEnv
-> SimpleLogPayload -> Namespace -> KatipContextT IO () -> IO ()
forall c (m :: * -> *) a.
LogItem c =>
LogEnv -> c -> Namespace -> KatipContextT m a -> m a
runKatipContextT LogEnv
logEnv (Text -> SimpleLogPayload
moduleField Text
"Ecluse.Dredger") Namespace
forall a. Monoid a => a
mempty (KatipContextT IO () -> IO ()) -> KatipContextT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Severity -> LogStr -> KatipContextT IO ()
forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
logFM Severity
InfoS (String -> LogStr
forall a. StringConv a Text => a -> LogStr
ls (String
"Dredger mode starting up on port " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
port :: String))

    ServerConfig -> IO Application -> IO ()
runWarp ServerConfig
cfg (ServerConfig -> IO Application
dredgerApplication ServerConfig
cfg)