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

{- | The shared boot environment owns the process logger and telemetry resources. Role work ends
before these resources drain and close. @ecluse check-config@ ("Ecluse.CheckConfig") reuses the
configuration prologue and the runtime-knob projection here, so the two entry points cannot
disagree about what a start-up reads or refuses.
-}
module Ecluse.Boot (
    -- * The boot environment
    BootEnv (..),
    withBootEnv,

    -- * The configuration prologue
    loadBootConfig,
    applySecretFileIndirection,
    readConfigDocument,
    runtimeOverridesOf,

    -- * Refusal
    BootAborted (..),
    orExit,
    refuseBoot,

    -- * Boot-time logging and wiring
    logBootWarning,
    logBootInfo,
    logRuleBootOrder,
    buildMirrorQueue,
    applyServerSettings,
    probeServerConfig,
) where

import Data.ByteString qualified as BS
import Data.List (lookup)
import Data.Text qualified as T
import Katip (Environment (Environment), LogEnv, Severity (InfoS, WarningS), closeScribes)
import System.Environment (getEnvironment)
import System.IO.Error (ioeGetErrorString, isDoesNotExistError)
import UnliftIO (bracket, throwIO, tryIO)

import Ecluse.Composition.BootError (renderAdvisory, renderBootErrors)
import Ecluse.Composition.MirrorQueue (
    MirrorQueuePlan (MemoryBackend, SqsBackend),
    deadLetterTerminusWarning,
    memoryQueueDropWarning,
 )
import Ecluse.Composition.Plan (
    BootInputs (BootInputs, biConfig, biDocument, biEnvVars, biFdLimit, biRuntimePlan),
    BootPlan (bpLines, bpWarnings),
    BootReport (brAdvisories, brOutcome, brProvenance),
    configDocumentPath,
    defaultConfigPath,
    explicitConfigPath,
    resolveBootPlan,
 )
import Ecluse.Composition.Sizing (openFileSoftLimit)
import Ecluse.Composition.Types (BootRole)
import Ecluse.Config (
    AppConfig (cfgObservability, cfgRuntime, cfgServer),
    Config (configApp),
    ObservabilitySettings (obsLogFormat, obsLogLevel, obsTelemetry),
    RuntimeSettings (rtCores, rtCoresCeiling, rtMaxHeapBytes),
    ServerSettings (srvPort, srvShutdownDrainTimeout),
    loadConfig,
    renderConfigError,
 )
import Ecluse.Config.Resolve (secretEnvSpellings)
import Ecluse.Core.Queue (MirrorQueue (deadLetterTerminus, deliveryBudget))
import Ecluse.Core.Queue.Memory (defaultMemoryQueueConfig, newBoundedInMemoryQueue)
import Ecluse.Core.Rules (renderBootOrder)
import Ecluse.Core.Security.Egress (mkRegistryUrl)
import Ecluse.Core.Server.Context (PackumentDeps (pdRules))
import Ecluse.Core.Text (displayExceptionT)
import Ecluse.Rts (RuntimeOverrides (RuntimeOverrides, roCores, roCoresCeiling, roMaxHeapBytes), applyRuntimePosture)
import Ecluse.Runtime.Log (moduleLog, newLogEnv)
import Ecluse.Runtime.Queue.Sqs (newSqsQueue)
import Ecluse.Runtime.Server (
    MountBinding (bindingPackumentDeps, bindingPrefix),
    ServerConfig (scDrainTimeout, scPort),
    ShutdownDrainTimeout (ShutdownDrainTimeout),
    mkServerConfig,
 )
import Ecluse.Runtime.Telemetry (Telemetry, TelemetrySwitch (TelemetryOff, TelemetryOn), withTelemetry)
import Ecluse.Runtime.Telemetry.Correlation (ddIdentityFromEnvironment)
import Ecluse.Runtime.Telemetry.Resolve (prepareTelemetry)

-- | Configuration and process resources borrowed by a running role.
data BootEnv = BootEnv
    { BootEnv -> Config
beConfig :: Config
    -- ^ The complete loaded configuration, including its provenance.
    , BootEnv -> LogEnv
beLogEnv :: LogEnv
    -- ^ The process structured-logging environment.
    , BootEnv -> Telemetry
beTelemetry :: Telemetry
    -- ^ The telemetry handle, inert unless @ECLUSE_OBSERVABILITY__TELEMETRY@ enabled it.
    , BootEnv -> BootPlan
beBootPlan :: BootPlan
    -- ^ The resolved plan, whose diagnostics were logged before role work starts.
    }

{- | The environment, the secret files it names, the config document, and the parse, in that order.
@decorate@ wraps each refusal, which is how @ecluse check-config@ adds its own verdict line.
-}
loadBootConfig :: (Text -> Text) -> IO ([(String, String)], Maybe ByteString, Config)
loadBootConfig :: (Text -> Text) -> IO ([(String, String)], Maybe ByteString, Config)
loadBootConfig Text -> Text
decorate = do
    rawEnvVars <- IO [(String, String)]
getEnvironment
    envVars <- applySecretFileIndirection rawEnvVars >>= orExit decorate
    docBlob <- readConfigDocument envVars >>= orExit decorate
    config <- orExit (decorate . T.unlines . map renderConfigError) (loadConfig envVars docBlob)
    pure (envVars, docBlob, config)

-- | Resolve secret files, strip trailing newlines, and refuse conflicting direct values.
applySecretFileIndirection :: [(String, String)] -> IO (Either Text [(String, String)])
applySecretFileIndirection :: [(String, String)] -> IO (Either Text [(String, String)])
applySecretFileIndirection [(String, String)]
envVars = do
    reads' <- ((String, String) -> IO (Either Text (String, String)))
-> [(String, String)] -> IO [Either Text (String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (String, String) -> IO (Either Text (String, String))
readSecretFile [(String, String)]
fileVars
    let (readErrs, resolved) = partitionEithers reads'
    pure $ case conflicts <> readErrs of
        [] -> [(String, String)] -> Either Text [(String, String)]
forall a b. b -> Either a b
Right (((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, String) -> Bool) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isSecretFileVar (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
envVars [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> [(String, String)]
resolved)
        [Text]
errs -> Text -> Either Text [(String, String)]
forall a b. a -> Either a b
Left ([Text] -> Text
T.unlines [Text]
errs)
  where
    fileVars :: [(String, String)]
fileVars = ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
isSecretFileVar (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
envVars

    conflicts :: [Text]
conflicts =
        [ String -> Text
T.pack String
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are both set: supply the secret through exactly one of them"
        | (String
name, String
_) <- [(String, String)]
fileVars
        , let base :: String
base = String -> String
baseVarOf String
name
        , Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
base [(String, String)]
envVars)
        ]

readSecretFile :: (String, String) -> IO (Either Text (String, String))
readSecretFile :: (String, String) -> IO (Either Text (String, String))
readSecretFile (String
name, String
path) = do
    outcome <- IO ByteString -> IO (Either IOException ByteString)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO (String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBS String
path)
    pure $ case outcome of
        Left IOException
err ->
            Text -> Either Text (String, String)
forall a b. a -> Either a b
Left (String -> Text
T.pack String
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" points at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", which cannot be read: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall e. Exception e => e -> Text
displayExceptionT IOException
err)
        Right ByteString
bytes ->
            (String, String) -> Either Text (String, String)
forall a b. b -> Either a b
Right (String -> String
baseVarOf String
name, Text -> String
T.unpack ((Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
bytes)))

isSecretFileVar :: String -> Bool
isSecretFileVar :: String -> Bool
isSecretFileVar String
name =
    let spelling :: Text
spelling = String -> Text
T.pack String
name
     in Text
"ECLUSE_" Text -> Text -> Bool
`T.isPrefixOf` Text
spelling Bool -> Bool -> Bool
&& (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isSuffixOf` Text
spelling) [Text]
secretFileSuffixes

-- Total even though the callers only pass matched names: an unmatched name passes
-- through rather than inventing a partial strip.
baseVarOf :: String -> String
baseVarOf :: String -> String
baseVarOf String
name = String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
name Text -> String
T.unpack (Text -> Text -> Maybe Text
T.stripSuffix Text
"_FILE" (String -> Text
T.pack String
name))

-- The secret-typed keys, by their env-spelling tails. Anything else keeps the strict
-- no-secrets-in-config posture, with no file-shaped side door.
secretFileSuffixes :: [Text]
secretFileSuffixes :: [Text]
secretFileSuffixes = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_FILE") [Text]
secretEnvSpellings

-- | Accept a missing default document, but refuse an explicit path that does not exist.
readConfigDocument :: [(String, String)] -> IO (Either Text (Maybe ByteString))
readConfigDocument :: [(String, String)] -> IO (Either Text (Maybe ByteString))
readConfigDocument [(String, String)]
envVars = do
    let docPath :: String
docPath = [(String, String)] -> String
configDocumentPath [(String, String)]
envVars
    mDocBlob <- IO ByteString -> IO (Either IOException ByteString)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO (String -> IO ByteString
BS.readFile String
docPath)
    pure $ case mDocBlob of
        Right ByteString
bytes -> Maybe ByteString -> Either Text (Maybe ByteString)
forall a b. b -> Either a b
Right (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bytes)
        Left IOException
err
            | IOException -> Bool
isDoesNotExistError IOException
err ->
                case [(String, String)] -> Maybe String
explicitConfigPath [(String, String)]
envVars of
                    Maybe String
Nothing -> Maybe ByteString -> Either Text (Maybe ByteString)
forall a b. b -> Either a b
Right Maybe ByteString
forall a. Maybe a
Nothing
                    Just String
path ->
                        Text -> Either Text (Maybe ByteString)
forall a b. a -> Either a b
Left
                            ( Text
"ECLUSE_CONFIG points at "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but no config document exists there; fix the path, or unset ECLUSE_CONFIG to use "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
defaultConfigPath
                            )
            | Bool
otherwise ->
                Text -> Either Text (Maybe ByteString)
forall a b. a -> Either a b
Left
                    ( Text
"config document at "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
docPath
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" cannot be read: "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IOException -> String
ioeGetErrorString IOException
err)
                    )

-- | Drain the process logger after role work and telemetry cleanup, on normal or exceptional exit.
withBootEnv :: BootRole -> (BootEnv -> IO a) -> IO a
withBootEnv :: forall a. BootRole -> (BootEnv -> IO a) -> IO a
withBootEnv BootRole
role BootEnv -> IO a
action = do
    (envVars, docBlob, config) <- (Text -> Text) -> IO ([(String, String)], Maybe ByteString, Config)
loadBootConfig Text -> Text
forall a. a -> a
id
    let observability = AppConfig -> ObservabilitySettings
cfgObservability (Config -> AppConfig
configApp Config
config)
    -- The log identity comes from the table the SDK reads, before any OTEL_* projection applies,
    -- so a boot line carries the same identity as a served request.
    ddIdentity <- ddIdentityFromEnvironment
    bracket
        (newLogEnv (obsLogFormat observability) (obsLogLevel observability) ddIdentity (Environment "production"))
        (void . closeScribes)
        $ \LogEnv
logEnv -> do
            -- Applying the posture may exec the binary in place to enforce a heap ceiling (same
            -- PID, see "Ecluse.Rts"), so nothing else may have spun up yet.
            runtimePlan <-
                (Text -> IO ())
-> (Text -> IO ()) -> RuntimeOverrides -> IO EffectiveRuntimePlan
applyRuntimePosture (LogEnv -> Text -> IO ()
logBootInfo LogEnv
logEnv) (LogEnv -> Text -> IO ()
logBootWarning LogEnv
logEnv) (RuntimeSettings -> RuntimeOverrides
runtimeOverridesOf (AppConfig -> RuntimeSettings
cfgRuntime (Config -> AppConfig
configApp Config
config)))
            fdLimit <- openFileSoftLimit
            bootPlan <-
                reportBootPlan logEnv $
                    resolveBootPlan
                        role
                        BootInputs
                            { biEnvVars = envVars
                            , biDocument = docBlob
                            , biConfig = config
                            , biRuntimePlan = runtimePlan
                            , biFdLimit = fdLimit
                            }
            prepareTelemetryBoot (obsTelemetry observability) logEnv
            withTelemetry (obsTelemetry observability) logEnv $ \Telemetry
telemetry ->
                BootEnv -> IO a
action
                    BootEnv
                        { beConfig :: Config
beConfig = Config
config
                        , beLogEnv :: LogEnv
beLogEnv = LogEnv
logEnv
                        , beTelemetry :: Telemetry
beTelemetry = Telemetry
telemetry
                        , beBootPlan :: BootPlan
beBootPlan = BootPlan
bootPlan
                        }

{- Log the report and yield the plan, or refuse. The order is load-bearing: @ecluse check-config@
prints the same lists in it, so a transcript and a boot log agree line for line. -}
reportBootPlan :: LogEnv -> BootReport -> IO BootPlan
reportBootPlan :: LogEnv -> BootReport -> IO BootPlan
reportBootPlan LogEnv
logEnv BootReport
report = do
    -- Provenance logs ahead of every refusable phase, so a refusal that names a config key stays
    -- traceable to the layer that set it.
    (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (LogEnv -> Text -> IO ()
logBootInfo LogEnv
logEnv) (BootReport -> [Text]
brProvenance BootReport
report)
    bootPlan <- case BootReport -> Either [BootError] BootPlan
brOutcome BootReport
report of
        -- An advisory about a configuration that will not start is still one its operator must act
        -- on, so a refusal reports beside it rather than instead of it.
        Left [BootError]
errs -> IO ()
logAdvisories IO () -> IO BootPlan -> IO BootPlan
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> IO BootPlan
forall a. Text -> IO a
refuseBoot ([BootError] -> Text
renderBootErrors [BootError]
errs)
        Right BootPlan
plan -> BootPlan -> IO BootPlan
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BootPlan
plan
    traverse_ (logBootInfo logEnv) (bpLines bootPlan)
    traverse_ (logBootWarning logEnv) (bpWarnings bootPlan)
    logAdvisories
    pure bootPlan
  where
    logAdvisories :: IO ()
logAdvisories = (Advisory -> IO ()) -> [Advisory] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (LogEnv -> Text -> IO ()
logBootWarning LogEnv
logEnv (Text -> IO ()) -> (Advisory -> Text) -> Advisory -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Advisory -> Text
renderAdvisory) (BootReport -> [Advisory]
brAdvisories BootReport
report)

-- | Project the configured runtime knobs onto the posture the RTS applies.
runtimeOverridesOf :: RuntimeSettings -> RuntimeOverrides
runtimeOverridesOf :: RuntimeSettings -> RuntimeOverrides
runtimeOverridesOf RuntimeSettings
settings =
    RuntimeOverrides
        { roCores :: Maybe Int
roCores = RuntimeSettings -> Maybe Int
rtCores RuntimeSettings
settings
        , roCoresCeiling :: Maybe Int
roCoresCeiling = RuntimeSettings -> Maybe Int
rtCoresCeiling RuntimeSettings
settings
        , roMaxHeapBytes :: Maybe Int
roMaxHeapBytes = RuntimeSettings -> Maybe Int
rtMaxHeapBytes RuntimeSettings
settings
        }

-- | Build the planned queue and log its durability and delivery-limit warnings.
buildMirrorQueue :: LogEnv -> Int -> MirrorQueuePlan -> IO MirrorQueue
buildMirrorQueue :: LogEnv -> Int -> MirrorQueuePlan -> IO MirrorQueue
buildMirrorQueue LogEnv
logEnv Int
memoryDepth MirrorQueuePlan
plan = do
    queue <- case MirrorQueuePlan
plan of
        SqsBackend SqsConfig
sqsConfig -> LogEnv
-> (Text -> Either Text RegistryUrl) -> SqsConfig -> IO MirrorQueue
newSqsQueue LogEnv
logEnv Text -> Either Text RegistryUrl
mkRegistryUrl SqsConfig
sqsConfig
        MirrorQueuePlan
MemoryBackend ->
            MemoryQueueConfig -> (Int -> IO ()) -> IO MirrorQueue
newBoundedInMemoryQueue (Int -> MemoryQueueConfig
defaultMemoryQueueConfig Int
memoryDepth) (LogEnv -> Text -> IO ()
logBootWarning LogEnv
logEnv (Text -> IO ()) -> (Int -> Text) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
memoryQueueDropWarning)
    whenJust (deadLetterTerminusWarning plan (deliveryBudget queue) (deadLetterTerminus queue)) (logBootWarning logEnv)
    pure queue

-- | Apply the shared listener settings without replacing role hooks or the launch's drain signal.
applyServerSettings :: ServerSettings -> ServerConfig -> ServerConfig
applyServerSettings :: ServerSettings -> ServerConfig -> ServerConfig
applyServerSettings ServerSettings
settings ServerConfig
cfg =
    ServerConfig
cfg
        { scPort = srvPort settings
        , scDrainTimeout = ShutdownDrainTimeout (srvShutdownDrainTimeout settings)
        }

-- | Serve health probes with the shared listener settings and no package mounts.
probeServerConfig :: AppConfig -> ServerConfig
probeServerConfig :: AppConfig -> ServerConfig
probeServerConfig AppConfig
appConfig = ServerSettings -> ServerConfig -> ServerConfig
applyServerSettings (AppConfig -> ServerSettings
cfgServer AppConfig
appConfig) ([MountBinding] -> ServerConfig
mkServerConfig [])

-- | Report a boot warning under the root module's logging context.
logBootWarning :: LogEnv -> Text -> IO ()
logBootWarning :: LogEnv -> Text -> IO ()
logBootWarning LogEnv
logEnv = LogEnv -> Text -> Severity -> Text -> IO ()
moduleLog LogEnv
logEnv Text
"Ecluse" Severity
WarningS

-- | Report a boot diagnostic under the root module's logging context.
logBootInfo :: LogEnv -> Text -> IO ()
logBootInfo :: LogEnv -> Text -> IO ()
logBootInfo LogEnv
logEnv = LogEnv -> Text -> Severity -> Text -> IO ()
moduleLog LogEnv
logEnv Text
"Ecluse" Severity
InfoS

-- | Report evaluation order for each wired mount.
logRuleBootOrder :: LogEnv -> [MountBinding] -> IO ()
logRuleBootOrder :: LogEnv -> [MountBinding] -> IO ()
logRuleBootOrder LogEnv
logEnv = (MountBinding -> IO ()) -> [MountBinding] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ MountBinding -> IO ()
logMount
  where
    logMount :: MountBinding -> IO ()
logMount MountBinding
binding = do
        let deps :: PackumentDeps
deps = MountBinding -> PackumentDeps
bindingPackumentDeps MountBinding
binding
        let label :: Text
label = Text -> [Text] -> Text
T.intercalate Text
"/" (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (MountBinding -> NonEmpty Text
bindingPrefix MountBinding
binding))
        LogEnv -> Text -> IO ()
logBootInfo LogEnv
logEnv (Text
"rule boot order for mount " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":")
        (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (LogEnv -> Text -> IO ()
logBootInfo LogEnv
logEnv) ([PreparedRule] -> [Text]
renderBootOrder (PackumentDeps -> [PreparedRule]
pdRules PackumentDeps
deps))

-- | A start-up refusal that the process perimeter reports before exiting.
newtype BootAborted = BootAborted Text
    deriving stock (BootAborted -> BootAborted -> Bool
(BootAborted -> BootAborted -> Bool)
-> (BootAborted -> BootAborted -> Bool) -> Eq BootAborted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BootAborted -> BootAborted -> Bool
== :: BootAborted -> BootAborted -> Bool
$c/= :: BootAborted -> BootAborted -> Bool
/= :: BootAborted -> BootAborted -> Bool
Eq, Int -> BootAborted -> String -> String
[BootAborted] -> String -> String
BootAborted -> String
(Int -> BootAborted -> String -> String)
-> (BootAborted -> String)
-> ([BootAborted] -> String -> String)
-> Show BootAborted
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> BootAborted -> String -> String
showsPrec :: Int -> BootAborted -> String -> String
$cshow :: BootAborted -> String
show :: BootAborted -> String
$cshowList :: [BootAborted] -> String -> String
showList :: [BootAborted] -> String -> String
Show)

instance Exception BootAborted

-- | Raise the complete refusal for the process perimeter to report.
refuseBoot :: Text -> IO a
refuseBoot :: forall a. Text -> IO a
refuseBoot = BootAborted -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (BootAborted -> IO a) -> (Text -> BootAborted) -> Text -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BootAborted
BootAborted

-- | Abort on a rendered refusal, or return the successful result.
orExit :: (e -> Text) -> Either e a -> IO a
orExit :: forall e a. (e -> Text) -> Either e a -> IO a
orExit e -> Text
render = (e -> IO a) -> (a -> IO a) -> Either e a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> IO a
forall a. Text -> IO a
refuseBoot (Text -> IO a) -> (e -> Text) -> e -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Text
render) a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

{- Prepare the telemetry substrate before the SDK initialises. With
@ECLUSE_OBSERVABILITY__TELEMETRY@ off it is a no-op, reading no process environment. -}
prepareTelemetryBoot :: TelemetrySwitch -> LogEnv -> IO ()
prepareTelemetryBoot :: TelemetrySwitch -> LogEnv -> IO ()
prepareTelemetryBoot TelemetrySwitch
switch LogEnv
logEnv = case TelemetrySwitch
switch of
    TelemetrySwitch
TelemetryOff -> IO ()
forall (f :: * -> *). Applicative f => f ()
pass
    TelemetrySwitch
TelemetryOn -> do
        environment <- IO [(String, String)]
getEnvironment
        prepareTelemetry logEnv environment