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

{- | The boot's config-decidable tier: one pure pass from the loaded configuration to every
decision a role settles without touching its environment again, plus the ordered lines that
report them. The boot logs those lines and the dry-run checker prints the same ones, so every
refusal here is one 'Ecluse.CheckConfig.runCheckConfig' reaches too.
-}
module Ecluse.Composition.Plan (
    -- * The config-decidable tier
    BootInputs (..),
    BootReport (brProvenance, brAdvisories, brOutcome),
    BootPlan (
        bpRole,
        bpValidated,
        bpMirrorRuntime,
        bpMemoryPlan,
        bpLimits,
        bpCacheConfig,
        bpS3Endpoint,
        bpPrivateConnections,
        bpPublicConnections,
        bpLines,
        bpWarnings
    ),
    resolveBootPlan,
    roleRefusalWarnings,

    -- * Locating the configuration document
    defaultConfigPath,
    explicitConfigPath,
    configDocumentPath,
) where

import Data.List (lookup)
import Data.Map.Strict qualified as Map

import Ecluse.Composition.BootError (
    Advisory,
    BootError (AwsEndpointMalformed, MemoryPlanOverrideUnsafe),
    renderBootError,
 )
import Ecluse.Composition.MemoryPlan (
    MemoryPlan (mpDegradations, mpMaxResponseBytes, mpOverrideViolations, mpQueueMemoryMaxDepth),
    planCacheConfig,
    queueTenantDemand,
    resolveMemoryPlan,
 )
import Ecluse.Composition.MirrorQueue (
    MirrorQueuePlan (MemoryBackend, SqsBackend),
    MirrorRuntimePlan (MirrorWith, NoMirroring),
    mirrorQueuePlanWarning,
    planMirrorRuntime,
 )
import Ecluse.Composition.MirrorRole (mirrorRoleRefusal)
import Ecluse.Composition.Sizing (resolvePrivateConnections, resolvePublicConnections)
import Ecluse.Composition.Types (BootRole (BootWithoutPipeline), bootInvocation, everyBootRole, pipelineRoleOf, registryRoleOf)
import Ecluse.Composition.Validate (ValidatedPlan (vpProgressFloor), vetBoot)
import Ecluse.Composition.Vet (decided, runVet)
import Ecluse.Config (
    AppConfig (cfgAdvisories, cfgCache, cfgLimits, cfgMounts, cfgQueue, cfgRuntime),
    Config (configApp),
    LimitsSettings (limMaxArtifactCount, limMaxNestingDepth, limMaxVersionCount),
    MountConfig (mntPublicationTarget),
    RuntimeSettings (rtPrivateConnectionsPerHost, rtPublicConnectionsPerHost, rtServeMaxInFlight),
    advisoryAgeLines,
    advisoryEpssLines,
    mountPostureLines,
    resolvedKeyProvenance,
 )
import Ecluse.Config.Ambient (AmbientAws, ambientAwsFromEnv, ambientS3Endpoint)
import Ecluse.Core.Security (Limits (..), defaultLimits)
import Ecluse.Core.Server.Cache (CacheConfig)
import Ecluse.Core.Text (nonBlank)
import Ecluse.Pilot.Plan (epssAttemptLine)
import Ecluse.Rts (EffectiveRuntimePlan)
import Ecluse.Runtime.Aws.Env (AwsEndpoint)
import Ecluse.Runtime.Queue.Sqs (SqsConfig (sqsQueueUrl, sqsRegion))

{- | What the pure tier reads: the loaded configuration, the layers it came from, and the process
facts a boot measured before any decision. Nothing past this is read from the environment again.
-}
data BootInputs = BootInputs
    { BootInputs -> [(String, String)]
biEnvVars :: [(String, String)]
    -- ^ The process environment, for the provenance lines and the ambient AWS override.
    , BootInputs -> Maybe ByteString
biDocument :: Maybe ByteString
    -- ^ The config document's bytes, absent where none exists at the resolved path.
    , BootInputs -> Config
biConfig :: Config
    -- ^ The loaded configuration every rule vets.
    , BootInputs -> EffectiveRuntimePlan
biRuntimePlan :: EffectiveRuntimePlan
    -- ^ The runtime posture every byte-valued bound is sized against.
    , BootInputs -> Int
biFdLimit :: Int
    -- ^ The open-file soft limit both connection-pool sizes are computed from.
    }

{- | What one role's pass reported. Every field comes back on the refusing path too, so a refusal
naming a config key stays traceable and an advisory beside it is not lost with the plan.
-}
data BootReport = BootReport
    { BootReport -> [Text]
brProvenance :: [Text]
    -- ^ The config-document line and the per-key provenance lines, reported ahead of any refusal.
    , BootReport -> [Advisory]
brAdvisories :: [Advisory]
    -- ^ The advisories the vetting pass logged, whatever it decided.
    , BootReport -> Either [BootError] BootPlan
brOutcome :: Either [BootError] BootPlan
    -- ^ Every refusal the role earned, or the decisions it cleared.
    }

{- | What a boot resolves: the role it starts, the decisions that role applies, and the lines
both entry points report in the order they hold here.
-}
data BootPlan = BootPlan
    { BootPlan -> BootRole
bpRole :: BootRole
    {- ^ The role the pass vetted under, which a boot also selects its behaviour from, so the
    severities it cleared and the behaviour it runs name one role.
    -}
    , BootPlan -> ValidatedPlan
bpValidated :: ValidatedPlan
    -- ^ What the pure pass cleared: the mounts, the endpoints, and the settings no rule vets.
    , BootPlan -> MirrorRuntimePlan
bpMirrorRuntime :: MirrorRuntimePlan
    -- ^ Whether a mirror runtime runs at all, and which queue backend carries it.
    , BootPlan -> MemoryPlan
bpMemoryPlan :: MemoryPlan
    -- ^ The heap partition every byte-valued bound comes from.
    , BootPlan -> Limits
bpLimits :: Limits
    -- ^ The request-shape bounds every mount serves under.
    , BootPlan -> CacheConfig
bpCacheConfig :: CacheConfig
    -- ^ The metadata cache's shared bounds and per-store eviction floors.
    , BootPlan -> Maybe AwsEndpoint
bpS3Endpoint :: Maybe AwsEndpoint
    -- ^ The @AWS_ENDPOINT_URL@ override the S3 advisory client dials. A malformed one refused the boot.
    , BootPlan -> Int
bpPrivateConnections :: Int
    -- ^ The private-upstream connection-pool size.
    , BootPlan -> Int
bpPublicConnections :: Int
    -- ^ The public-upstream connection-pool size.
    , BootPlan -> [Text]
bpLines :: [Text]
    -- ^ The information lines after the provenance block, in emission order.
    , BootPlan -> [Text]
bpWarnings :: [Text]
    -- ^ The warning lines, in emission order.
    }

{- | Decide everything one role's boot settles from the configuration alone. @ecluse check-config@
runs this whole tier, and a boot adds no pure refusal of its own past it.
-}
resolveBootPlan :: BootRole -> BootInputs -> BootReport
resolveBootPlan :: BootRole -> BootInputs -> BootReport
resolveBootPlan BootRole
role BootInputs
inputs =
    BootReport
        { brProvenance :: [Text]
brProvenance = [(String, String)] -> Maybe ByteString -> Text
configDocumentLine [(String, String)]
envVars Maybe ByteString
document Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [(String, String)] -> Maybe ByteString -> [Text]
resolvedKeyProvenance [(String, String)]
envVars Maybe ByteString
document
        , brAdvisories :: [Advisory]
brAdvisories = [Advisory]
advisories
        , brOutcome :: Either [BootError] BootPlan
brOutcome = Either [BootError] BootPlan
outcome
        }
  where
    envVars :: [(String, String)]
envVars = BootInputs -> [(String, String)]
biEnvVars BootInputs
inputs
    document :: Maybe ByteString
document = BootInputs -> Maybe ByteString
biDocument BootInputs
inputs
    ([Advisory]
advisories, Either [BootError] BootPlan
outcome) = BootRole -> BootInputs -> ([Advisory], Either [BootError] BootPlan)
planDecisions BootRole
role BootInputs
inputs

{- | Every refusal a role other than @own@ earns from this configuration, each named by the command
that earns it. A checker picks no subcommand, so it reports these beside its own verdict.
-}
roleRefusalWarnings :: BootRole -> BootInputs -> [Text]
roleRefusalWarnings :: BootRole -> BootInputs -> [Text]
roleRefusalWarnings BootRole
own BootInputs
inputs =
    [ BootRole -> Text
bootInvocation BootRole
role Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" would refuse to boot: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BootError -> Text
renderBootError BootError
err
    | BootRole
role <- [BootRole]
everyBootRole
    , BootRole
role BootRole -> BootRole -> Bool
forall a. Eq a => a -> a -> Bool
/= BootRole
own
    , BootError
err <- [BootError] -> Either [BootError] BootPlan -> [BootError]
forall a b. a -> Either a b -> a
fromLeft [] (BootReport -> Either [BootError] BootPlan
brOutcome (BootRole -> BootInputs -> BootReport
resolveBootPlan BootRole
role BootInputs
inputs))
    ]

-- Every decision past the provenance block, joined by '<*>' so every group reports.
planDecisions :: BootRole -> BootInputs -> ([Advisory], Either [BootError] BootPlan)
planDecisions :: BootRole -> BootInputs -> ([Advisory], Either [BootError] BootPlan)
planDecisions BootRole
role BootInputs
inputs =
    (Either
   [BootError] (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)
 -> Either [BootError] BootPlan)
-> ([Advisory],
    Either
      [BootError] (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint))
-> ([Advisory], Either [BootError] BootPlan)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (((ValidatedPlan, MirrorDecision, Maybe AwsEndpoint) -> BootPlan)
-> Either
     [BootError] (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)
-> Either [BootError] BootPlan
forall a b.
(a -> b) -> Either [BootError] a -> Either [BootError] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BootRole
-> BootInputs
-> (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)
-> BootPlan
bootPlanFrom BootRole
role BootInputs
inputs)) (([Advisory],
  Either
    [BootError] (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint))
 -> ([Advisory], Either [BootError] BootPlan))
-> (Vet (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)
    -> ([Advisory],
        Either
          [BootError] (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)))
-> Vet (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)
-> ([Advisory], Either [BootError] BootPlan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegistryRole
-> Vet (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)
-> ([Advisory],
    Either
      [BootError] (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint))
forall a.
RegistryRole -> Vet a -> ([Advisory], Either [BootError] a)
runVet (BootRole -> RegistryRole
registryRoleOf BootRole
role) (Vet (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)
 -> ([Advisory], Either [BootError] BootPlan))
-> Vet (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)
-> ([Advisory], Either [BootError] BootPlan)
forall a b. (a -> b) -> a -> b
$
        (,,)
            (ValidatedPlan
 -> MirrorDecision
 -> Maybe AwsEndpoint
 -> (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint))
-> Vet ValidatedPlan
-> Vet
     (MirrorDecision
      -> Maybe AwsEndpoint
      -> (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Vet ValidatedPlan
vetBoot Config
config
            Vet
  (MirrorDecision
   -> Maybe AwsEndpoint
   -> (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint))
-> Vet MirrorDecision
-> Vet
     (Maybe AwsEndpoint
      -> (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint))
forall a b. Vet (a -> b) -> Vet a -> Vet b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either [BootError] MirrorDecision -> Vet MirrorDecision
forall a. Either [BootError] a -> Vet a
decided (BootRole
-> AmbientAws
-> EffectiveRuntimePlan
-> Config
-> Either [BootError] MirrorDecision
mirrorDecision BootRole
role AmbientAws
ambient (BootInputs -> EffectiveRuntimePlan
biRuntimePlan BootInputs
inputs) Config
config)
            Vet
  (Maybe AwsEndpoint
   -> (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint))
-> Vet (Maybe AwsEndpoint)
-> Vet (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)
forall a b. Vet (a -> b) -> Vet a -> Vet b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either [BootError] (Maybe AwsEndpoint) -> Vet (Maybe AwsEndpoint)
forall a. Either [BootError] a -> Vet a
decided (AmbientAws -> Either [BootError] (Maybe AwsEndpoint)
ambientEndpoint AmbientAws
ambient)
  where
    config :: Config
config = BootInputs -> Config
biConfig BootInputs
inputs
    ambient :: AmbientAws
ambient = [(String, String)] -> AmbientAws
ambientAwsFromEnv (BootInputs -> [(String, String)]
biEnvVars BootInputs
inputs)

{- The ambient @AWS_ENDPOINT_URL@ override the S3 advisory client dials, settled over the same
environment the rest of the pass reads, so it accumulates with the rest rather than after it. -}
ambientEndpoint :: AmbientAws -> Either [BootError] (Maybe AwsEndpoint)
ambientEndpoint :: AmbientAws -> Either [BootError] (Maybe AwsEndpoint)
ambientEndpoint = (Secret -> [BootError])
-> Either Secret (Maybe AwsEndpoint)
-> Either [BootError] (Maybe AwsEndpoint)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (BootError -> [BootError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BootError -> [BootError])
-> (Secret -> BootError) -> Secret -> [BootError]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Secret -> BootError
AwsEndpointMalformed) (Either Secret (Maybe AwsEndpoint)
 -> Either [BootError] (Maybe AwsEndpoint))
-> (AmbientAws -> Either Secret (Maybe AwsEndpoint))
-> AmbientAws
-> Either [BootError] (Maybe AwsEndpoint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmbientAws -> Either Secret (Maybe AwsEndpoint)
ambientS3Endpoint

{- What the mirror pipeline resolved to: the queue backend, the memory plan sized against it, and
that plan's own lines. The memory plan reads the selected backend, so the two resolve together. -}
data MirrorDecision = MirrorDecision
    { MirrorDecision -> MirrorRuntimePlan
mdRuntime :: MirrorRuntimePlan
    , MirrorDecision -> MemoryPlan
mdMemoryPlan :: MemoryPlan
    , MirrorDecision -> [Text]
mdMemoryLines :: [Text]
    }

{- The backend selection precedes the rest, because the queue tenant exists only when that
selection picks the in-memory backend, and the role's fitness is judged against it. -}
mirrorDecision :: BootRole -> AmbientAws -> EffectiveRuntimePlan -> Config -> Either [BootError] MirrorDecision
mirrorDecision :: BootRole
-> AmbientAws
-> EffectiveRuntimePlan
-> Config
-> Either [BootError] MirrorDecision
mirrorDecision BootRole
role AmbientAws
ambient EffectiveRuntimePlan
effective Config
config = do
    runtime <- AmbientAws -> Config -> Either [BootError] MirrorRuntimePlan
planMirrorRuntime AmbientAws
ambient Config
config
    let (memoryPlan, memoryLines) = memoryPlanFor (configApp config) effective runtime
        violations = MemoryPlan -> [Text]
mpOverrideViolations MemoryPlan
memoryPlan
    -- A degraded-but-coherent plan boots, because shrinking is what makes it safe. Only
    -- an explicit override the shed ladder cannot work around refuses.
    case roleRefusals runtime <> [MemoryPlanOverrideUnsafe violations | not (null violations)] of
        [] -> MirrorDecision -> Either [BootError] MirrorDecision
forall a b. b -> Either a b
Right MirrorDecision{mdRuntime :: MirrorRuntimePlan
mdRuntime = MirrorRuntimePlan
runtime, mdMemoryPlan :: MemoryPlan
mdMemoryPlan = MemoryPlan
memoryPlan, mdMemoryLines :: [Text]
mdMemoryLines = [Text]
memoryLines}
        [BootError]
errs -> [BootError] -> Either [BootError] MirrorDecision
forall a b. a -> Either a b
Left [BootError]
errs
  where
    roleRefusals :: MirrorRuntimePlan -> [BootError]
roleRefusals MirrorRuntimePlan
runtime =
        [BootError] -> Either [BootError] () -> [BootError]
forall a b. a -> Either a b -> a
fromLeft [] (Either [BootError] ()
-> (MirrorRole -> Either [BootError] ())
-> Maybe MirrorRole
-> Either [BootError] ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either [BootError] ()
forall a b. b -> Either a b
Right ()) (MirrorRole -> MirrorRuntimePlan -> Either [BootError] ()
`mirrorRoleRefusal` MirrorRuntimePlan
runtime) (BootRole -> Maybe MirrorRole
pipelineRoleOf BootRole
role))

bootPlanFrom :: BootRole -> BootInputs -> (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint) -> BootPlan
bootPlanFrom :: BootRole
-> BootInputs
-> (ValidatedPlan, MirrorDecision, Maybe AwsEndpoint)
-> BootPlan
bootPlanFrom BootRole
role BootInputs
inputs (ValidatedPlan
validated, MirrorDecision
mirror, Maybe AwsEndpoint
s3Endpoint) =
    BootPlan
        { bpRole :: BootRole
bpRole = BootRole
role
        , bpValidated :: ValidatedPlan
bpValidated = ValidatedPlan
validated
        , bpMirrorRuntime :: MirrorRuntimePlan
bpMirrorRuntime = MirrorDecision -> MirrorRuntimePlan
mdRuntime MirrorDecision
mirror
        , bpMemoryPlan :: MemoryPlan
bpMemoryPlan = MemoryPlan
memoryPlan
        , bpLimits :: Limits
bpLimits =
            Limits
defaultLimits
                { maxMetadataBytes = mpMaxResponseBytes memoryPlan
                , maxVersionCount = limMaxVersionCount (cfgLimits app)
                , maxArtifactCount = limMaxArtifactCount (cfgLimits app)
                , maxNestingDepth = limMaxNestingDepth (cfgLimits app)
                , progressFloor = vpProgressFloor validated
                }
        , bpCacheConfig :: CacheConfig
bpCacheConfig = CacheSettings -> MemoryPlan -> CacheConfig
planCacheConfig (AppConfig -> CacheSettings
cfgCache AppConfig
app) MemoryPlan
memoryPlan
        , bpS3Endpoint :: Maybe AwsEndpoint
bpS3Endpoint = Maybe AwsEndpoint
s3Endpoint
        , bpPrivateConnections :: Int
bpPrivateConnections = Int
privateConnections
        , bpPublicConnections :: Int
bpPublicConnections = Int
publicConnections
        , bpLines :: [Text]
bpLines =
            [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [Text
privateLine, Text
publicLine]
                , MirrorDecision -> [Text]
mdMemoryLines MirrorDecision
mirror
                , Int -> MirrorRuntimePlan -> [Text]
mirrorRuntimeLines (MemoryPlan -> Int
mpQueueMemoryMaxDepth MemoryPlan
memoryPlan) (MirrorDecision -> MirrorRuntimePlan
mdRuntime MirrorDecision
mirror)
                , Config -> [Text]
mountPostureLines Config
config
                , Config -> [Text]
advisoryAgeLines Config
config
                , Config -> [Text]
advisoryEpssLines Config
config
                , [AdvisoriesSettings -> Text
epssAttemptLine (AppConfig -> AdvisoriesSettings
cfgAdvisories AppConfig
app) | BootRole
role BootRole -> BootRole -> Bool
forall a. Eq a => a -> a -> Bool
== BootRole
BootWithoutPipeline]
                ]
        , bpWarnings :: [Text]
bpWarnings = MemoryPlan -> [Text]
mpDegradations MemoryPlan
memoryPlan [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> MirrorRuntimePlan -> [Text]
mirrorRuntimeWarnings (MirrorDecision -> MirrorRuntimePlan
mdRuntime MirrorDecision
mirror)
        }
  where
    config :: Config
config = BootInputs -> Config
biConfig BootInputs
inputs
    app :: AppConfig
app = Config -> AppConfig
configApp Config
config
    memoryPlan :: MemoryPlan
memoryPlan = MirrorDecision -> MemoryPlan
mdMemoryPlan MirrorDecision
mirror
    runtimeSettings :: RuntimeSettings
runtimeSettings = AppConfig -> RuntimeSettings
cfgRuntime AppConfig
app
    (Int
privateConnections, Text
privateLine) = Maybe Int -> Int -> (Int, Text)
resolvePrivateConnections (RuntimeSettings -> Maybe Int
rtPrivateConnectionsPerHost RuntimeSettings
runtimeSettings) (BootInputs -> Int
biFdLimit BootInputs
inputs)
    (Int
publicConnections, Text
publicLine) = Maybe Int -> Int -> (Int, Text)
resolvePublicConnections (RuntimeSettings -> Maybe Int
rtPublicConnectionsPerHost RuntimeSettings
runtimeSettings) (BootInputs -> Int
biFdLimit BootInputs
inputs)

{- The memory plan and its lines. The 'publishConfigured' predicate and this settings
projection live here, so the two entry points cannot disagree on either. -}
memoryPlanFor :: AppConfig -> EffectiveRuntimePlan -> MirrorRuntimePlan -> (MemoryPlan, [Text])
memoryPlanFor :: AppConfig
-> EffectiveRuntimePlan
-> MirrorRuntimePlan
-> (MemoryPlan, [Text])
memoryPlanFor AppConfig
appConfig EffectiveRuntimePlan
effective MirrorRuntimePlan
mirrorRuntime =
    CacheSettings
-> LimitsSettings
-> QueueSettings
-> Maybe Int
-> EffectiveRuntimePlan
-> QueueTenantDemand
-> Bool
-> (MemoryPlan, [Text])
resolveMemoryPlan
        (AppConfig -> CacheSettings
cfgCache AppConfig
appConfig)
        (AppConfig -> LimitsSettings
cfgLimits AppConfig
appConfig)
        (AppConfig -> QueueSettings
cfgQueue AppConfig
appConfig)
        (RuntimeSettings -> Maybe Int
rtServeMaxInFlight (AppConfig -> RuntimeSettings
cfgRuntime AppConfig
appConfig))
        EffectiveRuntimePlan
effective
        (MirrorRuntimePlan -> QueueTenantDemand
queueTenantDemand MirrorRuntimePlan
mirrorRuntime)
        Bool
publishConfigured
  where
    publishConfigured :: Bool
publishConfigured = (MountConfig -> Bool) -> [MountConfig] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe PublicationEndpoint -> Bool
forall a. Maybe a -> Bool
isJust (Maybe PublicationEndpoint -> Bool)
-> (MountConfig -> Maybe PublicationEndpoint)
-> MountConfig
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MountConfig -> Maybe PublicationEndpoint
mntPublicationTarget) (Map Ecosystem MountConfig -> [MountConfig]
forall k a. Map k a -> [a]
Map.elems (AppConfig -> Map Ecosystem MountConfig
cfgMounts AppConfig
appConfig))

{- The document the boot read, or the path it found none at. An absent document is
normal: the environment layer alone is a complete configuration. -}
configDocumentLine :: [(String, String)] -> Maybe ByteString -> Text
configDocumentLine :: [(String, String)] -> Maybe ByteString -> Text
configDocumentLine [(String, String)]
envVars = \case
    Just ByteString
_ -> Text
"Config document: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path
    Maybe ByteString
Nothing -> Text
"Config document: none at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (defaults and environment only)"
  where
    path :: Text
path = String -> Text
forall a. ToText a => a -> Text
toText ([(String, String)] -> String
configDocumentPath [(String, String)]
envVars)

{- What the mirror runtime resolved to: the queue an operator gets, or the fact that no
mount mirrors, so the boot builds nothing. -}
mirrorRuntimeLines :: Int -> MirrorRuntimePlan -> [Text]
mirrorRuntimeLines :: Int -> MirrorRuntimePlan -> [Text]
mirrorRuntimeLines Int
memoryDepth = \case
    MirrorRuntimePlan
NoMirroring -> [Text
"mirror runtime disabled: no mount mirrors, so no queue is built and no worker starts"]
    MirrorWith (SqsBackend SqsConfig
sqs) ->
        [Text
"mirror queue: sqs, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SqsConfig -> Text
sqsQueueUrl SqsConfig
sqs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (region " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SqsConfig -> Text
sqsRegion SqsConfig
sqs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"]
    MirrorWith MirrorQueuePlan
MemoryBackend ->
        [Text
"mirror queue: in-memory (depth " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
memoryDepth Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"]

-- The warning the selected backend warrants. A durable backend warrants none.
mirrorRuntimeWarnings :: MirrorRuntimePlan -> [Text]
mirrorRuntimeWarnings :: MirrorRuntimePlan -> [Text]
mirrorRuntimeWarnings = \case
    MirrorRuntimePlan
NoMirroring -> []
    MirrorWith MirrorQueuePlan
queuePlan -> Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (MirrorQueuePlan -> Maybe Text
mirrorQueuePlanWarning MirrorQueuePlan
queuePlan)

-- | The shipped config-document path. A non-blank @ECLUSE_CONFIG@ relocates it.
defaultConfigPath :: FilePath
defaultConfigPath :: String
defaultConfigPath = String
"/etc/ecluse/config.yaml"

{- | The path a non-blank @ECLUSE_CONFIG@ names, trimmed of surrounding whitespace. 'Nothing'
leaves 'defaultConfigPath' standing, where an absent document is not a failure.
-}
explicitConfigPath :: [(String, String)] -> Maybe FilePath
explicitConfigPath :: [(String, String)] -> Maybe String
explicitConfigPath [(String, String)]
envVars = do
    raw <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"ECLUSE_CONFIG" [(String, String)]
envVars
    toString <$> nonBlank (toText raw)

-- | The config-document path this environment resolves to.
configDocumentPath :: [(String, String)] -> FilePath
configDocumentPath :: [(String, String)] -> String
configDocumentPath = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defaultConfigPath (Maybe String -> String)
-> ([(String, String)] -> Maybe String)
-> [(String, String)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Maybe String
explicitConfigPath