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

{- | The verdict behind @\/readyz@, and the per-mount advisory state it was decided from.

One configured ecosystem awaiting its advisory database does not take the whole listener out of
rotation, so a router keeps sending the healthy mounts their traffic. Only a mount whose rules
deny on the database waits for one. Readiness routes traffic and gates no request: a mount with
no advisory database refuses what needs one through its own rule policy. The constructors are
exported for matching, and 'mountReadiness' is the sanctioned builder for a mount map, so a verdict
a producer makes agrees with its own map.
-}
module Ecluse.Core.Server.Readiness (
    -- * One mount's advisory state
    DatabaseRequirement (..),
    MountReadiness (..),
    mountStateFor,

    -- * The verdict
    Readiness (..),
    mountReadiness,
    alwaysReady,

    -- * Reading the verdict
    routable,
    allMountsReady,
) where

import Data.Map.Strict qualified as Map

import Ecluse.Core.Ecosystem (Ecosystem)

-- | Whether a mount's own rules deny on the advisory database, so it cannot decide without one.
data DatabaseRequirement
    = DatabaseRequired
    | DatabaseOptional
    deriving stock (DatabaseRequirement -> DatabaseRequirement -> Bool
(DatabaseRequirement -> DatabaseRequirement -> Bool)
-> (DatabaseRequirement -> DatabaseRequirement -> Bool)
-> Eq DatabaseRequirement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DatabaseRequirement -> DatabaseRequirement -> Bool
== :: DatabaseRequirement -> DatabaseRequirement -> Bool
$c/= :: DatabaseRequirement -> DatabaseRequirement -> Bool
/= :: DatabaseRequirement -> DatabaseRequirement -> Bool
Eq, Int -> DatabaseRequirement -> ShowS
[DatabaseRequirement] -> ShowS
DatabaseRequirement -> String
(Int -> DatabaseRequirement -> ShowS)
-> (DatabaseRequirement -> String)
-> ([DatabaseRequirement] -> ShowS)
-> Show DatabaseRequirement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatabaseRequirement -> ShowS
showsPrec :: Int -> DatabaseRequirement -> ShowS
$cshow :: DatabaseRequirement -> String
show :: DatabaseRequirement -> String
$cshowList :: [DatabaseRequirement] -> ShowS
showList :: [DatabaseRequirement] -> ShowS
Show)

-- | One mount's advisory state. The flip is one-way, so a mount never falls back to awaiting.
data MountReadiness
    = MountReady
    | MountAwaitingFirstSync
    deriving stock (MountReadiness -> MountReadiness -> Bool
(MountReadiness -> MountReadiness -> Bool)
-> (MountReadiness -> MountReadiness -> Bool) -> Eq MountReadiness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MountReadiness -> MountReadiness -> Bool
== :: MountReadiness -> MountReadiness -> Bool
$c/= :: MountReadiness -> MountReadiness -> Bool
/= :: MountReadiness -> MountReadiness -> Bool
Eq, Int -> MountReadiness -> ShowS
[MountReadiness] -> ShowS
MountReadiness -> String
(Int -> MountReadiness -> ShowS)
-> (MountReadiness -> String)
-> ([MountReadiness] -> ShowS)
-> Show MountReadiness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MountReadiness -> ShowS
showsPrec :: Int -> MountReadiness -> ShowS
$cshow :: MountReadiness -> String
show :: MountReadiness -> String
$cshowList :: [MountReadiness] -> ShowS
showList :: [MountReadiness] -> ShowS
Show)

{- | One mount's state from what its rules need and whether its first sync has landed. A mount
that only reads the database, and never denies on it, serves before any artifact is published.
-}
mountStateFor :: DatabaseRequirement -> Bool -> MountReadiness
mountStateFor :: DatabaseRequirement -> Bool -> MountReadiness
mountStateFor DatabaseRequirement
requirement Bool
synced = case DatabaseRequirement
requirement of
    DatabaseRequirement
DatabaseOptional -> MountReadiness
MountReady
    DatabaseRequirement
DatabaseRequired -> MountReadiness -> MountReadiness -> Bool -> MountReadiness
forall a. a -> a -> Bool -> a
bool MountReadiness
MountAwaitingFirstSync MountReadiness
MountReady Bool
synced

-- | The readiness verdict, carrying the mounts it was decided from.
data Readiness
    = -- | At least one configured mount is ready, or no mount is configured.
      Routable (Map.Map Ecosystem MountReadiness)
    | -- | Mounts are configured and none has its advisory database yet.
      AwaitingMounts (Map.Map Ecosystem MountReadiness)
    | -- | Readiness closed for good, whatever the mounts hold (the Dredger's halt latch).
      Latched
    deriving stock (Readiness -> Readiness -> Bool
(Readiness -> Readiness -> Bool)
-> (Readiness -> Readiness -> Bool) -> Eq Readiness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Readiness -> Readiness -> Bool
== :: Readiness -> Readiness -> Bool
$c/= :: Readiness -> Readiness -> Bool
/= :: Readiness -> Readiness -> Bool
Eq, Int -> Readiness -> ShowS
[Readiness] -> ShowS
Readiness -> String
(Int -> Readiness -> ShowS)
-> (Readiness -> String)
-> ([Readiness] -> ShowS)
-> Show Readiness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Readiness -> ShowS
showsPrec :: Int -> Readiness -> ShowS
$cshow :: Readiness -> String
show :: Readiness -> String
$cshowList :: [Readiness] -> ShowS
showList :: [Readiness] -> ShowS
Show)

-- | Decide the verdict from the mounts. No configured mount is routable: nothing gates routing.
mountReadiness :: Map.Map Ecosystem MountReadiness -> Readiness
mountReadiness :: Map Ecosystem MountReadiness -> Readiness
mountReadiness Map Ecosystem MountReadiness
mounts
    | Map Ecosystem MountReadiness -> Bool
forall k a. Map k a -> Bool
Map.null Map Ecosystem MountReadiness
mounts Bool -> Bool -> Bool
|| MountReadiness
MountReady MountReadiness -> [MountReadiness] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` Map Ecosystem MountReadiness -> [MountReadiness]
forall k a. Map k a -> [a]
Map.elems Map Ecosystem MountReadiness
mounts = Map Ecosystem MountReadiness -> Readiness
Routable Map Ecosystem MountReadiness
mounts
    | Bool
otherwise = Map Ecosystem MountReadiness -> Readiness
AwaitingMounts Map Ecosystem MountReadiness
mounts

-- | The verdict of a role with no advisory mount to wait for.
alwaysReady :: Readiness
alwaysReady :: Readiness
alwaysReady = Map Ecosystem MountReadiness -> Readiness
mountReadiness Map Ecosystem MountReadiness
forall k a. Map k a
Map.empty

-- | Whether @\/readyz@ answers @200@. Derived from the verdict, never stored beside it.
routable :: Readiness -> Bool
routable :: Readiness -> Bool
routable = \case
    Routable Map Ecosystem MountReadiness
_ -> Bool
True
    AwaitingMounts Map Ecosystem MountReadiness
_ -> Bool
False
    Readiness
Latched -> Bool
False

{- | Whether every configured mount is ready, which for one that denies on the advisory database
means it holds one. A wait condition, not the routing verdict: the Dredger holds its first sweep.
-}
allMountsReady :: Readiness -> Bool
allMountsReady :: Readiness -> Bool
allMountsReady = \case
    Routable Map Ecosystem MountReadiness
mounts -> (MountReadiness -> Bool) -> [MountReadiness] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (MountReadiness -> MountReadiness -> Bool
forall a. Eq a => a -> a -> Bool
== MountReadiness
MountReady) (Map Ecosystem MountReadiness -> [MountReadiness]
forall k a. Map k a -> [a]
Map.elems Map Ecosystem MountReadiness
mounts)
    AwaitingMounts Map Ecosystem MountReadiness
_ -> Bool
False
    Readiness
Latched -> Bool
False