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

-- | Reclaim tenant bytes in priority order while preserving explicit storage pins.
module Ecluse.Composition.MemoryPlan.Shed (
    shedToFit,
    cacheEntryBound,
) where

import Data.Ord (clamp)

import Ecluse.Composition.MemoryPlan.Bounds (
    cacheEntriesCap,
    cacheEntriesFloor,
    cacheEntryExpectedBytes,
    mirrorArtifactEnvelopeMultiplier,
    queueCharge,
    queueDepthFloor,
 )
import Ecluse.Composition.MemoryPlan.Internal (
    OverridePins (opArtifact, opCache, opDepth),
    ShedOutcomes (..),
    TenantDemands (..),
 )
import Ecluse.Core.Server.MemoryModel (mirrorJobEstimatedBytes)

{- | Walk the shed ladder: every tenant at its desired share, then shed in step order until
the sum fits or every tenant hits its minimum. The residual is what shedding cannot reclaim.
-}
shedToFit :: TenantDemands -> ShedOutcomes
shedToFit :: TenantDemands -> ShedOutcomes
shedToFit TenantDemands
d =
    ShedOutcomes
        { soMirrorShed :: Int
soMirrorShed = ShedStep -> Int
stepShed ShedStep
mirrorStep
        , soArtifactCapFinal :: Int
soArtifactCapFinal = Int
artifactCapFinal
        , soCacheShed :: Int
soCacheShed = ShedStep -> Int
stepShed ShedStep
cacheStep
        , soCacheFinal :: Int
soCacheFinal = ShedStep -> Int
stepFinal ShedStep
cacheStep
        , soAdmissionFinal :: Int
soAdmissionFinal = TenantDemands -> Int
tdAdmissionDesired TenantDemands
d
        , soResponseFinal :: Int
soResponseFinal = TenantDemands -> Int
tdResponseFinal TenantDemands
d
        , soPublishShed :: Int
soPublishShed = ShedStep -> Int
stepShed ShedStep
publishStep
        , soPublishFinal :: Int
soPublishFinal = ShedStep -> Int
stepFinal ShedStep
publishStep
        , soQueueShedBytes :: Int
soQueueShedBytes = QueueOutcome -> Int
qoShed QueueOutcome
queue
        , soDepthFinal :: Int
soDepthFinal = QueueOutcome -> Int
qoDepthFinal QueueOutcome
queue
        , soQueueTenantBytes :: Int
soQueueTenantBytes = QueueOutcome -> Int
qoTenantBytes QueueOutcome
queue
        , soResidualOvershoot :: Int
soResidualOvershoot = QueueOutcome -> Int
qoResidual QueueOutcome
queue
        }
  where
    mirrorStep :: ShedStep
mirrorStep = TenantDemands -> Int -> ShedStep
shedMirrorStep TenantDemands
d (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (TenantDemands -> Int
desiredTenantSum TenantDemands
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- TenantDemands -> Int
tdCeiling TenantDemands
d))
    -- The surviving cap after shedding: an explicit cap stands, and a computed one is
    -- the shed charge divided back down by the envelope multiplier.
    artifactCapFinal :: Int
artifactCapFinal = case OverridePins -> Maybe Int
opArtifact (TenantDemands -> OverridePins
tdPins TenantDemands
d) of
        Just Int
n -> Int
n
        Maybe Int
Nothing -> ShedStep -> Int
stepFinal ShedStep
mirrorStep Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
mirrorArtifactEnvelopeMultiplier
    cacheStep :: ShedStep
cacheStep = TenantDemands -> Int -> ShedStep
shedCacheStep TenantDemands
d (ShedStep -> Int
stepResidual ShedStep
mirrorStep)
    publishStep :: ShedStep
publishStep = TenantDemands -> Int -> ShedStep
shedPublishStep TenantDemands
d (ShedStep -> Int
stepResidual ShedStep
cacheStep)
    queue :: QueueOutcome
queue = TenantDemands -> Int -> QueueOutcome
shedQueueStep TenantDemands
d (ShedStep -> Int
stepResidual ShedStep
publishStep)

-- Every tenant at its desired share. What this overshoots is what the ladder must reclaim.
desiredTenantSum :: TenantDemands -> Int
desiredTenantSum :: TenantDemands -> Int
desiredTenantSum TenantDemands
d =
    TenantDemands -> Int
tdReserve TenantDemands
d
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TenantDemands -> Int
tdFixedBuffers TenantDemands
d
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TenantDemands -> Int
tdMirrorChargeDesired TenantDemands
d
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TenantDemands -> Int
tdCacheDesired TenantDemands
d
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if TenantDemands -> Bool
tdPublishConfigured TenantDemands
d then TenantDemands -> Int
tdPublishDesired TenantDemands
d else Int
0)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int -> Int
queueCharge (TenantDemands -> Bool
tdMemoryBacked TenantDemands
d) (TenantDemands -> Int
tdDepthDesired TenantDemands
d)

-- One shed-ladder step: give up as much of a tenant's reclaimable bytes as the residual
-- overshoot demands. 'stepResidual' is the overshoot the next step inherits.
data ShedStep = ShedStep
    { ShedStep -> Int
stepShed :: Int
    , ShedStep -> Int
stepFinal :: Int
    , ShedStep -> Int
stepResidual :: Int
    }

shedStep :: Int -> Int -> Int -> ShedStep
shedStep :: Int -> Int -> Int -> ShedStep
shedStep Int
overshoot Int
desired Int
reclaimable =
    ShedStep{stepShed :: Int
stepShed = Int
shed, stepFinal :: Int
stepFinal = Int
desired Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
shed, stepResidual :: Int
stepResidual = Int
overshoot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
shed}
  where
    shed :: Int
shed = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
overshoot Int
reclaimable

-- Step 0: the mirror-artifact cap gives way first, to zero if needed. The plan surrenders
-- the background back-fill leg before the serve hot path.
shedMirrorStep :: TenantDemands -> Int -> ShedStep
shedMirrorStep :: TenantDemands -> Int -> ShedStep
shedMirrorStep TenantDemands
d Int
overshoot =
    Int -> Int -> Int -> ShedStep
shedStep Int
overshoot Int
desired (if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (OverridePins -> Maybe Int
opArtifact (TenantDemands -> OverridePins
tdPins TenantDemands
d)) then Int
0 else Int
desired)
  where
    desired :: Int
desired = TenantDemands -> Int
tdMirrorChargeDesired TenantDemands
d

-- Step 1: the cache gives way next, to zero if needed (never an explicit one).
shedCacheStep :: TenantDemands -> Int -> ShedStep
shedCacheStep :: TenantDemands -> Int -> ShedStep
shedCacheStep TenantDemands
d Int
overshoot =
    Int -> Int -> Int -> ShedStep
shedStep Int
overshoot Int
desired (if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (OverridePins -> Maybe Int
opCache (TenantDemands -> OverridePins
tdPins TenantDemands
d)) then Int
0 else Int
desired)
  where
    desired :: Int
desired = TenantDemands -> Int
tdCacheDesired TenantDemands
d

-- Step 2: the publish aggregate shrinks to one maximum request.
shedPublishStep :: TenantDemands -> Int -> ShedStep
shedPublishStep :: TenantDemands -> Int -> ShedStep
shedPublishStep TenantDemands
d Int
overshoot =
    Int -> Int -> Int -> ShedStep
shedStep Int
overshoot Int
desired (if TenantDemands -> Bool
tdPublishConfigured TenantDemands
d then Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
desired Int -> Int -> Int
forall a. Num a => a -> a -> a
- TenantDemands -> Int
tdRequestFinal TenantDemands
d) else Int
0)
  where
    desired :: Int
desired = TenantDemands -> Int
tdPublishDesired TenantDemands
d

-- The queue tenant after shedding: bytes shed, the depth cap (in jobs), and the bytes
-- that depth charges.
data QueueOutcome = QueueOutcome
    { QueueOutcome -> Int
qoShed :: Int
    , QueueOutcome -> Int
qoDepthFinal :: Int
    , QueueOutcome -> Int
qoTenantBytes :: Int
    , QueueOutcome -> Int
qoResidual :: Int
    }

-- Step 3: the memory-queue depth to its floor (never an explicit one).
shedQueueStep :: TenantDemands -> Int -> QueueOutcome
shedQueueStep :: TenantDemands -> Int -> QueueOutcome
shedQueueStep TenantDemands
d Int
overshoot =
    QueueOutcome
        { qoShed :: Int
qoShed = Int
queueShedBytes
        , qoDepthFinal :: Int
qoDepthFinal = Int
depthFinal
        , qoTenantBytes :: Int
qoTenantBytes = Int -> Int
charge Int
depthFinal
        , qoResidual :: Int
qoResidual = Int
overshoot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
queueShedBytes
        }
  where
    charge :: Int -> Int
charge = Bool -> Int -> Int
queueCharge (TenantDemands -> Bool
tdMemoryBacked TenantDemands
d)
    depthDesired :: Int
depthDesired = TenantDemands -> Int
tdDepthDesired TenantDemands
d
    depthExplicit :: Maybe Int
depthExplicit = OverridePins -> Maybe Int
opDepth (TenantDemands -> OverridePins
tdPins TenantDemands
d)
    depthReclaimableBytes :: Int
depthReclaimableBytes = case Maybe Int
depthExplicit of
        Just Int
_ -> Int
0
        Maybe Int
Nothing -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int
charge Int
depthDesired Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
charge Int
queueDepthFloor)
    queueShedBytes :: Int
queueShedBytes = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
overshoot Int
depthReclaimableBytes
    depthFinal :: Int
depthFinal = case Maybe Int
depthExplicit of
        Just Int
n -> Int
n
        Maybe Int
Nothing
            | Int
queueShedBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
queueDepthFloor ((Int -> Int
charge Int
depthDesired Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
queueShedBytes) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
mirrorJobEstimatedBytes)
            | Bool
otherwise -> Int
depthDesired

{- | The cache entry bound: an explicit count, or the surviving aggregate divided by the
planning allowance per shared local metadata entry slot.
-}
cacheEntryBound :: TenantDemands -> ShedOutcomes -> Int
cacheEntryBound :: TenantDemands -> ShedOutcomes -> Int
cacheEntryBound TenantDemands
d ShedOutcomes
o =
    Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ((Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
cacheEntriesFloor, Int
cacheEntriesCap) (ShedOutcomes -> Int
soCacheFinal ShedOutcomes
o Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
cacheEntryExpectedBytes)) (TenantDemands -> Maybe Int
tdCacheEntriesExplicit TenantDemands
d)