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

{- | The start-up every @ecluse@ command runs: the process perimeter, the boot environment, the
executable plan, and the role behaviour that plan carries. The caller chooses the adapter resolver
each mount binds through. The shipped executable passes 'mountBindingFor'. The load harness passes a
loopback resolver, so the proxy it measures boots through this code.
-}
module Ecluse.Startup (runWith) where

import Data.Text.IO qualified as TIO

import Ecluse.Boot
import Ecluse.CLI (AppCommand (..))
import Ecluse.CheckConfig (runCheckConfig)
import Ecluse.Composition (ResolveAdapter)
import Ecluse.Composition.BootError (renderAdvisory, renderBootErrors)
import Ecluse.Composition.Credential (initTargetCredentialProviders)
import Ecluse.Composition.Executable (
    PrunerWiring,
    RoleWiring (MirrorPipelineWiring, PilotWiring, StorePrunerWiring),
    epRoleWiring,
    planExecutable,
 )
import Ecluse.Composition.Maintenance (storeBuilds)
import Ecluse.Composition.Plan (BootPlan (bpS3Endpoint))
import Ecluse.Composition.Types (
    BootRole (BootMirrorPipeline, BootWithoutPipeline),
    MirrorRole (MirrorOnly, ServeAndMirror, ServeOnly),
 )
import Ecluse.Dredger (runDredger)
import Ecluse.Dredger.Plan (DredgerOptions (doMode), dredgerBootRole)
import Ecluse.Internal (ProcessOutcome (ServiceExited, ShutdownRequested), exitCodeFor, exitReasonFor, superviseProcess)
import Ecluse.Mirror
import Ecluse.Pilot
import Ecluse.Proxy
import Ecluse.Runtime.Telemetry.Tracing (tracingPortOf)
import Ecluse.Service

-- | Start one command under the process perimeter, then exit with the status its ending owns.
runWith :: ResolveAdapter -> AppCommand -> IO ()
runWith :: ResolveAdapter -> AppCommand -> IO ()
runWith ResolveAdapter
resolveAdapter AppCommand
cmd = do
    outcome <- IO ProcessOutcome -> IO ProcessOutcome
superviseProcess (ResolveAdapter -> AppCommand -> IO ProcessOutcome
runCommand ResolveAdapter
resolveAdapter AppCommand
cmd)
    -- A non-zero status is representable only beside its reason, so reporting here covers
    -- every one of them.
    traverse_ (TIO.hPutStrLn stderr) (exitReasonFor outcome)
    exitWith (exitCodeFor outcome)

{- Each arm names its role once, and the plan carries it from there. check-config runs outside
'withBootEnv': no logger, no services. -}
runCommand :: ResolveAdapter -> AppCommand -> IO ProcessOutcome
runCommand :: ResolveAdapter -> AppCommand -> IO ProcessOutcome
runCommand ResolveAdapter
resolveAdapter = \case
    AppCommand
RunCheckConfig -> IO () -> IO ProcessOutcome
shutdownAfter IO ()
runCheckConfig
    RunService MirrorRole
role -> BootRole -> (BootEnv -> IO ProcessOutcome) -> IO ProcessOutcome
forall a. BootRole -> (BootEnv -> IO a) -> IO a
withBootEnv (MirrorRole -> BootRole
BootMirrorPipeline MirrorRole
role) (ResolveAdapter
-> Maybe DredgerOptions -> BootEnv -> IO ProcessOutcome
startPlannedRole ResolveAdapter
resolveAdapter Maybe DredgerOptions
forall {a}. Maybe a
noDredgerOptions)
    AppCommand
RunPilot -> BootRole -> (BootEnv -> IO ProcessOutcome) -> IO ProcessOutcome
forall a. BootRole -> (BootEnv -> IO a) -> IO a
withBootEnv BootRole
BootWithoutPipeline (ResolveAdapter
-> Maybe DredgerOptions -> BootEnv -> IO ProcessOutcome
startPlannedRole ResolveAdapter
resolveAdapter Maybe DredgerOptions
forall {a}. Maybe a
noDredgerOptions)
    -- The flags settle which store role the process boots under, so the vetting pass below runs
    -- for the authority this invocation will hold.
    RunDredger DredgerOptions
opts -> BootRole -> (BootEnv -> IO ProcessOutcome) -> IO ProcessOutcome
forall a. BootRole -> (BootEnv -> IO a) -> IO a
withBootEnv (SweepMode -> BootRole
dredgerBootRole (DredgerOptions -> SweepMode
doMode DredgerOptions
opts)) (ResolveAdapter
-> Maybe DredgerOptions -> BootEnv -> IO ProcessOutcome
startPlannedRole ResolveAdapter
resolveAdapter (DredgerOptions -> Maybe DredgerOptions
forall a. a -> Maybe a
Just DredgerOptions
opts))
    -- A one-shot compile vets under the Pilot's role and then does its own work rather than
    -- that role's long-running one, so it is the one boot whose behaviour the plan cannot name.
    RunPilotCompile PilotCompileOptions
opts ->
        BootRole -> (BootEnv -> IO ProcessOutcome) -> IO ProcessOutcome
forall a. BootRole -> (BootEnv -> IO a) -> IO a
withBootEnv BootRole
BootWithoutPipeline ((BootEnv -> IO ProcessOutcome) -> IO ProcessOutcome)
-> (BootEnv -> IO ProcessOutcome) -> IO ProcessOutcome
forall a b. (a -> b) -> a -> b
$ \BootEnv
bootEnv ->
            IO () -> IO ProcessOutcome
shutdownAfter (IO FilePath -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LogEnv
-> Telemetry
-> Maybe AwsEndpoint
-> Config
-> PilotCompileOptions
-> IO FilePath
runPilotCompile (BootEnv -> LogEnv
beLogEnv BootEnv
bootEnv) (BootEnv -> Telemetry
beTelemetry BootEnv
bootEnv) (BootPlan -> Maybe AwsEndpoint
bpS3Endpoint (BootEnv -> BootPlan
beBootPlan BootEnv
bootEnv)) (BootEnv -> Config
beConfig BootEnv
bootEnv) PilotCompileOptions
opts))
  where
    -- Only 'RunDredger' carries sweep options, and only it boots the deleting role.
    noDredgerOptions :: Maybe a
noDredgerOptions = Maybe a
forall {a}. Maybe a
Nothing

{- Plan the role's runtime, then start the behaviour that plan carries. Every role plans through
the one phase, so this is where a boot spends its last refusal whichever role it started. -}
startPlannedRole :: ResolveAdapter -> Maybe DredgerOptions -> BootEnv -> IO ProcessOutcome
startPlannedRole :: ResolveAdapter
-> Maybe DredgerOptions -> BootEnv -> IO ProcessOutcome
startPlannedRole ResolveAdapter
resolveAdapter Maybe DredgerOptions
dredgerOptions BootEnv
bootEnv = do
    (advisories, outcome) <-
        LogEnv
-> TracingPort
-> ResolveAdapter
-> BuildMirrorQueue
-> BuildCredentials
-> StoreBuilds
-> BootPlan
-> IO ([Advisory], Either [BootError] ExecutablePlan)
planExecutable
            (BootEnv -> LogEnv
beLogEnv BootEnv
bootEnv)
            (Telemetry -> TracingPort
tracingPortOf (BootEnv -> Telemetry
beTelemetry BootEnv
bootEnv))
            ResolveAdapter
resolveAdapter
            BuildMirrorQueue
buildMirrorQueue
            BuildCredentials
initTargetCredentialProviders
            StoreBuilds
storeBuilds
            (BootEnv -> BootPlan
beBootPlan BootEnv
bootEnv)
    -- A finding about a configuration that will not start is still one its operator must act on,
    -- so this reports beside the refusal rather than instead of it.
    traverse_ (logBootWarning (beLogEnv bootEnv) . renderAdvisory) advisories
    plan <- orExit renderBootErrors outcome
    case epRoleWiring plan of
        MirrorPipelineWiring MirrorWiring
mirror -> IO () -> IO ProcessOutcome
shutdownAfter (BootEnv
-> ExecutablePlan
-> MirrorWiring
-> (ServiceRuntime -> IO ())
-> IO ()
withServiceRuntime BootEnv
bootEnv ExecutablePlan
plan MirrorWiring
mirror ServiceRuntime -> IO ()
runMirrorPipeline)
        -- Only 'RunDredger' names a store role, so it is the only command that reaches here and
        -- the options it settled are always in hand.
        StorePrunerWiring PrunerWiring
pruner -> IO ProcessOutcome
-> (DredgerOptions -> IO ProcessOutcome)
-> Maybe DredgerOptions
-> IO ProcessOutcome
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ProcessOutcome -> IO ProcessOutcome
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProcessOutcome
ShutdownRequested) (BootEnv -> PrunerWiring -> DredgerOptions -> IO ProcessOutcome
sweepUnder BootEnv
bootEnv PrunerWiring
pruner) Maybe DredgerOptions
dredgerOptions
        PilotWiring ExportLoopPlan
exportPlan -> IO () -> IO ProcessOutcome
shutdownAfter (BootEnv -> ExportLoopPlan -> IO ()
runPilot BootEnv
bootEnv ExportLoopPlan
exportPlan)

{- Run the Dredger and report what it ended on. A one-shot cycle that halted is a service ending
rather than a shutdown, so a scheduler reads the outcome from the exit status. -}
sweepUnder :: BootEnv -> PrunerWiring -> DredgerOptions -> IO ProcessOutcome
sweepUnder :: BootEnv -> PrunerWiring -> DredgerOptions -> IO ProcessOutcome
sweepUnder BootEnv
bootEnv PrunerWiring
pruner DredgerOptions
opts = ProcessOutcome
-> (Text -> ProcessOutcome) -> Maybe Text -> ProcessOutcome
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ProcessOutcome
ShutdownRequested Text -> ProcessOutcome
ServiceExited (Maybe Text -> ProcessOutcome)
-> IO (Maybe Text) -> IO ProcessOutcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BootEnv -> DredgerOptions -> PrunerWiring -> IO (Maybe Text)
runDredger BootEnv
bootEnv DredgerOptions
opts PrunerWiring
pruner

shutdownAfter :: IO () -> IO ProcessOutcome
shutdownAfter :: IO () -> IO ProcessOutcome
shutdownAfter IO ()
act = ProcessOutcome
ShutdownRequested ProcessOutcome -> IO () -> IO ProcessOutcome
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO ()
act

{- Pick the entry point the assembled runtime's own role names. Both halves run over the one
assembly, so the dedicated worker composes the wiring the serve path embeds. -}
runMirrorPipeline :: ServiceRuntime -> IO ()
runMirrorPipeline :: ServiceRuntime -> IO ()
runMirrorPipeline ServiceRuntime
runtime = case ServiceRuntime -> MirrorRole
svcRole ServiceRuntime
runtime of
    MirrorRole
MirrorOnly -> ServiceRuntime -> IO ()
runMirror ServiceRuntime
runtime
    MirrorRole
ServeAndMirror -> ServiceRuntime -> IO ()
runProxy ServiceRuntime
runtime
    MirrorRole
ServeOnly -> ServiceRuntime -> IO ()
runProxy ServiceRuntime
runtime