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

{- | Decode advisory evidence for the compiled artifact.
Package keys use the same ecosystem identity as policy queries.
-}
module Ecluse.Core.Osv.Advisory (
    OsvAdvisory (..),
    OsvAffected (..),
    OsvPackage (..),
    OsvRange (..),
    OsvEvent (..),
    OsvDatabaseSpecific (..),
    OsvSeverityEntry (..),
    ExtractedOsv (..),
    advisorySeverity,
    extractFromAdvisory,
    orderableBounds,
    unorderableBounds,
    osvExportUrl,
) where

import Prelude hiding (universe)

import Data.Aeson (FromJSON (..), withObject, (.:), (.:?))
import Data.Foldable1 qualified as Foldable1
import Data.Text qualified as T
import Data.Time (UTCTime)
import Data.Universe.Class (Universe (universe))
import Security.CVSS (cvssScore, parseCVSS)

import Ecluse.Core.Ecosystem (Ecosystem)
import Ecluse.Core.Osv.Ecosystem (osvEcosystemFor, osvExportDirectory)
import Ecluse.Core.Osv.Epss (EpssScores, epssForIds)
import Ecluse.Core.Osv.Types (UpperBound (..))
import Ecluse.Core.Package (canonicalise)
import Ecluse.Core.Text (joinUrlPath)
import Ecluse.Core.Version (parseVersionKey)

-- | The OSV fields used to select and score active advisory evidence.
data OsvAdvisory = OsvAdvisory
    { OsvAdvisory -> Text
osvId :: Text
    , OsvAdvisory -> Maybe [Text]
osvAliases :: Maybe [Text]
    {- ^ The same vulnerability's identifiers in other databases. An npm advisory is
    GHSA-keyed, so its CVE ids live here, and they are what the EPSS feed keys on.
    -}
    , OsvAdvisory -> Maybe [OsvAffected]
osvAffected :: Maybe [OsvAffected]
    , OsvAdvisory -> Maybe [OsvSeverityEntry]
osvSeverity :: Maybe [OsvSeverityEntry]
    , OsvAdvisory -> Maybe OsvDatabaseSpecific
osvDatabaseSpecific :: Maybe OsvDatabaseSpecific
    , OsvAdvisory -> Maybe UTCTime
osvWithdrawn :: Maybe UTCTime
    -- ^ A withdrawn record supplies no active evidence, even when it retains affected ranges.
    , OsvAdvisory -> Maybe Text
osvModified :: Maybe Text
    {- ^ When the source database last changed this record, as written. It is read where the
    pass judges it, so a value no grammar accepts costs the date and not the record.
    -}
    }
    deriving stock (Int -> OsvAdvisory -> ShowS
[OsvAdvisory] -> ShowS
OsvAdvisory -> String
(Int -> OsvAdvisory -> ShowS)
-> (OsvAdvisory -> String)
-> ([OsvAdvisory] -> ShowS)
-> Show OsvAdvisory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OsvAdvisory -> ShowS
showsPrec :: Int -> OsvAdvisory -> ShowS
$cshow :: OsvAdvisory -> String
show :: OsvAdvisory -> String
$cshowList :: [OsvAdvisory] -> ShowS
showList :: [OsvAdvisory] -> ShowS
Show, OsvAdvisory -> OsvAdvisory -> Bool
(OsvAdvisory -> OsvAdvisory -> Bool)
-> (OsvAdvisory -> OsvAdvisory -> Bool) -> Eq OsvAdvisory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OsvAdvisory -> OsvAdvisory -> Bool
== :: OsvAdvisory -> OsvAdvisory -> Bool
$c/= :: OsvAdvisory -> OsvAdvisory -> Bool
/= :: OsvAdvisory -> OsvAdvisory -> Bool
Eq)

instance FromJSON OsvAdvisory where
    parseJSON :: Value -> Parser OsvAdvisory
parseJSON = String
-> (Object -> Parser OsvAdvisory) -> Value -> Parser OsvAdvisory
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OsvAdvisory" ((Object -> Parser OsvAdvisory) -> Value -> Parser OsvAdvisory)
-> (Object -> Parser OsvAdvisory) -> Value -> Parser OsvAdvisory
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Text
-> Maybe [Text]
-> Maybe [OsvAffected]
-> Maybe [OsvSeverityEntry]
-> Maybe OsvDatabaseSpecific
-> Maybe UTCTime
-> Maybe Text
-> OsvAdvisory
OsvAdvisory
            (Text
 -> Maybe [Text]
 -> Maybe [OsvAffected]
 -> Maybe [OsvSeverityEntry]
 -> Maybe OsvDatabaseSpecific
 -> Maybe UTCTime
 -> Maybe Text
 -> OsvAdvisory)
-> Parser Text
-> Parser
     (Maybe [Text]
      -> Maybe [OsvAffected]
      -> Maybe [OsvSeverityEntry]
      -> Maybe OsvDatabaseSpecific
      -> Maybe UTCTime
      -> Maybe Text
      -> OsvAdvisory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            Parser
  (Maybe [Text]
   -> Maybe [OsvAffected]
   -> Maybe [OsvSeverityEntry]
   -> Maybe OsvDatabaseSpecific
   -> Maybe UTCTime
   -> Maybe Text
   -> OsvAdvisory)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [OsvAffected]
      -> Maybe [OsvSeverityEntry]
      -> Maybe OsvDatabaseSpecific
      -> Maybe UTCTime
      -> Maybe Text
      -> OsvAdvisory)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aliases"
            Parser
  (Maybe [OsvAffected]
   -> Maybe [OsvSeverityEntry]
   -> Maybe OsvDatabaseSpecific
   -> Maybe UTCTime
   -> Maybe Text
   -> OsvAdvisory)
-> Parser (Maybe [OsvAffected])
-> Parser
     (Maybe [OsvSeverityEntry]
      -> Maybe OsvDatabaseSpecific
      -> Maybe UTCTime
      -> Maybe Text
      -> OsvAdvisory)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [OsvAffected])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"affected"
            Parser
  (Maybe [OsvSeverityEntry]
   -> Maybe OsvDatabaseSpecific
   -> Maybe UTCTime
   -> Maybe Text
   -> OsvAdvisory)
-> Parser (Maybe [OsvSeverityEntry])
-> Parser
     (Maybe OsvDatabaseSpecific
      -> Maybe UTCTime -> Maybe Text -> OsvAdvisory)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [OsvSeverityEntry])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"severity"
            Parser
  (Maybe OsvDatabaseSpecific
   -> Maybe UTCTime -> Maybe Text -> OsvAdvisory)
-> Parser (Maybe OsvDatabaseSpecific)
-> Parser (Maybe UTCTime -> Maybe Text -> OsvAdvisory)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe OsvDatabaseSpecific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"database_specific"
            Parser (Maybe UTCTime -> Maybe Text -> OsvAdvisory)
-> Parser (Maybe UTCTime) -> Parser (Maybe Text -> OsvAdvisory)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"withdrawn"
            Parser (Maybe Text -> OsvAdvisory)
-> Parser (Maybe Text) -> Parser OsvAdvisory
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"modified"

{- | One entry of an advisory's @severity@ array: a scoring-system tag (@CVSS_V3@) and
its value. For a CVSS system that value is the /vector string/, not a number.
-}
data OsvSeverityEntry = OsvSeverityEntry
    { OsvSeverityEntry -> Text
sevType :: Text
    , OsvSeverityEntry -> Text
sevScore :: Text
    }
    deriving stock (Int -> OsvSeverityEntry -> ShowS
[OsvSeverityEntry] -> ShowS
OsvSeverityEntry -> String
(Int -> OsvSeverityEntry -> ShowS)
-> (OsvSeverityEntry -> String)
-> ([OsvSeverityEntry] -> ShowS)
-> Show OsvSeverityEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OsvSeverityEntry -> ShowS
showsPrec :: Int -> OsvSeverityEntry -> ShowS
$cshow :: OsvSeverityEntry -> String
show :: OsvSeverityEntry -> String
$cshowList :: [OsvSeverityEntry] -> ShowS
showList :: [OsvSeverityEntry] -> ShowS
Show, OsvSeverityEntry -> OsvSeverityEntry -> Bool
(OsvSeverityEntry -> OsvSeverityEntry -> Bool)
-> (OsvSeverityEntry -> OsvSeverityEntry -> Bool)
-> Eq OsvSeverityEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OsvSeverityEntry -> OsvSeverityEntry -> Bool
== :: OsvSeverityEntry -> OsvSeverityEntry -> Bool
$c/= :: OsvSeverityEntry -> OsvSeverityEntry -> Bool
/= :: OsvSeverityEntry -> OsvSeverityEntry -> Bool
Eq)

instance FromJSON OsvSeverityEntry where
    parseJSON :: Value -> Parser OsvSeverityEntry
parseJSON = String
-> (Object -> Parser OsvSeverityEntry)
-> Value
-> Parser OsvSeverityEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OsvSeverityEntry" ((Object -> Parser OsvSeverityEntry)
 -> Value -> Parser OsvSeverityEntry)
-> (Object -> Parser OsvSeverityEntry)
-> Value
-> Parser OsvSeverityEntry
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Text -> Text -> OsvSeverityEntry
OsvSeverityEntry
            (Text -> Text -> OsvSeverityEntry)
-> Parser Text -> Parser (Text -> OsvSeverityEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
            Parser (Text -> OsvSeverityEntry)
-> Parser Text -> Parser OsvSeverityEntry
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"score"

-- | The subset of an advisory's @database_specific@ block the pipeline consumes.
newtype OsvDatabaseSpecific = OsvDatabaseSpecific
    { OsvDatabaseSpecific -> Maybe Text
dbsSeverity :: Maybe Text
    {- ^ The source database's qualitative severity label (for GHSA-sourced npm
    advisories: @LOW@, @MODERATE@, @HIGH@, or @CRITICAL@).
    -}
    }
    deriving stock (Int -> OsvDatabaseSpecific -> ShowS
[OsvDatabaseSpecific] -> ShowS
OsvDatabaseSpecific -> String
(Int -> OsvDatabaseSpecific -> ShowS)
-> (OsvDatabaseSpecific -> String)
-> ([OsvDatabaseSpecific] -> ShowS)
-> Show OsvDatabaseSpecific
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OsvDatabaseSpecific -> ShowS
showsPrec :: Int -> OsvDatabaseSpecific -> ShowS
$cshow :: OsvDatabaseSpecific -> String
show :: OsvDatabaseSpecific -> String
$cshowList :: [OsvDatabaseSpecific] -> ShowS
showList :: [OsvDatabaseSpecific] -> ShowS
Show, OsvDatabaseSpecific -> OsvDatabaseSpecific -> Bool
(OsvDatabaseSpecific -> OsvDatabaseSpecific -> Bool)
-> (OsvDatabaseSpecific -> OsvDatabaseSpecific -> Bool)
-> Eq OsvDatabaseSpecific
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OsvDatabaseSpecific -> OsvDatabaseSpecific -> Bool
== :: OsvDatabaseSpecific -> OsvDatabaseSpecific -> Bool
$c/= :: OsvDatabaseSpecific -> OsvDatabaseSpecific -> Bool
/= :: OsvDatabaseSpecific -> OsvDatabaseSpecific -> Bool
Eq)

instance FromJSON OsvDatabaseSpecific where
    parseJSON :: Value -> Parser OsvDatabaseSpecific
parseJSON = String
-> (Object -> Parser OsvDatabaseSpecific)
-> Value
-> Parser OsvDatabaseSpecific
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OsvDatabaseSpecific" ((Object -> Parser OsvDatabaseSpecific)
 -> Value -> Parser OsvDatabaseSpecific)
-> (Object -> Parser OsvDatabaseSpecific)
-> Value
-> Parser OsvDatabaseSpecific
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Maybe Text -> OsvDatabaseSpecific
OsvDatabaseSpecific
            (Maybe Text -> OsvDatabaseSpecific)
-> Parser (Maybe Text) -> Parser OsvDatabaseSpecific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"severity"

data OsvAffected = OsvAffected
    { OsvAffected -> OsvPackage
affectedPackage :: OsvPackage
    , OsvAffected -> Maybe [OsvRange]
affectedRanges :: Maybe [OsvRange]
    , OsvAffected -> Maybe [Text]
affectedVersions :: Maybe [Text]
    {- ^ Exact affected versions enumerated outside any range, each an affected point.
    Much of the npm malware feed names the single bad version here with no @ranges@.
    -}
    }
    deriving stock (Int -> OsvAffected -> ShowS
[OsvAffected] -> ShowS
OsvAffected -> String
(Int -> OsvAffected -> ShowS)
-> (OsvAffected -> String)
-> ([OsvAffected] -> ShowS)
-> Show OsvAffected
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OsvAffected -> ShowS
showsPrec :: Int -> OsvAffected -> ShowS
$cshow :: OsvAffected -> String
show :: OsvAffected -> String
$cshowList :: [OsvAffected] -> ShowS
showList :: [OsvAffected] -> ShowS
Show, OsvAffected -> OsvAffected -> Bool
(OsvAffected -> OsvAffected -> Bool)
-> (OsvAffected -> OsvAffected -> Bool) -> Eq OsvAffected
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OsvAffected -> OsvAffected -> Bool
== :: OsvAffected -> OsvAffected -> Bool
$c/= :: OsvAffected -> OsvAffected -> Bool
/= :: OsvAffected -> OsvAffected -> Bool
Eq)

instance FromJSON OsvAffected where
    parseJSON :: Value -> Parser OsvAffected
parseJSON = String
-> (Object -> Parser OsvAffected) -> Value -> Parser OsvAffected
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OsvAffected" ((Object -> Parser OsvAffected) -> Value -> Parser OsvAffected)
-> (Object -> Parser OsvAffected) -> Value -> Parser OsvAffected
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        OsvPackage -> Maybe [OsvRange] -> Maybe [Text] -> OsvAffected
OsvAffected
            (OsvPackage -> Maybe [OsvRange] -> Maybe [Text] -> OsvAffected)
-> Parser OsvPackage
-> Parser (Maybe [OsvRange] -> Maybe [Text] -> OsvAffected)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser OsvPackage
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"package"
            Parser (Maybe [OsvRange] -> Maybe [Text] -> OsvAffected)
-> Parser (Maybe [OsvRange])
-> Parser (Maybe [Text] -> OsvAffected)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [OsvRange])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ranges"
            Parser (Maybe [Text] -> OsvAffected)
-> Parser (Maybe [Text]) -> Parser OsvAffected
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"versions"

data OsvPackage = OsvPackage
    { OsvPackage -> Text
packageName :: Text
    , OsvPackage -> Text
packageEcosystem :: Text
    }
    deriving stock (Int -> OsvPackage -> ShowS
[OsvPackage] -> ShowS
OsvPackage -> String
(Int -> OsvPackage -> ShowS)
-> (OsvPackage -> String)
-> ([OsvPackage] -> ShowS)
-> Show OsvPackage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OsvPackage -> ShowS
showsPrec :: Int -> OsvPackage -> ShowS
$cshow :: OsvPackage -> String
show :: OsvPackage -> String
$cshowList :: [OsvPackage] -> ShowS
showList :: [OsvPackage] -> ShowS
Show, OsvPackage -> OsvPackage -> Bool
(OsvPackage -> OsvPackage -> Bool)
-> (OsvPackage -> OsvPackage -> Bool) -> Eq OsvPackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OsvPackage -> OsvPackage -> Bool
== :: OsvPackage -> OsvPackage -> Bool
$c/= :: OsvPackage -> OsvPackage -> Bool
/= :: OsvPackage -> OsvPackage -> Bool
Eq)

instance FromJSON OsvPackage where
    parseJSON :: Value -> Parser OsvPackage
parseJSON = String
-> (Object -> Parser OsvPackage) -> Value -> Parser OsvPackage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OsvPackage" ((Object -> Parser OsvPackage) -> Value -> Parser OsvPackage)
-> (Object -> Parser OsvPackage) -> Value -> Parser OsvPackage
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Text -> Text -> OsvPackage
OsvPackage
            (Text -> Text -> OsvPackage)
-> Parser Text -> Parser (Text -> OsvPackage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            Parser (Text -> OsvPackage) -> Parser Text -> Parser OsvPackage
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ecosystem"

data OsvRange = OsvRange
    { OsvRange -> Text
rangeType :: Text
    , OsvRange -> [OsvEvent]
rangeEvents :: [OsvEvent]
    }
    deriving stock (Int -> OsvRange -> ShowS
[OsvRange] -> ShowS
OsvRange -> String
(Int -> OsvRange -> ShowS)
-> (OsvRange -> String) -> ([OsvRange] -> ShowS) -> Show OsvRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OsvRange -> ShowS
showsPrec :: Int -> OsvRange -> ShowS
$cshow :: OsvRange -> String
show :: OsvRange -> String
$cshowList :: [OsvRange] -> ShowS
showList :: [OsvRange] -> ShowS
Show, OsvRange -> OsvRange -> Bool
(OsvRange -> OsvRange -> Bool)
-> (OsvRange -> OsvRange -> Bool) -> Eq OsvRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OsvRange -> OsvRange -> Bool
== :: OsvRange -> OsvRange -> Bool
$c/= :: OsvRange -> OsvRange -> Bool
/= :: OsvRange -> OsvRange -> Bool
Eq)

instance FromJSON OsvRange where
    parseJSON :: Value -> Parser OsvRange
parseJSON = String -> (Object -> Parser OsvRange) -> Value -> Parser OsvRange
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OsvRange" ((Object -> Parser OsvRange) -> Value -> Parser OsvRange)
-> (Object -> Parser OsvRange) -> Value -> Parser OsvRange
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Text -> [OsvEvent] -> OsvRange
OsvRange
            (Text -> [OsvEvent] -> OsvRange)
-> Parser Text -> Parser ([OsvEvent] -> OsvRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
            Parser ([OsvEvent] -> OsvRange)
-> Parser [OsvEvent] -> Parser OsvRange
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [OsvEvent]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"events"

{- | One event in a range's ordered event list, carrying exactly one bound. @introduced@ opens
the affected interval inclusively, @fixed@ closes it exclusively, and @last_affected@ inclusively.
-}
data OsvEvent = OsvEvent
    { OsvEvent -> Maybe Text
eventIntroduced :: Maybe Text
    , OsvEvent -> Maybe Text
eventFixed :: Maybe Text
    , OsvEvent -> Maybe Text
eventLastAffected :: Maybe Text
    }
    deriving stock (Int -> OsvEvent -> ShowS
[OsvEvent] -> ShowS
OsvEvent -> String
(Int -> OsvEvent -> ShowS)
-> (OsvEvent -> String) -> ([OsvEvent] -> ShowS) -> Show OsvEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OsvEvent -> ShowS
showsPrec :: Int -> OsvEvent -> ShowS
$cshow :: OsvEvent -> String
show :: OsvEvent -> String
$cshowList :: [OsvEvent] -> ShowS
showList :: [OsvEvent] -> ShowS
Show, OsvEvent -> OsvEvent -> Bool
(OsvEvent -> OsvEvent -> Bool)
-> (OsvEvent -> OsvEvent -> Bool) -> Eq OsvEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OsvEvent -> OsvEvent -> Bool
== :: OsvEvent -> OsvEvent -> Bool
$c/= :: OsvEvent -> OsvEvent -> Bool
/= :: OsvEvent -> OsvEvent -> Bool
Eq)

instance FromJSON OsvEvent where
    parseJSON :: Value -> Parser OsvEvent
parseJSON = String -> (Object -> Parser OsvEvent) -> Value -> Parser OsvEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OsvEvent" ((Object -> Parser OsvEvent) -> Value -> Parser OsvEvent)
-> (Object -> Parser OsvEvent) -> Value -> Parser OsvEvent
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Maybe Text -> Maybe Text -> Maybe Text -> OsvEvent
OsvEvent
            (Maybe Text -> Maybe Text -> Maybe Text -> OsvEvent)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> OsvEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"introduced"
            Parser (Maybe Text -> Maybe Text -> OsvEvent)
-> Parser (Maybe Text) -> Parser (Maybe Text -> OsvEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fixed"
            Parser (Maybe Text -> OsvEvent)
-> Parser (Maybe Text) -> Parser OsvEvent
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_affected"

{- | An artifact segment keyed by the ecosystem's canonical package name.
A missing introduced bound means affected from the beginning.
-}
data ExtractedOsv = ExtractedOsv
    { ExtractedOsv -> Text
extPackage :: Text
    , ExtractedOsv -> Text
extEcosystem :: Text
    , ExtractedOsv -> Text
extCveId :: Text
    , ExtractedOsv -> Maybe Text
extIntroduced :: Maybe Text
    , ExtractedOsv -> UpperBound
extUpperBound :: UpperBound
    , ExtractedOsv -> Maybe Double
extSeverity :: Maybe Double
    {- ^ The advisory's CVSS base score (0 to 10), carried onto each of its segments.
    'Nothing' when the advisory is unscored, as much of the npm malware feed is.
    -}
    , ExtractedOsv -> Maybe Double
extEpss :: Maybe Double
    {- ^ The advisory's EPSS probability (0 to 1), carried onto each of its segments.
    'Nothing' when the feed scores none of its identifiers.
    -}
    }
    deriving stock (Int -> ExtractedOsv -> ShowS
[ExtractedOsv] -> ShowS
ExtractedOsv -> String
(Int -> ExtractedOsv -> ShowS)
-> (ExtractedOsv -> String)
-> ([ExtractedOsv] -> ShowS)
-> Show ExtractedOsv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtractedOsv -> ShowS
showsPrec :: Int -> ExtractedOsv -> ShowS
$cshow :: ExtractedOsv -> String
show :: ExtractedOsv -> String
$cshowList :: [ExtractedOsv] -> ShowS
showList :: [ExtractedOsv] -> ShowS
Show, ExtractedOsv -> ExtractedOsv -> Bool
(ExtractedOsv -> ExtractedOsv -> Bool)
-> (ExtractedOsv -> ExtractedOsv -> Bool) -> Eq ExtractedOsv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtractedOsv -> ExtractedOsv -> Bool
== :: ExtractedOsv -> ExtractedOsv -> Bool
$c/= :: ExtractedOsv -> ExtractedOsv -> Bool
/= :: ExtractedOsv -> ExtractedOsv -> Bool
Eq)

-- | Prefer the highest parsing CVSS vector, then the qualitative label's ceiling, or no score.
advisorySeverity :: OsvAdvisory -> Maybe Double
advisorySeverity :: OsvAdvisory -> Maybe Double
advisorySeverity OsvAdvisory
adv = Maybe Double
vectorScore Maybe Double -> Maybe Double -> Maybe Double
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Double
labelScore
  where
    vectorScore :: Maybe Double
vectorScore = (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 ((OsvSeverityEntry -> Maybe Double)
-> [OsvSeverityEntry] -> [Double]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Double
parseVectorScore (Text -> Maybe Double)
-> (OsvSeverityEntry -> Text) -> OsvSeverityEntry -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsvSeverityEntry -> Text
sevScore) ([OsvSeverityEntry]
-> Maybe [OsvSeverityEntry] -> [OsvSeverityEntry]
forall a. a -> Maybe a -> a
fromMaybe [] (OsvAdvisory -> Maybe [OsvSeverityEntry]
osvSeverity OsvAdvisory
adv)))
    labelScore :: Maybe Double
labelScore = Text -> Maybe Double
ghsaSeverityCeiling (Text -> Maybe Double) -> Maybe Text -> Maybe Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (OsvDatabaseSpecific -> Maybe Text
dbsSeverity (OsvDatabaseSpecific -> Maybe Text)
-> Maybe OsvDatabaseSpecific -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< OsvAdvisory -> Maybe OsvDatabaseSpecific
osvDatabaseSpecific OsvAdvisory
adv)

parseVectorScore :: Text -> Maybe Double
parseVectorScore :: Text -> Maybe Double
parseVectorScore = (CVSSError -> Maybe Double)
-> (CVSS -> Maybe Double) -> Either CVSSError CVSS -> Maybe Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Double -> CVSSError -> Maybe Double
forall a b. a -> b -> a
const Maybe Double
forall a. Maybe a
Nothing) (Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double)
-> (CVSS -> Double) -> CVSS -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
oneDecimal (Float -> Double) -> (CVSS -> Float) -> CVSS -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rating, Float) -> Float
forall a b. (a, b) -> b
snd ((Rating, Float) -> Float)
-> (CVSS -> (Rating, Float)) -> CVSS -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVSS -> (Rating, Float)
cvssScore) (Either CVSSError CVSS -> Maybe Double)
-> (Text -> Either CVSSError CVSS) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CVSSError CVSS
parseCVSS

-- The CVSS specification defines base scores to one decimal place. Rounding in 'Double'
-- space keeps the stored value exact to compare, not a Float-to-Double widening artefact.
oneDecimal :: Float -> Double
oneDecimal :: Float -> Double
oneDecimal Float
f = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
f Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10 :: Double) :: Integer) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10

-- Use the band's ceiling so a qualitative score cannot fall below its possible deny threshold.
ghsaSeverityCeiling :: Text -> Maybe Double
ghsaSeverityCeiling :: Text -> Maybe Double
ghsaSeverityCeiling Text
label = case Text -> Text
T.toUpper (Text -> Text
T.strip Text
label) of
    Text
"NONE" -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
0.0
    Text
"LOW" -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
3.9
    Text
"MODERATE" -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
6.9
    Text
"MEDIUM" -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
6.9
    Text
"HIGH" -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
8.9
    Text
"CRITICAL" -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
10.0
    Text
_ -> Maybe Double
forall a. Maybe a
Nothing

{- | Emit only active advisory segments, with canonical package keys and raw version bounds.
Withdrawn records emit nothing. Unknown ecosystems keep their package spelling.
-}
extractFromAdvisory :: EpssScores -> OsvAdvisory -> [ExtractedOsv]
extractFromAdvisory :: EpssScores -> OsvAdvisory -> [ExtractedOsv]
extractFromAdvisory EpssScores
scores OsvAdvisory
adv = do
    Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isNothing (OsvAdvisory -> Maybe UTCTime
osvWithdrawn OsvAdvisory
adv))
    aff <- [OsvAffected] -> Maybe [OsvAffected] -> [OsvAffected]
forall a. a -> Maybe a -> a
fromMaybe [] (OsvAdvisory -> Maybe [OsvAffected]
osvAffected OsvAdvisory
adv)
    let pkg = OsvAffected -> OsvPackage
affectedPackage OsvAffected
aff
        eco = (Ecosystem -> Bool) -> [Ecosystem] -> Maybe Ecosystem
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== OsvPackage -> Text
packageEcosystem OsvPackage
pkg) (Text -> Bool) -> (Ecosystem -> Text) -> Ecosystem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsvEcosystem -> Text
osvExportDirectory (OsvEcosystem -> Text)
-> (Ecosystem -> OsvEcosystem) -> Ecosystem -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ecosystem -> OsvEcosystem
osvEcosystemFor) [Ecosystem]
forall a. Universe a => [a]
universe
        name = (Text -> Text)
-> (Ecosystem -> Text -> Text) -> Maybe Ecosystem -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id Ecosystem -> Text -> Text
canonicalise Maybe Ecosystem
eco (OsvPackage -> Text
packageName OsvPackage
pkg)
    Segment intro upper <- affectedSegments aff
    pure $
        ExtractedOsv
            { extPackage = name
            , extEcosystem = packageEcosystem pkg
            , extCveId = osvId adv
            , extIntroduced = intro
            , extUpperBound = upper
            , extSeverity = severity
            , extEpss = epss
            }
  where
    -- Shared across every segment the advisory yields: both scores are a property of
    -- the advisory, not of a segment.
    severity :: Maybe Double
severity = OsvAdvisory -> Maybe Double
advisorySeverity OsvAdvisory
adv
    -- The feed keys on CVE ids, and an npm row keys on the GHSA id, so the join runs
    -- over the advisory's own id and its aliases together.
    epss :: Maybe Double
epss = EpssScores -> [Text] -> Maybe Double
epssForIds EpssScores
scores (OsvAdvisory -> Text
osvId OsvAdvisory
adv Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (OsvAdvisory -> Maybe [Text]
osvAliases OsvAdvisory
adv))

{- | Does every bound this segment carries parse under the ecosystem's version grammar? A bound
that does not leaves 'Ecluse.Core.Cve.affecting' matching every version, fail-closed.
-}
orderableBounds :: Ecosystem -> ExtractedOsv -> Bool
orderableBounds :: Ecosystem -> ExtractedOsv -> Bool
orderableBounds Ecosystem
eco = [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool)
-> (ExtractedOsv -> [Text]) -> ExtractedOsv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ecosystem -> ExtractedOsv -> [Text]
unorderableBounds Ecosystem
eco

-- | The bounds this segment carries that the ecosystem's version grammar cannot parse.
unorderableBounds :: Ecosystem -> ExtractedOsv -> [Text]
unorderableBounds :: Ecosystem -> ExtractedOsv -> [Text]
unorderableBounds Ecosystem
eco ExtractedOsv
osv = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
parses) ([Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [ExtractedOsv -> Maybe Text
extIntroduced ExtractedOsv
osv, UpperBound -> Maybe Text
upperBound (ExtractedOsv -> UpperBound
extUpperBound ExtractedOsv
osv)])
  where
    parses :: Text -> Bool
parses = Either VersionError VersionKey -> Bool
forall a b. Either a b -> Bool
isRight (Either VersionError VersionKey -> Bool)
-> (Text -> Either VersionError VersionKey) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ecosystem -> Text -> Either VersionError VersionKey
parseVersionKey Ecosystem
eco

    upperBound :: UpperBound -> Maybe Text
upperBound = \case
        FixedBefore Text
f -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
f
        LastAffected Text
la -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
la
        UpperBound
Unbounded -> Maybe Text
forall a. Maybe a
Nothing

-- One affected interval: an inclusive lower bound and where it closes.
data Segment = Segment (Maybe Text) UpperBound

-- OSV spells "affected from the beginning" as @introduced: "0"@, which semver rejects. Decoded here
-- to no lower bound. An enumerated version of @"0"@ is a version, not a sentinel, and never comes here.
rangeSegment :: Maybe Text -> UpperBound -> Segment
rangeSegment :: Maybe Text -> UpperBound -> Segment
rangeSegment Maybe Text
introduced = Maybe Text -> UpperBound -> Segment
Segment (Maybe Text
introduced Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
forall {a}. (Eq a, IsString a) => a -> Maybe a
beyondTheBeginning)
  where
    beyondTheBeginning :: a -> Maybe a
beyondTheBeginning a
i = if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"0" then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
i

affectedSegments :: OsvAffected -> [Segment]
affectedSegments :: OsvAffected -> [Segment]
affectedSegments OsvAffected
aff =
    [Segment]
-> ([OsvRange] -> [Segment]) -> Maybe [OsvRange] -> [Segment]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((OsvRange -> [Segment]) -> [OsvRange] -> [Segment]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([OsvEvent] -> [Segment]
extractRange ([OsvEvent] -> [Segment])
-> (OsvRange -> [OsvEvent]) -> OsvRange -> [Segment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsvRange -> [OsvEvent]
rangeEvents) ([OsvRange] -> [Segment])
-> ([OsvRange] -> [OsvRange]) -> [OsvRange] -> [Segment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OsvRange -> Bool) -> [OsvRange] -> [OsvRange]
forall a. (a -> Bool) -> [a] -> [a]
filter OsvRange -> Bool
versionTyped) (OsvAffected -> Maybe [OsvRange]
affectedRanges OsvAffected
aff)
        [Segment] -> [Segment] -> [Segment]
forall a. Semigroup a => a -> a -> a
<> [Segment] -> ([Text] -> [Segment]) -> Maybe [Text] -> [Segment]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Text -> Segment) -> [Text] -> [Segment]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Segment
exactVersion) (OsvAffected -> Maybe [Text]
affectedVersions OsvAffected
aff)
  where
    exactVersion :: Text -> Segment
exactVersion Text
v = Maybe Text -> UpperBound -> Segment
Segment (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v) (Text -> UpperBound
LastAffected Text
v)

    -- Git commits are not version bounds. Treating them as unorderable versions would deny every release.
    versionTyped :: OsvRange -> Bool
    versionTyped :: OsvRange -> Bool
versionTyped OsvRange
r = Text -> Text
T.toUpper (Text -> Text
T.strip (OsvRange -> Text
rangeType OsvRange
r)) Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text
"SEMVER", Text
"ECOSYSTEM"]

-- An introduced event closes an already-open interval as unbounded.
extractRange :: [OsvEvent] -> [Segment]
extractRange :: [OsvEvent] -> [Segment]
extractRange = Maybe Text -> [OsvEvent] -> [Segment]
go Maybe Text
forall a. Maybe a
Nothing
  where
    go :: Maybe Text -> [OsvEvent] -> [Segment]
go Maybe Text
Nothing [] = []
    go (Just Text
i) [] = [Maybe Text -> UpperBound -> Segment
rangeSegment (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i) UpperBound
Unbounded]
    go Maybe Text
current (OsvEvent
e : [OsvEvent]
es)
        | Just Text
i <- OsvEvent -> Maybe Text
eventIntroduced OsvEvent
e =
            case Maybe Text
current of
                Just Text
prev -> Maybe Text -> UpperBound -> Segment
rangeSegment (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prev) UpperBound
Unbounded Segment -> [Segment] -> [Segment]
forall a. a -> [a] -> [a]
: Maybe Text -> [OsvEvent] -> [Segment]
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i) [OsvEvent]
es
                Maybe Text
Nothing -> Maybe Text -> [OsvEvent] -> [Segment]
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i) [OsvEvent]
es
        | Just Text
f <- OsvEvent -> Maybe Text
eventFixed OsvEvent
e = Maybe Text -> UpperBound -> Segment
rangeSegment Maybe Text
current (Text -> UpperBound
FixedBefore Text
f) Segment -> [Segment] -> [Segment]
forall a. a -> [a] -> [a]
: Maybe Text -> [OsvEvent] -> [Segment]
go Maybe Text
forall a. Maybe a
Nothing [OsvEvent]
es
        | Just Text
la <- OsvEvent -> Maybe Text
eventLastAffected OsvEvent
e = Maybe Text -> UpperBound -> Segment
rangeSegment Maybe Text
current (Text -> UpperBound
LastAffected Text
la) Segment -> [Segment] -> [Segment]
forall a. a -> [a] -> [a]
: Maybe Text -> [OsvEvent] -> [Segment]
go Maybe Text
forall a. Maybe a
Nothing [OsvEvent]
es
        | Bool
otherwise = Maybe Text -> [OsvEvent] -> [Segment]
go Maybe Text
current [OsvEvent]
es

-- | Build the ecosystem archive URL under a configured OSV export base.
osvExportUrl :: Text -> Text -> String
osvExportUrl :: Text -> Text -> String
osvExportUrl Text
baseUrl Text
ecosystem = Text -> String
forall a. ToString a => a -> String
toString (Text -> Text -> Text
joinUrlPath Text
baseUrl (Text
ecosystem Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/all.zip"))