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

module Ecluse.Core.Osv.Advisory (
    OsvAdvisory (..),
    OsvAffected (..),
    OsvPackage (..),
    OsvRange (..),
    OsvEvent (..),
    OsvDatabaseSpecific (..),
    OsvSeverityEntry (..),
    ExtractedOsv (..),
    advisorySeverity,
    extractFromAdvisory,
    osvExportUrl,
) where

import Data.Aeson (FromJSON (..), withObject, (.:), (.:?))
import Data.Text qualified as T
import Security.CVSS (cvssScore, parseCVSS)

{- | An ecosystem's advisory export under an OSV-layout base URL
(@\<base\>\/\<ecosystem\>\/all.zip@): a zip archive of every advisory currently
published for the ecosystem. The base comes from configuration
(@osvExportBaseUrl@), so a moved or mirrored upstream never needs a new
binary; a trailing slash on the base is tolerated.

>>> osvExportUrl "https://osv-vulnerabilities.storage.googleapis.com/" "npm"
"https://osv-vulnerabilities.storage.googleapis.com/npm/all.zip"
-}
osvExportUrl :: Text -> Text -> String
osvExportUrl :: Text -> Text -> String
osvExportUrl Text
baseUrl Text
ecosystem =
    Text -> String
forall a. ToString a => a -> String
toString ((Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
baseUrl) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
ecosystem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/all.zip"

-- | Exact model of what osv.dev makes available
data OsvAdvisory = OsvAdvisory
    { OsvAdvisory -> Text
osvId :: Text
    , OsvAdvisory -> Maybe [OsvAffected]
osvAffected :: Maybe [OsvAffected]
    , OsvAdvisory -> Maybe [OsvSeverityEntry]
osvSeverity :: Maybe [OsvSeverityEntry]
    , OsvAdvisory -> Maybe OsvDatabaseSpecific
osvDatabaseSpecific :: Maybe OsvDatabaseSpecific
    }
    deriving stock (Int -> OsvAdvisory -> String -> String
[OsvAdvisory] -> String -> String
OsvAdvisory -> String
(Int -> OsvAdvisory -> String -> String)
-> (OsvAdvisory -> String)
-> ([OsvAdvisory] -> String -> String)
-> Show OsvAdvisory
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> OsvAdvisory -> String -> String
showsPrec :: Int -> OsvAdvisory -> String -> String
$cshow :: OsvAdvisory -> String
show :: OsvAdvisory -> String
$cshowList :: [OsvAdvisory] -> String -> String
showList :: [OsvAdvisory] -> String -> String
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 [OsvAffected]
-> Maybe [OsvSeverityEntry]
-> Maybe OsvDatabaseSpecific
-> OsvAdvisory
OsvAdvisory
            (Text
 -> Maybe [OsvAffected]
 -> Maybe [OsvSeverityEntry]
 -> Maybe OsvDatabaseSpecific
 -> OsvAdvisory)
-> Parser Text
-> Parser
     (Maybe [OsvAffected]
      -> Maybe [OsvSeverityEntry]
      -> Maybe OsvDatabaseSpecific
      -> 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 [OsvAffected]
   -> Maybe [OsvSeverityEntry]
   -> Maybe OsvDatabaseSpecific
   -> OsvAdvisory)
-> Parser (Maybe [OsvAffected])
-> Parser
     (Maybe [OsvSeverityEntry]
      -> Maybe OsvDatabaseSpecific -> 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 -> OsvAdvisory)
-> Parser (Maybe [OsvSeverityEntry])
-> Parser (Maybe OsvDatabaseSpecific -> 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 -> OsvAdvisory)
-> Parser (Maybe OsvDatabaseSpecific) -> 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 OsvDatabaseSpecific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"database_specific"

{- | One entry of an advisory's @severity@ array: a scoring-system tag (for
example @CVSS_V3@) and its value. For the CVSS systems the value is the
/vector string/, not a number; the numeric base score is computed from it
('advisorySeverity').
-}
data OsvSeverityEntry = OsvSeverityEntry
    { OsvSeverityEntry -> Text
sevType :: Text
    , OsvSeverityEntry -> Text
sevScore :: Text
    }
    deriving stock (Int -> OsvSeverityEntry -> String -> String
[OsvSeverityEntry] -> String -> String
OsvSeverityEntry -> String
(Int -> OsvSeverityEntry -> String -> String)
-> (OsvSeverityEntry -> String)
-> ([OsvSeverityEntry] -> String -> String)
-> Show OsvSeverityEntry
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> OsvSeverityEntry -> String -> String
showsPrec :: Int -> OsvSeverityEntry -> String -> String
$cshow :: OsvSeverityEntry -> String
show :: OsvSeverityEntry -> String
$cshowList :: [OsvSeverityEntry] -> String -> String
showList :: [OsvSeverityEntry] -> String -> String
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 -> String -> String
[OsvDatabaseSpecific] -> String -> String
OsvDatabaseSpecific -> String
(Int -> OsvDatabaseSpecific -> String -> String)
-> (OsvDatabaseSpecific -> String)
-> ([OsvDatabaseSpecific] -> String -> String)
-> Show OsvDatabaseSpecific
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> OsvDatabaseSpecific -> String -> String
showsPrec :: Int -> OsvDatabaseSpecific -> String -> String
$cshow :: OsvDatabaseSpecific -> String
show :: OsvDatabaseSpecific -> String
$cshowList :: [OsvDatabaseSpecific] -> String -> String
showList :: [OsvDatabaseSpecific] -> String -> String
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. A real and common
    OSV shape (much of the npm malware feed names the single bad version here
    with no @ranges@ at all); each is an affected point in its own right.
    -}
    }
    deriving stock (Int -> OsvAffected -> String -> String
[OsvAffected] -> String -> String
OsvAffected -> String
(Int -> OsvAffected -> String -> String)
-> (OsvAffected -> String)
-> ([OsvAffected] -> String -> String)
-> Show OsvAffected
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> OsvAffected -> String -> String
showsPrec :: Int -> OsvAffected -> String -> String
$cshow :: OsvAffected -> String
show :: OsvAffected -> String
$cshowList :: [OsvAffected] -> String -> String
showList :: [OsvAffected] -> String -> String
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 -> String -> String
[OsvPackage] -> String -> String
OsvPackage -> String
(Int -> OsvPackage -> String -> String)
-> (OsvPackage -> String)
-> ([OsvPackage] -> String -> String)
-> Show OsvPackage
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> OsvPackage -> String -> String
showsPrec :: Int -> OsvPackage -> String -> String
$cshow :: OsvPackage -> String
show :: OsvPackage -> String
$cshowList :: [OsvPackage] -> String -> String
showList :: [OsvPackage] -> String -> String
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 -> String -> String
[OsvRange] -> String -> String
OsvRange -> String
(Int -> OsvRange -> String -> String)
-> (OsvRange -> String)
-> ([OsvRange] -> String -> String)
-> Show OsvRange
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> OsvRange -> String -> String
showsPrec :: Int -> OsvRange -> String -> String
$cshow :: OsvRange -> String
show :: OsvRange -> String
$cshowList :: [OsvRange] -> String -> String
showList :: [OsvRange] -> String -> String
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. An event carries exactly one
bound: @introduced@ opens the affected interval (inclusive), @fixed@ closes it
below the fix (exclusive), and @last_affected@ closes it at an inclusive upper
bound. The two upper bounds are genuinely different -- @fixed 2.0@ excludes
@2.0@, @last_affected 2.0@ includes it -- so they are decoded and carried
separately.
-}
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 -> String -> String
[OsvEvent] -> String -> String
OsvEvent -> String
(Int -> OsvEvent -> String -> String)
-> (OsvEvent -> String)
-> ([OsvEvent] -> String -> String)
-> Show OsvEvent
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> OsvEvent -> String -> String
showsPrec :: Int -> OsvEvent -> String -> String
$cshow :: OsvEvent -> String
show :: OsvEvent -> String
$cshowList :: [OsvEvent] -> String -> String
showList :: [OsvEvent] -> String -> String
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"

{- | One affected segment of one package, flattened for storage: the advisory
identity and severity carried alongside the interval bounds. Each 'ExtractedOsv'
becomes a row of the artifact's ranges table.

The bounds mirror OSV's own model: 'extIntroduced' is the inclusive lower bound
('Nothing' == from the beginning); the upper bound is @'extFixed'@ (exclusive) or
@'extLastAffected'@ (inclusive) or neither (open-ended). An exact enumerated
version becomes a point segment (@introduced == last_affected == v@).
-}
data ExtractedOsv = ExtractedOsv
    { ExtractedOsv -> Text
extPackage :: Text
    , ExtractedOsv -> Text
extEcosystem :: Text
    , ExtractedOsv -> Text
extCveId :: Text
    , ExtractedOsv -> Maybe Text
extIntroduced :: Maybe Text
    , ExtractedOsv -> Maybe Text
extFixed :: Maybe Text
    , ExtractedOsv -> Maybe Text
extLastAffected :: Maybe Text
    , 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 (much of the npm malware
    feed). See 'advisorySeverity'.
    -}
    }
    deriving stock (Int -> ExtractedOsv -> String -> String
[ExtractedOsv] -> String -> String
ExtractedOsv -> String
(Int -> ExtractedOsv -> String -> String)
-> (ExtractedOsv -> String)
-> ([ExtractedOsv] -> String -> String)
-> Show ExtractedOsv
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ExtractedOsv -> String -> String
showsPrec :: Int -> ExtractedOsv -> String -> String
$cshow :: ExtractedOsv -> String
show :: ExtractedOsv -> String
$cshowList :: [ExtractedOsv] -> String -> String
showList :: [ExtractedOsv] -> String -> String
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)

{- | The advisory's CVSS base score, normalised to a number at ingest so the
stored artifact holds a single comparable form and the reader needs no parsing.

OSV carries severity as a CVSS /vector string/, not a number, so the score is
computed from it with the "Security.CVSS" library (the highest, when several
vectors parse). When no vector parses, the source database's qualitative label
('dbsSeverity') is mapped to its band ceiling (@ghsaSeverityCeiling@). 'Nothing'
when the advisory offers neither.
-}
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 = case (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)) of
        [] -> Maybe Double
forall a. Maybe a
Nothing
        (Double
s : [Double]
ss) -> Double -> Maybe Double
forall a. a -> Maybe a
Just ((Double -> Double -> Double) -> Double -> [Double] -> Double
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
s [Double]
ss)
    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)

-- The CVSS base score of a vector string via the library, or 'Nothing' if it does
-- not parse (a CVSS version this build's parser rejects).
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

-- CVSS base scores are defined to one decimal place; round the library's 'Float' to
-- that precision in 'Double' space, so the stored value is the canonical one-decimal
-- 'Double' (exact to compare) rather than 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

-- GitHub's qualitative severity label mapped to the ceiling of its CVSS v3 band --
-- the highest score it could denote, so a coarse label is never under-counted past
-- a downstream deny threshold. GHSA labels are GitHub's own taxonomy (note
-- @MODERATE@, where CVSS says @Medium@), which the CVSS library does not parse, so
-- this small bridge is the irreducible remainder. 'Nothing' for an unknown label.
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

{- | Flatten an advisory into one 'ExtractedOsv' per affected segment: every
range segment of every affected package, plus each exactly-enumerated version as
a point. An advisory with neither ranges nor versions yields nothing.
-}
extractFromAdvisory :: OsvAdvisory -> [ExtractedOsv]
extractFromAdvisory :: OsvAdvisory -> [ExtractedOsv]
extractFromAdvisory OsvAdvisory
adv = do
    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
    Segment intro fixed lastAffected <- affectedSegments aff
    pure $
        ExtractedOsv
            { extPackage = packageName pkg
            , extEcosystem = packageEcosystem pkg
            , extCveId = osvId adv
            , extIntroduced = intro
            , extFixed = fixed
            , extLastAffected = lastAffected
            , extSeverity = severity
            }
  where
    -- Shared across every segment the advisory yields: the score is a property of
    -- the advisory, not of a segment.
    severity :: Maybe Double
severity = OsvAdvisory -> Maybe Double
advisorySeverity OsvAdvisory
adv

-- | One affected interval: an inclusive lower bound and at most one upper bound.
data Segment = Segment (Maybe Text) (Maybe Text) (Maybe Text)

-- The affected segments of one package entry: the segments carved from each
-- __version-typed__ range's event list, plus one point segment per
-- exactly-enumerated version.
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 -> Maybe Text -> Maybe Text -> Segment
Segment (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v) Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v)

    -- OSV defines three range types (@SEMVER@, @ECOSYSTEM@, @GIT@); only the first
    -- two carry version-string bounds this model can order with
    -- 'Ecluse.Core.Version.compareVersions'. A @GIT@ range's events are __commit
    -- identifiers__, not versions, so carving them into segments would store a
    -- commit hash as a version bound; the downstream matcher ('insideAffectedRange')
    -- then fails that unparseable bound __closed to affected__, so a single @GIT@
    -- range (@introduced: "0"@, @fixed: \<sha\>@) would flag /every/ version of a
    -- healthy package as CVE-affected and quarantine it wholesale. Such a range
    -- expresses no npm-version constraint at all, so it must contribute nothing; a
    -- genuinely version-affecting npm advisory always carries an @ECOSYSTEM@ (or
    -- @SEMVER@) range. The type match is case-folded so a mixed-case producer's
    -- version range is still honoured rather than silently dropped.
    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"]

{- | Carve a range's ordered events into affected segments. An @introduced@ opens
a segment; a @fixed@ or @last_affected@ closes it; an @introduced@ that arrives
with one already open closes the open one as unbounded first. A segment still open
at the end is unbounded above.
-}
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 -> Maybe Text -> Maybe Text -> Segment
Segment (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i) Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing]
    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 -> Maybe Text -> Maybe Text -> Segment
Segment (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prev) Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing 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 -> Maybe Text -> Maybe Text -> Segment
Segment Maybe Text
current (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
f) Maybe Text
forall a. Maybe a
Nothing 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 -> Maybe Text -> Maybe Text -> Segment
Segment Maybe Text
current Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just 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