{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}

-- | This module provides a CVSS parser and utility functions
-- adapted from https://www.first.org/cvss/v3.1/specification-document
module Security.CVSS
  ( -- * Type
    CVSS (cvssVersion),
    CVSSVersion (..),
    Rating (..),

    -- * Parser
    parseCVSS,
    CVSSError (..),

    -- * Helpers
    cvssVectorString,
    cvssVectorStringOrdered,
    cvssScore,
    cvssInfo,
  )
where

import Data.Coerce (coerce)
import Data.Foldable (traverse_)
import Data.List (find, group, sort)
import Data.Maybe (mapMaybe)
import Data.String (IsString)
import Data.Text (Text)
import Data.Text qualified as Text
import GHC.Float (powerFloat)

-- | The CVSS version.
data CVSSVersion
  = -- | Version 3.1: https://www.first.org/cvss/v3-1/
    CVSS31
  | -- | Version 3.0: https://www.first.org/cvss/v3.0/
    CVSS30
  | -- | Version 2.0: https://www.first.org/cvss/v2/
    CVSS20
  deriving (CVSSVersion -> CVSSVersion -> Bool
(CVSSVersion -> CVSSVersion -> Bool)
-> (CVSSVersion -> CVSSVersion -> Bool) -> Eq CVSSVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CVSSVersion -> CVSSVersion -> Bool
== :: CVSSVersion -> CVSSVersion -> Bool
$c/= :: CVSSVersion -> CVSSVersion -> Bool
/= :: CVSSVersion -> CVSSVersion -> Bool
Eq)

-- | Parsed CVSS string obtained with 'parseCVSS'.
data CVSS = CVSS
  { -- | The CVSS Version.
    CVSS -> CVSSVersion
cvssVersion :: CVSSVersion,
    -- | The metrics are stored as provided by the user
    CVSS -> [Metric]
cvssMetrics :: [Metric]
  }

instance Show CVSS where
  show :: CVSS -> [Char]
show = Text -> [Char]
Text.unpack (Text -> [Char]) -> (CVSS -> Text) -> CVSS -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVSS -> Text
cvssVectorString

-- | CVSS Rating obtained with 'cvssScore'
data Rating = None | Low | Medium | High | Critical
  deriving (Int -> Rating
Rating -> Int
Rating -> [Rating]
Rating -> Rating
Rating -> Rating -> [Rating]
Rating -> Rating -> Rating -> [Rating]
(Rating -> Rating)
-> (Rating -> Rating)
-> (Int -> Rating)
-> (Rating -> Int)
-> (Rating -> [Rating])
-> (Rating -> Rating -> [Rating])
-> (Rating -> Rating -> [Rating])
-> (Rating -> Rating -> Rating -> [Rating])
-> Enum Rating
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Rating -> Rating
succ :: Rating -> Rating
$cpred :: Rating -> Rating
pred :: Rating -> Rating
$ctoEnum :: Int -> Rating
toEnum :: Int -> Rating
$cfromEnum :: Rating -> Int
fromEnum :: Rating -> Int
$cenumFrom :: Rating -> [Rating]
enumFrom :: Rating -> [Rating]
$cenumFromThen :: Rating -> Rating -> [Rating]
enumFromThen :: Rating -> Rating -> [Rating]
$cenumFromTo :: Rating -> Rating -> [Rating]
enumFromTo :: Rating -> Rating -> [Rating]
$cenumFromThenTo :: Rating -> Rating -> Rating -> [Rating]
enumFromThenTo :: Rating -> Rating -> Rating -> [Rating]
Enum, Rating -> Rating -> Bool
(Rating -> Rating -> Bool)
-> (Rating -> Rating -> Bool) -> Eq Rating
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rating -> Rating -> Bool
== :: Rating -> Rating -> Bool
$c/= :: Rating -> Rating -> Bool
/= :: Rating -> Rating -> Bool
Eq, Eq Rating
Eq Rating =>
(Rating -> Rating -> Ordering)
-> (Rating -> Rating -> Bool)
-> (Rating -> Rating -> Bool)
-> (Rating -> Rating -> Bool)
-> (Rating -> Rating -> Bool)
-> (Rating -> Rating -> Rating)
-> (Rating -> Rating -> Rating)
-> Ord Rating
Rating -> Rating -> Bool
Rating -> Rating -> Ordering
Rating -> Rating -> Rating
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Rating -> Rating -> Ordering
compare :: Rating -> Rating -> Ordering
$c< :: Rating -> Rating -> Bool
< :: Rating -> Rating -> Bool
$c<= :: Rating -> Rating -> Bool
<= :: Rating -> Rating -> Bool
$c> :: Rating -> Rating -> Bool
> :: Rating -> Rating -> Bool
$c>= :: Rating -> Rating -> Bool
>= :: Rating -> Rating -> Bool
$cmax :: Rating -> Rating -> Rating
max :: Rating -> Rating -> Rating
$cmin :: Rating -> Rating -> Rating
min :: Rating -> Rating -> Rating
Ord, Int -> Rating -> ShowS
[Rating] -> ShowS
Rating -> [Char]
(Int -> Rating -> ShowS)
-> (Rating -> [Char]) -> ([Rating] -> ShowS) -> Show Rating
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rating -> ShowS
showsPrec :: Int -> Rating -> ShowS
$cshow :: Rating -> [Char]
show :: Rating -> [Char]
$cshowList :: [Rating] -> ShowS
showList :: [Rating] -> ShowS
Show)

-- | Implementation of Section 5. "Qualitative Severity Rating Scale"
toRating :: Float -> Rating
toRating :: Float -> Rating
toRating Float
score
  | Float
score Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = Rating
None
  | Float
score Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
4 = Rating
Low
  | Float
score Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
7 = Rating
Medium
  | Float
score Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
9 = Rating
High
  | Bool
otherwise = Rating
Critical

data CVSSError
  = UnknownVersion
  | EmptyComponent
  | MissingValue Text
  | DuplicateMetric Text
  | MissingRequiredMetric Text
  | UnknownMetric Text
  | UnknownValue Text Char

instance Show CVSSError where
  show :: CVSSError -> [Char]
show = Text -> [Char]
Text.unpack (Text -> [Char]) -> (CVSSError -> Text) -> CVSSError -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CVSSError -> Text
showCVSSError

showCVSSError :: CVSSError -> Text
showCVSSError :: CVSSError -> Text
showCVSSError CVSSError
e = case CVSSError
e of
  CVSSError
UnknownVersion -> Text
"Unknown CVSS version"
  CVSSError
EmptyComponent -> Text
"Empty component"
  MissingValue Text
name -> Text
"Missing value for \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  DuplicateMetric Text
name -> Text
"Duplicate metric for \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  MissingRequiredMetric Text
name -> Text
"Missing required metric \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  UnknownMetric Text
name -> Text
"Unknown metric \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  UnknownValue Text
name Char
value -> Text
"Unknown value '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (Char -> [Char]
forall a. Show a => a -> [Char]
show Char
value) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' for \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

newtype MetricShortName = MetricShortName Text
  deriving newtype (MetricShortName -> MetricShortName -> Bool
(MetricShortName -> MetricShortName -> Bool)
-> (MetricShortName -> MetricShortName -> Bool)
-> Eq MetricShortName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetricShortName -> MetricShortName -> Bool
== :: MetricShortName -> MetricShortName -> Bool
$c/= :: MetricShortName -> MetricShortName -> Bool
/= :: MetricShortName -> MetricShortName -> Bool
Eq, [Char] -> MetricShortName
([Char] -> MetricShortName) -> IsString MetricShortName
forall a. ([Char] -> a) -> IsString a
$cfromString :: [Char] -> MetricShortName
fromString :: [Char] -> MetricShortName
IsString, Eq MetricShortName
Eq MetricShortName =>
(MetricShortName -> MetricShortName -> Ordering)
-> (MetricShortName -> MetricShortName -> Bool)
-> (MetricShortName -> MetricShortName -> Bool)
-> (MetricShortName -> MetricShortName -> Bool)
-> (MetricShortName -> MetricShortName -> Bool)
-> (MetricShortName -> MetricShortName -> MetricShortName)
-> (MetricShortName -> MetricShortName -> MetricShortName)
-> Ord MetricShortName
MetricShortName -> MetricShortName -> Bool
MetricShortName -> MetricShortName -> Ordering
MetricShortName -> MetricShortName -> MetricShortName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MetricShortName -> MetricShortName -> Ordering
compare :: MetricShortName -> MetricShortName -> Ordering
$c< :: MetricShortName -> MetricShortName -> Bool
< :: MetricShortName -> MetricShortName -> Bool
$c<= :: MetricShortName -> MetricShortName -> Bool
<= :: MetricShortName -> MetricShortName -> Bool
$c> :: MetricShortName -> MetricShortName -> Bool
> :: MetricShortName -> MetricShortName -> Bool
$c>= :: MetricShortName -> MetricShortName -> Bool
>= :: MetricShortName -> MetricShortName -> Bool
$cmax :: MetricShortName -> MetricShortName -> MetricShortName
max :: MetricShortName -> MetricShortName -> MetricShortName
$cmin :: MetricShortName -> MetricShortName -> MetricShortName
min :: MetricShortName -> MetricShortName -> MetricShortName
Ord, Int -> MetricShortName -> ShowS
[MetricShortName] -> ShowS
MetricShortName -> [Char]
(Int -> MetricShortName -> ShowS)
-> (MetricShortName -> [Char])
-> ([MetricShortName] -> ShowS)
-> Show MetricShortName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetricShortName -> ShowS
showsPrec :: Int -> MetricShortName -> ShowS
$cshow :: MetricShortName -> [Char]
show :: MetricShortName -> [Char]
$cshowList :: [MetricShortName] -> ShowS
showList :: [MetricShortName] -> ShowS
Show)

newtype MetricValueChar = MetricValueChar Char
  deriving newtype (MetricValueChar -> MetricValueChar -> Bool
(MetricValueChar -> MetricValueChar -> Bool)
-> (MetricValueChar -> MetricValueChar -> Bool)
-> Eq MetricValueChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetricValueChar -> MetricValueChar -> Bool
== :: MetricValueChar -> MetricValueChar -> Bool
$c/= :: MetricValueChar -> MetricValueChar -> Bool
/= :: MetricValueChar -> MetricValueChar -> Bool
Eq, Eq MetricValueChar
Eq MetricValueChar =>
(MetricValueChar -> MetricValueChar -> Ordering)
-> (MetricValueChar -> MetricValueChar -> Bool)
-> (MetricValueChar -> MetricValueChar -> Bool)
-> (MetricValueChar -> MetricValueChar -> Bool)
-> (MetricValueChar -> MetricValueChar -> Bool)
-> (MetricValueChar -> MetricValueChar -> MetricValueChar)
-> (MetricValueChar -> MetricValueChar -> MetricValueChar)
-> Ord MetricValueChar
MetricValueChar -> MetricValueChar -> Bool
MetricValueChar -> MetricValueChar -> Ordering
MetricValueChar -> MetricValueChar -> MetricValueChar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MetricValueChar -> MetricValueChar -> Ordering
compare :: MetricValueChar -> MetricValueChar -> Ordering
$c< :: MetricValueChar -> MetricValueChar -> Bool
< :: MetricValueChar -> MetricValueChar -> Bool
$c<= :: MetricValueChar -> MetricValueChar -> Bool
<= :: MetricValueChar -> MetricValueChar -> Bool
$c> :: MetricValueChar -> MetricValueChar -> Bool
> :: MetricValueChar -> MetricValueChar -> Bool
$c>= :: MetricValueChar -> MetricValueChar -> Bool
>= :: MetricValueChar -> MetricValueChar -> Bool
$cmax :: MetricValueChar -> MetricValueChar -> MetricValueChar
max :: MetricValueChar -> MetricValueChar -> MetricValueChar
$cmin :: MetricValueChar -> MetricValueChar -> MetricValueChar
min :: MetricValueChar -> MetricValueChar -> MetricValueChar
Ord, Int -> MetricValueChar -> ShowS
[MetricValueChar] -> ShowS
MetricValueChar -> [Char]
(Int -> MetricValueChar -> ShowS)
-> (MetricValueChar -> [Char])
-> ([MetricValueChar] -> ShowS)
-> Show MetricValueChar
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetricValueChar -> ShowS
showsPrec :: Int -> MetricValueChar -> ShowS
$cshow :: MetricValueChar -> [Char]
show :: MetricValueChar -> [Char]
$cshowList :: [MetricValueChar] -> ShowS
showList :: [MetricValueChar] -> ShowS
Show)

data Metric = Metric
  { Metric -> MetricShortName
mName :: MetricShortName,
    Metric -> MetricValueChar
mChar :: MetricValueChar
  }
  deriving (Int -> Metric -> ShowS
[Metric] -> ShowS
Metric -> [Char]
(Int -> Metric -> ShowS)
-> (Metric -> [Char]) -> ([Metric] -> ShowS) -> Show Metric
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metric -> ShowS
showsPrec :: Int -> Metric -> ShowS
$cshow :: Metric -> [Char]
show :: Metric -> [Char]
$cshowList :: [Metric] -> ShowS
showList :: [Metric] -> ShowS
Show)

-- example CVSS string: CVSS:3.1/AV:N/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:N

-- | Parse a CVSS string.
parseCVSS :: Text -> Either CVSSError CVSS
parseCVSS :: Text -> Either CVSSError CVSS
parseCVSS Text
txt
  | Text
"CVSS:3.1/" Text -> Text -> Bool
`Text.isPrefixOf` Text
txt = CVSSVersion -> [Metric] -> CVSS
CVSS CVSSVersion
CVSS31 ([Metric] -> CVSS)
-> Either CVSSError [Metric] -> Either CVSSError CVSS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Metric] -> Either CVSSError [Metric])
-> Either CVSSError [Metric]
forall {b}. ([Metric] -> Either CVSSError b) -> Either CVSSError b
validateComponents [Metric] -> Either CVSSError [Metric]
validateCvss31
  | Text
"CVSS:3.0/" Text -> Text -> Bool
`Text.isPrefixOf` Text
txt = CVSSVersion -> [Metric] -> CVSS
CVSS CVSSVersion
CVSS30 ([Metric] -> CVSS)
-> Either CVSSError [Metric] -> Either CVSSError CVSS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Metric] -> Either CVSSError [Metric])
-> Either CVSSError [Metric]
forall {b}. ([Metric] -> Either CVSSError b) -> Either CVSSError b
validateComponents [Metric] -> Either CVSSError [Metric]
validateCvss30
  | Text
"CVSS:2.0/" Text -> Text -> Bool
`Text.isPrefixOf` Text
txt = CVSSVersion -> [Metric] -> CVSS
CVSS CVSSVersion
CVSS20 ([Metric] -> CVSS)
-> Either CVSSError [Metric] -> Either CVSSError CVSS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Metric] -> Either CVSSError [Metric])
-> Either CVSSError [Metric]
forall {b}. ([Metric] -> Either CVSSError b) -> Either CVSSError b
validateComponents [Metric] -> Either CVSSError [Metric]
validateCvss20
  | Bool
otherwise = CVSSError -> Either CVSSError CVSS
forall a b. a -> Either a b
Left CVSSError
UnknownVersion
  where
    validateComponents :: ([Metric] -> Either CVSSError b) -> Either CVSSError b
validateComponents [Metric] -> Either CVSSError b
validator = do
      [Metric]
metrics <- (Text -> Either CVSSError Metric)
-> [Text] -> Either CVSSError [Metric]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Text -> Either CVSSError Metric
splitComponent [Text]
components
      [Metric] -> Either CVSSError b
validator [Metric]
metrics

    components :: [Text]
components = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
txt
    splitComponent :: Text -> Either CVSSError Metric
    splitComponent :: Text -> Either CVSSError Metric
splitComponent Text
componentTxt = case Text -> Maybe (Text, Char)
Text.unsnoc Text
componentTxt of
      Maybe (Text, Char)
Nothing -> CVSSError -> Either CVSSError Metric
forall a b. a -> Either a b
Left CVSSError
EmptyComponent
      Just (Text
rest, Char
c) -> case Text -> Maybe (Text, Char)
Text.unsnoc Text
rest of
        Just (Text
name, Char
':') -> Metric -> Either CVSSError Metric
forall a b. b -> Either a b
Right (MetricShortName -> MetricValueChar -> Metric
Metric (Text -> MetricShortName
MetricShortName Text
name) (Char -> MetricValueChar
MetricValueChar Char
c))
        Maybe (Text, Char)
_ -> CVSSError -> Either CVSSError Metric
forall a b. a -> Either a b
Left (Text -> CVSSError
MissingValue Text
componentTxt)

-- | Compute the base score.
cvssScore :: CVSS -> (Rating, Float)
cvssScore :: CVSS -> (Rating, Float)
cvssScore CVSS
cvss = case CVSS -> CVSSVersion
cvssVersion CVSS
cvss of
  CVSSVersion
CVSS31 -> [Metric] -> (Rating, Float)
cvss31score (CVSS -> [Metric]
cvssMetrics CVSS
cvss)
  CVSSVersion
CVSS30 -> [Metric] -> (Rating, Float)
cvss30score (CVSS -> [Metric]
cvssMetrics CVSS
cvss)
  CVSSVersion
CVSS20 -> [Metric] -> (Rating, Float)
cvss20score (CVSS -> [Metric]
cvssMetrics CVSS
cvss)

-- | Explain the CVSS metrics.
cvssInfo :: CVSS -> [Text]
cvssInfo :: CVSS -> [Text]
cvssInfo CVSS
cvss = CVSSDB -> [Metric] -> [Text]
doCVSSInfo (CVSSVersion -> CVSSDB
cvssDB (CVSS -> CVSSVersion
cvssVersion CVSS
cvss)) (CVSS -> [Metric]
cvssMetrics CVSS
cvss)

-- | Format the CVSS back to its original string.
cvssVectorString :: CVSS -> Text
cvssVectorString :: CVSS -> Text
cvssVectorString = Bool -> CVSS -> Text
cvssShow Bool
False

-- | Format the CVSS to the prefered ordered vector string.
cvssVectorStringOrdered :: CVSS -> Text
cvssVectorStringOrdered :: CVSS -> Text
cvssVectorStringOrdered = Bool -> CVSS -> Text
cvssShow Bool
True

cvssShow :: Bool -> CVSS -> Text
cvssShow :: Bool -> CVSS -> Text
cvssShow Bool
ordered CVSS
cvss = case CVSS -> CVSSVersion
cvssVersion CVSS
cvss of
  CVSSVersion
CVSS31 -> Text -> [Text] -> Text
Text.intercalate Text
"/" (Text
"CVSS:3.1" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
components)
  CVSSVersion
CVSS30 -> Text -> [Text] -> Text
Text.intercalate Text
"/" (Text
"CVSS:3.0" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
components)
  CVSSVersion
CVSS20 -> Text -> [Text] -> Text
Text.intercalate Text
"/" (Text
"CVSS:2.0" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
components)
  where
    components :: [Text]
components = (Metric -> Text) -> [Metric] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Metric -> Text
toComponent ([Metric] -> [Metric]
cvssOrder (CVSS -> [Metric]
cvssMetrics CVSS
cvss))
    toComponent :: Metric -> Text
    toComponent :: Metric -> Text
toComponent (Metric (MetricShortName Text
name) (MetricValueChar Char
value)) = Text -> Char -> Text
Text.snoc (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":") Char
value
    cvssOrder :: [Metric] -> [Metric]
cvssOrder [Metric]
metrics
      | Bool
ordered = (MetricInfo -> Maybe Metric) -> [MetricInfo] -> [Metric]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MetricInfo -> Maybe Metric
getMetric (CVSSDB -> [MetricInfo]
allMetrics (CVSSVersion -> CVSSDB
cvssDB (CVSS -> CVSSVersion
cvssVersion CVSS
cvss)))
      | Bool
otherwise = [Metric]
metrics
      where
        getMetric :: MetricInfo -> Maybe Metric
getMetric MetricInfo
mi = (Metric -> Bool) -> [Metric] -> Maybe Metric
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Metric
metric -> MetricInfo -> MetricShortName
miShortName MetricInfo
mi MetricShortName -> MetricShortName -> Bool
forall a. Eq a => a -> a -> Bool
== Metric -> MetricShortName
mName Metric
metric) [Metric]
metrics

newtype CVSSDB = CVSSDB [MetricGroup]

cvssDB :: CVSSVersion -> CVSSDB
cvssDB :: CVSSVersion -> CVSSDB
cvssDB CVSSVersion
v = case CVSSVersion
v of
  CVSSVersion
CVSS31 -> CVSSDB
cvss31
  CVSSVersion
CVSS30 -> CVSSDB
cvss30
  CVSSVersion
CVSS20 -> CVSSDB
cvss20

-- | Description of a metric group.
data MetricGroup = MetricGroup
  { MetricGroup -> Text
mgName :: Text,
    MetricGroup -> [MetricInfo]
mgMetrics :: [MetricInfo]
  }

-- | Description of a single metric.
data MetricInfo = MetricInfo
  { MetricInfo -> Text
miName :: Text,
    MetricInfo -> MetricShortName
miShortName :: MetricShortName,
    MetricInfo -> Bool
miRequired :: Bool,
    MetricInfo -> [MetricValue]
miValues :: [MetricValue]
  }

-- | Description of a single metric value
data MetricValue = MetricValue
  { MetricValue -> Text
mvName :: Text,
    MetricValue -> MetricValueChar
mvChar :: MetricValueChar,
    MetricValue -> Float
mvNum :: Float,
    MetricValue -> Maybe Float
mvNumChangedScope :: Maybe Float,
    MetricValue -> Text
mvDesc :: Text
  }

-- | CVSS3.1 metrics pulled from section 2. "Base Metrics" and section section 7.4. "Metric Values"
cvss31 :: CVSSDB
cvss31 :: CVSSDB
cvss31 =
  [MetricGroup] -> CVSSDB
CVSSDB
    [ Text -> [MetricInfo] -> MetricGroup
MetricGroup Text
"Base" [MetricInfo]
baseMetrics,
      Text -> [MetricInfo] -> MetricGroup
MetricGroup Text
"Temporal" [MetricInfo]
forall {a}. [a]
temporalMetrics,
      Text -> [MetricInfo] -> MetricGroup
MetricGroup Text
"Environmental" [MetricInfo]
forall {a}. [a]
environmentalMetrics
    ]
  where
    baseMetrics :: [MetricInfo]
baseMetrics =
      [ Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Attack Vector"
          MetricShortName
"AV"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Network" (Char -> MetricValueChar
C Char
'N') Float
0.85 Maybe Float
forall a. Maybe a
Nothing Text
"The vulnerable component is bound to the network stack and the set of possible attackers extends beyond the other options listed below, up to and including the entire Internet.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Adjacent" (Char -> MetricValueChar
C Char
'A') Float
0.62 Maybe Float
forall a. Maybe a
Nothing Text
"The vulnerable component is bound to the network stack, but the attack is limited at the protocol level to a logically adjacent topology.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Local" (Char -> MetricValueChar
C Char
'L') Float
0.55 Maybe Float
forall a. Maybe a
Nothing Text
"The vulnerable component is not bound to the network stack and the attacker’s path is via read/write/execute capabilities.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Physical" (Char -> MetricValueChar
C Char
'P') Float
0.2 Maybe Float
forall a. Maybe a
Nothing Text
"The attack requires the attacker to physically touch or manipulate the vulnerable component."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Attack Complexity"
          MetricShortName
"AC"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Low" (Char -> MetricValueChar
C Char
'L') Float
0.77 Maybe Float
forall a. Maybe a
Nothing Text
"Specialized access conditions or extenuating circumstances do not exist.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"High" (Char -> MetricValueChar
C Char
'H') Float
0.44 Maybe Float
forall a. Maybe a
Nothing Text
"A successful attack depends on conditions beyond the attacker's control."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Privileges Required"
          MetricShortName
"PR"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"None" (Char -> MetricValueChar
C Char
'N') Float
0.85 Maybe Float
forall a. Maybe a
Nothing Text
"The attacker is unauthorized prior to attack, and therefore does not require any access to settings or files of the vulnerable system to carry out an attack.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Low" (Char -> MetricValueChar
C Char
'L') Float
0.62 (Float -> Maybe Float
forall a. a -> Maybe a
Just Float
0.68) Text
"The attacker requires privileges that provide basic user capabilities that could normally affect only settings and files owned by a user.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"High" (Char -> MetricValueChar
C Char
'H') Float
0.27 (Float -> Maybe Float
forall a. a -> Maybe a
Just Float
0.5) Text
"The attacker requires privileges that provide significant (e.g., administrative) control over the vulnerable component allowing access to component-wide settings and files."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"User Interaction"
          MetricShortName
"UI"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"None" (Char -> MetricValueChar
C Char
'N') Float
0.85 Maybe Float
forall a. Maybe a
Nothing Text
"The vulnerable system can be exploited without interaction from any user.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Required" (Char -> MetricValueChar
C Char
'R') Float
0.62 Maybe Float
forall a. Maybe a
Nothing Text
"Successful exploitation of this vulnerability requires a user to take some action before the vulnerability can be exploited."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Scope"
          MetricShortName
"S"
          Bool
True
          [ -- Note: not defined as contants in specification
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Unchanged" (Char -> MetricValueChar
C Char
'U') Float
Unchanged Maybe Float
forall a. Maybe a
Nothing Text
"An exploited vulnerability can only affect resources managed by the same security authority.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Changed" (Char -> MetricValueChar
C Char
'C') Float
Changed Maybe Float
forall a. Maybe a
Nothing Text
"An exploited vulnerability can affect resources beyond the security scope managed by the security authority of the vulnerable component."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Confidentiality Impact"
          MetricShortName
"C"
          Bool
True
          [ Text -> MetricValue
mkHigh Text
"There is a total loss of confidentiality, resulting in all resources within the impacted component being divulged to the attacker.",
            Text -> MetricValue
mkLow Text
"There is some loss of confidentiality.",
            Text -> MetricValue
mkNone Text
"There is no loss of confidentiality within the impacted component."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Integrity Impact"
          MetricShortName
"I"
          Bool
True
          [ Text -> MetricValue
mkHigh Text
"There is a total loss of integrity, or a complete loss of protection.",
            Text -> MetricValue
mkLow Text
"Modification of data is possible, but the attacker does not have control over the consequence of a modification, or the amount of modification is limited.",
            Text -> MetricValue
mkNone Text
"There is no loss of integrity within the impacted component."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Availability Impact"
          MetricShortName
"A"
          Bool
True
          [ Text -> MetricValue
mkHigh Text
"There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the impacted component",
            Text -> MetricValue
mkLow Text
"Performance is reduced or there are interruptions in resource availability.",
            Text -> MetricValue
mkNone Text
"There is no impact to availability within the impacted component."
          ]
      ]
    mkHigh :: Text -> MetricValue
mkHigh = Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"High" (Char -> MetricValueChar
C Char
'H') Float
0.56 Maybe Float
forall a. Maybe a
Nothing
    mkLow :: Text -> MetricValue
mkLow = Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Low" (Char -> MetricValueChar
C Char
'L') Float
0.22 Maybe Float
forall a. Maybe a
Nothing
    mkNone :: Text -> MetricValue
mkNone = Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"None" (Char -> MetricValueChar
C Char
'N') Float
0 Maybe Float
forall a. Maybe a
Nothing
    -- TODOs
    temporalMetrics :: [a]
temporalMetrics = []
    environmentalMetrics :: [a]
environmentalMetrics = []

pattern C :: Char -> MetricValueChar
pattern $mC :: forall {r}. MetricValueChar -> (Char -> r) -> ((# #) -> r) -> r
$bC :: Char -> MetricValueChar
C c = MetricValueChar c

pattern Unchanged :: Float
pattern $mUnchanged :: forall {r}. Float -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnchanged :: Float
Unchanged = 6.42

pattern Changed :: Float
pattern $mChanged :: forall {r}. Float -> ((# #) -> r) -> ((# #) -> r) -> r
$bChanged :: Float
Changed = 7.52

doCVSSInfo :: CVSSDB -> [Metric] -> [Text]
doCVSSInfo :: CVSSDB -> [Metric] -> [Text]
doCVSSInfo (CVSSDB [MetricGroup]
db) = (Metric -> Text) -> [Metric] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Metric -> Text
showMetricInfo
  where
    showMetricInfo :: Metric -> Text
showMetricInfo Metric
metric = case (MetricGroup -> Maybe (MetricGroup, MetricInfo, MetricValue))
-> [MetricGroup] -> [(MetricGroup, MetricInfo, MetricValue)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Metric
-> MetricGroup -> Maybe (MetricGroup, MetricInfo, MetricValue)
getInfo Metric
metric) [MetricGroup]
db of
      [(MetricGroup
mg, MetricInfo
mi, MetricValue
mv)] ->
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [MetricGroup -> Text
mgName MetricGroup
mg, Text
" ", MetricInfo -> Text
miName MetricInfo
mi, Text
": ", MetricValue -> Text
mvName MetricValue
mv, Text
" (", MetricValue -> Text
mvDesc MetricValue
mv, Text
")"]
      [(MetricGroup, MetricInfo, MetricValue)]
_ -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"The impossible have happened for " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Metric -> [Char]
forall a. Show a => a -> [Char]
show Metric
metric
    getInfo :: Metric
-> MetricGroup -> Maybe (MetricGroup, MetricInfo, MetricValue)
getInfo Metric
metric MetricGroup
mg = do
      MetricInfo
mi <- (MetricInfo -> Bool) -> [MetricInfo] -> Maybe MetricInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\MetricInfo
mi -> MetricInfo -> MetricShortName
miShortName MetricInfo
mi MetricShortName -> MetricShortName -> Bool
forall a. Eq a => a -> a -> Bool
== Metric -> MetricShortName
mName Metric
metric) (MetricGroup -> [MetricInfo]
mgMetrics MetricGroup
mg)
      MetricValue
mv <- (MetricValue -> Bool) -> [MetricValue] -> Maybe MetricValue
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\MetricValue
mv -> MetricValue -> MetricValueChar
mvChar MetricValue
mv MetricValueChar -> MetricValueChar -> Bool
forall a. Eq a => a -> a -> Bool
== Metric -> MetricValueChar
mChar Metric
metric) (MetricInfo -> [MetricValue]
miValues MetricInfo
mi)
      (MetricGroup, MetricInfo, MetricValue)
-> Maybe (MetricGroup, MetricInfo, MetricValue)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetricGroup
mg, MetricInfo
mi, MetricValue
mv)

allMetrics :: CVSSDB -> [MetricInfo]
allMetrics :: CVSSDB -> [MetricInfo]
allMetrics (CVSSDB [MetricGroup]
db) = (MetricGroup -> [MetricInfo]) -> [MetricGroup] -> [MetricInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap MetricGroup -> [MetricInfo]
mgMetrics [MetricGroup]
db

-- | Implementation of the Appendix A - "Floating Point Rounding"
roundup :: Float -> Float
roundup :: Float -> Float
roundup Float
input
  | Int
int_input Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10000 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int_input Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100000
  | Bool
otherwise = (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int
floor_int (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int_input Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
10000)) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
10
  where
    floor_int :: Float -> Int
    floor_int :: Float -> Int
floor_int = Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor
    int_input :: Int
    int_input :: Int
int_input = Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Float
input Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
100000)

-- | Implementation of section 7.1. Base Metrics Equations
cvss31score :: [Metric] -> (Rating, Float)
cvss31score :: [Metric] -> (Rating, Float)
cvss31score [Metric]
metrics = (Float -> Rating
toRating Float
score, Float
score)
  where
    iss :: Float
iss = Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Text -> Float
gm Text
"Confidentiality Impact") Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Text -> Float
gm Text
"Integrity Impact") Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Text -> Float
gm Text
"Availability Impact")
    impact :: Float
impact
      | Float
scope Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
Unchanged = Float
scope Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
iss
      | Bool
otherwise = Float
scope Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
iss Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.029) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
3.25 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float -> Float
powerFloat (Float
iss Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.02) Float
15
    exploitability :: Float
exploitability = Float
8.22 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"Attack Vector" Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"Attack Complexity" Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"Privileges Required" Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"User Interaction"
    score :: Float
score
      | Float
impact Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = Float
0
      | Float
scope Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
Unchanged = Float -> Float
roundup (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float
impact Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
exploitability) Float
10)
      | Bool
otherwise = Float -> Float
roundup (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float
1.08 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
impact Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
exploitability)) Float
10)
    scope :: Float
scope = Text -> Float
gm Text
"Scope"

    gm :: Text -> Float
    gm :: Text -> Float
gm = CVSSDB -> [Metric] -> Float -> Text -> Float
getMetricValue CVSSDB
cvss31 [Metric]
metrics Float
scope

getMetricValue :: CVSSDB -> [Metric] -> Float -> Text -> Float
getMetricValue :: CVSSDB -> [Metric] -> Float -> Text -> Float
getMetricValue CVSSDB
db [Metric]
metrics Float
scope Text
name = case Maybe Float
mValue of
  Maybe Float
Nothing -> [Char] -> Float
forall a. HasCallStack => [Char] -> a
error ([Char] -> Float) -> [Char] -> Float
forall a b. (a -> b) -> a -> b
$ [Char]
"The impossible have happened, unknown metric: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack Text
name
  Just Float
v -> Float
v
  where
    mValue :: Maybe Float
mValue = do
      MetricInfo
mi <- (MetricInfo -> Bool) -> [MetricInfo] -> Maybe MetricInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\MetricInfo
mi -> MetricInfo -> Text
miName MetricInfo
mi Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) (CVSSDB -> [MetricInfo]
allMetrics CVSSDB
db)
      Metric MetricShortName
_ MetricValueChar
valueChar <- (Metric -> Bool) -> [Metric] -> Maybe Metric
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Metric
metric -> MetricInfo -> MetricShortName
miShortName MetricInfo
mi MetricShortName -> MetricShortName -> Bool
forall a. Eq a => a -> a -> Bool
== Metric -> MetricShortName
mName Metric
metric) [Metric]
metrics
      MetricValue
mv <- (MetricValue -> Bool) -> [MetricValue] -> Maybe MetricValue
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\MetricValue
mv -> MetricValue -> MetricValueChar
mvChar MetricValue
mv MetricValueChar -> MetricValueChar -> Bool
forall a. Eq a => a -> a -> Bool
== MetricValueChar
valueChar) (MetricInfo -> [MetricValue]
miValues MetricInfo
mi)
      Float -> Maybe Float
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ case MetricValue -> Maybe Float
mvNumChangedScope MetricValue
mv of
        Just Float
value | Float
scope Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
Unchanged -> Float
value
        Maybe Float
_ -> MetricValue -> Float
mvNum MetricValue
mv

validateCvss31 :: [Metric] -> Either CVSSError [Metric]
validateCvss31 :: [Metric] -> Either CVSSError [Metric]
validateCvss31 [Metric]
metrics = do
  (([Metric] -> Either CVSSError ()) -> Either CVSSError ())
-> [[Metric] -> Either CVSSError ()] -> Either CVSSError ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\[Metric] -> Either CVSSError ()
t -> [Metric] -> Either CVSSError ()
t [Metric]
metrics) [[Metric] -> Either CVSSError ()
validateUnique, CVSSDB -> [Metric] -> Either CVSSError ()
validateKnown CVSSDB
cvss31, CVSSDB -> [Metric] -> Either CVSSError ()
validateRequired CVSSDB
cvss31]
  [Metric] -> Either CVSSError [Metric]
forall a. a -> Either CVSSError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Metric]
metrics

cvss30 :: CVSSDB
cvss30 :: CVSSDB
cvss30 =
  [MetricGroup] -> CVSSDB
CVSSDB
    [ Text -> [MetricInfo] -> MetricGroup
MetricGroup Text
"Base" [MetricInfo]
baseMetrics
    ]
  where
    baseMetrics :: [MetricInfo]
baseMetrics =
      [ Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Attack Vector"
          MetricShortName
"AV"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Network" (Char -> MetricValueChar
C Char
'N') Float
0.85 Maybe Float
forall a. Maybe a
Nothing Text
"A vulnerability exploitable with network access means the vulnerable component is bound to the network stack and the attacker's path is through OSI layer 3 (the network layer).",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Adjacent" (Char -> MetricValueChar
C Char
'A') Float
0.62 Maybe Float
forall a. Maybe a
Nothing Text
"A vulnerability exploitable with adjacent network access means the vulnerable component is bound to the network stack",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Local" (Char -> MetricValueChar
C Char
'L') Float
0.55 Maybe Float
forall a. Maybe a
Nothing Text
"A vulnerability exploitable with Local access means that the vulnerable component is not bound to the network stack, and the attacker's path is via read/write/execute capabilities.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Physical" (Char -> MetricValueChar
C Char
'P') Float
0.2 Maybe Float
forall a. Maybe a
Nothing Text
"A vulnerability exploitable with Physical access requires the attacker to physically touch or manipulate the vulnerable component."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Attack Complexity"
          MetricShortName
"AC"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Low" (Char -> MetricValueChar
C Char
'L') Float
0.77 Maybe Float
forall a. Maybe a
Nothing Text
"Specialized access conditions or extenuating circumstances do not exist.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"High" (Char -> MetricValueChar
C Char
'H') Float
0.44 Maybe Float
forall a. Maybe a
Nothing Text
"A successful attack depends on conditions beyond the attacker's control."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Privileges Required"
          MetricShortName
"PR"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"None" (Char -> MetricValueChar
C Char
'N') Float
0.85 Maybe Float
forall a. Maybe a
Nothing Text
"The attacker is unauthorized prior to attack, and therefore does not require any access to settings or files to carry out an attack.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Low" (Char -> MetricValueChar
C Char
'L') Float
0.62 (Float -> Maybe Float
forall a. a -> Maybe a
Just Float
0.68) Text
"The attacker is authorized with (i.e. requires) privileges that provide basic user capabilities that could normally affect only settings and files owned by a user.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"High" (Char -> MetricValueChar
C Char
'H') Float
0.27 (Float -> Maybe Float
forall a. a -> Maybe a
Just Float
0.5) Text
"The attacker is authorized with (i.e. requires) privileges that provide significant (e.g. administrative) control over the vulnerable component that could affect component-wide settings and files."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"User Interaction"
          MetricShortName
"UI"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"None" (Char -> MetricValueChar
C Char
'N') Float
0.85 Maybe Float
forall a. Maybe a
Nothing Text
"The vulnerable system can be exploited without interaction from any user.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Required" (Char -> MetricValueChar
C Char
'R') Float
0.62 Maybe Float
forall a. Maybe a
Nothing Text
"Successful exploitation of this vulnerability requires a user to take some action before the vulnerability can be exploited."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Scope"
          MetricShortName
"S"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Unchanged" (Char -> MetricValueChar
C Char
'U') Float
Unchanged Maybe Float
forall a. Maybe a
Nothing Text
"An exploited vulnerability can only affect resources managed by the same authority.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Changed" (Char -> MetricValueChar
C Char
'C') Float
Changed Maybe Float
forall a. Maybe a
Nothing Text
"An exploited vulnerability can affect resources beyond the authorization privileges intended by the vulnerable component."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Confidentiality Impact"
          MetricShortName
"C"
          Bool
True
          [ Text -> MetricValue
mkHigh Text
"There is a total loss of confidentiality, resulting in all resources within the impacted component being divulged to the attacker.",
            Text -> MetricValue
mkLow Text
"There is some loss of confidentiality.",
            Text -> MetricValue
mkNone Text
"There is no loss of confidentiality within the impacted component."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Integrity Impact"
          MetricShortName
"I"
          Bool
True
          [ Text -> MetricValue
mkHigh Text
"There is a total loss of integrity, or a complete loss of protection.",
            Text -> MetricValue
mkLow Text
"Modification of data is possible, but the attacker does not have control over the consequence of a modification, or the amount of modification is limited.",
            Text -> MetricValue
mkNone Text
"There is no loss of integrity within the impacted component."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Availability Impact"
          MetricShortName
"A"
          Bool
True
          [ Text -> MetricValue
mkHigh Text
"There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the impacted component",
            Text -> MetricValue
mkLow Text
"Performance is reduced or there are interruptions in resource availability.",
            Text -> MetricValue
mkNone Text
"There is no impact to availability within the impacted component."
          ]
      ]
    mkHigh :: Text -> MetricValue
mkHigh = Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"High" (Char -> MetricValueChar
C Char
'H') Float
0.56 Maybe Float
forall a. Maybe a
Nothing
    mkLow :: Text -> MetricValue
mkLow = Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Low" (Char -> MetricValueChar
C Char
'L') Float
0.22 Maybe Float
forall a. Maybe a
Nothing
    mkNone :: Text -> MetricValue
mkNone = Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"None" (Char -> MetricValueChar
C Char
'N') Float
0 Maybe Float
forall a. Maybe a
Nothing

-- | Implementation of Section 8.1 "Base"
cvss30score :: [Metric] -> (Rating, Float)
cvss30score :: [Metric] -> (Rating, Float)
cvss30score [Metric]
metrics = (Float -> Rating
toRating Float
score, Float
score)
  where
    score :: Float
score
      | Float
impact Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = Float
0
      | Float
scope Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
Unchanged = Float -> Float
roundup (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float
impact Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
exploitability) Float
10)
      | Bool
otherwise = Float -> Float
roundup (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float
1.08 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
impact Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
exploitability)) Float
10)
    impact :: Float
impact
      | Float
scope Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
Unchanged = Float
scope Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
iscBase
      | Bool
otherwise = Float
scope Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
iscBase Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.029) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
3.25 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float -> Float
powerFloat (Float
iscBase Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.02) Float
15
    iscBase :: Float
iscBase = Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Text -> Float
gm Text
"Confidentiality Impact") Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Text -> Float
gm Text
"Integrity Impact") Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Text -> Float
gm Text
"Availability Impact")
    scope :: Float
scope = Text -> Float
gm Text
"Scope"

    exploitability :: Float
exploitability = Float
8.22 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"Attack Vector" Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"Attack Complexity" Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"Privileges Required" Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"User Interaction"
    gm :: Text -> Float
gm = CVSSDB -> [Metric] -> Float -> Text -> Float
getMetricValue CVSSDB
cvss30 [Metric]
metrics Float
scope

validateCvss30 :: [Metric] -> Either CVSSError [Metric]
validateCvss30 :: [Metric] -> Either CVSSError [Metric]
validateCvss30 [Metric]
metrics = do
  (([Metric] -> Either CVSSError ()) -> Either CVSSError ())
-> [[Metric] -> Either CVSSError ()] -> Either CVSSError ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\[Metric] -> Either CVSSError ()
t -> [Metric] -> Either CVSSError ()
t [Metric]
metrics) [[Metric] -> Either CVSSError ()
validateUnique, CVSSDB -> [Metric] -> Either CVSSError ()
validateKnown CVSSDB
cvss30, CVSSDB -> [Metric] -> Either CVSSError ()
validateRequired CVSSDB
cvss30]
  [Metric] -> Either CVSSError [Metric]
forall a. a -> Either CVSSError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Metric]
metrics

cvss20 :: CVSSDB
cvss20 :: CVSSDB
cvss20 =
  [MetricGroup] -> CVSSDB
CVSSDB
    [ Text -> [MetricInfo] -> MetricGroup
MetricGroup Text
"Base" [MetricInfo]
baseMetrics
    ]
  where
    baseMetrics :: [MetricInfo]
baseMetrics =
      [ Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Access Vector"
          MetricShortName
"AV"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Local" (Char -> MetricValueChar
C Char
'L') Float
0.395 Maybe Float
forall a. Maybe a
Nothing Text
"A vulnerability exploitable with only local access requires the attacker to have either physical access to the vulnerable system or a local (shell) account.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Adjacent Network" (Char -> MetricValueChar
C Char
'A') Float
0.646 Maybe Float
forall a. Maybe a
Nothing Text
"A vulnerability exploitable with adjacent network access requires the attacker to have access to either the broadcast or collision domain of the vulnerable software.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Network" (Char -> MetricValueChar
C Char
'N') Float
1.0 Maybe Float
forall a. Maybe a
Nothing Text
"A vulnerability exploitable with network access means the vulnerable software is bound to the network stack and the attacker does not require local network access or local access."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Access Complexity"
          MetricShortName
"AC"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"High" (Char -> MetricValueChar
C Char
'H') Float
0.35 Maybe Float
forall a. Maybe a
Nothing Text
"Specialized access conditions exist.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Medium" (Char -> MetricValueChar
C Char
'M') Float
0.61 Maybe Float
forall a. Maybe a
Nothing Text
"The access conditions are somewhat specialized.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Low" (Char -> MetricValueChar
C Char
'L') Float
0.71 Maybe Float
forall a. Maybe a
Nothing Text
"Specialized access conditions or extenuating circumstances do not exist."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Authentication"
          MetricShortName
"Au"
          Bool
True
          [ Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Multiple" (Char -> MetricValueChar
C Char
'M') Float
0.45 Maybe Float
forall a. Maybe a
Nothing Text
"Exploiting the vulnerability requires that the attacker authenticate two or more times, even if the same credentials are used each time.",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Single" (Char -> MetricValueChar
C Char
'S') Float
0.56 Maybe Float
forall a. Maybe a
Nothing Text
"The vulnerability requires an attacker to be logged into the system (such as at a command line or via a desktop session or web interface).",
            Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"None" (Char -> MetricValueChar
C Char
'N') Float
0.704 Maybe Float
forall a. Maybe a
Nothing Text
"Authentication is not required to exploit the vulnerability."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Confidentiality Impact"
          MetricShortName
"C"
          Bool
True
          [ Text -> MetricValue
mkNone Text
"There is no impact to the confidentiality of the system.",
            Text -> MetricValue
mkPartial Text
"There is considerable informational disclosure.",
            Text -> MetricValue
mkComplete Text
"There is total information disclosure, resulting in all system files being revealed."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Integrity Impact"
          MetricShortName
"I"
          Bool
True
          [ Text -> MetricValue
mkNone Text
"There is no impact to the integrity of the system.",
            Text -> MetricValue
mkPartial Text
"Modification of some system files or information is possible, but the attacker does not have control over what can be modified, or the scope of what the attacker can affect is limited.",
            Text -> MetricValue
mkComplete Text
"There is a total compromise of system integrity."
          ],
        Text -> MetricShortName -> Bool -> [MetricValue] -> MetricInfo
MetricInfo
          Text
"Availability Impact"
          MetricShortName
"A"
          Bool
True
          [ Text -> MetricValue
mkNone Text
"There is no impact to the availability of the system.",
            Text -> MetricValue
mkPartial Text
"There is reduced performance or interruptions in resource availability.",
            Text -> MetricValue
mkComplete Text
"There is a total shutdown of the affected resource."
          ]
      ]
    mkNone :: Text -> MetricValue
mkNone = Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"None" (Char -> MetricValueChar
C Char
'N') Float
0 Maybe Float
forall a. Maybe a
Nothing
    mkPartial :: Text -> MetricValue
mkPartial = Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Partial" (Char -> MetricValueChar
C Char
'P') Float
0.275 Maybe Float
forall a. Maybe a
Nothing
    mkComplete :: Text -> MetricValue
mkComplete = Text
-> MetricValueChar -> Float -> Maybe Float -> Text -> MetricValue
MetricValue Text
"Complete" (Char -> MetricValueChar
C Char
'C') Float
0.660 Maybe Float
forall a. Maybe a
Nothing

validateCvss20 :: [Metric] -> Either CVSSError [Metric]
validateCvss20 :: [Metric] -> Either CVSSError [Metric]
validateCvss20 [Metric]
metrics = do
  (([Metric] -> Either CVSSError ()) -> Either CVSSError ())
-> [[Metric] -> Either CVSSError ()] -> Either CVSSError ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\[Metric] -> Either CVSSError ()
t -> [Metric] -> Either CVSSError ()
t [Metric]
metrics) [[Metric] -> Either CVSSError ()
validateUnique, CVSSDB -> [Metric] -> Either CVSSError ()
validateKnown CVSSDB
cvss20, CVSSDB -> [Metric] -> Either CVSSError ()
validateRequired CVSSDB
cvss20]
  [Metric] -> Either CVSSError [Metric]
forall a. a -> Either CVSSError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Metric]
metrics

-- | Implementation of section 3.2.1. "Base Equation"
cvss20score :: [Metric] -> (Rating, Float)
cvss20score :: [Metric] -> (Rating, Float)
cvss20score [Metric]
metrics = (Float -> Rating
toRating Float
score, Float
score)
  where
    score :: Float
score = Float -> Float
round_to_1_decimal ((Float
0.6 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
impact Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.4 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
exploitability Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1.5) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
fImpact)
    impact :: Float
impact = Float
10.41 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Text -> Float
gm Text
"Confidentiality Impact") Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Text -> Float
gm Text
"Integrity Impact") Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Text -> Float
gm Text
"Availability Impact"))
    exploitability :: Float
exploitability = Float
20 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"Access Vector" Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"Access Complexity" Float -> Float -> Float
forall a. Num a => a -> a -> a
* Text -> Float
gm Text
"Authentication"
    fImpact :: Float
fImpact
      | Float
impact Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = Float
0
      | Bool
otherwise = Float
1.176

    round_to_1_decimal :: Float -> Float
    round_to_1_decimal :: Float -> Float
round_to_1_decimal Float
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int (Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
10)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
10

    gm :: Text -> Float
    gm :: Text -> Float
gm = CVSSDB -> [Metric] -> Float -> Text -> Float
getMetricValue CVSSDB
cvss20 [Metric]
metrics Float
0

-- | Check for duplicates metric
--
-- >>> validateUnique [("AV", (C 'N')), ("AC", (C 'L')), ("AV", (C 'L'))]
-- Left "Duplicated \"AV\""
validateUnique :: [Metric] -> Either CVSSError ()
validateUnique :: [Metric] -> Either CVSSError ()
validateUnique = ([MetricShortName] -> Either CVSSError ())
-> [[MetricShortName]] -> Either CVSSError ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ [MetricShortName] -> Either CVSSError ()
checkDouble ([[MetricShortName]] -> Either CVSSError ())
-> ([Metric] -> [[MetricShortName]])
-> [Metric]
-> Either CVSSError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MetricShortName] -> [[MetricShortName]]
forall a. Eq a => [a] -> [[a]]
group ([MetricShortName] -> [[MetricShortName]])
-> ([Metric] -> [MetricShortName])
-> [Metric]
-> [[MetricShortName]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MetricShortName] -> [MetricShortName]
forall a. Ord a => [a] -> [a]
sort ([MetricShortName] -> [MetricShortName])
-> ([Metric] -> [MetricShortName]) -> [Metric] -> [MetricShortName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Metric -> MetricShortName) -> [Metric] -> [MetricShortName]
forall a b. (a -> b) -> [a] -> [b]
map Metric -> MetricShortName
mName
  where
    checkDouble :: [MetricShortName] -> Either CVSSError ()
checkDouble [] = [Char] -> Either CVSSError ()
forall a. HasCallStack => [Char] -> a
error [Char]
"The impossible have happened"
    checkDouble [MetricShortName
_] = () -> Either CVSSError ()
forall a. a -> Either CVSSError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    checkDouble (MetricShortName Text
n : [MetricShortName]
_) = CVSSError -> Either CVSSError ()
forall a b. a -> Either a b
Left (Text -> CVSSError
DuplicateMetric Text
n)

-- | Check for unknown metric
--
-- >>> validateKnown [("AV", (C 'M'))]
-- Left "Unknown value: (C 'M')"
--
-- >>> validateKnown [("AW", (C 'L'))]
-- Left "Unknown metric: \"AW\""
validateKnown :: CVSSDB -> [Metric] -> Either CVSSError ()
validateKnown :: CVSSDB -> [Metric] -> Either CVSSError ()
validateKnown CVSSDB
db = (Metric -> Either CVSSError ()) -> [Metric] -> Either CVSSError ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Metric -> Either CVSSError ()
checkKnown
  where
    checkKnown :: Metric -> Either CVSSError ()
checkKnown (Metric MetricShortName
name MetricValueChar
char) = do
      MetricInfo
mi <- case (MetricInfo -> Bool) -> [MetricInfo] -> Maybe MetricInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\MetricInfo
mi -> MetricInfo -> MetricShortName
miShortName MetricInfo
mi MetricShortName -> MetricShortName -> Bool
forall a. Eq a => a -> a -> Bool
== MetricShortName
name) (CVSSDB -> [MetricInfo]
allMetrics CVSSDB
db) of
        Maybe MetricInfo
Nothing -> CVSSError -> Either CVSSError MetricInfo
forall a b. a -> Either a b
Left (Text -> CVSSError
UnknownMetric (MetricShortName -> Text
forall a b. Coercible a b => a -> b
coerce MetricShortName
name))
        Just MetricInfo
m -> MetricInfo -> Either CVSSError MetricInfo
forall a. a -> Either CVSSError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetricInfo
m
      case (MetricValue -> Bool) -> [MetricValue] -> Maybe MetricValue
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\MetricValue
mv -> MetricValue -> MetricValueChar
mvChar MetricValue
mv MetricValueChar -> MetricValueChar -> Bool
forall a. Eq a => a -> a -> Bool
== MetricValueChar
char) (MetricInfo -> [MetricValue]
miValues MetricInfo
mi) of
        Maybe MetricValue
Nothing -> CVSSError -> Either CVSSError ()
forall a b. a -> Either a b
Left (Text -> Char -> CVSSError
UnknownValue (MetricShortName -> Text
forall a b. Coercible a b => a -> b
coerce MetricShortName
name) (MetricValueChar -> Char
forall a b. Coercible a b => a -> b
coerce MetricValueChar
char))
        Just MetricValue
_ -> () -> Either CVSSError ()
forall a. a -> Either CVSSError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Check for required metric
--
-- >>> validateRequired []
-- Left "Missing \"Attack Vector\""
validateRequired :: CVSSDB -> [Metric] -> Either CVSSError ()
validateRequired :: CVSSDB -> [Metric] -> Either CVSSError ()
validateRequired CVSSDB
db [Metric]
metrics = (MetricInfo -> Either CVSSError ())
-> [MetricInfo] -> Either CVSSError ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ MetricInfo -> Either CVSSError ()
checkRequired (CVSSDB -> [MetricInfo]
allMetrics CVSSDB
db)
  where
    checkRequired :: MetricInfo -> Either CVSSError ()
checkRequired MetricInfo
mi
      | MetricInfo -> Bool
miRequired MetricInfo
mi,
        Maybe Metric
Nothing <- (Metric -> Bool) -> [Metric] -> Maybe Metric
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Metric
metric -> MetricInfo -> MetricShortName
miShortName MetricInfo
mi MetricShortName -> MetricShortName -> Bool
forall a. Eq a => a -> a -> Bool
== Metric -> MetricShortName
mName Metric
metric) [Metric]
metrics =
          CVSSError -> Either CVSSError ()
forall a b. a -> Either a b
Left (Text -> CVSSError
MissingRequiredMetric (MetricInfo -> Text
miName MetricInfo
mi))
      | Bool
otherwise = () -> Either CVSSError ()
forall a. a -> Either CVSSError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()