|
| 1 | +{-# LANGUAGE ImportQualifiedPost #-} |
| 2 | +{-# LANGUAGE OverloadedStrings #-} |
| 3 | +{-# LANGUAGE PatternSynonyms #-} |
| 4 | + |
| 5 | +{- | This module provides a CVSS parser and utility functions |
| 6 | + adapted from https://www.first.org/cvss/v3.1/specification-document |
| 7 | +-} |
| 8 | +module Security.CVSS ( |
| 9 | + -- * Type |
| 10 | + CVSS, |
| 11 | + Rating (..), |
| 12 | + parseCVSS, |
| 13 | + |
| 14 | + -- * Helpers |
| 15 | + cvssScore, |
| 16 | + cvssInfo, |
| 17 | +) where |
| 18 | + |
| 19 | +import Data.Foldable (traverse_) |
| 20 | +import Data.List (find, group, sort) |
| 21 | +import Data.Maybe (mapMaybe) |
| 22 | +import Data.Text (Text) |
| 23 | +import Data.Text qualified as Text |
| 24 | +import GHC.Float (powerFloat) |
| 25 | + |
| 26 | +data CVSSVersion = CVSS31 |
| 27 | + |
| 28 | +-- | Parsed CVSS string obtained with 'parseCVSS' |
| 29 | +data CVSS = CVSS |
| 30 | + { cvssVersion :: CVSSVersion |
| 31 | + , cvssMetrics :: [Metric] |
| 32 | + -- ^ The metrics are stored as provided by the user |
| 33 | + } |
| 34 | + |
| 35 | +-- | CVSS Rating obtained with 'cvssScore' |
| 36 | +data Rating = None | Low | Medium | High | Critical |
| 37 | + deriving (Enum, Eq, Ord, Show) |
| 38 | + |
| 39 | +toRating :: Float -> Rating |
| 40 | +toRating score |
| 41 | + | score <= 0 = None |
| 42 | + | score <= 3.9 = Low |
| 43 | + | score <= 6.9 = Medium |
| 44 | + | score <= 8.9 = High |
| 45 | + | otherwise = Critical |
| 46 | + |
| 47 | +type Metric = (Text, Char) |
| 48 | + |
| 49 | +-- example CVSS string: CVSS:3.1/AV:N/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:N |
| 50 | + |
| 51 | +-- | Parse a CVSS string. |
| 52 | +parseCVSS :: Text -> Either Text CVSS |
| 53 | +parseCVSS txt |
| 54 | + | "CVSS:3.1/" `Text.isPrefixOf` txt = parseCVSS31 |
| 55 | + | otherwise = Left "Unknown CVSS version" |
| 56 | + where |
| 57 | + parseCVSS31 = |
| 58 | + CVSS CVSS31 <$> do |
| 59 | + metrics <- traverse splitComponent components |
| 60 | + validateCvss31 metrics |
| 61 | + |
| 62 | + components = drop 1 $ Text.split (== '/') txt |
| 63 | + splitComponent :: Text -> Either Text Metric |
| 64 | + splitComponent componentTxt = case Text.unsnoc componentTxt of |
| 65 | + Nothing -> Left "Empty component" |
| 66 | + Just (rest, c) -> case Text.unsnoc rest of |
| 67 | + Just (name, ':') -> Right (name, c) |
| 68 | + _ -> Left "Expected :" |
| 69 | + |
| 70 | +-- | Compute the base score. |
| 71 | +cvssScore :: CVSS -> (Rating, Float) |
| 72 | +cvssScore cvss = case cvssVersion cvss of |
| 73 | + CVSS31 -> cvss31score (cvssMetrics cvss) |
| 74 | + |
| 75 | +-- | Explain the CVSS metrics. |
| 76 | +cvssInfo :: CVSS -> [Text] |
| 77 | +cvssInfo cvss = case cvssVersion cvss of |
| 78 | + CVSS31 -> cvss31info (cvssMetrics cvss) |
| 79 | + |
| 80 | +-- | Description of a metric group. |
| 81 | +data MetricGroup = MetricGroup |
| 82 | + { mgName :: Text |
| 83 | + , mgMetrics :: [MetricInfo] |
| 84 | + } |
| 85 | + |
| 86 | +-- | Description of a single metric. |
| 87 | +data MetricInfo = MetricInfo |
| 88 | + { miName :: Text |
| 89 | + , miShortName :: Text |
| 90 | + , miRequired :: Bool |
| 91 | + , miValues :: [MetricValue] |
| 92 | + } |
| 93 | + |
| 94 | +-- | Description of a single metric value |
| 95 | +data MetricValue = MetricValue |
| 96 | + { mvName :: Text |
| 97 | + , mvChar :: Char |
| 98 | + , mvNum :: Float |
| 99 | + , mvNumChangedScope :: Maybe Float |
| 100 | + , mvDesc :: Text |
| 101 | + } |
| 102 | + |
| 103 | +-- | CVSS3.1 metrics pulled from section 2. "Base Metrics" and section section 7.4. "Metric Values" |
| 104 | +cvss31 :: [MetricGroup] |
| 105 | +cvss31 = |
| 106 | + [ MetricGroup "Base" baseMetrics |
| 107 | + , MetricGroup "Temporal" temporalMetrics |
| 108 | + , MetricGroup "Environmental" environmentalMetrics |
| 109 | + ] |
| 110 | + where |
| 111 | + baseMetrics = |
| 112 | + [ MetricInfo |
| 113 | + "Attack Vector" |
| 114 | + "AV" |
| 115 | + True |
| 116 | + [ MetricValue "Network" '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." |
| 117 | + , MetricValue "Adjacent" '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." |
| 118 | + , MetricValue "Local" '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." |
| 119 | + , MetricValue "Physical" 'P' 0.2 Nothing "The attack requires the attacker to physically touch or manipulate the vulnerable component." |
| 120 | + ] |
| 121 | + , MetricInfo |
| 122 | + "Attack Complexity" |
| 123 | + "AC" |
| 124 | + True |
| 125 | + [ MetricValue "Low" 'L' 0.77 Nothing "Specialized access conditions or extenuating circumstances do not exist." |
| 126 | + , MetricValue "High" 'H' 0.44 Nothing "A successful attack depends on conditions beyond the attacker's control." |
| 127 | + ] |
| 128 | + , MetricInfo |
| 129 | + "Privileges Required" |
| 130 | + "PR" |
| 131 | + True |
| 132 | + [ MetricValue "None" '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." |
| 133 | + , MetricValue "Low" '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." |
| 134 | + , MetricValue "High" '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." |
| 135 | + ] |
| 136 | + , MetricInfo |
| 137 | + "User Interaction" |
| 138 | + "UI" |
| 139 | + True |
| 140 | + [ MetricValue "None" 'N' 0.85 Nothing "The vulnerable system can be exploited without interaction from any user." |
| 141 | + , MetricValue "Required" 'R' 0.62 Nothing "Successful exploitation of this vulnerability requires a user to take some action before the vulnerability can be exploited." |
| 142 | + ] |
| 143 | + , MetricInfo |
| 144 | + "Scope" |
| 145 | + "S" |
| 146 | + True |
| 147 | + [ -- Note: not defined as contants in specification |
| 148 | + MetricValue "Unchanged" 'U' Unchanged Nothing "An exploited vulnerability can only affect resources managed by the same security authority." |
| 149 | + , MetricValue "Changed" 'C' Changed Nothing "An exploited vulnerability can affect resources beyond the security scope managed by the security authority of the vulnerable component." |
| 150 | + ] |
| 151 | + , MetricInfo |
| 152 | + "Confidentiality Impact" |
| 153 | + "C" |
| 154 | + True |
| 155 | + [ mkHigh "There is a total loss of confidentiality, resulting in all resources within the impacted component being divulged to the attacker." |
| 156 | + , mkLow "There is some loss of confidentiality." |
| 157 | + , mkNone "There is no loss of confidentiality within the impacted component." |
| 158 | + ] |
| 159 | + , MetricInfo |
| 160 | + "Integrity Impact" |
| 161 | + "I" |
| 162 | + True |
| 163 | + [ mkHigh "There is a total loss of integrity, or a complete loss of protection." |
| 164 | + , 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." |
| 165 | + , mkNone "There is no loss of integrity within the impacted component." |
| 166 | + ] |
| 167 | + , MetricInfo |
| 168 | + "Availability Impact" |
| 169 | + "A" |
| 170 | + True |
| 171 | + [ mkHigh "There is a total loss of availability, resulting in the attacker being able to fully deny access to resources in the impacted component" |
| 172 | + , mkLow "Performance is reduced or there are interruptions in resource availability." |
| 173 | + , mkNone "There is no impact to availability within the impacted component." |
| 174 | + ] |
| 175 | + ] |
| 176 | + mkHigh = MetricValue "High" 'H' 0.56 Nothing |
| 177 | + mkLow = MetricValue "Low" 'L' 0.22 Nothing |
| 178 | + mkNone = MetricValue "None" 'N' 0 Nothing |
| 179 | + -- TODOs |
| 180 | + temporalMetrics = [] |
| 181 | + environmentalMetrics = [] |
| 182 | + |
| 183 | +pattern Unchanged :: Float |
| 184 | +pattern Unchanged = 6.42 |
| 185 | +pattern Changed :: Float |
| 186 | +pattern Changed = 7.52 |
| 187 | + |
| 188 | +cvss31info :: [Metric] -> [Text] |
| 189 | +cvss31info = map showMetricInfo |
| 190 | + where |
| 191 | + showMetricInfo metric = case mapMaybe (getInfo metric) cvss31 of |
| 192 | + [(mg, mi, mv)] -> |
| 193 | + mconcat [mgName mg, " ", miName mi, ": ", mvName mv, " (", mvDesc mv, ")"] |
| 194 | + _ -> error $ "The impossible have happened for " <> show metric |
| 195 | + getInfo (name, value) mg = do |
| 196 | + mi <- find (\mi -> miShortName mi == name) (mgMetrics mg) |
| 197 | + mv <- find (\mv -> mvChar mv == value) (miValues mi) |
| 198 | + pure (mg, mi, mv) |
| 199 | + |
| 200 | +allMetrics :: [MetricInfo] |
| 201 | +allMetrics = concatMap mgMetrics cvss31 |
| 202 | + |
| 203 | +roundup :: Float -> Float |
| 204 | +roundup input |
| 205 | + | int_input `mod` 10000 == 0 = fromIntegral int_input / 100000 |
| 206 | + | otherwise = (fromIntegral (floor_int (fromIntegral int_input / 10000)) + 1) / 10 |
| 207 | + where |
| 208 | + floor_int :: Float -> Int |
| 209 | + floor_int = floor |
| 210 | + int_input :: Int |
| 211 | + int_input = round (input * 100000) |
| 212 | + |
| 213 | +-- | Implementation of section 7.1. Base Metrics Equations |
| 214 | +cvss31score :: [Metric] -> (Rating, Float) |
| 215 | +cvss31score metrics = (toRating score, score) |
| 216 | + where |
| 217 | + iss = 1 - (1 - gm "Confidentiality Impact") * (1 - gm "Integrity Impact") * (1 - gm "Availability Impact") |
| 218 | + impact |
| 219 | + | scope == Unchanged = scope * iss |
| 220 | + | otherwise = scope * (iss - 0.029) - 3.25 * powerFloat (iss - 0.02) 15 |
| 221 | + exploitability = 8.22 * gm "Attack Vector" * gm "Attack Complexity" * gm "Privileges Required" * gm "User Interaction" |
| 222 | + score |
| 223 | + | impact <= 0 = 0 |
| 224 | + | scope == Unchanged = roundup (min (impact + exploitability) 10) |
| 225 | + | otherwise = roundup (min (1.08 * (impact + exploitability)) 10) |
| 226 | + scope = gm "Scope" |
| 227 | + |
| 228 | + gm :: Text -> Float |
| 229 | + gm name = case getMetric name of |
| 230 | + Nothing -> error $ "The impossible have happened, unknown metric: " <> Text.unpack name |
| 231 | + Just v -> v |
| 232 | + getMetric :: Text -> Maybe Float |
| 233 | + getMetric name = do |
| 234 | + mi <- find (\mi -> miName mi == name) allMetrics |
| 235 | + valueChar <- lookup (miShortName mi) metrics |
| 236 | + mv <- find (\mv -> mvChar mv == valueChar) (miValues mi) |
| 237 | + pure $ case mvNumChangedScope mv of |
| 238 | + Just value | scope /= Unchanged -> value |
| 239 | + _ -> mvNum mv |
| 240 | + |
| 241 | +validateCvss31 :: [Metric] -> Either Text [Metric] |
| 242 | +validateCvss31 metrics = do |
| 243 | + traverse_ (\t -> t metrics) [validateUnique, validateKnown, validateRequired] |
| 244 | + pure metrics |
| 245 | + |
| 246 | +{- | Check for duplicates metric |
| 247 | +
|
| 248 | + >>> validateUnique [("AV", 'N'), ("AC", 'L'), ("AV", 'L')] |
| 249 | + Left "Duplicated \"AV\"" |
| 250 | +-} |
| 251 | +validateUnique :: [Metric] -> Either Text () |
| 252 | +validateUnique = traverse_ checkDouble . group . sort . map fst |
| 253 | + where |
| 254 | + checkDouble [] = error "The impossible have happened" |
| 255 | + checkDouble [_] = pure () |
| 256 | + checkDouble (n : _) = Left $ "Duplicated \"" <> n <> "\"" |
| 257 | + |
| 258 | +{- | Check for unknown metric |
| 259 | +
|
| 260 | + >>> validateKnown [("AV", 'M')] |
| 261 | + Left "Unknown value: 'M'" |
| 262 | +
|
| 263 | + >>> validateKnown [("AW", 'L')] |
| 264 | + Left "Unknown metric: \"AW\"" |
| 265 | +-} |
| 266 | +validateKnown :: [Metric] -> Either Text () |
| 267 | +validateKnown = traverse_ checkKnown |
| 268 | + where |
| 269 | + checkKnown (name, value) = do |
| 270 | + mi <- case find (\mi -> miShortName mi == name) allMetrics of |
| 271 | + Nothing -> Left $ "Unknown metric: \"" <> name <> "\"" |
| 272 | + Just m -> pure m |
| 273 | + case find (\mv -> mvChar mv == value) (miValues mi) of |
| 274 | + Nothing -> Left $ "Unknown value: '" <> Text.pack (show value) <> "'" |
| 275 | + Just _ -> pure () |
| 276 | + |
| 277 | +{- | Check for required metric |
| 278 | +
|
| 279 | + >>> validateRequired [] |
| 280 | + Left "Missing \"Attack Vector\"" |
| 281 | +-} |
| 282 | +validateRequired :: [Metric] -> Either Text () |
| 283 | +validateRequired metrics = traverse_ checkRequired allMetrics |
| 284 | + where |
| 285 | + checkRequired mi |
| 286 | + | miRequired mi |
| 287 | + , Nothing <- lookup (miShortName mi) metrics = |
| 288 | + Left $ "Missing \"" <> miName mi <> "\"" |
| 289 | + | otherwise = pure () |
0 commit comments