diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +## 0.5.0.0 + +* Add `HsecEcosystemSpecific` with `affected_api` in OSV exports +* Add TOML parsing/rendering for `api` key in affected sections +* Add HTML rendering for affected APIs +* Update `hsec-core` to `0.5.0.0` + ## 0.4.0.0 * Update `hsec-core` to `0.4.0.0` diff --git a/hsec-tools.cabal b/hsec-tools.cabal --- a/hsec-tools.cabal +++ b/hsec-tools.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hsec-tools -version: 0.4.0.0 +version: 0.5.0.0 -- A short (one-line) description of the package. synopsis: @@ -73,7 +73,7 @@ , extra >=1.7 && <1.9 , file-embed >=0.0.13.0 && <0.0.17 , filepath >=1.4 && <1.6 - , hsec-core >=0.4.0.0 && <0.5 + , hsec-core >=0.5.0.0 && <0.6 , lens >=5.1.0 && <5.4 , lucid >=2.9.0 && <3 , mtl >=2.2 && <2.4 @@ -120,7 +120,7 @@ , Cabal-syntax >=3.8.1.0 && <3.15 , directory <2 , filepath >=1.4 && <1.6 - , hsec-core >=0.4.0.0 && <0.5 + , hsec-core >=0.5.0.0 && <0.6 , hsec-tools , network-uri >=2.6.3.0 && <2.8 , optparse-applicative >=0.17 && <0.19 @@ -142,10 +142,13 @@ other-modules: Paths_hsec_tools Spec.FormatSpec + Spec.OsvSpec build-depends: + , aeson >=2.0.1.0 && <3 , aeson-pretty <2 , base + , bytestring >=0.10 && <0.14 , Cabal-syntax , containers , cvss diff --git a/src/Security/Advisories/Convert/OSV.hs b/src/Security/Advisories/Convert/OSV.hs --- a/src/Security/Advisories/Convert/OSV.hs +++ b/src/Security/Advisories/Convert/OSV.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -6,6 +8,7 @@ convertWithLinks, DbLinks (..), AffectedLinks (..), + HsecEcosystemSpecific (..), haskellLinks, ) where @@ -18,7 +21,7 @@ import Security.Advisories.Core.OsvId (printOsvId) import qualified Security.OSV as OSV -convert :: Advisory -> OSV.Model Void Void Void Void +convert :: Advisory -> OSV.Model Void Void HsecEcosystemSpecific Void convert adv = ( OSV.newModel' (T.pack . printHsecId $ advisoryId adv) @@ -33,13 +36,16 @@ OSV.modelAffected = fmap mkAffected (advisoryAffected adv) } -mkAffected :: Affected -> OSV.Affected Void Void Void +mkAffected :: Affected -> OSV.Affected Void HsecEcosystemSpecific Void mkAffected aff = OSV.Affected { OSV.affectedPackage = mkPackage (affectedComponentIdentifier aff), OSV.affectedRanges = pure $ mkRange (affectedVersions aff), OSV.affectedSeverity = [OSV.Severity (affectedCVSS aff)], - OSV.affectedEcosystemSpecific = Nothing, + OSV.affectedEcosystemSpecific = + if null (affectedApi aff) + then Nothing + else Just (HsecEcosystemSpecific (affectedApi aff)), OSV.affectedDatabaseSpecific = Nothing } @@ -66,7 +72,7 @@ OSV.EventIntroduced (T.pack $ prettyShow $ affectedVersionRangeIntroduced range) : maybe [] (pure . OSV.EventFixed . T.pack . prettyShow) (affectedVersionRangeFixed range) -convertWithLinks :: DbLinks -> Advisory -> OSV.Model DbLinks AffectedLinks Void Void +convertWithLinks :: DbLinks -> Advisory -> OSV.Model DbLinks AffectedLinks HsecEcosystemSpecific Void convertWithLinks links adv = OSV.Model { OSV.modelDatabaseSpecific = Just links, @@ -90,6 +96,13 @@ "home" .= dbLinksHome ] +instance FromJSON DbLinks where + parseJSON = withObject "DbLinks" $ \o -> do + dbLinksRepository <- o .: "repository" + dbLinksOSVs <- o .: "osvs" + dbLinksHome <- o .: "home" + pure DbLinks {..} + haskellLinks :: DbLinks haskellLinks = DbLinks @@ -110,7 +123,42 @@ "human_link" .= affectedLinksHumanLink ] -mkAffectedWithLinks :: DbLinks -> HsecId -> Affected -> OSV.Affected AffectedLinks Void Void +instance FromJSON AffectedLinks where + parseJSON = withObject "AffectedLinks" $ \o -> do + affectedLinksOSV <- o .: "osv" + affectedLinksHumanLink <- o .: "human_link" + pure AffectedLinks {..} + +newtype HsecEcosystemSpecific = HsecEcosystemSpecific + { hsecEcosystemAffectedApi :: [AffectedApi] + } + deriving stock (Eq, Show) + +instance ToJSON HsecEcosystemSpecific where + toJSON (HsecEcosystemSpecific apis) = + object + [ "affected_api" .= apis + ] + +instance FromJSON HsecEcosystemSpecific where + parseJSON = withObject "HsecEcosystemSpecific" $ \o -> do + hsecEcosystemAffectedApi <- o .: "affected_api" + pure HsecEcosystemSpecific {..} + +instance ToJSON AffectedApi where + toJSON AffectedApi {..} = + object + [ "module" .= affectedApiModule, + "name" .= affectedApiName + ] + +instance FromJSON AffectedApi where + parseJSON = withObject "AffectedApi" $ \o -> do + affectedApiModule <- o .: "module" + affectedApiName <- o .: "name" + pure AffectedApi {..} + +mkAffectedWithLinks :: DbLinks -> HsecId -> Affected -> OSV.Affected AffectedLinks HsecEcosystemSpecific Void mkAffectedWithLinks links hsecId aff = OSV.Affected { OSV.affectedDatabaseSpecific = diff --git a/src/Security/Advisories/Format.hs b/src/Security/Advisories/Format.hs --- a/src/Security/Advisories/Format.hs +++ b/src/Security/Advisories/Format.hs @@ -176,6 +176,7 @@ os <- Toml.optKey "os" arch <- Toml.optKey "arch" decls <- maybe [] Map.toList <$> Toml.optKey "declarations" + api <- fromMaybe [] <$> Toml.optKey "api" versions <- Toml.reqKey "versions" pure $ Affected @@ -184,7 +185,8 @@ affectedVersions = versions, affectedArchitectures = arch, affectedOS = os, - affectedDeclarations = decls + affectedDeclarations = decls, + affectedApi = api } instance Toml.ToValue Affected where @@ -200,6 +202,7 @@ ++ ["os" Toml..= y | Just y <- [affectedOS x]] ++ ["arch" Toml..= y | Just y <- [affectedArchitectures x]] ++ ["declarations" Toml..= asTable (affectedDeclarations x) | not (null (affectedDeclarations x))] + ++ ["api" Toml..= affectedApi x | not (null (affectedApi x))] where ecosystem = case affectedComponentIdentifier x of Repository repoUrl repoName pkg @@ -207,6 +210,25 @@ | otherwise -> ["repository-url" Toml..= repoUrl, "repository-name" Toml..= repoName, "package" Toml..= pkg] GHC c -> ["ghc-component" Toml..= c] asTable kvs = Map.fromList [(T.unpack k, v) | (k, v) <- kvs] + +instance Toml.FromValue AffectedApi where + fromValue = Toml.parseTableFromValue $ do + mod <- Toml.reqKey "module" + name <- Toml.reqKey "name" + pure AffectedApi + { affectedApiModule = mod, + affectedApiName = name + } + +instance Toml.ToValue AffectedApi where + toValue = Toml.defaultTableToValue + +instance Toml.ToTable AffectedApi where + toTable x = + Toml.table + [ "module" Toml..= affectedApiModule x, + "name" Toml..= affectedApiName x + ] instance Toml.FromValue AffectedVersionRange where fromValue = Toml.parseTableFromValue $ diff --git a/src/Security/Advisories/Generate/HTML.hs b/src/Security/Advisories/Generate/HTML.hs --- a/src/Security/Advisories/Generate/HTML.hs +++ b/src/Security/Advisories/Generate/HTML.hs @@ -265,6 +265,13 @@ code_ [] $ toHtml declaration ": " code_ [] $ toHtml $ T.pack $ prettyShow versionRange + dt_ "Affected APIs" + placeholderWhenEmptyOr (Advisories.affectedApi affected) $ \apis -> + forM_ apis $ \api -> + dd_ [] $ do + code_ [] $ toHtml $ Advisories.affectedApiModule api + "." + code_ [] $ toHtml $ Advisories.affectedApiName api -- * Utils diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -13,6 +13,7 @@ import qualified Security.Advisories.Convert.OSV as OSV import Security.Advisories.Parse import qualified Spec.FormatSpec as FormatSpec +import qualified Spec.OsvSpec as OsvSpec import System.Directory (listDirectory) import Test.Tasty (defaultMain, testGroup, TestTree) import Test.Tasty.Golden (goldenVsString) @@ -26,6 +27,7 @@ "Tests" [ goldenTestsSpec goldenFiles , FormatSpec.spec + , OsvSpec.spec ] listGoldenFiles :: IO [FilePath] diff --git a/test/Spec/FormatSpec.hs b/test/Spec/FormatSpec.hs --- a/test/Spec/FormatSpec.hs +++ b/test/Spec/FormatSpec.hs @@ -79,6 +79,7 @@ <*> 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)) + <*> Gen.list (Range.linear 0 5) genAffectedApi genComponentIdentifier :: Gen.Gen ComponentIdentifier genComponentIdentifier = @@ -139,7 +140,7 @@ genUTCTime = UTCTime <$> genDay - <*> fmap secondsToDiffTime (Gen.integral $ Range.constant 0 86401) + <*> fmap secondsToDiffTime (Gen.integral $ Range.constant 0 86399) genDay :: Gen.Gen Day genDay = do @@ -205,3 +206,6 @@ ] entry <- Gen.text (Range.linear 4 10) Gen.alphaNum pure . Maybe.fromJust . parseOsvId $ prefix <> "-" <> entry + +genAffectedApi :: Gen.Gen AffectedApi +genAffectedApi = AffectedApi <$> genText <*> genText diff --git a/test/Spec/OsvSpec.hs b/test/Spec/OsvSpec.hs new file mode 100644 --- /dev/null +++ b/test/Spec/OsvSpec.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Spec.OsvSpec (spec) where + +import Data.Aeson (decode, encode) +import Data.ByteString.Lazy (toStrict) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Security.Advisories.Convert.OSV +import Security.Advisories.Core.Advisory +import Test.Tasty +import Test.Tasty.Hedgehog +import qualified Hedgehog as Gen +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + +spec :: TestTree +spec = + testGroup + "OSV" + [ testGroup + "AffectedApi" + [ testProperty "JSON roundtrip" $ + Gen.property $ do + api <- Gen.forAll genAffectedApi + let encoded = encode api + decoded = decode encoded + Just api Gen.=== decoded + ] + , testGroup + "HsecEcosystemSpecific" + [ testProperty "JSON roundtrip" $ + Gen.property $ do + ecs <- Gen.forAll genHsecEcosystemSpecific + let encoded = encode ecs + decoded = decode encoded + Just ecs Gen.=== decoded + , testProperty "encodes affected_api key" $ + Gen.property $ do + apis <- Gen.forAll (Gen.list (Range.linear 1 5) genAffectedApi) + let ecs = HsecEcosystemSpecific apis + jsonBytes = encode ecs + jsonText = TE.decodeUtf8 (toStrict jsonBytes) + Gen.assert $ "affected_api" `T.isInfixOf` jsonText + , testProperty "Nothing when empty" $ + Gen.property $ do + let ecs = HsecEcosystemSpecific [] + jsonBytes = encode ecs + jsonText = TE.decodeUtf8 (toStrict jsonBytes) + Gen.assert $ "affected_api" `T.isInfixOf` jsonText + ] + ] + +genAffectedApi :: Gen.Gen AffectedApi +genAffectedApi = AffectedApi <$> genText <*> genText + +genHsecEcosystemSpecific :: Gen.Gen HsecEcosystemSpecific +genHsecEcosystemSpecific = HsecEcosystemSpecific <$> Gen.list (Range.linear 0 5) genAffectedApi + +genText :: Gen.Gen T.Text +genText = Gen.text (Range.linear 1 20) Gen.alphaNum diff --git a/test/golden/EXAMPLE_ADVISORY_GHC.md.golden b/test/golden/EXAMPLE_ADVISORY_GHC.md.golden --- a/test/golden/EXAMPLE_ADVISORY_GHC.md.golden +++ b/test/golden/EXAMPLE_ADVISORY_GHC.md.golden @@ -46,6 +46,7 @@ , affectedArchitectures = Nothing , affectedOS = Nothing , affectedDeclarations = [] + , affectedApi = [] } ] , advisoryReferences = diff --git a/test/golden/EXAMPLE_ADVISORY_HACKAGE.md.golden b/test/golden/EXAMPLE_ADVISORY_HACKAGE.md.golden --- a/test/golden/EXAMPLE_ADVISORY_HACKAGE.md.golden +++ b/test/golden/EXAMPLE_ADVISORY_HACKAGE.md.golden @@ -51,6 +51,7 @@ , affectedArchitectures = Nothing , affectedOS = Nothing , affectedDeclarations = [] + , affectedApi = [] } ] , advisoryReferences = diff --git a/test/golden/EXAMPLE_ADVISORY_REPO.md.golden b/test/golden/EXAMPLE_ADVISORY_REPO.md.golden --- a/test/golden/EXAMPLE_ADVISORY_REPO.md.golden +++ b/test/golden/EXAMPLE_ADVISORY_REPO.md.golden @@ -51,6 +51,7 @@ , affectedArchitectures = Nothing , affectedOS = Nothing , affectedDeclarations = [] + , affectedApi = [] } ] , advisoryReferences =