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

{- | Resolving and applying the process's runtime posture: the capability count, the allocation
area and the heap ceiling.

The RTS sizes itself from the /machine/, not the pod. Bare @-N@ claims a capability per visible
processor, a cgroup CPU quota does not shrink that count, and the heap is unbounded unless @-M@
says so, leaving the kernel OOM killer as the only backstop. Neither @-A@ nor @-M@ has an in-process
setter, so applying one re-executes this binary in place once, guarded by 'reexecMarker'. Sizes are
bytes throughout.
-}
module Ecluse.Rts (
    -- * Applying the resolved posture at boot
    applyRuntimePosture,

    -- * The pure resolution core
    RtsPosture (..),
    CgroupLimits (..),
    RuntimeOverrides (..),
    Provenance (..),
    RuntimePlan (..),
    provenanceClause,
    resolveRuntimePlan,
    currentRtsPosture,
    readCgroupLimits,
    deriveMaxHeapBytes,
    deriveAllocAreaBytes,
    requiredRtsFlags,

    -- * The effective plan (desired reconciled with observed)
    EffectiveAxis (..),
    EffectiveRuntimePlan (..),
    axEnforced,
    reconcileRuntimePlan,
    appliedRuntimePlan,
    effectiveCapabilities,
    effectiveHeapCeiling,
    renderEffectivePosture,
    renderPostureWarnings,

    -- * Cgroup v2 parsing
    parseCpuMax,
    parseMemoryMax,
    readIfExists,
    parseInactiveFile,
    usePermille,

    -- * Cgroup memory use
    cgroupMemoryUse,
) where

import Data.Ord (clamp)
import Data.Text qualified as T
import GHC.Conc (getNumCapabilities, getNumProcessors, setNumCapabilities)
import GHC.RTS.Flags (GCFlags (maxHeapSize, minAllocAreaSize, nurseryChunkSize), getGCFlags)
import System.Environment (getEnvironment, getExecutablePath)
import System.IO.Error (isDoesNotExistError)
import System.Posix.Process (executeFile)
import UnliftIO (tryIO, tryJust)

-- | The RTS posture the process is actually running with, read at boot by 'currentRtsPosture'.
data RtsPosture = RtsPosture
    { RtsPosture -> Int
rpCapabilities :: Int
    -- ^ Capabilities claimed ('getNumCapabilities' at boot).
    , RtsPosture -> Int
rpProcessors :: Int
    -- ^ Processors the RTS can see: the ceiling a derived capability count clamps to.
    , RtsPosture -> Int
rpAllocAreaBytes :: Int
    -- ^ The per-capability allocation area (@-A@), bytes.
    , RtsPosture -> Maybe Int
rpNurseryChunkBytes :: Maybe Int
    -- ^ The nursery chunk size (@-n@), bytes. 'Nothing' when unset.
    , RtsPosture -> Maybe Int
rpMaxHeapBytes :: Maybe Int
    -- ^ The heap ceiling (@-M@), bytes. 'Nothing' when unlimited.
    }
    deriving stock (RtsPosture -> RtsPosture -> Bool
(RtsPosture -> RtsPosture -> Bool)
-> (RtsPosture -> RtsPosture -> Bool) -> Eq RtsPosture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RtsPosture -> RtsPosture -> Bool
== :: RtsPosture -> RtsPosture -> Bool
$c/= :: RtsPosture -> RtsPosture -> Bool
/= :: RtsPosture -> RtsPosture -> Bool
Eq, Int -> RtsPosture -> ShowS
[RtsPosture] -> ShowS
RtsPosture -> FilePath
(Int -> RtsPosture -> ShowS)
-> (RtsPosture -> FilePath)
-> ([RtsPosture] -> ShowS)
-> Show RtsPosture
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RtsPosture -> ShowS
showsPrec :: Int -> RtsPosture -> ShowS
$cshow :: RtsPosture -> FilePath
show :: RtsPosture -> FilePath
$cshowList :: [RtsPosture] -> ShowS
showList :: [RtsPosture] -> ShowS
Show)

{- | What the cgroup (v2) grants this process: the CPU quota in cores and the memory ceiling in
bytes. 'Nothing' per axis when the file is absent or carries the unlimited @max@ sentinel.
-}
data CgroupLimits = CgroupLimits
    { CgroupLimits -> Maybe Double
cgCpuCores :: Maybe Double
    , CgroupLimits -> Maybe Int
cgMemoryMaxBytes :: Maybe Int
    }
    deriving stock (CgroupLimits -> CgroupLimits -> Bool
(CgroupLimits -> CgroupLimits -> Bool)
-> (CgroupLimits -> CgroupLimits -> Bool) -> Eq CgroupLimits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CgroupLimits -> CgroupLimits -> Bool
== :: CgroupLimits -> CgroupLimits -> Bool
$c/= :: CgroupLimits -> CgroupLimits -> Bool
/= :: CgroupLimits -> CgroupLimits -> Bool
Eq, Int -> CgroupLimits -> ShowS
[CgroupLimits] -> ShowS
CgroupLimits -> FilePath
(Int -> CgroupLimits -> ShowS)
-> (CgroupLimits -> FilePath)
-> ([CgroupLimits] -> ShowS)
-> Show CgroupLimits
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CgroupLimits -> ShowS
showsPrec :: Int -> CgroupLimits -> ShowS
$cshow :: CgroupLimits -> FilePath
show :: CgroupLimits -> FilePath
$cshowList :: [CgroupLimits] -> ShowS
showList :: [CgroupLimits] -> ShowS
Show)

{- | The @runtime@ configuration the resolution reads. Each unset field falls to the next rung,
and 'roCoresCeiling' bounds the last rung alone.
-}
data RuntimeOverrides = RuntimeOverrides
    { RuntimeOverrides -> Maybe Int
roCores :: Maybe Int
    , RuntimeOverrides -> Maybe Int
roCoresCeiling :: Maybe Int
    , RuntimeOverrides -> Maybe Int
roMaxHeapBytes :: Maybe Int
    }
    deriving stock (RuntimeOverrides -> RuntimeOverrides -> Bool
(RuntimeOverrides -> RuntimeOverrides -> Bool)
-> (RuntimeOverrides -> RuntimeOverrides -> Bool)
-> Eq RuntimeOverrides
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuntimeOverrides -> RuntimeOverrides -> Bool
== :: RuntimeOverrides -> RuntimeOverrides -> Bool
$c/= :: RuntimeOverrides -> RuntimeOverrides -> Bool
/= :: RuntimeOverrides -> RuntimeOverrides -> Bool
Eq, Int -> RuntimeOverrides -> ShowS
[RuntimeOverrides] -> ShowS
RuntimeOverrides -> FilePath
(Int -> RuntimeOverrides -> ShowS)
-> (RuntimeOverrides -> FilePath)
-> ([RuntimeOverrides] -> ShowS)
-> Show RuntimeOverrides
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuntimeOverrides -> ShowS
showsPrec :: Int -> RuntimeOverrides -> ShowS
$cshow :: RuntimeOverrides -> FilePath
show :: RuntimeOverrides -> FilePath
$cshowList :: [RuntimeOverrides] -> ShowS
showList :: [RuntimeOverrides] -> ShowS
Show)

-- | Where a resolved value came from, for the boot log's provenance clause.
data Provenance
    = -- | Explicit Écluse configuration (@cores@ \/ @maxHeapBytes@).
      FromConfig
    | -- | Derived from the cgroup CPU quota, or from @memory.max@ on the heap axis.
      FromCgroup
    | -- | Bounded by what the cgroup memory limit can feed, for want of a CPU quota.
      FromCgroupMemory
    | -- | Capped at @coresCeiling@, with no cgroup limit of either kind in force.
      FromCoresCeiling
    | -- | Fitted to a heap ceiling from config, or from @GHCRTS@ with no cgroup memory limit in force.
      FromHeapCeiling
    | -- | Left as the RTS resolved it (baked defaults plus any operator @GHCRTS@).
      FromRts
    deriving stock (Provenance -> Provenance -> Bool
(Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Bool) -> Eq Provenance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Provenance -> Provenance -> Bool
== :: Provenance -> Provenance -> Bool
$c/= :: Provenance -> Provenance -> Bool
/= :: Provenance -> Provenance -> Bool
Eq, Int -> Provenance -> ShowS
[Provenance] -> ShowS
Provenance -> FilePath
(Int -> Provenance -> ShowS)
-> (Provenance -> FilePath)
-> ([Provenance] -> ShowS)
-> Show Provenance
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Provenance -> ShowS
showsPrec :: Int -> Provenance -> ShowS
$cshow :: Provenance -> FilePath
show :: Provenance -> FilePath
$cshowList :: [Provenance] -> ShowS
showList :: [Provenance] -> ShowS
Show)

{- | The resolved runtime posture: the capability count, allocation area and heap ceiling to run
with, each with its provenance. A 'FromRts' entry means leave the live posture alone.
-}
data RuntimePlan = RuntimePlan
    { RuntimePlan -> (Int, Provenance)
planCapabilities :: (Int, Provenance)
    , RuntimePlan -> (Int, Provenance)
planAllocAreaBytes :: (Int, Provenance)
    , RuntimePlan -> (Maybe Int, Provenance)
planMaxHeapBytes :: (Maybe Int, Provenance)
    }
    deriving stock (RuntimePlan -> RuntimePlan -> Bool
(RuntimePlan -> RuntimePlan -> Bool)
-> (RuntimePlan -> RuntimePlan -> Bool) -> Eq RuntimePlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuntimePlan -> RuntimePlan -> Bool
== :: RuntimePlan -> RuntimePlan -> Bool
$c/= :: RuntimePlan -> RuntimePlan -> Bool
/= :: RuntimePlan -> RuntimePlan -> Bool
Eq, Int -> RuntimePlan -> ShowS
[RuntimePlan] -> ShowS
RuntimePlan -> FilePath
(Int -> RuntimePlan -> ShowS)
-> (RuntimePlan -> FilePath)
-> ([RuntimePlan] -> ShowS)
-> Show RuntimePlan
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuntimePlan -> ShowS
showsPrec :: Int -> RuntimePlan -> ShowS
$cshow :: RuntimePlan -> FilePath
show :: RuntimePlan -> FilePath
$cshowList :: [RuntimePlan] -> ShowS
showList :: [RuntimePlan] -> ShowS
Show)

{- | Resolve the runtime plan: capabilities down the four-rung ladder, the heap ceiling from
@maxHeapBytes@, else the cgroup limit, else @GHCRTS@, and the allocation area to fit either bound.
-}
resolveRuntimePlan :: RuntimeOverrides -> CgroupLimits -> RtsPosture -> RuntimePlan
resolveRuntimePlan :: RuntimeOverrides -> CgroupLimits -> RtsPosture -> RuntimePlan
resolveRuntimePlan RuntimeOverrides
overrides CgroupLimits
cgroup RtsPosture
rts =
    RuntimePlan
        { planCapabilities :: (Int, Provenance)
planCapabilities = (Int, Provenance)
capabilities
        , planAllocAreaBytes :: (Int, Provenance)
planAllocAreaBytes = (Int, Provenance)
allocArea
        , planMaxHeapBytes :: (Maybe Int, Provenance)
planMaxHeapBytes = (Maybe Int, Provenance)
maxHeap
        }
  where
    -- The quota floors as Go's automaxprocs floors it: a stop-the-world collection claiming above
    -- the CFS quota would freeze mid-pause, so a fractional entitlement is stranded, not borrowed.
    capabilities :: (Int, Provenance)
capabilities = case (RuntimeOverrides -> Maybe Int
roCores RuntimeOverrides
overrides, CgroupLimits -> Maybe Double
cgCpuCores CgroupLimits
cgroup, CgroupLimits -> Maybe Int
cgMemoryMaxBytes CgroupLimits
cgroup) of
        (Just Int
n, Maybe Double
_, Maybe Int
_) -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n, Provenance
FromConfig)
        (Maybe Int
Nothing, Just Double
quota, Maybe Int
_) -> (Int -> Int
visible (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
quota), Provenance
FromCgroup)
        -- Fitted against the shipped area, since the live one is derived from this count.
        (Maybe Int
Nothing, Maybe Double
Nothing, Just Int
memMax) ->
            (Int -> Int
visible (Int -> Int -> Int
nurseryFittedCapabilities Int
memMax Int
shippedAllocAreaBytes), Provenance
FromCgroupMemory)
        (Maybe Int
Nothing, Maybe Double
Nothing, Maybe Int
Nothing) ->
            (Int -> Int
visible (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defaultCoresCeiling (RuntimeOverrides -> Maybe Int
roCoresCeiling RuntimeOverrides
overrides)), Provenance
FromCoresCeiling)

    -- Every derived rung floors at one capability and ceilings at the visible processors.
    visible :: Int -> Int
visible = (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
1, RtsPosture -> Int
rpProcessors RtsPosture
rts)

    -- The area fits the tighter of the memory limit and a configured heap ceiling, or a GHCRTS -M with no
    -- limit. Any live area other than the shipped or the derived one is an operator's choice, and stands.
    allocArea :: (Int, Provenance)
allocArea = case (CgroupLimits -> Maybe Int
cgMemoryMaxBytes CgroupLimits
cgroup, RuntimeOverrides -> Maybe Int
roMaxHeapBytes RuntimeOverrides
overrides) of
        (Just Int
memMax, Just Int
ceiling') | Int
ceiling' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
memMax -> Int -> Provenance -> (Int, Provenance)
fitted Int
ceiling' Provenance
FromHeapCeiling
        (Just Int
memMax, Maybe Int
_) -> Int -> Provenance -> (Int, Provenance)
fitted Int
memMax Provenance
FromCgroup
        (Maybe Int
Nothing, Maybe Int
configured) -> (Int, Provenance)
-> (Int -> (Int, Provenance)) -> Maybe Int -> (Int, Provenance)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RtsPosture -> Int
rpAllocAreaBytes RtsPosture
rts, Provenance
FromRts) (Int -> Provenance -> (Int, Provenance)
`fitted` Provenance
FromHeapCeiling) (Maybe Int
configured Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RtsPosture -> Maybe Int
rpMaxHeapBytes RtsPosture
rts)
    fitted :: Int -> Provenance -> (Int, Provenance)
fitted Int
bound Provenance
provenance
        | RtsPosture -> Int
rpAllocAreaBytes RtsPosture
rts Int -> [Int] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Int
shippedAllocAreaBytes, Int
derivedArea] = (Int
derivedArea, Provenance
provenance)
        | Bool
otherwise = (RtsPosture -> Int
rpAllocAreaBytes RtsPosture
rts, Provenance
FromRts)
      where
        derivedArea :: Int
derivedArea = Int -> Int -> Int
deriveAllocAreaBytes Int
bound ((Int, Provenance) -> Int
forall a b. (a, b) -> a
fst (Int, Provenance)
capabilities)

    maxHeap :: (Maybe Int, Provenance)
maxHeap = case (RuntimeOverrides -> Maybe Int
roMaxHeapBytes RuntimeOverrides
overrides, CgroupLimits -> Maybe Int
cgMemoryMaxBytes CgroupLimits
cgroup) of
        (Just Int
bytes, Maybe Int
_) -> (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
alignToBlock Int
bytes), Provenance
FromConfig)
        (Maybe Int
Nothing, Just Int
memMax) -> (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int -> Int
deriveMaxHeapBytes Int
memMax ((Int, Provenance) -> Int
forall a b. (a, b) -> a
fst (Int, Provenance)
allocArea)), Provenance
FromCgroup)
        (Maybe Int
Nothing, Maybe Int
Nothing) -> (RtsPosture -> Maybe Int
rpMaxHeapBytes RtsPosture
rts, Provenance
FromRts)

-- The last rung's cap, when no cgroup limit says anything. It is a policy stance, not a machine
-- property, so @runtime.coresCeiling@ overrides it rather than any derivation.
defaultCoresCeiling :: Int
defaultCoresCeiling :: Int
defaultCoresCeiling = Int
8

{- | The capability count a memory budget can feed. The nursery charge is capabilities x the
allocation area, and a count the budget cannot feed is the surge shape that overflows the heap.
-}
nurseryFittedCapabilities :: Int -> Int -> Int
nurseryFittedCapabilities :: Int -> Int -> Int
nurseryFittedCapabilities Int
budgetBytes Int
allocAreaBytes =
    Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
budgetBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
nurseryCeilingShareDiv Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
allocAreaBytes)

-- The share of a memory budget the nursery may hold before the capability count is what has
-- to give, when no CPU quota names the count.
nurseryCeilingShareDiv :: Int
nurseryCeilingShareDiv :: Int
nurseryCeilingShareDiv = Int
4

{- | The per-capability allocation area for a memory limit: an eighth of the limit across the
capabilities, in whole MiB from 4 to 64. A smaller nursery costs collector time, not a core.
-}
deriveAllocAreaBytes :: Int -> Int -> Int
deriveAllocAreaBytes :: Int -> Int -> Int
deriveAllocAreaBytes Int
memMax Int
capabilities =
    (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mebibyte, Int
shippedAllocAreaBytes) Int
share Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
mebibyte Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mebibyte
  where
    share :: Int
share = Int
memMax Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
nurseryShareDiv Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
capabilities)

-- The share of the memory limit the whole nursery may take.
nurseryShareDiv :: Int
nurseryShareDiv :: Int
nurseryShareDiv = Int
8

-- The @-A@ the executable bakes in. A live value other than this is an operator's choice.
shippedAllocAreaBytes :: Int
shippedAllocAreaBytes :: Int
shippedAllocAreaBytes = Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mebibyte

mebibyte :: Int
mebibyte :: Int
mebibyte = Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

{- | The heap ceiling derived from a cgroup memory limit, floored at half the limit. The nursery
counts inside @-M@ (GHC 9.6 and later), so only an overshoot allowance and off-heap memory come off.
-}
deriveMaxHeapBytes :: Int -> Int -> Int
deriveMaxHeapBytes :: Int -> Int -> Int
deriveMaxHeapBytes Int
memMax Int
allocAreaBytes =
    Int -> Int
alignToBlock (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
memMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
overshoot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offHeap) (Int
memMax Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2))
  where
    -- The RTS checks @-M@ only at a collection, and large objects allocated in between can
    -- reach @-AL@, which defaults to @-A@.
    overshoot :: Int
overshoot = Int
allocAreaBytes
    -- Memory @-M@ does not see: socket buffers, OS thread stacks and native zlib state.
    offHeap :: Int
offHeap = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mebibyte) (Int
memMax Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)

{- A heap ceiling rounded down to the RTS's 4 KiB block granularity. The RTS stores @-M@ in
blocks, so a non-multiple would read back rounded and the plan would look unapplied forever. -}
alignToBlock :: Int -> Int
alignToBlock :: Int -> Int
alignToBlock Int
bytes = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
rtsBlockBytes (Int
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
rtsBlockBytes)

{- | One axis of the runtime posture after the boot applied the plan. An apply can fail, so
downstream sizings read 'effectiveCapabilities' and 'effectiveHeapCeiling', never the desired plan.
-}
data EffectiveAxis a = EffectiveAxis
    { forall a. EffectiveAxis a -> a
axDesired :: a
    -- ^ What the resolution wanted ('resolveRuntimePlan').
    , forall a. EffectiveAxis a -> a
axObserved :: a
    -- ^ What the RTS reports after the apply attempt.
    , forall a. EffectiveAxis a -> Provenance
axProvenance :: Provenance
    -- ^ Where the desired value came from.
    }
    deriving stock (EffectiveAxis a -> EffectiveAxis a -> Bool
(EffectiveAxis a -> EffectiveAxis a -> Bool)
-> (EffectiveAxis a -> EffectiveAxis a -> Bool)
-> Eq (EffectiveAxis a)
forall a. Eq a => EffectiveAxis a -> EffectiveAxis a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => EffectiveAxis a -> EffectiveAxis a -> Bool
== :: EffectiveAxis a -> EffectiveAxis a -> Bool
$c/= :: forall a. Eq a => EffectiveAxis a -> EffectiveAxis a -> Bool
/= :: EffectiveAxis a -> EffectiveAxis a -> Bool
Eq, Int -> EffectiveAxis a -> ShowS
[EffectiveAxis a] -> ShowS
EffectiveAxis a -> FilePath
(Int -> EffectiveAxis a -> ShowS)
-> (EffectiveAxis a -> FilePath)
-> ([EffectiveAxis a] -> ShowS)
-> Show (EffectiveAxis a)
forall a. Show a => Int -> EffectiveAxis a -> ShowS
forall a. Show a => [EffectiveAxis a] -> ShowS
forall a. Show a => EffectiveAxis a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> EffectiveAxis a -> ShowS
showsPrec :: Int -> EffectiveAxis a -> ShowS
$cshow :: forall a. Show a => EffectiveAxis a -> FilePath
show :: EffectiveAxis a -> FilePath
$cshowList :: forall a. Show a => [EffectiveAxis a] -> ShowS
showList :: [EffectiveAxis a] -> ShowS
Show)

-- | Whether the live RTS backs an axis (desired and observed agree).
axEnforced :: (Eq a) => EffectiveAxis a -> Bool
axEnforced :: forall a. Eq a => EffectiveAxis a -> Bool
axEnforced EffectiveAxis a
ax = EffectiveAxis a -> a
forall a. EffectiveAxis a -> a
axDesired EffectiveAxis a
ax a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== EffectiveAxis a -> a
forall a. EffectiveAxis a -> a
axObserved EffectiveAxis a
ax

{- | The runtime plan reconciled with the posture the RTS actually runs: each planned axis as a
desired\/observed pair, plus the observed-only datapoints downstream sizing needs.
-}
data EffectiveRuntimePlan = EffectiveRuntimePlan
    { EffectiveRuntimePlan -> EffectiveAxis Int
erpCapabilities :: EffectiveAxis Int
    , EffectiveRuntimePlan -> EffectiveAxis (Maybe Int)
erpMaxHeapBytes :: EffectiveAxis (Maybe Int)
    , EffectiveRuntimePlan -> Int
erpAllocAreaBytes :: Int
    -- ^ The per-capability allocation area the RTS runs with.
    , EffectiveRuntimePlan -> Provenance
erpAllocAreaProvenance :: Provenance
    -- ^ Where the allocation area came from, 'FromRts' when the plan left it alone.
    , EffectiveRuntimePlan -> Maybe Int
erpNurseryChunkBytes :: Maybe Int
    -- ^ The nursery chunk size, observed only.
    , EffectiveRuntimePlan -> Maybe Int
erpContainerMemoryBytes :: Maybe Int
    -- ^ The cgroup @memory.max@ datapoint, when one binds this process.
    }
    deriving stock (EffectiveRuntimePlan -> EffectiveRuntimePlan -> Bool
(EffectiveRuntimePlan -> EffectiveRuntimePlan -> Bool)
-> (EffectiveRuntimePlan -> EffectiveRuntimePlan -> Bool)
-> Eq EffectiveRuntimePlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EffectiveRuntimePlan -> EffectiveRuntimePlan -> Bool
== :: EffectiveRuntimePlan -> EffectiveRuntimePlan -> Bool
$c/= :: EffectiveRuntimePlan -> EffectiveRuntimePlan -> Bool
/= :: EffectiveRuntimePlan -> EffectiveRuntimePlan -> Bool
Eq, Int -> EffectiveRuntimePlan -> ShowS
[EffectiveRuntimePlan] -> ShowS
EffectiveRuntimePlan -> FilePath
(Int -> EffectiveRuntimePlan -> ShowS)
-> (EffectiveRuntimePlan -> FilePath)
-> ([EffectiveRuntimePlan] -> ShowS)
-> Show EffectiveRuntimePlan
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EffectiveRuntimePlan -> ShowS
showsPrec :: Int -> EffectiveRuntimePlan -> ShowS
$cshow :: EffectiveRuntimePlan -> FilePath
show :: EffectiveRuntimePlan -> FilePath
$cshowList :: [EffectiveRuntimePlan] -> ShowS
showList :: [EffectiveRuntimePlan] -> ShowS
Show)

-- | Pair the desired plan with the posture the RTS reports, axis by axis.
reconcileRuntimePlan :: CgroupLimits -> RuntimePlan -> RtsPosture -> EffectiveRuntimePlan
reconcileRuntimePlan :: CgroupLimits -> RuntimePlan -> RtsPosture -> EffectiveRuntimePlan
reconcileRuntimePlan CgroupLimits
cgroup RuntimePlan
plan RtsPosture
posture =
    EffectiveRuntimePlan
        { erpCapabilities :: EffectiveAxis Int
erpCapabilities =
            EffectiveAxis
                { axDesired :: Int
axDesired = (Int, Provenance) -> Int
forall a b. (a, b) -> a
fst (RuntimePlan -> (Int, Provenance)
planCapabilities RuntimePlan
plan)
                , axObserved :: Int
axObserved = RtsPosture -> Int
rpCapabilities RtsPosture
posture
                , axProvenance :: Provenance
axProvenance = (Int, Provenance) -> Provenance
forall a b. (a, b) -> b
snd (RuntimePlan -> (Int, Provenance)
planCapabilities RuntimePlan
plan)
                }
        , erpMaxHeapBytes :: EffectiveAxis (Maybe Int)
erpMaxHeapBytes =
            EffectiveAxis
                { axDesired :: Maybe Int
axDesired = (Maybe Int, Provenance) -> Maybe Int
forall a b. (a, b) -> a
fst (RuntimePlan -> (Maybe Int, Provenance)
planMaxHeapBytes RuntimePlan
plan)
                , axObserved :: Maybe Int
axObserved = RtsPosture -> Maybe Int
rpMaxHeapBytes RtsPosture
posture
                , axProvenance :: Provenance
axProvenance = (Maybe Int, Provenance) -> Provenance
forall a b. (a, b) -> b
snd (RuntimePlan -> (Maybe Int, Provenance)
planMaxHeapBytes RuntimePlan
plan)
                }
        , erpAllocAreaBytes :: Int
erpAllocAreaBytes = RtsPosture -> Int
rpAllocAreaBytes RtsPosture
posture
        , erpAllocAreaProvenance :: Provenance
erpAllocAreaProvenance =
            if RtsPosture -> Int
rpAllocAreaBytes RtsPosture
posture Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Provenance) -> Int
forall a b. (a, b) -> a
fst (RuntimePlan -> (Int, Provenance)
planAllocAreaBytes RuntimePlan
plan) then (Int, Provenance) -> Provenance
forall a b. (a, b) -> b
snd (RuntimePlan -> (Int, Provenance)
planAllocAreaBytes RuntimePlan
plan) else Provenance
FromRts
        , erpNurseryChunkBytes :: Maybe Int
erpNurseryChunkBytes = RtsPosture -> Maybe Int
rpNurseryChunkBytes RtsPosture
posture
        , erpContainerMemoryBytes :: Maybe Int
erpContainerMemoryBytes = CgroupLimits -> Maybe Int
cgMemoryMaxBytes CgroupLimits
cgroup
        }

{- | The effective plan a successful application would produce, observed equal to desired.
@check-config@ sizes from this because it applies nothing, so its own posture is not the boot's.
-}
appliedRuntimePlan :: CgroupLimits -> RuntimePlan -> RtsPosture -> EffectiveRuntimePlan
appliedRuntimePlan :: CgroupLimits -> RuntimePlan -> RtsPosture -> EffectiveRuntimePlan
appliedRuntimePlan CgroupLimits
cgroup RuntimePlan
plan RtsPosture
posture =
    (CgroupLimits -> RuntimePlan -> RtsPosture -> EffectiveRuntimePlan
reconcileRuntimePlan CgroupLimits
cgroup RuntimePlan
plan RtsPosture
posture)
        { erpCapabilities = enforced (planCapabilities plan)
        , erpMaxHeapBytes = enforced (planMaxHeapBytes plan)
        , erpAllocAreaBytes = fst (planAllocAreaBytes plan)
        , erpAllocAreaProvenance = snd (planAllocAreaBytes plan)
        }
  where
    enforced :: (a, Provenance) -> EffectiveAxis a
enforced (a
v, Provenance
prov) = EffectiveAxis{axDesired :: a
axDesired = a
v, axObserved :: a
axObserved = a
v, axProvenance :: Provenance
axProvenance = Provenance
prov}

{- | The live capability count: budgets must never exceed what the RTS actually runs with, so the
observed side is authoritative. An unenforced count degrades the provenance to 'FromRts'.
-}
effectiveCapabilities :: EffectiveRuntimePlan -> (Int, Provenance)
effectiveCapabilities :: EffectiveRuntimePlan -> (Int, Provenance)
effectiveCapabilities EffectiveRuntimePlan
p =
    let ax :: EffectiveAxis Int
ax = EffectiveRuntimePlan -> EffectiveAxis Int
erpCapabilities EffectiveRuntimePlan
p
     in (EffectiveAxis Int -> Int
forall a. EffectiveAxis a -> a
axObserved EffectiveAxis Int
ax, if EffectiveAxis Int -> Bool
forall a. Eq a => EffectiveAxis a -> Bool
axEnforced EffectiveAxis Int
ax then EffectiveAxis Int -> Provenance
forall a. EffectiveAxis a -> Provenance
axProvenance EffectiveAxis Int
ax else Provenance
FromRts)

{- | The sizing ceiling: the __tighter__ of desired and observed. An observed @-M@ below the plan
binds, and an absent one leaves the desired ceiling standing on the cgroup limit's OOM backstop.
-}
effectiveHeapCeiling :: EffectiveRuntimePlan -> (Maybe Int, Provenance)
effectiveHeapCeiling :: EffectiveRuntimePlan -> (Maybe Int, Provenance)
effectiveHeapCeiling EffectiveRuntimePlan
p =
    let ax :: EffectiveAxis (Maybe Int)
ax = EffectiveRuntimePlan -> EffectiveAxis (Maybe Int)
erpMaxHeapBytes EffectiveRuntimePlan
p
     in case (EffectiveAxis (Maybe Int) -> Maybe Int
forall a. EffectiveAxis a -> a
axDesired EffectiveAxis (Maybe Int)
ax, EffectiveAxis (Maybe Int) -> Maybe Int
forall a. EffectiveAxis a -> a
axObserved EffectiveAxis (Maybe Int)
ax) of
            (Just Int
desired, Just Int
observed)
                | Int
observed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
desired -> (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
observed, Provenance
FromRts)
            (Maybe Int
Nothing, Just Int
observed) -> (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
observed, Provenance
FromRts)
            (Maybe Int
desired, Maybe Int
_) -> (Maybe Int
desired, EffectiveAxis (Maybe Int) -> Provenance
forall a. EffectiveAxis a -> Provenance
axProvenance EffectiveAxis (Maybe Int)
ax)

{- | The RTS flags the plan requires beyond the live posture, in @GHCRTS@ syntax. A 'FromRts'
entry never contributes a flag, because it /is/ the live posture.
-}
requiredRtsFlags :: RtsPosture -> RuntimePlan -> [Text]
requiredRtsFlags :: RtsPosture -> RuntimePlan -> [Text]
requiredRtsFlags RtsPosture
rts RuntimePlan
plan =
    [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
capsFlag, Maybe Text
allocFlag, Maybe Text
heapFlag]
  where
    capsFlag :: Maybe Text
capsFlag = case RuntimePlan -> (Int, Provenance)
planCapabilities RuntimePlan
plan of
        (Int
_, Provenance
FromRts) -> Maybe Text
forall a. Maybe a
Nothing
        (Int
n, Provenance
_)
            | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RtsPosture -> Int
rpCapabilities RtsPosture
rts -> Maybe Text
forall a. Maybe a
Nothing
            | Bool
otherwise -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"-N" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
n)

    allocFlag :: Maybe Text
allocFlag = case RuntimePlan -> (Int, Provenance)
planAllocAreaBytes RuntimePlan
plan of
        (Int
_, Provenance
FromRts) -> Maybe Text
forall a. Maybe a
Nothing
        (Int
bytes, Provenance
_)
            | Int
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RtsPosture -> Int
rpAllocAreaBytes RtsPosture
rts -> Maybe Text
forall a. Maybe a
Nothing
            | Bool
otherwise -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"-A" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
bytes)

    heapFlag :: Maybe Text
heapFlag = case RuntimePlan -> (Maybe Int, Provenance)
planMaxHeapBytes RuntimePlan
plan of
        (Maybe Int
_, Provenance
FromRts) -> Maybe Text
forall a. Maybe a
Nothing
        (Maybe Int
Nothing, Provenance
_) -> Maybe Text
forall a. Maybe a
Nothing
        (Just Int
bytes, Provenance
_)
            | Int -> Maybe Int
forall a. a -> Maybe a
Just Int
bytes Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== RtsPosture -> Maybe Int
rpMaxHeapBytes RtsPosture
rts -> Maybe Text
forall a. Maybe a
Nothing
            | Bool
otherwise -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"-M" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
bytes)

{- | The boot log's posture lines, one decision per line with its provenance. The allocation area
has no config key: the cgroup limit or an operator @GHCRTS@ sets it.
-}
renderEffectivePosture :: EffectiveRuntimePlan -> [Text]
renderEffectivePosture :: EffectiveRuntimePlan -> [Text]
renderEffectivePosture EffectiveRuntimePlan
p =
    [ Text
"runtime: capabilities " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
capabilities Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Provenance -> Text
renderProvenance Provenance
capsProvenance
    , case EffectiveRuntimePlan -> (Maybe Int, Provenance)
effectiveHeapCeiling EffectiveRuntimePlan
p of
        (Just Int
bytes, Provenance
prov) -> Text
"runtime: max heap " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
renderMiB Int
bytes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Provenance -> Text
renderProvenance Provenance
prov
        (Maybe Int
Nothing, Provenance
_) -> Text
"runtime: max heap unbounded (found no cgroup memory limit and no maxHeapBytes or -M, set runtime.maxHeapBytes (ECLUSE_RUNTIME__MAX_HEAP_BYTES) for a ceiling)"
    , Text
"runtime: allocation area "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
renderMiB (EffectiveRuntimePlan -> Int
erpAllocAreaBytes EffectiveRuntimePlan
p)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/capability"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Int
c -> Text
", nursery chunks " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
renderMiB Int
c) (EffectiveRuntimePlan -> Maybe Int
erpNurseryChunkBytes EffectiveRuntimePlan
p)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Provenance -> Text
renderProvenance (EffectiveRuntimePlan -> Provenance
erpAllocAreaProvenance EffectiveRuntimePlan
p)
    ]
  where
    (Int
capabilities, Provenance
capsProvenance) = EffectiveRuntimePlan -> (Int, Provenance)
effectiveCapabilities EffectiveRuntimePlan
p

{- | The boot log's posture warnings: an axis the RTS is not enforcing, and a capability count
no entitlement backs.
-}
renderPostureWarnings :: EffectiveRuntimePlan -> [Text]
renderPostureWarnings :: EffectiveRuntimePlan -> [Text]
renderPostureWarnings EffectiveRuntimePlan
p = EffectiveRuntimePlan -> [Text]
unenforcedWarnings EffectiveRuntimePlan
p [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> EffectiveRuntimePlan -> [Text]
capabilityAdvice EffectiveRuntimePlan
p

{- The last two rungs bound the count without reading an entitlement, so the advice is
conditional in form: the process cannot tell an unlimited pod from bare metal. -}
capabilityAdvice :: EffectiveRuntimePlan -> [Text]
capabilityAdvice :: EffectiveRuntimePlan -> [Text]
capabilityAdvice EffectiveRuntimePlan
p = case EffectiveRuntimePlan -> (Int, Provenance)
effectiveCapabilities EffectiveRuntimePlan
p of
    (Int
n, Provenance
FromCgroupMemory) ->
        [ Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
advice
            (Text
"no cgroup CPU quota binds this process, so capabilities are bounded at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" by what the cgroup memory limit can feed")
            Text
"If this container has a CPU request but no limit, set runtime.cores (ECLUSE_RUNTIME__CORES) to the whole cores requested."
        ]
    (Int
n, Provenance
FromCoresCeiling) ->
        [ Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
advice
            (Text
"found no cgroup CPU or memory limit, so capabilities are capped at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" by runtime.coresCeiling")
            Text
"If a limit exists but Écluse cannot read it, set runtime.cores (ECLUSE_RUNTIME__CORES) and the heap ceiling runtime.maxHeapBytes (ECLUSE_RUNTIME__MAX_HEAP_BYTES) by hand."
        ]
    -- Listed rather than wildcarded, so a new rung has to decide whether it warns.
    (Int
_, Provenance
FromConfig) -> []
    (Int
_, Provenance
FromCgroup) -> []
    (Int
_, Provenance
FromHeapCeiling) -> []
    (Int
_, Provenance
FromRts) -> []
  where
    advice :: a -> a -> a
advice a
reason a
suffix = a
"runtime: " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
reason a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
". " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
suffix

{- One warning per axis the RTS is not enforcing. The budgets size from the effective value, so a
divergence must be legible in the boot log rather than silently absorbed. -}
unenforcedWarnings :: EffectiveRuntimePlan -> [Text]
unenforcedWarnings :: EffectiveRuntimePlan -> [Text]
unenforcedWarnings EffectiveRuntimePlan
p =
    [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
        [ Text -> (Int -> Text) -> EffectiveAxis Int -> Maybe Text
forall a.
Eq a =>
Text -> (a -> Text) -> EffectiveAxis a -> Maybe Text
warnAxis Text
"capabilities" Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (EffectiveRuntimePlan -> EffectiveAxis Int
erpCapabilities EffectiveRuntimePlan
p)
        , Text
-> (Maybe Int -> Text) -> EffectiveAxis (Maybe Int) -> Maybe Text
forall a.
Eq a =>
Text -> (a -> Text) -> EffectiveAxis a -> Maybe Text
warnAxis Text
"max heap" (Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"unbounded" Int -> Text
renderMiB) (EffectiveRuntimePlan -> EffectiveAxis (Maybe Int)
erpMaxHeapBytes EffectiveRuntimePlan
p)
        ]
  where
    warnAxis :: (Eq a) => Text -> (a -> Text) -> EffectiveAxis a -> Maybe Text
    warnAxis :: forall a.
Eq a =>
Text -> (a -> Text) -> EffectiveAxis a -> Maybe Text
warnAxis Text
name a -> Text
render EffectiveAxis a
ax
        | EffectiveAxis a -> Bool
forall a. Eq a => EffectiveAxis a -> Bool
axEnforced EffectiveAxis a
ax = Maybe Text
forall a. Maybe a
Nothing
        | Bool
otherwise =
            Text -> Maybe Text
forall a. a -> Maybe a
Just
                ( Text
"runtime: "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" desired "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
render (EffectiveAxis a -> a
forall a. EffectiveAxis a -> a
axDesired EffectiveAxis a
ax)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but the RTS is running with "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
render (EffectiveAxis a -> a
forall a. EffectiveAxis a -> a
axObserved EffectiveAxis a
ax)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"; budgets use the effective value"
                )

renderProvenance :: Provenance -> Text
renderProvenance :: Provenance -> Text
renderProvenance Provenance
prov = Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Provenance -> Text
provenanceClause Provenance
prov Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | The provenance as a bare clause, for consumers composing their own log lines.
provenanceClause :: Provenance -> Text
provenanceClause :: Provenance -> Text
provenanceClause = \case
    Provenance
FromConfig -> Text
"from config"
    Provenance
FromCgroup -> Text
"derived from the cgroup limit"
    Provenance
FromCgroupMemory -> Text
"bounded by the cgroup memory limit, no CPU quota set"
    Provenance
FromCoresCeiling -> Text
"no cgroup CPU or memory limit found, capped at runtime.coresCeiling"
    Provenance
FromHeapCeiling -> Text
"fitted to the configured heap ceiling"
    Provenance
FromRts -> Text
"as the RTS resolved it"

-- A byte count in MiB: whole when exact, else to one decimal place.
renderMiB :: Int -> Text
renderMiB :: Int -> Text
renderMiB Int
bytes =
    let mib :: Double
mib = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bytes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1024 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1024) :: Double
     in if Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
mib :: Int) Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
mib
            then Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
mib :: Int) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" MiB"
            else FilePath -> Text
forall a. ToText a => a -> Text
toText (Double -> FilePath
showRounded Double
mib) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" MiB"

showRounded :: Double -> String
showRounded :: Double -> FilePath
showRounded Double
x = Double -> FilePath
forall b a. (Show a, IsString b) => a -> b
show (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10) :: Int) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10 :: Double)

{- | Parse a cgroup-v2 @cpu.max@ body. @\"<quota> <period>\"@ yields the granted cores, and the
@max@ sentinel or a malformed body yields 'Nothing': no limit is inferred from noise.
-}
parseCpuMax :: Text -> Maybe Double
parseCpuMax :: Text -> Maybe Double
parseCpuMax Text
body = case Text -> [Text]
T.words (Text -> Text
T.strip Text
body) of
    [Text
quota, Text
period] -> do
        q <- FilePath -> Maybe Double
forall a. Read a => FilePath -> Maybe a
readMaybe (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
quota) :: Maybe Double
        p <- readMaybe (toString period) :: Maybe Double
        guard (q > 0 && p > 0)
        pure (q / p)
    [Text]
_ -> Maybe Double
forall a. Maybe a
Nothing

{- | Parse a cgroup-v2 @memory.max@ body: a byte count, or the unlimited @max@
sentinel ('Nothing'). A malformed body yields 'Nothing'.
-}
parseMemoryMax :: Text -> Maybe Int
parseMemoryMax :: Text -> Maybe Int
parseMemoryMax Text
body = do
    n <- FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe (Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> Text
T.strip Text
body)) :: Maybe Int
    guard (n > 0)
    pure n

-- | The @inactive_file@ bytes in a cgroup-v2 @memory.stat@ body: page cache the kernel reclaims first.
parseInactiveFile :: Text -> Maybe Int
parseInactiveFile :: Text -> Maybe Int
parseInactiveFile Text
body =
    [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe
        [ Int
n
        | Text
line <- Text -> [Text]
forall t. IsText t "lines" => t -> [t]
lines Text
body
        , [Text
"inactive_file", Text
value] <- [Text -> [Text]
T.words Text
line]
        , Just Int
n <- [FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
value)]
        ]

{- | A reader for this process's cgroup memory use less reclaimable file pages, in thousandths of
the tightest @memory.max@ above it. It reads 'Nothing' when no limit binds or a read fails.
-}
cgroupMemoryUse :: IO (IO (Maybe Int))
cgroupMemoryUse :: IO (IO (Maybe Int))
cgroupMemoryUse = do
    selfCgroup <- FilePath -> IO (Maybe Text)
readIfExists FilePath
"/proc/self/cgroup"
    let relative = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"/" (Maybe Text
selfCgroup Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
parseCgroupSelfPath)
        dirs = [FilePath
cgroupRoot FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
suffix | Text
suffix <- Text -> [Text]
ancestorPaths Text
relative]
    limits <- traverse (\FilePath
dir -> (Int -> (FilePath, Int)) -> Maybe Int -> Maybe (FilePath, Int)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
dir,) (Maybe Int -> Maybe (FilePath, Int))
-> IO (Maybe Int) -> IO (Maybe (FilePath, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Int) -> FilePath -> FilePath -> IO (Maybe Int)
forall a. (Text -> Maybe a) -> FilePath -> FilePath -> IO (Maybe a)
limitAt Text -> Maybe Int
parseMemoryMax FilePath
"/memory.max" FilePath
dir) dirs
    pure $ case sortOn snd (catMaybes limits) of
        [] -> Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing
        (FilePath
dir, Int
limit) : [(FilePath, Int)]
_ -> FilePath -> Int -> IO (Maybe Int)
readUse FilePath
dir Int
limit

readUse :: FilePath -> Int -> IO (Maybe Int)
readUse :: FilePath -> Int -> IO (Maybe Int)
readUse FilePath
dir Int
limit = do
    current <- Maybe Int -> Either IOError (Maybe Int) -> Maybe Int
forall b a. b -> Either a b -> b
fromRight Maybe Int
forall a. Maybe a
Nothing (Either IOError (Maybe Int) -> Maybe Int)
-> IO (Either IOError (Maybe Int)) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Int) -> IO (Either IOError (Maybe Int))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOError a)
tryIO ((Text -> Maybe Int) -> FilePath -> FilePath -> IO (Maybe Int)
forall a. (Text -> Maybe a) -> FilePath -> FilePath -> IO (Maybe a)
limitAt Text -> Maybe Int
parseMemoryMax FilePath
"/memory.current" FilePath
dir)
    inactive <- fromRight Nothing <$> tryIO ((>>= parseInactiveFile) <$> readIfExists (dir <> "/memory.stat"))
    pure (usePermille limit inactive <$> current)

-- | Memory in use less reclaimable page cache, in thousandths of the limit, from a cgroup's readings.
usePermille :: Int -> Maybe Int -> Int -> Int
usePermille :: Int -> Maybe Int -> Int -> Int
usePermille Int
limit Maybe Int
inactive Int
current = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
current Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
inactive) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
limit

{- | Resolve the runtime plan and apply it, first thing at boot. It never aborts the boot, and the
plan it returns is the effective one, so downstream sizing computes from what the RTS runs with.
-}
applyRuntimePosture :: (Text -> IO ()) -> (Text -> IO ()) -> RuntimeOverrides -> IO EffectiveRuntimePlan
applyRuntimePosture :: (Text -> IO ())
-> (Text -> IO ()) -> RuntimeOverrides -> IO EffectiveRuntimePlan
applyRuntimePosture Text -> IO ()
logInfo Text -> IO ()
logWarning RuntimeOverrides
overrides = do
    rts <- IO RtsPosture
currentRtsPosture
    cgroup <- readCgroupLimits
    let plan = RuntimeOverrides -> CgroupLimits -> RtsPosture -> RuntimePlan
resolveRuntimePlan RuntimeOverrides
overrides CgroupLimits
cgroup RtsPosture
rts
        flags = RtsPosture -> RuntimePlan -> [Text]
requiredRtsFlags RtsPosture
rts RuntimePlan
plan
    alreadyApplied <- isJust <$> lookupEnv reexecMarker
    case flags of
        [] -> IO ()
forall (f :: * -> *). Applicative f => f ()
pass
        [Text]
_ | Bool
alreadyApplied -> (Text -> IO ()) -> [Text] -> IO ()
warnStillDivergent Text -> IO ()
logWarning [Text]
flags
        [Text
capsOnly]
            | Text
"-N" Text -> Text -> Bool
`T.isPrefixOf` Text
capsOnly ->
                Int -> IO ()
setNumCapabilities ((Int, Provenance) -> Int
forall a b. (a, b) -> a
fst (RuntimePlan -> (Int, Provenance)
planCapabilities RuntimePlan
plan))
        [Text]
_ -> (Text -> IO ()) -> (Text -> IO ()) -> [Text] -> IO ()
reexecOrWarn Text -> IO ()
logInfo Text -> IO ()
logWarning [Text]
flags
    -- Reached only when no exec happened or the exec failed: a successful exec never returns.
    applied <- currentRtsPosture
    let effective = CgroupLimits -> RuntimePlan -> RtsPosture -> EffectiveRuntimePlan
reconcileRuntimePlan CgroupLimits
cgroup RuntimePlan
plan RtsPosture
applied
    traverse_ logInfo (renderEffectivePosture effective)
    traverse_ logWarning (renderPostureWarnings effective)
    pure effective

-- The already-re-launched process found its plan still unapplied: warn and
-- continue with the live posture.
warnStillDivergent :: (Text -> IO ()) -> [Text] -> IO ()
warnStillDivergent :: (Text -> IO ()) -> [Text] -> IO ()
warnStillDivergent Text -> IO ()
logWarning [Text]
flags =
    Text -> IO ()
logWarning
        ( Text
"runtime: the resolved plan still requires "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " [Text]
flags
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" after re-launch; an operator GHCRTS may be overriding the configuration, or the RTS rejected a flag. Continuing with the live posture."
        )

{- Tuning must never take the service down. A failed exec degrades to a warning and an unenforced
posture, never an abort. The exec returns only on failure. -}
reexecOrWarn :: (Text -> IO ()) -> (Text -> IO ()) -> [Text] -> IO ()
reexecOrWarn :: (Text -> IO ()) -> (Text -> IO ()) -> [Text] -> IO ()
reexecOrWarn Text -> IO ()
logInfo Text -> IO ()
logWarning [Text]
flags =
    IO () -> IO (Either IOError ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOError a)
tryIO ((Text -> IO ()) -> [Text] -> IO ()
reexecWith Text -> IO ()
logInfo [Text]
flags) IO (Either IOError ()) -> (Either IOError () -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left IOError
err ->
            Text -> IO ()
logWarning
                ( Text
"runtime: re-launching to apply "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " [Text]
flags
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed ("
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOError -> Text
forall b a. (Show a, IsString b) => a -> b
show IOError
err
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"); continuing with the live posture, unenforced."
                )
        Right () -> IO ()
forall (f :: * -> *). Applicative f => f ()
pass

-- The live RTS posture, converted from the flag fields' 4 KiB blocks to bytes.
currentRtsPosture :: IO RtsPosture
currentRtsPosture :: IO RtsPosture
currentRtsPosture = do
    capabilities <- IO Int
getNumCapabilities
    processors <- getNumProcessors
    gc <- getGCFlags
    let blocks a
n = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rtsBlockBytes
    pure
        RtsPosture
            { rpCapabilities = capabilities
            , rpProcessors = processors
            , rpAllocAreaBytes = blocks (minAllocAreaSize gc)
            , rpNurseryChunkBytes = nonZero (blocks (nurseryChunkSize gc))
            , rpMaxHeapBytes = nonZero (blocks (maxHeapSize gc))
            }
  where
    nonZero :: a -> Maybe a
nonZero a
n = if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
n

-- The RTS flag fields ('minAllocAreaSize', 'nurseryChunkSize', 'maxHeapSize') count blocks of
-- this many bytes (GHC 9.10: -A64m reads back as 16384, -M500m as 128000).
rtsBlockBytes :: Int
rtsBlockBytes :: Int
rtsBlockBytes = Int
4096

{- The cgroup-v2 limits binding this process: its own cgroup and every ancestor up to the mount
root, each axis taking the tightest. The leaf alone would miss a limit sitting on a parent slice. -}
readCgroupLimits :: IO CgroupLimits
readCgroupLimits :: IO CgroupLimits
readCgroupLimits = do
    selfCgroup <- FilePath -> IO (Maybe Text)
readIfExists FilePath
"/proc/self/cgroup"
    let relative = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"/" (Maybe Text
selfCgroup Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
parseCgroupSelfPath)
        dirs = [FilePath
cgroupRoot FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
suffix | Text
suffix <- Text -> [Text]
ancestorPaths Text
relative]
    cpus <- traverse (limitAt parseCpuMax "/cpu.max") dirs
    memories <- traverse (limitAt parseMemoryMax "/memory.max") dirs
    pure
        CgroupLimits
            { cgCpuCores = tightest cpus
            , cgMemoryMaxBytes = tightest memories
            }

cgroupRoot :: FilePath
cgroupRoot :: FilePath
cgroupRoot = FilePath
"/sys/fs/cgroup"

limitAt :: (Text -> Maybe a) -> String -> FilePath -> IO (Maybe a)
limitAt :: forall a. (Text -> Maybe a) -> FilePath -> FilePath -> IO (Maybe a)
limitAt Text -> Maybe a
parse FilePath
file FilePath
dir = (Maybe Text -> (Text -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe a
parse) (Maybe Text -> Maybe a) -> IO (Maybe Text) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe Text)
readIfExists (FilePath
dir FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
file)

tightest :: (Ord a) => [Maybe a] -> Maybe a
tightest :: forall a. Ord a => [Maybe a] -> Maybe a
tightest [Maybe a]
found = case [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe a]
found of
    [] -> Maybe a
forall a. Maybe a
Nothing
    (a
x : [a]
xs) -> a -> Maybe a
forall a. a -> Maybe a
Just ((a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Ord a => a -> a -> a
min a
x [a]
xs)

-- | Read a file that may be absent, as off a cgroup-v2 host. Every other IO error propagates.
readIfExists :: FilePath -> IO (Maybe Text)
readIfExists :: FilePath -> IO (Maybe Text)
readIfExists FilePath
path =
    Either () Text -> Maybe Text
forall l r. Either l r -> Maybe r
rightToMaybe (Either () Text -> Maybe Text)
-> IO (Either () Text) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IOError -> Maybe ()) -> IO Text -> IO (Either () Text)
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError) (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
readFileBS FilePath
path)

{- The process's cgroup-v2 path from a @\/proc\/self\/cgroup@ body: the @0::@ line's path
(@"0::\/a\/b"@ yields @"\/a\/b"@). 'Nothing' on a pure cgroup-v1 host.
-}
parseCgroupSelfPath :: Text -> Maybe Text
parseCgroupSelfPath :: Text -> Maybe Text
parseCgroupSelfPath Text
body =
    [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ((Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Text -> Maybe Text
T.stripPrefix Text
"0::") (Text -> [Text]
forall t. IsText t "lines" => t -> [t]
lines (Text -> Text
T.strip Text
body)))

{- A cgroup path and its ancestors, leaf first, ending at the root (the empty suffix).
@"\/a\/b"@ yields @["\/a\/b", "\/a", ""]@, and @"\/"@ yields just @[""]@.
-}
ancestorPaths :: Text -> [Text]
ancestorPaths :: Text -> [Text]
ancestorPaths Text
path = case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" (Text -> Text
T.strip Text
path)) of
    [] -> [Text
""]
    [Text]
segments ->
        [[Text] -> Text
T.concat [Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
seg | Text
seg <- Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
n [Text]
segments] | Int
n <- [[Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
segments, [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
segments Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 .. Int
1]] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
""]

{- The one-shot guard for the exec-in-place. It sits outside the @ECLUSE_@ prefix because the
environment config layer rejects every unknown key under that prefix. -}
reexecMarker :: String
reexecMarker :: FilePath
reexecMarker = FilePath
"__ECLUSE_RUNTIME_RTS_APPLIED"

{- Exec this binary in place with the required flags appended to @GHCRTS@, where a later flag wins
(GHC 9.10). Same arguments and same PID, so a container supervisor sees one uninterrupted process. -}
reexecWith :: (Text -> IO ()) -> [Text] -> IO ()
reexecWith :: (Text -> IO ()) -> [Text] -> IO ()
reexecWith Text -> IO ()
logInfo [Text]
flags = do
    self <- IO FilePath
getExecutablePath
    args <- getArgs
    env <- getEnvironment
    let prior = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((FilePath, FilePath) -> FilePath)
-> Maybe (FilePath, FilePath) -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> Maybe (FilePath, FilePath)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"GHCRTS") (FilePath -> Bool)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst) [(FilePath, FilePath)]
env
        appended = Text -> (FilePath -> Text) -> Maybe FilePath -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
newFlags (\FilePath
p -> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newFlags) Maybe FilePath
prior
        env' =
            ((FilePath
"GHCRTS", Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
appended) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:)
                ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [(FilePath, FilePath)]
-> [(FilePath, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath
reexecMarker, FilePath
"1") (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:)
                ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [(FilePath, FilePath)]
-> [(FilePath, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(FilePath
k, FilePath
_) -> FilePath
k FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"GHCRTS" Bool -> Bool -> Bool
&& FilePath
k FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
reexecMarker)
                ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)]
env
    logInfo ("runtime: re-launching with GHCRTS " <> appended <> " to apply the resolved plan (same process, exec in place)")
    executeFile self False args (Just env')
  where
    newFlags :: Text
newFlags = Text -> [Text] -> Text
T.intercalate Text
" " [Text]
flags