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

{- | How old the advisory push behind a CVE-based deny may be. The clock is the published object's
own timestamp, which "Ecluse.Core.Cve.Slot" carries, so a recompile of unchanged bytes still moves
it and a restart does not reset it. What a source says about its own data is diagnostic and is
never read here. "Ecluse.Core.Rules" applies the reading to a prepared rule.
-}
module Ecluse.Core.Rules.Freshness (
    -- * The effective maximum
    MaxAdvisoryAge (..),
    AdvisoryAgeBasis (..),
    maxAdvisoryAgeFor,

    -- * Reading one push
    AdvisoryPublication (..),
    AdvisoryAge (..),
    AdvisoryFreshness (..),
    assessAdvisoryAge,
    ageAlarmStep,
) where

import Data.Time (NominalDiffTime, UTCTime, diffUTCTime)

import Ecluse.Core.Rules.Types (Rule (AllowIfOlderThan))

{- | The maximum push age one mount's CVE-based denies accept, and where the value came from.
The basis is carried so the boot log can report it beside the number.
-}
data MaxAdvisoryAge = MaxAdvisoryAge
    { MaxAdvisoryAge -> NominalDiffTime
maxAdvisoryAge :: NominalDiffTime
    -- ^ The effective limit. A push older than this expires.
    , MaxAdvisoryAge -> AdvisoryAgeBasis
maxAdvisoryAgeBasis :: AdvisoryAgeBasis
    -- ^ Which of the three ways below produced it.
    }
    deriving stock (MaxAdvisoryAge -> MaxAdvisoryAge -> Bool
(MaxAdvisoryAge -> MaxAdvisoryAge -> Bool)
-> (MaxAdvisoryAge -> MaxAdvisoryAge -> Bool) -> Eq MaxAdvisoryAge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaxAdvisoryAge -> MaxAdvisoryAge -> Bool
== :: MaxAdvisoryAge -> MaxAdvisoryAge -> Bool
$c/= :: MaxAdvisoryAge -> MaxAdvisoryAge -> Bool
/= :: MaxAdvisoryAge -> MaxAdvisoryAge -> Bool
Eq, Int -> MaxAdvisoryAge -> ShowS
[MaxAdvisoryAge] -> ShowS
MaxAdvisoryAge -> String
(Int -> MaxAdvisoryAge -> ShowS)
-> (MaxAdvisoryAge -> String)
-> ([MaxAdvisoryAge] -> ShowS)
-> Show MaxAdvisoryAge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaxAdvisoryAge -> ShowS
showsPrec :: Int -> MaxAdvisoryAge -> ShowS
$cshow :: MaxAdvisoryAge -> String
show :: MaxAdvisoryAge -> String
$cshowList :: [MaxAdvisoryAge] -> ShowS
showList :: [MaxAdvisoryAge] -> ShowS
Show)

-- | Where an effective maximum came from.
data AdvisoryAgeBasis
    = -- | The operator set @advisories.maxAgeSeconds@, which overrides every derivation.
      AgeConfigured
    | {- | Derived to land @advisoryAgeLead@ ahead of the earliest quarantine admission this
      mount's own rules allow (carried), so the failure shows before that cohort is admitted.
      -}
      AgeBeforeQuarantine NominalDiffTime
    | -- | The floor, which no derivation goes below.
      AgeFloor
    deriving stock (AdvisoryAgeBasis -> AdvisoryAgeBasis -> Bool
(AdvisoryAgeBasis -> AdvisoryAgeBasis -> Bool)
-> (AdvisoryAgeBasis -> AdvisoryAgeBasis -> Bool)
-> Eq AdvisoryAgeBasis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdvisoryAgeBasis -> AdvisoryAgeBasis -> Bool
== :: AdvisoryAgeBasis -> AdvisoryAgeBasis -> Bool
$c/= :: AdvisoryAgeBasis -> AdvisoryAgeBasis -> Bool
/= :: AdvisoryAgeBasis -> AdvisoryAgeBasis -> Bool
Eq, Int -> AdvisoryAgeBasis -> ShowS
[AdvisoryAgeBasis] -> ShowS
AdvisoryAgeBasis -> String
(Int -> AdvisoryAgeBasis -> ShowS)
-> (AdvisoryAgeBasis -> String)
-> ([AdvisoryAgeBasis] -> ShowS)
-> Show AdvisoryAgeBasis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdvisoryAgeBasis -> ShowS
showsPrec :: Int -> AdvisoryAgeBasis -> ShowS
$cshow :: AdvisoryAgeBasis -> String
show :: AdvisoryAgeBasis -> String
$cshowList :: [AdvisoryAgeBasis] -> ShowS
showList :: [AdvisoryAgeBasis] -> ShowS
Show)

-- | The shortest maximum a derivation yields: three days.
advisoryAgeFloor :: NominalDiffTime
advisoryAgeFloor :: NominalDiffTime
advisoryAgeFloor = NominalDiffTime
259200

-- | How far ahead of the earliest quarantine admission a derived maximum lands: 24 hours.
advisoryAgeLead :: NominalDiffTime
advisoryAgeLead :: NominalDiffTime
advisoryAgeLead = NominalDiffTime
86400

{- | One mount's effective maximum. An explicit value is final, above and below the derivation.
One mount's rules are read alone, so another ecosystem's quarantine cannot set this limit.
-}
maxAdvisoryAgeFor :: Maybe NominalDiffTime -> [Rule] -> MaxAdvisoryAge
maxAdvisoryAgeFor :: Maybe NominalDiffTime -> [Rule] -> MaxAdvisoryAge
maxAdvisoryAgeFor (Just NominalDiffTime
explicit) [Rule]
_ = NominalDiffTime -> AdvisoryAgeBasis -> MaxAdvisoryAge
MaxAdvisoryAge NominalDiffTime
explicit AdvisoryAgeBasis
AgeConfigured
maxAdvisoryAgeFor Maybe NominalDiffTime
Nothing [Rule]
rules = MaxAdvisoryAge
-> (NominalDiffTime -> MaxAdvisoryAge)
-> Maybe NominalDiffTime
-> MaxAdvisoryAge
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MaxAdvisoryAge
floorAge NominalDiffTime -> MaxAdvisoryAge
derivedFrom ((Rule -> Maybe NominalDiffTime -> Maybe NominalDiffTime)
-> Maybe NominalDiffTime -> [Rule] -> Maybe NominalDiffTime
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rule -> Maybe NominalDiffTime -> Maybe NominalDiffTime
earlier Maybe NominalDiffTime
forall a. Maybe a
Nothing [Rule]
rules)
  where
    earlier :: Rule -> Maybe NominalDiffTime -> Maybe NominalDiffTime
earlier (AllowIfOlderThan NominalDiffTime
quarantine) Maybe NominalDiffTime
soFar = NominalDiffTime -> Maybe NominalDiffTime
forall a. a -> Maybe a
Just (NominalDiffTime
-> (NominalDiffTime -> NominalDiffTime)
-> Maybe NominalDiffTime
-> NominalDiffTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NominalDiffTime
quarantine (NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
min NominalDiffTime
quarantine) Maybe NominalDiffTime
soFar)
    earlier Rule
_ Maybe NominalDiffTime
soFar = Maybe NominalDiffTime
soFar

    derivedFrom :: NominalDiffTime -> MaxAdvisoryAge
derivedFrom NominalDiffTime
quarantine
        | NominalDiffTime
quarantine NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
advisoryAgeLead NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
advisoryAgeFloor =
            NominalDiffTime -> AdvisoryAgeBasis -> MaxAdvisoryAge
MaxAdvisoryAge (NominalDiffTime
quarantine NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
advisoryAgeLead) (NominalDiffTime -> AdvisoryAgeBasis
AgeBeforeQuarantine NominalDiffTime
quarantine)
        | Bool
otherwise = MaxAdvisoryAge
floorAge

    floorAge :: MaxAdvisoryAge
floorAge = NominalDiffTime -> AdvisoryAgeBasis -> MaxAdvisoryAge
MaxAdvisoryAge NominalDiffTime
advisoryAgeFloor AdvisoryAgeBasis
AgeFloor

{- | One reading of a push: when it landed, how old it is now, and the maximum it was read
against. An audit line and an alarm both render this, so neither can report a different number.
-}
data AdvisoryAge = AdvisoryAge
    { AdvisoryAge -> UTCTime
advisoryPushedAt :: UTCTime
    , AdvisoryAge -> NominalDiffTime
advisoryAge :: NominalDiffTime
    , AdvisoryAge -> NominalDiffTime
advisoryMaxAge :: NominalDiffTime
    }
    deriving stock (AdvisoryAge -> AdvisoryAge -> Bool
(AdvisoryAge -> AdvisoryAge -> Bool)
-> (AdvisoryAge -> AdvisoryAge -> Bool) -> Eq AdvisoryAge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdvisoryAge -> AdvisoryAge -> Bool
== :: AdvisoryAge -> AdvisoryAge -> Bool
$c/= :: AdvisoryAge -> AdvisoryAge -> Bool
/= :: AdvisoryAge -> AdvisoryAge -> Bool
Eq, Int -> AdvisoryAge -> ShowS
[AdvisoryAge] -> ShowS
AdvisoryAge -> String
(Int -> AdvisoryAge -> ShowS)
-> (AdvisoryAge -> String)
-> ([AdvisoryAge] -> ShowS)
-> Show AdvisoryAge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdvisoryAge -> ShowS
showsPrec :: Int -> AdvisoryAge -> ShowS
$cshow :: AdvisoryAge -> String
show :: AdvisoryAge -> String
$cshowList :: [AdvisoryAge] -> ShowS
showList :: [AdvisoryAge] -> ShowS
Show)

{- | What a slot says about the serving artifact's publication. The undated case is separate
because a generation whose age cannot be established is not the same as none serving at all.
-}
data AdvisoryPublication
    = -- | Nothing is serving yet, so there is no artifact to age.
      NoGeneration
    | -- | The published object's own timestamp.
      PublishedAt UTCTime
    | -- | A generation is serving and the store reported no publication time for it.
      UndatedGeneration
    deriving stock (AdvisoryPublication -> AdvisoryPublication -> Bool
(AdvisoryPublication -> AdvisoryPublication -> Bool)
-> (AdvisoryPublication -> AdvisoryPublication -> Bool)
-> Eq AdvisoryPublication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdvisoryPublication -> AdvisoryPublication -> Bool
== :: AdvisoryPublication -> AdvisoryPublication -> Bool
$c/= :: AdvisoryPublication -> AdvisoryPublication -> Bool
/= :: AdvisoryPublication -> AdvisoryPublication -> Bool
Eq, Int -> AdvisoryPublication -> ShowS
[AdvisoryPublication] -> ShowS
AdvisoryPublication -> String
(Int -> AdvisoryPublication -> ShowS)
-> (AdvisoryPublication -> String)
-> ([AdvisoryPublication] -> ShowS)
-> Show AdvisoryPublication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdvisoryPublication -> ShowS
showsPrec :: Int -> AdvisoryPublication -> ShowS
$cshow :: AdvisoryPublication -> String
show :: AdvisoryPublication -> String
$cshowList :: [AdvisoryPublication] -> ShowS
showList :: [AdvisoryPublication] -> ShowS
Show)

{- | What a push permits. 'AdvisoryAging' is still eligible: it is the early warning, raised at
half the maximum so an update outage surfaces while there is still time to act on it.
-}
data AdvisoryFreshness
    = -- | Within half the maximum, or nothing serving to age.
      AdvisoryFresh
    | -- | Past half the maximum and still eligible.
      AdvisoryAging AdvisoryAge
    | -- | Past the maximum. CVE-based denial refuses, whatever its @onUnavailable@ says.
      AdvisoryStale AdvisoryAge
    | {- | A serving generation whose age cannot be established, which is unverified evidence
      and refuses on the same terms as an expired one.
      -}
      AdvisoryUndated
    deriving stock (AdvisoryFreshness -> AdvisoryFreshness -> Bool
(AdvisoryFreshness -> AdvisoryFreshness -> Bool)
-> (AdvisoryFreshness -> AdvisoryFreshness -> Bool)
-> Eq AdvisoryFreshness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdvisoryFreshness -> AdvisoryFreshness -> Bool
== :: AdvisoryFreshness -> AdvisoryFreshness -> Bool
$c/= :: AdvisoryFreshness -> AdvisoryFreshness -> Bool
/= :: AdvisoryFreshness -> AdvisoryFreshness -> Bool
Eq, Int -> AdvisoryFreshness -> ShowS
[AdvisoryFreshness] -> ShowS
AdvisoryFreshness -> String
(Int -> AdvisoryFreshness -> ShowS)
-> (AdvisoryFreshness -> String)
-> ([AdvisoryFreshness] -> ShowS)
-> Show AdvisoryFreshness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdvisoryFreshness -> ShowS
showsPrec :: Int -> AdvisoryFreshness -> ShowS
$cshow :: AdvisoryFreshness -> String
show :: AdvisoryFreshness -> String
$cshowList :: [AdvisoryFreshness] -> ShowS
showList :: [AdvisoryFreshness] -> ShowS
Show)

{- | Read one publication against a maximum: equal to it is eligible, and greater expires. Nothing
serving is not aged here, leaving the ordinary absent-database path to decide.
-}
assessAdvisoryAge :: MaxAdvisoryAge -> UTCTime -> AdvisoryPublication -> AdvisoryFreshness
assessAdvisoryAge :: MaxAdvisoryAge
-> UTCTime -> AdvisoryPublication -> AdvisoryFreshness
assessAdvisoryAge MaxAdvisoryAge
limit UTCTime
now = \case
    AdvisoryPublication
NoGeneration -> AdvisoryFreshness
AdvisoryFresh
    AdvisoryPublication
UndatedGeneration -> AdvisoryFreshness
AdvisoryUndated
    PublishedAt UTCTime
pushedAt -> UTCTime -> AdvisoryFreshness
reading UTCTime
pushedAt
  where
    reading :: UTCTime -> AdvisoryFreshness
reading UTCTime
pushedAt
        | NominalDiffTime
age NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
maxAge = AdvisoryAge -> AdvisoryFreshness
AdvisoryStale AdvisoryAge
observed
        -- Doubling the age keeps the halfway test off a division that could round either way.
        | NominalDiffTime
age NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
age NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
maxAge = AdvisoryAge -> AdvisoryFreshness
AdvisoryAging AdvisoryAge
observed
        | Bool
otherwise = AdvisoryFreshness
AdvisoryFresh
      where
        age :: NominalDiffTime
age = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
pushedAt
        maxAge :: NominalDiffTime
maxAge = MaxAdvisoryAge -> NominalDiffTime
maxAdvisoryAge MaxAdvisoryAge
limit
        observed :: AdvisoryAge
observed = AdvisoryAge{advisoryPushedAt :: UTCTime
advisoryPushedAt = UTCTime
pushedAt, advisoryAge :: NominalDiffTime
advisoryAge = NominalDiffTime
age, advisoryMaxAge :: NominalDiffTime
advisoryMaxAge = NominalDiffTime
maxAge}

{- | The early warning's next latch state, and the reading to report where this one crosses. An
undated generation has no age to report and raises its own alarm where the artifact lands.
-}
ageAlarmStep :: Bool -> AdvisoryFreshness -> (Bool, Maybe AdvisoryAge)
ageAlarmStep :: Bool -> AdvisoryFreshness -> (Bool, Maybe AdvisoryAge)
ageAlarmStep Bool
latched = \case
    AdvisoryFreshness
AdvisoryFresh -> (Bool
False, Maybe AdvisoryAge
forall a. Maybe a
Nothing)
    AdvisoryFreshness
AdvisoryUndated -> (Bool
False, Maybe AdvisoryAge
forall a. Maybe a
Nothing)
    AdvisoryAging AdvisoryAge
observed -> AdvisoryAge -> (Bool, Maybe AdvisoryAge)
forall {f :: * -> *} {a}. Alternative f => a -> (Bool, f a)
crossing AdvisoryAge
observed
    AdvisoryStale AdvisoryAge
observed -> AdvisoryAge -> (Bool, Maybe AdvisoryAge)
forall {f :: * -> *} {a}. Alternative f => a -> (Bool, f a)
crossing AdvisoryAge
observed
  where
    crossing :: a -> (Bool, f a)
crossing a
observed = (Bool
True, a
observed a -> f () -> f a
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
latched))