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

{- | The arithmetic "Ecluse.Core.Registry.Sweep.Pacing" decides a cycle's pace with: the seconds a
cycle has, the share of a scope's capacity it may take, and the seconds a tally of requests costs
at that share.

Importing this module opts out of the public surface's stability promises. It exists so a spec can
pin each step of the derivation against the decision built from it.
-}
module Ecluse.Core.Registry.Sweep.Pacing.Internal (
    cycleAllowance,
    nominalPackagePace,
    budgetFraction,
    ceilingsFor,
    cycleDemand,
    BudgetShortfall (..),
) where

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

import Ecluse.Core.Registry.Maintenance.Budget (
    QuotaDimension,
    RequestTally,
    StoreBudget (bgCosts, bgQuotas),
    smallestQuota,
    tallyCounts,
 )
import Ecluse.Core.Registry.Sweep.Types (
    SweepPacing (swpBudgetFraction, swpChunkPause, swpChunkSize, swpCyclePause, swpCycleWindow),
    minimumChunkPause,
 )

{- | The seconds one complete cycle has. A name newly covered by an advisory can miss the running
cycle's selection, so the window must cover that cycle, the pause, and the next one.
-}
cycleAllowance :: SweepPacing -> Rational
cycleAllowance :: SweepPacing -> Rational
cycleAllowance SweepPacing
pacing = (NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational (SweepPacing -> NominalDiffTime
swpCycleWindow SweepPacing
pacing) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational (SweepPacing -> NominalDiffTime
swpCyclePause SweepPacing
pacing)) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2

{- | The sweep's own nominal package pace, in requests per second. It is the one dial an operator
already has over how hard a cycle leans on a store, so both the derived capacity and the share use it.
-}
nominalPackagePace :: Int -> NominalDiffTime -> Rational
nominalPackagePace :: Int -> NominalDiffTime -> Rational
nominalPackagePace Int
chunkSize NominalDiffTime
chunkPause =
    Int -> Rational
forall a. Real a => a -> Rational
toRational (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
chunkSize) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational (NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
minimumChunkPause NominalDiffTime
chunkPause)

{- | The share of a scope's capacity the sweep may take: the configured fraction, else the smaller
of half the capacity and the share the nominal package pace already implies.
-}
budgetFraction :: SweepPacing -> StoreBudget -> Rational
budgetFraction :: SweepPacing -> StoreBudget -> Rational
budgetFraction SweepPacing
pacing StoreBudget
budget = Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe Rational
computed (SweepPacing -> Maybe Rational
swpBudgetFraction SweepPacing
pacing)
  where
    computed :: Rational
computed = Rational -> (Rational -> Rational) -> Maybe Rational -> Rational
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rational
fractionCeiling Rational -> Rational
implied (StoreBudget -> Maybe Rational
smallestQuota StoreBudget
budget)
    implied :: Rational -> Rational
implied Rational
smallest
        | Rational
smallest Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
0 = Rational
fractionCeiling
        | Bool
otherwise = Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
fractionCeiling (SweepPacing -> Rational
pacingPace SweepPacing
pacing Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
smallest)

-- The nominal pace of this pacing's own chunk size and chunk pause.
pacingPace :: SweepPacing -> Rational
pacingPace :: SweepPacing -> Rational
pacingPace SweepPacing
pacing = Int -> NominalDiffTime -> Rational
nominalPackagePace (SweepPacing -> Int
swpChunkSize SweepPacing
pacing) (SweepPacing -> NominalDiffTime
swpChunkPause SweepPacing
pacing)

-- The largest share of a store's capacity a sweep takes, leaving the rest to the proxy's calls.
fractionCeiling :: Rational
fractionCeiling :: Rational
fractionCeiling = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2

-- | The per-second ceilings one scope holds itself to under that share.
ceilingsFor :: Rational -> StoreBudget -> Map QuotaDimension Rational
ceilingsFor :: Rational -> StoreBudget -> Map QuotaDimension Rational
ceilingsFor Rational
fraction = (Rational -> Rational)
-> Map QuotaDimension Rational -> Map QuotaDimension Rational
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Rational
fraction Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*) (Map QuotaDimension Rational -> Map QuotaDimension Rational)
-> (StoreBudget -> Map QuotaDimension Rational)
-> StoreBudget
-> Map QuotaDimension Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreBudget -> Map QuotaDimension Rational
bgQuotas

{- | The seconds a tally of requests takes at those ceilings. Each attempt costs the longest its
own dimensions hold it to, and the cycle makes them one at a time, so the costs add.
-}
cycleDemand :: Map QuotaDimension Rational -> StoreBudget -> RequestTally -> Rational
cycleDemand :: Map QuotaDimension Rational
-> StoreBudget -> RequestTally -> Rational
cycleDemand Map QuotaDimension Rational
ceilings StoreBudget
budget RequestTally
tally =
    [Rational] -> Rational
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum [Int -> Rational
forall a. Real a => a -> Rational
toRational Int
count Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* RequestKind -> Rational
requestSeconds RequestKind
kind | (RequestKind
kind, Int
count) <- RequestTally -> [(RequestKind, Int)]
tallyCounts RequestTally
tally]
  where
    requestSeconds :: RequestKind -> Rational
requestSeconds RequestKind
kind =
        (Rational -> Rational -> Rational)
-> Rational -> [Rational] -> Rational
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max
            Rational
0
            [ Rational
cost Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
limit
            | (QuotaDimension
dimension, Rational
cost) <- Map QuotaDimension Rational -> [(QuotaDimension, Rational)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map QuotaDimension Rational
-> RequestKind
-> Map RequestKind (Map QuotaDimension Rational)
-> Map QuotaDimension Rational
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map QuotaDimension Rational
forall k a. Map k a
Map.empty RequestKind
kind (StoreBudget -> Map RequestKind (Map QuotaDimension Rational)
bgCosts StoreBudget
budget))
            , Just Rational
limit <- [QuotaDimension -> Map QuotaDimension Rational -> Maybe Rational
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QuotaDimension
dimension Map QuotaDimension Rational
ceilings]
            , Rational
limit Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0
            ]

-- | Why a cycle cannot be paced inside the window, which the warning names.
data BudgetShortfall
    = -- | The cycle's own work fills the allowance, so no request share reaches the window.
      WorkFillsAllowance
    | -- | The window needs this share of the scope's capacity, above the ceiling in force.
      NeedsFraction Rational
    deriving stock (BudgetShortfall -> BudgetShortfall -> Bool
(BudgetShortfall -> BudgetShortfall -> Bool)
-> (BudgetShortfall -> BudgetShortfall -> Bool)
-> Eq BudgetShortfall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BudgetShortfall -> BudgetShortfall -> Bool
== :: BudgetShortfall -> BudgetShortfall -> Bool
$c/= :: BudgetShortfall -> BudgetShortfall -> Bool
/= :: BudgetShortfall -> BudgetShortfall -> Bool
Eq, Int -> BudgetShortfall -> ShowS
[BudgetShortfall] -> ShowS
BudgetShortfall -> String
(Int -> BudgetShortfall -> ShowS)
-> (BudgetShortfall -> String)
-> ([BudgetShortfall] -> ShowS)
-> Show BudgetShortfall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BudgetShortfall -> ShowS
showsPrec :: Int -> BudgetShortfall -> ShowS
$cshow :: BudgetShortfall -> String
show :: BudgetShortfall -> String
$cshowList :: [BudgetShortfall] -> ShowS
showList :: [BudgetShortfall] -> ShowS
Show)