-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT
{-# LANGUAGE TupleSections #-}

{- | What one advisory artifact records about the sources it was compiled from, and how old
those sources say their data is.

Pilot writes these values into the artifact's @meta@ table ("Ecluse.Core.Osv.Schema") and the
consumer decodes them back at open. They are diagnostics and ordering evidence: nothing here
refuses a version. A source that declares no value records no row, so absence stays
distinguishable from a guess.
-}
module Ecluse.Core.Osv.Provenance (
    -- * The recorded sources
    AdvisoryProvenance (..),
    noProvenance,
    provenanceRows,
    decodeProvenance,

    -- * Source timestamps
    parseSourceTime,
    parseHttpDate,
    lastModifiedOf,

    -- * The quiet-time reading
    QuietTime (..),
    defaultQuietTime,
    ProvenanceSource (..),
    SourceAge (..),
    sourceAges,
    sourceQuiet,
    renderSourceAge,
) where

import Data.List (lookup)
import Data.Text qualified as T
import Data.Time (Day, NominalDiffTime, UTCTime (UTCTime), defaultTimeLocale, diffUTCTime, parseTimeM)
import Data.Time.Format.ISO8601 (iso8601ParseM)

import Ecluse.Core.Osv.Schema (
    MetaKey (
        MetaEpssLastModified,
        MetaEpssModelVersion,
        MetaEpssScoreDate,
        MetaEpssSource,
        MetaOsvLastModified,
        MetaOsvNewestModified,
        MetaOsvSource
    ),
    renderMetaKey,
 )
import Ecluse.Core.Text (renderIso8601Utc)

{- | The sources one artifact was compiled from, as they described themselves. Every field is
'Nothing' when the source supplied no such value, or when an older artifact predates the key.
-}
data AdvisoryProvenance = AdvisoryProvenance
    { AdvisoryProvenance -> Maybe Text
apOsvSource :: Maybe Text
    -- ^ The advisory export's credential-free URL.
    , AdvisoryProvenance -> Maybe UTCTime
apOsvLastModified :: Maybe UTCTime
    -- ^ The @Last-Modified@ the export answered the successful fetch with.
    , AdvisoryProvenance -> Maybe UTCTime
apOsvNewestModified :: Maybe UTCTime
    -- ^ The newest @modified@ across the advisory records the pass read.
    , AdvisoryProvenance -> Maybe Text
apEpssSource :: Maybe Text
    -- ^ The EPSS feed's credential-free URL.
    , AdvisoryProvenance -> Maybe UTCTime
apEpssLastModified :: Maybe UTCTime
    -- ^ The @Last-Modified@ the feed answered the successful fetch with.
    , AdvisoryProvenance -> Maybe UTCTime
apEpssScoreDate :: Maybe UTCTime
    -- ^ The @score_date@ the feed declares, a bare date read as its UTC start of day.
    , AdvisoryProvenance -> Maybe Text
apEpssModelVersion :: Maybe Text
    -- ^ The scoring model the feed declares.
    }
    deriving stock (AdvisoryProvenance -> AdvisoryProvenance -> Bool
(AdvisoryProvenance -> AdvisoryProvenance -> Bool)
-> (AdvisoryProvenance -> AdvisoryProvenance -> Bool)
-> Eq AdvisoryProvenance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdvisoryProvenance -> AdvisoryProvenance -> Bool
== :: AdvisoryProvenance -> AdvisoryProvenance -> Bool
$c/= :: AdvisoryProvenance -> AdvisoryProvenance -> Bool
/= :: AdvisoryProvenance -> AdvisoryProvenance -> Bool
Eq, Int -> AdvisoryProvenance -> ShowS
[AdvisoryProvenance] -> ShowS
AdvisoryProvenance -> String
(Int -> AdvisoryProvenance -> ShowS)
-> (AdvisoryProvenance -> String)
-> ([AdvisoryProvenance] -> ShowS)
-> Show AdvisoryProvenance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdvisoryProvenance -> ShowS
showsPrec :: Int -> AdvisoryProvenance -> ShowS
$cshow :: AdvisoryProvenance -> String
show :: AdvisoryProvenance -> String
$cshowList :: [AdvisoryProvenance] -> ShowS
showList :: [AdvisoryProvenance] -> ShowS
Show)

-- | Nothing recorded, which is what an artifact compiled before these keys decodes to.
noProvenance :: AdvisoryProvenance
noProvenance :: AdvisoryProvenance
noProvenance = Maybe Text
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> AdvisoryProvenance
AdvisoryProvenance Maybe Text
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing

-- | The @meta@ rows one provenance writes. A value the source did not supply writes no row.
provenanceRows :: AdvisoryProvenance -> [(Text, Text)]
provenanceRows :: AdvisoryProvenance -> [(Text, Text)]
provenanceRows AdvisoryProvenance
prov =
    [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes
        [ MetaKey -> Maybe Text -> Maybe (Text, Text)
forall {f :: * -> *} {a}.
Functor f =>
MetaKey -> f a -> f (Text, a)
row MetaKey
MetaOsvSource (AdvisoryProvenance -> Maybe Text
apOsvSource AdvisoryProvenance
prov)
        , MetaKey -> Maybe Text -> Maybe (Text, Text)
forall {f :: * -> *} {a}.
Functor f =>
MetaKey -> f a -> f (Text, a)
row MetaKey
MetaOsvLastModified (UTCTime -> Text
renderIso8601Utc (UTCTime -> Text) -> Maybe UTCTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AdvisoryProvenance -> Maybe UTCTime
apOsvLastModified AdvisoryProvenance
prov)
        , MetaKey -> Maybe Text -> Maybe (Text, Text)
forall {f :: * -> *} {a}.
Functor f =>
MetaKey -> f a -> f (Text, a)
row MetaKey
MetaOsvNewestModified (UTCTime -> Text
renderIso8601Utc (UTCTime -> Text) -> Maybe UTCTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AdvisoryProvenance -> Maybe UTCTime
apOsvNewestModified AdvisoryProvenance
prov)
        , MetaKey -> Maybe Text -> Maybe (Text, Text)
forall {f :: * -> *} {a}.
Functor f =>
MetaKey -> f a -> f (Text, a)
row MetaKey
MetaEpssSource (AdvisoryProvenance -> Maybe Text
apEpssSource AdvisoryProvenance
prov)
        , MetaKey -> Maybe Text -> Maybe (Text, Text)
forall {f :: * -> *} {a}.
Functor f =>
MetaKey -> f a -> f (Text, a)
row MetaKey
MetaEpssLastModified (UTCTime -> Text
renderIso8601Utc (UTCTime -> Text) -> Maybe UTCTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AdvisoryProvenance -> Maybe UTCTime
apEpssLastModified AdvisoryProvenance
prov)
        , MetaKey -> Maybe Text -> Maybe (Text, Text)
forall {f :: * -> *} {a}.
Functor f =>
MetaKey -> f a -> f (Text, a)
row MetaKey
MetaEpssScoreDate (UTCTime -> Text
renderIso8601Utc (UTCTime -> Text) -> Maybe UTCTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AdvisoryProvenance -> Maybe UTCTime
apEpssScoreDate AdvisoryProvenance
prov)
        , MetaKey -> Maybe Text -> Maybe (Text, Text)
forall {f :: * -> *} {a}.
Functor f =>
MetaKey -> f a -> f (Text, a)
row MetaKey
MetaEpssModelVersion (AdvisoryProvenance -> Maybe Text
apEpssModelVersion AdvisoryProvenance
prov)
        ]
  where
    row :: MetaKey -> f a -> f (Text, a)
row MetaKey
key = (a -> (Text, a)) -> f a -> f (Text, a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MetaKey -> Text
renderMetaKey MetaKey
key,)

{- | Read the provenance an artifact's @meta@ rows carry. An absent key, an over-long value,
and an unreadable timestamp all read as absence, never as a fault.
-}
decodeProvenance :: [(Text, Text)] -> AdvisoryProvenance
decodeProvenance :: [(Text, Text)] -> AdvisoryProvenance
decodeProvenance [(Text, Text)]
rows =
    AdvisoryProvenance
noProvenance
        { apOsvSource = text maxSourceLength MetaOsvSource
        , apOsvLastModified = stamp MetaOsvLastModified
        , apOsvNewestModified = stamp MetaOsvNewestModified
        , apEpssSource = text maxSourceLength MetaEpssSource
        , apEpssLastModified = stamp MetaEpssLastModified
        , apEpssScoreDate = stamp MetaEpssScoreDate
        , apEpssModelVersion = text maxLabelLength MetaEpssModelVersion
        }
  where
    text :: Int -> MetaKey -> Maybe Text
text Int
limit MetaKey
key = do
        value <- Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (MetaKey -> Text
renderMetaKey MetaKey
key) [(Text, Text)]
rows
        guard (T.compareLength value limit /= GT)
        pure value
    stamp :: MetaKey -> Maybe UTCTime
stamp MetaKey
key = Text -> Maybe UTCTime
parseSourceTime (Text -> Maybe UTCTime) -> Maybe Text -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> MetaKey -> Maybe Text
text Int
maxStampLength MetaKey
key

-- Bounds on what a decoded value may be, so an artifact cannot hand the consumer an
-- unbounded string. Each is several times the longest value Pilot writes.
maxSourceLength, maxStampLength, maxLabelLength :: Int
maxSourceLength :: Int
maxSourceLength = Int
2048
maxStampLength :: Int
maxStampLength = Int
64
maxLabelLength :: Int
maxLabelLength = Int
128

{- | An RFC 3339 timestamp, or a bare date read as its UTC start of day. Anything else is
'Nothing', which records no value rather than an invented one.
-}
parseSourceTime :: Text -> Maybe UTCTime
parseSourceTime :: Text -> Maybe UTCTime
parseSourceTime Text
raw = Maybe UTCTime
rfc3339 Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe UTCTime
offsetWithoutColon Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe UTCTime
startOfDay
  where
    value :: String
value = Text -> String
forall a. ToString a => a -> String
toString (Text -> Text
T.strip Text
raw)
    rfc3339 :: Maybe UTCTime
rfc3339 = String -> Maybe UTCTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM String
value :: Maybe UTCTime
    -- The EPSS feed writes its offset as @+0000@, which RFC 3339 does not admit.
    offsetWithoutColon :: Maybe UTCTime
offsetWithoutColon = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%Y-%m-%dT%H:%M:%S%z" String
value
    startOfDay :: Maybe UTCTime
startOfDay = (Day -> DiffTime -> UTCTime
`UTCTime` DiffTime
0) (Day -> UTCTime) -> Maybe Day -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Maybe Day
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM String
value :: Maybe Day)

-- | The instant an HTTP @Last-Modified@ header names, or 'Nothing' when it is unreadable.
parseHttpDate :: Text -> Maybe UTCTime
parseHttpDate :: Text -> Maybe UTCTime
parseHttpDate Text
raw = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%a, %d %b %Y %H:%M:%S %Z" (Text -> String
forall a. ToString a => a -> String
toString (Text -> Text
T.strip Text
raw))

-- | The instant a response's @Last-Modified@ names. An absent or unreadable header records nothing.
lastModifiedOf :: [ByteString] -> Maybe UTCTime
lastModifiedOf :: [ByteString] -> Maybe UTCTime
lastModifiedOf = Text -> Maybe UTCTime
parseHttpDate (Text -> Maybe UTCTime)
-> (ByteString -> Text) -> ByteString -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Maybe UTCTime)
-> ([ByteString] -> Maybe ByteString)
-> [ByteString]
-> Maybe UTCTime
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe

{- | How old each source may be before Pilot raises its alarm. Loud ecosystems take a short
threshold and slow ones a long threshold, so a quiet feed is not read as a stalled one.
-}
data QuietTime = QuietTime
    { QuietTime -> NominalDiffTime
qtOsv :: NominalDiffTime
    -- ^ The threshold for this ecosystem's advisory export.
    , QuietTime -> NominalDiffTime
qtEpss :: NominalDiffTime
    -- ^ The threshold for the EPSS feed, which is one feed across every ecosystem.
    }
    deriving stock (QuietTime -> QuietTime -> Bool
(QuietTime -> QuietTime -> Bool)
-> (QuietTime -> QuietTime -> Bool) -> Eq QuietTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QuietTime -> QuietTime -> Bool
== :: QuietTime -> QuietTime -> Bool
$c/= :: QuietTime -> QuietTime -> Bool
/= :: QuietTime -> QuietTime -> Bool
Eq, Int -> QuietTime -> ShowS
[QuietTime] -> ShowS
QuietTime -> String
(Int -> QuietTime -> ShowS)
-> (QuietTime -> String)
-> ([QuietTime] -> ShowS)
-> Show QuietTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QuietTime -> ShowS
showsPrec :: Int -> QuietTime -> ShowS
$cshow :: QuietTime -> String
show :: QuietTime -> String
$cshowList :: [QuietTime] -> ShowS
showList :: [QuietTime] -> ShowS
Show)

-- | Seven days, the threshold a source with no configured value of its own is judged by.
defaultQuietTime :: NominalDiffTime
defaultQuietTime :: NominalDiffTime
defaultQuietTime = NominalDiffTime
604800

-- | Which upstream an age was read from.
data ProvenanceSource
    = -- | The ecosystem's advisory export, aged by its newest record @modified@.
      OsvExport
    | -- | The EPSS feed, aged by its declared @score_date@.
      EpssFeed
    deriving stock (ProvenanceSource -> ProvenanceSource -> Bool
(ProvenanceSource -> ProvenanceSource -> Bool)
-> (ProvenanceSource -> ProvenanceSource -> Bool)
-> Eq ProvenanceSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProvenanceSource -> ProvenanceSource -> Bool
== :: ProvenanceSource -> ProvenanceSource -> Bool
$c/= :: ProvenanceSource -> ProvenanceSource -> Bool
/= :: ProvenanceSource -> ProvenanceSource -> Bool
Eq, Int -> ProvenanceSource -> ShowS
[ProvenanceSource] -> ShowS
ProvenanceSource -> String
(Int -> ProvenanceSource -> ShowS)
-> (ProvenanceSource -> String)
-> ([ProvenanceSource] -> ShowS)
-> Show ProvenanceSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProvenanceSource -> ShowS
showsPrec :: Int -> ProvenanceSource -> ShowS
$cshow :: ProvenanceSource -> String
show :: ProvenanceSource -> String
$cshowList :: [ProvenanceSource] -> ShowS
showList :: [ProvenanceSource] -> ShowS
Show)

-- | One source's age at an instant, with the threshold that decides whether it is quiet.
data SourceAge = SourceAge
    { SourceAge -> ProvenanceSource
saSource :: ProvenanceSource
    , SourceAge -> Text
saUrl :: Text
    -- ^ The credential-free source URL, or @\<unrecorded\>@ when the artifact carries none.
    , SourceAge -> NominalDiffTime
saAge :: NominalDiffTime
    , SourceAge -> NominalDiffTime
saThreshold :: NominalDiffTime
    }
    deriving stock (SourceAge -> SourceAge -> Bool
(SourceAge -> SourceAge -> Bool)
-> (SourceAge -> SourceAge -> Bool) -> Eq SourceAge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceAge -> SourceAge -> Bool
== :: SourceAge -> SourceAge -> Bool
$c/= :: SourceAge -> SourceAge -> Bool
/= :: SourceAge -> SourceAge -> Bool
Eq, Int -> SourceAge -> ShowS
[SourceAge] -> ShowS
SourceAge -> String
(Int -> SourceAge -> ShowS)
-> (SourceAge -> String)
-> ([SourceAge] -> ShowS)
-> Show SourceAge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceAge -> ShowS
showsPrec :: Int -> SourceAge -> ShowS
$cshow :: SourceAge -> String
show :: SourceAge -> String
$cshowList :: [SourceAge] -> ShowS
showList :: [SourceAge] -> ShowS
Show)

{- | The ages this provenance supports at @now@. A source that recorded no timestamp yields no
age, because nothing about it can be read as quiet or fresh.
-}
sourceAges :: UTCTime -> QuietTime -> AdvisoryProvenance -> [SourceAge]
sourceAges :: UTCTime -> QuietTime -> AdvisoryProvenance -> [SourceAge]
sourceAges UTCTime
now QuietTime
quiet AdvisoryProvenance
prov =
    [Maybe SourceAge] -> [SourceAge]
forall a. [Maybe a] -> [a]
catMaybes
        [ ProvenanceSource
-> Maybe Text
-> NominalDiffTime
-> Maybe UTCTime
-> Maybe SourceAge
forall {m :: * -> *}.
Monad m =>
ProvenanceSource
-> Maybe Text -> NominalDiffTime -> m UTCTime -> m SourceAge
ageOf ProvenanceSource
OsvExport (AdvisoryProvenance -> Maybe Text
apOsvSource AdvisoryProvenance
prov) (QuietTime -> NominalDiffTime
qtOsv QuietTime
quiet) (AdvisoryProvenance -> Maybe UTCTime
apOsvNewestModified AdvisoryProvenance
prov)
        , ProvenanceSource
-> Maybe Text
-> NominalDiffTime
-> Maybe UTCTime
-> Maybe SourceAge
forall {m :: * -> *}.
Monad m =>
ProvenanceSource
-> Maybe Text -> NominalDiffTime -> m UTCTime -> m SourceAge
ageOf ProvenanceSource
EpssFeed (AdvisoryProvenance -> Maybe Text
apEpssSource AdvisoryProvenance
prov) (QuietTime -> NominalDiffTime
qtEpss QuietTime
quiet) (AdvisoryProvenance -> Maybe UTCTime
apEpssScoreDate AdvisoryProvenance
prov)
        ]
  where
    ageOf :: ProvenanceSource
-> Maybe Text -> NominalDiffTime -> m UTCTime -> m SourceAge
ageOf ProvenanceSource
source Maybe Text
url NominalDiffTime
threshold m UTCTime
mStamp = do
        stamp <- m UTCTime
mStamp
        pure
            SourceAge
                { saSource = source
                , saUrl = fromMaybe "<unrecorded>" url
                , saAge = diffUTCTime now stamp
                , saThreshold = threshold
                }

-- | Whether this source has gone longer than its threshold without changing.
sourceQuiet :: SourceAge -> Bool
sourceQuiet :: SourceAge -> Bool
sourceQuiet SourceAge
reading = SourceAge -> NominalDiffTime
saAge SourceAge
reading NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> SourceAge -> NominalDiffTime
saThreshold SourceAge
reading

-- | The age as an operator reads it, in the seconds its threshold is configured in.
renderSourceAge :: SourceAge -> Text
renderSourceAge :: SourceAge -> Text
renderSourceAge SourceAge
reading =
    ProvenanceSource -> Text
sourceName (SourceAge -> ProvenanceSource
saSource SourceAge
reading)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceAge -> Text
saUrl SourceAge
reading
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" last changed "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
seconds (SourceAge -> NominalDiffTime
saAge SourceAge
reading)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s ago, quiet-time threshold "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
seconds (SourceAge -> NominalDiffTime
saThreshold SourceAge
reading)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s"
  where
    seconds :: NominalDiffTime -> Text
    seconds :: NominalDiffTime -> Text
seconds NominalDiffTime
d = Integer -> Text
forall b a. (Show a, IsString b) => a -> b
show (NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate NominalDiffTime
d :: Integer)

sourceName :: ProvenanceSource -> Text
sourceName :: ProvenanceSource -> Text
sourceName = \case
    ProvenanceSource
OsvExport -> Text
"OSV export"
    ProvenanceSource
EpssFeed -> Text
"EPSS feed"