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

{- | The FIRST.org EPSS feed, the exploitability score Pilot joins onto each advisory.

Pilot joins the scores through advisory aliases ("Ecluse.Core.Osv.Advisory"). Every compile
attempts the feed. A failed fetch is an 'EpssFeedFailure', and the ecosystem's 'EpssRequirement'
decides whether it stops publication. Individual missing scores remain absent.
-}
module Ecluse.Core.Osv.Epss (
    -- * The feed
    maxEpssFeedBytes,
    maxEpssLineBytes,
    EpssFeed (..),
    fetchEpssScores,
    EpssFeedTooLarge (..),
    EpssFeedEmpty (..),
    EpssFeedTruncated (..),

    -- * One compile's attempt
    EpssFeedFailure (..),
    renderEpssFeedFailure,
    classifyEpssFailure,
    acquireEpssFeed,
    EpssEnrichment (..),
    resolveEnrichment,
    enrichedFeed,
    enrichmentStatus,

    -- * The score table
    EpssScores,
    mkEpssScores,
    epssForIds,
    epssScoreCount,

    -- * One feed row
    parseEpssLine,

    -- * The feed's preamble
    EpssPreamble (..),
    parseEpssPreamble,
) where

import Conduit
import Control.Monad.Catch (MonadMask)
import Data.ByteString qualified as BS
import Data.Conduit.Combinators qualified as C
import Data.Foldable1 qualified as Foldable1
import Data.Map.Strict qualified as Map
import Data.Streaming.Zlib (
    Popper,
    PopperRes (PRDone, PRError, PRNext),
    WindowBits (WindowBits),
    ZlibException,
    feedInflate,
    finishInflate,
    getUnusedInflate,
    initInflate,
    isCompleteInflate,
 )
import Data.Text qualified as T
import Data.Time (UTCTime)
import Katip (KatipContext, Severity (InfoS), logFM, ls)
import Network.HTTP.Client (HttpException (HttpExceptionRequest, InvalidUrlException), HttpExceptionContent (StatusCodeException), responseStatus)
import Network.HTTP.Simple (getResponseBody, getResponseHeader, httpSource, parseRequest, setRequestCheckStatus)
import Network.HTTP.Types.Header (hLastModified)
import Network.HTTP.Types.Status (statusCode)
import UnliftIO.Exception (tryJust)

import Ecluse.Core.Fault (TransportCause, TransportFault (tfCause), renderTransportCause)
import Ecluse.Core.Fault.Http (classifyTransport)
import Ecluse.Core.Osv.Provenance (lastModifiedOf, parseSourceTime)
import Ecluse.Core.Osv.Retry (defaultOsvRetryPolicy, withOsvRetry)
import Ecluse.Core.Osv.Schema (EpssRequirement (EpssOptional, EpssRequired), EpssStatus (EnrichmentAvailable, EnrichmentUnavailable))
import Ecluse.Core.Security.Authority (dialledAuthorityLabel)
import Ecluse.Core.Stream (boundBytes, boundLines)

{- | The byte ceiling Pilot fetches under, 64 MiB, applied to the served stream and again to its
expansion. The feed is one short row per scored CVE, so the headroom is several times over.
-}
maxEpssFeedBytes :: Int
maxEpssFeedBytes :: Int
maxEpssFeedBytes = Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

{- | The longest feed line Pilot holds, 4 KiB. A scored row is under 100 bytes, so a longer line
is no row, and bytes that never reach a newline cannot pile up.
-}
maxEpssLineBytes :: Int
maxEpssLineBytes :: Int
maxEpssLineBytes = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

{- | The feed passed a byte ceiling, so the fetch refused it whole. Each carries that ceiling
and the bytes seen when it tripped, which is the ceiling plus at most one chunk.
-}
data EpssFeedTooLarge
    = -- | The compressed stream the host served, so an endless one cannot hang the pass.
      CompressedTooLarge Int Int
    | -- | Its expansion under gzip, which is what a compression bomb inflates.
      DecompressedTooLarge Int Int
    | -- | One line of the expansion ('maxEpssLineBytes'), however the stream was chunked.
      LineTooLarge Int Int
    deriving stock (EpssFeedTooLarge -> EpssFeedTooLarge -> Bool
(EpssFeedTooLarge -> EpssFeedTooLarge -> Bool)
-> (EpssFeedTooLarge -> EpssFeedTooLarge -> Bool)
-> Eq EpssFeedTooLarge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssFeedTooLarge -> EpssFeedTooLarge -> Bool
== :: EpssFeedTooLarge -> EpssFeedTooLarge -> Bool
$c/= :: EpssFeedTooLarge -> EpssFeedTooLarge -> Bool
/= :: EpssFeedTooLarge -> EpssFeedTooLarge -> Bool
Eq, Int -> EpssFeedTooLarge -> ShowS
[EpssFeedTooLarge] -> ShowS
EpssFeedTooLarge -> String
(Int -> EpssFeedTooLarge -> ShowS)
-> (EpssFeedTooLarge -> String)
-> ([EpssFeedTooLarge] -> ShowS)
-> Show EpssFeedTooLarge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EpssFeedTooLarge -> ShowS
showsPrec :: Int -> EpssFeedTooLarge -> ShowS
$cshow :: EpssFeedTooLarge -> String
show :: EpssFeedTooLarge -> String
$cshowList :: [EpssFeedTooLarge] -> ShowS
showList :: [EpssFeedTooLarge] -> ShowS
Show)

instance Exception EpssFeedTooLarge

{- | The feed decoded to no scores at all: an error page served as 200, or a column order the row
decode no longer reads. Whole-feed failure remains distinct from an individual missing score.
-}
data EpssFeedEmpty = EpssFeedEmpty
    deriving stock (EpssFeedEmpty -> EpssFeedEmpty -> Bool
(EpssFeedEmpty -> EpssFeedEmpty -> Bool)
-> (EpssFeedEmpty -> EpssFeedEmpty -> Bool) -> Eq EpssFeedEmpty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssFeedEmpty -> EpssFeedEmpty -> Bool
== :: EpssFeedEmpty -> EpssFeedEmpty -> Bool
$c/= :: EpssFeedEmpty -> EpssFeedEmpty -> Bool
/= :: EpssFeedEmpty -> EpssFeedEmpty -> Bool
Eq, Int -> EpssFeedEmpty -> ShowS
[EpssFeedEmpty] -> ShowS
EpssFeedEmpty -> String
(Int -> EpssFeedEmpty -> ShowS)
-> (EpssFeedEmpty -> String)
-> ([EpssFeedEmpty] -> ShowS)
-> Show EpssFeedEmpty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EpssFeedEmpty -> ShowS
showsPrec :: Int -> EpssFeedEmpty -> ShowS
$cshow :: EpssFeedEmpty -> String
show :: EpssFeedEmpty -> String
$cshowList :: [EpssFeedEmpty] -> ShowS
showList :: [EpssFeedEmpty] -> ShowS
Show)

instance Exception EpssFeedEmpty

-- | A gzip member ended before its end-of-stream marker, so the rows it carried may be a fraction.
data EpssFeedTruncated = EpssFeedTruncated
    deriving stock (EpssFeedTruncated -> EpssFeedTruncated -> Bool
(EpssFeedTruncated -> EpssFeedTruncated -> Bool)
-> (EpssFeedTruncated -> EpssFeedTruncated -> Bool)
-> Eq EpssFeedTruncated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssFeedTruncated -> EpssFeedTruncated -> Bool
== :: EpssFeedTruncated -> EpssFeedTruncated -> Bool
$c/= :: EpssFeedTruncated -> EpssFeedTruncated -> Bool
/= :: EpssFeedTruncated -> EpssFeedTruncated -> Bool
Eq, Int -> EpssFeedTruncated -> ShowS
[EpssFeedTruncated] -> ShowS
EpssFeedTruncated -> String
(Int -> EpssFeedTruncated -> ShowS)
-> (EpssFeedTruncated -> String)
-> ([EpssFeedTruncated] -> ShowS)
-> Show EpssFeedTruncated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EpssFeedTruncated -> ShowS
showsPrec :: Int -> EpssFeedTruncated -> ShowS
$cshow :: EpssFeedTruncated -> String
show :: EpssFeedTruncated -> String
$cshowList :: [EpssFeedTruncated] -> ShowS
showList :: [EpssFeedTruncated] -> ShowS
Show)

instance Exception EpssFeedTruncated

{- | One fetch of the feed: the scores it carries, and what it says about itself. The feed
declares its own score date, so a stalled feed is visible without a second source of truth.
-}
data EpssFeed = EpssFeed
    { EpssFeed -> EpssScores
efScores :: EpssScores
    , EpssFeed -> Maybe UTCTime
efLastModified :: Maybe UTCTime
    -- ^ The @Last-Modified@ the fetch was answered with.
    , EpssFeed -> Maybe UTCTime
efScoreDate :: Maybe UTCTime
    -- ^ The @score_date@ the preamble declares, a bare date read as its UTC start of day.
    , EpssFeed -> Maybe Text
efModelVersion :: Maybe Text
    -- ^ The scoring model the preamble declares.
    }
    deriving stock (EpssFeed -> EpssFeed -> Bool
(EpssFeed -> EpssFeed -> Bool)
-> (EpssFeed -> EpssFeed -> Bool) -> Eq EpssFeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssFeed -> EpssFeed -> Bool
== :: EpssFeed -> EpssFeed -> Bool
$c/= :: EpssFeed -> EpssFeed -> Bool
/= :: EpssFeed -> EpssFeed -> Bool
Eq, Int -> EpssFeed -> ShowS
[EpssFeed] -> ShowS
EpssFeed -> String
(Int -> EpssFeed -> ShowS)
-> (EpssFeed -> String) -> ([EpssFeed] -> ShowS) -> Show EpssFeed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EpssFeed -> ShowS
showsPrec :: Int -> EpssFeed -> ShowS
$cshow :: EpssFeed -> String
show :: EpssFeed -> String
$cshowList :: [EpssFeed] -> ShowS
showList :: [EpssFeed] -> ShowS
Show)

{- | What the feed's leading comment line declares. FIRST.org writes it as
@#model_version:v2026.08.01,score_date:2026-08-29T00:00:00+0000@.
-}
data EpssPreamble = EpssPreamble
    { EpssPreamble -> Maybe UTCTime
epScoreDate :: Maybe UTCTime
    , EpssPreamble -> Maybe Text
epModelVersion :: Maybe Text
    }
    deriving stock (EpssPreamble -> EpssPreamble -> Bool
(EpssPreamble -> EpssPreamble -> Bool)
-> (EpssPreamble -> EpssPreamble -> Bool) -> Eq EpssPreamble
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssPreamble -> EpssPreamble -> Bool
== :: EpssPreamble -> EpssPreamble -> Bool
$c/= :: EpssPreamble -> EpssPreamble -> Bool
/= :: EpssPreamble -> EpssPreamble -> Bool
Eq, Int -> EpssPreamble -> ShowS
[EpssPreamble] -> ShowS
EpssPreamble -> String
(Int -> EpssPreamble -> ShowS)
-> (EpssPreamble -> String)
-> ([EpssPreamble] -> ShowS)
-> Show EpssPreamble
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EpssPreamble -> ShowS
showsPrec :: Int -> EpssPreamble -> ShowS
$cshow :: EpssPreamble -> String
show :: EpssPreamble -> String
$cshowList :: [EpssPreamble] -> ShowS
showList :: [EpssPreamble] -> ShowS
Show)

{- | Read the feed's leading comment line. A line that is not a comment, a comment naming
neither field, and a date the grammar cannot read all yield absence, never a substitute value.
-}
parseEpssPreamble :: ByteString -> EpssPreamble
parseEpssPreamble :: ByteString -> EpssPreamble
parseEpssPreamble ByteString
raw = case Text -> Text -> Maybe Text
T.stripPrefix Text
"#" (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
raw) of
    Maybe Text
Nothing -> Maybe UTCTime -> Maybe Text -> EpssPreamble
EpssPreamble Maybe UTCTime
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
    Just Text
body ->
        EpssPreamble
            { epScoreDate :: Maybe UTCTime
epScoreDate = Text -> Maybe UTCTime
parseSourceTime (Text -> Maybe UTCTime) -> Maybe Text -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Maybe Text
field Text
"score_date" Text
body
            , epModelVersion :: Maybe Text
epModelVersion = Text -> Text -> Maybe Text
field Text
"model_version" Text
body
            }
  where
    -- The score date holds colons of its own, so each field splits on its first one only.
    field :: Text -> Text -> Maybe Text
field Text
name Text
body = (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ((Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Text -> Maybe Text
valueOf Text
name) (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
body))
    valueOf :: Text -> Text -> Maybe Text
valueOf Text
name Text
entry =
        let (Text
key, Text
value) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
":" Text
entry
         in if Text -> Text
T.strip Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Text
T.strip (Int -> Text -> Text
T.drop Int
1 Text
value)) else Maybe Text
forall a. Maybe a
Nothing

{- | The scores from one fetch of the feed. Keys are upper-cased CVE ids, so a case
difference between the feed and an advisory's aliases cannot silently miss the join.
-}
newtype EpssScores = EpssScores (Map Text Double)
    deriving stock (EpssScores -> EpssScores -> Bool
(EpssScores -> EpssScores -> Bool)
-> (EpssScores -> EpssScores -> Bool) -> Eq EpssScores
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssScores -> EpssScores -> Bool
== :: EpssScores -> EpssScores -> Bool
$c/= :: EpssScores -> EpssScores -> Bool
/= :: EpssScores -> EpssScores -> Bool
Eq, Int -> EpssScores -> ShowS
[EpssScores] -> ShowS
EpssScores -> String
(Int -> EpssScores -> ShowS)
-> (EpssScores -> String)
-> ([EpssScores] -> ShowS)
-> Show EpssScores
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EpssScores -> ShowS
showsPrec :: Int -> EpssScores -> ShowS
$cshow :: EpssScores -> String
show :: EpssScores -> String
$cshowList :: [EpssScores] -> ShowS
showList :: [EpssScores] -> ShowS
Show)

{- | Build a score table from @(CVE id, probability)@ rows. A duplicate id keeps the higher
score, the fail-closed direction for a rule that denies above a threshold.
-}
mkEpssScores :: [(Text, Double)] -> EpssScores
mkEpssScores :: [(Text, Double)] -> EpssScores
mkEpssScores = (EpssScores -> (Text, Double) -> EpssScores)
-> EpssScores -> [(Text, Double)] -> EpssScores
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((Text, Double) -> EpssScores -> EpssScores)
-> EpssScores -> (Text, Double) -> EpssScores
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text, Double) -> EpssScores -> EpssScores
addScore) (Map Text Double -> EpssScores
EpssScores Map Text Double
forall k a. Map k a
Map.empty)

addScore :: (Text, Double) -> EpssScores -> EpssScores
addScore :: (Text, Double) -> EpssScores -> EpssScores
addScore (Text
cve, Double
score) (EpssScores Map Text Double
scores) = Map Text Double -> EpssScores
EpssScores ((Double -> Double -> Double)
-> Text -> Double -> Map Text Double -> Map Text Double
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Text -> Text
T.toUpper Text
cve) Double
score Map Text Double
scores)

{- | The highest score the feed carries for any of these identifiers, or 'Nothing' when it
scores none of them.
-}
epssForIds :: EpssScores -> [Text] -> Maybe Double
epssForIds :: EpssScores -> [Text] -> Maybe Double
epssForIds (EpssScores Map Text Double
scores) [Text]
ids = (NonEmpty Double -> Double) -> [Double] -> Maybe Double
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty Double -> Double
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable1 t, Ord a) => t a -> a
Foldable1.maximum ((Text -> Maybe Double) -> [Text] -> [Double]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Double
lookupScore [Text]
ids)
  where
    lookupScore :: Text -> Maybe Double
lookupScore Text
i = Text -> Map Text Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Text
T.toUpper Text
i) Map Text Double
scores

-- | How many CVEs the table scores.
epssScoreCount :: EpssScores -> Int
epssScoreCount :: EpssScores -> Int
epssScoreCount (EpssScores Map Text Double
scores) = Map Text Double -> Int
forall k a. Map k a -> Int
Map.size Map Text Double
scores

{- | One feed row as @(CVE id, probability)@. A comment, the header, an unreadable row, and a
score outside @[0, 1]@ all yield 'Nothing', so one bad row drops out instead of failing the pass.
-}
parseEpssLine :: ByteString -> Maybe (Text, Double)
parseEpssLine :: ByteString -> Maybe (Text, Double)
parseEpssLine ByteString
raw = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
raw) of
    (Text
cve : Text
score : [Text]
_) -> (,) (Text -> Double -> (Text, Double))
-> Maybe Text -> Maybe (Double -> (Text, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
identifier (Text -> Text
T.strip Text
cve) Maybe (Double -> (Text, Double))
-> Maybe Double -> Maybe (Text, Double)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Double
forall {b} {a}. (Read b, ToString a, Ord b, Num b) => a -> Maybe b
probability (Text -> Text
T.strip Text
score)
    [Text]
_ -> Maybe (Text, Double)
forall a. Maybe a
Nothing
  where
    identifier :: Text -> Maybe Text
identifier Text
t = if Text -> Bool
T.null Text
t then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
    probability :: a -> Maybe b
probability a
t = do
        p <- String -> Maybe b
forall a. Read a => String -> Maybe a
readMaybe (a -> String
forall a. ToString a => a -> String
toString a
t)
        guard (p >= 0 && p <= 1)
        pure p

{- | Fetch the feed and decode it into a score table, bounded by @cap@ bytes on each side of
decompression. A non-2xx, undecodable, over-large, or scoreless feed throws.
-}
fetchEpssScores :: (MonadResource m, MonadThrow m, KatipContext m) => Int -> String -> m EpssFeed
fetchEpssScores :: forall (m :: * -> *).
(MonadResource m, MonadThrow m, KatipContext m) =>
Int -> String -> m EpssFeed
fetchEpssScores Int
cap String
urlStr = do
    -- 'setRequestCheckStatus' throws at the header boundary, so a 502 reaches the caller's
    -- backoff as a retryable fault instead of feeding an error page to the decompressor.
    req <- IO Request -> m Request
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Request -> Request
setRequestCheckStatus (Request -> Request) -> IO Request -> IO Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
urlStr)
    -- The header is read from the response that carried the rows, so the date and the scores
    -- describe one fetch.
    (decoded, served) <- runConduit $ httpSource req $ \Response (ConduitM () ByteString m ())
res -> do
        accumulated <- Response (ConduitM () ByteString m ())
-> ConduitM () ByteString m ()
forall a. Response a -> a
getResponseBody Response (ConduitM () ByteString m ())
res ConduitM () ByteString m ()
-> ConduitT ByteString Void m FeedAccum
-> ConduitT () Void m FeedAccum
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Int -> ConduitT ByteString Void m FeedAccum
forall (m :: * -> *) o.
(MonadIO m, MonadThrow m) =>
Int -> ConduitT ByteString o m FeedAccum
decodeEpssFeed Int
cap
        pure (accumulated, lastModifiedOf (getResponseHeader hLastModified res))
    let scores = FeedAccum -> EpssScores
faScores FeedAccum
decoded
    when (epssScoreCount scores == 0) (throwM EpssFeedEmpty)
    logFM InfoS (ls ("Ingested " <> show (epssScoreCount scores) <> " EPSS scores from " <> dialledAuthorityLabel (toText urlStr)))
    pure
        EpssFeed
            { efScores = scores
            , efLastModified = served
            , efScoreDate = epScoreDate (faPreamble decoded)
            , efModelVersion = epModelVersion (faPreamble decoded)
            }

-- The running decode of one feed: the preamble the first line carries, and the scores the
-- rest of them do.
data FeedAccum = FeedAccum
    { FeedAccum -> Bool
faFirst :: !Bool
    , FeedAccum -> EpssPreamble
faPreamble :: EpssPreamble
    , FeedAccum -> EpssScores
faScores :: EpssScores
    }

-- The feed's wire form: gzip, then CSV rows. The served and expanded bounds cap the bytes a pass
-- reads, and the line bound caps what one unfinished row holds, however the stream is chunked.
decodeEpssFeed :: (MonadIO m, MonadThrow m) => Int -> ConduitT ByteString o m FeedAccum
decodeEpssFeed :: forall (m :: * -> *) o.
(MonadIO m, MonadThrow m) =>
Int -> ConduitT ByteString o m FeedAccum
decodeEpssFeed Int
cap =
    Int -> (Int -> m ()) -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
Int -> (Int -> m ()) -> ConduitT ByteString ByteString m ()
boundBytes Int
cap (EpssFeedTooLarge -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (EpssFeedTooLarge -> m ())
-> (Int -> EpssFeedTooLarge) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> EpssFeedTooLarge
CompressedTooLarge Int
cap)
        ConduitT ByteString ByteString m ()
-> ConduitT ByteString o m FeedAccum
-> ConduitT ByteString o m FeedAccum
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
ConduitT ByteString ByteString m ()
ungzipWhole
        ConduitT ByteString ByteString m ()
-> ConduitT ByteString o m FeedAccum
-> ConduitT ByteString o m FeedAccum
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Int -> (Int -> m ()) -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
Int -> (Int -> m ()) -> ConduitT ByteString ByteString m ()
boundBytes Int
cap (EpssFeedTooLarge -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (EpssFeedTooLarge -> m ())
-> (Int -> EpssFeedTooLarge) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> EpssFeedTooLarge
DecompressedTooLarge Int
cap)
        ConduitT ByteString ByteString m ()
-> ConduitT ByteString o m FeedAccum
-> ConduitT ByteString o m FeedAccum
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Int -> (Int -> m ()) -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
Int -> (Int -> m ()) -> ConduitT ByteString ByteString m ()
boundLines Int
maxEpssLineBytes (EpssFeedTooLarge -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (EpssFeedTooLarge -> m ())
-> (Int -> EpssFeedTooLarge) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> EpssFeedTooLarge
LineTooLarge Int
maxEpssLineBytes)
        ConduitT ByteString ByteString m ()
-> ConduitT ByteString o m FeedAccum
-> ConduitT ByteString o m FeedAccum
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (FeedAccum -> ByteString -> FeedAccum)
-> FeedAccum -> ConduitT ByteString o m FeedAccum
forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
C.foldl FeedAccum -> ByteString -> FeedAccum
addLine (Bool -> EpssPreamble -> EpssScores -> FeedAccum
FeedAccum Bool
True (Maybe UTCTime -> Maybe Text -> EpssPreamble
EpssPreamble Maybe UTCTime
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) ([(Text, Double)] -> EpssScores
mkEpssScores []))

-- Every gzip member to the end of input. Any byte that does not begin a whole member, zero padding
-- included, fails the feed. 'Data.Conduit.Zlib.ungzip' stops after one member and passes a cut one.
ungzipWhole :: (MonadIO m, MonadThrow m) => ConduitT ByteString ByteString m ()
ungzipWhole :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
ConduitT ByteString ByteString m ()
ungzipWhole = ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString ByteString m ()
-> (ByteString -> ConduitT ByteString ByteString m ())
-> Maybe ByteString
-> ConduitT ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConduitT ByteString ByteString m ()
forall (m :: * -> *) i o a. MonadThrow m => ConduitT i o m a
truncatedFeed ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
ByteString -> ConduitT ByteString ByteString m ()
inflateMember

-- One member from the bytes in hand. Input that ends before its end-of-stream marker truncates it.
inflateMember :: (MonadIO m, MonadThrow m) => ByteString -> ConduitT ByteString ByteString m ()
inflateMember :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
ByteString -> ConduitT ByteString ByteString m ()
inflateMember ByteString
opening = IO Inflate -> ConduitT ByteString ByteString m Inflate
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WindowBits -> IO Inflate
initInflate (Int -> WindowBits
WindowBits Int
31)) ConduitT ByteString ByteString m Inflate
-> (Inflate -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Inflate -> ByteString -> ConduitT ByteString ByteString m ()
forall {m :: * -> *}.
(MonadIO m, MonadThrow m) =>
Inflate -> ByteString -> ConduitT ByteString ByteString m ()
`feed` ByteString
opening)
  where
    feed :: Inflate -> ByteString -> ConduitT ByteString ByteString m ()
feed Inflate
inflate ByteString
chunk = do
        IO Popper -> ConduitT ByteString ByteString m Popper
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Inflate -> ByteString -> IO Popper
feedInflate Inflate
inflate ByteString
chunk) ConduitT ByteString ByteString m Popper
-> (Popper -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Popper -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i.
(MonadIO m, MonadThrow m) =>
Popper -> ConduitT i ByteString m ()
drainInflate
        complete <- IO Bool -> ConduitT ByteString ByteString m Bool
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Inflate -> IO Bool
isCompleteInflate Inflate
inflate)
        if complete
            then do
                liftIO (finishInflate inflate) >>= yieldNonEmpty
                liftIO (getUnusedInflate inflate) >>= afterMember
            else await >>= maybe truncatedFeed (feed inflate)

-- Any byte after a complete member starts another, so trailing bytes are read, not ignored.
afterMember :: (MonadIO m, MonadThrow m) => ByteString -> ConduitT ByteString ByteString m ()
afterMember :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
ByteString -> ConduitT ByteString ByteString m ()
afterMember ByteString
rest
    | ByteString -> Bool
BS.null ByteString
rest = ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString ByteString m ()
-> (ByteString -> ConduitT ByteString ByteString m ())
-> Maybe ByteString
-> ConduitT ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => f ()
pass ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
ByteString -> ConduitT ByteString ByteString m ()
afterMember
    | Bool
otherwise = ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
ByteString -> ConduitT ByteString ByteString m ()
inflateMember ByteString
rest

drainInflate :: (MonadIO m, MonadThrow m) => Popper -> ConduitT i ByteString m ()
drainInflate :: forall (m :: * -> *) i.
(MonadIO m, MonadThrow m) =>
Popper -> ConduitT i ByteString m ()
drainInflate Popper
popper =
    Popper -> ConduitT i ByteString m PopperRes
forall a. IO a -> ConduitT i ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Popper
popper ConduitT i ByteString m PopperRes
-> (PopperRes -> ConduitT i ByteString m ())
-> ConduitT i ByteString m ()
forall a b.
ConduitT i ByteString m a
-> (a -> ConduitT i ByteString m b) -> ConduitT i ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        PopperRes
PRDone -> ConduitT i ByteString m ()
forall (f :: * -> *). Applicative f => f ()
pass
        PRNext ByteString
out -> ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i ByteString m ()
yieldNonEmpty ByteString
out ConduitT i ByteString m ()
-> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall a b.
ConduitT i ByteString m a
-> ConduitT i ByteString m b -> ConduitT i ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Popper -> ConduitT i ByteString m ()
forall (m :: * -> *) i.
(MonadIO m, MonadThrow m) =>
Popper -> ConduitT i ByteString m ()
drainInflate Popper
popper
        PRError ZlibException
err -> ZlibException -> ConduitT i ByteString m ()
forall e a.
(HasCallStack, Exception e) =>
e -> ConduitT i ByteString m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM ZlibException
err

yieldNonEmpty :: (Monad m) => ByteString -> ConduitT i ByteString m ()
yieldNonEmpty :: forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i ByteString m ()
yieldNonEmpty ByteString
out = Bool -> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
out) (ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
out)

-- A throw, because only an exception stops the fetch mid-stream. 'acquireEpssFeed' reads it back.
truncatedFeed :: (MonadThrow m) => ConduitT i o m a
truncatedFeed :: forall (m :: * -> *) i o a. MonadThrow m => ConduitT i o m a
truncatedFeed = EpssFeedTruncated -> ConduitT i o m a
forall e a. (HasCallStack, Exception e) => e -> ConduitT i o m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM EpssFeedTruncated
EpssFeedTruncated

-- Only the first line can be the preamble, so a comment further down the feed cannot restate
-- the score date.
addLine :: FeedAccum -> ByteString -> FeedAccum
addLine :: FeedAccum -> ByteString -> FeedAccum
addLine FeedAccum
acc ByteString
line
    | FeedAccum -> Bool
faFirst FeedAccum
acc = FeedAccum
acc{faFirst = False, faPreamble = parseEpssPreamble line, faScores = scored}
    | Bool
otherwise = FeedAccum
acc{faScores = scored}
  where
    scored :: EpssScores
scored = EpssScores
-> ((Text, Double) -> EpssScores)
-> Maybe (Text, Double)
-> EpssScores
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FeedAccum -> EpssScores
faScores FeedAccum
acc) ((Text, Double) -> EpssScores -> EpssScores
`addScore` FeedAccum -> EpssScores
faScores FeedAccum
acc) (ByteString -> Maybe (Text, Double)
parseEpssLine ByteString
line)

-- | Why one attempt at the feed produced no scores.
data EpssFeedFailure
    = -- | The feed host answered with this non-2xx status.
      EpssFeedStatus Int
    | -- | The transport could not deliver the feed.
      EpssFeedTransport TransportCause
    | -- | The feed passed a byte ceiling.
      EpssFeedOversize EpssFeedTooLarge
    | -- | The feed is not valid gzip, or its stream ended early.
      EpssFeedUndecodable
    | -- | The feed decoded to no scores.
      EpssFeedNoScores
    deriving stock (EpssFeedFailure -> EpssFeedFailure -> Bool
(EpssFeedFailure -> EpssFeedFailure -> Bool)
-> (EpssFeedFailure -> EpssFeedFailure -> Bool)
-> Eq EpssFeedFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssFeedFailure -> EpssFeedFailure -> Bool
== :: EpssFeedFailure -> EpssFeedFailure -> Bool
$c/= :: EpssFeedFailure -> EpssFeedFailure -> Bool
/= :: EpssFeedFailure -> EpssFeedFailure -> Bool
Eq, Int -> EpssFeedFailure -> ShowS
[EpssFeedFailure] -> ShowS
EpssFeedFailure -> String
(Int -> EpssFeedFailure -> ShowS)
-> (EpssFeedFailure -> String)
-> ([EpssFeedFailure] -> ShowS)
-> Show EpssFeedFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EpssFeedFailure -> ShowS
showsPrec :: Int -> EpssFeedFailure -> ShowS
$cshow :: EpssFeedFailure -> String
show :: EpssFeedFailure -> String
$cshowList :: [EpssFeedFailure] -> ShowS
showList :: [EpssFeedFailure] -> ShowS
Show)

-- | The failure as an operator reads it. It never names the feed URL, which can carry a credential.
renderEpssFeedFailure :: EpssFeedFailure -> Text
renderEpssFeedFailure :: EpssFeedFailure -> Text
renderEpssFeedFailure = \case
    EpssFeedStatus Int
code -> Text
"the feed answered HTTP " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
code
    EpssFeedTransport TransportCause
cause -> TransportCause -> Text
renderTransportCause TransportCause
cause
    EpssFeedOversize (CompressedTooLarge Int
cap Int
_) -> Text
"the served feed passed its " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
cap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-byte ceiling"
    EpssFeedOversize (DecompressedTooLarge Int
cap Int
_) -> Text
"the decompressed feed passed its " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
cap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-byte ceiling"
    EpssFeedOversize (LineTooLarge Int
cap Int
_) -> Text
"a feed line passed its " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
cap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-byte ceiling"
    EpssFeedFailure
EpssFeedUndecodable -> Text
"the feed is not a complete gzip stream"
    EpssFeedFailure
EpssFeedNoScores -> Text
"the feed carried no scores"

{- | The feed failures a compile can continue past. An invalid URL is a configuration fault, and
anything unnamed here may be a bug, so both stay exceptions rather than read as an outage.
-}
classifyEpssFailure :: SomeException -> Maybe EpssFeedFailure
classifyEpssFailure :: SomeException -> Maybe EpssFeedFailure
classifyEpssFailure SomeException
err
    | Just HttpException
http <- SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err = HttpException -> Maybe EpssFeedFailure
httpFailure HttpException
http
    | Just EpssFeedTooLarge
tooLarge <- SomeException -> Maybe EpssFeedTooLarge
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err = EpssFeedFailure -> Maybe EpssFeedFailure
forall a. a -> Maybe a
Just (EpssFeedTooLarge -> EpssFeedFailure
EpssFeedOversize EpssFeedTooLarge
tooLarge)
    | Just EpssFeedEmpty
EpssFeedEmpty <- SomeException -> Maybe EpssFeedEmpty
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err = EpssFeedFailure -> Maybe EpssFeedFailure
forall a. a -> Maybe a
Just EpssFeedFailure
EpssFeedNoScores
    | Just (ZlibException
_ :: ZlibException) <- SomeException -> Maybe ZlibException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err = EpssFeedFailure -> Maybe EpssFeedFailure
forall a. a -> Maybe a
Just EpssFeedFailure
EpssFeedUndecodable
    | Just EpssFeedTruncated
EpssFeedTruncated <- SomeException -> Maybe EpssFeedTruncated
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err = EpssFeedFailure -> Maybe EpssFeedFailure
forall a. a -> Maybe a
Just EpssFeedFailure
EpssFeedUndecodable
    | Bool
otherwise = Maybe EpssFeedFailure
forall a. Maybe a
Nothing

httpFailure :: HttpException -> Maybe EpssFeedFailure
httpFailure :: HttpException -> Maybe EpssFeedFailure
httpFailure = \case
    InvalidUrlException{} -> Maybe EpssFeedFailure
forall a. Maybe a
Nothing
    HttpExceptionRequest Request
_ (StatusCodeException Response ()
response ByteString
_) -> EpssFeedFailure -> Maybe EpssFeedFailure
forall a. a -> Maybe a
Just (Int -> EpssFeedFailure
EpssFeedStatus (Status -> Int
statusCode (Response () -> Status
forall body. Response body -> Status
responseStatus Response ()
response)))
    HttpException
other -> EpssFeedFailure -> Maybe EpssFeedFailure
forall a. a -> Maybe a
Just (TransportCause -> EpssFeedFailure
EpssFeedTransport (TransportFault -> TransportCause
tfCause (HttpException -> TransportFault
classifyTransport HttpException
other)))

{- | Fetch the feed under the advisory retry policy. A failure 'classifyEpssFailure' names returns
as a value, and every other exception, a cancellation included, propagates.
-}
acquireEpssFeed :: (MonadResource m, MonadMask m, MonadUnliftIO m, KatipContext m) => Int -> String -> m (Either EpssFeedFailure EpssFeed)
acquireEpssFeed :: forall (m :: * -> *).
(MonadResource m, MonadMask m, MonadUnliftIO m, KatipContext m) =>
Int -> String -> m (Either EpssFeedFailure EpssFeed)
acquireEpssFeed Int
cap String
url = (SomeException -> Maybe EpssFeedFailure)
-> m EpssFeed -> m (Either EpssFeedFailure EpssFeed)
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust SomeException -> Maybe EpssFeedFailure
classifyEpssFailure (RetryPolicyM m -> m EpssFeed -> m EpssFeed
forall (m :: * -> *) a.
(MonadMask m, KatipContext m) =>
RetryPolicyM m -> m a -> m a
withOsvRetry RetryPolicyM m
forall (m :: * -> *). MonadIO m => RetryPolicyM m
defaultOsvRetryPolicy (Int -> String -> m EpssFeed
forall (m :: * -> *).
(MonadResource m, MonadThrow m, KatipContext m) =>
Int -> String -> m EpssFeed
fetchEpssScores Int
cap String
url))

-- | What one compile joins onto its advisories.
data EpssEnrichment
    = -- | The feed arrived, so its scores join and its provenance is recorded.
      EpssEnriched EpssFeed
    | -- | The feed failed where the ecosystem does not require it, so no score joins.
      EpssUnavailable EpssFeedFailure
    deriving stock (EpssEnrichment -> EpssEnrichment -> Bool
(EpssEnrichment -> EpssEnrichment -> Bool)
-> (EpssEnrichment -> EpssEnrichment -> Bool) -> Eq EpssEnrichment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssEnrichment -> EpssEnrichment -> Bool
== :: EpssEnrichment -> EpssEnrichment -> Bool
$c/= :: EpssEnrichment -> EpssEnrichment -> Bool
/= :: EpssEnrichment -> EpssEnrichment -> Bool
Eq, Int -> EpssEnrichment -> ShowS
[EpssEnrichment] -> ShowS
EpssEnrichment -> String
(Int -> EpssEnrichment -> ShowS)
-> (EpssEnrichment -> String)
-> ([EpssEnrichment] -> ShowS)
-> Show EpssEnrichment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EpssEnrichment -> ShowS
showsPrec :: Int -> EpssEnrichment -> ShowS
$cshow :: EpssEnrichment -> String
show :: EpssEnrichment -> String
$cshowList :: [EpssEnrichment] -> ShowS
showList :: [EpssEnrichment] -> ShowS
Show)

{- | Settle one attempt under the ecosystem's requirement. A failure stays 'Left' where the
ecosystem requires enrichment, so an unavailable feed never stands in for a required one.
-}
resolveEnrichment :: EpssRequirement -> Either EpssFeedFailure EpssFeed -> Either EpssFeedFailure EpssEnrichment
resolveEnrichment :: EpssRequirement
-> Either EpssFeedFailure EpssFeed
-> Either EpssFeedFailure EpssEnrichment
resolveEnrichment EpssRequirement
requirement = \case
    Right EpssFeed
feed -> EpssEnrichment -> Either EpssFeedFailure EpssEnrichment
forall a b. b -> Either a b
Right (EpssFeed -> EpssEnrichment
EpssEnriched EpssFeed
feed)
    Left EpssFeedFailure
failure -> case EpssRequirement
requirement of
        EpssRequirement
EpssRequired -> EpssFeedFailure -> Either EpssFeedFailure EpssEnrichment
forall a b. a -> Either a b
Left EpssFeedFailure
failure
        EpssRequirement
EpssOptional -> EpssEnrichment -> Either EpssFeedFailure EpssEnrichment
forall a b. b -> Either a b
Right (EpssFeedFailure -> EpssEnrichment
EpssUnavailable EpssFeedFailure
failure)

-- | The feed an enrichment joined, if one arrived.
enrichedFeed :: EpssEnrichment -> Maybe EpssFeed
enrichedFeed :: EpssEnrichment -> Maybe EpssFeed
enrichedFeed = \case
    EpssEnriched EpssFeed
feed -> EpssFeed -> Maybe EpssFeed
forall a. a -> Maybe a
Just EpssFeed
feed
    EpssUnavailable EpssFeedFailure
_ -> Maybe EpssFeed
forall a. Maybe a
Nothing

-- | The status the artifact records for this enrichment.
enrichmentStatus :: EpssEnrichment -> EpssStatus
enrichmentStatus :: EpssEnrichment -> EpssStatus
enrichmentStatus = \case
    EpssEnriched EpssFeed
_ -> EpssStatus
EnrichmentAvailable
    EpssUnavailable EpssFeedFailure
_ -> EpssStatus
EnrichmentUnavailable