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

{- | The arithmetic of the metadata memory budget: what a byte count costs, how many steps cover a
shortfall, and which request the meter lets move. "Ecluse.Core.Server.Admission.Meter" applies
these decisions inside its transactions.
-}
module Ecluse.Core.Server.Admission.Budget (
    -- * Charges
    scaleCharge,
    roundUpToStep,

    -- * Decisions
    MeterView (..),
    EntryGate (..),
    entryDecision,
    entryReady,
    GrowthGate (..),
    growthDecision,
) where

import Data.IntSet qualified as IntSet

-- | The charge for a byte count, rounded up, so a non-empty read never costs nothing.
scaleCharge :: Int -> Int -> Int
scaleCharge :: Int -> Int -> Int
scaleCharge Int
permille Int
bytes
    | Int
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Int
permille Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int
0
    | Bool
otherwise = (Int
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
permille Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
999) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1000

-- | The smallest whole number of steps that covers a shortfall, in bytes.
roundUpToStep :: Int -> Int -> Int
roundUpToStep :: Int -> Int -> Int
roundUpToStep Int
step Int
shortfall
    | Int
shortfall Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int
0
    | Bool
otherwise = ((Int
shortfall Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
size) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size
  where
    size :: Int
size = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
step

-- | What a meter transaction reads before it decides.
data MeterView = MeterView
    { MeterView -> Int
mvBudget :: Int
    , MeterView -> Int
mvCharged :: Int
    , MeterView -> Maybe Int
mvToken :: Maybe Int
    -- ^ The ticket that holds the overdraw token, if any.
    , MeterView -> Maybe Int
mvOldestWaiter :: Maybe Int
    -- ^ The oldest ticket paused on a growth step or waiting on the work of one, if any.
    }
    deriving stock (MeterView -> MeterView -> Bool
(MeterView -> MeterView -> Bool)
-> (MeterView -> MeterView -> Bool) -> Eq MeterView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MeterView -> MeterView -> Bool
== :: MeterView -> MeterView -> Bool
$c/= :: MeterView -> MeterView -> Bool
/= :: MeterView -> MeterView -> Bool
Eq, Int -> MeterView -> ShowS
[MeterView] -> ShowS
MeterView -> String
(Int -> MeterView -> ShowS)
-> (MeterView -> String)
-> ([MeterView] -> ShowS)
-> Show MeterView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MeterView -> ShowS
showsPrec :: Int -> MeterView -> ShowS
$cshow :: MeterView -> String
show :: MeterView -> String
$cshowList :: [MeterView] -> ShowS
showList :: [MeterView] -> ShowS
Show)

-- | The gate's answer to a new request.
data EntryGate
    = -- | The entry step fits now.
      EntryAdmit
    | -- | Wait for the step, up to the admission wait.
      EntryQueue
    | -- | The waiting room is full: shed at once.
      EntryRefuse
    deriving stock (EntryGate -> EntryGate -> Bool
(EntryGate -> EntryGate -> Bool)
-> (EntryGate -> EntryGate -> Bool) -> Eq EntryGate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntryGate -> EntryGate -> Bool
== :: EntryGate -> EntryGate -> Bool
$c/= :: EntryGate -> EntryGate -> Bool
/= :: EntryGate -> EntryGate -> Bool
Eq, Int -> EntryGate -> ShowS
[EntryGate] -> ShowS
EntryGate -> String
(Int -> EntryGate -> ShowS)
-> (EntryGate -> String)
-> ([EntryGate] -> ShowS)
-> Show EntryGate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryGate -> ShowS
showsPrec :: Int -> EntryGate -> ShowS
$cshow :: EntryGate -> String
show :: EntryGate -> String
$cshowList :: [EntryGate] -> ShowS
showList :: [EntryGate] -> ShowS
Show)

{- | New work takes its entry step only when it fits, nobody queued before it, and no started read
is paused. A paused read always has the prior claim on freed memory.
-}
entryDecision :: MeterView -> Int -> Int -> Int -> EntryGate
entryDecision :: MeterView -> Int -> Int -> Int -> EntryGate
entryDecision MeterView
view Int
waiting Int
room Int
step
    | Int
waiting Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& MeterView -> Int -> Bool
entryReady MeterView
view Int
step = EntryGate
EntryAdmit
    | Int
waiting Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
room = EntryGate
EntryRefuse
    | Bool
otherwise = EntryGate
EntryQueue

-- | Whether a queued request may take its entry step now.
entryReady :: MeterView -> Int -> Bool
entryReady :: MeterView -> Int -> Bool
entryReady MeterView
view Int
step = MeterView -> Int -> Bool
fits MeterView
view Int
step Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (MeterView -> Maybe Int
mvOldestWaiter MeterView
view)

-- | The answer to a started request that needs more bytes.
data GrowthGate
    = -- | The step fits within the budget.
      GrowWithin
    | -- | The step does not fit, but it serves the ticket that holds the overdraw token.
      GrowOnToken
    | -- | The step does not fit, the token is free, and this charge serves the oldest paused ticket.
      GrowTakeToken
    | -- | Pause until memory frees.
      GrowWait
    deriving stock (GrowthGate -> GrowthGate -> Bool
(GrowthGate -> GrowthGate -> Bool)
-> (GrowthGate -> GrowthGate -> Bool) -> Eq GrowthGate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrowthGate -> GrowthGate -> Bool
== :: GrowthGate -> GrowthGate -> Bool
$c/= :: GrowthGate -> GrowthGate -> Bool
/= :: GrowthGate -> GrowthGate -> Bool
Eq, Int -> GrowthGate -> ShowS
[GrowthGate] -> ShowS
GrowthGate -> String
(Int -> GrowthGate -> ShowS)
-> (GrowthGate -> String)
-> ([GrowthGate] -> ShowS)
-> Show GrowthGate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrowthGate -> ShowS
showsPrec :: Int -> GrowthGate -> ShowS
$cshow :: GrowthGate -> String
show :: GrowthGate -> String
$cshowList :: [GrowthGate] -> ShowS
showList :: [GrowthGate] -> ShowS
Show)

{- | A step that fits proceeds. Past the budget, only work serving the token holder moves, or with a free
token, work serving the oldest paused ticket. @served@: the charging ticket and those waiting on it.
-}
growthDecision :: MeterView -> IntSet -> Int -> GrowthGate
growthDecision :: MeterView -> IntSet -> Int -> GrowthGate
growthDecision MeterView
view IntSet
served Int
want
    | MeterView -> Int -> Bool
fits MeterView
view Int
want = GrowthGate
GrowWithin
    | (Int -> Bool) -> Maybe Int -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> IntSet -> Bool
`IntSet.member` IntSet
served) (MeterView -> Maybe Int
mvToken MeterView
view) = GrowthGate
GrowOnToken
    | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (MeterView -> Maybe Int
mvToken MeterView
view) Bool -> Bool -> Bool
&& Bool
oldestServed = GrowthGate
GrowTakeToken
    | Bool
otherwise = GrowthGate
GrowWait
  where
    oldestServed :: Bool
oldestServed = case ((Int, IntSet) -> Int
forall a b. (a, b) -> a
fst ((Int, IntSet) -> Int) -> Maybe (Int, IntSet) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntSet -> Maybe (Int, IntSet)
IntSet.minView IntSet
served, MeterView -> Maybe Int
mvOldestWaiter MeterView
view) of
        (Just Int
ticket, Just Int
oldest) -> Int
ticket Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
oldest
        (Just Int
_, Maybe Int
Nothing) -> Bool
True
        (Maybe Int
Nothing, Maybe Int
_) -> Bool
False

fits :: MeterView -> Int -> Bool
fits :: MeterView -> Int -> Bool
fits MeterView
view Int
bytes = MeterView -> Int
mvCharged MeterView
view Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= MeterView -> Int
mvBudget MeterView
view