fix: hsec-tools snapshot generation (thanks to property test)

code/cvss/src/Security/CVSS.hs

@@ -51,6 +51,7 @@ data CVSS = CVSS
     -- | The metrics are stored as provided by the user
     cvssMetrics :: [Metric]
   }
+  deriving stock (Eq)
 
 instance Show CVSS where
   show = Text.unpack . cvssVectorString
@@ -100,7 +101,7 @@ data Metric = Metric
   { mName :: MetricShortName,
     mChar :: MetricValueChar
   }
-  deriving (Show)
+  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
 

code/hsec-core/src/Security/Advisories/Core/Advisory.hs

@@ -54,13 +54,13 @@ data Affected = Affected
   , affectedOS :: Maybe [OS]
   , affectedDeclarations :: [(Text, VersionRange)]
   }
-  deriving stock (Show)
+  deriving stock (Eq, Show)
 
 newtype CAPEC = CAPEC {unCAPEC :: Integer}
-  deriving stock (Show)
+  deriving stock (Eq, Show)
 
 newtype CWE = CWE {unCWE :: Integer}
-  deriving stock (Show)
+  deriving stock (Eq, Show)
 
 data Architecture
   = AArch64
@@ -88,7 +88,7 @@ data Architecture
   | SPARC64
   | VAX
   | X86_64
-  deriving stock (Show)
+  deriving stock (Eq, Show, Enum, Bounded)
 
 data OS
   = Windows
@@ -98,7 +98,7 @@ data OS
   | Android
   | NetBSD
   | OpenBSD
-  deriving stock (Show)
+  deriving stock (Eq, Show, Enum, Bounded)
 
 newtype Keyword = Keyword {unKeyword :: Text}
   deriving stock (Eq, Ord)
@@ -108,4 +108,4 @@ data AffectedVersionRange = AffectedVersionRange
   { affectedVersionRangeIntroduced :: Version,
     affectedVersionRangeFixed :: Maybe Version
   }
-  deriving stock (Show)
+  deriving stock (Eq, Show)

code/hsec-tools/hsec-tools.cabal

@@ -113,21 +113,29 @@ test-suite spec
   type:             exitcode-stdio-1.0
   hs-source-dirs:   test
   main-is:          Spec.hs
-  other-modules:    Spec.QueriesSpec
+  other-modules:
+    Spec.FormatSpec
+    Spec.QueriesSpec
   build-depends:
     , aeson-pretty   <2
     , base           <5
     , Cabal-syntax
+    , containers
     , cvss
     , directory
+    , hedgehog       <2
     , hsec-core
     , hsec-tools
+    , osv
     , pretty-simple  <5
+    , prettyprinter
     , tasty          <1.5
     , tasty-golden   <2.4
+    , tasty-hedgehog <2
     , tasty-hunit    <0.11
     , text
     , time
+    , toml-parser
 
   default-language: Haskell2010
   ghc-options:

code/hsec-tools/src/Security/Advisories/Format.hs

@@ -61,7 +61,7 @@ data FrontMatter = FrontMatter {
   frontMatterAdvisory :: AdvisoryMetadata,
   frontMatterReferences :: [Reference],
   frontMatterAffected :: [Affected]
-} deriving (Generic)
+} deriving (Show, Generic)
 
 instance Toml.FromValue FrontMatter where
   fromValue = Toml.parseTableFromValue $
@@ -96,6 +96,7 @@ data AdvisoryMetadata = AdvisoryMetadata
   , amdAliases    :: [T.Text]
   , amdRelated    :: [T.Text]
   }
+  deriving (Show, Generic)
 
 instance Toml.FromValue AdvisoryMetadata where
   fromValue = Toml.parseTableFromValue $
@@ -131,7 +132,7 @@ instance Toml.ToTable AdvisoryMetadata where
     ["cwe"       Toml..= amdCWEs x | not (null (amdCWEs x))] ++
     ["keywords"  Toml..= amdKeywords x | not (null (amdKeywords x))] ++
     ["aliases"   Toml..= amdAliases x | not (null (amdAliases x))] ++
-    ["Related"   Toml..= amdRelated x | not (null (amdRelated x))]
+    ["related"   Toml..= amdRelated x | not (null (amdRelated x))]
 
 instance Toml.FromValue Affected where
   fromValue = Toml.parseTableFromValue $

code/hsec-tools/test/Spec.hs

@@ -9,23 +9,25 @@ import qualified Data.Text.Lazy as LText
 import qualified Data.Text.Lazy.Encoding as LText
 import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
 import Data.Time.LocalTime
+import qualified Security.Advisories.Convert.OSV as OSV
+import Security.Advisories.Parse
+import qualified Spec.FormatSpec as FormatSpec
+import qualified Spec.QueriesSpec as QueriesSpec
 import System.Directory (listDirectory)
 import Test.Tasty
 import Test.Tasty.Golden (goldenVsString)
 import Text.Pretty.Simple (pShowNoColor)
 
-import qualified Security.Advisories.Convert.OSV as OSV
-import Security.Advisories.Parse
-import qualified Spec.QueriesSpec as QueriesSpec
-
 main :: IO ()
 main = do
     goldenFiles <- listGoldenFiles
     defaultMain $
-      testGroup "Tests"
-        [ goldenTestsSpec goldenFiles
-        , QueriesSpec.spec
-        ]
+        testGroup
+            "Tests"
+            [ goldenTestsSpec goldenFiles
+            , QueriesSpec.spec
+            , FormatSpec.spec
+            ]
 
 listGoldenFiles :: IO [FilePath]
 listGoldenFiles = map (mappend dpath) . filter (not . isSuffixOf ".golden") <$> listDirectory dpath

code/hsec-tools/test/Spec/FormatSpec.hs

@@ -0,0 +1,175 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Spec.FormatSpec (spec) where
+
+import Data.Fixed (Fixed (MkFixed))
+import Data.Function (on)
+import qualified Data.Map.Strict as Map
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time
+import Distribution.Types.Version
+import Distribution.Types.VersionRange
+import qualified Hedgehog as Gen
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import qualified Prettyprinter as Pretty
+import qualified Prettyprinter.Render.Text as Pretty
+import Security.Advisories.Core.Advisory
+import Security.Advisories.Core.HsecId
+import Security.Advisories.Format
+import Security.CVSS
+import Security.OSV (Reference (..), ReferenceType (..))
+import Test.Tasty
+import Test.Tasty.Hedgehog
+import qualified Toml
+
+spec :: TestTree
+spec =
+  testGroup
+    "Format"
+    [ testGroup
+        "FrontMatter"
+        [ testProperty "parse . render == id" $
+            Gen.property $ do
+              fm <- Gen.forAll genFrontMatter
+              let rendered =
+                    Pretty.renderStrict $ Pretty.layoutPretty Pretty.defaultLayoutOptions $ Toml.encode fm
+              Gen.footnote $ T.unpack rendered
+              Toml.decode rendered Gen.=== Toml.Success mempty (FrontMatterEq fm)
+        ]
+    ]
+
+newtype FrontMatterEq = FrontMatterEq {unFrontMatter :: FrontMatter}
+  deriving newtype (Show, FromValue)
+
+instance Eq FrontMatterEq where
+  (==) = (==) `on` show . unFrontMatter
+
+genFrontMatter :: Gen.Gen FrontMatter
+genFrontMatter =
+  FrontMatter
+    <$> genAdvisoryMetadata
+    <*> Gen.list (Range.linear 0 10) genReference
+    <*> Gen.list (Range.linear 0 10) genAffected
+
+genAdvisoryMetadata :: Gen.Gen AdvisoryMetadata
+genAdvisoryMetadata =
+  AdvisoryMetadata
+    <$> genHsecId
+    <*> Gen.maybe genZonedTime
+    <*> Gen.maybe genZonedTime
+    <*> Gen.list (Range.linear 0 5) genCAPEC
+    <*> Gen.list (Range.linear 0 5) genCWE
+    <*> Gen.list (Range.linear 0 5) genKeyword
+    <*> Gen.list (Range.linear 0 5) genText
+    <*> Gen.list (Range.linear 0 5) genText
+
+genAffected :: Gen.Gen Affected
+genAffected =
+  Affected
+    <$> genText
+    <*> 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))
+
+genCVSS :: Gen.Gen CVSS
+genCVSS =
+  Gen.choice $
+    map
+      (\x -> either (\e -> error $ "Cannot parse CVSS " <> show x <> " " <> show e) return $ parseCVSS x)
+      [ "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:C/C:N/I:L/A:N",
+        "CVSS:3.1/AV:N/AC:L/PR:L/UI:N/S:C/C:L/I:L/A:N",
+        "CVSS:3.1/AV:N/AC:H/PR:N/UI:R/S:U/C:L/I:N/A:N",
+        "CVSS:3.0/AV:N/AC:L/PR:N/UI:R/S:C/C:L/I:L/A:N",
+        "CVSS:3.0/AV:N/AC:L/PR:L/UI:N/S:C/C:L/I:L/A:N",
+        "CVSS:3.0/AV:N/AC:H/PR:N/UI:R/S:U/C:L/I:N/A:N",
+        "CVSS:3.0/AV:L/AC:L/PR:N/UI:N/S:U/C:N/I:L/A:N",
+        "CVSS:3.0/AV:N/AC:L/PR:L/UI:N/S:C/C:H/I:H/A:H",
+        "CVSS:3.0/AV:L/AC:L/PR:H/UI:N/S:U/C:L/I:L/A:L",
+        "CVSS:2.0/AV:N/AC:L/Au:N/C:N/I:N/A:C",
+        "CVSS:2.0/AV:N/AC:L/Au:N/C:C/I:C/A:C",
+        "CVSS:2.0/AV:L/AC:H/Au:N/C:C/I:C/A:C"
+      ]
+
+genCAPEC :: Gen.Gen CAPEC
+genCAPEC = CAPEC <$> Gen.integral (Range.linear 100 999)
+
+genCWE :: Gen.Gen CWE
+genCWE = CWE <$> Gen.integral (Range.linear 100 999)
+
+genHsecId :: Gen.Gen HsecId
+genHsecId = flip nextHsecId placeholder <$> Gen.integral (Range.linear 2024 2032)
+
+genZonedTime :: Gen.Gen ZonedTime
+genZonedTime = do
+  local <- genLocalTime
+  zMin <- Gen.int (Range.constant (-720) 720)
+  let zTime = minutesToTimeZone zMin
+  pure $ ZonedTime local zTime
+
+genDay :: Gen.Gen Day
+genDay = do
+  y <- toInteger <$> Gen.int (Range.constant 1968 2019)
+  m <- Gen.int (Range.constant 1 12)
+  d <- Gen.int (Range.constant 1 28)
+  pure $ fromGregorian y m d
+
+genLocalTime :: Gen.Gen LocalTime
+genLocalTime = do
+  day <- genDay
+  LocalTime day <$> genTimeOfDay
+
+genTimeOfDay :: Gen.Gen TimeOfDay
+genTimeOfDay = do
+  secs <- MkFixed <$> Gen.integral (Range.constant 0 61)
+  mins <- Gen.int (Range.constant 0 59)
+  hours <- Gen.int (Range.constant 0 23)
+  pure $ TimeOfDay hours mins secs
+
+genVersionRange :: Gen.Gen VersionRange
+genVersionRange =
+  Gen.recursive
+    Gen.choice
+    [ pure anyVersion,
+      pure noVersion,
+      thisVersion <$> genVersion,
+      notThisVersion <$> genVersion,
+      laterVersion <$> genVersion,
+      earlierVersion <$> genVersion,
+      orLaterVersion <$> genVersion,
+      orEarlierVersion <$> genVersion,
+      withinVersion <$> genVersion,
+      majorBoundVersion <$> genVersion
+    ]
+    [ Gen.subterm2 genVersionRange genVersionRange unionVersionRanges,
+      Gen.subterm2 genVersionRange genVersionRange intersectVersionRanges
+    ]
+
+genText :: Gen.Gen Text
+genText = Gen.text (Range.linear 1 20) Gen.alphaNum
+
+genAffectedVersionRange :: Gen.Gen AffectedVersionRange
+genAffectedVersionRange = AffectedVersionRange <$> genVersion <*> Gen.maybe genVersion
+
+genVersion :: Gen.Gen Version
+genVersion = mkVersion <$> Gen.list (Range.linear 1 5) (Gen.integral (Range.linear 0 999))
+
+genArchitecture :: Gen.Gen Architecture
+genArchitecture = Gen.enumBounded
+
+genOS :: Gen.Gen OS
+genOS = Gen.enumBounded
+
+genKeyword :: Gen.Gen Keyword
+genKeyword = Keyword <$> genText
+
+genReference :: Gen.Gen Reference
+genReference = Reference <$> genReferenceType <*> genText
+
+genReferenceType :: Gen.Gen ReferenceType
+genReferenceType = Gen.enumBounded

code/osv/src/Security/OSV.hs

@@ -246,7 +246,7 @@ data ReferenceType
   -- @app.any.run@ replaying the exploitation of the vulnerability.
   | ReferenceTypeWeb
   -- ^ A web page of some unspecified kind.
-  deriving (Show, Eq)
+  deriving (Show, Eq, Enum, Bounded)
 
 -- | Bijection of reference types and their string representations
 referenceTypes :: [(ReferenceType, Text)]