diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## 0.3 + +* Fix CVSS V2 score bugs +* Add support for V3/V3.1/V4 + ## 0.2.0.1 * Update `tasty` dependency bounds diff --git a/cvss.cabal b/cvss.cabal --- a/cvss.cabal +++ b/cvss.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: cvss -version: 0.2.0.1 +version: 0.3.0.0 synopsis: Common Vulnerability Scoring System. description: Use this library to parse CVSS string and compute its score. @@ -9,15 +9,34 @@ author: Tristan de Cacqueray maintainer: tdecacqu@redhat.com category: Data -extra-doc-files: CHANGELOG.md, README.md +extra-doc-files: + CHANGELOG.md + README.md + tested-with: - GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.3 || ==9.10.1 || ==9.12.1 + GHC ==8.10.7 + || ==9.0.2 + || ==9.2.8 + || ==9.4.8 + || ==9.6.6 + || ==9.8.3 + || ==9.10.1 + || ==9.12.1 library exposed-modules: Security.CVSS + other-modules: + Security.CVSS.Internal + Security.CVSS.Types + Security.CVSS.V20 + Security.CVSS.V30 + Security.CVSS.V31 + Security.CVSS.V40 + build-depends: - , base >=4.14 && <5 - , text >=1.2 && <3 + , base >=4.14 && <5 + , containers >=0.6 && <0.8 + , text >=1.2 && <3 hs-source-dirs: src default-language: Haskell2010 @@ -27,13 +46,30 @@ test-suite spec type: exitcode-stdio-1.0 - hs-source-dirs: test + hs-source-dirs: test src main-is: Spec.hs + other-modules: + OfficialExamples + Security.CVSS + Security.CVSS.Internal + Security.CVSS.Types + Security.CVSS.V20 + Security.CVSS.V30 + Security.CVSS.V31 + Security.CVSS.V40 + TestCVSS.Common + TestCVSS.V20 + TestCVSS.V30 + TestCVSS.V31 + TestCVSS.V40 + build-depends: - , base <5 + , base <5 + , containers , cvss - , tasty <2 - , tasty-hunit <1.0 + , tasty <2 + , tasty-hunit <1.0 + , tasty-quickcheck , text default-language: Haskell2010 diff --git a/src/Security/CVSS.hs b/src/Security/CVSS.hs --- a/src/Security/CVSS.hs +++ b/src/Security/CVSS.hs @@ -1,113 +1,88 @@ -{-# 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 +-- Description : Main entry point for CVSS v2.0, v3.0, v3.1, and v4.0 scoring +-- +-- Provides a unified interface for parsing, validating, and scoring +-- Common Vulnerability Scoring System (CVSS) vector strings across +-- all supported versions: +-- +-- * __CVSS v2.0__ — https:\/\/www.first.org\/cvss\/v2\/guide +-- * __CVSS v3.0__ — https:\/\/www.first.org\/cvss\/v3-0\/ +-- * __CVSS v3.1__ — https:\/\/www.first.org\/cvss\/v3-1\/ +-- * __CVSS v4.0__ — https:\/\/www.first.org\/cvss\/v4.0\/specification-document +-- +-- Vector string formats: +-- +-- * v4.0: @CVSS:4.0\/AV:N\/AC:L\/...@ +-- * v3.1: @CVSS:3.1\/AV:N\/AC:L\/...@ +-- * v3.0: @CVSS:3.0\/AV:N\/AC:L\/...@ +-- * v2.0: @AV:N\/AC:L\/Au:N\/...@ (no prefix) module Security.CVSS - ( -- * Type - CVSS (cvssVersion), + ( -- * Types + CVSS (..), CVSSVersion (..), + CVSSNomenclature (..), Rating (..), + CVSSError (..), + Metric (..), + MetricShortName, + MetricValueChar, + showCVSSError, + toRating, + toRating20, -- * Parser parseCVSS, - CVSSError (..), -- * Helpers cvssVectorString, cvssVectorStringOrdered, cvssScore, + cvss20TemporalScore, + cvss20EnvironmentalScore, + cvss30TemporalScore, + cvss30EnvironmentalScore, + cvss31TemporalScore, + cvss31EnvironmentalScore, + cvss40score, + cvss40BaseScore, + cvss40EnvironmentalScore, cvssInfo, + cvssSupplementalInfo, + + -- * Nomenclature + determineNomenclature, + cvssScoreWithNomenclature, + showCVSSWithNomenclature, ) where -import Data.Coerce (coerce) -import Data.Foldable (traverse_) -import Data.List (find, group, sort) +import Data.List (find) 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 (Eq) - --- | Parsed CVSS string obtained with 'parseCVSS'. -data CVSS = CVSS - { -- | The CVSS Version. - cvssVersion :: CVSSVersion, - -- | The metrics are stored as provided by the user - cvssMetrics :: [Metric] - } - deriving stock (Eq) - -instance Show CVSS where - show = Text.unpack . cvssVectorString - --- | CVSS Rating obtained with 'cvssScore' -data Rating = None | Low | Medium | High | Critical - deriving (Enum, Eq, Ord, Show) - --- | Implementation of Section 5. "Qualitative Severity Rating Scale" -toRating :: Float -> Rating -toRating score - | score <= 0 = None - | score < 4 = Low - | score < 7 = Medium - | score < 9 = High - | otherwise = Critical - -data CVSSError - = UnknownVersion - | EmptyComponent - | MissingValue Text - | DuplicateMetric Text - | MissingRequiredMetric Text - | UnknownMetric Text - | UnknownValue Text Char - -instance Show CVSSError where - show = Text.unpack . showCVSSError - -showCVSSError :: CVSSError -> Text -showCVSSError e = case e of - UnknownVersion -> "Unknown CVSS version" - EmptyComponent -> "Empty component" - MissingValue name -> "Missing value for \"" <> name <> "\"" - DuplicateMetric name -> "Duplicate metric for \"" <> name <> "\"" - MissingRequiredMetric name -> "Missing required metric \"" <> name <> "\"" - UnknownMetric name -> "Unknown metric \"" <> name <> "\"" - UnknownValue name value -> "Unknown value '" <> Text.pack (show value) <> "' for \"" <> name <> "\"" - -newtype MetricShortName = MetricShortName Text - deriving newtype (Eq, IsString, Ord, Show) - -newtype MetricValueChar = MetricValueChar Char - deriving newtype (Eq, Ord, Show) - -data Metric = Metric - { mName :: MetricShortName, - mChar :: MetricValueChar - } - deriving (Eq, Show) - --- example CVSS string: CVSS:3.1/AV:N/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:N +import Security.CVSS.Internal (CVSSDB (..), allMetrics, doCVSSInfo, miShortName) +import Security.CVSS.Types (CVSS (..), CVSSError (..), CVSSNomenclature (..), CVSSVersion (..), Metric (..), MetricShortName (..), MetricValueChar (..), Rating (..), showCVSSError, toRating, toRating20) +import Security.CVSS.V20 (cvss20DB, cvss20EnvironmentalScore, cvss20TemporalScore, cvss20score, validateCvss20) +import Security.CVSS.V30 (cvss30DB, cvss30EnvironmentalScore, cvss30TemporalScore, cvss30score, validateCvss30) +import Security.CVSS.V31 (cvss31DB, cvss31EnvironmentalScore, cvss31TemporalScore, cvss31score, validateCvss31) +import Security.CVSS.V40 (cvss40BaseScore, cvss40DB, cvss40EnvironmentalScore, cvss40SupplementalInfo, cvss40score, hasEnvironmentalMetrics40, hasThreatMetrics40, validateCvss40) --- | Parse a CVSS string. +-- | Parse a CVSS vector string into a 'CVSS' value. +-- +-- The version is detected from the prefix: +-- +-- * @CVSS:4.0\/...@ → CVSS40 +-- * @CVSS:3.1\/...@ → CVSS31 +-- * @CVSS:3.0\/...@ → CVSS30 +-- * Any other string without a @CVSS:@ prefix → CVSS20 +-- * @CVSS:@ with an unknown version → 'Left' 'UnknownVersion' parseCVSS :: Text -> Either CVSSError CVSS parseCVSS txt + | "CVSS:4.0/" `Text.isPrefixOf` txt = CVSS CVSS40 <$> validateComponents True validateCvss40 | "CVSS:3.1/" `Text.isPrefixOf` txt = CVSS CVSS31 <$> validateComponents True validateCvss31 | "CVSS:3.0/" `Text.isPrefixOf` txt = CVSS CVSS30 <$> validateComponents True validateCvss30 | "CVSS:" `Text.isPrefixOf` txt = Left UnknownVersion @@ -115,449 +90,103 @@ where validateComponents withPrefix validator = do metrics <- traverse splitComponent $ components withPrefix - validator metrics + _ <- validator metrics + pure metrics components withPrefix = (if withPrefix then drop 1 else id) $ Text.split (== '/') txt splitComponent :: Text -> Either CVSSError Metric - splitComponent componentTxt = case Text.unsnoc componentTxt of - Nothing -> Left EmptyComponent - Just (rest, c) -> case Text.unsnoc rest of - Just (name, ':') -> Right (Metric (MetricShortName name) (MetricValueChar c)) - _ -> Left (MissingValue componentTxt) + splitComponent componentTxt = case Text.breakOnEnd ":" componentTxt of + ("", _) -> Left EmptyComponent + (_, "") -> Left (MissingValue componentTxt) + (nameWithColon, valueText) -> + let name = Text.init nameWithColon + in Right (Metric (MetricShortName name) (MetricValueChar valueText)) --- | Compute the base score. +-- | Compute the CVSS score for any supported version. +-- Dispatches to the appropriate version-specific scorer. cvssScore :: CVSS -> (Rating, Float) cvssScore cvss = case cvssVersion cvss of + CVSS40 -> cvss40score (cvssMetrics cvss) CVSS31 -> cvss31score (cvssMetrics cvss) CVSS30 -> cvss30score (cvssMetrics cvss) CVSS20 -> cvss20score (cvssMetrics cvss) --- | Explain the CVSS metrics. +-- | Look up human-readable descriptions for each metric in the vector. cvssInfo :: CVSS -> [Text] cvssInfo cvss = doCVSSInfo (cvssDB (cvssVersion cvss)) (cvssMetrics cvss) --- | Format the CVSS back to its original string. +-- | Render the CVSS vector string preserving the original metric order. cvssVectorString :: CVSS -> Text cvssVectorString = cvssShow False --- | Format the CVSS to the prefered ordered vector string. +-- | Render the CVSS vector string in canonical (specification-defined) metric order. cvssVectorStringOrdered :: CVSS -> Text cvssVectorStringOrdered = cvssShow True +-- | Internal: render a CVSS vector string, optionally ordering metrics +-- according to the specification. cvssShow :: Bool -> CVSS -> Text cvssShow ordered cvss = case cvssVersion cvss of + CVSS40 -> Text.intercalate "/" ("CVSS:4.0" : components) CVSS31 -> Text.intercalate "/" ("CVSS:3.1" : components) CVSS30 -> Text.intercalate "/" ("CVSS:3.0" : components) CVSS20 -> Text.intercalate "/" components where components = map toComponent (cvssOrder (cvssMetrics cvss)) toComponent :: Metric -> Text - toComponent (Metric (MetricShortName name) (MetricValueChar value)) = Text.snoc (name <> ":") value + toComponent (Metric (MetricShortName name) (MetricValueChar value)) = name <> ":" <> value cvssOrder metrics | ordered = mapMaybe getMetric (allMetrics (cvssDB (cvssVersion cvss))) | otherwise = metrics where getMetric mi = find (\metric -> miShortName mi == mName metric) metrics -newtype CVSSDB = CVSSDB [MetricGroup] +-- | Retrieve supplemental metric info for CVSS v4.0 vectors. +-- Returns 'Nothing' for all other CVSS versions. +cvssSupplementalInfo :: CVSS -> Maybe Text +cvssSupplementalInfo cvss = case cvssVersion cvss of + CVSS40 -> Security.CVSS.V40.cvss40SupplementalInfo (cvssMetrics cvss) + _ -> Nothing +-- | Get the metric database for a given CVSS version. cvssDB :: CVSSVersion -> CVSSDB cvssDB v = case v of - CVSS31 -> cvss31 - CVSS30 -> cvss30 - CVSS20 -> cvss20 - --- | Description of a metric group. -data MetricGroup = MetricGroup - { mgName :: Text, - mgMetrics :: [MetricInfo] - } - --- | Description of a single metric. -data MetricInfo = MetricInfo - { miName :: Text, - miShortName :: MetricShortName, - miRequired :: Bool, - miValues :: [MetricValue] - } - --- | Description of a single metric value -data MetricValue = MetricValue - { mvName :: Text, - mvChar :: MetricValueChar, - mvNum :: Float, - mvNumChangedScope :: Maybe Float, - mvDesc :: Text - } - --- | CVSS3.1 metrics pulled from section 2. "Base Metrics" and section section 7.4. "Metric Values" -cvss31 :: CVSSDB -cvss31 = - CVSSDB - [ MetricGroup "Base" baseMetrics, - MetricGroup "Temporal" temporalMetrics, - MetricGroup "Environmental" environmentalMetrics - ] - where - baseMetrics = - [ MetricInfo - "Attack Vector" - "AV" - True - [ MetricValue "Network" (C 'N') 0.85 Nothing "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.", - MetricValue "Adjacent" (C 'A') 0.62 Nothing "The vulnerable component is bound to the network stack, but the attack is limited at the protocol level to a logically adjacent topology.", - MetricValue "Local" (C 'L') 0.55 Nothing "The vulnerable component is not bound to the network stack and the attacker’s path is via read/write/execute capabilities.", - MetricValue "Physical" (C 'P') 0.2 Nothing "The attack requires the attacker to physically touch or manipulate the vulnerable component." - ], - MetricInfo - "Attack Complexity" - "AC" - True - [ MetricValue "Low" (C 'L') 0.77 Nothing "Specialized access conditions or extenuating circumstances do not exist.", - MetricValue "High" (C 'H') 0.44 Nothing "A successful attack depends on conditions beyond the attacker's control." - ], - MetricInfo - "Privileges Required" - "PR" - True - [ MetricValue "None" (C 'N') 0.85 Nothing "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.", - MetricValue "Low" (C 'L') 0.62 (Just 0.68) "The attacker requires privileges that provide basic user capabilities that could normally affect only settings and files owned by a user.", - MetricValue "High" (C 'H') 0.27 (Just 0.5) "The attacker requires privileges that provide significant (e.g., administrative) control over the vulnerable component allowing access to component-wide settings and files." - ], - MetricInfo - "User Interaction" - "UI" - True - [ MetricValue "None" (C 'N') 0.85 Nothing "The vulnerable system can be exploited without interaction from any user.", - MetricValue "Required" (C 'R') 0.62 Nothing "Successful exploitation of this vulnerability requires a user to take some action before the vulnerability can be exploited." - ], - MetricInfo - "Scope" - "S" - True - [ -- Note: not defined as contants in specification - MetricValue "Unchanged" (C 'U') Unchanged Nothing "An exploited vulnerability can only affect resources managed by the same security authority.", - MetricValue "Changed" (C 'C') Changed Nothing "An exploited vulnerability can affect resources beyond the security scope managed by the security authority of the vulnerable component." - ], - MetricInfo - "Confidentiality Impact" - "C" - True - [ mkHigh "There is a total loss of confidentiality, resulting in all resources within the impacted component being divulged to the attacker.", - mkLow "There is some loss of confidentiality.", - mkNone "There is no loss of confidentiality within the impacted component." - ], - MetricInfo - "Integrity Impact" - "I" - True - [ mkHigh "There is a total loss of integrity, or a complete loss of protection.", - mkLow "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.", - mkNone "There is no loss of integrity within the impacted component." - ], - MetricInfo - "Availability Impact" - "A" - True - [ mkHigh "There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the impacted component", - mkLow "Performance is reduced or there are interruptions in resource availability.", - mkNone "There is no impact to availability within the impacted component." - ] - ] - mkHigh = MetricValue "High" (C 'H') 0.56 Nothing - mkLow = MetricValue "Low" (C 'L') 0.22 Nothing - mkNone = MetricValue "None" (C 'N') 0 Nothing - -- TODOs - temporalMetrics = [] - environmentalMetrics = [] - -pattern C :: Char -> MetricValueChar -pattern C c = MetricValueChar c - -pattern Unchanged :: Float -pattern Unchanged = 6.42 - -pattern Changed :: Float -pattern Changed = 7.52 - -doCVSSInfo :: CVSSDB -> [Metric] -> [Text] -doCVSSInfo (CVSSDB db) = map showMetricInfo - where - showMetricInfo metric = case mapMaybe (getInfo metric) db of - [(mg, mi, mv)] -> - mconcat [mgName mg, " ", miName mi, ": ", mvName mv, " (", mvDesc mv, ")"] - _ -> error $ "The impossible have happened for " <> show metric - getInfo metric mg = do - mi <- find (\mi -> miShortName mi == mName metric) (mgMetrics mg) - mv <- find (\mv -> mvChar mv == mChar metric) (miValues mi) - pure (mg, mi, mv) - -allMetrics :: CVSSDB -> [MetricInfo] -allMetrics (CVSSDB db) = concatMap mgMetrics db - --- | Implementation of the Appendix A - "Floating Point Rounding" -roundup :: Float -> Float -roundup input - | int_input `mod` 10000 == 0 = fromIntegral int_input / 100000 - | otherwise = (fromIntegral (floor_int (fromIntegral int_input / 10000)) + 1) / 10 - where - floor_int :: Float -> Int - floor_int = floor - int_input :: Int - int_input = round (input * 100000) - --- | Implementation of section 7.1. Base Metrics Equations -cvss31score :: [Metric] -> (Rating, Float) -cvss31score metrics = (toRating score, score) - where - iss = 1 - (1 - gm "Confidentiality Impact") * (1 - gm "Integrity Impact") * (1 - gm "Availability Impact") - impact - | scope == Unchanged = scope * iss - | otherwise = scope * (iss - 0.029) - 3.25 * powerFloat (iss - 0.02) 15 - exploitability = 8.22 * gm "Attack Vector" * gm "Attack Complexity" * gm "Privileges Required" * gm "User Interaction" - score - | impact <= 0 = 0 - | scope == Unchanged = roundup (min (impact + exploitability) 10) - | otherwise = roundup (min (1.08 * (impact + exploitability)) 10) - scope = gm "Scope" - - gm :: Text -> Float - gm = getMetricValue cvss31 metrics scope - -getMetricValue :: CVSSDB -> [Metric] -> Float -> Text -> Float -getMetricValue db metrics scope name = case mValue of - Nothing -> error $ "The impossible have happened, unknown metric: " <> Text.unpack name - Just v -> v - where - mValue = do - mi <- find (\mi -> miName mi == name) (allMetrics db) - Metric _ valueChar <- find (\metric -> miShortName mi == mName metric) metrics - mv <- find (\mv -> mvChar mv == valueChar) (miValues mi) - pure $ case mvNumChangedScope mv of - Just value | scope /= Unchanged -> value - _ -> mvNum mv - -validateCvss31 :: [Metric] -> Either CVSSError [Metric] -validateCvss31 metrics = do - traverse_ (\t -> t metrics) [validateUnique, validateKnown cvss31, validateRequired cvss31] - pure metrics - -cvss30 :: CVSSDB -cvss30 = - CVSSDB - [ MetricGroup "Base" baseMetrics - ] - where - baseMetrics = - [ MetricInfo - "Attack Vector" - "AV" - True - [ MetricValue "Network" (C 'N') 0.85 Nothing "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).", - MetricValue "Adjacent" (C 'A') 0.62 Nothing "A vulnerability exploitable with adjacent network access means the vulnerable component is bound to the network stack", - MetricValue "Local" (C 'L') 0.55 Nothing "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.", - MetricValue "Physical" (C 'P') 0.2 Nothing "A vulnerability exploitable with Physical access requires the attacker to physically touch or manipulate the vulnerable component." - ], - MetricInfo - "Attack Complexity" - "AC" - True - [ MetricValue "Low" (C 'L') 0.77 Nothing "Specialized access conditions or extenuating circumstances do not exist.", - MetricValue "High" (C 'H') 0.44 Nothing "A successful attack depends on conditions beyond the attacker's control." - ], - MetricInfo - "Privileges Required" - "PR" - True - [ MetricValue "None" (C 'N') 0.85 Nothing "The attacker is unauthorized prior to attack, and therefore does not require any access to settings or files to carry out an attack.", - MetricValue "Low" (C 'L') 0.62 (Just 0.68) "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.", - MetricValue "High" (C 'H') 0.27 (Just 0.5) "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." - ], - MetricInfo - "User Interaction" - "UI" - True - [ MetricValue "None" (C 'N') 0.85 Nothing "The vulnerable system can be exploited without interaction from any user.", - MetricValue "Required" (C 'R') 0.62 Nothing "Successful exploitation of this vulnerability requires a user to take some action before the vulnerability can be exploited." - ], - MetricInfo - "Scope" - "S" - True - [ MetricValue "Unchanged" (C 'U') Unchanged Nothing "An exploited vulnerability can only affect resources managed by the same authority.", - MetricValue "Changed" (C 'C') Changed Nothing "An exploited vulnerability can affect resources beyond the authorization privileges intended by the vulnerable component." - ], - MetricInfo - "Confidentiality Impact" - "C" - True - [ mkHigh "There is a total loss of confidentiality, resulting in all resources within the impacted component being divulged to the attacker.", - mkLow "There is some loss of confidentiality.", - mkNone "There is no loss of confidentiality within the impacted component." - ], - MetricInfo - "Integrity Impact" - "I" - True - [ mkHigh "There is a total loss of integrity, or a complete loss of protection.", - mkLow "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.", - mkNone "There is no loss of integrity within the impacted component." - ], - MetricInfo - "Availability Impact" - "A" - True - [ mkHigh "There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the impacted component", - mkLow "Performance is reduced or there are interruptions in resource availability.", - mkNone "There is no impact to availability within the impacted component." - ] - ] - mkHigh = MetricValue "High" (C 'H') 0.56 Nothing - mkLow = MetricValue "Low" (C 'L') 0.22 Nothing - mkNone = MetricValue "None" (C 'N') 0 Nothing - --- | Implementation of Section 8.1 "Base" -cvss30score :: [Metric] -> (Rating, Float) -cvss30score metrics = (toRating score, score) - where - score - | impact <= 0 = 0 - | scope == Unchanged = roundup (min (impact + exploitability) 10) - | otherwise = roundup (min (1.08 * (impact + exploitability)) 10) - impact - | scope == Unchanged = scope * iscBase - | otherwise = scope * (iscBase - 0.029) - 3.25 * powerFloat (iscBase - 0.02) 15 - iscBase = 1 - (1 - gm "Confidentiality Impact") * (1 - gm "Integrity Impact") * (1 - gm "Availability Impact") - scope = gm "Scope" - - exploitability = 8.22 * gm "Attack Vector" * gm "Attack Complexity" * gm "Privileges Required" * gm "User Interaction" - gm = getMetricValue cvss30 metrics scope - -validateCvss30 :: [Metric] -> Either CVSSError [Metric] -validateCvss30 metrics = do - traverse_ (\t -> t metrics) [validateUnique, validateKnown cvss30, validateRequired cvss30] - pure metrics - -cvss20 :: CVSSDB -cvss20 = - CVSSDB - [ MetricGroup "Base" baseMetrics - ] - where - baseMetrics = - [ MetricInfo - "Access Vector" - "AV" - True - [ MetricValue "Local" (C 'L') 0.395 Nothing "A vulnerability exploitable with only local access requires the attacker to have either physical access to the vulnerable system or a local (shell) account.", - MetricValue "Adjacent Network" (C 'A') 0.646 Nothing "A vulnerability exploitable with adjacent network access requires the attacker to have access to either the broadcast or collision domain of the vulnerable software.", - MetricValue "Network" (C 'N') 1.0 Nothing "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." - ], - MetricInfo - "Access Complexity" - "AC" - True - [ MetricValue "High" (C 'H') 0.35 Nothing "Specialized access conditions exist.", - MetricValue "Medium" (C 'M') 0.61 Nothing "The access conditions are somewhat specialized.", - MetricValue "Low" (C 'L') 0.71 Nothing "Specialized access conditions or extenuating circumstances do not exist." - ], - MetricInfo - "Authentication" - "Au" - True - [ MetricValue "Multiple" (C 'M') 0.45 Nothing "Exploiting the vulnerability requires that the attacker authenticate two or more times, even if the same credentials are used each time.", - MetricValue "Single" (C 'S') 0.56 Nothing "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).", - MetricValue "None" (C 'N') 0.704 Nothing "Authentication is not required to exploit the vulnerability." - ], - MetricInfo - "Confidentiality Impact" - "C" - True - [ mkNone "There is no impact to the confidentiality of the system.", - mkPartial "There is considerable informational disclosure.", - mkComplete "There is total information disclosure, resulting in all system files being revealed." - ], - MetricInfo - "Integrity Impact" - "I" - True - [ mkNone "There is no impact to the integrity of the system.", - mkPartial "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.", - mkComplete "There is a total compromise of system integrity." - ], - MetricInfo - "Availability Impact" - "A" - True - [ mkNone "There is no impact to the availability of the system.", - mkPartial "There is reduced performance or interruptions in resource availability.", - mkComplete "There is a total shutdown of the affected resource." - ] - ] - mkNone = MetricValue "None" (C 'N') 0 Nothing - mkPartial = MetricValue "Partial" (C 'P') 0.275 Nothing - mkComplete = MetricValue "Complete" (C 'C') 0.660 Nothing - -validateCvss20 :: [Metric] -> Either CVSSError [Metric] -validateCvss20 metrics = do - traverse_ (\t -> t metrics) [validateUnique, validateKnown cvss20, validateRequired cvss20] - pure metrics - --- | Implementation of section 3.2.1. "Base Equation" -cvss20score :: [Metric] -> (Rating, Float) -cvss20score metrics = (toRating score, score) - where - score = round_to_1_decimal ((0.6 * impact + 0.4 * exploitability - 1.5) * fImpact) - impact = 10.41 * (1 - (1 - gm "Confidentiality Impact") * (1 - gm "Integrity Impact") * (1 - gm "Availability Impact")) - exploitability = 20 * gm "Access Vector" * gm "Access Complexity" * gm "Authentication" - fImpact - | impact == 0 = 0 - | otherwise = 1.176 - - round_to_1_decimal :: Float -> Float - round_to_1_decimal x = fromIntegral @Int (round (x * 10)) / 10 - - gm :: Text -> Float - gm = getMetricValue cvss20 metrics 0 + CVSS40 -> cvss40DB + CVSS31 -> cvss31DB + CVSS30 -> cvss30DB + CVSS20 -> cvss20DB --- | Check for duplicates metric --- --- >>> validateUnique [("AV", (C 'N')), ("AC", (C 'L')), ("AV", (C 'L'))] --- Left "Duplicated \"AV\"" -validateUnique :: [Metric] -> Either CVSSError () -validateUnique = traverse_ checkDouble . group . sort . map mName - where - checkDouble [] = error "The impossible have happened" - checkDouble [_] = pure () - checkDouble (MetricShortName n : _) = Left (DuplicateMetric n) +-- | Determine the CVSS nomenclature (CVSS-B, CVSS-BT, CVSS-BE, CVSS-BTE) +-- for a CVSS v4.0 vector based on which metric groups are present. +-- For v2.x and v3.x, always returns 'CVSS_B'. +determineNomenclature :: CVSS -> CVSSNomenclature +determineNomenclature cvss = case cvssVersion cvss of + CVSS40 -> + let metrics = cvssMetrics cvss + hasT = hasThreatMetrics40 metrics + hasE = hasEnvironmentalMetrics40 metrics + in case (hasT, hasE) of + (False, False) -> CVSS_B + (True, False) -> CVSS_BT + (False, True) -> CVSS_BE + (True, True) -> CVSS_BTE + _ -> CVSS_B --- | 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 db = traverse_ checkKnown - where - checkKnown (Metric name char) = do - mi <- case find (\mi -> miShortName mi == name) (allMetrics db) of - Nothing -> Left (UnknownMetric (coerce name)) - Just m -> pure m - case find (\mv -> mvChar mv == char) (miValues mi) of - Nothing -> Left (UnknownValue (coerce name) (coerce char)) - Just _ -> pure () +-- | Compute the score along with the CVSS nomenclature. +cvssScoreWithNomenclature :: CVSS -> (Rating, Float, CVSSNomenclature) +cvssScoreWithNomenclature cvss = + let (rating, score) = cvssScore cvss + nomen = determineNomenclature cvss + in (rating, score, nomen) --- | Check for required metric --- --- >>> validateRequired [] --- Left "Missing \"Attack Vector\"" -validateRequired :: CVSSDB -> [Metric] -> Either CVSSError () -validateRequired db metrics = traverse_ checkRequired (allMetrics db) - where - checkRequired mi - | miRequired mi, - Nothing <- find (\metric -> miShortName mi == mName metric) metrics = - Left (MissingRequiredMetric (miName mi)) - | otherwise = pure () +-- | Render a CVSS vector with its nomenclature, rating, and score +-- in the format @CVSS-B:Medium\/6.5@ (or CVSS-BT, CVSS-BE, CVSS-BTE). +showCVSSWithNomenclature :: CVSS -> Text +showCVSSWithNomenclature cvss = + let (rating, score, nomen) = cvssScoreWithNomenclature cvss + nomenStr = case nomen of + CVSS_B -> "CVSS-B" + CVSS_BT -> "CVSS-BT" + CVSS_BE -> "CVSS-BE" + CVSS_BTE -> "CVSS-BTE" + in nomenStr <> ":" <> Text.pack (show rating) <> "/" <> Text.pack (show score) diff --git a/src/Security/CVSS/Internal.hs b/src/Security/CVSS/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Security/CVSS/Internal.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} + +module Security.CVSS.Internal + ( CVSSDB (..), + MetricGroup (..), + MetricInfo (..), + MetricValue (..), + allMetrics, + lookupMetricInfo, + lookupMetricValueChar, + lookupMetricValue, + getMetricValue, + getMetricValueOr, + doCVSSInfo, + roundup, + validateUnique, + validateKnown, + validateRequired, + hasTemporalMetrics, + hasEnvironmentalMetrics, + getModifiedMetricValue, + changed, + unchanged, + ) +where + +import Data.Coerce (coerce) +import Data.Foldable (traverse_) +import Data.List (find, group, sort) +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Text (Text) +import Data.Text qualified as Text +import Security.CVSS.Types + +-- Constants used in place of Unchanged/Changed pattern synonyms +unchanged :: Float +unchanged = 6.42 + +changed :: Float +changed = 7.52 + +newtype CVSSDB = CVSSDB [MetricGroup] + +data MetricGroup = MetricGroup + { mgName :: Text, + mgMetrics :: [MetricInfo] + } + +data MetricInfo = MetricInfo + { miName :: Text, + miShortName :: MetricShortName, + miRequired :: Bool, + miValues :: [MetricValue] + } + +data MetricValue = MetricValue + { mvName :: Text, + mvChar :: MetricValueChar, + mvNum :: Float, + mvNumChangedScope :: Maybe Float, + mvDesc :: Text + } + +allMetrics :: CVSSDB -> [MetricInfo] +allMetrics (CVSSDB db) = concatMap mgMetrics db + +lookupMetricInfo :: CVSSDB -> Text -> Maybe MetricInfo +lookupMetricInfo db name = + find (\mi -> miName mi == name) (allMetrics db) + +lookupMetricValueChar :: CVSSDB -> [Metric] -> Text -> Maybe MetricValueChar +lookupMetricValueChar db metrics name = do + mi <- lookupMetricInfo db name + Metric _ valueChar <- find (\metric -> miShortName mi == mName metric) metrics + pure valueChar + +lookupMetricValue :: CVSSDB -> [Metric] -> Float -> Text -> Maybe Float +lookupMetricValue db metrics scope name = do + mi <- lookupMetricInfo db name + valueChar <- lookupMetricValueChar db metrics name + mv <- find (\mv -> mvChar mv == valueChar) (miValues mi) + pure $ case mvNumChangedScope mv of + Just value | scope /= unchanged -> value + _ -> mvNum mv + +getMetricValue :: CVSSDB -> [Metric] -> Float -> Text -> Float +getMetricValue db metrics scope name = case lookupMetricValue db metrics scope name of + Nothing -> error $ "The impossible have happened, unknown metric: " <> Text.unpack name + Just value -> value + +getMetricValueOr :: CVSSDB -> [Metric] -> Float -> Float -> Text -> Float +getMetricValueOr db metrics defaultValue scope name = fromMaybe defaultValue $ lookupMetricValue db metrics scope name + +doCVSSInfo :: CVSSDB -> [Metric] -> [Text] +doCVSSInfo (CVSSDB db) = map showMetricInfo + where + showMetricInfo metric = case mapMaybe (getInfo metric) db of + [(mg, mi, mv)] -> + mconcat [mgName mg, " ", miName mi, ": ", mvName mv, " (", mvDesc mv, ")"] + _ -> error $ "The impossible have happened for " <> show metric + getInfo metric mg = do + mi <- find (\mi -> miShortName mi == mName metric) (mgMetrics mg) + mv <- find (\mv -> mvChar mv == mChar metric) (miValues mi) + pure (mg, mi, mv) + +roundup :: Float -> Float +roundup input + | int_input `mod` 10000 == 0 = fromIntegral int_input / 100000 + | otherwise = (fromIntegral (floor_int (fromIntegral int_input / 10000)) + 1) / 10 + where + floor_int :: Float -> Int + floor_int = floor + int_input :: Int + int_input = round (input * 100000) + +validateUnique :: [Metric] -> Either CVSSError () +validateUnique = traverse_ checkDouble . group . sort . map mName + where + checkDouble [] = error "The impossible have happened" + checkDouble [_] = pure () + checkDouble (MetricShortName n : _) = Left (DuplicateMetric n) + +validateKnown :: CVSSDB -> [Metric] -> Either CVSSError () +validateKnown db = traverse_ checkKnown + where + checkKnown (Metric name char) = do + mi <- case find (\mi -> miShortName mi == name) (allMetrics db) of + Nothing -> Left (UnknownMetric (coerce name)) + Just m -> pure m + case find (\mv -> mvChar mv == char) (miValues mi) of + Nothing -> Left (UnknownValue (coerce name) (coerce char)) + Just _ -> pure () + +validateRequired :: CVSSDB -> [Metric] -> Either CVSSError () +validateRequired db metrics = traverse_ checkRequired (allMetrics db) + where + checkRequired mi + | miRequired mi, + Nothing <- find (\metric -> miShortName mi == mName metric) metrics = + Left (MissingRequiredMetric (miName mi)) + | otherwise = pure () + +hasTemporalMetrics :: [Metric] -> Bool +hasTemporalMetrics = + any (\metric -> mName metric `elem` ["E", "RL", "RC"]) + +hasEnvironmentalMetrics :: [Metric] -> Bool +hasEnvironmentalMetrics = + any + ( \metric -> + mName metric + `elem` ["CR", "IR", "AR", "MAV", "MAC", "MPR", "MUI", "MS", "MC", "MI", "MA"] + ) + +getModifiedMetricValue :: CVSSDB -> [Metric] -> Text -> Text -> Float -> Float +getModifiedMetricValue db ms modifiedName baseName scope = + case lookupMetricValueChar db ms modifiedName of + Just (MetricValueChar "X") -> getMetricValue db ms scope baseName + Just _ -> getMetricValue db ms scope modifiedName + Nothing -> getMetricValue db ms scope baseName diff --git a/src/Security/CVSS/Types.hs b/src/Security/CVSS/Types.hs new file mode 100644 --- /dev/null +++ b/src/Security/CVSS/Types.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} + +module Security.CVSS.Types + ( CVSS (..), + CVSSVersion (..), + CVSSNomenclature (..), + Rating (..), + CVSSError (..), + Metric (..), + MetricShortName (..), + MetricValueChar (..), + showCVSSError, + toRating, + toRating20, + ) +where + +import Data.String (IsString) +import Data.Text (Text) +import Data.Text qualified as Text + +newtype MetricShortName = MetricShortName Text + deriving newtype (Eq, IsString, Ord, Show) + +newtype MetricValueChar = MetricValueChar Text + deriving newtype (Eq, IsString, Ord, Show) + +data Metric = Metric + { mName :: MetricShortName, + mChar :: MetricValueChar + } + deriving (Eq, Show) + +data CVSSVersion + = CVSS40 + | CVSS31 + | CVSS30 + | CVSS20 + deriving (Eq, Show) + +data CVSSNomenclature + = CVSS_B + | CVSS_BT + | CVSS_BE + | CVSS_BTE + deriving stock (Eq, Show) + +data CVSS = CVSS + { cvssVersion :: CVSSVersion, + cvssMetrics :: [Metric] + } + deriving stock (Eq) + +instance Show CVSS where + show = Text.unpack . cvssVectorString' + where + cvssVectorString' cvss = case cvssVersion cvss of + CVSS40 -> Text.intercalate "/" ("CVSS:4.0" : components) + CVSS31 -> Text.intercalate "/" ("CVSS:3.1" : components) + CVSS30 -> Text.intercalate "/" ("CVSS:3.0" : components) + CVSS20 -> Text.intercalate "/" components + where + components = map toComponent (cvssMetrics cvss) + toComponent (Metric (MetricShortName name) (MetricValueChar value)) = name <> ":" <> value + +data Rating = None | Low | Medium | High | Critical + deriving (Enum, Eq, Ord, Show) + +data CVSSError + = UnknownVersion + | EmptyComponent + | MissingValue Text + | DuplicateMetric Text + | MissingRequiredMetric Text + | UnknownMetric Text + | UnknownValue Text Text + +instance Show CVSSError where + show = Text.unpack . showCVSSError + +showCVSSError :: CVSSError -> Text +showCVSSError e = case e of + UnknownVersion -> "Unknown CVSS version" + EmptyComponent -> "Empty component" + MissingValue name -> "Missing value for \"" <> name <> "\"" + DuplicateMetric name -> "Duplicate metric for \"" <> name <> "\"" + MissingRequiredMetric name -> "Missing required metric \"" <> name <> "\"" + UnknownMetric name -> "Unknown metric \"" <> name <> "\"" + UnknownValue name value -> "Unknown value '" <> value <> "' for \"" <> name <> "\"" + +toRating :: Float -> Rating +toRating score + | score <= 0 = None + | score < 4 = Low + | score < 7 = Medium + | score < 9 = High + | otherwise = Critical + +toRating20 :: Float -> Rating +toRating20 score + | score <= 0 = None + | score < 4 = Low + | score < 7 = Medium + | otherwise = High diff --git a/src/Security/CVSS/V20.hs b/src/Security/CVSS/V20.hs new file mode 100644 --- /dev/null +++ b/src/Security/CVSS/V20.hs @@ -0,0 +1,305 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Module : Security.CVSS.V20 +-- Description : CVSS v2.0 scoring implementation +-- +-- Implements CVSS v2.0 scoring as defined by FIRST. +-- +-- Specification: https:\/\/www.first.org\/cvss\/v2\/guide +-- +-- CVSS v2.0 vector strings do __not__ use a @CVSS:2.0\/@ prefix; +-- they consist of slash-separated metric pairs (e.g. @AV:N\/AC:L\/Au:N\/C:C\/I:C\/A:C@). +-- +-- Scoring is organized into three metric groups: +-- +-- * __Base__ — intrinsic qualities of the vulnerability (required). +-- * __Temporal__ — qualities that change over time (optional). +-- * __Environmental__ — qualities specific to a user's environment (optional). +-- +-- When environmental metrics are present, the environmental score is returned; +-- otherwise when temporal metrics are present, the temporal score is returned; +-- otherwise the base score is returned. +module Security.CVSS.V20 + ( cvss20DB, + validateCvss20, + cvss20score, + cvss20BaseScore, + cvss20TemporalScore, + cvss20EnvironmentalScore, + ) +where + +import Data.Foldable (traverse_) +import Data.Text (Text) +import Security.CVSS.Internal +import Security.CVSS.Types + +-- | The complete CVSS v2.0 metric database. Each 'MetricValue' carries +-- the numeric weight specified by the standard (used in score computation) +-- and a human-readable description. +cvss20DB :: CVSSDB +cvss20DB = + CVSSDB + [ MetricGroup "Base" baseMetrics, + MetricGroup "Temporal" temporalMetrics, + MetricGroup "Environmental" environmentalMetrics + ] + where + baseMetrics = + [ MetricInfo + "Access Vector" + "AV" + True + [ MetricValue "Local" (MetricValueChar "L") 0.395 Nothing "A vulnerability exploitable with only local access requires the attacker to have either physical access to the vulnerable system or a local (shell) account.", + MetricValue "Adjacent Network" (MetricValueChar "A") 0.646 Nothing "A vulnerability exploitable with adjacent network access requires the attacker to have access to either the broadcast or collision domain of the vulnerable software.", + MetricValue "Network" (MetricValueChar "N") 1.0 Nothing "A vulnerability exploitable with network access means that the vulnerable software is bound to the network stack and the attacker does not require local network access or local access." + ], + MetricInfo + "Access Complexity" + "AC" + True + [ MetricValue "High" (MetricValueChar "H") 0.35 Nothing "Specialized access conditions exist.", + MetricValue "Medium" (MetricValueChar "M") 0.61 Nothing "The access conditions are somewhat specialized.", + MetricValue "Low" (MetricValueChar "L") 0.71 Nothing "Specialized access conditions or extenuating circumstances do not exist." + ], + MetricInfo + "Authentication" + "Au" + True + [ MetricValue "Multiple" (MetricValueChar "M") 0.45 Nothing "Exploiting the vulnerability requires that the attacker authenticate two or more times, even if the same credentials are used each time.", + MetricValue "Single" (MetricValueChar "S") 0.56 Nothing "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).", + MetricValue "None" (MetricValueChar "N") 0.704 Nothing "Authentication is not required to exploit the vulnerability." + ], + MetricInfo + "Confidentiality Impact" + "C" + True + [ mkNone "There is no impact to the confidentiality of the system.", + mkPartial "There is considerable informational disclosure.", + mkComplete "There is total information disclosure, resulting in all system files being revealed." + ], + MetricInfo + "Integrity Impact" + "I" + True + [ mkNone "There is no impact to the integrity of the system.", + mkPartial "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.", + mkComplete "There is a total compromise of system integrity." + ], + MetricInfo + "Availability Impact" + "A" + True + [ mkNone "There is no impact to the availability of the system.", + mkPartial "There is reduced performance or interruptions in resource availability.", + mkComplete "There is a total shutdown of the affected resource." + ] + ] + mkNone = MetricValue "None" (MetricValueChar "N") 0 Nothing + mkPartial = MetricValue "Partial" (MetricValueChar "P") 0.275 Nothing + mkComplete = MetricValue "Complete" (MetricValueChar "C") 0.660 Nothing + temporalMetrics = + [ MetricInfo + "Exploitability" + "E" + False + [ MetricValue "Not Defined" (MetricValueChar "ND") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Temporal Score.", + MetricValue "Unproven" (MetricValueChar "U") 0.85 Nothing "No exploit code is available, or an exploit is theoretical.", + MetricValue "Proof of Concept" (MetricValueChar "POC") 0.9 Nothing "Proof-of-concept exploit code is available, or an attack demonstration is not practical for most systems.", + MetricValue "Functional" (MetricValueChar "F") 0.95 Nothing "Functional exploit code is available. The code works in most situations where the vulnerability exists.", + MetricValue "High" (MetricValueChar "H") 1.0 Nothing "Functional autonomous code exists, or no exploit is required (manual trigger) and details are widely available." + ], + MetricInfo + "Remediation Level" + "RL" + False + [ MetricValue "Not Defined" (MetricValueChar "ND") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Temporal Score.", + MetricValue "Official Fix" (MetricValueChar "OF") 0.87 Nothing "A complete vendor solution is available. Either the vendor has issued an official patch, or an upgrade is available.", + MetricValue "Temporary Fix" (MetricValueChar "TF") 0.9 Nothing "There is an official but temporary fix available. This includes instances where the vendor issues a temporary hotfix, tool, or workaround.", + MetricValue "Workaround" (MetricValueChar "W") 0.95 Nothing "There is an unofficial, non-vendor solution available. In some cases, users of the affected technology will create a patch of their own or provide steps to work around or otherwise mitigate the vulnerability.", + MetricValue "Unavailable" (MetricValueChar "U") 1.0 Nothing "There is either no solution available or it is impossible to apply." + ], + MetricInfo + "Report Confidence" + "RC" + False + [ MetricValue "Not Defined" (MetricValueChar "ND") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Temporal Score.", + MetricValue "Unconfirmed" (MetricValueChar "UC") 0.9 Nothing "There are reports of impacts that indicate a vulnerability is present. The reports indicate that the cause of the vulnerability is unknown, or reports may differ on the cause or impacts of the vulnerability.", + MetricValue "Uncorroborated" (MetricValueChar "UR") 0.95 Nothing "Significant details are published, but researchers either do not have full confidence in the root cause.", + MetricValue "Confirmed" (MetricValueChar "C") 1.0 Nothing "Detailed reports exist, or functional reproduction is possible (functional exploits may provide this). Source code is available to independently verify the assertions of the research." + ] + ] + environmentalMetrics = + [ MetricInfo + "Confidentiality Requirement" + "CR" + False + [ MetricValue "Not Defined" (MetricValueChar "ND") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Environmental Score, i.e., it has the same effect on scoring as assigning Medium.", + MetricValue "Low" (MetricValueChar "L") 0.5 Nothing "Loss of the metric is likely to have only a limited adverse effect on the organization or individuals associated with the organization.", + MetricValue "Medium" (MetricValueChar "M") 1 Nothing "Loss of the metric is likely to have a serious adverse effect on the organization or individuals associated with the organization.", + MetricValue "High" (MetricValueChar "H") 1.51 Nothing "Loss of the metric is likely to have a catastrophic adverse effect on the organization or individuals associated with the organization." + ], + MetricInfo + "Integrity Requirement" + "IR" + False + [ MetricValue "Not Defined" (MetricValueChar "ND") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Environmental Score, i.e., it has the same effect on scoring as assigning Medium.", + MetricValue "Low" (MetricValueChar "L") 0.5 Nothing "Loss of the metric is likely to have only a limited adverse effect on the organization or individuals associated with the organization.", + MetricValue "Medium" (MetricValueChar "M") 1 Nothing "Loss of the metric is likely to have a serious adverse effect on the organization or individuals associated with the organization.", + MetricValue "High" (MetricValueChar "H") 1.51 Nothing "Loss of the metric is likely to have a catastrophic adverse effect on the organization or individuals associated with the organization." + ], + MetricInfo + "Availability Requirement" + "AR" + False + [ MetricValue "Not Defined" (MetricValueChar "ND") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Environmental Score, i.e., it has the same effect on scoring as assigning Medium.", + MetricValue "Low" (MetricValueChar "L") 0.5 Nothing "Loss of the metric is likely to have only a limited adverse effect on the organization or individuals associated with the organization.", + MetricValue "Medium" (MetricValueChar "M") 1 Nothing "Loss of the metric is likely to have a serious adverse effect on the organization or individuals associated with the organization.", + MetricValue "High" (MetricValueChar "H") 1.51 Nothing "Loss of the metric is likely to have a catastrophic adverse effect on the organization or individuals associated with the organization." + ], + MetricInfo + "Collateral Damage Potential" + "CDP" + False + [ MetricValue "Not Defined" (MetricValueChar "ND") 0 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Environmental Score, i.e., it has the same effect on scoring as assigning None.", + MetricValue "None" (MetricValueChar "N") 0 Nothing "There is no potential for loss of physical assets or loss of human life.", + MetricValue "Low" (MetricValueChar "L") 0.1 Nothing "There is a negligible loss of physical assets or a minor loss of human life.", + MetricValue "Low-Medium" (MetricValueChar "LM") 0.3 Nothing "There is a significant loss of physical assets or a significant loss of human life.", + MetricValue "Medium-High" (MetricValueChar "MH") 0.4 Nothing "There is a massive loss of physical assets or a major loss of human life.", + MetricValue "High" (MetricValueChar "H") 0.5 Nothing "There is a catastrophic loss of physical assets or a massive loss of human life." + ], + MetricInfo + "Target Distribution" + "TD" + False + [ MetricValue "Not Defined" (MetricValueChar "ND") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Environmental Score, i.e., it has the same effect on scoring as assigning High.", + MetricValue "None" (MetricValueChar "N") 0 Nothing "There is no significant effect on the organization.", + MetricValue "Low" (MetricValueChar "L") 0.25 Nothing "The vulnerable component affects a minority of the organization.", + MetricValue "Medium" (MetricValueChar "M") 0.75 Nothing "The vulnerable component affects a significant portion of the organization.", + MetricValue "High" (MetricValueChar "H") 1 Nothing "The vulnerable component affects the entire organization." + ] + ] + +-- | Validate a list of CVSS v2.0 metrics, checking that: +-- +-- * No metric appears more than once. +-- * All metrics are recognized for v2.0. +-- * All required (Base) metrics are present. +validateCvss20 :: [Metric] -> Either CVSSError () +validateCvss20 metrics = do + traverse_ (\t -> t metrics) [validateUnique, validateKnown cvss20DB, validateRequired cvss20DB] + +-- | Returns 'True' when any environmental metric (CDP, TD, CR, IR, AR) is present. +hasEnvironmentalMetrics20 :: [Metric] -> Bool +hasEnvironmentalMetrics20 = any (\metric -> mName metric `elem` ["CDP", "TD", "CR", "IR", "AR"]) + +-- | Compute the CVSS v2.0 score for the given metrics. +-- Returns the environmental score if environmental metrics are present, +-- the temporal score if temporal metrics are present, or the base score otherwise. +cvss20score :: [Metric] -> (Rating, Float) +cvss20score metrics + | hasEnvironmentalMetrics20 metrics = cvss20EnvironmentalScore metrics + | hasTemporalMetrics metrics = cvss20TemporalScore metrics + | otherwise = cvss20BaseScore metrics + +-- | Compute the CVSS v2.0 Base Score. +-- +-- Per the specification: +-- +-- @ +-- Impact = 10.41 × (1 − (1−ConfImpact) × (1−IntegImpact) × (1−AvailImpact)) +-- Exploitability = 20 × AccessVector × AccessComplexity × Authentication +-- f(Impact) = 0 if Impact=0, else 1.176 +-- BaseScore = round_to_1_decimal( (0.6×Impact − 0.4×Exploitability − 1.5) × f(Impact) ) +-- @ +cvss20BaseScore :: [Metric] -> (Rating, Float) +cvss20BaseScore metrics = (toRating20 score, score) + where + score = round_to_1_decimal ((0.6 * impact + 0.4 * exploitability - 1.5) * fImpact) + impact = min 10.0 $ 10.41 * (1 - (1 - gm "Confidentiality Impact") * (1 - gm "Integrity Impact") * (1 - gm "Availability Impact")) + exploitability = 20 * gm "Access Vector" * gm "Access Complexity" * gm "Authentication" + fImpact + | impact == 0 = 0 + | otherwise = 1.176 + + round_to_1_decimal :: Float -> Float + round_to_1_decimal x = fromIntegral @Int (round (x * 10)) / 10 + + -- \| Look up the numeric weight of a metric by its full name. + gm :: Text -> Float + gm = getMetricValue cvss20DB metrics 0 + +-- | Compute the CVSS v2.0 Temporal Score. +-- +-- @ +-- TemporalScore = round_to_1_decimal(BaseScore × Exploitability × RemediationLevel × ReportConfidence) +-- @ +-- +-- Optional metrics default to 1.0 (no effect) when absent or \"Not Defined\". +cvss20TemporalScore :: [Metric] -> (Rating, Float) +cvss20TemporalScore metrics = (toRating20 score, score) + where + (_, baseScore) = cvss20BaseScore metrics + exploitability = optionalMetric20 metrics 1.0 "Exploitability" + remediationLevel = optionalMetric20 metrics 1.0 "Remediation Level" + reportConfidence = optionalMetric20 metrics 1.0 "Report Confidence" + score = round_to_1_decimal (baseScore * exploitability * remediationLevel * reportConfidence) + + round_to_1_decimal :: Float -> Float + round_to_1_decimal x = fromIntegral @Int (round (x * 10)) / 10 + +-- | Look up an optional (temporal) metric value, returning the default +-- when the metric is absent. +optionalMetric20 :: [Metric] -> Float -> Text -> Float +optionalMetric20 metrics defaultValue = + getMetricValueOr cvss20DB metrics defaultValue 0 + +-- | Compute the CVSS v2.0 Environmental Score. +-- +-- Per the specification: +-- +-- @ +-- AdjustedImpact = min(10.0, 10.41 × (1 − (1−ConfImpact×ConfReq) × (1−IntegImpact×IntegReq) × (1−AvailImpact×AvailReq))) +-- AdjustedBase = round_to_1_decimal((0.6×AdjustedImpact + 0.4×AdjustedExploitability − 1.5) × f(AdjustedImpact)) +-- AdjustedTemporal = round_to_1_decimal(AdjustedBase × Exploitability × RemediationLevel × ReportConfidence) +-- EnvironmentalScore = round_to_1_decimal((AdjustedTemporal + (10 − AdjustedTemporal) × CollateralDamagePotential) × TargetDistribution) +-- @ +cvss20EnvironmentalScore :: [Metric] -> (Rating, Float) +cvss20EnvironmentalScore metrics = (toRating20 score, score) + where + securityRequirement = getMetricValueOr cvss20DB metrics 1 0 + confidentialityRequirement = securityRequirement "Confidentiality Requirement" + integrityRequirement = securityRequirement "Integrity Requirement" + availabilityRequirement = securityRequirement "Availability Requirement" + + cVal = gm "Confidentiality Impact" + iVal = gm "Integrity Impact" + aVal = gm "Availability Impact" + + adjustedImpact = min 10.0 (10.41 * (1 - (1 - cVal * confidentialityRequirement) * (1 - iVal * integrityRequirement) * (1 - aVal * availabilityRequirement))) + + exploitability = 20 * gm "Access Vector" * gm "Access Complexity" * gm "Authentication" + + fAdj + | adjustedImpact == 0 = 0 + | otherwise = 1.176 + + adjustedBase = round_to_1_decimal ((0.6 * adjustedImpact + 0.4 * exploitability - 1.5) * fAdj) + + exploitabilityTemporal = optionalMetric20 metrics 1.0 "Exploitability" + remediationLevel = optionalMetric20 metrics 1.0 "Remediation Level" + reportConfidence = optionalMetric20 metrics 1.0 "Report Confidence" + adjustedTemporal = round_to_1_decimal (adjustedBase * exploitabilityTemporal * remediationLevel * reportConfidence) + + collateralDamagePotential = optionalMetric20 metrics 0 "Collateral Damage Potential" + targetDistribution = optionalMetric20 metrics 1 "Target Distribution" + + score = round_to_1_decimal ((adjustedTemporal + (10 - adjustedTemporal) * collateralDamagePotential) * targetDistribution) + + gm :: Text -> Float + gm = getMetricValue cvss20DB metrics 0 + + round_to_1_decimal :: Float -> Float + round_to_1_decimal x = fromIntegral @Int (round (x * 10)) / 10 diff --git a/src/Security/CVSS/V30.hs b/src/Security/CVSS/V30.hs new file mode 100644 --- /dev/null +++ b/src/Security/CVSS/V30.hs @@ -0,0 +1,345 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Security.CVSS.V30 +-- Description : CVSS v3.0 scoring implementation +-- +-- Implements CVSS v3.0 scoring as defined by FIRST. +-- +-- Specification: https:\/\/www.first.org\/cvss\/v3-0\/ +-- +-- CVSS v3.0 vector strings use the @CVSS:3.0\/@ prefix. +-- +-- Key differences from v2.0 include: +-- +-- * Introduction of __Scope__ (Unchanged\/Changed), which bifurcates the +-- impact sub-formula and applies a 1.08 multiplier for Changed scope. +-- * __Privileges Required__ replaces Authentication, with different weights +-- depending on Scope. +-- * __User Interaction__ is a new metric (None\/Required). +-- * Impact values are High\/Low\/None instead of Complete\/Partial\/None. +-- * Rounding uses the \"Roundup\" function (ceiling to one decimal place). +module Security.CVSS.V30 + ( cvss30DB, + validateCvss30, + cvss30score, + cvss30BaseScore, + cvss30TemporalScore, + cvss30EnvironmentalScore, + ) +where + +import Data.Foldable (traverse_) +import GHC.Float (powerFloat) +import Security.CVSS.Internal +import Security.CVSS.Types + +-- | The complete CVSS v3.0 metric database. Each 'MetricValue' carries +-- the numeric weight specified by the standard (used in score computation) +-- and a human-readable description. +-- +-- Note: 'Privileges Required' has an optional second weight ('mvNumChangedScope') +-- that is used when Scope is Changed. +cvss30DB :: CVSSDB +cvss30DB = + CVSSDB + [ MetricGroup "Base" baseMetrics, + MetricGroup "Temporal" temporalMetrics, + MetricGroup "Environmental" environmentalMetrics + ] + where + baseMetrics = + [ MetricInfo + "Attack Vector" + "AV" + True + avValues, + MetricInfo + "Attack Complexity" + "AC" + True + acValues, + MetricInfo + "Privileges Required" + "PR" + True + prValues, + MetricInfo + "User Interaction" + "UI" + True + uiValues, + MetricInfo + "Scope" + "S" + True + sValues, + MetricInfo + "Confidentiality Impact" + "C" + True + cValues, + MetricInfo + "Integrity Impact" + "I" + True + iValues, + MetricInfo + "Availability Impact" + "A" + True + aValues + ] + avValues = + [ MetricValue "Network" (MetricValueChar "N") 0.85 Nothing "A vulnerability exploitable with network access means that the vulnerable component is bound to the network stack and the attacker's path is through OSI layer 3 (the network layer).", + MetricValue "Adjacent" (MetricValueChar "A") 0.62 Nothing "A vulnerability exploitable with adjacent network access means that the vulnerable component is bound to the network stack", + MetricValue "Local" (MetricValueChar "L") 0.55 Nothing "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.", + MetricValue "Physical" (MetricValueChar "P") 0.2 Nothing "A vulnerability exploitable with Physical access requires the attacker to physically touch or manipulate the vulnerable component." + ] + acValues = + [ MetricValue "Low" (MetricValueChar "L") 0.77 Nothing "Specialized access conditions or extenuating circumstances do not exist.", + MetricValue "High" (MetricValueChar "H") 0.44 Nothing "A successful attack depends on conditions beyond the attacker's control." + ] + prValues = + [ MetricValue "None" (MetricValueChar "N") 0.85 Nothing "The attacker is unauthorized prior to attack, and therefore does not require any access to settings or files to carry out an attack.", + MetricValue "Low" (MetricValueChar "L") 0.62 (Just 0.68) "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.", + MetricValue "High" (MetricValueChar "H") 0.27 (Just 0.5) "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." + ] + uiValues = + [ MetricValue "None" (MetricValueChar "N") 0.85 Nothing "The vulnerable system can be exploited without interaction from any user.", + MetricValue "Required" (MetricValueChar "R") 0.62 Nothing "Successful exploitation of this vulnerability requires a user to take some action before the vulnerability can be exploited." + ] + sValues = + [ MetricValue "unchanged" (MetricValueChar "U") unchanged Nothing "An exploited vulnerability can only affect resources managed by the same authority.", + MetricValue "changed" (MetricValueChar "C") changed Nothing "An exploited vulnerability can affect resources beyond the authorization privileges intended by the vulnerable component." + ] + cValues = + [ mkHigh "There is a total loss of confidentiality, resulting in all resources within the impacted component being divulged to the attacker.", + mkLow "There is some loss of confidentiality.", + mkNone "There is no loss of confidentiality within the impacted component." + ] + iValues = + [ mkHigh "There is a total loss of integrity, or a complete loss of protection.", + mkLow "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.", + mkNone "There is no loss of integrity within the impacted component." + ] + aValues = + [ mkHigh "There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the impacted component", + mkLow "Performance is reduced or there are interruptions in resource availability.", + mkNone "There is no impact to availability within the impacted component." + ] + mkHigh = MetricValue "High" (MetricValueChar "H") 0.56 Nothing + mkLow = MetricValue "Low" (MetricValueChar "L") 0.22 Nothing + mkNone = MetricValue "None" (MetricValueChar "N") 0 Nothing + temporalMetrics = + [ MetricInfo + "Exploit Code Maturity" + "E" + False + [ mkTemporalUndef "High", + MetricValue "High" (MetricValueChar "H") 1 Nothing "Functional autonomous code exists, or no exploit is required (manual trigger) and details are widely available. Exploit code works in every situation, or is actively being delivered via an autonomous agent (such as a worm or virus). Network-connected systems are likely to encounter scanning or exploitation attempts. Exploit development has reached the level of reliable, widely available, easy-to-use automated tools.", + MetricValue "Functional" (MetricValueChar "F") 0.97 Nothing "Functional exploit code is available. The code works in most situations where the vulnerability exists.", + MetricValue "Proof of Concept" (MetricValueChar "P") 0.94 Nothing "Proof-of-concept exploit code is available, or an attack demonstration is not practical for most systems. The code or technique is not functional in all situations and may require substantial modification by a skilled attacker.", + MetricValue "Unproven" (MetricValueChar "U") 0.91 Nothing "No exploit code is available, or an exploit is theoretical." + ], + MetricInfo + "Remediation Level" + "RL" + False + [ mkTemporalUndef "Unavailable", + MetricValue "Unavailable" (MetricValueChar "U") 1 Nothing "There is either no solution available or it is impossible to apply.", + MetricValue "Workaround" (MetricValueChar "W") 0.97 Nothing "There is an unofficial, non-vendor solution available. In some cases, users of the affected technology will create a patch of their own or provide steps to work around or otherwise mitigate the vulnerability.", + MetricValue "Temporary Fix" (MetricValueChar "T") 0.96 Nothing "There is an official but temporary fix available. This includes instances where the vendor issues a temporary hotfix, tool, or workaround.", + MetricValue "Official Fix" (MetricValueChar "O") 0.95 Nothing "A complete vendor solution is available. Either the vendor has issued an official patch, or an upgrade is available." + ], + MetricInfo + "Report Confidence" + "RC" + False + [ mkTemporalUndef "Confirmed", + MetricValue "Confirmed" (MetricValueChar "C") 1 Nothing "Detailed reports exist, or functional reproduction is possible (functional exploits may provide this). Source code is available to independently verify the assertions of the research, or the author or vendor of the affected code has confirmed the presence of the vulnerability.", + MetricValue "Reasonable" (MetricValueChar "R") 0.96 Nothing "Significant details are published, but researchers either do not have full confidence in the root cause, or do not have access to source code to fully confirm all of the interactions that may lead to the result. Reasonable confidence exists, however, that the bug is reproducible and at least one impact is able to be verified (proof-of-concept exploits may provide this). An example is a detailed write-up of research into a vulnerability with an explanation (possibly obfuscated or \"left as an exercise to the reader\") that gives assurances on how to reproduce the results.", + MetricValue "Unknown" (MetricValueChar "U") 0.92 Nothing "There are reports of impacts that indicate a vulnerability is present. The reports indicate that the cause of the vulnerability is unknown, or reports may differ on the cause or impacts of the vulnerability. Reporters are uncertain of the true nature of the vulnerability, and there is little confidence in the validity of the reports or whether a static Base Score can be applied given the differences described. An example is a bug report which notes that an intermittent but non-reproducible crash occurs, with evidence of memory corruption suggesting that denial of service, or possible more serious impacts, may result." + ] + ] + mkTemporalUndef m = MetricValue "Not Defined" (MetricValueChar "X") 1 Nothing $ mkTemporalUndefMsg m + mkTemporalUndefMsg m = "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Temporal Score, i.e., it has the same effect on scoring as assigning " <> m <> "." + environmentalMetrics = + [ MetricInfo + "Confidentiality Requirement" + "CR" + False + [ mkEnvUndef, + mkEnvHigh "Confidentiality", + mkEnvMedium "Confidentiality", + mkEnvLow "Confidentiality" + ], + MetricInfo + "Integrity Requirement" + "IR" + False + [ mkEnvUndef, + mkEnvHigh "Integrity", + mkEnvMedium "Integrity", + mkEnvLow "Integrity" + ], + MetricInfo + "Availability Requirement" + "AR" + False + [ mkEnvUndef, + mkEnvHigh "Availability", + mkEnvMedium "Availability", + mkEnvLow "Availability" + ], + MetricInfo "Modified Attack Vector" "MAV" False $ mkModifiedUndef : avValues, + MetricInfo "Modified Attack Complexity" "MAC" False $ mkModifiedUndef : acValues, + MetricInfo "Modified Privileges Required" "MPR" False $ mkModifiedUndef : prValues, + MetricInfo "Modified User Interaction" "MUI" False $ mkModifiedUndef : uiValues, + MetricInfo "Modified Scope" "MS" False $ mkModifiedUndef : sValues, + MetricInfo "Modified Confidentiality" "MC" False $ mkModifiedUndef : cValues, + MetricInfo "Modified Integrity" "MI" False $ mkModifiedUndef : iValues, + MetricInfo "Modified Availability" "MA" False $ mkModifiedUndef : aValues + ] + mkEnvUndef = MetricValue "Not Defined" (MetricValueChar "X") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Environmental Score, i.e., it has the same effect on scoring as assigning Medium." + mkEnvHighMsg m = "Loss of " <> m <> " is likely to have a catastrophic adverse effect on the organization or individuals associated with the organization (e.g., employees, customers)." + mkEnvHigh m = MetricValue "High" (MetricValueChar "H") 1.5 Nothing $ mkEnvHighMsg m + mkEnvMediumMsg m = "Loss of " <> m <> " is likely to have a serious adverse effect on the organization or individuals associated with the organization (e.g., employees, customers)." + mkEnvMedium m = MetricValue "Medium" (MetricValueChar "M") 1 Nothing $ mkEnvMediumMsg m + mkEnvLowMsg m = "Loss of " <> m <> " is likely to have only a limited adverse effect on the organization or individuals associated with the organization (e.g., employees, customers)." + mkEnvLow m = MetricValue "Low" (MetricValueChar "L") 0.5 Nothing $ mkEnvLowMsg m + mkModifiedUndef = MetricValue "Not Defined" (MetricValueChar "X") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Score" + +-- | Validate a list of CVSS v3.0 metrics, checking that: +-- +-- * No metric appears more than once. +-- * All metrics are recognized for v3.0. +-- * All required (Base) metrics are present. +validateCvss30 :: [Metric] -> Either CVSSError () +validateCvss30 metrics = do + traverse_ (\t -> t metrics) [validateUnique, validateKnown cvss30DB, validateRequired cvss30DB] + +-- | Compute the CVSS v3.0 Base Score. +-- +-- Per the specification: +-- +-- @ +-- ISCbase = 1 − (1−ConfImpact) × (1−IntegImpact) × (1−AvailImpact) +-- Impact = 6.42 × ISCbase , if Scope = Unchanged +-- Impact = 7.52 × [ISCbase−0.029] − 3.25 × [ISCbase−0.02]^15, if Scope = Changed +-- Exploitability = 8.22 × AttackVector × AttackComplexity × PrivilegesRequired × UserInteraction +-- BaseScore = Roundup(min(Impact + Exploitability, 10)) , if Scope = Unchanged +-- BaseScore = Roundup(min(1.08 × (Impact + Exploitability), 10)), if Scope = Changed +-- @ +-- +-- If Impact ≤ 0 the score is 0. +cvss30BaseScore :: [Metric] -> (Rating, Float) +cvss30BaseScore metrics = (toRating score, score) + where + score + | impact <= 0 = 0 + | scope == unchanged = roundup (min (impact + exploitability) 10) + | otherwise = roundup (min (1.08 * (impact + exploitability)) 10) + impact + | scope == unchanged = scope * iscBase + | otherwise = scope * (iscBase - 0.029) - 3.25 * powerFloat (iscBase - 0.02) 15 + iscBase = 1 - (1 - gm "Confidentiality Impact") * (1 - gm "Integrity Impact") * (1 - gm "Availability Impact") + scope = gm "Scope" + + exploitability = 8.22 * gm "Attack Vector" * gm "Attack Complexity" * gm "Privileges Required" * gm "User Interaction" + gm = getMetricValue cvss30DB metrics scope + +-- | Compute the CVSS v3.0 score for the given metrics. +-- Returns the environmental score if environmental metrics are present, +-- the temporal score if temporal metrics are present, or the base score otherwise. +cvss30score :: [Metric] -> (Rating, Float) +cvss30score metrics + | hasEnvironmentalMetrics metrics = cvss30EnvironmentalScore metrics + | hasTemporalMetrics metrics = cvss30TemporalScore metrics + | otherwise = cvss30BaseScore metrics + +-- | Compute the CVSS v3.0 Temporal Score. +-- +-- @ +-- TemporalScore = Roundup(BaseScore × ExploitCodeMaturity × RemediationLevel × ReportConfidence) +-- @ +-- +-- Optional metrics default to 1.0 (no effect) when absent or \"Not Defined\" (X). +cvss30TemporalScore :: [Metric] -> (Rating, Float) +cvss30TemporalScore metrics = (toRating score, score) + where + (_, baseScore) = cvss30BaseScore metrics + exploitCodeMaturity = getMetricValueOr cvss30DB metrics 1.0 unchanged "Exploit Code Maturity" + remediationLevel = getMetricValueOr cvss30DB metrics 1.0 unchanged "Remediation Level" + reportConfidence = getMetricValueOr cvss30DB metrics 1.0 unchanged "Report Confidence" + score = roundup (baseScore * exploitCodeMaturity * remediationLevel * reportConfidence) + +-- | Compute the CVSS v3.0 Environmental Score. +-- +-- Per the specification: +-- +-- @ +-- MISS = min(1 − (1−ConfReq×ModifiedConf) × (1−IntegReq×ModifiedInteg) × (1−AvailReq×ModifiedAvail), 0.915) +-- ModifiedImpact = 6.42 × MISS , if ModifiedScope = Unchanged +-- ModifiedImpact = 7.52 × (MISS−0.029) − 3.25 × (MISS−0.02)^15 , if ModifiedScope = Changed +-- ModifiedExploitability = 8.22 × ModifiedAV × ModifiedAC × ModifiedPR × ModifiedUI +-- EnvScoreHelper = Roundup(min(ModifiedImpact + ModifiedExploitability, 10)) , if ModifiedScope = Unchanged +-- EnvScoreHelper = Roundup(min(1.08 × (ModifiedImpact + ModifiedExploitability), 10)) , if ModifiedScope = Changed +-- EnvironmentalScore = Roundup(EnvScoreHelper × ExploitCodeMaturity × RemediationLevel × ReportConfidence) +-- @ +-- +-- If ModifiedImpact ≤ 0 the score is 0. +cvss30EnvironmentalScore :: [Metric] -> (Rating, Float) +cvss30EnvironmentalScore metrics = (toRating score, score) + where + miss = + min + ( 1 + - (1 - confidentialityRequirement * modifiedConfidentiality) + * (1 - integrityRequirement * modifiedIntegrity) + * (1 - availabilityRequirement * modifiedAvailability) + ) + 0.915 + + modifiedImpact + | modifiedScope == unchanged = 6.42 * miss + | otherwise = 7.52 * (miss - 0.029) - 3.25 * powerFloat (miss - 0.02) 15 + + modifiedExploitability = + 8.22 + * modifiedAttackVector + * modifiedAttackComplexity + * modifiedPrivilegesRequired + * modifiedUserInteraction + + envScoreHelper + | modifiedImpact <= 0 = 0 + | modifiedScope == unchanged = + roundup (min (modifiedImpact + modifiedExploitability) 10) + | otherwise = + roundup (min (1.08 * (modifiedImpact + modifiedExploitability)) 10) + + score + | modifiedImpact <= 0 = 0 + | otherwise = + roundup + ( envScoreHelper + * exploitCodeMaturity + * remediationLevel + * reportConfidence + ) + + exploitCodeMaturity = getMetricValueOr cvss30DB metrics 1.0 unchanged "Exploit Code Maturity" + remediationLevel = getMetricValueOr cvss30DB metrics 1.0 unchanged "Remediation Level" + reportConfidence = getMetricValueOr cvss30DB metrics 1.0 unchanged "Report Confidence" + confidentialityRequirement = getMetricValueOr cvss30DB metrics 1.0 unchanged "Confidentiality Requirement" + integrityRequirement = getMetricValueOr cvss30DB metrics 1.0 unchanged "Integrity Requirement" + availabilityRequirement = getMetricValueOr cvss30DB metrics 1.0 unchanged "Availability Requirement" + modifiedAttackVector = getModifiedMetricValue cvss30DB metrics "Modified Attack Vector" "Attack Vector" modifiedScope + modifiedAttackComplexity = getModifiedMetricValue cvss30DB metrics "Modified Attack Complexity" "Attack Complexity" modifiedScope + modifiedPrivilegesRequired = getModifiedMetricValue cvss30DB metrics "Modified Privileges Required" "Privileges Required" modifiedScope + modifiedUserInteraction = getModifiedMetricValue cvss30DB metrics "Modified User Interaction" "User Interaction" modifiedScope + modifiedScope = getModifiedMetricValue cvss30DB metrics "Modified Scope" "Scope" unchanged + modifiedConfidentiality = getModifiedMetricValue cvss30DB metrics "Modified Confidentiality" "Confidentiality Impact" modifiedScope + modifiedIntegrity = getModifiedMetricValue cvss30DB metrics "Modified Integrity" "Integrity Impact" modifiedScope + modifiedAvailability = getModifiedMetricValue cvss30DB metrics "Modified Availability" "Availability Impact" modifiedScope diff --git a/src/Security/CVSS/V31.hs b/src/Security/CVSS/V31.hs new file mode 100644 --- /dev/null +++ b/src/Security/CVSS/V31.hs @@ -0,0 +1,406 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Security.CVSS.V31 +-- Description : CVSS v3.1 scoring implementation +-- +-- Implements CVSS v3.1 scoring as defined by FIRST. +-- +-- Specification: https:\/\/www.first.org\/cvss\/v3-1\/ +-- +-- CVSS v3.1 vector strings use the @CVSS:3.1\/@ prefix. +-- +-- Key differences from v3.0 include: +-- +-- * Adjusted weights for __Privileges Required__ when Scope is Changed +-- (the \"changed scope\" override values in 'mvNumChangedScope'). +-- * Refined __Attack Complexity__ and __User Interaction__ descriptions. +-- * \"Not Defined\" for temporal\/environmental metrics uses @X@ instead of @ND@. +-- * The \"Roundup\" function is clarified to always round up to one decimal. +module Security.CVSS.V31 + ( cvss31DB, + validateCvss31, + cvss31score, + cvss31BaseScore, + cvss31TemporalScore, + cvss31EnvironmentalScore, + ) +where + +import Data.Foldable (traverse_) +import Data.Text (Text) +import GHC.Float (powerFloat) +import Security.CVSS.Internal +import Security.CVSS.Types + +-- | The complete CVSS v3.1 metric database. Each 'MetricValue' carries +-- the numeric weight specified by the standard (used in score computation) +-- and a human-readable description. +-- +-- Note: 'Privileges Required' has an optional second weight ('mvNumChangedScope') +-- that is used when Scope is Changed. +cvss31DB :: CVSSDB +cvss31DB = + CVSSDB + [ MetricGroup "Base" baseMetrics, + MetricGroup "Temporal" temporalMetrics, + MetricGroup "Environmental" environmentalMetrics + ] + where + baseMetrics = + [ MetricInfo + "Attack Vector" + "AV" + True + avValues, + MetricInfo + "Attack Complexity" + "AC" + True + acValues, + MetricInfo + "Privileges Required" + "PR" + True + prValues, + MetricInfo + "User Interaction" + "UI" + True + uiValues, + MetricInfo + "Scope" + "S" + True + sValues, + MetricInfo + "Confidentiality Impact" + "C" + True + cValues, + MetricInfo + "Integrity Impact" + "I" + True + iValues, + MetricInfo + "Availability Impact" + "A" + True + aValues + ] + avValues = + [ MetricValue "Network" (MetricValueChar "N") 0.85 Nothing "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.", + MetricValue "Adjacent" (MetricValueChar "A") 0.62 Nothing "The vulnerable component is bound to the network stack, but the attack is limited at the protocol level to a logically adjacent topology.", + MetricValue "Local" (MetricValueChar "L") 0.55 Nothing "The vulnerable component is not bound to the network stack and the attacker's path is via read/write/execute capabilities.", + MetricValue "Physical" (MetricValueChar "P") 0.2 Nothing "The attack requires the attacker to physically touch or manipulate the vulnerable component." + ] + acValues = + [ MetricValue "Low" (MetricValueChar "L") 0.77 Nothing "Specialized access conditions or extenuating circumstances do not exist.", + MetricValue "High" (MetricValueChar "H") 0.44 Nothing "A successful attack depends on conditions beyond the attacker's control." + ] + prValues = + [ MetricValue "None" (MetricValueChar "N") 0.85 Nothing "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.", + MetricValue "Low" (MetricValueChar "L") 0.62 (Just 0.68) "The attacker requires privileges that provide basic user capabilities that could normally affect only settings and files owned by a user.", + MetricValue "High" (MetricValueChar "H") 0.27 (Just 0.5) "The attacker requires privileges that provide significant (e.g., administrative) control over the vulnerable component allowing access to component-wide settings and files." + ] + uiValues = + [ MetricValue "None" (MetricValueChar "N") 0.85 Nothing "The vulnerable system can be exploited without interaction from any user.", + MetricValue "Required" (MetricValueChar "R") 0.62 Nothing "Successful exploitation of this vulnerability requires a user to take some action before the vulnerability can be exploited." + ] + sValues = + [ MetricValue "Unchanged" (MetricValueChar "U") unchanged Nothing "An exploited vulnerability can only affect resources managed by the same security authority.", + MetricValue "Changed" (MetricValueChar "C") changed Nothing "An exploited vulnerability can affect resources beyond the security scope managed by the security authority of the vulnerable component." + ] + cValues = + [ mkHigh "There is a total loss of confidentiality, resulting in all resources within the impacted component being divulged to the attacker.", + mkLow "There is some loss of confidentiality.", + mkNone "There is no loss of confidentiality within the impacted component." + ] + iValues = + [ mkHigh "There is a total loss of integrity, or a complete loss of protection.", + mkLow "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.", + mkNone "There is no loss of integrity within the impacted component." + ] + aValues = + [ mkHigh "There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the impacted component", + mkLow "Performance is reduced or there are interruptions in resource availability.", + mkNone "There is no impact to availability within the impacted component." + ] + mkHigh = MetricValue "High" (MetricValueChar "H") 0.56 Nothing + mkLow = MetricValue "Low" (MetricValueChar "L") 0.22 Nothing + mkNone = MetricValue "None" (MetricValueChar "N") 0 Nothing + temporalMetrics = + [ MetricInfo + "Exploit Code Maturity" + "E" + False + [ mkTemporalUndef "High", + MetricValue "High" (MetricValueChar "H") 1 Nothing "Functional autonomous code exists, or no exploit is required (manual trigger) and details are widely available. Exploit code works in every situation, or is actively being delivered via an autonomous agent (such as a worm or virus). Network-connected systems are likely to encounter scanning or exploitation attempts. Exploit development has reached the level of reliable, widely available, easy-to-use automated tools.", + MetricValue "Functional" (MetricValueChar "F") 0.97 Nothing "Functional exploit code is available. The code works in most situations where the vulnerability exists.", + MetricValue "Proof of Concept" (MetricValueChar "P") 0.94 Nothing "Proof-of-concept exploit code is available, or an attack demonstration is not practical for most systems. The code or technique is not functional in all situations and may require substantial modification by a skilled attacker.", + MetricValue "Unproven" (MetricValueChar "U") 0.91 Nothing "No exploit code is available, or an exploit is theoretical." + ], + MetricInfo + "Remediation Level" + "RL" + False + [ mkTemporalUndef "Unavailable", + MetricValue "Unavailable" (MetricValueChar "U") 1 Nothing "There is either no solution available or it is impossible to apply.", + MetricValue "Workaround" (MetricValueChar "W") 0.97 Nothing "There is an unofficial, non-vendor solution available. In some cases, users of the affected technology will create a patch of their own or provide steps to work around or otherwise mitigate the vulnerability.", + MetricValue "Temporary Fix" (MetricValueChar "T") 0.96 Nothing "There is an official but temporary fix available. This includes instances where the vendor issues a temporary hotfix, tool, or workaround.", + MetricValue "Official Fix" (MetricValueChar "O") 0.95 Nothing "A complete vendor solution is available. Either the vendor has issued an official patch, or an upgrade is available." + ], + MetricInfo + "Report Confidence" + "RC" + False + [ mkTemporalUndef "Confirmed", + MetricValue "Confirmed" (MetricValueChar "C") 1 Nothing "Detailed reports exist, or functional reproduction is possible (functional exploits may provide this). Source code is available to independently verify the assertions of the research, or the author or vendor of the affected code has confirmed the presence of the vulnerability.", + MetricValue "Reasonable" (MetricValueChar "R") 0.96 Nothing "Significant details are published, but researchers either do not have full confidence in the root cause, or do not have access to source code to fully confirm all of the interactions that may lead to the result. Reasonable confidence exists, however, that the bug is reproducible and at least one impact is able to be verified (proof-of-concept exploits may provide this). An example is a detailed write-up of research into a vulnerability with an explanation (possibly obfuscated or \"left as an exercise to the reader\") that gives assurances on how to reproduce the results.", + MetricValue "Unknown" (MetricValueChar "U") 0.92 Nothing "There are reports of impacts that indicate a vulnerability is present. The reports indicate that the cause of the vulnerability is unknown, or reports may differ on the cause or impacts of the vulnerability. Reporters are uncertain of the true nature of the vulnerability, and there is little confidence in the validity of the reports or whether a static Base Score can be applied given the differences described. An example is a bug report which notes that an intermittent but non-reproducible crash occurs, with evidence of memory corruption suggesting that denial of service, or possible more serious impacts, may result." + ] + ] + mkTemporalUndef m = MetricValue "Not Defined" (MetricValueChar "X") 1 Nothing $ mkTemporalUndefMsg m + mkTemporalUndefMsg m = "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Temporal Score, i.e., it has the same effect on scoring as assigning " <> m <> "." + environmentalMetrics = + [ MetricInfo + "Confidentiality Requirement" + "CR" + False + [ mkEnvUndef, + mkEnvHigh "Confidentiality", + mkEnvMedium "Confidentiality", + mkEnvLow "Confidentiality" + ], + MetricInfo + "Integrity Requirement" + "IR" + False + [ mkEnvUndef, + mkEnvHigh "Integrity", + mkEnvMedium "Integrity", + mkEnvLow "Integrity" + ], + MetricInfo + "Availability Requirement" + "AR" + False + [ mkEnvUndef, + mkEnvHigh "Availability", + mkEnvMedium "Availability", + mkEnvLow "Availability" + ], + -- Modified Base Metric - the same values as the corresponding Base Metric as well as Not Defined (the default). + MetricInfo "Modified Attack Vector" "MAV" False $ mkModifiedUndef : avValues, + MetricInfo "Modified Attack Complexity" "MAC" False $ mkModifiedUndef : acValues, + MetricInfo "Modified Privileges Required" "MPR" False $ mkModifiedUndef : prValues, + MetricInfo "Modified User Interaction" "MUI" False $ mkModifiedUndef : uiValues, + MetricInfo "Modified Scope" "MS" False $ mkModifiedUndef : sValues, + MetricInfo "Modified Confidentiality" "MC" False $ mkModifiedUndef : cValues, + MetricInfo "Modified Integrity" "MI" False $ mkModifiedUndef : iValues, + MetricInfo "Modified Availability" "MA" False $ mkModifiedUndef : aValues + ] + mkEnvUndef = MetricValue "Not Defined" (MetricValueChar "X") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Environmental Score, i.e., it has the same effect on scoring as assigning Medium." + mkEnvHighMsg m = "Loss of " <> m <> " is likely to have a catastrophic adverse effect on the organization or individuals associated with the organization (e.g., employees, customers)." + mkEnvHigh m = MetricValue "High" (MetricValueChar "H") 1.5 Nothing $ mkEnvHighMsg m + mkEnvMediumMsg m = "Loss of " <> m <> " is likely to have a serious adverse effect on the organization or individuals associated with the organization (e.g., employees, customers)." + mkEnvMedium m = MetricValue "Medium" (MetricValueChar "M") 1 Nothing $ mkEnvMediumMsg m + mkEnvLowMsg m = "Loss of " <> m <> " is likely to have only a limited adverse effect on the organization or individuals associated with the organization (e.g., employees, customers)." + mkEnvLow m = MetricValue "Low" (MetricValueChar "L") 0.5 Nothing $ mkEnvLowMsg m + mkModifiedUndef = MetricValue "Not Defined" (MetricValueChar "X") 1 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Score" -- Not Defined (X): mvNum is ignored in scoring; getModifiedMetricValue substitutes the base metric value + +-- | Validate a list of CVSS v3.1 metrics, checking that: +-- +-- * No metric appears more than once. +-- * All metrics are recognized for v3.1. +-- * All required (Base) metrics are present. +validateCvss31 :: [Metric] -> Either CVSSError () +validateCvss31 metrics = do + traverse_ (\t -> t metrics) [validateUnique, validateKnown cvss31DB, validateRequired cvss31DB] + +-- | Compute the CVSS v3.1 score for the given metrics. +-- Returns the environmental score if environmental metrics are present, +-- the temporal score if temporal metrics are present, or the base score otherwise. +cvss31score :: [Metric] -> (Rating, Float) +cvss31score metrics + | hasEnvironmentalMetrics metrics = cvss31EnvironmentalScore metrics + | hasTemporalMetrics metrics = cvss31TemporalScore metrics + | otherwise = cvss31BaseScore metrics + +-- | Compute the CVSS v3.1 Base Score. +-- +-- Per the specification (Section 7.1): +-- +-- @ +-- ISS = 1 − (1−ConfImpact) × (1−IntegImpact) × (1−AvailImpact) +-- Impact = 6.42 × ISS , if Scope = Unchanged +-- Impact = 7.52 × (ISS−0.029) − 3.25 × (ISS−0.02)^15 , if Scope = Changed +-- Exploitability = 8.22 × AttackVector × AttackComplexity × PrivilegesRequired × UserInteraction +-- BaseScore = Roundup(min(Impact + Exploitability, 10)) , if Scope = Unchanged +-- BaseScore = Roundup(min(1.08 × (Impact + Exploitability), 10)), if Scope = Changed +-- @ +-- +-- If Impact ≤ 0 the score is 0. +cvss31BaseScore :: [Metric] -> (Rating, Float) +cvss31BaseScore metrics = (toRating score, score) + where + iss = 1 - (1 - gm "Confidentiality Impact") * (1 - gm "Integrity Impact") * (1 - gm "Availability Impact") + impact + | scope == unchanged = scope * iss + | otherwise = 7.52 * (iss - 0.029) - 3.25 * powerFloat (iss - 0.02) 15 + exploitability = 8.22 * gm "Attack Vector" * gm "Attack Complexity" * gm "Privileges Required" * gm "User Interaction" + score + | impact <= 0 = 0 + | scope == unchanged = roundup (min (impact + exploitability) 10) + | otherwise = roundup (min (1.08 * (impact + exploitability)) 10) + scope = gm "Scope" + + gm :: Text -> Float + gm = getMetricValue cvss31DB metrics scope + +-- | Compute the CVSS v3.1 Temporal Score. +-- +-- @ +-- TemporalScore = Roundup(BaseScore × ExploitCodeMaturity × RemediationLevel × ReportConfidence) +-- @ +-- +-- Optional metrics default to 1.0 (no effect) when absent or \"Not Defined\" (X). +cvss31TemporalScore :: [Metric] -> (Rating, Float) +cvss31TemporalScore metrics = (toRating score, score) + where + (_, baseScore) = cvss31BaseScore metrics + exploitCodeMaturity = optionalMetric metrics 1.0 "Exploit Code Maturity" + remediationLevel = optionalMetric metrics 1.0 "Remediation Level" + reportConfidence = optionalMetric metrics 1.0 "Report Confidence" + score = roundup (baseScore * exploitCodeMaturity * remediationLevel * reportConfidence) + +-- | Look up an optional (temporal) metric value, returning the default +-- when the metric is absent. +optionalMetric :: [Metric] -> Float -> Text -> Float +optionalMetric metrics defaultValue = + getMetricValueOr cvss31DB metrics defaultValue unchanged + +-- | Check whether a specific metric is absent or set to \"Not Defined\" (X). +isMetricND :: [Metric] -> Text -> Bool +isMetricND metrics name = + case lookupMetricValueChar cvss31DB metrics name of + Nothing -> True + Just (MetricValueChar "X") -> True + _ -> False + +-- | Returns 'True' when all environmental metrics (requirements + modified base metrics) +-- are absent or set to \"Not Defined\" (X). In this case the environmental score +-- degenerates to the temporal score. +allEnvMetricsND :: [Metric] -> Bool +allEnvMetricsND metrics = + all (isMetricND metrics) envMetricNames + where + envMetricNames = + [ "Confidentiality Requirement", + "Integrity Requirement", + "Availability Requirement", + "Modified Attack Vector", + "Modified Attack Complexity", + "Modified Privileges Required", + "Modified User Interaction", + "Modified Scope", + "Modified Confidentiality", + "Modified Integrity", + "Modified Availability" + ] + +-- | Compute the CVSS v3.1 Environmental Score. +-- +-- Per the specification (Section 7.3): +-- +-- @ +-- MISS = min(1 − (1−ConfReq×ModifiedConf) × (1−IntegReq×ModifiedInteg) × (1−AvailReq×ModifiedAvail), 0.915) +-- ModifiedImpact = 6.42 × MISS , if ModifiedScope = Unchanged +-- ModifiedImpact = 7.52 × (MISS−0.029) − 3.25 × (MISS × 0.9731 − 0.02)^13 , if ModifiedScope = Changed +-- ModifiedExploitability = 8.22 × ModifiedAV × ModifiedAC × ModifiedPR × ModifiedUI +-- @ +-- +-- If all environmental metrics are \"Not Defined\", this falls back to 'cvss31TemporalScore'. +-- +-- Note the v3.1 spec uses @0.9731@ and exponent @13@ in the Changed scope formula, +-- differing slightly from the v3.0 formula. +cvss31EnvironmentalScore :: [Metric] -> (Rating, Float) +cvss31EnvironmentalScore metrics + | allEnvMetricsND metrics = cvss31TemporalScore metrics + | otherwise = (toRating score, score) + where + {- MISS = Minimum ( + 1 - [(1 - ConfidentialityRequirement × ModifiedConfidentiality) + × (1 - IntegrityRequirement × ModifiedIntegrity) + × (1 - AvailabilityRequirement × ModifiedAvailability) ], 0.915) + -} + miss = + min + ( 1 + - (1 - confidentialityRequirement * modifiedConfidentiality) + * (1 - integrityRequirement * modifiedIntegrity) + * (1 - availabilityRequirement * modifiedAvailability) + ) + 0.915 + {- + ModifiedImpact = + If ModifiedScope is unchanged 6.42 × MISS + If ModifiedScope is changed 7.52 × (MISS - 0.029) - 3.25 × (MISS × 0.9731 - 0.02)^13 + -} + modifiedImpact + | modifiedScope == unchanged = 6.42 * miss + | otherwise = 7.52 * (miss - 0.029) - 3.25 * powerFloat (miss * 0.9731 - 0.02) 13 + + {- + ModifiedExploitability = 8.22 × ModifiedAttackVector × ModifiedAttackComplexity + × ModifiedPrivilegesRequired × ModifiedUserInteraction + -} + modifiedExploitability = + 8.22 + * modifiedAttackVector + * modifiedAttackComplexity + * modifiedPrivilegesRequired + * modifiedUserInteraction + + {- + EnvironmentalScore = + If ModifiedImpact \<= 0 0, else + If ModifiedScope is Unchanged + Roundup ( Roundup [Minimum ([ModifiedImpact + ModifiedExploitability], 10) ] + × ExploitCodeMaturity × RemediationLevel × ReportConfidence) + If ModifiedScope is Changed + Roundup ( Roundup [Minimum (1.08 × [ModifiedImpact + ModifiedExploitability], 10) ] + × ExploitCodeMaturity × RemediationLevel × ReportConfidence) + -} + envScoreHelper + | modifiedImpact <= 0 = 0 + | modifiedScope == unchanged = + roundup (min (modifiedImpact + modifiedExploitability) 10) + | otherwise = + roundup (min (1.08 * (modifiedImpact + modifiedExploitability)) 10) + + score + | modifiedImpact <= 0 = 0 + | otherwise = + roundup + ( envScoreHelper + * exploitCodeMaturity + * remediationLevel + * reportConfidence + ) + + exploitCodeMaturity = optionalMetric metrics 1.0 "Exploit Code Maturity" + remediationLevel = optionalMetric metrics 1.0 "Remediation Level" + reportConfidence = optionalMetric metrics 1.0 "Report Confidence" + confidentialityRequirement = optionalMetric metrics 1.0 "Confidentiality Requirement" + integrityRequirement = optionalMetric metrics 1.0 "Integrity Requirement" + availabilityRequirement = optionalMetric metrics 1.0 "Availability Requirement" + modifiedAttackVector = getModifiedMetricValue cvss31DB metrics "Modified Attack Vector" "Attack Vector" modifiedScope + modifiedAttackComplexity = getModifiedMetricValue cvss31DB metrics "Modified Attack Complexity" "Attack Complexity" modifiedScope + modifiedPrivilegesRequired = getModifiedMetricValue cvss31DB metrics "Modified Privileges Required" "Privileges Required" modifiedScope + modifiedUserInteraction = getModifiedMetricValue cvss31DB metrics "Modified User Interaction" "User Interaction" modifiedScope + modifiedScope = getModifiedMetricValue cvss31DB metrics "Modified Scope" "Scope" unchanged + modifiedConfidentiality = getModifiedMetricValue cvss31DB metrics "Modified Confidentiality" "Confidentiality Impact" modifiedScope + modifiedIntegrity = getModifiedMetricValue cvss31DB metrics "Modified Integrity" "Integrity Impact" modifiedScope + modifiedAvailability = getModifiedMetricValue cvss31DB metrics "Modified Availability" "Availability Impact" modifiedScope diff --git a/src/Security/CVSS/V40.hs b/src/Security/CVSS/V40.hs new file mode 100644 --- /dev/null +++ b/src/Security/CVSS/V40.hs @@ -0,0 +1,1544 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Module : Security.CVSS.V40 +-- Description : CVSS v4.0 implementation targeting specification revision v4.0-r1.2 +-- +-- Implements CVSS v4.0 scoring per the FIRST specification (Document Version 1.2). +-- +-- Specification: https:\/\/www.first.org\/cvss\/v4.0\/specification-document +-- Reference implementation: https:\/\/github.com\/RedHatProductSecurity\/cvss-v4-calculator +-- +-- CVSS v4.0 uses a fundamentally different scoring approach from v2.x and v3.x. +-- Instead of a multiplicative formula, it uses a __macrovector lookup table__ +-- combined with __severity distance__ calculations. +-- +-- The scoring algorithm: +-- +-- 1. Classify each metric into an __Equivalence Level__ (EQ0–EQ2) across six +-- equivalence groups (EQ1–EQ6). +-- 2. Combine these into a __MacroVector@ (six EQ levels). +-- 3. Look up a __base score@ from the macrovector lookup table. +-- 4. Compute __severity distances@ between the current metric values and the +-- \"maximum\" values for each EQ level. +-- 5. For each EQ group, calculate a __score reduction@ proportional to the +-- severity distance and the available score gap to the next EQ level. +-- 6. Subtract the __mean@ of all valid reductions from the looked-up score. +-- +-- Metric groups in v4.0: +-- +-- * __Base__ — 11 required metrics (includes Attack Requirements and separate +-- Vulnerable System \/ Subsequent System impacts). +-- * __Threat__ — Exploit Maturity (replaces Temporal). +-- * __Environmental__ — Security Requirements + Modified Base Metrics. +-- * __Supplemental__ — informational metrics that do not affect scoring +-- (Safety, Automatable, Recovery, Value Density, Vulnerability Response Effort, +-- Provider Urgency). +module Security.CVSS.V40 + ( cvss40DB, + validateCvss40, + cvss40score, + cvss40BaseScore, + cvss40ThreatScore, + cvss40EnvironmentalScore, + hasThreatMetrics40, + hasEnvironmentalMetrics40, + getSupplementalMetrics, + hasSupplementalMetrics, + cvss40SupplementalInfo, + getSupplementalValue, + parseSupplementalValue, + ) +where + +import Data.Coerce (coerce) +import Data.Foldable (traverse_) +import Data.List (find) +import Data.Map qualified as Map +import Data.Maybe (catMaybes) +import Data.Text (Text) +import Data.Text qualified as Text +import Security.CVSS.Internal +import Security.CVSS.Types + +-- | Equivalence level used in the macrovector system. EQ0 represents the +-- most severe configuration within a group; EQ2 represents the least. +data EQLevel = EQ0 | EQ1 | EQ2 + deriving (Eq, Ord, Show, Enum, Bounded) + +-- | A macrovector is a tuple of six EQ levels (EQ1–EQ6) that uniquely +-- identifies a score in the lookup table. +data MacroVector = MacroVector + { mvEQ1 :: EQLevel, + mvEQ2 :: EQLevel, + mvEQ3 :: EQLevel, + mvEQ4 :: EQLevel, + mvEQ5 :: EQLevel, + mvEQ6 :: EQLevel + } + deriving (Eq, Ord, Show) + +-- | A newtype wrapper around 'Float' representing a severity distance. +-- Lower values indicate more severe configurations. +newtype Severity = Severity Float + deriving newtype (Eq, Ord, Num, Fractional, Real, RealFrac) + +instance Show Severity where + show (Severity f) = show f + +-- | Result of computing EQ1: Exploitability metrics (AV, PR, UI). +-- EQ1 classifies the ease of exploitation: +-- EQ0 = AV:Network AND PR:None AND UI:None +-- EQ1 = one of {AV:Network, PR:None, UI:None} but not all three, and AV != Physical +-- EQ2 = AV:Physical OR none of {AV:Network, PR:None, UI:None} +data EQ1Result = EQ1Result + { eq1Level :: EQLevel, + eq1AV :: Severity, + eq1PR :: Severity, + eq1UI :: Severity + } + deriving (Eq, Show) + +-- | Result of computing EQ2: Complexity bypass metrics (AC, AT). +-- EQ2 classifies attack complexity: +-- EQ0 = AC:Low AND AT:Absent +-- EQ1 = all other combinations +data EQ2Result = EQ2Result + { eq2Level :: EQLevel, + eq2AC :: Severity, + eq2AT :: Severity + } + deriving (Eq, Show) + +-- | Result of computing EQ3: Vulnerable system impact (VC, VI, VA). +-- EQ3 classifies impact to the vulnerable system: +-- EQ0 = VC:High AND VI:High +-- EQ1 = at least one of VC/VI/VA is High (but not both VC and VI High) +-- EQ2 = none of VC/VI/VA is High +data EQ3Result = EQ3Result + { eq3Level :: EQLevel, + eq3VC :: Severity, + eq3VI :: Severity, + eq3VA :: Severity + } + deriving (Eq, Show) + +-- | Result of computing EQ4: Subsequent system impact (SC, SI, SA). +-- EQ4 classifies impact to subsequent systems: +-- EQ0 = SI:Safety OR SA:Safety +-- EQ1 = at least one of SC/SI/SA is High (but no Safety) +-- EQ2 = none of SC/SI/SA is High (and no Safety) +data EQ4Result = EQ4Result + { eq4Level :: EQLevel, + eq4SC :: Severity, + eq4SI :: Severity, + eq4SA :: Severity + } + deriving (Eq, Show) + +-- | Result of computing EQ5: Exploit maturity (E). +-- EQ5 classifies exploit maturity: +-- EQ0 = Attacked +-- EQ1 = Proof of Concept +-- EQ2 = Unreported +data EQ5Result = EQ5Result + { eq5Level :: EQLevel, + eq5E :: Severity + } + deriving (Eq, Show) + +-- | Result of computing EQ6: Security requirements (CR, IR, AR). +-- EQ6 classifies the environment's security requirements: +-- EQ0 = any high requirement matches a zero-impact metric +-- (e.g. CR:High AND VC:None) +-- EQ1 = all other cases +data EQ6Result = EQ6Result + { eq6Level :: EQLevel, + eq6CR :: Severity, + eq6IR :: Severity, + eq6AR :: Severity + } + deriving (Eq, Show) + +-- | Attack Vector values for CVSS v4.0. +data CVSS40_AV = AV_Network | AV_Adjacent | AV_Local | AV_Physical + deriving (Eq, Show, Enum, Bounded) + +-- | Privileges Required values for CVSS v4.0. +data CVSS40_PR = PR_None | PR_Low | PR_High + deriving (Eq, Show, Enum, Bounded) + +-- | User Interaction values for CVSS v4.0. +-- Note: v4.0 adds \"Passive\" (user reads/views), unlike v3.x which only had None\/Required. +data CVSS40_UI = UI_None | UI_Passive | UI_Active + deriving (Eq, Show, Enum, Bounded) + +-- | Attack Complexity values for CVSS v4.0. +data CVSS40_AC = AC_Low | AC_High + deriving (Eq, Show, Enum, Bounded) + +-- | Attack Requirements values for CVSS v4.0. +-- This is a new metric in v4.0 (absent in v3.x). +data CVSS40_AT = AT_Absent | AT_Present + deriving (Eq, Show, Enum, Bounded) + +-- | Impact value for Vulnerable System metrics (VC, VI, VA, SC). +data CVSS40_ImpactValue = Impact_High | Impact_Low | Impact_None + deriving (Eq, Show, Enum, Bounded) + +-- | Impact value for Subsequent System metrics (SI, SA). +-- Extends 'CVSS40_ImpactValue' with the Safety level. +data CVSS40_SubsequentImpactValue = SI_Safety | SI_High | SI_Low | SI_None + deriving (Eq, Show, Enum, Bounded) + +-- | Security Requirement values for environmental metrics (CR, IR, AR). +data CVSS40_SecurityReqValue = SR_High | SR_Medium | SR_Low + deriving (Eq, Show, Enum, Bounded) + +-- | Exploit Maturity values for the Threat metric. +data CVSS40_ExploitMaturity = EM_Attacked | EM_PoC | EM_Unreported + deriving (Eq, Show, Enum, Bounded) + +-- | The complete CVSS v4.0 metric database. Each 'MetricValue' carries +-- the numeric weight specified by the standard (used in score computation) +-- and a human-readable description. +-- +-- In v4.0, Base metric numeric weights are all 0 because scoring is done +-- via the macrovector lookup table and severity distance calculations, +-- not via multiplicative formulas. The weights in the database are used +-- for metric descriptions and validation only. +-- +-- The database organizes metrics into four groups: +-- +-- * __Base__ (required) — 11 metrics describing intrinsic vulnerability qualities. +-- * __Supplemental__ (optional) — 6 informational metrics that do not affect scoring. +-- * __Environmental__ (optional) — 3 security requirements + 11 modified base metrics. +-- * __Threat__ (optional) — 1 Exploit Maturity metric. +cvss40DB :: CVSSDB +cvss40DB = + CVSSDB + [ MetricGroup "Base" baseMetrics, + MetricGroup "Supplemental" supplementalMetrics, + MetricGroup "Environmental" environmentalMetrics, + MetricGroup "Threat" threatMetrics + ] + where + baseMetrics = + [ MetricInfo "Attack Vector" "AV" True avValues, + MetricInfo "Attack Complexity" "AC" True acValues, + MetricInfo "Attack Requirements" "AT" True atValues, + MetricInfo "Privileges Required" "PR" True prValues, + MetricInfo "User Interaction" "UI" True uiValues, + MetricInfo "Confidentiality Impact to the Vulnerable System" "VC" True vcValues, + MetricInfo "Integrity Impact to the Vulnerable System" "VI" True viValues, + MetricInfo "Availability Impact to the Vulnerable System" "VA" True vaValues, + MetricInfo "Subsequent System Confidentiality Impact" "SC" True scValues, + MetricInfo "Subsequent System Integrity Impact" "SI" True siValues, + MetricInfo "Subsequent System Availability Impact" "SA" True saValues + ] + avValues = + [ MetricValue "Network" (MetricValueChar "N") 0 Nothing "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.", + MetricValue "Adjacent" (MetricValueChar "A") 0 Nothing "The vulnerable component is bound to the network stack, but the attack is limited at the protocol level to a logically adjacent topology.", + MetricValue "Local" (MetricValueChar "L") 0 Nothing "The vulnerable component is not bound to the network stack and the attacker's path is via read/write/execute capabilities.", + MetricValue "Physical" (MetricValueChar "P") 0 Nothing "The attack requires the attacker to physically touch or manipulate the vulnerable component." + ] + acValues = + [ MetricValue "Low" (MetricValueChar "L") 0 Nothing "Specialized access conditions or extenuating circumstances do not exist.", + MetricValue "High" (MetricValueChar "H") 0 Nothing "A successful attack depends on conditions beyond the attacker's control." + ] + atValues = + [ MetricValue "Present" (MetricValueChar "P") 0 Nothing "The conditions described in Attack Vector, Attack Complexity, Privileges Required, and User Interaction exist in the environment.", + MetricValue "Absent" (MetricValueChar "N") 0 Nothing "The conditions described in Attack Vector, Attack Complexity, Privileges Required, and User Interaction do NOT exist in the environment." + ] + prValues = + [ MetricValue "None" (MetricValueChar "N") 0 Nothing "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.", + MetricValue "Low" (MetricValueChar "L") 0 Nothing "The attacker requires privileges that provide basic user capabilities that could normally affect only settings and files owned by a user.", + MetricValue "High" (MetricValueChar "H") 0 Nothing "The attacker requires privileges that provide significant (e.g., administrative) control over the vulnerable component allowing access to component-wide settings and files." + ] + uiValues = + [ MetricValue "None" (MetricValueChar "N") 0 Nothing "The vulnerable system can be exploited without interaction from any user.", + MetricValue "Passive" (MetricValueChar "P") 0 Nothing "The human user must be engaged in some form of passive interaction (e.g., read an email, view a file).", + MetricValue "Active" (MetricValueChar "A") 0 Nothing "The human user must be engaged in some form of active interaction (e.g., click a link, run a program)." + ] + vcValues = + [ mkImpactHigh "There is a total loss of confidentiality, resulting in all resources within the impacted component being divulged to the attacker.", + mkImpactLow "There is some loss of confidentiality.", + mkImpactNone "There is no loss of confidentiality within the impacted component." + ] + viValues = + [ mkImpactHigh "There is a total loss of integrity, or a complete loss of protection.", + mkImpactLow "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.", + mkImpactNone "There is no loss of integrity within the impacted component." + ] + vaValues = + [ mkImpactHigh "There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the impacted component.", + mkImpactLow "Performance is reduced or there are interruptions in resource availability.", + mkImpactNone "There is no impact to availability within the impacted component." + ] + scValues = + [ mkImpactHigh "There is total loss of confidentiality, resulting in all resources within the Subsequent System being divulged to the attacker.", + mkImpactLow "There is some loss of confidentiality.", + mkImpactNone "There is no loss of confidentiality within the Subsequent System." + ] + siValues = + [ mkImpactHigh "There is a total loss of integrity, or a complete loss of protection.", + mkImpactLow "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.", + mkImpactNone "There is no loss of integrity within the Subsequent System." + ] + saValues = + [ mkImpactHigh "There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the Subsequent System.", + mkImpactLow "Performance is reduced or there are interruptions in resource availability.", + mkImpactNone "There is no impact to availability within the Subsequent System." + ] + mkImpactHigh = MetricValue "High" (MetricValueChar "H") 0 Nothing + mkImpactLow = MetricValue "Low" (MetricValueChar "L") 0 Nothing + mkImpactNone = MetricValue "None" (MetricValueChar "N") 0 Nothing + mkImpactSafety = MetricValue "Safety" (MetricValueChar "S") 0 Nothing "There is a predictable potential to cause injury categorized as Marginal or worse." + supplementalMetrics = + [ MetricInfo "Safety" "S" False sValues, + MetricInfo "Automatable" "AU" False auValues, + MetricInfo "Recovery" "R" False rValues, + MetricInfo "Value Density" "V" False vValues, + MetricInfo "Vulnerability Response Effort" "RE" False reValues, + MetricInfo "Provider Urgency" "U" False uValues + ] + sValues = + [ mkSuppUndef, + MetricValue "Negligible" (MetricValueChar "N") 0 Nothing "There is little to no safety impact to human life.", + MetricValue "Present" (MetricValueChar "P") 0 Nothing "There is a potential for non-trivial negative impact on human life." + ] + auValues = + [ mkSuppUndef, + MetricValue "No" (MetricValueChar "N") 0 Nothing "The attacker cannot reliably cause the specific impact or the effort required is beyond the attacker's capabilities.", + MetricValue "Yes" (MetricValueChar "Y") 0 Nothing "The attacker can reliably cause the specific impact using the available exploitation techniques and capabilities." + ] + rValues = + [ mkSuppUndef, + MetricValue "Automatic" (MetricValueChar "A") 0 Nothing "Recovery is performed by the system without human intervention.", + MetricValue "User" (MetricValueChar "U") 0 Nothing "Recovery is performed by a system administrator.", + MetricValue "Irreversible" (MetricValueChar "I") 0 Nothing "Recovery is impossible." + ] + vValues = + [ mkSuppUndef, + MetricValue "Diffuse" (MetricValueChar "D") 0 Nothing "The vulnerable component impacts a large number of organizations or users.", + MetricValue "Concentrated" (MetricValueChar "C") 0 Nothing "The vulnerable component impacts a small number of organizations or users." + ] + reValues = + [ mkSuppUndef, + MetricValue "Low" (MetricValueChar "L") 0 Nothing "The effort required to respond to the vulnerability is low.", + MetricValue "Moderate" (MetricValueChar "M") 0 Nothing "The effort required to respond to the vulnerability is moderate.", + MetricValue "High" (MetricValueChar "H") 0 Nothing "The effort required to respond to the vulnerability is high." + ] + uValues = + [ mkSuppUndef, + MetricValue "Clear" (MetricValueChar "C") 0 Nothing "The provider urges immediate action to resolve the vulnerability.", + MetricValue "Amber" (MetricValueChar "A") 0 Nothing "The provider urges action to resolve the vulnerability in a timely manner.", + MetricValue "Green" (MetricValueChar "G") 0 Nothing "The provider recommends the vulnerability be resolved, but the urgency is lower." + ] + mkSuppUndef = MetricValue "Not Defined" (MetricValueChar "X") 0 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall score." + environmentalMetrics = + [ MetricInfo "Confidentiality Requirement" "CR" False crValues, + MetricInfo "Integrity Requirement" "IR" False irValues, + MetricInfo "Availability Requirement" "AR" False arValues, + MetricInfo "Modified Attack Vector" "MAV" False $ mkEnvUndef : avValues, + MetricInfo "Modified Attack Complexity" "MAC" False $ mkEnvUndef : acValues, + MetricInfo "Modified Attack Requirements" "MAT" False $ mkEnvUndef : atValues, + MetricInfo "Modified Privileges Required" "MPR" False $ mkEnvUndef : prValues, + MetricInfo "Modified User Interaction" "MUI" False $ mkEnvUndef : uiValues, + MetricInfo "Modified Confidentiality Impact to the Vulnerable System" "MVC" False $ mkEnvUndef : vcValues, + MetricInfo "Modified Integrity Impact to the Vulnerable System" "MVI" False $ mkEnvUndef : viValues, + MetricInfo "Modified Availability Impact to the Vulnerable System" "MVA" False $ mkEnvUndef : vaValues, + MetricInfo "Modified Subsequent System Confidentiality Impact" "MSC" False $ mkEnvUndef : scValues, + MetricInfo "Modified Subsequent System Integrity Impact" "MSI" False $ [MetricValue "Not Defined" (MetricValueChar "X") 0 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Environmental Score, i.e., it has the same effect on scoring as assigning Medium.", mkImpactSafety, mkImpactHigh "There is a total loss of integrity, or a complete loss of protection.", mkImpactLow "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.", mkImpactNone "There is no loss of integrity within the Subsequent System."], + MetricInfo "Modified Subsequent System Availability Impact" "MSA" False $ [MetricValue "Not Defined" (MetricValueChar "X") 0 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Environmental Score, i.e., it has the same effect on scoring as assigning Medium.", mkImpactSafety, mkImpactHigh "There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the Subsequent System.", mkImpactLow "Performance is reduced or there are interruptions in resource availability.", mkImpactNone "There is no impact to availability within the Subsequent System."] + ] + crValues = + [ mkEnvUndef, + MetricValue "Low" (MetricValueChar "L") 0 Nothing "Loss of confidentiality is likely to have only a limited adverse effect on an organization or individuals associated with the organization (e.g., employees, customers).", + MetricValue "Medium" (MetricValueChar "M") 0 Nothing "Loss of confidentiality is likely to have a serious adverse effect on an organization or individuals associated with the organization (e.g., employees, customers).", + MetricValue "High" (MetricValueChar "H") 0 Nothing "Loss of confidentiality is likely to have a catastrophic adverse effect on an organization or individuals associated with the organization (e.g., employees, customers)." + ] + irValues = + [ mkEnvUndef, + MetricValue "Low" (MetricValueChar "L") 0 Nothing "Loss of integrity is likely to have only a limited adverse effect on an organization or individuals associated with the organization (e.g., employees, customers).", + MetricValue "Medium" (MetricValueChar "M") 0 Nothing "Loss of integrity is likely to have a serious adverse effect on an organization or individuals associated with the organization (e.g., employees, customers).", + MetricValue "High" (MetricValueChar "H") 0 Nothing "Loss of integrity is likely to have a catastrophic adverse effect on an organization or individuals associated with the organization (e.g., employees, customers)." + ] + arValues = + [ mkEnvUndef, + MetricValue "Low" (MetricValueChar "L") 0 Nothing "Loss of availability is likely to have only a limited adverse effect on an organization or individuals associated with the organization (e.g., employees, customers).", + MetricValue "Medium" (MetricValueChar "M") 0 Nothing "Loss of availability is likely to have a serious adverse effect on an organization or individuals associated with the organization (e.g., employees, customers).", + MetricValue "High" (MetricValueChar "H") 0 Nothing "Loss of availability is likely to have a catastrophic adverse effect on an organization or individuals associated with the organization (e.g., employees, customers)." + ] + mkEnvUndef = MetricValue "Not Defined" (MetricValueChar "X") 0 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values, and has no impact on the overall Environmental Score, i.e., it has the same effect on scoring as assigning Medium." + threatMetrics = + [ MetricInfo "Exploit Maturity" "E" False eValues + ] + eValues = + [ mkThreatUndef, + MetricValue "Unreported" (MetricValueChar "U") 0 Nothing "The vulnerability has not been reported to the vendor or the vendor has not been given the opportunity to respond.", + MetricValue "Proof of Concept" (MetricValueChar "P") 0 Nothing "Proof of concept code exists, or the vulnerability is theoretical.", + MetricValue "Attacked" (MetricValueChar "A") 0 Nothing "The vulnerability has been exploited in the wild." + ] + mkThreatUndef = MetricValue "Not Defined" (MetricValueChar "X") 0 Nothing "Assigning this value indicates there is insufficient information to choose one of the other values. According to the CVSS 4.0 specification, this is the default value and is equivalent to Attacked (A) for scoring purposes (assuming the worst case)." + +-- | Validate a list of CVSS v4.0 metrics, checking that: +-- +-- * No metric appears more than once. +-- * All metrics are recognized for v4.0. +-- * All required (Base) metrics are present. +validateCvss40 :: [Metric] -> Either CVSSError () +validateCvss40 metrics = do + traverse_ (\t -> t metrics) [validateUnique, validateKnown cvss40DB, validateRequired cvss40DB] + +-- | Returns 'True' when the Exploit Maturity (E) threat metric is present. +hasThreatMetrics40 :: [Metric] -> Bool +hasThreatMetrics40 = any (\metric -> mName metric == "E") + +-- | Returns 'True' when any environmental metric is present +-- (CR, IR, AR, MAV, MAC, MAT, MPR, MUI, MVC, MVI, MVA, MSC, MSI, MSA). +hasEnvironmentalMetrics40 :: [Metric] -> Bool +hasEnvironmentalMetrics40 metrics = + any + ( \metric -> + let n = coerce (mName metric) :: Text + in n + `elem` [ "CR", + "IR", + "AR", + "MAV", + "MAC", + "MAT", + "MPR", + "MUI", + "MVC", + "MVI", + "MVA", + "MSC", + "MSI", + "MSA" + ] + ) + metrics + +getMetricValueChar40 :: [Metric] -> Text -> MetricValueChar +getMetricValueChar40 metrics name = + case find (\metric -> mName metric == MetricShortName name) metrics of + Nothing -> MetricValueChar "X" + Just (Metric _ char) -> char + +getChar40 :: [Metric] -> Text -> Char +getChar40 metrics name = case getMetricValueChar40 metrics name of + MetricValueChar c -> Text.head c + +-- | Parse a character into a 'CVSS40_AV' value. +parseAV :: Char -> CVSS40_AV +parseAV c = case c of + 'N' -> AV_Network + 'A' -> AV_Adjacent + 'L' -> AV_Local + 'P' -> AV_Physical + _ -> AV_Physical + +parsePR :: Char -> CVSS40_PR +parsePR c = case c of + 'N' -> PR_None + 'L' -> PR_Low + 'H' -> PR_High + _ -> PR_High + +parseUI :: Char -> CVSS40_UI +parseUI c = case c of + 'N' -> UI_None + 'P' -> UI_Passive + 'A' -> UI_Active + _ -> UI_Active + +parseAC :: Char -> CVSS40_AC +parseAC c = case c of + 'L' -> AC_Low + 'H' -> AC_High + _ -> AC_High + +parseAT :: Char -> CVSS40_AT +parseAT c = case c of + 'N' -> AT_Absent + 'P' -> AT_Present + _ -> AT_Present + +parseImpactValue :: Char -> CVSS40_ImpactValue +parseImpactValue c = case c of + 'H' -> Impact_High + 'L' -> Impact_Low + 'N' -> Impact_None + _ -> Impact_None + +parseSubsequentImpactValue :: Char -> CVSS40_SubsequentImpactValue +parseSubsequentImpactValue c = case c of + 'S' -> SI_Safety + 'H' -> SI_High + 'L' -> SI_Low + 'N' -> SI_None + _ -> SI_None + +parseSecurityReqValue :: Char -> CVSS40_SecurityReqValue +parseSecurityReqValue c = case c of + 'H' -> SR_High + 'M' -> SR_Medium + 'L' -> SR_Low + _ -> SR_High + +parseExploitMaturity :: Char -> CVSS40_ExploitMaturity +parseExploitMaturity c = case c of + 'A' -> EM_Attacked + 'P' -> EM_PoC + 'U' -> EM_Unreported + _ -> EM_Attacked + +avSeverity :: CVSS40_AV -> Severity +avSeverity v = case v of + AV_Network -> Severity 0.0 + AV_Adjacent -> Severity 0.1 + AV_Local -> Severity 0.2 + AV_Physical -> Severity 0.3 + +prSeverity :: CVSS40_PR -> Severity +prSeverity v = case v of + PR_None -> Severity 0.0 + PR_Low -> Severity 0.1 + PR_High -> Severity 0.2 + +uiSeverity :: CVSS40_UI -> Severity +uiSeverity v = case v of + UI_None -> Severity 0.0 + UI_Passive -> Severity 0.1 + UI_Active -> Severity 0.2 + +acSeverity :: CVSS40_AC -> Severity +acSeverity v = case v of + AC_Low -> Severity 0.0 + AC_High -> Severity 0.1 + +atSeverity :: CVSS40_AT -> Severity +atSeverity v = case v of + AT_Absent -> Severity 0.0 + AT_Present -> Severity 0.1 + +vcSeverity :: CVSS40_ImpactValue -> Severity +vcSeverity v = case v of + Impact_High -> Severity 0.0 + Impact_Low -> Severity 0.1 + Impact_None -> Severity 0.2 + +viSeverity :: CVSS40_ImpactValue -> Severity +viSeverity v = case v of + Impact_High -> Severity 0.0 + Impact_Low -> Severity 0.1 + Impact_None -> Severity 0.2 + +vaSeverity :: CVSS40_ImpactValue -> Severity +vaSeverity v = case v of + Impact_High -> Severity 0.0 + Impact_Low -> Severity 0.1 + Impact_None -> Severity 0.2 + +scSeverity :: CVSS40_ImpactValue -> Severity +scSeverity v = case v of + Impact_High -> Severity 0.1 + Impact_Low -> Severity 0.2 + Impact_None -> Severity 0.3 + +siSeverity :: CVSS40_SubsequentImpactValue -> Severity +siSeverity v = case v of + SI_Safety -> Severity 0.0 + SI_High -> Severity 0.1 + SI_Low -> Severity 0.2 + SI_None -> Severity 0.3 + +saSeverity :: CVSS40_SubsequentImpactValue -> Severity +saSeverity v = case v of + SI_Safety -> Severity 0.0 + SI_High -> Severity 0.1 + SI_Low -> Severity 0.2 + SI_None -> Severity 0.3 + +crSeverity :: CVSS40_SecurityReqValue -> Severity +crSeverity v = case v of + SR_High -> Severity 0.0 + SR_Medium -> Severity 0.1 + SR_Low -> Severity 0.2 + +irSeverity :: CVSS40_SecurityReqValue -> Severity +irSeverity v = case v of + SR_High -> Severity 0.0 + SR_Medium -> Severity 0.1 + SR_Low -> Severity 0.2 + +arSeverity :: CVSS40_SecurityReqValue -> Severity +arSeverity v = case v of + SR_High -> Severity 0.0 + SR_Medium -> Severity 0.1 + SR_Low -> Severity 0.2 + +eSeverity :: CVSS40_ExploitMaturity -> Severity +eSeverity v = case v of + EM_Attacked -> Severity 0.0 + EM_PoC -> Severity 1.0 + EM_Unreported -> Severity 2.0 + +getModifiedChar40 :: [Metric] -> Text -> Text -> Char +getModifiedChar40 metrics modifiedName baseName = + let modifiedChar = getChar40 metrics modifiedName + in if modifiedChar == 'X' then getChar40 metrics baseName else modifiedChar + +getSecurityReqChar40 :: [Metric] -> Text -> Char +getSecurityReqChar40 metrics name = + let raw = getChar40 metrics name + in if raw == 'X' then 'H' else raw + +-- | Maximum severity vector compositions for EQ1 at each EQ level. +-- These represent the most severe configurations that achieve the given EQ level. +-- Used to compute severity distances. +maxComposedEQ1 :: EQLevel -> [(Severity, Severity, Severity)] +maxComposedEQ1 eq = case eq of + EQ0 -> [(Severity 0.0, Severity 0.0, Severity 0.0)] + EQ1 -> [(Severity 0.1, Severity 0.0, Severity 0.0), (Severity 0.0, Severity 0.1, Severity 0.0), (Severity 0.0, Severity 0.0, Severity 0.1)] + EQ2 -> [(Severity 0.3, Severity 0.0, Severity 0.0), (Severity 0.1, Severity 0.1, Severity 0.1)] + +-- | Maximum severity vector compositions for EQ2 at each EQ level. +maxComposedEQ2 :: EQLevel -> [(Severity, Severity, Severity)] +maxComposedEQ2 eq = case eq of + EQ0 -> [(Severity 0.0, Severity 0.0, Severity 0.0)] + EQ1 -> [(Severity 0.1, Severity 0.0, Severity 0.0), (Severity 0.0, Severity 0.1, Severity 0.0)] + _ -> [] + +-- | Maximum severity vector compositions for the combined EQ3+EQ6. +-- These are paired because the severity distance calculation combines +-- EQ3 (VC, VI, VA) and EQ6 (CR, IR, AR) into a single reduction. +maxComposedEQ3EQ6 :: EQLevel -> EQLevel -> [(Severity, Severity, Severity, Severity, Severity, Severity)] +maxComposedEQ3EQ6 eq3 eq6 = case (eq3, eq6) of + (EQ0, EQ0) -> [(Severity 0.0, Severity 0.0, Severity 0.0, Severity 0.0, Severity 0.0, Severity 0.0)] + (EQ0, EQ1) -> [(Severity 0.0, Severity 0.0, Severity 0.1, Severity 0.1, Severity 0.1, Severity 0.0), (Severity 0.0, Severity 0.0, Severity 0.0, Severity 0.1, Severity 0.1, Severity 0.1)] + (EQ1, EQ0) -> [(Severity 0.1, Severity 0.0, Severity 0.0, Severity 0.0, Severity 0.0, Severity 0.0), (Severity 0.0, Severity 0.1, Severity 0.0, Severity 0.0, Severity 0.0, Severity 0.0)] + (EQ1, EQ1) -> + [ (Severity 0.1, Severity 0.0, Severity 0.1, Severity 0.0, Severity 0.1, Severity 0.0), + (Severity 0.1, Severity 0.0, Severity 0.0, Severity 0.0, Severity 0.1, Severity 0.1), + (Severity 0.0, Severity 0.1, Severity 0.0, Severity 0.1, Severity 0.0, Severity 0.1), + (Severity 0.0, Severity 0.1, Severity 0.1, Severity 0.1, Severity 0.0, Severity 0.0), + (Severity 0.1, Severity 0.1, Severity 0.0, Severity 0.0, Severity 0.0, Severity 0.1) + ] + (EQ2, EQ1) -> [(Severity 0.1, Severity 0.1, Severity 0.1, Severity 0.0, Severity 0.0, Severity 0.0)] + (_, _) -> [] + +-- | Maximum severity vector compositions for EQ4 at each EQ level. +maxComposedEQ4 :: EQLevel -> [(Severity, Severity, Severity)] +maxComposedEQ4 eq = case eq of + EQ0 -> [(Severity 0.1, Severity 0.0, Severity 0.0)] + EQ1 -> [(Severity 0.1, Severity 0.1, Severity 0.1)] + EQ2 -> [(Severity 0.2, Severity 0.2, Severity 0.2)] + +-- | Maximum depth (number of severity steps) for EQ1 at each level. +maxDepthEQ1 :: EQLevel -> Int +maxDepthEQ1 eq = case eq of + EQ0 -> 1 + EQ1 -> 4 + EQ2 -> 5 + +-- | Maximum depth for EQ2 at each level. +maxDepthEQ2 :: EQLevel -> Int +maxDepthEQ2 eq = case eq of + EQ0 -> 1 + EQ1 -> 2 + _ -> 0 + +-- | Maximum depth for the combined EQ3+EQ6. +maxDepthEQ3EQ6 :: EQLevel -> EQLevel -> Int +maxDepthEQ3EQ6 eq3 eq6 = case (eq3, eq6) of + (EQ0, EQ0) -> 7 + (EQ0, EQ1) -> 6 + (EQ1, EQ0) -> 8 + (EQ1, EQ1) -> 8 + (EQ2, EQ1) -> 10 + (_, _) -> 0 + +-- | Maximum depth for EQ4 at each level. +maxDepthEQ4 :: EQLevel -> Int +maxDepthEQ4 eq = case eq of + EQ0 -> 6 + EQ1 -> 5 + EQ2 -> 4 + +-- | Maximum depth for EQ5 (always 1 since EQ5 is a single metric). +maxDepthEQ5 :: EQLevel -> Int +maxDepthEQ5 _ = 1 + +-- | Compute the severity distance between a current metric configuration +-- and a single maximum vector. The distance is the sum of absolute +-- differences across each severity component, scaled by 10. +severityDistance :: [Severity] -> [Severity] -> Int +severityDistance current maxV = + sum [round (abs (cVal - mVal) * 10) | (cVal, mVal) <- zip cVals mVals] + where + cVals = map (\(Severity f) -> f) current + mVals = map (\(Severity f) -> f) maxV + +-- | Find the minimum severity distance between the current configuration +-- and all maximum vectors for a given EQ level. +minSeverityDistance :: [Severity] -> [[Severity]] -> Int +minSeverityDistance current maxVectors = + minimum [severityDistance current maxV | maxV <- maxVectors] + +-- | Variant of 'minSeverityDistance' for 6-tuple maximum vectors +-- (used for the combined EQ3+EQ6 distance calculation). +minSeverityDistance6 :: [Severity] -> [(Severity, Severity, Severity, Severity, Severity, Severity)] -> Int +minSeverityDistance6 current maxVectors = + minimum [severityDistance current [a, b, c, d, e, f] | (a, b, c, d, e, f) <- maxVectors] + +-- | Advance an EQ level by one step. EQ2 is the maximum and stays at EQ2. +incrementEQ :: EQLevel -> EQLevel +incrementEQ eq = case eq of + EQ0 -> EQ1 + EQ1 -> EQ2 + EQ2 -> EQ2 + +clamp :: Float -> Float -> Float -> Float +clamp x lo hi = max lo (min hi x) + +-- | Compute the CVSS v4.0 score for the given metrics. +-- Returns the environmental score if environmental metrics are present, +-- the threat score if threat metrics are present, or the base score otherwise. +cvss40score :: [Metric] -> (Rating, Float) +cvss40score metrics + | hasEnvironmentalMetrics40 metrics = cvss40EnvironmentalScore metrics + | hasThreatMetrics40 metrics = cvss40ThreatScore metrics + | otherwise = cvss40BaseScore metrics + +-- | Filter metrics to only those relevant for base score computation +-- (removes threat, environmental, and supplemental metrics). +filterBaseMetrics :: [Metric] -> [Metric] +filterBaseMetrics = filter isBaseMetric + where + isBaseMetric m = + let n = coerce (mName m) :: Text + in n + `notElem` [ "E", + "CR", + "IR", + "AR", + "MAV", + "MAC", + "MAT", + "MPR", + "MUI", + "MVC", + "MVI", + "MVA", + "MSC", + "MSI", + "MSA", + "S", + "AU", + "R", + "V" + ] + +-- | Filter metrics to those relevant for threat score computation +-- (removes environmental and supplemental metrics, keeps threat + base). +filterThreatMetrics :: [Metric] -> [Metric] +filterThreatMetrics = filter isThreatRelevant + where + isThreatRelevant m = + let n = coerce (mName m) :: Text + in n + `notElem` [ "CR", + "IR", + "AR", + "MAV", + "MAC", + "MAT", + "MPR", + "MUI", + "MVC", + "MVI", + "MVA", + "MSC", + "MSI", + "MSA", + "S", + "AU", + "R", + "V" + ] + +-- | Core CVSS v4.0 scoring algorithm. +-- +-- The algorithm works as follows: +-- +-- 1. Compute the macrovector (EQ1–EQ6 levels) from the given metrics. +-- 2. Look up the base score from 'cvss40LookupTable' using the macrovector. +-- 3. For each EQ group (1, 2, 3+6, 4, 5), compute: +-- a. The severity distance between the current metrics and the +-- \"maximum\" (worst-case) severity vectors for that EQ level. +-- b. The available score gap (difference between the current lookup +-- score and the score at the next higher EQ level). +-- c. The score reduction: @available × severityDistance \/ maxDepth@. +-- 4. Compute the mean of all valid (non-Nothing) reductions. +-- 5. Subtract the mean reduction from the looked-up score. +-- 6. Clamp the result to [0.0, 10.0] and round to one decimal place. +-- +-- EQ3 and EQ6 are combined because they share the severity distance calculation +-- (the available gap is the minimum of the EQ3 and EQ6 gaps). +cvss40ComputeScore :: [Metric] -> (Rating, Float) +cvss40ComputeScore metrics = (toRating finalScore, finalScore) + where + finalScore = round40 (clamp (lookupScore - meanDistance) 0.0 10.0) + + mv = macroVectorFromMetrics metrics + lookupScore = macroVectorLookup mv + + EQ1Result {..} = computeEQ1 metrics + EQ2Result {..} = computeEQ2 metrics + EQ3Result {..} = computeEQ3 metrics + EQ4Result {..} = computeEQ4 metrics + EQ5Result {..} = computeEQ5 metrics + EQ6Result {..} = computeEQ6 (eq3VC, eq3VI, eq3VA) metrics + + eq1MaxVectors = maxComposedEQ1 eq1Level + eq2MaxVectors = maxComposedEQ2 eq2Level + eq3eq6MaxVectors = maxComposedEQ3EQ6 eq3Level eq6Level + eq4MaxVectors = maxComposedEQ4 eq4Level + + eq1SeverityDist = if null eq1MaxVectors then 0 else minSeverityDistance [eq1AV, eq1PR, eq1UI] (map (\(a, b, c) -> [a, b, c]) eq1MaxVectors) + eq2SeverityDist = if null eq2MaxVectors then 0 else minSeverityDistance [eq2AC, eq2AT, Severity 0] (map (\(a, b, c) -> [a, b, c]) eq2MaxVectors) + eq3eq6SeverityDist = if null eq3eq6MaxVectors then 0 else minSeverityDistance6 [eq3VC, eq3VI, eq3VA, eq6CR, eq6IR, eq6AR] eq3eq6MaxVectors + eq4SeverityDist = if null eq4MaxVectors then 0 else minSeverityDistance [eq4SC, eq4SI, eq4SA] (map (\(a, b, c) -> [a, b, c]) eq4MaxVectors) + + eq1Depth = maxDepthEQ1 eq1Level + eq2Depth = maxDepthEQ2 eq2Level + eq3eq6Depth = maxDepthEQ3EQ6 eq3Level eq6Level + eq4Depth = maxDepthEQ4 eq4Level + eq5Depth = maxDepthEQ5 eq5Level + + eq1NextMv = mv {mvEQ1 = incrementEQ (mvEQ1 mv)} + eq2NextMv = mv {mvEQ2 = incrementEQ (mvEQ2 mv)} + eq3NextMv = mv {mvEQ3 = incrementEQ (mvEQ3 mv)} + eq4NextMv = mv {mvEQ4 = incrementEQ (mvEQ4 mv)} + eq5NextMv = mv {mvEQ5 = incrementEQ (mvEQ5 mv)} + eq6NextMv = mv {mvEQ6 = incrementEQ (mvEQ6 mv)} + + eq1Available = positiveAvailable eq1NextMv + eq2Available = positiveAvailable eq2NextMv + eq3Available = positiveAvailable eq3NextMv + eq4Available = positiveAvailable eq4NextMv + eq5Available = positiveAvailable eq5NextMv + eq6Available = positiveAvailable eq6NextMv + + positiveAvailable nextMv = case Map.lookup nextMv cvss40LookupTable of + Just next + | lookupScore - next > 0 -> Just (lookupScore - next) + | otherwise -> Nothing + Nothing -> Nothing + + eq3eq6Available = case (eq3Available, eq6Available) of + (Just a, Just b) -> Just (min a b) + (Just a, Nothing) -> Just a + (Nothing, Just b) -> Just b + (Nothing, Nothing) -> Nothing + + eq1Reduction = (\avail -> avail * fromIntegral eq1SeverityDist / fromIntegral eq1Depth) <$> eq1Available + eq2Reduction = (\avail -> avail * fromIntegral eq2SeverityDist / fromIntegral eq2Depth) <$> eq2Available + eq3eq6Reduction = (\avail -> avail * fromIntegral eq3eq6SeverityDist / fromIntegral eq3eq6Depth) <$> eq3eq6Available + eq4Reduction = (\avail -> avail * fromIntegral eq4SeverityDist / fromIntegral eq4Depth) <$> eq4Available + eq5Reduction = (\avail -> avail * 0 / fromIntegral eq5Depth) <$> eq5Available + + allReductions = [eq1Reduction, eq2Reduction, eq3eq6Reduction, eq4Reduction, eq5Reduction] + validReductions = catMaybes allReductions + count = length validReductions + meanDistance = if count > 0 then sum validReductions / fromIntegral count else 0.0 + + round40 :: Float -> Float + round40 x = fromIntegral @Int (round (x * 10 + 0.0001)) / 10 + +-- | Compute the CVSS v4.0 Base Score (base metrics only). +cvss40BaseScore :: [Metric] -> (Rating, Float) +cvss40BaseScore = cvss40ComputeScore . filterBaseMetrics + +-- | Compute the CVSS v4.0 Threat Score (base + threat metrics). +cvss40ThreatScore :: [Metric] -> (Rating, Float) +cvss40ThreatScore = cvss40ComputeScore . filterThreatMetrics + +-- | Compute the CVSS v4.0 Environmental Score. +-- +-- This uses modified base metrics and security requirements from the +-- environmental group. When a modified metric is \"Not Defined\" (X), +-- the corresponding base metric value is used instead. +cvss40EnvironmentalScore :: [Metric] -> (Rating, Float) +cvss40EnvironmentalScore metrics = (toRating finalScore, finalScore) + where + finalScore = round40 (clamp (lookupScore - meanDistance) 0.0 10.0) + + mv = macroVectorFromMetricsEnv metrics + lookupScore = macroVectorLookup mv + + EQ1Result {..} = computeEQ1Env metrics + EQ2Result {..} = computeEQ2Env metrics + EQ3Result {..} = computeEQ3Env metrics + EQ4Result {..} = computeEQ4Env metrics + EQ5Result {..} = computeEQ5 metrics + EQ6Result {..} = computeEQ6 (eq3VC, eq3VI, eq3VA) metrics + + eq1MaxVectors = maxComposedEQ1 eq1Level + eq2MaxVectors = maxComposedEQ2 eq2Level + eq3eq6MaxVectors = maxComposedEQ3EQ6 eq3Level eq6Level + eq4MaxVectors = maxComposedEQ4 eq4Level + + eq1SeverityDist = if null eq1MaxVectors then 0 else minSeverityDistance [eq1AV, eq1PR, eq1UI] (map (\(a, b, c) -> [a, b, c]) eq1MaxVectors) + eq2SeverityDist = if null eq2MaxVectors then 0 else minSeverityDistance [eq2AC, eq2AT, Severity 0] (map (\(a, b, c) -> [a, b, c]) eq2MaxVectors) + eq3eq6SeverityDist = if null eq3eq6MaxVectors then 0 else minSeverityDistance6 [eq3VC, eq3VI, eq3VA, eq6CR, eq6IR, eq6AR] eq3eq6MaxVectors + eq4SeverityDist = if null eq4MaxVectors then 0 else minSeverityDistance [eq4SC, eq4SI, eq4SA] (map (\(a, b, c) -> [a, b, c]) eq4MaxVectors) + + eq1Depth = maxDepthEQ1 eq1Level + eq2Depth = maxDepthEQ2 eq2Level + eq3eq6Depth = maxDepthEQ3EQ6 eq3Level eq6Level + eq4Depth = maxDepthEQ4 eq4Level + eq5Depth = maxDepthEQ5 eq5Level + + eq1NextMv = mv {mvEQ1 = incrementEQ (mvEQ1 mv)} + eq2NextMv = mv {mvEQ2 = incrementEQ (mvEQ2 mv)} + eq3NextMv = mv {mvEQ3 = incrementEQ (mvEQ3 mv)} + eq4NextMv = mv {mvEQ4 = incrementEQ (mvEQ4 mv)} + eq5NextMv = mv {mvEQ5 = incrementEQ (mvEQ5 mv)} + eq6NextMv = mv {mvEQ6 = incrementEQ (mvEQ6 mv)} + + eq1Available = positiveAvailable eq1NextMv + eq2Available = positiveAvailable eq2NextMv + eq3Available = positiveAvailable eq3NextMv + eq4Available = positiveAvailable eq4NextMv + eq5Available = positiveAvailable eq5NextMv + eq6Available = positiveAvailable eq6NextMv + + positiveAvailable nextMv = case Map.lookup nextMv cvss40LookupTable of + Just next + | lookupScore - next > 0 -> Just (lookupScore - next) + | otherwise -> Nothing + Nothing -> Nothing + + eq3eq6Available = case (eq3Available, eq6Available) of + (Just a, Just b) -> Just (min a b) + (Just a, Nothing) -> Just a + (Nothing, Just b) -> Just b + (Nothing, Nothing) -> Nothing + + eq1Reduction = (\avail -> avail * fromIntegral eq1SeverityDist / fromIntegral eq1Depth) <$> eq1Available + eq2Reduction = (\avail -> avail * fromIntegral eq2SeverityDist / fromIntegral eq2Depth) <$> eq2Available + eq3eq6Reduction = (\avail -> avail * fromIntegral eq3eq6SeverityDist / fromIntegral eq3eq6Depth) <$> eq3eq6Available + eq4Reduction = (\avail -> avail * fromIntegral eq4SeverityDist / fromIntegral eq4Depth) <$> eq4Available + eq5Reduction = (\avail -> avail * 0 / fromIntegral eq5Depth) <$> eq5Available + + allReductions = [eq1Reduction, eq2Reduction, eq3eq6Reduction, eq4Reduction, eq5Reduction] + validReductions = catMaybes allReductions + count = length validReductions + meanDistance = if count > 0 then sum validReductions / fromIntegral count else 0.0 + + round40 :: Float -> Float + round40 x = fromIntegral @Int (round (x * 10 + 0.0001)) / 10 + +-- | Short names of all supplemental metrics. +supplementalShortNames :: [Text] +supplementalShortNames = ["S", "AU", "R", "V", "RE", "U"] + +-- | Extract supplemental metrics from a metric list. +getSupplementalMetrics :: [Metric] -> [Metric] +getSupplementalMetrics = + filter (\metric -> coerce (mName metric) `elem` supplementalShortNames) + +-- | Returns 'True' when any supplemental metric is present. +hasSupplementalMetrics :: [Metric] -> Bool +hasSupplementalMetrics = not . null . getSupplementalMetrics + +-- | Produce a human-readable description of all supplemental metrics. +-- Returns 'Nothing' when no supplemental metrics are present. +cvss40SupplementalInfo :: [Metric] -> Maybe Text +cvss40SupplementalInfo metrics + | null supplemental = Nothing + | otherwise = Just $ Text.unlines $ map formatSupplemental supplemental + where + supplemental = getSupplementalMetrics metrics + formatSupplemental metric = case doSupplementalInfo metric of + Just txt -> txt + Nothing -> coerce (mName metric) <> ":" <> coerce (mChar metric) <> " (unknown)" + doSupplementalInfo (Metric name char) = do + mi <- find (\mi -> miShortName mi == name) $ allMetrics cvss40DB + mv <- find (\mv -> mvChar mv == char) $ miValues mi + pure $ Text.concat [miName mi, " (", coerce name, "): ", mvName mv, "\n ", mvDesc mv] + +-- | Look up the value of a specific supplemental metric by name. +getSupplementalValue :: [Metric] -> Text -> Maybe MetricValueChar +getSupplementalValue metrics metricName = + mChar <$> find (\metric -> coerce (mName metric) == metricName) (getSupplementalMetrics metrics) + +-- | Parse a supplemental metric value character into its human-readable name. +parseSupplementalValue :: Text -> MetricValueChar -> Maybe Text +parseSupplementalValue metricName char = do + mi <- find (\mi -> miShortName mi == MetricShortName metricName) $ allMetrics cvss40DB + mv <- find (\mv -> mvChar mv == char) $ miValues mi + pure $ mvName mv + +-- | Compute the macrovector from base metrics only (for base\/threat scores). +macroVectorFromMetrics :: [Metric] -> MacroVector +macroVectorFromMetrics metrics = + MacroVector + { mvEQ1 = eq1Level (computeEQ1 metrics), + mvEQ2 = eq2Level (computeEQ2 metrics), + mvEQ3 = eq3Level (computeEQ3 metrics), + mvEQ4 = eq4Level (computeEQ4 metrics), + mvEQ5 = eq5Level (computeEQ5 metrics), + mvEQ6 = eq6Level (computeEQ6 (vcLevel, viLevel, vaLevel) metrics) + } + where + EQ3Result {eq3VC = vcLevel, eq3VI = viLevel, eq3VA = vaLevel} = computeEQ3 metrics + +-- | Compute the macrovector using modified environmental metrics (for +-- environmental scores). Uses the \"Env\" variants of EQ computation +-- functions which substitute modified metrics for base metrics. +macroVectorFromMetricsEnv :: [Metric] -> MacroVector +macroVectorFromMetricsEnv metrics = + MacroVector + { mvEQ1 = eq1Level (computeEQ1Env metrics), + mvEQ2 = eq2Level (computeEQ2Env metrics), + mvEQ3 = eq3Level (computeEQ3Env metrics), + mvEQ4 = eq4Level (computeEQ4Env metrics), + mvEQ5 = eq5Level (computeEQ5 metrics), + mvEQ6 = eq6Level (computeEQ6 (vcLevel, viLevel, vaLevel) metrics) + } + where + EQ3Result {eq3VC = vcLevel, eq3VI = viLevel, eq3VA = vaLevel} = computeEQ3Env metrics + +-- | Look up the score for a macrovector from the lookup table. +-- Throws an error for invalid macrovectors (should never happen with valid metrics). +macroVectorLookup :: MacroVector -> Float +macroVectorLookup mv = case Map.lookup mv cvss40LookupTable of + Nothing -> error $ "CVSS 4.0: invalid MacroVector: " <> show mv + Just s -> s + +-- | Parse a 6-character string (e.g. \"000000\") into a 'MacroVector'. +textToMacroVector :: Text -> MacroVector +textToMacroVector txt = MacroVector (charToEQ (Text.index txt 0)) (charToEQ (Text.index txt 1)) (charToEQ (Text.index txt 2)) (charToEQ (Text.index txt 3)) (charToEQ (Text.index txt 4)) (charToEQ (Text.index txt 5)) + where + charToEQ '0' = EQ0 + charToEQ '1' = EQ1 + charToEQ '2' = EQ2 + charToEQ _ = EQ0 + +-- | Compute EQ1 from base metrics (AV, PR, UI). +computeEQ1 :: [Metric] -> EQ1Result +computeEQ1 metrics = + EQ1Result + { eq1Level = eq1, + eq1AV = avLevel, + eq1PR = prLevel, + eq1UI = uiLevel + } + where + avChar = getChar40 metrics "AV" + prChar = getChar40 metrics "PR" + uiChar = getChar40 metrics "UI" + + avLevel = avSeverity (parseAV avChar) + prLevel = prSeverity (parsePR prChar) + uiLevel = uiSeverity (parseUI uiChar) + + eq1 + | avChar == 'N' && prChar == 'N' && uiChar == 'N' = EQ0 + | (avChar == 'N' || prChar == 'N' || uiChar == 'N') && not (avChar == 'N' && prChar == 'N' && uiChar == 'N') && avChar /= 'P' = EQ1 + | avChar == 'P' || not (avChar == 'N' || prChar == 'N' || uiChar == 'N') = EQ2 + | otherwise = EQ1 + +-- | Compute EQ2 from base metrics (AC, AT). +computeEQ2 :: [Metric] -> EQ2Result +computeEQ2 metrics = + EQ2Result + { eq2Level = eq2, + eq2AC = acLevel, + eq2AT = atLevel + } + where + acChar = getChar40 metrics "AC" + atChar = getChar40 metrics "AT" + + acLevel = acSeverity (parseAC acChar) + atLevel = atSeverity (parseAT atChar) + + eq2 + | acChar == 'L' && atChar == 'N' = EQ0 + | otherwise = EQ1 + +-- | Compute EQ3 from base metrics (VC, VI, VA). +computeEQ3 :: [Metric] -> EQ3Result +computeEQ3 metrics = + EQ3Result + { eq3Level = eq3, + eq3VC = vcLevel, + eq3VI = viLevel, + eq3VA = vaLevel + } + where + vcChar = getChar40 metrics "VC" + viChar = getChar40 metrics "VI" + vaChar = getChar40 metrics "VA" + + vcLevel = vcSeverity (parseImpactValue vcChar) + viLevel = viSeverity (parseImpactValue viChar) + vaLevel = vaSeverity (parseImpactValue vaChar) + + eq3 + | vcChar == 'H' && viChar == 'H' = EQ0 + | not (vcChar == 'H' && viChar == 'H') && (vcChar == 'H' || viChar == 'H' || vaChar == 'H') = EQ1 + | not (vcChar == 'H' || viChar == 'H' || vaChar == 'H') = EQ2 + | otherwise = EQ1 + +-- | Compute EQ4 from base metrics (SC, SI, SA). +computeEQ4 :: [Metric] -> EQ4Result +computeEQ4 metrics = + EQ4Result + { eq4Level = eq4, + eq4SC = scLevel, + eq4SI = siLevel, + eq4SA = saLevel + } + where + scChar = getChar40 metrics "SC" + siChar = getChar40 metrics "SI" + saChar = getChar40 metrics "SA" + + scLevel = scSeverity (parseImpactValue scChar) + siLevel = siSeverity (parseSubsequentImpactValue siChar) + saLevel = saSeverity (parseSubsequentImpactValue saChar) + + eq4 + | siChar == 'S' || saChar == 'S' = EQ0 + | not (siChar == 'S' || saChar == 'S') && (scChar == 'H' || siChar == 'H' || saChar == 'H') = EQ1 + | not (siChar == 'S' || saChar == 'S') && not (scChar == 'H' || siChar == 'H' || saChar == 'H') = EQ2 + | otherwise = EQ1 + +-- | Compute EQ5 from the Exploit Maturity metric (E). +computeEQ5 :: [Metric] -> EQ5Result +computeEQ5 metrics = + EQ5Result + { eq5Level = eq5, + eq5E = eLevel + } + where + eChar = getChar40 metrics "E" + eLevel = eSeverity (parseExploitMaturity eChar) + + eq5 + | eChar == 'A' = EQ0 + | eChar == 'P' = EQ1 + | eChar == 'U' = EQ2 + | otherwise = EQ0 + +-- | Compute EQ6 from security requirements (CR, IR, AR) and the +-- previously computed EQ3 severity levels for VC, VI, VA. +computeEQ6 :: (Severity, Severity, Severity) -> [Metric] -> EQ6Result +computeEQ6 (Severity vcLevel, Severity viLevel, Severity vaLevel) metrics = + EQ6Result + { eq6Level = eq6, + eq6CR = crLevel, + eq6IR = irLevel, + eq6AR = arLevel + } + where + crChar = getSecurityReqChar40 metrics "CR" + irChar = getSecurityReqChar40 metrics "IR" + arChar = getSecurityReqChar40 metrics "AR" + + crLevel = crSeverity (parseSecurityReqValue crChar) + irLevel = irSeverity (parseSecurityReqValue irChar) + arLevel = arSeverity (parseSecurityReqValue arChar) + + eq6 + | (crChar == 'H' && vcLevel == 0.0) || (irChar == 'H' && viLevel == 0.0) || (arChar == 'H' && vaLevel == 0.0) = EQ0 + | otherwise = EQ1 + +-- | Compute EQ1 using modified environmental metrics (MAV, MPR, MUI), +-- falling back to base metrics (AV, PR, UI) when the modified metric is X. +computeEQ1Env :: [Metric] -> EQ1Result +computeEQ1Env metrics = + EQ1Result + { eq1Level = eq1, + eq1AV = avLevel, + eq1PR = prLevel, + eq1UI = uiLevel + } + where + avChar = getModifiedChar40 metrics "MAV" "AV" + prChar = getModifiedChar40 metrics "MPR" "PR" + uiChar = getModifiedChar40 metrics "MUI" "UI" + + avLevel = avSeverity (parseAV avChar) + prLevel = prSeverity (parsePR prChar) + uiLevel = uiSeverity (parseUI uiChar) + + eq1 + | avChar == 'N' && prChar == 'N' && uiChar == 'N' = EQ0 + | (avChar == 'N' || prChar == 'N' || uiChar == 'N') && not (avChar == 'N' && prChar == 'N' && uiChar == 'N') && avChar /= 'P' = EQ1 + | avChar == 'P' || not (avChar == 'N' || prChar == 'N' || uiChar == 'N') = EQ2 + | otherwise = EQ1 + +-- | Compute EQ2 using modified environmental metrics (MAC, MAT), +-- falling back to base metrics (AC, AT) when the modified metric is X. +computeEQ2Env :: [Metric] -> EQ2Result +computeEQ2Env metrics = + EQ2Result + { eq2Level = eq2, + eq2AC = acLevel, + eq2AT = atLevel + } + where + acChar = getModifiedChar40 metrics "MAC" "AC" + atChar = getModifiedChar40 metrics "MAT" "AT" + + acLevel = acSeverity (parseAC acChar) + atLevel = atSeverity (parseAT atChar) + + eq2 + | acChar == 'L' && atChar == 'N' = EQ0 + | otherwise = EQ1 + +-- | Compute EQ3 using modified environmental metrics (MVC, MVI, MVA), +-- falling back to base metrics (VC, VI, VA) when the modified metric is X. +computeEQ3Env :: [Metric] -> EQ3Result +computeEQ3Env metrics = + EQ3Result + { eq3Level = eq3, + eq3VC = vcLevel, + eq3VI = viLevel, + eq3VA = vaLevel + } + where + vcChar = getModifiedChar40 metrics "MVC" "VC" + viChar = getModifiedChar40 metrics "MVI" "VI" + vaChar = getModifiedChar40 metrics "MVA" "VA" + + vcLevel = vcSeverity (parseImpactValue vcChar) + viLevel = viSeverity (parseImpactValue viChar) + vaLevel = vaSeverity (parseImpactValue vaChar) + + eq3 + | vcChar == 'H' && viChar == 'H' = EQ0 + | not (vcChar == 'H' && viChar == 'H') && (vcChar == 'H' || viChar == 'H' || vaChar == 'H') = EQ1 + | not (vcChar == 'H' || viChar == 'H' || vaChar == 'H') = EQ2 + | otherwise = EQ1 + +-- | Compute EQ4 using modified environmental metrics (MSC, MSI, MSA), +-- falling back to base metrics (SC, SI, SA) when the modified metric is X. +computeEQ4Env :: [Metric] -> EQ4Result +computeEQ4Env metrics = + EQ4Result + { eq4Level = eq4, + eq4SC = scLevel, + eq4SI = siLevel, + eq4SA = saLevel + } + where + scChar = getModifiedChar40 metrics "MSC" "SC" + siChar = getModifiedChar40 metrics "MSI" "SI" + saChar = getModifiedChar40 metrics "MSA" "SA" + + scLevel = scSeverity (parseImpactValue scChar) + siLevel = siSeverity (parseSubsequentImpactValue siChar) + saLevel = saSeverity (parseSubsequentImpactValue saChar) + + eq4 + | siChar == 'S' || saChar == 'S' = EQ0 + | not (siChar == 'S' || saChar == 'S') && (scChar == 'H' || siChar == 'H' || saChar == 'H') = EQ1 + | not (siChar == 'S' || saChar == 'S') && not (scChar == 'H' || siChar == 'H' || saChar == 'H') = EQ2 + | otherwise = EQ1 + +-- | The complete CVSS v4.0 macrovector lookup table. +-- Each key is a 6-character string representing EQ1–EQ6 levels (each 0, 1, or 2). +-- The value is the corresponding score from the specification. +-- +-- This table is derived directly from the FIRST CVSS v4.0 specification +-- (Document Version 1.2, Section 7.1). +cvss40LookupTable :: Map.Map MacroVector Float +cvss40LookupTable = Map.fromList [(textToMacroVector k, v) | (k, v) <- textTable] + where + textTable = + [ ("000000", 10.0), + ("000001", 9.9), + ("000010", 9.8), + ("000011", 9.5), + ("000020", 9.5), + ("000021", 9.2), + ("000100", 10.0), + ("000101", 9.6), + ("000110", 9.3), + ("000111", 8.7), + ("000120", 9.1), + ("000121", 8.1), + ("000200", 9.3), + ("000201", 9.0), + ("000210", 8.9), + ("000211", 8.0), + ("000220", 8.1), + ("000221", 6.8), + ("001000", 9.8), + ("001001", 9.5), + ("001010", 9.5), + ("001011", 9.2), + ("001020", 9.0), + ("001021", 8.4), + ("001100", 9.3), + ("001101", 9.2), + ("001110", 8.9), + ("001111", 8.1), + ("001120", 8.1), + ("001121", 6.5), + ("001200", 8.8), + ("001201", 8.0), + ("001210", 7.8), + ("001211", 7.0), + ("001220", 6.9), + ("001221", 4.8), + ("002001", 9.2), + ("002011", 8.2), + ("002021", 7.2), + ("002101", 7.9), + ("002111", 6.9), + ("002121", 5.0), + ("002201", 6.9), + ("002211", 5.5), + ("002221", 2.7), + ("010000", 9.9), + ("010001", 9.7), + ("010010", 9.5), + ("010011", 9.2), + ("010020", 9.2), + ("010021", 8.5), + ("010100", 9.5), + ("010101", 9.1), + ("010110", 9.0), + ("010111", 8.3), + ("010120", 8.4), + ("010121", 7.1), + ("010200", 9.2), + ("010201", 8.1), + ("010210", 8.2), + ("010211", 7.1), + ("010220", 7.2), + ("010221", 5.3), + ("011000", 9.5), + ("011001", 9.3), + ("011010", 9.2), + ("011011", 8.5), + ("011020", 8.5), + ("011021", 7.3), + ("011100", 9.2), + ("011101", 8.2), + ("011110", 8.0), + ("011111", 7.2), + ("011120", 7.0), + ("011121", 5.9), + ("011200", 8.4), + ("011201", 7.0), + ("011210", 7.1), + ("011211", 5.2), + ("011220", 5.0), + ("011221", 3.0), + ("012001", 8.6), + ("012011", 7.5), + ("012021", 5.2), + ("012101", 7.1), + ("012111", 5.2), + ("012121", 2.9), + ("012201", 6.3), + ("012211", 2.9), + ("012221", 1.7), + ("100000", 9.8), + ("100001", 9.5), + ("100010", 9.4), + ("100011", 8.7), + ("100020", 9.1), + ("100021", 8.1), + ("100100", 9.4), + ("100101", 8.9), + ("100110", 8.6), + ("100111", 7.4), + ("100120", 7.7), + ("100121", 6.4), + ("100200", 8.7), + ("100201", 7.5), + ("100210", 7.4), + ("100211", 6.3), + ("100220", 6.3), + ("100221", 4.9), + ("101000", 9.4), + ("101001", 8.9), + ("101010", 8.8), + ("101011", 7.7), + ("101020", 7.6), + ("101021", 6.7), + ("101100", 8.6), + ("101101", 7.6), + ("101110", 7.4), + ("101111", 5.8), + ("101120", 5.9), + ("101121", 5.0), + ("101200", 7.2), + ("101201", 5.7), + ("101210", 5.7), + ("101211", 5.2), + ("101220", 5.2), + ("101221", 2.5), + ("102001", 8.3), + ("102011", 7.0), + ("102021", 5.4), + ("102101", 6.5), + ("102111", 5.8), + ("102121", 2.6), + ("102201", 5.3), + ("102211", 2.1), + ("102221", 1.3), + ("110000", 9.5), + ("110001", 9.0), + ("110010", 8.8), + ("110011", 7.6), + ("110020", 7.6), + ("110021", 7.0), + ("110100", 9.0), + ("110101", 7.7), + ("110110", 7.5), + ("110111", 6.2), + ("110120", 6.1), + ("110121", 5.3), + ("110200", 7.7), + ("110201", 6.6), + ("110210", 6.8), + ("110211", 5.9), + ("110220", 5.2), + ("110221", 3.0), + ("111000", 8.9), + ("111001", 7.8), + ("111010", 7.6), + ("111011", 6.7), + ("111020", 6.2), + ("111021", 5.8), + ("111100", 7.4), + ("111101", 5.9), + ("111110", 5.7), + ("111111", 5.7), + ("111120", 4.7), + ("111121", 2.3), + ("111200", 6.1), + ("111201", 5.2), + ("111210", 5.7), + ("111211", 2.9), + ("111220", 2.4), + ("111221", 1.6), + ("112001", 7.1), + ("112011", 5.9), + ("112021", 3.0), + ("112101", 5.8), + ("112111", 2.6), + ("112121", 1.5), + ("112201", 2.3), + ("112211", 1.3), + ("112221", 0.6), + ("200000", 9.3), + ("200001", 8.7), + ("200010", 8.6), + ("200011", 7.2), + ("200020", 7.5), + ("200021", 5.8), + ("200100", 8.6), + ("200101", 7.4), + ("200110", 7.4), + ("200111", 6.1), + ("200120", 5.6), + ("200121", 3.4), + ("200200", 7.0), + ("200201", 5.4), + ("200210", 5.2), + ("200211", 4.0), + ("200220", 4.0), + ("200221", 2.2), + ("201000", 8.5), + ("201001", 7.5), + ("201010", 7.4), + ("201011", 5.5), + ("201020", 6.2), + ("201021", 5.1), + ("201100", 7.2), + ("201101", 5.7), + ("201110", 5.5), + ("201111", 4.1), + ("201120", 4.6), + ("201121", 1.9), + ("201200", 5.3), + ("201201", 3.6), + ("201210", 3.4), + ("201211", 1.9), + ("201220", 1.9), + ("201221", 0.8), + ("202001", 6.4), + ("202011", 5.1), + ("202021", 2.0), + ("202101", 4.7), + ("202111", 2.1), + ("202121", 1.1), + ("202201", 2.4), + ("202211", 0.9), + ("202221", 0.4), + ("210000", 8.8), + ("210001", 7.5), + ("210010", 7.3), + ("210011", 5.3), + ("210020", 6.0), + ("210021", 5.0), + ("210100", 7.3), + ("210101", 5.5), + ("210110", 5.9), + ("210111", 4.0), + ("210120", 4.1), + ("210121", 2.0), + ("210200", 5.4), + ("210201", 4.3), + ("210210", 4.5), + ("210211", 2.2), + ("210220", 2.0), + ("210221", 1.1), + ("211000", 7.5), + ("211001", 5.5), + ("211010", 5.8), + ("211011", 4.5), + ("211020", 4.0), + ("211021", 2.1), + ("211100", 6.1), + ("211101", 5.1), + ("211110", 4.8), + ("211111", 1.8), + ("211120", 2.0), + ("211121", 0.9), + ("211200", 4.6), + ("211201", 1.8), + ("211210", 1.7), + ("211211", 0.7), + ("211220", 0.8), + ("211221", 0.2), + ("212001", 5.3), + ("212011", 2.4), + ("212021", 1.4), + ("212101", 2.4), + ("212111", 1.2), + ("212121", 0.5), + ("212201", 1.0), + ("212211", 0.3), + ("212221", 0.1) + ] diff --git a/test/OfficialExamples.hs b/test/OfficialExamples.hs new file mode 100644 --- /dev/null +++ b/test/OfficialExamples.hs @@ -0,0 +1,599 @@ +{-# LANGUAGE OverloadedStrings #-} + +module OfficialExamples + ( OfficialExample (..), + cvss20OfficialExamples, + cvss30OfficialExamples, + cvss31OfficialExamples, + cvss40OfficialExamples, + ) +where + +import Data.Text (Text) +import Security.CVSS (Rating (..)) + +data OfficialExample = OfficialExample + { oeVector :: Text, + oeBaseScore :: Float, + oeBaseRating :: Rating, + oeTemporalScore :: Maybe (Float, Rating), + oeThreatScore :: Maybe (Float, Rating), + oeEnvironmentalScore :: Maybe (Float, Rating), + oeDescription :: Text + } + +cvss20OfficialExamples :: [OfficialExample] +cvss20OfficialExamples = + [ OfficialExample + "AV:N/AC:L/Au:N/C:N/I:N/A:C" + 7.8 + High + (Just (7.8, High)) + Nothing + Nothing + "CVE-2002-0392 Apache Chunked-Encoding Memory Corruption - Base", + OfficialExample + "AV:N/AC:L/Au:N/C:N/I:N/A:C/E:F/RL:OF/RC:C" + 6.4 + Medium + (Just (6.4, Medium)) + Nothing + Nothing + "CVE-2002-0392 Apache Chunked-Encoding Memory Corruption - Temporal", + OfficialExample + "AV:N/AC:L/Au:N/C:N/I:N/A:C/E:ND/RL:ND/RC:ND/CDP:N/TD:H/CR:H/IR:H/AR:H" + 10.0 + High + Nothing + Nothing + (Just (10.0, High)) + "CVE-2002-0392 Apache Chunked-Encoding Memory Corruption - Environmental (High AR)", + OfficialExample + "AV:N/AC:L/Au:N/C:N/I:N/A:C/E:ND/RL:ND/RC:ND/CDP:N/TD:H/CR:L/IR:L/AR:L" + 5.4 + Medium + Nothing + Nothing + (Just (5.4, Medium)) + "CVE-2002-0392 Apache Chunked-Encoding Memory Corruption - Environmental (Low AR)", + OfficialExample + "AV:N/AC:L/Au:N/C:N/I:N/A:C/E:ND/RL:ND/RC:ND/CDP:N/TD:N" + 0.0 + None + Nothing + Nothing + (Just (0.0, None)) + "CVE-2002-0392 Apache Chunked-Encoding Memory Corruption - Environmental (TD:N)", + OfficialExample + "AV:N/AC:L/Au:N/C:C/I:C/A:C" + 10.0 + High + (Just (10.0, High)) + Nothing + Nothing + "CVE-2003-0818 Windows ASN.1 Library Integer Handling - Base", + OfficialExample + "AV:N/AC:L/Au:N/C:C/I:C/A:C/E:F/RL:OF/RC:C" + 8.3 + High + (Just (8.3, High)) + Nothing + Nothing + "CVE-2003-0818 Windows ASN.1 Library Integer Handling - Temporal", + OfficialExample + "AV:N/AC:L/Au:N/C:C/I:C/A:C/E:ND/RL:ND/RC:ND/CDP:N/TD:H/CR:H/IR:H/AR:H" + 10.0 + High + Nothing + Nothing + (Just (10.0, High)) + "CVE-2003-0818 Windows ASN.1 Library Integer Handling - Environmental (High AR)", + OfficialExample + "AV:N/AC:L/Au:N/C:C/I:C/A:C/E:ND/RL:ND/RC:ND/CDP:N/TD:H/CR:L/IR:L/AR:L" + 8.1 + High + Nothing + Nothing + (Just (8.1, High)) + "CVE-2003-0818 Windows ASN.1 Library Integer Handling - Environmental (Low AR)", + OfficialExample + "AV:N/AC:L/Au:N/C:C/I:C/A:C/E:ND/RL:ND/RC:ND/CDP:N/TD:N" + 0.0 + None + Nothing + Nothing + (Just (0.0, None)) + "CVE-2003-0818 Windows ASN.1 Library Integer Handling - Environmental (TD:N)", + OfficialExample + "AV:L/AC:H/Au:N/C:C/I:C/A:C" + 6.2 + Medium + (Just (6.2, Medium)) + Nothing + Nothing + "CVE-2003-0062 NOD32 Antivirus Buffer Overflow - Base", + OfficialExample + "AV:L/AC:H/Au:N/C:C/I:C/A:C/E:POC/RL:OF/RC:C" + 4.9 + Medium + (Just (4.9, Medium)) + Nothing + Nothing + "CVE-2003-0062 NOD32 Antivirus Buffer Overflow - Temporal", + OfficialExample + "AV:L/AC:H/Au:N/C:C/I:C/A:C/E:ND/RL:ND/RC:ND/CDP:N/TD:H/CR:M/IR:M/AR:M" + 6.2 + Medium + Nothing + Nothing + (Just (6.2, Medium)) + "CVE-2003-0062 NOD32 Antivirus Buffer Overflow - Environmental (Medium AR)", + OfficialExample + "AV:L/AC:H/Au:N/C:C/I:C/A:C/E:ND/RL:ND/RC:ND/CDP:N/TD:H/CR:L/IR:L/AR:L" + 4.3 + Medium + Nothing + Nothing + (Just (4.3, Medium)) + "CVE-2003-0062 NOD32 Antivirus Buffer Overflow - Environmental (Low AR)", + OfficialExample + "AV:L/AC:H/Au:N/C:C/I:C/A:C/E:ND/RL:ND/RC:ND/CDP:N/TD:N" + 0.0 + None + Nothing + Nothing + (Just (0.0, None)) + "CVE-2003-0062 NOD32 Antivirus Buffer Overflow - Environmental (TD:N)" + ] + +cvss30OfficialExamples :: [OfficialExample] +cvss30OfficialExamples = + [ OfficialExample + "CVSS:3.0/AV:N/AC:L/PR:N/UI:R/S:C/C:L/I:L/A:N" + 6.1 + Medium + Nothing + Nothing + Nothing + "CVE-2013-1937 phpMyAdmin XSS", + OfficialExample + "CVSS:3.0/AV:N/AC:L/PR:L/UI:N/S:C/C:L/I:L/A:N" + 6.4 + Medium + Nothing + Nothing + Nothing + "CVE-2013-0375 MySQL Stored SQL Injection", + OfficialExample + "CVSS:3.0/AV:N/AC:H/PR:N/UI:R/S:U/C:L/I:N/A:N" + 3.1 + Low + Nothing + Nothing + Nothing + "CVE-2014-3566 SSLv3 POODLE", + OfficialExample + "CVSS:3.0/AV:N/AC:L/PR:L/UI:N/S:C/C:H/I:H/A:H" + 9.9 + Critical + Nothing + Nothing + Nothing + "CVE-2012-1516 VMware Guest to Host Escape", + OfficialExample + "CVSS:3.0/AV:L/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:L" + 4.2 + Medium + Nothing + Nothing + Nothing + "CVE-2009-0783 Apache Tomcat XML Parser", + OfficialExample + "CVSS:3.0/AV:N/AC:L/PR:L/UI:N/S:U/C:H/I:H/A:H" + 8.8 + High + Nothing + Nothing + Nothing + "CVE-2012-0384 Cisco IOS Cmd Execution (v3.0 PR:L)", + OfficialExample + "CVSS:3.0/AV:L/AC:L/PR:N/UI:R/S:U/C:H/I:H/A:H" + 7.8 + High + Nothing + Nothing + Nothing + "CVE-2015-1098 Apple iWork DoS", + OfficialExample + "CVSS:3.0/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:N/A:N" + 7.5 + High + Nothing + Nothing + Nothing + "CVE-2014-0160 OpenSSL Heartbleed", + OfficialExample + "CVSS:3.0/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H" + 9.8 + Critical + Nothing + Nothing + Nothing + "CVE-2014-6271 Shellshock", + OfficialExample + "CVSS:3.0/AV:N/AC:H/PR:N/UI:N/S:C/C:N/I:H/A:N" + 6.8 + Medium + Nothing + Nothing + Nothing + "CVE-2008-1447 DNS Kaminsky", + OfficialExample + "CVSS:3.0/AV:P/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H" + 6.8 + Medium + Nothing + Nothing + Nothing + "CVE-2014-2005 Sophos Login Bypass", + OfficialExample + "CVSS:3.0/AV:N/AC:L/PR:N/UI:N/S:C/C:L/I:N/A:N" + 5.8 + Medium + Nothing + Nothing + Nothing + "CVE-2010-0467 Joomla Directory Traversal", + OfficialExample + "CVSS:3.0/AV:N/AC:L/PR:N/UI:N/S:C/C:N/I:L/A:N" + 5.8 + Medium + Nothing + Nothing + Nothing + "CVE-2012-1342 Cisco ACL Bypass", + OfficialExample + "CVSS:3.0/AV:A/AC:L/PR:N/UI:N/S:C/C:H/I:N/A:H" + 9.3 + Critical + Nothing + Nothing + Nothing + "CVE-2013-6014 Juniper Proxy ARP DoS", + OfficialExample + "CVSS:3.0/AV:N/AC:L/PR:L/UI:R/S:C/C:L/I:L/A:N" + 5.4 + Medium + Nothing + Nothing + Nothing + "CVE-2014-9253 DokuWiki XSS", + OfficialExample + "CVSS:3.0/AV:L/AC:L/PR:N/UI:R/S:U/C:H/I:H/A:H" + 7.8 + High + Nothing + Nothing + Nothing + "CVE-2009-0658 Adobe Acrobat Overflow", + OfficialExample + "CVSS:3.0/AV:A/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H" + 8.8 + High + Nothing + Nothing + Nothing + "CVE-2011-1265 Windows Bluetooth RCE", + OfficialExample + "CVSS:3.0/AV:P/AC:L/PR:N/UI:N/S:U/C:N/I:H/A:N" + 4.6 + Medium + Nothing + Nothing + Nothing + "CVE-2014-2019 Apple iOS Control Bypass" + ] + +cvss31OfficialExamples :: [OfficialExample] +cvss31OfficialExamples = + [ OfficialExample + "CVSS:3.1/AV:N/AC:L/PR:L/UI:N/S:C/C:L/I:L/A:N" + 6.4 + Medium + Nothing + Nothing + Nothing + "CVE-2013-0375 MySQL Stored SQL Injection", + OfficialExample + "CVSS:3.1/AV:N/AC:H/PR:N/UI:R/S:U/C:L/I:N/A:N" + 3.1 + Low + Nothing + Nothing + Nothing + "CVE-2014-3566 SSLv3 POODLE", + OfficialExample + "CVSS:3.1/AV:N/AC:L/PR:L/UI:N/S:C/C:H/I:H/A:H" + 9.9 + Critical + Nothing + Nothing + Nothing + "CVE-2012-1516 VMware Guest to Host Escape", + OfficialExample + "CVSS:3.1/AV:L/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:L" + 4.2 + Medium + Nothing + Nothing + Nothing + "CVE-2009-0783 Apache Tomcat XML Parser", + OfficialExample + "CVSS:3.1/AV:N/AC:L/PR:H/UI:N/S:U/C:H/I:H/A:H" + 7.2 + High + Nothing + Nothing + Nothing + "CVE-2012-0384 Cisco IOS Cmd Execution (v3.1 PR:H)", + OfficialExample + "CVSS:3.1/AV:L/AC:L/PR:N/UI:R/S:U/C:H/I:H/A:H" + 7.8 + High + Nothing + Nothing + Nothing + "CVE-2015-1098 Apple iWork DoS", + OfficialExample + "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:N/A:N" + 7.5 + High + Nothing + Nothing + Nothing + "CVE-2014-0160 OpenSSL Heartbleed", + OfficialExample + "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H" + 9.8 + Critical + Nothing + Nothing + Nothing + "CVE-2014-6271 Shellshock", + OfficialExample + "CVSS:3.1/AV:N/AC:H/PR:N/UI:N/S:C/C:N/I:H/A:N" + 6.8 + Medium + Nothing + Nothing + Nothing + "CVE-2008-1447 DNS Kaminsky", + OfficialExample + "CVSS:3.1/AV:P/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H" + 6.8 + Medium + Nothing + Nothing + Nothing + "CVE-2014-2005 Sophos Login Bypass", + OfficialExample + "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:C/C:L/I:N/A:N" + 5.8 + Medium + Nothing + Nothing + Nothing + "CVE-2010-0467 Joomla Directory Traversal", + OfficialExample + "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:C/C:N/I:L/A:N" + 5.8 + Medium + Nothing + Nothing + Nothing + "CVE-2012-1342 Cisco ACL Bypass", + OfficialExample + "CVSS:3.1/AV:A/AC:L/PR:N/UI:N/S:C/C:H/I:N/A:H" + 9.3 + Critical + Nothing + Nothing + Nothing + "CVE-2013-6014 Juniper Proxy ARP DoS", + OfficialExample + "CVSS:3.1/AV:N/AC:L/PR:L/UI:R/S:C/C:H/I:H/A:H" + 9.0 + Critical + Nothing + Nothing + Nothing + "CVE-2019-7551 Cantemo Portal XSS", + OfficialExample + "CVSS:3.1/AV:L/AC:L/PR:N/UI:R/S:U/C:H/I:H/A:H" + 7.8 + High + Nothing + Nothing + Nothing + "CVE-2009-0658 Adobe Acrobat Overflow", + OfficialExample + "CVSS:3.1/AV:A/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H" + 8.8 + High + Nothing + Nothing + Nothing + "CVE-2011-1265 Windows Bluetooth RCE", + OfficialExample + "CVSS:3.1/AV:P/AC:L/PR:N/UI:N/S:U/C:N/I:H/A:N" + 4.6 + Medium + Nothing + Nothing + Nothing + "CVE-2014-2019 Apple iOS Control Bypass", + OfficialExample + "CVSS:3.1/AV:N/AC:L/PR:N/UI:R/S:U/C:H/I:H/A:H" + 8.8 + High + Nothing + Nothing + Nothing + "CVE-2015-0970 SearchBlox CSRF" + ] + +cvss40OfficialExamples :: [OfficialExample] +cvss40OfficialExamples = + [ OfficialExample + "CVSS:4.0/AV:L/AC:L/AT:P/PR:L/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N" + 7.3 + High + Nothing + Nothing + Nothing + "CVE-2022-41741 New Metric -- Attack Requirements", + OfficialExample + "CVSS:4.0/AV:N/AC:L/AT:P/PR:N/UI:P/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N" + 7.7 + High + Nothing + Nothing + Nothing + "CVE-2020-3549 New Metric -- Attack Requirements (Base)", + OfficialExample + "CVSS:4.0/AV:N/AC:L/AT:P/PR:N/UI:P/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:U" + 7.7 + High + Nothing + (Just (5.2, Medium)) + Nothing + "CVE-2020-3549 New Metric -- Attack Requirements (Threat)", + OfficialExample + "CVSS:4.0/AV:N/AC:L/AT:P/PR:N/UI:N/VC:H/VI:L/VA:L/SC:N/SI:N/SA:N" + 8.3 + High + Nothing + Nothing + Nothing + "CVE-2023-3089 New Metric -- Attack Requirements (High score)", + OfficialExample + "CVSS:4.0/AV:N/AC:L/AT:P/PR:N/UI:N/VC:H/VI:L/VA:L/SC:N/SI:N/SA:N/CR:H/IR:L/AR:L/MAV:N/MAC:H/MVC:H/MVI:L/MVA:L" + 8.3 + High + Nothing + Nothing + (Just (8.1, High)) + "CVE-2023-3089 New Metric -- Attack Requirements (Environmental)", + OfficialExample + "CVSS:4.0/AV:L/AC:L/AT:N/PR:N/UI:A/VC:L/VI:N/VA:N/SC:N/SI:N/SA:N" + 4.6 + Medium + Nothing + Nothing + Nothing + "CVE-2021-44714 Revised Metric -- User Interaction", + OfficialExample + "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:A/VC:N/VI:N/VA:N/SC:L/SI:L/SA:N" + 5.1 + Medium + Nothing + Nothing + Nothing + "CVE-2022-21830 Revised Metric -- User Interaction", + OfficialExample + "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:N/VI:N/VA:N/SC:L/SI:L/SA:N" + 6.9 + Medium + Nothing + Nothing + Nothing + "CVE-2022-22186 Subsequent Confidentiality/Integrity/Availability", + OfficialExample + "CVSS:4.0/AV:L/AC:L/AT:N/PR:H/UI:N/VC:N/VI:N/VA:N/SC:H/SI:N/SA:N" + 5.9 + Medium + Nothing + Nothing + Nothing + "CVE-2023-21989 Subsequent Confidentiality/Integrity/Availability", + OfficialExample + "CVSS:4.0/AV:L/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:H/SA:H" + 9.4 + Critical + Nothing + Nothing + Nothing + "CVE-2020-3947 Subsequent Confidentiality/Integrity/Availability", + OfficialExample + "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:N/VI:H/VA:N/SC:H/SI:H/SA:H" + 9.3 + Critical + Nothing + Nothing + Nothing + "CVE-2023-48228 Subsequent Confidentiality/Integrity/Availability", + OfficialExample + "CVSS:4.0/AV:P/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:H/SA:N/S:P/V:D" + 8.3 + High + Nothing + Nothing + Nothing + "CVE-2023-30560 Safety Metric", + OfficialExample + "CVSS:4.0/AV:L/AC:L/AT:N/PR:L/UI:N/VC:H/VI:N/VA:N/SC:N/SI:N/SA:N/E:A" + 6.8 + Medium + Nothing + (Just (6.8, Medium)) + Nothing + "CVE-2026-20805 CISA KEV Examples", + OfficialExample + "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:N/VA:N/SC:N/SI:N/SA:N/E:A" + 8.7 + High + Nothing + (Just (8.7, High)) + Nothing + "CVE-2014-0160 Heartbleed Classic Example (Threat)", + OfficialExample + "CVSS:4.0/AV:N/AC:H/AT:P/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N" + 9.2 + Critical + Nothing + Nothing + Nothing + "CVE-2021-44228 log4shell (immutable containers)", + OfficialExample + "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:A" + 9.3 + Critical + Nothing + (Just (9.3, Critical)) + Nothing + "CVE-2021-44228 log4shell Classic Example (Threat)", + OfficialExample + "CVSS:4.0/AV:N/AC:H/AT:P/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:P/MAC:L/MAT:N/MVC:N/MVI:N/MVA:L" + 9.2 + Critical + Nothing + Nothing + (Just (5.5, Medium)) + "CVE-2021-44228 log4shell Classic Example (Environmental)", + OfficialExample + "CVSS:4.0/AV:A/AC:L/AT:N/PR:N/UI:N/VC:N/VI:L/VA:N/SC:H/SI:N/SA:H" + 6.4 + Medium + Nothing + Nothing + Nothing + "CVE-2013-6014 Juniper Proxy ARP Classic Example", + OfficialExample + "CVSS:4.0/AV:L/AC:L/AT:N/PR:H/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/R:I" + 8.4 + High + Nothing + (Just (8.4, High)) + Nothing + "CVE-2016-5729 Lenovo ThinkPwn Classic Example" + ] diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,36 +1,18 @@ -{-# LANGUAGE OverloadedStrings #-} - module Main where -import Control.Monad -import Data.Text (Text) -import qualified Security.CVSS as CVSS import Test.Tasty -import Test.Tasty.HUnit +import qualified TestCVSS.V20 as V20 +import qualified TestCVSS.V30 as V30 +import qualified TestCVSS.V31 as V31 +import qualified TestCVSS.V40 as V40 main :: IO () -main = defaultMain $ - testCase "Security.CVSS" $ do - forM_ examples $ \(cvssString, score, rating) -> do - case CVSS.parseCVSS cvssString of - Left e -> assertFailure (show e) - Right cvss -> do - CVSS.cvssScore cvss @?= (rating, score) - CVSS.cvssVectorString cvss @?= cvssString - CVSS.cvssVectorStringOrdered cvss @?= cvssString - -examples :: [(Text, Float, CVSS.Rating)] -examples = - [ ("CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:C/C:N/I:L/A:N", 5.8, CVSS.Medium) - , ("CVSS:3.1/AV:N/AC:L/PR:L/UI:N/S:C/C:L/I:L/A:N", 6.4, CVSS.Medium) - , ("CVSS:3.1/AV:N/AC:H/PR:N/UI:R/S:U/C:L/I:N/A:N", 3.1, CVSS.Low) - , ("CVSS:3.0/AV:N/AC:L/PR:N/UI:R/S:C/C:L/I:L/A:N", 6.1, CVSS.Medium) - , ("CVSS:3.0/AV:N/AC:L/PR:L/UI:N/S:C/C:L/I:L/A:N", 6.4, CVSS.Medium) - , ("CVSS:3.0/AV:N/AC:H/PR:N/UI:R/S:U/C:L/I:N/A:N", 3.1, CVSS.Low) - , ("CVSS:3.0/AV:L/AC:L/PR:N/UI:N/S:U/C:N/I:L/A:N", 4.0, CVSS.Medium) - , ("CVSS:3.0/AV:N/AC:L/PR:L/UI:N/S:C/C:H/I:H/A:H", 9.9, CVSS.Critical) - , ("CVSS:3.0/AV:L/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:L", 4.2, CVSS.Medium) - , ("AV:N/AC:L/Au:N/C:N/I:N/A:C", 7.8, CVSS.High) - , ("AV:N/AC:L/Au:N/C:C/I:C/A:C", 10, CVSS.Critical) - , ("AV:L/AC:H/Au:N/C:C/I:C/A:C", 6.2, CVSS.Medium) - ] +main = + defaultMain $ + testGroup + "Security.CVSS" + [ V20.v20Tests, + V30.v30Tests, + V31.v31Tests, + V40.v40Tests + ] diff --git a/test/TestCVSS/Common.hs b/test/TestCVSS/Common.hs new file mode 100644 --- /dev/null +++ b/test/TestCVSS/Common.hs @@ -0,0 +1,485 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module TestCVSS.Common + ( -- * CVSS 3.1/3.0 types + Base31 (..), + base31Vector, + base30Vector, + cvss31Vector, + + -- * CVSS 2.0 types + Base20 (..), + base20Vector, + Temporal20 (..), + temporal20Vector, + Env20 (..), + env20Vector, + full20Vector, + allNDEnv, + + -- * CVSS 3.x types + Temporal3x (..), + temporal3xVector, + Env3x (..), + env3xVector, + full30Vector, + full31TemporalVector, + full31EnvVector, + allXEnv3x, + + -- * CVSS 4.0 types + Base40 (..), + base40Vector, + Env40 (..), + env40Vector, + full40Vector, + allXEnv, + + -- * Helpers + metric, + metric20, + notDefinedTemporalEnv, + + -- * Test helpers + scoreTestCase, + officialTestCaseV3X, + ) +where + +import Data.Text (Text) +import qualified Data.Text as Text +import OfficialExamples (OfficialExample (..)) +import qualified Security.CVSS as CVSS +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +metric :: Text -> Char -> Text +metric name value = name <> ":" <> Text.singleton value + +metric20 :: Text -> Text -> Text +metric20 name value = name <> ":" <> value + +cvss31Vector :: [Text] -> Text +cvss31Vector metrics = Text.intercalate "/" ("CVSS:3.1" : metrics) + +notDefinedTemporalEnv :: Text +notDefinedTemporalEnv = + "/E:X/RL:X/RC:X/CR:X/IR:X/AR:X/MAV:X/MAC:X/MPR:X/MUI:X/MS:X/MC:X/MI:X/MA:X" + +-- | Create a single testCase from a (vector, score, rating) triple. +scoreTestCase :: (Text, Float, CVSS.Rating) -> TestTree +scoreTestCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Left e -> assertFailure (show e) + Right cvss -> do + CVSS.cvssScore cvss @?= (rating, score) + CVSS.cvssVectorString cvss @?= cvssString + CVSS.cvssVectorStringOrdered cvss @?= cvssString + +-- ------------------------------------------------------------------ +-- CVSS 3.1 / 3.0 base +-- ------------------------------------------------------------------ + +data Base31 = Base31 + { bAV :: Char, + bAC :: Char, + bPR :: Char, + bUI :: Char, + bS :: Char, + bC :: Char, + bI :: Char, + bA :: Char + } + deriving (Eq, Show) + +instance Arbitrary Base31 where + arbitrary = + Base31 + <$> elements ['N', 'A', 'L', 'P'] + <*> elements ['L', 'H'] + <*> elements ['N', 'L', 'H'] + <*> elements ['N', 'R'] + <*> elements ['U', 'C'] + <*> elements ['H', 'L', 'N'] + <*> elements ['H', 'L', 'N'] + <*> elements ['H', 'L', 'N'] + +base31Vector :: Base31 -> Text +base31Vector b = + cvss31Vector + [ metric "AV" (bAV b), + metric "AC" (bAC b), + metric "PR" (bPR b), + metric "UI" (bUI b), + metric "S" (bS b), + metric "C" (bC b), + metric "I" (bI b), + metric "A" (bA b) + ] + +base30Vector :: Base31 -> Text +base30Vector b = + Text.intercalate + "/" + [ "CVSS:3.0", + metric "AV" (bAV b), + metric "AC" (bAC b), + metric "PR" (bPR b), + metric "UI" (bUI b), + metric "S" (bS b), + metric "C" (bC b), + metric "I" (bI b), + metric "A" (bA b) + ] + +-- ------------------------------------------------------------------ +-- CVSS 2.0 types +-- ------------------------------------------------------------------ + +data Base20 = Base20 + { b20AV :: Text, + b20AC :: Text, + b20Au :: Text, + b20C :: Text, + b20I :: Text, + b20A :: Text + } + deriving (Eq, Show) + +instance Arbitrary Base20 where + arbitrary = + Base20 + <$> elements ["L", "A", "N"] + <*> elements ["H", "M", "L"] + <*> elements ["M", "S", "N"] + <*> elements ["N", "P", "C"] + <*> elements ["N", "P", "C"] + <*> elements ["N", "P", "C"] + +data Temporal20 = Temporal20 + { t20E :: Text, + t20RL :: Text, + t20RC :: Text + } + deriving (Eq, Show) + +instance Arbitrary Temporal20 where + arbitrary = + Temporal20 + <$> elements ["ND", "U", "POC", "F", "H"] + <*> elements ["ND", "OF", "TF", "W", "U"] + <*> elements ["ND", "UC", "UR", "C"] + +data Env20 = Env20 + { e20CR :: Text, + e20IR :: Text, + e20AR :: Text, + e20CDP :: Text, + e20TD :: Text + } + deriving (Eq, Show) + +instance Arbitrary Env20 where + arbitrary = + Env20 + <$> elements ["ND", "L", "M", "H"] + <*> elements ["ND", "L", "M", "H"] + <*> elements ["ND", "L", "M", "H"] + <*> elements ["ND", "N", "L", "LM", "MH", "H"] + <*> elements ["ND", "N", "L", "M", "H"] + +base20Vector :: Base20 -> Text +base20Vector b = + Text.intercalate + "/" + [ metric20 "AV" (b20AV b), + metric20 "AC" (b20AC b), + metric20 "Au" (b20Au b), + metric20 "C" (b20C b), + metric20 "I" (b20I b), + metric20 "A" (b20A b) + ] + +temporal20Vector :: Temporal20 -> Text +temporal20Vector t = + Text.intercalate + "/" + [ metric20 "E" (t20E t), + metric20 "RL" (t20RL t), + metric20 "RC" (t20RC t) + ] + +env20Vector :: Env20 -> Text +env20Vector e = + Text.intercalate + "/" + [ metric20 "CR" (e20CR e), + metric20 "IR" (e20IR e), + metric20 "AR" (e20AR e), + metric20 "CDP" (e20CDP e), + metric20 "TD" (e20TD e) + ] + +full20Vector :: Base20 -> Temporal20 -> Env20 -> Text +full20Vector b t e = + base20Vector b <> "/" <> temporal20Vector t <> "/" <> env20Vector e + +allNDEnv :: Env20 +allNDEnv = + Env20 + { e20CR = "ND", + e20IR = "ND", + e20AR = "ND", + e20CDP = "ND", + e20TD = "H" + } + +-- ------------------------------------------------------------------ +-- CVSS 3.x temporal / environmental +-- ------------------------------------------------------------------ + +data Temporal3x = Temporal3x + { t3xE :: Char, + t3xRL :: Char, + t3xRC :: Char + } + deriving (Eq, Show) + +instance Arbitrary Temporal3x where + arbitrary = + Temporal3x + <$> elements ['X', 'H', 'F', 'P', 'U'] + <*> elements ['X', 'U', 'W', 'T', 'O'] + <*> elements ['X', 'C', 'R', 'U'] + +data Env3x = Env3x + { e3xCR :: Char, + e3xIR :: Char, + e3xAR :: Char, + e3xMAV :: Char, + e3xMAC :: Char, + e3xMPR :: Char, + e3xMUI :: Char, + e3xMS :: Char, + e3xMC :: Char, + e3xMI :: Char, + e3xMA :: Char + } + deriving (Eq, Show) + +instance Arbitrary Env3x where + arbitrary = + Env3x + <$> elements ['X', 'H', 'M', 'L'] + <*> elements ['X', 'H', 'M', 'L'] + <*> elements ['X', 'H', 'M', 'L'] + <*> elements ['X', 'N', 'A', 'L', 'P'] + <*> elements ['X', 'L', 'H'] + <*> elements ['X', 'N', 'L', 'H'] + <*> elements ['X', 'N', 'R'] + <*> elements ['X', 'U', 'C'] + <*> elements ['X', 'H', 'L', 'N'] + <*> elements ['X', 'H', 'L', 'N'] + <*> elements ['X', 'H', 'L', 'N'] + +temporal3xVector :: Temporal3x -> Text +temporal3xVector t = + Text.intercalate + "/" + [ metric "E" (t3xE t), + metric "RL" (t3xRL t), + metric "RC" (t3xRC t) + ] + +env3xVector :: Env3x -> Text +env3xVector e = + Text.intercalate + "/" + [ metric "CR" (e3xCR e), + metric "IR" (e3xIR e), + metric "AR" (e3xAR e), + metric "MAV" (e3xMAV e), + metric "MAC" (e3xMAC e), + metric "MPR" (e3xMPR e), + metric "MUI" (e3xMUI e), + metric "MS" (e3xMS e), + metric "MC" (e3xMC e), + metric "MI" (e3xMI e), + metric "MA" (e3xMA e) + ] + +full30Vector :: Base31 -> Temporal3x -> Env3x -> Text +full30Vector b t e = + base30Vector b <> "/" <> temporal3xVector t <> "/" <> env3xVector e + +full31TemporalVector :: Base31 -> Temporal3x -> Text +full31TemporalVector b t = + base31Vector b <> "/" <> temporal3xVector t + +full31EnvVector :: Base31 -> Temporal3x -> Env3x -> Text +full31EnvVector b t e = + base31Vector b <> "/" <> temporal3xVector t <> "/" <> env3xVector e + +allXEnv3x :: Env3x +allXEnv3x = + Env3x + { e3xCR = 'X', + e3xIR = 'X', + e3xAR = 'X', + e3xMAV = 'X', + e3xMAC = 'X', + e3xMPR = 'X', + e3xMUI = 'X', + e3xMS = 'X', + e3xMC = 'X', + e3xMI = 'X', + e3xMA = 'X' + } + +-- ------------------------------------------------------------------ +-- CVSS 4.0 types +-- ------------------------------------------------------------------ + +data Base40 = Base40 + { b40AV :: Char, + b40AC :: Char, + b40AT :: Char, + b40PR :: Char, + b40UI :: Char, + b40VC :: Char, + b40VI :: Char, + b40VA :: Char, + b40SC :: Char, + b40SI :: Char, + b40SA :: Char + } + deriving (Eq, Show) + +instance Arbitrary Base40 where + arbitrary = + Base40 + <$> elements ['N', 'A', 'L', 'P'] + <*> elements ['L', 'H'] + <*> elements ['N', 'P'] + <*> elements ['N', 'L', 'H'] + <*> elements ['N', 'A', 'P'] + <*> elements ['H', 'L', 'N'] + <*> elements ['H', 'L', 'N'] + <*> elements ['H', 'L', 'N'] + <*> elements ['H', 'L', 'N'] + <*> elements ['H', 'L', 'N'] + <*> elements ['H', 'L', 'N'] + +data Env40 = Env40 + { e40CR :: Char, + e40IR :: Char, + e40AR :: Char, + e40MAV :: Char, + e40MAC :: Char, + e40MAT :: Char, + e40MPR :: Char, + e40MUI :: Char, + e40MVC :: Char, + e40MVI :: Char, + e40MVA :: Char, + e40MSC :: Char, + e40MSI :: Char, + e40MSA :: Char + } + deriving (Eq, Show) + +instance Arbitrary Env40 where + arbitrary = + Env40 + <$> elements ['X', 'L', 'M', 'H'] + <*> elements ['X', 'L', 'M', 'H'] + <*> elements ['X', 'L', 'M', 'H'] + <*> elements ['X', 'N', 'A', 'L', 'P'] + <*> elements ['X', 'L', 'H'] + <*> elements ['X', 'N', 'P'] + <*> elements ['X', 'N', 'L', 'H'] + <*> elements ['X', 'N', 'P', 'A'] + <*> elements ['X', 'H', 'L', 'N'] + <*> elements ['X', 'H', 'L', 'N'] + <*> elements ['X', 'H', 'L', 'N'] + <*> elements ['X', 'H', 'L', 'N'] + <*> elements ['X', 'S', 'H', 'L', 'N'] + <*> elements ['X', 'S', 'H', 'L', 'N'] + +cvss40Vector :: [Text] -> Text +cvss40Vector metrics = Text.intercalate "/" ("CVSS:4.0" : metrics) + +base40Vector :: Base40 -> Text +base40Vector b = + cvss40Vector + [ metric "AV" (b40AV b), + metric "AC" (b40AC b), + metric "AT" (b40AT b), + metric "PR" (b40PR b), + metric "UI" (b40UI b), + metric "VC" (b40VC b), + metric "VI" (b40VI b), + metric "VA" (b40VA b), + metric "SC" (b40SC b), + metric "SI" (b40SI b), + metric "SA" (b40SA b) + ] + +env40Vector :: Env40 -> Text +env40Vector e = + Text.intercalate + "/" + [ metric "CR" (e40CR e), + metric "IR" (e40IR e), + metric "AR" (e40AR e), + metric "MAV" (e40MAV e), + metric "MAC" (e40MAC e), + metric "MAT" (e40MAT e), + metric "MPR" (e40MPR e), + metric "MUI" (e40MUI e), + metric "MVC" (e40MVC e), + metric "MVI" (e40MVI e), + metric "MVA" (e40MVA e), + metric "MSC" (e40MSC e), + metric "MSI" (e40MSI e), + metric "MSA" (e40MSA e) + ] + +full40Vector :: Base40 -> Env40 -> Text +full40Vector b e = base40Vector b <> "/" <> env40Vector e + +allXEnv :: Env40 +allXEnv = + Env40 + { e40CR = 'X', + e40IR = 'X', + e40AR = 'X', + e40MAV = 'X', + e40MAC = 'X', + e40MAT = 'X', + e40MPR = 'X', + e40MUI = 'X', + e40MVC = 'X', + e40MVI = 'X', + e40MVA = 'X', + e40MSC = 'X', + e40MSI = 'X', + e40MSA = 'X' + } + +-- ------------------------------------------------------------------ +-- Shared official-test helper (used by V30 and V31) +-- ------------------------------------------------------------------ + +officialTestCaseV3X :: OfficialExample -> TestTree +officialTestCaseV3X ex = + testCase (Text.unpack $ oeVector ex) $ + case CVSS.parseCVSS (oeVector ex) of + Left e -> assertFailure (show e) + Right cvss -> do + let (rating, score) = CVSS.cvssScore cvss + score @?= oeBaseScore ex + rating @?= oeBaseRating ex diff --git a/test/TestCVSS/V20.hs b/test/TestCVSS/V20.hs new file mode 100644 --- /dev/null +++ b/test/TestCVSS/V20.hs @@ -0,0 +1,252 @@ +{-# LANGUAGE OverloadedStrings #-} + +module TestCVSS.V20 + ( v20Tests, + ) +where + +import Data.Text (Text) +import qualified Data.Text as Text +import OfficialExamples (OfficialExample (..), cvss20OfficialExamples) +import qualified Security.CVSS as CVSS +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import TestCVSS.Common + +v20Tests :: TestTree +v20Tests = + testGroup + "CVSS v2.0" + [ testGroup "score examples" $ scoreTestCase <$> v20ScoreExamples, + testGroup "rating boundary tests" $ boundaryCase <$> cvss20BoundaryTests, + testGroup "temporal score examples" $ temporalCase <$> cvss20TemporalExamples, + testCase "ND temporal metrics do not change score" testCVSS20NotDefinedNoScoreChange, + testGroup "environmental score examples" $ envCase <$> cvss20EnvironmentalExamples, + testCase "ND environmental metrics do not change score" testCVSS20EnvironmentalNotDefinedNoScoreChange, + testGroup + "QuickCheck Properties" + [ testProperty "temporal <= base" prop_v20_temporalLEBase, + testProperty "ND temporal doesn't change score" prop_v20_ndTemporalNoChange, + testProperty "ND env doesn't change score" prop_v20_ndEnvNoChange, + testProperty "temporal score in [0, 10]" prop_v20_temporalScoreBounds, + testProperty "env score in [0, 10]" prop_v20_envScoreBounds, + testProperty "TD:N results in score 0" prop_v20_tdNoneZero, + testProperty "env <= temporal when CR/IR/AR=ND and CDP=ND" prop_v20_envLETemporal, + testProperty "full vector roundtrip" prop_v20_fullRoundTrip + ], + testGroup "Official FIRST cross-validation" $ officialTestCaseV20 <$> cvss20OfficialExamples + ] + +-- ------------------------------------------------------------------ +-- Example data +-- ------------------------------------------------------------------ + +v20ScoreExamples :: [(Text, Float, CVSS.Rating)] +v20ScoreExamples = + [ ("AV:N/AC:L/Au:N/C:N/I:N/A:C", 7.8, CVSS.High), + ("AV:N/AC:L/Au:N/C:C/I:C/A:C", 10, CVSS.High), + ("AV:L/AC:H/Au:N/C:C/I:C/A:C", 6.2, CVSS.Medium), + ("AV:N/AC:M/Au:N/C:P/I:N/A:N", 4.3, CVSS.Medium) + ] + +cvss20BoundaryTests :: [(Float, CVSS.Rating)] +cvss20BoundaryTests = + [ (0, CVSS.None), + (0.1, CVSS.Low), + (3.9, CVSS.Low), + (4.0, CVSS.Medium), + (6.9, CVSS.Medium), + (7.0, CVSS.High), + (9.0, CVSS.High), + (10, CVSS.High) + ] + +cvss20TemporalExamples :: [(Text, Float, CVSS.Rating)] +cvss20TemporalExamples = + [ ("AV:N/AC:L/Au:N/C:C/I:C/A:C/E:ND/RL:ND/RC:ND", 10.0, CVSS.High), + ("AV:N/AC:L/Au:N/C:N/I:N/A:C/E:ND/RL:ND/RC:ND", 7.8, CVSS.High) + ] + +cvss20EnvironmentalExamples :: [(Text, Float, CVSS.Rating)] +cvss20EnvironmentalExamples = + [ ( "AV:N/AC:L/Au:N/C:C/I:C/A:C/E:ND/RL:ND/RC:ND/CDP:ND/TD:ND/CR:ND/IR:ND/AR:ND", + 10.0, + CVSS.High + ), + ( "AV:N/AC:L/Au:N/C:P/I:P/A:N/E:ND/RL:ND/RC:ND/CDP:ND/TD:H/CR:H/IR:H/AR:H", + 7.8, + CVSS.High + ), + ( "AV:N/AC:L/Au:N/C:P/I:P/A:N/E:ND/RL:ND/RC:ND/CDP:L/TD:H/CR:L/IR:L/AR:L", + 5.3, + CVSS.Medium + ), + ( "AV:N/AC:L/Au:N/C:P/I:P/A:N/E:F/RL:OF/RC:UC/CDP:H/TD:H/CR:M/IR:M/AR:M", + 7.4, + CVSS.High + ), + ( "AV:N/AC:L/Au:N/C:P/I:P/A:N/E:ND/RL:ND/RC:ND/CDP:H/TD:N/CR:M/IR:M/AR:M", + 0, + CVSS.None + ), + ( "AV:N/AC:L/Au:N/C:P/I:P/A:N/E:ND/RL:ND/RC:ND/CDP:H/TD:L/CR:M/IR:M/AR:M", + 2.0, + CVSS.Low + ) + ] + +-- ------------------------------------------------------------------ +-- Individual test-case builders +-- ------------------------------------------------------------------ + +boundaryCase :: (Float, CVSS.Rating) -> TestTree +boundaryCase (score, expectedRating) = + testCase ("boundary: " <> showFFloat score) $ + CVSS.toRating20 score @?= expectedRating + +temporalCase :: (Text, Float, CVSS.Rating) -> TestTree +temporalCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS20, CVSS.cvssMetrics = cm} -> + CVSS.cvss20TemporalScore cm @?= (rating, score) + other -> assertFailure (show other) + +envCase :: (Text, Float, CVSS.Rating) -> TestTree +envCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS20, CVSS.cvssMetrics = cm} -> + CVSS.cvss20EnvironmentalScore cm @?= (rating, score) + other -> assertFailure (show other) + +showFFloat :: Float -> String +showFFloat = show + +-- ------------------------------------------------------------------ +-- Single-assertion tests +-- ------------------------------------------------------------------ + +testCVSS20NotDefinedNoScoreChange :: Assertion +testCVSS20NotDefinedNoScoreChange = do + let baseVector = "AV:N/AC:L/Au:N/C:C/I:C/A:C" + fullVector = baseVector <> "/E:ND/RL:ND/RC:ND" + case (CVSS.parseCVSS baseVector, CVSS.parseCVSS fullVector) of + (Right baseCvss, Right fullCvss) -> + CVSS.cvssScore fullCvss @?= CVSS.cvssScore baseCvss + _ -> assertFailure "base or full vector parse failed" + +testCVSS20EnvironmentalNotDefinedNoScoreChange :: Assertion +testCVSS20EnvironmentalNotDefinedNoScoreChange = do + let baseVector = "AV:N/AC:L/Au:N/C:P/I:P/A:N" + fullVector = baseVector <> "/E:ND/RL:ND/RC:ND/CDP:ND/TD:ND/CR:ND/IR:ND/AR:ND" + case (CVSS.parseCVSS baseVector, CVSS.parseCVSS fullVector) of + (Right baseCvss, Right fullCvss) -> + CVSS.cvssScore fullCvss @?= CVSS.cvssScore baseCvss + _ -> assertFailure "base or full vector parse failed" + +-- ------------------------------------------------------------------ +-- QuickCheck properties +-- ------------------------------------------------------------------ + +prop_v20_temporalLEBase :: Base20 -> Temporal20 -> Property +prop_v20_temporalLEBase b t = + let baseInput = base20Vector b + temporalInput = baseInput <> "/" <> temporal20Vector t + in case (CVSS.parseCVSS baseInput, CVSS.parseCVSS temporalInput) of + (Right baseCvss, Right temporalCvss) -> + let (_, baseScore) = CVSS.cvssScore baseCvss + (_, temporalScore) = CVSS.cvss20TemporalScore (CVSS.cvssMetrics temporalCvss) + in property $ temporalScore <= baseScore + _ -> counterexample "parse failed" False + +prop_v20_ndTemporalNoChange :: Base20 -> Property +prop_v20_ndTemporalNoChange b = + let baseInput = base20Vector b + ndTemporal = "/E:ND/RL:ND/RC:ND" + temporalInput = baseInput <> ndTemporal + in case (CVSS.parseCVSS baseInput, CVSS.parseCVSS temporalInput) of + (Right baseCvss, Right temporalCvss) -> + CVSS.cvssScore baseCvss === CVSS.cvss20TemporalScore (CVSS.cvssMetrics temporalCvss) + _ -> counterexample "parse failed" False + +prop_v20_ndEnvNoChange :: Base20 -> Temporal20 -> Property +prop_v20_ndEnvNoChange b t = + let temporalInput = base20Vector b <> "/" <> temporal20Vector t + ndEnv = "/CR:ND/IR:ND/AR:ND/CDP:ND/TD:ND" + envInput = temporalInput <> ndEnv + in case (CVSS.parseCVSS temporalInput, CVSS.parseCVSS envInput) of + (Right temporalCvss, Right envCvss) -> + CVSS.cvss20TemporalScore (CVSS.cvssMetrics temporalCvss) === CVSS.cvss20EnvironmentalScore (CVSS.cvssMetrics envCvss) + _ -> counterexample "parse failed" False + +prop_v20_temporalScoreBounds :: Base20 -> Temporal20 -> Property +prop_v20_temporalScoreBounds b t = + let temporalInput = base20Vector b <> "/" <> temporal20Vector t + in case CVSS.parseCVSS temporalInput of + Right cvss -> + let (_, score) = CVSS.cvss20TemporalScore (CVSS.cvssMetrics cvss) + in score >= 0.0 .&&. score <= 10.0 + Left err -> counterexample ("parse failed: " <> show err) False + +prop_v20_envScoreBounds :: Base20 -> Temporal20 -> Env20 -> Property +prop_v20_envScoreBounds b t e = + let envInput = full20Vector b t e + in case CVSS.parseCVSS envInput of + Right cvss -> + let (_, score) = CVSS.cvss20EnvironmentalScore (CVSS.cvssMetrics cvss) + in score >= 0.0 .&&. score <= 10.0 + Left err -> counterexample ("parse failed: " <> show err) False + +prop_v20_tdNoneZero :: Base20 -> Temporal20 -> Property +prop_v20_tdNoneZero b t = + let envInput = base20Vector b <> "/" <> temporal20Vector t <> "/CR:ND/IR:ND/AR:ND/CDP:ND/TD:N" + in case CVSS.parseCVSS envInput of + Right cvss -> + let (_, score) = CVSS.cvss20EnvironmentalScore (CVSS.cvssMetrics cvss) + in score === 0.0 + Left err -> counterexample ("parse failed: " <> show err) False + +prop_v20_envLETemporal :: Base20 -> Temporal20 -> Property +prop_v20_envLETemporal b t = + let envInput = base20Vector b <> "/" <> temporal20Vector t <> "/CR:ND/IR:ND/AR:ND/CDP:ND/TD:ND" + in case CVSS.parseCVSS envInput of + Right envCvss -> + let (_, envScore) = CVSS.cvss20EnvironmentalScore (CVSS.cvssMetrics envCvss) + (_, temporalScore) = CVSS.cvss20TemporalScore (CVSS.cvssMetrics envCvss) + in property $ envScore <= temporalScore + Left err -> counterexample ("parse failed: " <> show err) False + +prop_v20_fullRoundTrip :: Base20 -> Temporal20 -> Env20 -> Property +prop_v20_fullRoundTrip b t e = + let input = full20Vector b t e + in case CVSS.parseCVSS input of + Right cvss -> CVSS.cvssVectorString cvss === input + Left err -> counterexample ("parse failed: " <> show err) False + +-- ------------------------------------------------------------------ +-- Official FIRST cross-validation +-- ------------------------------------------------------------------ + +officialTestCaseV20 :: OfficialExample -> TestTree +officialTestCaseV20 ex = + testCase (Text.unpack $ oeVector ex) $ + case CVSS.parseCVSS (oeVector ex) of + Left e -> assertFailure (show e) + Right cvss -> do + let (rating, score) = CVSS.cvssScore cvss + score @?= oeBaseScore ex + rating @?= oeBaseRating ex + case oeTemporalScore ex of + Just (expectedScore, expectedRating) -> + case cvss of + CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS20, CVSS.cvssMetrics = cm} -> CVSS.cvss20TemporalScore cm @?= (expectedRating, expectedScore) + _ -> assertFailure "Not a CVSS v2.0 vector" + Nothing -> pure () + case oeEnvironmentalScore ex of + Just (expectedScore, expectedRating) -> + case cvss of + CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS20, CVSS.cvssMetrics = cm} -> CVSS.cvss20EnvironmentalScore cm @?= (expectedRating, expectedScore) + _ -> assertFailure "Not a CVSS v2.0 vector" + Nothing -> pure () diff --git a/test/TestCVSS/V30.hs b/test/TestCVSS/V30.hs new file mode 100644 --- /dev/null +++ b/test/TestCVSS/V30.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE OverloadedStrings #-} + +module TestCVSS.V30 + ( v30Tests, + ) +where + +import Data.Text (Text) +import qualified Data.Text as Text +import OfficialExamples (cvss30OfficialExamples) +import qualified Security.CVSS as CVSS +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import TestCVSS.Common + +v30Tests :: TestTree +v30Tests = + testGroup + "CVSS v3.0" + [ testGroup "score examples" $ scoreTestCase <$> v30ScoreExamples, + testGroup "temporal score examples" $ temporalCase <$> cvss30TemporalExamples, + testCase "ND temporal metrics do not change score" testCVSS30NotDefinedNoScoreChange, + testGroup "environmental score examples" $ envCase <$> cvss30EnvironmentalExamples, + testCase "ND environmental metrics do not change score" testCVSS30EnvironmentalNotDefinedNoScoreChange, + testGroup + "QuickCheck Properties" + [ testProperty "temporal <= base" prop_v30_temporalLEBase, + testProperty "ND temporal doesn't change score" prop_v30_ndTemporalNoChange, + testProperty "ND env doesn't change score" prop_v30_ndEnvNoChange, + testProperty "temporal score in [0, 10]" prop_v30_temporalScoreBounds, + testProperty "env score in [0, 10]" prop_v30_envScoreBounds, + testProperty "env rating consistent with score" prop_v30_envRatingConsistency, + testProperty "full vector roundtrip" prop_v30_fullRoundTrip + ], + testGroup "Official FIRST cross-validation" $ officialTestCaseV3X <$> cvss30OfficialExamples + ] + +-- ------------------------------------------------------------------ +-- Example data +-- ------------------------------------------------------------------ + +v30ScoreExamples :: [(Text, Float, CVSS.Rating)] +v30ScoreExamples = + [ ("CVSS:3.0/AV:N/AC:L/PR:N/UI:R/S:C/C:L/I:L/A:N", 6.1, CVSS.Medium), + ("CVSS:3.0/AV:N/AC:L/PR:L/UI:N/S:C/C:L/I:L/A:N", 6.4, CVSS.Medium), + ("CVSS:3.0/AV:N/AC:H/PR:N/UI:R/S:U/C:L/I:N/A:N", 3.1, CVSS.Low), + ("CVSS:3.0/AV:L/AC:L/PR:N/UI:N/S:U/C:N/I:L/A:N", 4.0, CVSS.Medium), + ("CVSS:3.0/AV:N/AC:L/PR:L/UI:N/S:C/C:H/I:H/A:H", 9.9, CVSS.Critical), + ("CVSS:3.0/AV:L/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:L", 4.2, CVSS.Medium), + ("CVSS:3.0/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H/E:F/RL:O/RC:R", 8.7, CVSS.High) + ] + +cvss30TemporalExamples :: [(Text, Float, CVSS.Rating)] +cvss30TemporalExamples = + [ ("CVSS:3.0/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H/E:F/RL:O/RC:R", 8.7, CVSS.High), + ("CVSS:3.0/AV:N/AC:L/PR:N/UI:R/S:C/C:L/I:L/A:N/E:F/RL:O/RC:R", 5.4, CVSS.Medium), + ("CVSS:3.0/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H/E:X/RL:X/RC:X", 9.8, CVSS.Critical) + ] + +cvss30EnvironmentalExamples :: [(Text, Float, CVSS.Rating)] +cvss30EnvironmentalExamples = + [ ( "CVSS:3.0/AV:N/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:N/E:F/CR:L/IR:M/AR:H/MAV:N/MAC:L/MPR:H/MUI:R/MS:C/MC:L/MI:H/MA:N", + 6.5, + CVSS.Medium + ), + ( "CVSS:3.0/AV:N/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:N/CR:M/IR:M/AR:M/MAV:N/MAC:L/MPR:H/MUI:N/MS:C/MC:L/MI:L/MA:N", + 5.5, + CVSS.Medium + ) + ] + +-- ------------------------------------------------------------------ +-- Individual test-case builders +-- ------------------------------------------------------------------ + +temporalCase :: (Text, Float, CVSS.Rating) -> TestTree +temporalCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS30, CVSS.cvssMetrics = cm} -> + CVSS.cvss30TemporalScore cm @?= (rating, score) + other -> assertFailure (show other) + +envCase :: (Text, Float, CVSS.Rating) -> TestTree +envCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS30, CVSS.cvssMetrics = cm} -> + CVSS.cvss30EnvironmentalScore cm @?= (rating, score) + other -> assertFailure (show other) + +-- ------------------------------------------------------------------ +-- Single-assertion tests +-- ------------------------------------------------------------------ + +testCVSS30NotDefinedNoScoreChange :: Assertion +testCVSS30NotDefinedNoScoreChange = do + let baseVector = "CVSS:3.0/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H" + fullVector = baseVector <> "/E:X/RL:X/RC:X" + case (CVSS.parseCVSS baseVector, CVSS.parseCVSS fullVector) of + (Right baseCvss, Right fullCvss) -> + CVSS.cvssScore fullCvss @?= CVSS.cvssScore baseCvss + _ -> assertFailure "base or full vector parse failed" + +testCVSS30EnvironmentalNotDefinedNoScoreChange :: Assertion +testCVSS30EnvironmentalNotDefinedNoScoreChange = do + let temporalVector = "CVSS:3.0/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H/E:F/RL:O/RC:R" + fullVector = temporalVector <> "/CR:X/IR:X/AR:X/MAV:X/MAC:X/MPR:X/MUI:X/MS:X/MC:X/MI:X/MA:X" + case (CVSS.parseCVSS temporalVector, CVSS.parseCVSS fullVector) of + (Right temporalCvss, Right fullCvss) -> + CVSS.cvssScore fullCvss @?= CVSS.cvssScore temporalCvss + _ -> assertFailure "temporal or full vector parse failed" + +-- ------------------------------------------------------------------ +-- QuickCheck properties +-- ------------------------------------------------------------------ + +prop_v30_temporalLEBase :: Base31 -> Temporal3x -> Property +prop_v30_temporalLEBase b t = + let baseInput = base30Vector b + temporalInput = baseInput <> "/" <> temporal3xVector t + in case (CVSS.parseCVSS baseInput, CVSS.parseCVSS temporalInput) of + (Right baseCvss, Right temporalCvss) -> + let (_, baseScore) = CVSS.cvssScore baseCvss + (_, temporalScore) = CVSS.cvss30TemporalScore (CVSS.cvssMetrics temporalCvss) + in property $ temporalScore <= baseScore + _ -> counterexample "parse failed" False + +prop_v30_ndTemporalNoChange :: Base31 -> Property +prop_v30_ndTemporalNoChange b = + let baseInput = base30Vector b + ndTemporal = "/E:X/RL:X/RC:X" + temporalInput = baseInput <> ndTemporal + in case (CVSS.parseCVSS baseInput, CVSS.parseCVSS temporalInput) of + (Right baseCvss, Right temporalCvss) -> + CVSS.cvssScore baseCvss === CVSS.cvss30TemporalScore (CVSS.cvssMetrics temporalCvss) + _ -> counterexample "parse failed" False + +prop_v30_ndEnvNoChange :: Base31 -> Temporal3x -> Property +prop_v30_ndEnvNoChange b t = + let temporalInput = base30Vector b <> "/" <> temporal3xVector t + ndEnv = "/CR:X/IR:X/AR:X/MAV:X/MAC:X/MPR:X/MUI:X/MS:X/MC:X/MI:X/MA:X" + envInput = temporalInput <> ndEnv + in case (CVSS.parseCVSS temporalInput, CVSS.parseCVSS envInput) of + (Right temporalCvss, Right envCvss) -> + CVSS.cvss30TemporalScore (CVSS.cvssMetrics temporalCvss) === CVSS.cvss30EnvironmentalScore (CVSS.cvssMetrics envCvss) + _ -> counterexample "parse failed" False + +prop_v30_temporalScoreBounds :: Base31 -> Temporal3x -> Property +prop_v30_temporalScoreBounds b t = + let temporalInput = base30Vector b <> "/" <> temporal3xVector t + in case CVSS.parseCVSS temporalInput of + Right cvss -> + let (_, score) = CVSS.cvss30TemporalScore (CVSS.cvssMetrics cvss) + in score >= 0.0 .&&. score <= 10.0 + Left err -> counterexample ("parse failed: " <> show err) False + +prop_v30_envScoreBounds :: Base31 -> Temporal3x -> Env3x -> Property +prop_v30_envScoreBounds b t e = + let envInput = full30Vector b t e + in case CVSS.parseCVSS envInput of + Right cvss -> + let (_, score) = CVSS.cvss30EnvironmentalScore (CVSS.cvssMetrics cvss) + in score >= 0.0 .&&. score <= 10.0 + Left err -> counterexample ("parse failed: " <> show err) False + +prop_v30_envRatingConsistency :: Base31 -> Temporal3x -> Env3x -> Property +prop_v30_envRatingConsistency b t e = + let envInput = full30Vector b t e + in case CVSS.parseCVSS envInput of + Right cvss -> + let (rating, score) = CVSS.cvss30EnvironmentalScore (CVSS.cvssMetrics cvss) + in rating === CVSS.toRating score + Left err -> counterexample ("parse failed: " <> show err) False + +prop_v30_fullRoundTrip :: Base31 -> Temporal3x -> Env3x -> Property +prop_v30_fullRoundTrip b t e = + let input = full30Vector b t e + in case CVSS.parseCVSS input of + Right cvss -> CVSS.cvssVectorString cvss === input + Left err -> counterexample ("parse failed: " <> show err) False diff --git a/test/TestCVSS/V31.hs b/test/TestCVSS/V31.hs new file mode 100644 --- /dev/null +++ b/test/TestCVSS/V31.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE OverloadedStrings #-} + +module TestCVSS.V31 + ( v31Tests, + ) +where + +import Data.Text (Text) +import qualified Data.Text as Text +import OfficialExamples (cvss31OfficialExamples) +import qualified Security.CVSS as CVSS +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import TestCVSS.Common + +v31Tests :: TestTree +v31Tests = + testGroup + "CVSS v3.1" + [ testGroup "score examples" $ scoreTestCase <$> v31ScoreExamples, + testGroup "temporal score examples" $ temporalCase <$> v31TemporalExamples, + testGroup "environmental score examples" $ envCase <$> v31EnvironmentalExamples, + testCase "X temporal/env metrics do not change score" testNotDefinedOptionalNoScoreChange, + testProperty "parser preserves original vector string" prop_cvss31RoundTrip, + testGroup + "QuickCheck Properties" + [ testProperty "temporal <= base" prop_v31_temporalLEBase, + testProperty "ND temporal doesn't change score" prop_v31_ndTemporalNoChange, + testProperty "ND env doesn't change score" prop_v31_ndEnvNoChange, + testProperty "temporal score in [0, 10]" prop_v31_temporalScoreBounds, + testProperty "env score in [0, 10]" prop_v31_envScoreBounds, + testProperty "env rating consistent with score" prop_v31_envRatingConsistency, + testProperty "temporal vector roundtrip" prop_v31_temporalRoundTrip + ], + testGroup "Official FIRST cross-validation" $ officialTestCaseV3X <$> cvss31OfficialExamples + ] + +-- ------------------------------------------------------------------ +-- Example data +-- ------------------------------------------------------------------ + +v31ScoreExamples :: [(Text, Float, CVSS.Rating)] +v31ScoreExamples = + [ ("CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:C/C:N/I:L/A:N", 5.8, CVSS.Medium), + ("CVSS:3.1/AV:N/AC:L/PR:L/UI:N/S:C/C:L/I:L/A:N", 6.4, CVSS.Medium), + ("CVSS:3.1/AV:N/AC:H/PR:N/UI:R/S:U/C:L/I:N/A:N", 3.1, CVSS.Low), + ("CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:N/A:N", 7.5, CVSS.High), + ( "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H/E:X/RL:X/RC:X/CR:X/IR:X/AR:X/MAV:X/MAC:X/MPR:X/MUI:X/MS:X/MC:X/MI:X/MA:X", + 9.8, + CVSS.Critical + ), + ("CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H/E:F/RL:O/RC:R", 8.7, CVSS.High) + ] + +v31TemporalExamples :: [(Text, Float, CVSS.Rating)] +v31TemporalExamples = + [ ("CVSS:3.1/AV:N/AC:H/PR:N/UI:N/S:C/C:H/I:H/A:H/E:F/RL:O/RC:R", 8.0, CVSS.High), + ("CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:N/I:H/A:N/E:F/RL:O/RC:R", 6.7, CVSS.Medium), + ( "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H/E:X/RL:X/RC:X/CR:X/IR:X/AR:X/MAV:X/MAC:X/MPR:X/MUI:X/MS:X/MC:X/MI:X/MA:X", + 9.8, + CVSS.Critical + ), + ("CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H/E:F/RL:O/RC:R", 8.7, CVSS.High) + ] + +v31EnvironmentalExamples :: [(Text, Float, CVSS.Rating)] +v31EnvironmentalExamples = + [ ( "CVSS:3.1/AV:N/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:N/E:F/CR:L/IR:M/AR:H/MAV:N/MAC:L/MPR:H/MUI:R/MS:C/MC:L/MI:H/MA:N", + 6.5, + CVSS.Medium + ), + ( "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H/E:X/RL:X/RC:X/CR:X/IR:X/AR:X/MAV:X/MAC:X/MPR:X/MUI:X/MS:X/MC:X/MI:X/MA:X", + 9.8, + CVSS.Critical + ), + ( "CVSS:3.1/AV:N/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:N/CR:M/IR:M/AR:M/MAV:N/MAC:L/MPR:H/MUI:N/MS:C/MC:L/MI:L/MA:N", + 5.5, + CVSS.Medium + ) + ] + +-- ------------------------------------------------------------------ +-- Individual test-case builders +-- ------------------------------------------------------------------ + +temporalCase :: (Text, Float, CVSS.Rating) -> TestTree +temporalCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS31, CVSS.cvssMetrics = cm} -> + CVSS.cvss31TemporalScore cm @?= (rating, score) + other -> assertFailure (show other) + +envCase :: (Text, Float, CVSS.Rating) -> TestTree +envCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS31, CVSS.cvssMetrics = cm} -> + CVSS.cvss31EnvironmentalScore cm @?= (rating, score) + other -> assertFailure (show other) + +-- ------------------------------------------------------------------ +-- Single-assertion tests +-- ------------------------------------------------------------------ + +testNotDefinedOptionalNoScoreChange :: Assertion +testNotDefinedOptionalNoScoreChange = do + let baseVector = "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H" + fullVector = baseVector <> notDefinedTemporalEnv + case (CVSS.parseCVSS baseVector, CVSS.parseCVSS fullVector) of + (Right baseCvss, Right fullCvss) -> + CVSS.cvssScore fullCvss @?= CVSS.cvssScore baseCvss + _ -> assertFailure ("base parse failed: " <> show fullVector) + +-- ------------------------------------------------------------------ +-- QuickCheck properties +-- ------------------------------------------------------------------ + +prop_cvss31RoundTrip :: Base31 -> Property +prop_cvss31RoundTrip b = + let input = base31Vector b <> notDefinedTemporalEnv + in case CVSS.parseCVSS input of + Right cvss -> CVSS.cvssVectorString cvss === input + Left e -> counterexample ("parse failed: " <> show e <> "\n" <> Text.unpack input) False + +prop_v31_temporalLEBase :: Base31 -> Temporal3x -> Property +prop_v31_temporalLEBase b t = + let baseInput = base31Vector b + temporalInput = baseInput <> "/" <> temporal3xVector t + in case (CVSS.parseCVSS baseInput, CVSS.parseCVSS temporalInput) of + (Right baseCvss, Right temporalCvss) -> + let (_, baseScore) = CVSS.cvssScore baseCvss + (_, temporalScore) = CVSS.cvss31TemporalScore (CVSS.cvssMetrics temporalCvss) + in property $ temporalScore <= baseScore + _ -> counterexample "parse failed" False + +prop_v31_ndTemporalNoChange :: Base31 -> Property +prop_v31_ndTemporalNoChange b = + let baseInput = base31Vector b + ndTemporal = "/E:X/RL:X/RC:X" + temporalInput = baseInput <> ndTemporal + in case (CVSS.parseCVSS baseInput, CVSS.parseCVSS temporalInput) of + (Right baseCvss, Right temporalCvss) -> + CVSS.cvssScore baseCvss === CVSS.cvss31TemporalScore (CVSS.cvssMetrics temporalCvss) + _ -> counterexample "parse failed" False + +prop_v31_ndEnvNoChange :: Base31 -> Temporal3x -> Property +prop_v31_ndEnvNoChange b t = + let temporalInput = base31Vector b <> "/" <> temporal3xVector t + ndEnv = "/CR:X/IR:X/AR:X/MAV:X/MAC:X/MPR:X/MUI:X/MS:X/MC:X/MI:X/MA:X" + envInput = temporalInput <> ndEnv + in case (CVSS.parseCVSS temporalInput, CVSS.parseCVSS envInput) of + (Right temporalCvss, Right envCvss) -> + CVSS.cvss31TemporalScore (CVSS.cvssMetrics temporalCvss) === CVSS.cvss31EnvironmentalScore (CVSS.cvssMetrics envCvss) + _ -> counterexample "parse failed" False + +prop_v31_temporalScoreBounds :: Base31 -> Temporal3x -> Property +prop_v31_temporalScoreBounds b t = + let temporalInput = base31Vector b <> "/" <> temporal3xVector t + in case CVSS.parseCVSS temporalInput of + Right cvss -> + let (_, score) = CVSS.cvss31TemporalScore (CVSS.cvssMetrics cvss) + in score >= 0.0 .&&. score <= 10.0 + Left err -> counterexample ("parse failed: " <> show err) False + +prop_v31_envScoreBounds :: Base31 -> Temporal3x -> Env3x -> Property +prop_v31_envScoreBounds b t e = + let envInput = full31EnvVector b t e + in case CVSS.parseCVSS envInput of + Right cvss -> + let (_, score) = CVSS.cvss31EnvironmentalScore (CVSS.cvssMetrics cvss) + in score >= 0.0 .&&. score <= 10.0 + Left err -> counterexample ("parse failed: " <> show err) False + +prop_v31_envRatingConsistency :: Base31 -> Temporal3x -> Env3x -> Property +prop_v31_envRatingConsistency b t e = + let envInput = full31EnvVector b t e + in case CVSS.parseCVSS envInput of + Right cvss -> + let (rating, score) = CVSS.cvss31EnvironmentalScore (CVSS.cvssMetrics cvss) + in rating === CVSS.toRating score + Left err -> counterexample ("parse failed: " <> show err) False + +prop_v31_temporalRoundTrip :: Base31 -> Temporal3x -> Property +prop_v31_temporalRoundTrip b t = + let input = full31TemporalVector b t + in case CVSS.parseCVSS input of + Right cvss -> CVSS.cvssVectorString cvss === input + Left err -> counterexample ("parse failed: " <> show err) False diff --git a/test/TestCVSS/V40.hs b/test/TestCVSS/V40.hs new file mode 100644 --- /dev/null +++ b/test/TestCVSS/V40.hs @@ -0,0 +1,412 @@ +{-# LANGUAGE OverloadedStrings #-} + +module TestCVSS.V40 + ( v40Tests, + ) +where + +import Data.Maybe (isJust) +import Data.Text (Text) +import qualified Data.Text as Text +import OfficialExamples (OfficialExample (..), cvss40OfficialExamples) +import qualified Security.CVSS as CVSS +import qualified Security.CVSS.V40 as V40 +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import TestCVSS.Common + +v40Tests :: TestTree +v40Tests = + testGroup + "CVSS v4.0" + [ testGroup "valid parsing" $ validParseCase <$> cvss40ValidVectors, + testGroup "invalid parsing" $ invalidParseCase <$> cvss40InvalidVectors, + testCase "should require CVSS:4.0/ prefix" testCVSS40LegacyRejected, + testGroup "base score examples" $ cvss40ScoringCase <$> cvss40ScoringExamples, + testGroup "expanded base score tests" $ cvss40ScoringCase <$> cvss40ExpandedExamples, + testGroup "direct baseScore tests" $ cvss40BaseScoreCase <$> cvss40BaseScoreExamples, + testGroup "threat score examples" $ threatCase <$> cvss40ThreatExamples, + testGroup "environmental score examples" $ envCase <$> cvss40EnvironmentalExamples, + testGroup "parsing with optional metrics" $ optionalParseCase <$> cvss40OptionalVectors, + testCase "X metrics do not change score" testCVSS40XMetricsNoScoreChange, + testGroup "rating boundary tests" $ boundaryCase <$> cvss40BoundaryTests, + testGroup + "QuickCheck Properties" + [ testProperty "parser preserves original vector string" prop_cvss40RoundTrip, + testProperty "environmental parser preserves original vector string" prop_cvss40EnvRoundTrip, + testProperty "all-X environmental metrics do not change score" prop_cvss40EnvXNoScoreChange, + testProperty "environmental score is in [0, 10]" prop_cvss40EnvScoreBounds, + testProperty "environmental rating is consistent with score" prop_cvss40EnvRatingConsistency + ], + testGroup "Supplemental Metrics" testSupplementalMetrics, + testGroup "CVSS Nomenclature" testNomenclature, + testGroup "Official FIRST cross-validation" $ officialTestCaseV40 <$> cvss40OfficialExamples + ] + +-- ------------------------------------------------------------------ +-- Example data +-- ------------------------------------------------------------------ + +cvss40ValidVectors :: [(Text, Int)] +cvss40ValidVectors = + [ ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N", 11), + ("CVSS:4.0/AV:N/AC:H/AT:N/PR:H/UI:N/VC:L/VI:N/VA:N/SC:L/SI:N/SA:N/E:X", 12), + ("CVSS:4.0/AV:A/AC:L/AT:P/PR:L/UI:P/VC:H/VI:H/VA:H/SC:H/SI:H/SA:H", 11) + ] + +cvss40InvalidVectors :: [Text] +cvss40InvalidVectors = + [ "CVSS:4.0/AV:N/AC:L/PR:N/UI:N/VC:H/VI:H/VA:N", + "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N", + "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N/E:INVALID", + "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N/AV:N", + "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:S/SA:N", + "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:N/SA:S" + ] + +cvss40ScoringExamples :: [(Text, Float, CVSS.Rating)] +cvss40ScoringExamples = + [ ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:H/SA:N", 9.9, CVSS.Critical), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N", 9.3, CVSS.Critical), + ("CVSS:4.0/AV:A/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N", 8.6, CVSS.High), + ("CVSS:4.0/AV:L/AC:L/AT:N/PR:L/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N", 8.4, CVSS.High), + ("CVSS:4.0/AV:P/AC:L/AT:N/PR:N/UI:N/VC:N/VI:N/VA:N/SC:N/SI:N/SA:N", 2.4, CVSS.Low) + ] + +cvss40ExpandedExamples :: [(Text, Float, CVSS.Rating)] +cvss40ExpandedExamples = + [] + +cvss40BaseScoreExamples :: [(Text, Float, CVSS.Rating)] +cvss40BaseScoreExamples = + [ ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:H/SA:H", 10.0, CVSS.Critical), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N", 9.3, CVSS.Critical), + ("CVSS:4.0/AV:L/AC:L/AT:N/PR:L/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N", 8.4, CVSS.High), + ("CVSS:4.0/AV:P/AC:L/AT:N/PR:N/UI:N/VC:N/VI:N/VA:N/SC:N/SI:N/SA:N", 2.4, CVSS.Low), + ("CVSS:4.0/AV:N/AC:L/AT:P/PR:L/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N", 7.6, CVSS.High) + ] + +cvss40ThreatExamples :: [(Text, Float, CVSS.Rating)] +cvss40ThreatExamples = + [ ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N/E:A", 9.3, CVSS.Critical), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N/E:P", 8.8, CVSS.High), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N/E:U", 8.0, CVSS.High) + ] + +cvss40EnvironmentalExamples :: [(Text, Float, CVSS.Rating)] +cvss40EnvironmentalExamples = + [ ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:H/SA:H/CR:X/IR:X/AR:X/MAV:X/MAC:X/MAT:X/MPR:X/MUI:X/MVC:X/MVI:X/MVA:X/MSC:X/MSI:S/MSA:X", 10.0, CVSS.Critical), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:H/SA:H/CR:H/IR:H/AR:H/MAV:L", 9.4, CVSS.Critical), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:H/SA:H/CR:L/IR:L/AR:L", 9.6, CVSS.Critical), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:H/SA:H/CR:X/IR:X/AR:X/MVC:L", 9.3, CVSS.Critical), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:H/SA:H/CR:X/IR:X/AR:X/MAV:X/MAC:X/MAT:X/MPR:X/MUI:X/MVC:X/MVI:X/MVA:X/MSC:X/MSI:S/MSA:X", 10.0, CVSS.Critical), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:H/SA:H/CR:X/IR:X/AR:X/MAV:X/MAC:X/MAT:X/MPR:X/MUI:X/MVC:X/MVI:X/MVA:X/MSC:X/MSI:X/MSA:S", 10.0, CVSS.Critical), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:H/SI:H/SA:H/CR:X/IR:X/AR:X/MAV:X/MAC:X/MAT:X/MPR:X/MUI:X/MVC:X/MVI:X/MVA:X/MSC:X/MSI:S/MSA:S", 10.0, CVSS.Critical) + ] + +cvss40OptionalVectors :: [(Text, Int)] +cvss40OptionalVectors = + [ ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/S:N", 12), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/S:N/AU:N", 13), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:X", 12), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:A", 12), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:P", 12), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:U", 12), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/CR:H/IR:H/AR:H", 14), + ("CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/S:N/AU:N/E:X/CR:X/IR:X/AR:X", 17) + ] + +cvss40BoundaryTests :: [(Float, CVSS.Rating)] +cvss40BoundaryTests = + [ (0, CVSS.None), + (0.1, CVSS.Low), + (3.9, CVSS.Low), + (4.0, CVSS.Medium), + (6.9, CVSS.Medium), + (7.0, CVSS.High), + (8.9, CVSS.High), + (9.0, CVSS.Critical), + (10, CVSS.Critical) + ] + +-- ------------------------------------------------------------------ +-- Individual test-case builders +-- ------------------------------------------------------------------ + +validParseCase :: (Text, Int) -> TestTree +validParseCase (cvssString, expectedMetricsCount) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS40, CVSS.cvssMetrics = metrics} -> do + length metrics @?= expectedMetricsCount + CVSS.cvssVectorString (CVSS.CVSS CVSS.CVSS40 metrics) @?= cvssString + other -> assertFailure $ "Failed to parse valid CVSS 4.0: " <> show other <> " for " <> show cvssString + +invalidParseCase :: Text -> TestTree +invalidParseCase cvssString = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Left _ -> pure () + Right _ -> assertFailure $ "Should have failed to parse: " <> show cvssString + +cvss40ScoringCase :: (Text, Float, CVSS.Rating) -> TestTree +cvss40ScoringCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Left e -> assertFailure (show e) + Right cvss -> do + CVSS.cvssScore cvss @?= (rating, score) + CVSS.cvssVectorString cvss @?= cvssString + +cvss40BaseScoreCase :: (Text, Float, CVSS.Rating) -> TestTree +cvss40BaseScoreCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Left e -> assertFailure (show e) + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS40, CVSS.cvssMetrics = cm} -> + V40.cvss40BaseScore cm @?= (rating, score) + other -> assertFailure $ "Not a CVSS 4.0 vector: " <> show other + +threatCase :: (Text, Float, CVSS.Rating) -> TestTree +threatCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS40, CVSS.cvssMetrics = cm} -> + V40.cvss40ThreatScore cm @?= (rating, score) + other -> assertFailure (show other) + +envCase :: (Text, Float, CVSS.Rating) -> TestTree +envCase (cvssString, score, rating) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS40, CVSS.cvssMetrics = cm} -> + CVSS.cvss40EnvironmentalScore cm @?= (rating, score) + other -> assertFailure (show other) + +optionalParseCase :: (Text, Int) -> TestTree +optionalParseCase (cvssString, expectedCount) = + testCase (Text.unpack cvssString) $ + case CVSS.parseCVSS cvssString of + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS40, CVSS.cvssMetrics = cm} -> do + length cm @?= expectedCount + CVSS.cvssVectorString (CVSS.CVSS CVSS.CVSS40 cm) @?= cvssString + other -> assertFailure $ "Failed to parse: " <> show other <> " for " <> show cvssString + +boundaryCase :: (Float, CVSS.Rating) -> TestTree +boundaryCase (score, expectedRating) = + testCase ("boundary: " <> show score) $ + CVSS.toRating score @?= expectedRating + +-- ------------------------------------------------------------------ +-- Single-assertion tests +-- ------------------------------------------------------------------ + +testCVSS40LegacyRejected :: Assertion +testCVSS40LegacyRejected = + case CVSS.parseCVSS "AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:N/SC:N/SI:N/SA:N" of + Left _ -> pure () + Right _ -> assertFailure "CVSS 4.0 should require CVSS:4.0/ prefix (no legacy format)" + +testCVSS40XMetricsNoScoreChange :: Assertion +testCVSS40XMetricsNoScoreChange = do + let baseVector = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N" + xMetrics = "/E:X/S:N/AU:N/CR:X/IR:X/AR:X" + fullVector = baseVector <> xMetrics + case (CVSS.parseCVSS baseVector, CVSS.parseCVSS fullVector) of + (Right CVSS.CVSS {CVSS.cvssMetrics = baseMetrics}, Right CVSS.CVSS {CVSS.cvssMetrics = fullMetrics}) -> + V40.cvss40BaseScore baseMetrics @?= V40.cvss40BaseScore fullMetrics + _ -> assertFailure "Failed to parse base or full vector" + +-- ------------------------------------------------------------------ +-- QuickCheck properties +-- ------------------------------------------------------------------ + +prop_cvss40RoundTrip :: Base40 -> Property +prop_cvss40RoundTrip b = + let input = base40Vector b + in case CVSS.parseCVSS input of + Right cvss -> CVSS.cvssVectorString cvss === input + Left e -> counterexample ("parse failed: " <> show e <> "\n" <> Text.unpack input) False + +prop_cvss40EnvRoundTrip :: Base40 -> Env40 -> Property +prop_cvss40EnvRoundTrip b e = + let input = full40Vector b e + in case CVSS.parseCVSS input of + Right cvss -> CVSS.cvssVectorString cvss === input + Left err -> counterexample ("parse failed: " <> show err <> "\n" <> Text.unpack input) False + +prop_cvss40EnvXNoScoreChange :: Base40 -> Property +prop_cvss40EnvXNoScoreChange b = + let baseInput = base40Vector b + fullInput = full40Vector b allXEnv + in case (CVSS.parseCVSS baseInput, CVSS.parseCVSS fullInput) of + (Right baseCvss, Right fullCvss) -> + let (_, baseScore) = CVSS.cvssScore baseCvss + (_, fullScore) = CVSS.cvssScore fullCvss + in fullScore === baseScore + _ -> counterexample "parse failed for base or full vector" False + +prop_cvss40EnvScoreBounds :: Base40 -> Env40 -> Property +prop_cvss40EnvScoreBounds b e = + let input = full40Vector b e + in case CVSS.parseCVSS input of + Right cvss -> + let (_, score) = CVSS.cvssScore cvss + in score >= 0.0 .&&. score <= 10.0 + Left err -> counterexample ("parse failed: " <> show err <> "\n" <> Text.unpack input) False + +prop_cvss40EnvRatingConsistency :: Base40 -> Env40 -> Property +prop_cvss40EnvRatingConsistency b e = + let input = full40Vector b e + in case CVSS.parseCVSS input of + Right CVSS.CVSS {CVSS.cvssMetrics = cm} -> + let (rating, score) = CVSS.cvss40EnvironmentalScore cm + in rating === CVSS.toRating score + Left err -> counterexample ("parse failed: " <> show err <> "\n" <> Text.unpack input) False + +-- ------------------------------------------------------------------ +-- Supplemental Metrics +-- ------------------------------------------------------------------ + +testSupplementalMetrics :: [TestTree] +testSupplementalMetrics = + [ testCase "No supplemental metrics" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N" + case CVSS.parseCVSS vec of + Right cvss -> do + V40.hasSupplementalMetrics (CVSS.cvssMetrics cvss) @?= False + CVSS.cvssSupplementalInfo cvss @?= Nothing + Left e -> assertFailure $ show e, + testCase "Single supplemental metric" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/S:P" + case CVSS.parseCVSS vec of + Right cvss -> do + V40.hasSupplementalMetrics (CVSS.cvssMetrics cvss) @?= True + let info = CVSS.cvssSupplementalInfo cvss + isJust info @?= True + maybeInfo <- maybe (pure "") pure info + Text.isInfixOf "Safety" maybeInfo @?= True + Text.isInfixOf "Present" maybeInfo @?= True + Left e -> assertFailure $ show e, + testCase "All supplemental metrics" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/S:P/AU:Y/R:A/V:D/RE:H/U:C" + case CVSS.parseCVSS vec of + Right cvss -> do + V40.hasSupplementalMetrics (CVSS.cvssMetrics cvss) @?= True + let info = CVSS.cvssSupplementalInfo cvss + maybeInfo <- maybe (pure "") pure info + Text.isInfixOf "Safety" maybeInfo @?= True + Text.isInfixOf "Automatable" maybeInfo @?= True + Text.isInfixOf "Recovery" maybeInfo @?= True + Text.isInfixOf "Value Density" maybeInfo @?= True + Text.isInfixOf "Vulnerability Response Effort" maybeInfo @?= True + Text.isInfixOf "Provider Urgency" maybeInfo @?= True + Left e -> assertFailure $ show e, + testCase "Supplemental does not affect score" $ do + let baseVec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N" + withSupplemental = baseVec <> "/S:P/AU:Y/R:A/V:D/RE:H/U:C" + case (CVSS.parseCVSS baseVec, CVSS.parseCVSS withSupplemental) of + (Right baseCvss, Right suppCvss) -> do + let (_, baseScore) = V40.cvss40BaseScore (CVSS.cvssMetrics baseCvss) + (_, suppScore) = V40.cvss40BaseScore (CVSS.cvssMetrics suppCvss) + suppScore @?= baseScore + _ -> assertFailure "Parse failed", + testCase "getSupplementalValue returns correct value" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/S:P/AU:Y/R:A/V:D/RE:H/U:C" + case CVSS.parseCVSS vec of + Right cvss -> do + V40.getSupplementalValue (CVSS.cvssMetrics cvss) "S" @?= Just "P" + V40.getSupplementalValue (CVSS.cvssMetrics cvss) "AU" @?= Just "Y" + V40.getSupplementalValue (CVSS.cvssMetrics cvss) "NOTEXIST" @?= Nothing + Left e -> assertFailure $ show e, + testCase "parseSupplementalValue returns correct descriptions" $ do + V40.parseSupplementalValue "S" "P" @?= Just "Present" + V40.parseSupplementalValue "S" "N" @?= Just "Negligible" + V40.parseSupplementalValue "AU" "Y" @?= Just "Yes" + V40.parseSupplementalValue "AU" "N" @?= Just "No" + V40.parseSupplementalValue "R" "A" @?= Just "Automatic" + V40.parseSupplementalValue "R" "U" @?= Just "User" + V40.parseSupplementalValue "R" "I" @?= Just "Irreversible" + V40.parseSupplementalValue "V" "D" @?= Just "Diffuse" + V40.parseSupplementalValue "V" "C" @?= Just "Concentrated" + V40.parseSupplementalValue "RE" "L" @?= Just "Low" + V40.parseSupplementalValue "RE" "M" @?= Just "Moderate" + V40.parseSupplementalValue "RE" "H" @?= Just "High" + V40.parseSupplementalValue "U" "C" @?= Just "Clear" + V40.parseSupplementalValue "U" "A" @?= Just "Amber" + V40.parseSupplementalValue "U" "G" @?= Just "Green", + testCase "cvssSupplementalInfo returns Nothing for non-CVSS40" $ do + let vec = "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H" + case CVSS.parseCVSS vec of + Right cvss -> CVSS.cvssSupplementalInfo cvss @?= Nothing + Left e -> assertFailure $ show e + ] + +-- ------------------------------------------------------------------ +-- CVSS Nomenclature +-- ------------------------------------------------------------------ + +testNomenclature :: [TestTree] +testNomenclature = + [ testCase "Base only is CVSS-B" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N" + case CVSS.parseCVSS vec of + Right cvss -> CVSS.determineNomenclature cvss @?= CVSS.CVSS_B + Left e -> assertFailure $ show e, + testCase "Base + Threat (E:A) is CVSS-BT" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:A" + case CVSS.parseCVSS vec of + Right cvss -> CVSS.determineNomenclature cvss @?= CVSS.CVSS_BT + Left e -> assertFailure $ show e, + testCase "Base + Threat (E:X) is CVSS-BT" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:X" + case CVSS.parseCVSS vec of + Right cvss -> CVSS.determineNomenclature cvss @?= CVSS.CVSS_BT + Left e -> assertFailure $ show e, + testCase "Base + Environmental (CR:H) is CVSS-BE" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/CR:H" + case CVSS.parseCVSS vec of + Right cvss -> CVSS.determineNomenclature cvss @?= CVSS.CVSS_BE + Left e -> assertFailure $ show e, + testCase "Base + Threat + Environmental is CVSS-BTE" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:A/CR:H" + case CVSS.parseCVSS vec of + Right cvss -> CVSS.determineNomenclature cvss @?= CVSS.CVSS_BTE + Left e -> assertFailure $ show e, + testCase "All X metrics is CVSS-BTE" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N/E:X/CR:X/IR:X/AR:X/MAV:X/MAC:X/MAT:X/MPR:X/MUI:X/MVC:X/MVI:X/MVA:X/MSC:X/MSI:X/MSA:X" + case CVSS.parseCVSS vec of + Right cvss -> CVSS.determineNomenclature cvss @?= CVSS.CVSS_BTE + Left e -> assertFailure $ show e, + testCase "CVSS 3.1 is always CVSS-B" $ do + let vec = "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H/E:U/RL:O/RC:C/CR:H/IR:H/AR:H" + case CVSS.parseCVSS vec of + Right cvss -> CVSS.determineNomenclature cvss @?= CVSS.CVSS_B + Left e -> assertFailure $ show e, + testCase "showCVSSWithNomenclature format" $ do + let vec = "CVSS:4.0/AV:N/AC:L/AT:N/PR:N/UI:N/VC:H/VI:H/VA:H/SC:N/SI:N/SA:N" + case CVSS.parseCVSS vec of + Right cvss -> + CVSS.showCVSSWithNomenclature cvss @?= "CVSS-B:Critical/9.3" + Left e -> assertFailure $ show e + ] + +-- ------------------------------------------------------------------ +-- Official FIRST cross-validation +-- ------------------------------------------------------------------ + +officialTestCaseV40 :: OfficialExample -> TestTree +officialTestCaseV40 ex = + testCase (Text.unpack $ oeVector ex) $ + case CVSS.parseCVSS (oeVector ex) of + Left e -> assertFailure (show e) + Right CVSS.CVSS {CVSS.cvssVersion = CVSS.CVSS40, CVSS.cvssMetrics = cm} -> do + V40.cvss40BaseScore cm @?= (oeBaseRating ex, oeBaseScore ex) + case oeThreatScore ex of + Just (expectedScore, expectedRating) -> V40.cvss40ThreatScore cm @?= (expectedRating, expectedScore) + Nothing -> pure () + case oeEnvironmentalScore ex of + Just (expectedScore, expectedRating) -> CVSS.cvss40EnvironmentalScore cm @?= (expectedRating, expectedScore) + Nothing -> pure () + other -> assertFailure $ "Not a CVSS 4.0 vector: " <> show other