Rebase Advisory.Ecosystem change

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

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 $

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

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

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 $