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

{- | Pacing one sweep cycle inside the target cycle window. Every decision here is a pure function
of the last complete cycle's measured request counts and the capacity the store declared.
-}
module Ecluse.Core.Registry.Sweep.Pacing (
    -- * The window and the capacity a cycle is paced against
    defaultCycleWindow,
    nominalPackagePace,
    derivedCapacity,
    renderScopeBudget,

    -- * The decision the next cycle runs under
    PaceDecision (..),
    BudgetShortfall,
    decidePace,
    renderPaceDecision,
) where

import Data.Map.Strict qualified as Map
import Data.Time (NominalDiffTime)

import Ecluse.Core.Registry.Maintenance.Budget (
    CyclePace,
    QuotaDimension (StoreRequests),
    QuotaOrigin (QuotaDerived),
    QuotaScope,
    RequestTally,
    StoreBudget (bgOrigin, bgQuotas, bgScope),
    budgetDeclared,
    oneRequest,
    paceOf,
    renderQuotaScope,
    renderRates,
    renderStoreBudget,
    requestKinds,
    toHundredths,
 )
import Ecluse.Core.Registry.Sweep.Pacing.Internal (
    BudgetShortfall (NeedsFraction, WorkFillsAllowance),
    budgetFraction,
    ceilingsFor,
    cycleAllowance,
    cycleDemand,
    nominalPackagePace,
 )
import Ecluse.Core.Registry.Sweep.Types (
    SweepPacing (swpBudgetFraction, swpChunkPause, swpChunkSize, swpCycleWindow),
 )

{- | The window a cycle is paced to finish inside when the configuration names none: three cycle
pauses, so each active cycle is granted the same allowance as the idle interval between them.
-}
defaultCycleWindow :: NominalDiffTime -> NominalDiffTime
defaultCycleWindow :: NominalDiffTime -> NominalDiffTime
defaultCycleWindow NominalDiffTime
cyclePause = NominalDiffTime
3 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
cyclePause

{- | The capacity a backend that publishes no quota is taken to have: the nominal package pace, on
the one request dimension. Raising the chunk pause lowers it, and a declared capacity replaces it.
-}
derivedCapacity :: Rational -> StoreBudget -> StoreBudget
derivedCapacity :: Rational -> StoreBudget -> StoreBudget
derivedCapacity Rational
pace StoreBudget
budget
    | StoreBudget -> Bool
budgetDeclared StoreBudget
budget = StoreBudget
budget
    | Bool
otherwise = StoreBudget
budget{bgQuotas = Map.singleton StoreRequests pace, bgOrigin = QuotaDerived}

-- | What one scope's next cycle runs at, and what it cannot reach inside the window.
data PaceDecision = PaceDecision
    { PaceDecision -> QuotaScope
pdScope :: QuotaScope
    , PaceDecision -> Rational
pdFraction :: Rational
    -- ^ The share of the scope's capacity this decision held the sweep to.
    , PaceDecision -> CyclePace
pdPace :: CyclePace
    , PaceDecision -> Maybe BudgetShortfall
pdShortfall :: Maybe BudgetShortfall
    }
    deriving stock (PaceDecision -> PaceDecision -> Bool
(PaceDecision -> PaceDecision -> Bool)
-> (PaceDecision -> PaceDecision -> Bool) -> Eq PaceDecision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PaceDecision -> PaceDecision -> Bool
== :: PaceDecision -> PaceDecision -> Bool
$c/= :: PaceDecision -> PaceDecision -> Bool
/= :: PaceDecision -> PaceDecision -> Bool
Eq, Int -> PaceDecision -> ShowS
[PaceDecision] -> ShowS
PaceDecision -> String
(Int -> PaceDecision -> ShowS)
-> (PaceDecision -> String)
-> ([PaceDecision] -> ShowS)
-> Show PaceDecision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PaceDecision -> ShowS
showsPrec :: Int -> PaceDecision -> ShowS
$cshow :: PaceDecision -> String
show :: PaceDecision -> String
$cshowList :: [PaceDecision] -> ShowS
showList :: [PaceDecision] -> ShowS
Show)

{- | Pace one scope's next cycle from the last complete one: its measured requests, and the seconds
that cycle spent outside its own budget waits. With no sample it runs at the ceiling and measures.
-}
decidePace :: SweepPacing -> StoreBudget -> Maybe (RequestTally, Rational) -> PaceDecision
decidePace :: SweepPacing
-> StoreBudget -> Maybe (RequestTally, Rational) -> PaceDecision
decidePace SweepPacing
pacing StoreBudget
budget Maybe (RequestTally, Rational)
sample
    | Bool -> Bool
not (StoreBudget -> Bool
budgetDeclared StoreBudget
budget) = Rational -> Maybe BudgetShortfall -> PaceDecision
decision Rational
1 Maybe BudgetShortfall
forall a. Maybe a
Nothing
    | Bool
otherwise = PaceDecision
-> ((RequestTally, Rational) -> PaceDecision)
-> Maybe (RequestTally, Rational)
-> PaceDecision
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Rational -> Maybe BudgetShortfall -> PaceDecision
decision Rational
1 Maybe BudgetShortfall
forall a. Maybe a
Nothing) (RequestTally, Rational) -> PaceDecision
measured Maybe (RequestTally, Rational)
sample
  where
    fraction :: Rational
fraction = SweepPacing -> StoreBudget -> Rational
budgetFraction SweepPacing
pacing StoreBudget
budget
    ceilings :: Map QuotaDimension Rational
ceilings = Rational -> StoreBudget -> Map QuotaDimension Rational
ceilingsFor Rational
fraction StoreBudget
budget

    measured :: (RequestTally, Rational) -> PaceDecision
measured (RequestTally
tally, Rational
workSeconds)
        | Rational
headroom Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
0 = Rational -> Maybe BudgetShortfall -> PaceDecision
decision Rational
1 (BudgetShortfall -> Maybe BudgetShortfall
forall a. a -> Maybe a
Just BudgetShortfall
WorkFillsAllowance)
        | Rational
demand Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
0 = Rational -> Maybe BudgetShortfall -> PaceDecision
decision Rational
1 Maybe BudgetShortfall
forall a. Maybe a
Nothing
        | Rational
demand Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
headroom = Rational -> Maybe BudgetShortfall -> PaceDecision
decision Rational
1 (BudgetShortfall -> Maybe BudgetShortfall
forall a. a -> Maybe a
Just (Rational -> BudgetShortfall
NeedsFraction (Rational
fraction Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
demand Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
headroom)))
        | Bool
otherwise = Rational -> Maybe BudgetShortfall -> PaceDecision
decision (Rational
demand Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
headroom) Maybe BudgetShortfall
forall a. Maybe a
Nothing
      where
        headroom :: Rational
headroom = SweepPacing -> Rational
cycleAllowance SweepPacing
pacing Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
workSeconds
        demand :: Rational
demand = Map QuotaDimension Rational
-> StoreBudget -> RequestTally -> Rational
cycleDemand Map QuotaDimension Rational
ceilings StoreBudget
budget RequestTally
tally

    decision :: Rational -> Maybe BudgetShortfall -> PaceDecision
decision Rational
share Maybe BudgetShortfall
shortfall =
        PaceDecision
            { pdScope :: QuotaScope
pdScope = StoreBudget -> QuotaScope
bgScope StoreBudget
budget
            , pdFraction :: Rational
pdFraction = Rational
fraction
            , pdPace :: CyclePace
pdPace = SweepPacing
-> StoreBudget
-> Map QuotaDimension Rational
-> Rational
-> CyclePace
paceAtShare SweepPacing
pacing StoreBudget
budget Map QuotaDimension Rational
ceilings Rational
share
            , pdShortfall :: Maybe BudgetShortfall
pdShortfall = Maybe BudgetShortfall
shortfall
            }

-- A share below one stretches every request's own cost by the same factor.
paceAtShare :: SweepPacing -> StoreBudget -> Map QuotaDimension Rational -> Rational -> CyclePace
paceAtShare :: SweepPacing
-> StoreBudget
-> Map QuotaDimension Rational
-> Rational
-> CyclePace
paceAtShare SweepPacing
pacing StoreBudget
budget Map QuotaDimension Rational
ceilings Rational
share =
    Map RequestKind Rational -> CyclePace
paceOf ([(RequestKind, Rational)] -> Map RequestKind Rational
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RequestKind
kind, Rational -> Rational
held (RequestKind -> Rational
seconds RequestKind
kind Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
share)) | RequestKind
kind <- [RequestKind]
requestKinds, RequestKind -> Rational
seconds RequestKind
kind Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0])
  where
    held :: Rational -> Rational
held = Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min (SweepPacing -> Rational
paceBound SweepPacing
pacing)
    seconds :: RequestKind -> Rational
seconds RequestKind
kind = Map QuotaDimension Rational
-> StoreBudget -> RequestTally -> Rational
cycleDemand Map QuotaDimension Rational
ceilings StoreBudget
budget (RequestKind -> RequestTally
oneRequest RequestKind
kind)

{- The longest one request is ever held. A wait past a whole cycle's allowance cannot land that
cycle inside the window, and an unbounded one would overrun the thread delay. -}
paceBound :: SweepPacing -> Rational
paceBound :: SweepPacing -> Rational
paceBound SweepPacing
pacing = Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
1 (SweepPacing -> Rational
cycleAllowance SweepPacing
pacing)

{- | The warning an unattainable window earns, naming the budget it would need. The sweep runs on
at its ceiling, because a refused cycle leaves the denied version served.
-}
renderPaceDecision :: SweepPacing -> PaceDecision -> Maybe Text
renderPaceDecision :: SweepPacing -> PaceDecision -> Maybe Text
renderPaceDecision SweepPacing
pacing PaceDecision
decision = BudgetShortfall -> Text
shortfall (BudgetShortfall -> Text) -> Maybe BudgetShortfall -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PaceDecision -> Maybe BudgetShortfall
pdShortfall PaceDecision
decision
  where
    opening :: Text
opening =
        Text
"the sweep cannot finish inside the target cycle window of "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show (SweepPacing -> NominalDiffTime
swpCycleWindow SweepPacing
pacing)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" against "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QuotaScope -> Text
renderQuotaScope (PaceDecision -> QuotaScope
pdScope PaceDecision
decision)
    ceilingClause :: Text
ceilingClause = Text
", above the ceiling of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Rational -> Text
forall {b}. IsString b => Rational -> b
share (PaceDecision -> Rational
pdFraction PaceDecision
decision) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in force"
    closing :: Text
closing = Text
". The sweep runs on at that ceiling"
    shortfall :: BudgetShortfall -> Text
shortfall = \case
        BudgetShortfall
WorkFillsAllowance ->
            Text
opening
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": its own work already fills the allowance of "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall b a. (Show a, IsString b) => a -> b
show (Rational -> Double
toHundredths (SweepPacing -> Rational
cycleAllowance SweepPacing
pacing))
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" seconds, so no request budget reaches the window"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
closing
        NeedsFraction Rational
needed ->
            Text
opening
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": it would need "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Rational -> Text
forall {b}. IsString b => Rational -> b
share Rational
needed
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of the store's request capacity"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ceilingClause
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
closing
    share :: Rational -> b
share Rational
value = Double -> b
forall b a. (Show a, IsString b) => a -> b
show (Rational -> Double
toHundredths Rational
value)

{- | What one store's capacity resolved to, for the boot line: where each figure came from, the
share in force, and the per-second ceilings that share yields.
-}
renderScopeBudget :: SweepPacing -> StoreBudget -> Text
renderScopeBudget :: SweepPacing -> StoreBudget -> Text
renderScopeBudget SweepPacing
pacing StoreBudget
budget =
    Text
"paced against "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QuotaScope -> Text
renderQuotaScope (StoreBudget -> QuotaScope
bgScope StoreBudget
budget)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
capacity
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", fraction "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall b a. (Show a, IsString b) => a -> b
show (Rational -> Double
toHundredths Rational
fraction)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fractionOrigin
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"), ceilings "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ceilings
  where
    fraction :: Rational
fraction = SweepPacing -> StoreBudget -> Rational
budgetFraction SweepPacing
pacing StoreBudget
budget
    fractionOrigin :: Text
fractionOrigin = if Maybe Rational -> Bool
forall a. Maybe a -> Bool
isJust (SweepPacing -> Maybe Rational
swpBudgetFraction SweepPacing
pacing) then Text
"from configuration" else Text
"computed"
    capacity :: Text
capacity = case StoreBudget -> QuotaOrigin
bgOrigin StoreBudget
budget of
        QuotaOrigin
QuotaDerived ->
            Text
"capacity derived from dredger.chunkSize "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (SweepPacing -> Int
swpChunkSize SweepPacing
pacing)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" every "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show (SweepPacing -> NominalDiffTime
swpChunkPause SweepPacing
pacing)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Map QuotaDimension Rational -> Text
renderRates (StoreBudget -> Map QuotaDimension Rational
bgQuotas StoreBudget
budget)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        QuotaOrigin
_ -> StoreBudget -> Text
renderStoreBudget StoreBudget
budget
    ceilings :: Text
ceilings
        | Map QuotaDimension Rational -> Bool
forall k a. Map k a -> Bool
Map.null Map QuotaDimension Rational
resolved = Text
"none"
        | Bool
otherwise = Map QuotaDimension Rational -> Text
renderRates Map QuotaDimension Rational
resolved
    resolved :: Map QuotaDimension Rational
resolved = Rational -> StoreBudget -> Map QuotaDimension Rational
ceilingsFor Rational
fraction StoreBudget
budget