diff --git a/code/cvss/src/Security/CVSS.hs b/code/cvss/src/Security/CVSS.hs index e47654dc..4feab9a6 100644 --- a/code/cvss/src/Security/CVSS.hs +++ b/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 diff --git a/code/hsec-core/src/Security/Advisories/Core/Advisory.hs b/code/hsec-core/src/Security/Advisories/Core/Advisory.hs index e330eebe..284506c4 100644 --- a/code/hsec-core/src/Security/Advisories/Core/Advisory.hs +++ b/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) diff --git a/code/hsec-tools/hsec-tools.cabal b/code/hsec-tools/hsec-tools.cabal index 33be226e..36ae2b4a 100644 --- a/code/hsec-tools/hsec-tools.cabal +++ b/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: diff --git a/code/hsec-tools/src/Security/Advisories/Format.hs b/code/hsec-tools/src/Security/Advisories/Format.hs index 27453a70..fe07d564 100644 --- a/code/hsec-tools/src/Security/Advisories/Format.hs +++ b/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 $ diff --git a/code/hsec-tools/test/Spec.hs b/code/hsec-tools/test/Spec.hs index d8981c2b..e01ecb41 100644 --- a/code/hsec-tools/test/Spec.hs +++ b/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 diff --git a/code/hsec-tools/test/Spec/FormatSpec.hs b/code/hsec-tools/test/Spec/FormatSpec.hs new file mode 100644 index 00000000..b4f0320c --- /dev/null +++ b/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 diff --git a/code/osv/src/Security/OSV.hs b/code/osv/src/Security/OSV.hs index 7a030ab4..745b4207 100644 --- a/code/osv/src/Security/OSV.hs +++ b/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)]