From ca594289b2e647f269a620a4cc2fdc38dbb8dfa4 Mon Sep 17 00:00:00 2001 From: Tristan Cacqueray Date: Fri, 19 Jul 2024 23:40:54 -0400 Subject: [PATCH] Rebase Advisory.Ecosystem change --- .../src/Security/Advisories/Core/Advisory.hs | 2 +- code/hsec-tools/app/Main.hs | 8 +------ .../src/Security/Advisories/Format.hs | 21 +++++++++++++++---- .../src/Security/Advisories/Parse.hs | 7 +++++++ code/hsec-tools/test/Spec/FormatSpec.hs | 11 +++++++++- 5 files changed, 36 insertions(+), 13 deletions(-) diff --git a/code/hsec-core/src/Security/Advisories/Core/Advisory.hs b/code/hsec-core/src/Security/Advisories/Core/Advisory.hs index cf9d6aa6..ca3f3175 100644 --- a/code/hsec-core/src/Security/Advisories/Core/Advisory.hs +++ b/code/hsec-core/src/Security/Advisories/Core/Advisory.hs @@ -53,7 +53,7 @@ data Ecosystem = Hackage Text | GHC GHCComponent -- Keep this list in sync with the 'ghcComponentFromText' below data GHCComponent = GHCCompiler | GHCi | GHCRTS - deriving stock (Show, Eq) + deriving stock (Show, Eq, Enum, Bounded) ghcComponentToText :: GHCComponent -> Text ghcComponentToText c = case c of diff --git a/code/hsec-tools/app/Main.hs b/code/hsec-tools/app/Main.hs index ac80133c..95ec61a4 100644 --- a/code/hsec-tools/app/Main.hs +++ b/code/hsec-tools/app/Main.hs @@ -23,18 +23,12 @@ import Security.Advisories.Generate.HTML import Security.Advisories.Generate.Snapshot import Security.Advisories.Git import Security.Advisories.Queries (listVersionRangeAffectedBy) - +import Security.Advisories.Filesystem (parseEcosystem) import System.Exit (die, exitFailure, exitSuccess) import System.FilePath (takeBaseName) import System.IO (hPrint, hPutStrLn, stderr) import Validation (Validation (..)) -import Security.Advisories.Generate.HTML -import Security.Advisories.Filesystem (parseEcosystem) - -import qualified Command.Reserve - - main :: IO () main = join $ diff --git a/code/hsec-tools/src/Security/Advisories/Format.hs b/code/hsec-tools/src/Security/Advisories/Format.hs index 7107522d..b7c58f07 100644 --- a/code/hsec-tools/src/Security/Advisories/Format.hs +++ b/code/hsec-tools/src/Security/Advisories/Format.hs @@ -15,6 +15,7 @@ module Security.Advisories.Format ) where +import Control.Applicative ((<|>)) import Commonmark.Types (HasAttributes (..), IsBlock (..), IsInline (..), Rangeable (..), SourceRange (..)) import qualified Data.Map as Map import Data.Maybe (fromMaybe) @@ -135,16 +136,25 @@ instance Toml.ToTable AdvisoryMetadata where ["aliases" Toml..= amdAliases x | not (null (amdAliases x))] ++ ["related" Toml..= amdRelated x | not (null (amdRelated x))] +instance Toml.FromValue GHCComponent where + fromValue v = case v of + Toml.Text' _ n + | Just c <- ghcComponentFromText n -> pure c + _ -> Toml.failAt (Toml.valueAnn v) "Invalid component, expected compiler|ghci|rts" + +instance Toml.ToValue GHCComponent where + toValue = Toml.Text' () . ghcComponentToText + instance Toml.FromValue Affected where fromValue = Toml.parseTableFromValue $ - do package <- Toml.reqKey "package" + do ecosystem <- (Hackage <$> Toml.reqKey "package") <|> (GHC <$> Toml.reqKey "ghc-component") cvss <- Toml.reqKey "cvss" -- TODO validate CVSS format os <- Toml.optKey "os" arch <- Toml.optKey "arch" decls <- maybe [] Map.toList <$> Toml.optKey "declarations" versions <- Toml.reqKey "versions" pure $ Affected - { affectedPackage = package + { affectedEcosystem = ecosystem , affectedCVSS = cvss , affectedVersions = versions , affectedArchitectures = arch @@ -157,14 +167,17 @@ instance Toml.ToValue Affected where instance Toml.ToTable Affected where toTable x = Toml.table $ - [ "package" Toml..= affectedPackage x - , "cvss" Toml..= affectedCVSS x + ecosystem ++ + [ "cvss" Toml..= affectedCVSS x , "versions" Toml..= affectedVersions x ] ++ [ "os" Toml..= y | Just y <- [affectedOS x]] ++ [ "arch" Toml..= y | Just y <- [affectedArchitectures x]] ++ [ "declarations" Toml..= asTable (affectedDeclarations x) | not (null (affectedDeclarations x))] where + ecosystem = case affectedEcosystem x of + Hackage pkg -> ["package" Toml..= pkg] + GHC c -> ["ghc-component" Toml..= c] asTable kvs = Map.fromList [(T.unpack k, v) | (k,v) <- kvs] instance Toml.FromValue AffectedVersionRange where diff --git a/code/hsec-tools/src/Security/Advisories/Parse.hs b/code/hsec-tools/src/Security/Advisories/Parse.hs index ecdf942a..ff4500e3 100644 --- a/code/hsec-tools/src/Security/Advisories/Parse.hs +++ b/code/hsec-tools/src/Security/Advisories/Parse.hs @@ -16,6 +16,7 @@ , displayOOBError , AttributeOverridePolicy(..) , ParseAdvisoryError(..) + , validateEcosystem ) where @@ -209,6 +210,12 @@ parseAdvisoryTable oob policy doc summary details html tab = , advisoryDetails = details } +-- | Make sure one of the affected match the ecosystem +validateEcosystem :: MonadFail m => Ecosystem -> [Affected] -> m () +validateEcosystem ecosystem xs + | any (\affected -> affectedEcosystem affected == ecosystem) xs = pure () + | otherwise = fail $ "Expected an affected to match the ecosystem: " <> show ecosystem + advisoryDoc :: Blocks -> Either Text (Text, [Block]) advisoryDoc (Many blocks) = case blocks of CodeBlock (_, classes, _) frontMatter :<| t diff --git a/code/hsec-tools/test/Spec/FormatSpec.hs b/code/hsec-tools/test/Spec/FormatSpec.hs index 5aac95e6..b40f05c5 100644 --- a/code/hsec-tools/test/Spec/FormatSpec.hs +++ b/code/hsec-tools/test/Spec/FormatSpec.hs @@ -70,13 +70,22 @@ genAdvisoryMetadata = genAffected :: Gen.Gen Affected genAffected = Affected - <$> genText + <$> genEcosystem <*> genCVSS <*> Gen.list (Range.linear 0 5) genAffectedVersionRange <*> Gen.maybe (Gen.list (Range.linear 0 5) genArchitecture) <*> Gen.maybe (Gen.list (Range.linear 0 5) genOS) <*> (Map.toList . Map.fromList <$> Gen.list (Range.linear 0 5) ((,) <$> genText <*> genVersionRange)) +genEcosystem :: Gen.Gen Ecosystem +genEcosystem = Gen.choice $ + [ Hackage <$> genText + , GHC <$> genGHCComponent + ] + +genGHCComponent :: Gen.Gen GHCComponent +genGHCComponent = Gen.choice $ map pure [minBound..maxBound] + genCVSS :: Gen.Gen CVSS genCVSS = Gen.choice $