{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module CVE
( parseFeed,
CPE (..),
CPEMatch (..),
CPEMatchRow (..),
cpeMatches,
CVE (..),
CVEID,
cveLI,
)
where
import Data.Aeson
( FromJSON,
Object,
eitherDecode,
parseJSON,
withObject,
(.!=),
(.:),
(.:!),
)
import Data.Aeson.Types (Parser, prependFailure)
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.List (intercalate)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
import Database.SQLite.Simple (FromRow, ToRow, field, fromRow, toRow)
import Database.SQLite.Simple.ToField (toField)
import OurPrelude
import Utils (Boundary (..), VersionMatcher (..))
type CVEID = Text
data CVE = CVE
{ cveID :: CVEID,
cveCPEMatches :: [CPEMatch],
cveDescription :: Text,
cvePublished :: UTCTime,
cveLastModified :: UTCTime
}
deriving (Show, Eq, Ord)
-- | cve list item
cveLI :: CVE -> Bool -> Text
cveLI c patched =
"- ["
<> cveID c
<> "](https://nvd.nist.gov/vuln/detail/"
<> cveID c
<> ")"
<> p
where
p =
if patched
then " (patched)"
else ""
data CPEMatch = CPEMatch
{ cpeMatchCPE :: CPE,
cpeMatchVulnerable :: Bool,
cpeMatchVersionMatcher :: VersionMatcher
}
deriving (Show, Eq, Ord)
instance FromRow CPEMatch where
fromRow = do
cpeMatchCPE <- fromRow
let cpeMatchVulnerable = True
cpeMatchVersionMatcher <- field
pure CPEMatch {..}
-- This decodes an entire CPE string and related attributes, but we only use
-- cpeVulnerable, cpeProduct, cpeVersion and cpeMatcher.
data CPE = CPE
{ cpePart :: (Maybe Text),
cpeVendor :: (Maybe Text),
cpeProduct :: (Maybe Text),
cpeVersion :: (Maybe Text),
cpeUpdate :: (Maybe Text),
cpeEdition :: (Maybe Text),
cpeLanguage :: (Maybe Text),
cpeSoftwareEdition :: (Maybe Text),
cpeTargetSoftware :: (Maybe Text),
cpeTargetHardware :: (Maybe Text),
cpeOther :: (Maybe Text)
}
deriving (Eq, Ord)
instance Show CPE where
show
CPE
{ cpePart,
cpeVendor,
cpeProduct,
cpeVersion,
cpeUpdate,
cpeEdition,
cpeLanguage,
cpeSoftwareEdition,
cpeTargetSoftware,
cpeTargetHardware,
cpeOther
} =
"CPE {"
<> (intercalate ", " . concat)
[ cpeField "part" cpePart,
cpeField "vendor" cpeVendor,
cpeField "product" cpeProduct,
cpeField "version" cpeVersion,
cpeField "update" cpeUpdate,
cpeField "edition" cpeEdition,
cpeField "language" cpeLanguage,
cpeField "softwareEdition" cpeSoftwareEdition,
cpeField "targetSoftware" cpeTargetSoftware,
cpeField "targetHardware" cpeTargetHardware,
cpeField "other" cpeOther
]
<> "}"
where
cpeField :: Show a => String -> Maybe a -> [String]
cpeField _ Nothing = []
cpeField name (Just value) = [name <> " = " <> show value]
instance ToRow CPE where
toRow
CPE
{ cpePart,
cpeVendor,
cpeProduct,
cpeVersion,
cpeUpdate,
cpeEdition,
cpeLanguage,
cpeSoftwareEdition,
cpeTargetSoftware,
cpeTargetHardware,
cpeOther
} =
fmap -- There is no toRow instance for a tuple this large
toField
[ cpePart,
cpeVendor,
cpeProduct,
cpeVersion,
cpeUpdate,
cpeEdition,
cpeLanguage,
cpeSoftwareEdition,
cpeTargetSoftware,
cpeTargetHardware,
cpeOther
]
instance FromRow CPE where
fromRow = do
cpePart <- field
cpeVendor <- field
cpeProduct <- field
cpeVersion <- field
cpeUpdate <- field
cpeEdition <- field
cpeLanguage <- field
cpeSoftwareEdition <- field
cpeTargetSoftware <- field
cpeTargetHardware <- field
cpeOther <- field
pure CPE {..}
-- | Parse a @description_data@ subtree and return the concatenation of the
-- english descriptions.
parseDescription :: Object -> Parser Text
parseDescription o = do
dData <- o .: "description_data"
descriptions <-
fmap concat $
sequence $
flip map dData $
\dDatum -> do
value <- dDatum .: "value"
lang :: Text <- dDatum .: "lang"
pure $
case lang of
"en" -> [value]
_ -> []
pure $ T.intercalate "\n\n" descriptions
instance FromJSON CVE where
parseJSON =
withObject "CVE" $ \o -> do
cve <- o .: "cve"
meta <- cve .: "CVE_data_meta"
cveID <- meta .: "ID"
prependFailure (T.unpack cveID <> ": ") $ do
cfgs <- o .: "configurations"
cveCPEMatches <- parseConfigurations cfgs
cvePublished <- o .: "publishedDate"
cveLastModified <- o .: "lastModifiedDate"
description <- cve .: "description"
cveDescription <- parseDescription description
pure CVE {..}
instance ToRow CVE where
toRow CVE {cveID, cveDescription, cvePublished, cveLastModified} =
toRow (cveID, cveDescription, cvePublished, cveLastModified)
instance FromRow CVE where
fromRow = do
let cveCPEMatches = []
cveID <- field
cveDescription <- field
cvePublished <- field
cveLastModified <- field
pure CVE {..}
splitCPE :: Text -> [Maybe Text]
splitCPE =
map (toMaybe . T.replace "\a" ":") . T.splitOn ":" . T.replace "\\:" "\a"
where
toMaybe "*" = Nothing
toMaybe x = Just x
instance FromJSON CPEMatch where
parseJSON =
withObject "CPEMatch" $ \o -> do
t <- o .: "cpe23Uri"
cpeMatchCPE <-
case splitCPE t of
[Just "cpe", Just "2.3", cpePart, cpeVendor, cpeProduct, cpeVersion, cpeUpdate, cpeEdition, cpeLanguage, cpeSoftwareEdition, cpeTargetSoftware, cpeTargetHardware, cpeOther] ->
pure CPE {..}
_ -> fail $ "unparsable cpe23Uri: " <> T.unpack t
cpeMatchVulnerable <- o .: "vulnerable"
vStartIncluding <- o .:! "versionStartIncluding"
vEndIncluding <- o .:! "versionEndIncluding"
vStartExcluding <- o .:! "versionStartExcluding"
vEndExcluding <- o .:! "versionEndExcluding"
startBoundary <-
case (vStartIncluding, vStartExcluding) of
(Nothing, Nothing) -> pure Unbounded
(Just start, Nothing) -> pure (Including start)
(Nothing, Just start) -> pure (Excluding start)
(Just _, Just _) -> fail "multiple version starts"
endBoundary <-
case (vEndIncluding, vEndExcluding) of
(Nothing, Nothing) -> pure Unbounded
(Just end, Nothing) -> pure (Including end)
(Nothing, Just end) -> pure (Excluding end)
(Just _, Just _) -> fail "multiple version ends"
cpeMatchVersionMatcher <-
case (cpeVersion cpeMatchCPE, startBoundary, endBoundary) of
(Just v, Unbounded, Unbounded) -> pure $ SingleMatcher v
(Nothing, start, end) -> pure $ RangeMatcher start end
_ ->
fail
( "cpe_match has both version "
<> show (cpeVersion cpeMatchCPE)
<> " in cpe, and boundaries from "
<> show startBoundary
<> " to "
<> show endBoundary
)
pure (CPEMatch {..})
data CPEMatchRow
= CPEMatchRow CVE CPEMatch
instance ToRow CPEMatchRow where
toRow (CPEMatchRow CVE {cveID} CPEMatch {cpeMatchCPE, cpeMatchVersionMatcher}) =
[toField $ Just cveID]
++ toRow cpeMatchCPE
++ [toField cpeMatchVersionMatcher]
instance FromRow CPEMatchRow where
fromRow = do
let cveCPEMatches = []
let cveDescription = undefined
let cvePublished = undefined
let cveLastModified = undefined
cveID <- field
cpeM <- fromRow
pure $ CPEMatchRow (CVE {..}) cpeM
cpeMatches :: [CVE] -> [CPEMatchRow]
cpeMatches = concatMap rows
where
rows cve = fmap (CPEMatchRow cve) (cveCPEMatches cve)
guardAttr :: (Eq a, FromJSON a, Show a) => Object -> Text -> a -> Parser ()
guardAttr object attribute expected = do
actual <- object .: attribute
unless (actual == expected) $
fail $
"unexpected "
<> T.unpack attribute
<> ", expected "
<> show expected
<> ", got "
<> show actual
boundedMatcher :: VersionMatcher -> Bool
boundedMatcher (RangeMatcher Unbounded Unbounded) = False
boundedMatcher _ = True
-- Because complex boolean formulas can't be used to determine if a single
-- product/version is vulnerable, we simply use all leaves marked vulnerable.
parseNode :: Object -> Parser [CPEMatch]
parseNode node = do
maybeChildren <- node .:! "children"
case maybeChildren of
Nothing -> do
matches <- node .:! "cpe_match" .!= []
pure $
filter (cpeMatchVersionMatcher >>> boundedMatcher) $
filter cpeMatchVulnerable matches
Just children -> do
fmap concat $ sequence $ map parseNode children
parseConfigurations :: Object -> Parser [CPEMatch]
parseConfigurations o = do
guardAttr o "CVE_data_version" ("4.0" :: Text)
nodes <- o .: "nodes"
fmap concat $ sequence $ map parseNode nodes
parseFeed :: BSL.ByteString -> Either Text [CVE]
parseFeed = bimap T.pack cvefItems . eitherDecode
data CVEFeed = CVEFeed
{ cvefItems :: [CVE]
}
instance FromJSON CVEFeed where
parseJSON = withObject "CVEFeed" $ \o -> CVEFeed <$> o .: "CVE_Items"