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

{- | The vocabulary a maintenance budget is written in: the pools a backend meters under, the
requests a cycle makes, and the rate one scope runs at. "Ecluse.Core.Registry.Maintenance.Budget"
curates what a caller outside needs of it.

Importing this module opts out of the public surface's stability promises. It exists so a spec can
pin each arm against the name a configuration key spells it with.
-}
module Ecluse.Core.Registry.Maintenance.Budget.Internal (
    QuotaDimension (..),
    quotaDimensions,
    quotaDimensionName,
    RequestKind (..),
    requestKinds,
    requestKindName,
    CyclePace (..),
    freePace,
    paceOf,
    paceSeconds,
) where

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

{- | One pool a backend meters its callers by. The arms are pool shapes rather than one vendor's
API names, so each backend maps its own calls onto them.
-}
data QuotaDimension
    = -- | Calls that list a store's package names.
      NameListing
    | -- | Calls that list one package's versions.
      VersionListing
    | -- | Requests the backend counts as reads of the account holding the store.
      AccountReads
    | -- | Requests the backend counts as writes to that account.
      AccountWrites
    | -- | Requests sharing the ceiling of one authentication token.
      TokenReads
    | -- | The single undivided request capacity of a backend that publishes no other pool.
      StoreRequests
    deriving stock (QuotaDimension -> QuotaDimension -> Bool
(QuotaDimension -> QuotaDimension -> Bool)
-> (QuotaDimension -> QuotaDimension -> Bool) -> Eq QuotaDimension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QuotaDimension -> QuotaDimension -> Bool
== :: QuotaDimension -> QuotaDimension -> Bool
$c/= :: QuotaDimension -> QuotaDimension -> Bool
/= :: QuotaDimension -> QuotaDimension -> Bool
Eq, Eq QuotaDimension
Eq QuotaDimension =>
(QuotaDimension -> QuotaDimension -> Ordering)
-> (QuotaDimension -> QuotaDimension -> Bool)
-> (QuotaDimension -> QuotaDimension -> Bool)
-> (QuotaDimension -> QuotaDimension -> Bool)
-> (QuotaDimension -> QuotaDimension -> Bool)
-> (QuotaDimension -> QuotaDimension -> QuotaDimension)
-> (QuotaDimension -> QuotaDimension -> QuotaDimension)
-> Ord QuotaDimension
QuotaDimension -> QuotaDimension -> Bool
QuotaDimension -> QuotaDimension -> Ordering
QuotaDimension -> QuotaDimension -> QuotaDimension
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: QuotaDimension -> QuotaDimension -> Ordering
compare :: QuotaDimension -> QuotaDimension -> Ordering
$c< :: QuotaDimension -> QuotaDimension -> Bool
< :: QuotaDimension -> QuotaDimension -> Bool
$c<= :: QuotaDimension -> QuotaDimension -> Bool
<= :: QuotaDimension -> QuotaDimension -> Bool
$c> :: QuotaDimension -> QuotaDimension -> Bool
> :: QuotaDimension -> QuotaDimension -> Bool
$c>= :: QuotaDimension -> QuotaDimension -> Bool
>= :: QuotaDimension -> QuotaDimension -> Bool
$cmax :: QuotaDimension -> QuotaDimension -> QuotaDimension
max :: QuotaDimension -> QuotaDimension -> QuotaDimension
$cmin :: QuotaDimension -> QuotaDimension -> QuotaDimension
min :: QuotaDimension -> QuotaDimension -> QuotaDimension
Ord, Int -> QuotaDimension -> ShowS
[QuotaDimension] -> ShowS
QuotaDimension -> String
(Int -> QuotaDimension -> ShowS)
-> (QuotaDimension -> String)
-> ([QuotaDimension] -> ShowS)
-> Show QuotaDimension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QuotaDimension -> ShowS
showsPrec :: Int -> QuotaDimension -> ShowS
$cshow :: QuotaDimension -> String
show :: QuotaDimension -> String
$cshowList :: [QuotaDimension] -> ShowS
showList :: [QuotaDimension] -> ShowS
Show)

{- | Every pool this build meters under. 'quotaDimensionName' carries no wildcard and the spec
pins this list, so a new arm fails both until it is named in each.
-}
quotaDimensions :: [QuotaDimension]
quotaDimensions :: [QuotaDimension]
quotaDimensions = [QuotaDimension
NameListing, QuotaDimension
VersionListing, QuotaDimension
AccountReads, QuotaDimension
AccountWrites, QuotaDimension
TokenReads, QuotaDimension
StoreRequests]

-- | The dimension as a configuration key spells it.
quotaDimensionName :: QuotaDimension -> Text
quotaDimensionName :: QuotaDimension -> Text
quotaDimensionName = \case
    QuotaDimension
NameListing -> Text
"nameListing"
    QuotaDimension
VersionListing -> Text
"versionListing"
    QuotaDimension
AccountReads -> Text
"accountReads"
    QuotaDimension
AccountWrites -> Text
"accountWrites"
    QuotaDimension
TokenReads -> Text
"tokenReads"
    QuotaDimension
StoreRequests -> Text
"storeRequests"

-- | One request a cycle makes against the store being dredged.
data RequestKind
    = -- | One page of the store's package-name listing.
      ListingPage
    | -- | One enumeration of a package's versions.
      VersionPage
    | -- | One read of a package's metadata back from the store.
      ManifestRead
    | -- | One destructive call, whatever number of versions the backend takes in it.
      DeleteBatch
    | -- | One read of a standing permission, including a reassessment before a delete.
      PermissionRead
    | -- | One read of the walk's resumption marker.
      CursorRead
    | -- | One write or clearing of that marker.
      CursorWrite
    deriving stock (RequestKind -> RequestKind -> Bool
(RequestKind -> RequestKind -> Bool)
-> (RequestKind -> RequestKind -> Bool) -> Eq RequestKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestKind -> RequestKind -> Bool
== :: RequestKind -> RequestKind -> Bool
$c/= :: RequestKind -> RequestKind -> Bool
/= :: RequestKind -> RequestKind -> Bool
Eq, Eq RequestKind
Eq RequestKind =>
(RequestKind -> RequestKind -> Ordering)
-> (RequestKind -> RequestKind -> Bool)
-> (RequestKind -> RequestKind -> Bool)
-> (RequestKind -> RequestKind -> Bool)
-> (RequestKind -> RequestKind -> Bool)
-> (RequestKind -> RequestKind -> RequestKind)
-> (RequestKind -> RequestKind -> RequestKind)
-> Ord RequestKind
RequestKind -> RequestKind -> Bool
RequestKind -> RequestKind -> Ordering
RequestKind -> RequestKind -> RequestKind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RequestKind -> RequestKind -> Ordering
compare :: RequestKind -> RequestKind -> Ordering
$c< :: RequestKind -> RequestKind -> Bool
< :: RequestKind -> RequestKind -> Bool
$c<= :: RequestKind -> RequestKind -> Bool
<= :: RequestKind -> RequestKind -> Bool
$c> :: RequestKind -> RequestKind -> Bool
> :: RequestKind -> RequestKind -> Bool
$c>= :: RequestKind -> RequestKind -> Bool
>= :: RequestKind -> RequestKind -> Bool
$cmax :: RequestKind -> RequestKind -> RequestKind
max :: RequestKind -> RequestKind -> RequestKind
$cmin :: RequestKind -> RequestKind -> RequestKind
min :: RequestKind -> RequestKind -> RequestKind
Ord, Int -> RequestKind -> ShowS
[RequestKind] -> ShowS
RequestKind -> String
(Int -> RequestKind -> ShowS)
-> (RequestKind -> String)
-> ([RequestKind] -> ShowS)
-> Show RequestKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestKind -> ShowS
showsPrec :: Int -> RequestKind -> ShowS
$cshow :: RequestKind -> String
show :: RequestKind -> String
$cshowList :: [RequestKind] -> ShowS
showList :: [RequestKind] -> ShowS
Show)

-- | Every request a cycle can make, held to 'requestKindName' the way 'quotaDimensions' is.
requestKinds :: [RequestKind]
requestKinds :: [RequestKind]
requestKinds = [RequestKind
ListingPage, RequestKind
VersionPage, RequestKind
ManifestRead, RequestKind
DeleteBatch, RequestKind
PermissionRead, RequestKind
CursorRead, RequestKind
CursorWrite]

-- | The kind as a configuration weight spells it.
requestKindName :: RequestKind -> Text
requestKindName :: RequestKind -> Text
requestKindName = \case
    RequestKind
ListingPage -> Text
"listingPage"
    RequestKind
VersionPage -> Text
"versionPage"
    RequestKind
ManifestRead -> Text
"manifestRead"
    RequestKind
DeleteBatch -> Text
"deleteBatch"
    RequestKind
PermissionRead -> Text
"permissionRead"
    RequestKind
CursorRead -> Text
"cursorRead"
    RequestKind
CursorWrite -> Text
"cursorWrite"

-- | What one request of each kind costs its scope in seconds, at the rate a cycle runs.
newtype CyclePace = CyclePace (Map RequestKind Rational)
    deriving stock (CyclePace -> CyclePace -> Bool
(CyclePace -> CyclePace -> Bool)
-> (CyclePace -> CyclePace -> Bool) -> Eq CyclePace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CyclePace -> CyclePace -> Bool
== :: CyclePace -> CyclePace -> Bool
$c/= :: CyclePace -> CyclePace -> Bool
/= :: CyclePace -> CyclePace -> Bool
Eq, Int -> CyclePace -> ShowS
[CyclePace] -> ShowS
CyclePace -> String
(Int -> CyclePace -> ShowS)
-> (CyclePace -> String)
-> ([CyclePace] -> ShowS)
-> Show CyclePace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CyclePace -> ShowS
showsPrec :: Int -> CyclePace -> ShowS
$cshow :: CyclePace -> String
show :: CyclePace -> String
$cshowList :: [CyclePace] -> ShowS
showList :: [CyclePace] -> ShowS
Show)

-- | The pace that imposes no wait, which a scope with no declared capacity runs at.
freePace :: CyclePace
freePace :: CyclePace
freePace = Map RequestKind Rational -> CyclePace
CyclePace Map RequestKind Rational
forall k a. Map k a
Map.empty

-- | Build a pace from the seconds each kind is held to.
paceOf :: Map RequestKind Rational -> CyclePace
paceOf :: Map RequestKind Rational -> CyclePace
paceOf = Map RequestKind Rational -> CyclePace
CyclePace

-- | The wait one request of this kind takes, which is none where the pace names no cost.
paceSeconds :: CyclePace -> RequestKind -> NominalDiffTime
paceSeconds :: CyclePace -> RequestKind -> NominalDiffTime
paceSeconds (CyclePace Map RequestKind Rational
costs) RequestKind
kind = NominalDiffTime
-> (Rational -> NominalDiffTime)
-> Maybe Rational
-> NominalDiffTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NominalDiffTime
0 Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (RequestKind -> Map RequestKind Rational -> Maybe Rational
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RequestKind
kind Map RequestKind Rational
costs)