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

{- | Resolve independent CPU and metadata ingest controls beside the memory tenants.
Tenant accounting guides sizing and shedding. Configured storage bounds retain their override
checks, and every control emits a boot-log line.
-}
module Ecluse.Composition.MemoryPlan (
    -- * The plan and its tenants
    MemoryPlan (..),
    PublishTenant (..),
    MirrorArtifactTenant (..),
    QueueTenantDemand (..),
    queueTenantDemand,
    TransientBudget (..),

    -- * Resolution
    resolveMemoryPlan,
    planCacheConfig,
    mirrorArtifactEnvelopeMultiplier,
    mirrorArtifactBytesCap,
) where

import Data.Ord (clamp)

import Ecluse.Composition.MemoryPlan.Bounds (
    anyMountMirrors,
    cacheBytesFallback,
    cacheEntriesCap,
    cacheEntriesFloor,
    cacheEntryExpectedBytes,
    fixedBufferBytes,
    memoryQueueCharged,
    mirrorArtifactBytesCap,
    mirrorArtifactEnvelopeMultiplier,
    publishAggregateFallbackRequests,
    queueCharge,
    queueDepthFallback,
    requestBytesFallback,
    responseBytesFallback,
 )
import Ecluse.Composition.MemoryPlan.Demands (tenantDemands)
import Ecluse.Composition.MemoryPlan.Internal (OverridePins (..), PlanInputs (..), ShedOutcomes (..), TenantDemands (..))
import Ecluse.Composition.MemoryPlan.Override (configuredPins, overrideViolationsFor)
import Ecluse.Composition.MemoryPlan.Render (localCachePolicyLine, renderControlWarnings, renderDegradations, renderPlanLines)
import Ecluse.Composition.MemoryPlan.Shed (cacheEntryBound, shedToFit)
import Ecluse.Composition.MemoryPlan.Transient (renderTransientBudget, transientBudget)
import Ecluse.Composition.MemoryPlan.Types (
    MemoryPlan (..),
    MirrorArtifactTenant (..),
    PublishTenant (..),
    QueueTenantDemand (..),
    TransientBudget (..),
    queueTenantDemand,
 )
import Ecluse.Composition.Sizing (resolveServeAdmission, resolveSized)
import Ecluse.Config (CacheSettings (..), LimitsSettings, QueueSettings)
import Ecluse.Core.Server.Cache (CacheConfig (..), StoreBudget (..))
import Ecluse.Rts (EffectiveRuntimePlan (erpAllocAreaBytes), effectiveCapabilities, effectiveHeapCeiling, provenanceClause)

{- | Resolve the memory plan and its boot lines. The caller selects the mirror-queue
backend first, since 'QueueTenantDemand' projects from that choice.
-}
resolveMemoryPlan ::
    CacheSettings ->
    LimitsSettings ->
    QueueSettings ->
    Maybe Int ->
    EffectiveRuntimePlan ->
    QueueTenantDemand ->
    Bool ->
    (MemoryPlan, [Text])
resolveMemoryPlan :: CacheSettings
-> LimitsSettings
-> QueueSettings
-> Maybe Int
-> EffectiveRuntimePlan
-> QueueTenantDemand
-> Bool
-> (MemoryPlan, [Text])
resolveMemoryPlan CacheSettings
cacheSettings LimitsSettings
limitsSettings QueueSettings
queueSettings Maybe Int
explicitAdmission EffectiveRuntimePlan
runtime QueueTenantDemand
queueDemand Bool
publishConfigured =
    (MemoryPlan, [Text])
-> (Int -> (MemoryPlan, [Text]))
-> Maybe Int
-> (MemoryPlan, [Text])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PlanInputs -> (MemoryPlan, [Text])
fallbackPlan PlanInputs
inputs) (PlanInputs -> Int -> (MemoryPlan, [Text])
solvedPlan PlanInputs
inputs) Maybe Int
heapCeiling
  where
    (Maybe Int
heapCeiling, Provenance
ceilingProvenance) = EffectiveRuntimePlan -> (Maybe Int, Provenance)
effectiveHeapCeiling EffectiveRuntimePlan
runtime
    (Int
capabilities, Provenance
_) = EffectiveRuntimePlan -> (Int, Provenance)
effectiveCapabilities EffectiveRuntimePlan
runtime
    -- The explicit serveMaxInFlight wins inside this one.
    (Int
cpuAdmission, Text
cpuAdmissionLine) = Maybe Int -> Int -> (Int, Text)
resolveServeAdmission Maybe Int
explicitAdmission Int
capabilities
    inputs :: PlanInputs
inputs =
        PlanInputs
            { piCache :: CacheSettings
piCache = CacheSettings
cacheSettings
            , piLimits :: LimitsSettings
piLimits = LimitsSettings
limitsSettings
            , piQueue :: QueueSettings
piQueue = QueueSettings
queueSettings
            , piExplicitAdmission :: Maybe Int
piExplicitAdmission = Maybe Int
explicitAdmission
            , piPublishConfigured :: Bool
piPublishConfigured = Bool
publishConfigured
            , piQueueDemand :: QueueTenantDemand
piQueueDemand = QueueTenantDemand
queueDemand
            , piCapabilities :: Int
piCapabilities = Int
capabilities
            , piAllocAreaBytes :: Int
piAllocAreaBytes = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (EffectiveRuntimePlan -> Int
erpAllocAreaBytes EffectiveRuntimePlan
runtime)
            , piCpuAdmission :: Int
piCpuAdmission = Int
cpuAdmission
            , piCpuAdmissionLine :: Text
piCpuAdmissionLine = Text
cpuAdmissionLine
            , piCeilingClause :: Text
piCeilingClause = Provenance -> Text
provenanceClause Provenance
ceilingProvenance
            }

-- The solved plan over a heap ceiling h. The arithmetic stays apart from the boot-log
-- prose, so the sum-within-ceiling invariant reads on its own.
solvedPlan :: PlanInputs -> Int -> (MemoryPlan, [Text])
solvedPlan :: PlanInputs -> Int -> (MemoryPlan, [Text])
solvedPlan PlanInputs
inputs Int
h =
    ( MemoryPlan
        { mpRuntimeReserveBytes :: Int
mpRuntimeReserveBytes = TenantDemands -> Int
tdReserve TenantDemands
demands
        , mpCacheAggregateBytes :: Int
mpCacheAggregateBytes = ShedOutcomes -> Int
soCacheFinal ShedOutcomes
outcomes
        , mpCacheMaxEntries :: Int
mpCacheMaxEntries = TenantDemands -> ShedOutcomes -> Int
cacheEntryBound TenantDemands
demands ShedOutcomes
outcomes
        , mpMaxResponseBytes :: Int
mpMaxResponseBytes = ShedOutcomes -> Int
soResponseFinal ShedOutcomes
outcomes
        , mpMaxRequestBytes :: Int
mpMaxRequestBytes = TenantDemands -> Int
tdRequestFinal TenantDemands
demands
        , mpAdmissionCapacity :: Int
mpAdmissionCapacity = ShedOutcomes -> Int
soAdmissionFinal ShedOutcomes
outcomes
        , mpPublishTenant :: Maybe PublishTenant
mpPublishTenant = TenantDemands -> ShedOutcomes -> Maybe PublishTenant
publishTenantOf TenantDemands
demands ShedOutcomes
outcomes
        , mpMirrorArtifactTenant :: Maybe MirrorArtifactTenant
mpMirrorArtifactTenant = TenantDemands -> ShedOutcomes -> Maybe MirrorArtifactTenant
mirrorArtifactTenantOf TenantDemands
demands ShedOutcomes
outcomes
        , mpQueueMemoryMaxDepth :: Int
mpQueueMemoryMaxDepth = ShedOutcomes -> Int
soDepthFinal ShedOutcomes
outcomes
        , mpQueueTenantBytes :: Int
mpQueueTenantBytes = ShedOutcomes -> Int
soQueueTenantBytes ShedOutcomes
outcomes
        , mpFixedBufferBytes :: Int
mpFixedBufferBytes = TenantDemands -> Int
tdFixedBuffers TenantDemands
demands
        , mpTransientBudget :: TransientBudget
mpTransientBudget = TransientBudget
transient
        , mpDegradations :: [Text]
mpDegradations = TenantDemands -> ShedOutcomes -> [Text]
renderDegradations TenantDemands
demands ShedOutcomes
outcomes
        , mpOverrideViolations :: [Text]
mpOverrideViolations = TenantDemands -> ShedOutcomes -> [Text]
overrideViolationsFor TenantDemands
demands ShedOutcomes
outcomes
        }
    , PlanInputs -> TenantDemands -> ShedOutcomes -> [Text]
renderPlanLines PlanInputs
inputs TenantDemands
demands ShedOutcomes
outcomes [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [TransientBudget -> Text
renderTransientBudget TransientBudget
transient]
    )
  where
    demands :: TenantDemands
demands = PlanInputs -> Int -> TenantDemands
tenantDemands PlanInputs
inputs Int
h
    -- Retained tenants only. Publish bodies and mirror artifacts are byte-admitted on their own,
    -- and the sampler measures what they hold after each major collection.
    tenants :: Int
tenants = ShedOutcomes -> Int
soCacheFinal ShedOutcomes
outcomes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShedOutcomes -> Int
soQueueTenantBytes ShedOutcomes
outcomes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TenantDemands -> Int
tdFixedBuffers TenantDemands
demands
    transient :: TransientBudget
transient = Maybe Int -> Int -> Int -> Int -> TransientBudget
transientBudget (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h) (PlanInputs -> Int
piCapabilities PlanInputs
inputs) (PlanInputs -> Int
piAllocAreaBytes PlanInputs
inputs) Int
tenants
    outcomes :: ShedOutcomes
outcomes = TenantDemands -> ShedOutcomes
shedToFit TenantDemands
demands

{- No ceiling datapoint: the shipped fallback bounds and admission from the CPU alone.
Nothing bounds the sum, so there is no tenant arithmetic to check. -}
fallbackPlan :: PlanInputs -> (MemoryPlan, [Text])
fallbackPlan :: PlanInputs -> (MemoryPlan, [Text])
fallbackPlan PlanInputs
inputs =
    ( MemoryPlan
        { mpRuntimeReserveBytes :: Int
mpRuntimeReserveBytes = Int
0
        , mpCacheAggregateBytes :: Int
mpCacheAggregateBytes = Int
cacheBytes
        , mpCacheMaxEntries :: Int
mpCacheMaxEntries = Int
cacheEntries
        , mpMaxResponseBytes :: Int
mpMaxResponseBytes = Int
responseBytes
        , mpMaxRequestBytes :: Int
mpMaxRequestBytes = Int
requestBytes
        , mpAdmissionCapacity :: Int
mpAdmissionCapacity = PlanInputs -> Int
piCpuAdmission PlanInputs
inputs
        , mpPublishTenant :: Maybe PublishTenant
mpPublishTenant = Maybe PublishTenant
publishTenant
        , mpMirrorArtifactTenant :: Maybe MirrorArtifactTenant
mpMirrorArtifactTenant = Maybe MirrorArtifactTenant
mirrorArtifactTenant
        , mpQueueMemoryMaxDepth :: Int
mpQueueMemoryMaxDepth = Int
queueDepth
        , mpQueueTenantBytes :: Int
mpQueueTenantBytes = Bool -> Int -> Int
queueCharge (QueueTenantDemand -> Bool
memoryQueueCharged QueueTenantDemand
demand) Int
queueDepth
        , mpFixedBufferBytes :: Int
mpFixedBufferBytes = QueueTenantDemand -> Int
fixedBufferBytes QueueTenantDemand
demand
        , mpTransientBudget :: TransientBudget
mpTransientBudget = TransientBudget
transient
        , mpDegradations :: [Text]
mpDegradations = OverridePins -> Int -> Int -> [Text]
renderControlWarnings OverridePins
pins (PlanInputs -> Int
piCpuAdmission PlanInputs
inputs) Int
responseBytes
        , mpOverrideViolations :: [Text]
mpOverrideViolations = []
        }
    , [Text
localCachePolicyLine, PlanInputs -> Text
piCpuAdmissionLine PlanInputs
inputs, Text
responseLine, Text
requestLine, Text
cacheBytesLine, Text
cacheEntriesLine, Text
queueDepthLine]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
artifactLine | QueueTenantDemand -> Bool
anyMountMirrors QueueTenantDemand
demand]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [TransientBudget -> Text
renderTransientBudget TransientBudget
transient]
    )
  where
    transient :: TransientBudget
transient = Maybe Int -> Int -> Int -> Int -> TransientBudget
transientBudget Maybe Int
forall a. Maybe a
Nothing (PlanInputs -> Int
piCapabilities PlanInputs
inputs) (PlanInputs -> Int
piAllocAreaBytes PlanInputs
inputs) (Int
cacheBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int -> Int
queueCharge (QueueTenantDemand -> Bool
memoryQueueCharged QueueTenantDemand
demand) Int
queueDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ QueueTenantDemand -> Int
fixedBufferBytes QueueTenantDemand
demand)
    demand :: QueueTenantDemand
demand = PlanInputs -> QueueTenantDemand
piQueueDemand PlanInputs
inputs
    pins :: OverridePins
pins = PlanInputs -> OverridePins
configuredPins PlanInputs
inputs
    (Int
responseBytes, Text
responseLine) = Text -> Maybe Int -> Int -> Text -> (Int, Text)
forall a. Show a => Text -> Maybe a -> a -> Text -> (a, Text)
resolveSized Text
"memory plan: metadata ingest ceiling" (OverridePins -> Maybe Int
opResponse OverridePins
pins) Int
responseBytesFallback Text
"built-in default, independent of heap and CPU"
    (Int
requestBytes, Text
requestLine) = Text -> Maybe Int -> Int -> (Int, Text)
fallbackOr Text
"request byte cap" (OverridePins -> Maybe Int
opRequest OverridePins
pins) Int
requestBytesFallback
    (Int
cacheBytes, Text
cacheBytesLine) = Text -> Maybe Int -> Int -> (Int, Text)
fallbackOr Text
"cache byte bound" (OverridePins -> Maybe Int
opCache OverridePins
pins) Int
cacheBytesFallback
    (Int
cacheEntries, Text
cacheEntriesLine) = Text -> Maybe Int -> Int -> (Int, Text)
fallbackOr Text
"cache entry bound" (CacheSettings -> Maybe Int
csMaxEntries (PlanInputs -> CacheSettings
piCache PlanInputs
inputs)) ((Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
cacheEntriesFloor, Int
cacheEntriesCap) (Int
cacheBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
cacheEntryExpectedBytes))
    (Int
queueDepth, Text
queueDepthLine) = Text -> Maybe Int -> Int -> (Int, Text)
fallbackOr Text
"memory-queue depth" (OverridePins -> Maybe Int
opDepth OverridePins
pins) Int
queueDepthFallback
    (Int
artifactBytes, Text
artifactLine) = Text -> Maybe Int -> Int -> (Int, Text)
fallbackOr Text
"mirror artifact byte cap" (OverridePins -> Maybe Int
opArtifact OverridePins
pins) Int
mirrorArtifactBytesCap
    publishTenant :: Maybe PublishTenant
publishTenant = PublishTenant{ptAggregateBytes :: Int
ptAggregateBytes = Int
publishAggregateFallbackRequests Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
requestBytes} PublishTenant -> Maybe () -> Maybe PublishTenant
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (PlanInputs -> Bool
piPublishConfigured PlanInputs
inputs)
    mirrorArtifactTenant :: Maybe MirrorArtifactTenant
mirrorArtifactTenant = MirrorArtifactTenant{matMaxBytes :: Int
matMaxBytes = Int
artifactBytes} MirrorArtifactTenant -> Maybe () -> Maybe MirrorArtifactTenant
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (QueueTenantDemand -> Bool
anyMountMirrors QueueTenantDemand
demand)

fallbackOr :: Text -> Maybe Int -> Int -> (Int, Text)
fallbackOr :: Text -> Maybe Int -> Int -> (Int, Text)
fallbackOr Text
name Maybe Int
explicit Int
fallback =
    Text -> Maybe Int -> Int -> Text -> (Int, Text)
forall a. Show a => Text -> Maybe a -> a -> Text -> (a, Text)
resolveSized (Text
"memory plan: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) Maybe Int
explicit Int
fallback Text
"built-in default, no heap-ceiling datapoint"

publishTenantOf :: TenantDemands -> ShedOutcomes -> Maybe PublishTenant
publishTenantOf :: TenantDemands -> ShedOutcomes -> Maybe PublishTenant
publishTenantOf TenantDemands
d ShedOutcomes
o = PublishTenant{ptAggregateBytes :: Int
ptAggregateBytes = ShedOutcomes -> Int
soPublishFinal ShedOutcomes
o} PublishTenant -> Maybe () -> Maybe PublishTenant
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TenantDemands -> Bool
tdPublishConfigured TenantDemands
d)

mirrorArtifactTenantOf :: TenantDemands -> ShedOutcomes -> Maybe MirrorArtifactTenant
mirrorArtifactTenantOf :: TenantDemands -> ShedOutcomes -> Maybe MirrorArtifactTenant
mirrorArtifactTenantOf TenantDemands
d ShedOutcomes
o = MirrorArtifactTenant{matMaxBytes :: Int
matMaxBytes = ShedOutcomes -> Int
soArtifactCapFinal ShedOutcomes
o} MirrorArtifactTenant -> Maybe () -> Maybe MirrorArtifactTenant
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TenantDemands -> Bool
tdMirrors TenantDemands
d)

-- | Apply one aggregate bound to eligible stores. Zero floors reserve no static shares.
planCacheConfig :: CacheSettings -> MemoryPlan -> CacheConfig
planCacheConfig :: CacheSettings -> MemoryPlan -> CacheConfig
planCacheConfig CacheSettings
cacheSettings MemoryPlan
plan =
    CacheConfig
        { cacheTtl :: NominalDiffTime
cacheTtl = CacheSettings -> NominalDiffTime
csTtl CacheSettings
cacheSettings
        , cacheMaxEntries :: Int
cacheMaxEntries = MemoryPlan -> Int
mpCacheMaxEntries MemoryPlan
plan
        , cacheMaxBytes :: Int
cacheMaxBytes = MemoryPlan -> Int
mpCacheAggregateBytes MemoryPlan
plan
        , cacheVersionBudget :: StoreBudget
cacheVersionBudget = Int -> Int -> StoreBudget
StoreBudget Int
0 Int
0
        , cacheAssembledBudget :: StoreBudget
cacheAssembledBudget = Int -> Int -> StoreBudget
StoreBudget Int
0 Int
0
        }