diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## 0.4.0.0 + +* Update `hsec-core` to `0.4.0.0` + ## 0.3.0.2 * Update `cvss` dependency bounds 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.3.0.2 +version: 0.4.0.0 -- A short (one-line) description of the package. synopsis: @@ -21,7 +21,10 @@ -- A copyright notice. -- copyright: category: Data -extra-doc-files: CHANGELOG.md, README.md +extra-doc-files: + CHANGELOG.md + README.md + extra-source-files: assets/css/*.css assets/images/*.png @@ -29,26 +32,30 @@ test/golden/*.md tested-with: - GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.3 || ==9.10.1 || ==9.12.1 + GHC ==8.10.7 + || ==9.0.2 + || ==9.2.8 + || ==9.4.8 + || ==9.6.6 + || ==9.8.3 + || ==9.10.1 + || ==9.12.1 library exposed-modules: Security.Advisories Security.Advisories.Convert.OSV Security.Advisories.Filesystem + Security.Advisories.Format Security.Advisories.Generate.HTML Security.Advisories.Generate.Snapshot Security.Advisories.Generate.TH Security.Advisories.Git - Security.Advisories.Format Security.Advisories.Parse Security.Advisories.Queries - other-modules: - Paths_hsec_tools - autogen-modules: - Paths_hsec_tools - + other-modules: Paths_hsec_tools + autogen-modules: Paths_hsec_tools build-depends: , aeson >=2.0.1.0 && <3 , atom-conduit >=0.9 && <0.10 @@ -64,9 +71,9 @@ , data-default >=0.7 && <0.8 , directory <2 , extra >=1.7 && <1.9 - , filepath >=1.4 && <1.6 - , hsec-core >= 0.3.0.0 && <0.4 , file-embed >=0.0.13.0 && <0.0.17 + , filepath >=1.4 && <1.6 + , hsec-core >=0.4.0.0 && <0.5 , lens >=5.1.0 && <5.4 , lucid >=2.9.0 && <3 , mtl >=2.2 && <2.4 @@ -80,13 +87,13 @@ , process >=1.6 && <1.7 , refined >=0.7 && <0.9 , resourcet >=1.2 && <1.4 - , text >=1.2 && <3 , template-haskell >=2.16.0.0 && <2.24 + , text >=1.2 && <3 , time >=1.9 && <1.15 , toml-parser >=2.0.0.0 && <2.1 , uri-bytestring >=0.3 && <0.5 - , xml-conduit >=1.9 && <1.11 , validation-selective >=0.1 && <1 + , xml-conduit >=1.9 && <1.11 hs-source-dirs: src default-language: Haskell2010 @@ -96,9 +103,10 @@ executable hsec-tools main-is: Main.hs - other-modules: Command.Reserve - , Command.NextID - , Util + other-modules: + Command.NextID + Command.Reserve + Util -- Modules included in this executable, other than Main. -- other-modules: @@ -106,19 +114,19 @@ -- LANGUAGE extensions used by modules in this package. -- other-extensions: build-depends: - , aeson >=2.0.1.0 && <3 - , base >=4.14 && <5 - , bytestring >=0.10 && <0.13 - , Cabal-syntax >=3.8.1.0 && <3.15 + , aeson >=2.0.1.0 && <3 + , base >=4.14 && <5 + , bytestring >=0.10 && <0.13 + , Cabal-syntax >=3.8.1.0 && <3.15 , directory <2 - , filepath >=1.4 && <1.6 - , hsec-core >= 0.3.0.0 && <0.4 + , filepath >=1.4 && <1.6 + , hsec-core >=0.4.0.0 && <0.5 , hsec-tools - , network-uri >=2.6.3.0 && <2.8 - , optparse-applicative >=0.17 && <0.19 - , text >=1.2 && <3 - , transformers >=0.5 && <0.7 - , validation-selective >=0.1 && <1 + , network-uri >=2.6.3.0 && <2.8 + , optparse-applicative >=0.17 && <0.19 + , text >=1.2 && <3 + , transformers >=0.5 && <0.7 + , validation-selective >=0.1 && <1 hs-source-dirs: app default-language: Haskell2010 @@ -130,28 +138,28 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs - autogen-modules: - Paths_hsec_tools + autogen-modules: Paths_hsec_tools other-modules: Paths_hsec_tools Spec.FormatSpec + build-depends: - , aeson-pretty <2 + , aeson-pretty <2 , base , Cabal-syntax , containers , cvss , directory - , hedgehog <2 + , hedgehog <2 , hsec-core , hsec-tools , network-uri , osv - , pretty-simple <5 + , pretty-simple <5 , prettyprinter - , tasty <2 - , tasty-golden <2.4 - , tasty-hedgehog <2 + , tasty <2 + , tasty-golden <2.4 + , tasty-hedgehog <2 , text , time , toml-parser 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,135 +1,140 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module Security.Advisories.Convert.OSV ( - convert, +module Security.Advisories.Convert.OSV + ( convert, convertWithLinks, DbLinks (..), AffectedLinks (..), haskellLinks, -) + ) where import Data.Aeson import qualified Data.Text as T import Data.Void import Distribution.Pretty (prettyShow) - import Security.Advisories +import Security.Advisories.Core.OsvId (printOsvId) import qualified Security.OSV as OSV convert :: Advisory -> OSV.Model Void Void Void Void convert adv = - ( OSV.newModel' - (T.pack . printHsecId $ advisoryId adv) - (advisoryModified adv) - ) - { OSV.modelPublished = Just $ advisoryPublished adv - , OSV.modelAliases = advisoryAliases adv - , OSV.modelRelated = advisoryRelated adv - , OSV.modelSummary = Just $ advisorySummary adv - , OSV.modelDetails = Just $ advisoryDetails adv - , OSV.modelReferences = advisoryReferences adv - , OSV.modelAffected = fmap mkAffected (advisoryAffected adv) - } + ( OSV.newModel' + (T.pack . printHsecId $ advisoryId adv) + (advisoryModified adv) + ) + { OSV.modelPublished = Just $ advisoryPublished adv, + OSV.modelAliases = map printOsvId (advisoryAliases adv), + OSV.modelRelated = map printOsvId (advisoryRelated adv), + OSV.modelSummary = Just $ advisorySummary adv, + OSV.modelDetails = Just $ advisoryDetails adv, + OSV.modelReferences = advisoryReferences adv, + OSV.modelAffected = fmap mkAffected (advisoryAffected adv) + } mkAffected :: Affected -> OSV.Affected Void Void 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.affectedDatabaseSpecific = Nothing - } + OSV.Affected + { OSV.affectedPackage = mkPackage (affectedComponentIdentifier aff), + OSV.affectedRanges = pure $ mkRange (affectedVersions aff), + OSV.affectedSeverity = [OSV.Severity (affectedCVSS aff)], + OSV.affectedEcosystemSpecific = Nothing, + OSV.affectedDatabaseSpecific = Nothing + } mkPackage :: ComponentIdentifier -> OSV.Package mkPackage ecosystem = - OSV.Package - { OSV.packageName = packageName - , OSV.packageEcosystem = ecosystemName - , OSV.packagePurl = Nothing - } + OSV.Package + { OSV.packageName = packageName, + OSV.packageEcosystem = ecosystemName, + OSV.packagePurl = Nothing + } where (ecosystemName, packageName) = case ecosystem of - Repository _ repoName pkg - | ecosystem == hackage pkg -> ("Hackage", T.pack $ unPackageName pkg) - | otherwise -> (unRepositoryName repoName, T.pack $ unPackageName pkg) - GHC c -> ("GHC", ghcComponentToText c) + Repository _ repoName pkg + | ecosystem == hackage pkg -> ("Hackage", T.pack $ unPackageName pkg) + | otherwise -> (unRepositoryName repoName, T.pack $ unPackageName pkg) + GHC c -> ("GHC", ghcComponentToText c) mkRange :: [AffectedVersionRange] -> OSV.Range Void mkRange ranges = - OSV.RangeEcosystem (foldMap mkEvs ranges) Nothing + OSV.RangeEcosystem (foldMap mkEvs ranges) Nothing where mkEvs :: AffectedVersionRange -> [OSV.Event T.Text] mkEvs range = - OSV.EventIntroduced (T.pack $ prettyShow $ affectedVersionRangeIntroduced range) - : maybe [] (pure . OSV.EventFixed . T.pack . prettyShow) (affectedVersionRangeFixed range) + 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 links adv = - OSV.Model - { OSV.modelDatabaseSpecific = Just links - , OSV.modelAffected = mkAffectedWithLinks links (advisoryId adv) <$> advisoryAffected adv - , .. - } + OSV.Model + { OSV.modelDatabaseSpecific = Just links, + OSV.modelAffected = mkAffectedWithLinks links (advisoryId adv) <$> advisoryAffected adv, + .. + } where - OSV.Model{..} = convert adv + OSV.Model {..} = convert adv data DbLinks = DbLinks - { dbLinksRepository :: T.Text - , dbLinksOSVs :: T.Text - , dbLinksHome :: T.Text - } + { dbLinksRepository :: T.Text, + dbLinksOSVs :: T.Text, + dbLinksHome :: T.Text + } instance ToJSON DbLinks where - toJSON DbLinks{..} = - object - [ "repository" .= dbLinksRepository - , "osvs" .= dbLinksOSVs - , "home" .= dbLinksHome - ] + toJSON DbLinks {..} = + object + [ "repository" .= dbLinksRepository, + "osvs" .= dbLinksOSVs, + "home" .= dbLinksHome + ] haskellLinks :: DbLinks haskellLinks = - DbLinks - { dbLinksRepository = "https://github.com/haskell/security-advisories" - , dbLinksOSVs = "https://raw.githubusercontent.com/haskell/security-advisories/refs/heads/generated/osv-export" - , dbLinksHome = "https://github.com/haskell/security-advisories" - } + DbLinks + { dbLinksRepository = "https://github.com/haskell/security-advisories", + dbLinksOSVs = "https://raw.githubusercontent.com/haskell/security-advisories/refs/heads/generated/osv-export", + dbLinksHome = "https://github.com/haskell/security-advisories" + } data AffectedLinks = AffectedLinks - { affectedLinksOSV :: T.Text - , affectedLinksHumanLink :: T.Text - } + { affectedLinksOSV :: T.Text, + affectedLinksHumanLink :: T.Text + } instance ToJSON AffectedLinks where - toJSON AffectedLinks{..} = - object - [ "osv" .= affectedLinksOSV - , "human_link" .= affectedLinksHumanLink - ] + toJSON AffectedLinks {..} = + object + [ "osv" .= affectedLinksOSV, + "human_link" .= affectedLinksHumanLink + ] mkAffectedWithLinks :: DbLinks -> HsecId -> Affected -> OSV.Affected AffectedLinks Void Void mkAffectedWithLinks links hsecId aff = - OSV.Affected - { OSV.affectedDatabaseSpecific = - Just - AffectedLinks - { affectedLinksOSV = osvLink - , affectedLinksHumanLink = humanLink - } - , .. - } + OSV.Affected + { OSV.affectedDatabaseSpecific = + Just + AffectedLinks + { affectedLinksOSV = osvLink, + affectedLinksHumanLink = humanLink + }, + .. + } where - OSV.Affected{..} = mkAffected aff + OSV.Affected {..} = mkAffected aff stripSlash = T.dropWhileEnd (== '/') osvLink = stripSlash (dbLinksOSVs links) - <> "/" <> T.pack (show $ hsecIdYear hsecId) - <> "/" <> T.pack (printHsecId hsecId) <> ".json" + <> "/" + <> T.pack (show $ hsecIdYear hsecId) + <> "/" + <> T.pack (printHsecId hsecId) + <> ".json" humanLink = stripSlash (dbLinksHome links) - <> "/tree/main/advisories/published/" - <> T.pack (show $ hsecIdYear hsecId) - <> "/" <> T.pack (printHsecId hsecId) <> ".md" + <> "/tree/main/advisories/published/" + <> T.pack (show $ hsecIdYear hsecId) + <> "/" + <> T.pack (printHsecId hsecId) + <> ".md" 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 @@ -1,9 +1,9 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-orphans #-} module Security.Advisories.Format @@ -16,31 +16,30 @@ ) where -import Control.Applicative ((<|>)) import Commonmark.Types (HasAttributes (..), IsBlock (..), IsInline (..), Rangeable (..), SourceRange (..)) +import Control.Applicative ((<|>)) +import Data.List (intercalate) import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Data.Monoid (First (..)) -import Data.List (intercalate) -import Data.Tuple (swap) -import GHC.Generics (Generic) - import Data.Text (Text) import qualified Data.Text as T -import Data.Time (utc, UTCTime(..), zonedTimeToUTC, localTimeToUTC) +import Data.Time (UTCTime (..), localTimeToUTC, utc, zonedTimeToUTC) +import Data.Tuple (swap) import Distribution.Parsec (eitherParsec) import Distribution.Pretty (pretty) import Distribution.Types.Version (Version) import Distribution.Types.VersionRange (VersionRange) +import GHC.Generics (Generic) import Network.URI (parseAbsoluteURI) -import qualified Text.PrettyPrint as Pretty -import qualified Toml -import qualified Toml.Schema as Toml - import Security.Advisories.Core.Advisory import Security.Advisories.Core.HsecId +import Security.Advisories.Core.OsvId (OsvId, parseOsvId, printOsvId) import qualified Security.CVSS as CVSS import Security.OSV (Reference (..), ReferenceType, referenceTypes) +import qualified Text.PrettyPrint as Pretty +import qualified Toml +import qualified Toml.Schema as Toml fromAdvisory :: Advisory -> FrontMatter fromAdvisory advisory = @@ -61,165 +60,178 @@ } -- advisory markdown file. -data FrontMatter = FrontMatter { - frontMatterAdvisory :: AdvisoryMetadata, - frontMatterReferences :: [Reference], - frontMatterAffected :: [Affected] -} deriving (Show, Generic) +data FrontMatter = FrontMatter + { frontMatterAdvisory :: AdvisoryMetadata, + frontMatterReferences :: [Reference], + frontMatterAffected :: [Affected] + } + deriving (Show, Generic) instance Toml.FromValue FrontMatter where fromValue = Toml.parseTableFromValue $ - do advisory <- Toml.reqKey "advisory" - affected <- Toml.reqKey "affected" + do + advisory <- Toml.reqKey "advisory" + affected <- Toml.reqKey "affected" references <- fromMaybe [] <$> Toml.optKey "references" - pure FrontMatter { - frontMatterAdvisory = advisory, - frontMatterAffected = affected, - frontMatterReferences = references - } + pure + FrontMatter + { frontMatterAdvisory = advisory, + frontMatterAffected = affected, + frontMatterReferences = references + } instance Toml.ToValue FrontMatter where toValue = Toml.defaultTableToValue instance Toml.ToTable FrontMatter where - toTable x = Toml.table - [ "advisory" Toml..= frontMatterAdvisory x - , "affected" Toml..= frontMatterAffected x - , "references" Toml..= frontMatterReferences x - ] + toTable x = + Toml.table + [ "advisory" Toml..= frontMatterAdvisory x, + "affected" Toml..= frontMatterAffected x, + "references" Toml..= frontMatterReferences x + ] -- | Internal type corresponding to the @[advisory]@ subsection of the -- TOML frontmatter in an advisory markdown file. data AdvisoryMetadata = AdvisoryMetadata - { amdId :: HsecId - , amdModified :: Maybe UTCTime - , amdPublished :: Maybe UTCTime - , amdCAPECs :: [CAPEC] - , amdCWEs :: [CWE] - , amdKeywords :: [Keyword] - , amdAliases :: [T.Text] - , amdRelated :: [T.Text] + { amdId :: HsecId, + amdModified :: Maybe UTCTime, + amdPublished :: Maybe UTCTime, + amdCAPECs :: [CAPEC], + amdCWEs :: [CWE], + amdKeywords :: [Keyword], + amdAliases :: [OsvId], + amdRelated :: [OsvId] } deriving (Show, Generic) instance Toml.FromValue AdvisoryMetadata where fromValue = Toml.parseTableFromValue $ - do identifier <- Toml.reqKey "id" - published <- Toml.optKeyOf "date" getDefaultedZonedTime - modified <- Toml.optKeyOf "modified" getDefaultedZonedTime + do + identifier <- Toml.reqKey "id" + published <- Toml.optKeyOf "date" getDefaultedZonedTime + modified <- Toml.optKeyOf "modified" getDefaultedZonedTime let optList key = fromMaybe [] <$> Toml.optKey key - capecs <- optList "capec" - cwes <- optList "cwe" - kwds <- optList "keywords" - aliases <- optList "aliases" - related <- optList "related" - pure AdvisoryMetadata - { amdId = identifier - , amdModified = modified - , amdPublished = published - , amdCAPECs = capecs - , amdCWEs = cwes - , amdKeywords = kwds - , amdAliases = aliases - , amdRelated = related - } + capecs <- optList "capec" + cwes <- optList "cwe" + kwds <- optList "keywords" + aliases <- optList "aliases" + related <- optList "related" + pure + AdvisoryMetadata + { amdId = identifier, + amdModified = modified, + amdPublished = published, + amdCAPECs = capecs, + amdCWEs = cwes, + amdKeywords = kwds, + amdAliases = aliases, + amdRelated = related + } instance Toml.ToValue AdvisoryMetadata where toValue = Toml.defaultTableToValue instance Toml.ToTable AdvisoryMetadata where - toTable x = Toml.table $ - ["id" Toml..= amdId x] ++ - ["modified" Toml..= y | Just y <- [amdModified x]] ++ - ["date" Toml..= y | Just y <- [amdPublished x]] ++ - ["capec" Toml..= amdCAPECs x | not (null (amdCAPECs x))] ++ - ["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))] + toTable x = + Toml.table $ + ["id" Toml..= amdId x] + ++ ["modified" Toml..= y | Just y <- [amdModified x]] + ++ ["date" Toml..= y | Just y <- [amdPublished x]] + ++ ["capec" Toml..= amdCAPECs x | not (null (amdCAPECs x))] + ++ ["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))] instance Toml.FromValue GHCComponent where fromValue v = case v of Toml.Text' _ n - | Just c <- ghcComponentFromText n - -> pure c - | otherwise - -> Toml.failAt (Toml.valueAnn v) $ - "Invalid ghc-component '" - <> T.unpack n - <> "', expected " - <> T.unpack (T.intercalate "|" componentNames) - _ -> Toml.failAt (Toml.valueAnn v) $ - "Non-text ghc-component, expected" + | Just c <- ghcComponentFromText n -> + pure c + | otherwise -> + Toml.failAt (Toml.valueAnn v) $ + "Invalid ghc-component '" + <> T.unpack n + <> "', expected " + <> T.unpack (T.intercalate "|" componentNames) + _ -> + Toml.failAt (Toml.valueAnn v) $ + "Non-text ghc-component, expected" <> T.unpack (T.intercalate "|" componentNames) - where - componentNames = map ghcComponentToText [minBound..maxBound] + where + componentNames = map ghcComponentToText [minBound .. maxBound] instance Toml.ToValue GHCComponent where toValue = Toml.Text' () . ghcComponentToText instance Toml.FromValue Affected where fromValue = - Toml.parseTableFromValue $ do - ecosystem <- - (Repository <$> Toml.reqKey "repository-url" <*> Toml.reqKey "repository-name" <*> Toml.reqKey "package" ) + Toml.parseTableFromValue $ do + ecosystem <- + (Repository <$> Toml.reqKey "repository-url" <*> Toml.reqKey "repository-name" <*> Toml.reqKey "package") <|> (hackage <$> Toml.reqKey "package") <|> (GHC <$> Toml.reqKey "ghc-component") - cvss <- Toml.reqKey "cvss" - os <- Toml.optKey "os" - arch <- Toml.optKey "arch" - decls <- maybe [] Map.toList <$> Toml.optKey "declarations" - versions <- Toml.reqKey "versions" - pure $ Affected - { affectedComponentIdentifier = ecosystem - , affectedCVSS = cvss - , affectedVersions = versions - , affectedArchitectures = arch - , affectedOS = os - , affectedDeclarations = decls - } + cvss <- Toml.reqKey "cvss" + os <- Toml.optKey "os" + arch <- Toml.optKey "arch" + decls <- maybe [] Map.toList <$> Toml.optKey "declarations" + versions <- Toml.reqKey "versions" + pure $ + Affected + { affectedComponentIdentifier = ecosystem, + affectedCVSS = cvss, + affectedVersions = versions, + affectedArchitectures = arch, + affectedOS = os, + affectedDeclarations = decls + } instance Toml.ToValue Affected where toValue = Toml.defaultTableToValue instance Toml.ToTable Affected where - toTable x = Toml.table $ - 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))] + toTable x = + Toml.table $ + 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 affectedComponentIdentifier x of Repository repoUrl repoName pkg | affectedComponentIdentifier x == hackage pkg -> ["package" Toml..= pkg] | 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] + asTable kvs = Map.fromList [(T.unpack k, v) | (k, v) <- kvs] instance Toml.FromValue AffectedVersionRange where fromValue = Toml.parseTableFromValue $ - do introduced <- Toml.reqKey "introduced" - fixed <- Toml.optKey "fixed" - pure AffectedVersionRange { - affectedVersionRangeIntroduced = introduced, - affectedVersionRangeFixed = fixed - } + do + introduced <- Toml.reqKey "introduced" + fixed <- Toml.optKey "fixed" + pure + AffectedVersionRange + { affectedVersionRangeIntroduced = introduced, + affectedVersionRangeFixed = fixed + } instance Toml.ToValue AffectedVersionRange where toValue = Toml.defaultTableToValue instance Toml.ToTable AffectedVersionRange where - toTable x = Toml.table $ - ("introduced" Toml..= affectedVersionRangeIntroduced x) : - ["fixed" Toml..= y | Just y <- [affectedVersionRangeFixed x]] - + toTable x = + Toml.table $ + ("introduced" Toml..= affectedVersionRangeIntroduced x) + : ["fixed" Toml..= y | Just y <- [affectedVersionRangeFixed x]] instance Toml.FromValue HsecId where fromValue v = - do s <- Toml.fromValue v + do + s <- Toml.fromValue v case parseHsecId s of Nothing -> Toml.failAt (Toml.valueAnn v) "invalid HSEC-ID: expected HSEC-[0-9]{4,}-[0-9]{4,}" Just x -> pure x @@ -227,6 +239,17 @@ instance Toml.ToValue HsecId where toValue = Toml.toValue . printHsecId +instance Toml.FromValue OsvId where + fromValue v = + do + s <- Toml.fromValue v + case parseOsvId s of + Nothing -> Toml.failAt (Toml.valueAnn v) "invalid OSV ID: expected -" + Just x -> pure x + +instance Toml.ToValue OsvId where + toValue = Toml.toValue . printOsvId + instance Toml.FromValue CAPEC where fromValue v = CAPEC <$> Toml.fromValue v @@ -249,13 +272,14 @@ getDefaultedZonedTime :: Toml.Value' l -> Toml.Matcher l UTCTime getDefaultedZonedTime (Toml.ZonedTime' _ x) = pure (zonedTimeToUTC x) getDefaultedZonedTime (Toml.LocalTime' _ x) = pure (localTimeToUTC utc x) -getDefaultedZonedTime (Toml.Day' _ x) = pure (UTCTime x 0) -getDefaultedZonedTime v = Toml.failAt (Toml.valueAnn v) "expected a date with optional time and timezone" +getDefaultedZonedTime (Toml.Day' _ x) = pure (UTCTime x 0) +getDefaultedZonedTime v = Toml.failAt (Toml.valueAnn v) "expected a date with optional time and timezone" instance Toml.FromValue Reference where fromValue = Toml.parseTableFromValue $ - do refType <- Toml.reqKey "type" - url <- Toml.reqKey "url" + do + refType <- Toml.reqKey "type" + url <- Toml.reqKey "url" pure (Reference refType url) instance Toml.FromValue ReferenceType where @@ -269,14 +293,16 @@ toValue = Toml.defaultTableToValue instance Toml.ToTable Reference where - toTable x = Toml.table - [ "type" Toml..= fromMaybe "UNKNOWN" (lookup (referencesType x) referenceTypes) - , "url" Toml..= referencesUrl x - ] + toTable x = + Toml.table + [ "type" Toml..= fromMaybe "UNKNOWN" (lookup (referencesType x) referenceTypes), + "url" Toml..= referencesUrl x + ] instance Toml.FromValue OS where fromValue v = - do s <- Toml.fromValue v + do + s <- Toml.fromValue v case s :: String of "darwin" -> pure MacOS "freebsd" -> pure FreeBSD @@ -290,18 +316,19 @@ instance Toml.ToValue OS where toValue x = Toml.toValue $ - case x of - MacOS -> "darwin" :: String - FreeBSD -> "freebsd" - Linux -> "linux" - Android -> "linux-android" - Windows -> "mingw32" - NetBSD -> "netbsd" - OpenBSD -> "openbsd" + case x of + MacOS -> "darwin" :: String + FreeBSD -> "freebsd" + Linux -> "linux" + Android -> "linux-android" + Windows -> "mingw32" + NetBSD -> "netbsd" + OpenBSD -> "openbsd" instance Toml.FromValue Architecture where fromValue v = - do s <- Toml.fromValue v + do + s <- Toml.fromValue v case parseArchitecture s of Just a -> pure a Nothing -> Toml.failAt (Toml.valueAnn v) ("Invalid architecture: " ++ show s) @@ -317,7 +344,8 @@ instance Toml.FromValue Version where fromValue v = - do s <- Toml.fromValue v + do + s <- Toml.fromValue v case eitherParsec s of Left err -> Toml.failAt (Toml.valueAnn v) ("parse error in version: " ++ err) Right affected -> pure affected @@ -327,7 +355,8 @@ instance Toml.FromValue VersionRange where fromValue v = - do s <- Toml.fromValue v + do + s <- Toml.fromValue v case eitherParsec s of Left err -> Toml.failAt (Toml.valueAnn v) ("parse error in version range: " ++ err) Right affected -> pure affected @@ -337,10 +366,11 @@ instance Toml.FromValue CVSS.CVSS where fromValue v = - do s <- Toml.fromValue v - case CVSS.parseCVSS s of - Left err -> Toml.failAt (Toml.valueAnn v) ("parse error in cvss: " ++ show err) - Right cvss -> pure cvss + do + s <- Toml.fromValue v + case CVSS.parseCVSS s of + Left err -> Toml.failAt (Toml.valueAnn v) ("parse error in cvss: " ++ show err) + Right cvss -> pure cvss instance Toml.ToValue CVSS.CVSS where toValue = Toml.toValue . CVSS.cvssVectorString @@ -369,7 +399,6 @@ -- block. We parse into this type to get the source range of -- the first block element. We can use it to delete the lines -- from the input. --- newtype FirstSourceRange = FirstSourceRange (First SourceRange) deriving (Show, Semigroup, Monoid) 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 @@ -33,6 +33,7 @@ import Refined (refineTH) import qualified Security.Advisories as Advisories import Security.Advisories.Core.Advisory (ComponentIdentifier (..), ghcComponentToText) +import Security.Advisories.Core.OsvId (printOsvId) import Security.Advisories.Filesystem (listAdvisories) import Security.Advisories.Generate.TH (readDirFilesTH) import qualified Security.OSV as OSV @@ -213,9 +214,9 @@ dt_ "Keywords" placeholderWhenEmptyOr (Advisories.advisoryKeywords advisory) $ dd_ [] . toHtml . T.intercalate ", " . map Advisories.unKeyword dt_ "Aliases" - placeholderWhenEmptyOr (Advisories.advisoryAliases advisory) $ dd_ [] . toHtml . T.intercalate ", " + placeholderWhenEmptyOr (Advisories.advisoryAliases advisory) $ dd_ [] . toHtml . T.intercalate ", " . map printOsvId dt_ "Related" - placeholderWhenEmptyOr (Advisories.advisoryRelated advisory) $ dd_ [] . toHtml . T.intercalate ", " + placeholderWhenEmptyOr (Advisories.advisoryRelated advisory) $ dd_ [] . toHtml . T.intercalate ", " . map printOsvId dt_ "References" placeholderWhenEmptyOr (Advisories.advisoryReferences advisory) $ \references -> forM_ references $ \reference -> @@ -228,10 +229,9 @@ case Advisories.affectedComponentIdentifier affected of Repository repoUrl repoName package -> let name = Advisories.unPackageName package - in - ( T.pack $ show $ set uriPathLens ("package/" <> name) nullURI `relativeTo` Advisories.unRepositoryURL repoUrl, - "@" <> Advisories.unRepositoryName repoName <> "/" <> T.pack name - ) + in ( T.pack $ show $ set uriPathLens ("package/" <> name) nullURI `relativeTo` Advisories.unRepositoryURL repoUrl, + "@" <> Advisories.unRepositoryName repoName <> "/" <> T.pack name + ) GHC component -> ( "https://gitlab.haskell.org/ghc/ghc", Advisories.ghcComponentToText component diff --git a/test/Spec/FormatSpec.hs b/test/Spec/FormatSpec.hs --- a/test/Spec/FormatSpec.hs +++ b/test/Spec/FormatSpec.hs @@ -7,6 +7,7 @@ import Control.Monad (replicateM) import Data.Function (on) import qualified Data.Map.Strict as Map +import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Text as T import Data.Time @@ -15,11 +16,12 @@ import qualified Hedgehog as Gen import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range -import Network.URI (URI(URI), URIAuth(URIAuth)) +import Network.URI (URI (URI), URIAuth (URIAuth)) 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.Core.OsvId (OsvId, parseOsvId) import Security.Advisories.Format import Security.CVSS import Security.OSV (Reference (..), ReferenceType (..)) @@ -65,8 +67,8 @@ <*> 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 + <*> Gen.list (Range.linear 0 5) genOsvId + <*> Gen.list (Range.linear 0 5) genOsvId genAffected :: Gen.Gen Affected genAffected = @@ -79,28 +81,30 @@ <*> (Map.toList . Map.fromList <$> Gen.list (Range.linear 0 5) ((,) <$> genText <*> genVersionRange)) genComponentIdentifier :: Gen.Gen ComponentIdentifier -genComponentIdentifier = Gen.choice $ - [ Repository - <$> (RepositoryURL <$> genURI) - <*> (RepositoryName <$> genText) - <*> (mkPackageName . T.unpack <$> genText) - , hackage . mkPackageName . T.unpack <$> genText - , GHC <$> Gen.enumBounded - ] +genComponentIdentifier = + Gen.choice $ + [ Repository + <$> (RepositoryURL <$> genURI) + <*> (RepositoryName <$> genText) + <*> (mkPackageName . T.unpack <$> genText), + hackage . mkPackageName . T.unpack <$> genText, + GHC <$> Gen.enumBounded + ] genURI :: Gen.Gen URI genURI = do - host <- Gen.element ["example.com", "foo.org", "bar.net", "test.co"] - nPath <- Gen.int (Range.linear 0 2) - parts <- replicateM nPath (Gen.string (Range.linear 1 10) Gen.alphaNum) - let path = concatMap ('/':) parts - hasQ <- Gen.bool - query <- if not hasQ - then pure "" - else do - k <- Gen.string (Range.linear 1 6) Gen.alphaNum - v <- Gen.string (Range.linear 1 6) Gen.alphaNum - pure $ '?': k ++ "=" ++ v + host <- Gen.element ["example.com", "foo.org", "bar.net", "test.co"] + nPath <- Gen.int (Range.linear 0 2) + parts <- replicateM nPath (Gen.string (Range.linear 1 10) Gen.alphaNum) + let path = concatMap ('/' :) parts + hasQ <- Gen.bool + query <- + if not hasQ + then pure "" + else do + k <- Gen.string (Range.linear 1 6) Gen.alphaNum + v <- Gen.string (Range.linear 1 6) Gen.alphaNum + pure $ '?' : k ++ "=" ++ v pure $ URI "https:" (Just $ URIAuth "" host "") path query "" genCVSS :: Gen.Gen CVSS @@ -186,3 +190,18 @@ genReferenceType :: Gen.Gen ReferenceType genReferenceType = Gen.enumBounded + +genOsvId :: Gen.Gen OsvId +genOsvId = do + prefix <- + Gen.element + [ "CVE", + "GHSA", + "HSEC", + "RUSTSEC", + "GO", + "OSV", + "PYSEC" + ] + entry <- Gen.text (Range.linear 4 10) Gen.alphaNum + pure . Maybe.fromJust . parseOsvId $ prefix <> "-" <> entry diff --git a/test/golden/EXAMPLE_ADVISORY_GHC.md b/test/golden/EXAMPLE_ADVISORY_GHC.md --- a/test/golden/EXAMPLE_ADVISORY_GHC.md +++ b/test/golden/EXAMPLE_ADVISORY_GHC.md @@ -4,8 +4,8 @@ id = "HSEC-0000-0000" cwe = [] keywords = ["example", "freeform", "keywords"] -aliases = ["CVE-2022-XXXX"] -related = ["CVE-2022-YYYY", "CVE-2022-ZZZZ"] +aliases = ["CVE-2022-1234"] +related = ["CVE-2022-5678", "CVE-2022-9012"] [[affected]] ghc-component = "ghci" 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 @@ -10,10 +10,11 @@ , "freeform" , "keywords" ] - , advisoryAliases = [ "CVE-2022-XXXX" ] + , advisoryAliases = + [ OsvId "CVE-2022-1234" ] , advisoryRelated = - [ "CVE-2022-YYYY" - , "CVE-2022-ZZZZ" + [ OsvId "CVE-2022-5678" + , OsvId "CVE-2022-9012" ] , advisoryAffected = [ Affected @@ -113,8 +114,8 @@ id = "HSEC-0000-0000" cwe = [] keywords = ["example", "freeform", "keywords"] - aliases = ["CVE-2022-XXXX"] - related = ["CVE-2022-YYYY", "CVE-2022-ZZZZ"] + aliases = ["CVE-2022-1234"] + related = ["CVE-2022-5678", "CVE-2022-9012"] [[affected]] ghc-component = "ghci" @@ -160,10 +161,10 @@ , modelModified = 1970-01-01 00:00:00 UTC , modelPublished = Just 1970-01-01 00:00:00 UTC , modelWithdrawn = Nothing - , modelAliases = [ "CVE-2022-XXXX" ] + , modelAliases = [ "CVE-2022-1234" ] , modelRelated = - [ "CVE-2022-YYYY" - , "CVE-2022-ZZZZ" + [ "CVE-2022-5678" + , "CVE-2022-9012" ] , modelSummary = Just "Advisory Template - Title Goes Here" , modelDetails = Just "# Advisory Template - Title Goes Here @@ -237,7 +238,7 @@ } ], "aliases": [ - "CVE-2022-XXXX" + "CVE-2022-1234" ], "details": "# Advisory Template - Title Goes Here\n\nThis is an example template.\n\n * Markdown\n * TOML \"front matter\".\n\n > Acme Broken.\n", "id": "HSEC-0000-0000", @@ -250,8 +251,8 @@ } ], "related": [ - "CVE-2022-YYYY", - "CVE-2022-ZZZZ" + "CVE-2022-5678", + "CVE-2022-9012" ], "schema_version": "1.5.0", "summary": "Advisory Template - Title Goes Here" diff --git a/test/golden/EXAMPLE_ADVISORY_HACKAGE.md b/test/golden/EXAMPLE_ADVISORY_HACKAGE.md --- a/test/golden/EXAMPLE_ADVISORY_HACKAGE.md +++ b/test/golden/EXAMPLE_ADVISORY_HACKAGE.md @@ -4,8 +4,8 @@ id = "HSEC-0000-0000" cwe = [] keywords = ["example", "freeform", "keywords"] -aliases = ["CVE-2022-XXXX"] -related = ["CVE-2022-YYYY", "CVE-2022-ZZZZ"] +aliases = ["CVE-2022-1234"] +related = ["CVE-2022-5678", "CVE-2022-9012"] [[affected]] package = "package-name" 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 @@ -10,10 +10,11 @@ , "freeform" , "keywords" ] - , advisoryAliases = [ "CVE-2022-XXXX" ] + , advisoryAliases = + [ OsvId "CVE-2022-1234" ] , advisoryRelated = - [ "CVE-2022-YYYY" - , "CVE-2022-ZZZZ" + [ OsvId "CVE-2022-5678" + , OsvId "CVE-2022-9012" ] , advisoryAffected = [ Affected @@ -118,8 +119,8 @@ id = "HSEC-0000-0000" cwe = [] keywords = ["example", "freeform", "keywords"] - aliases = ["CVE-2022-XXXX"] - related = ["CVE-2022-YYYY", "CVE-2022-ZZZZ"] + aliases = ["CVE-2022-1234"] + related = ["CVE-2022-5678", "CVE-2022-9012"] [[affected]] package = "package-name" @@ -165,10 +166,10 @@ , modelModified = 1970-01-01 00:00:00 UTC , modelPublished = Just 1970-01-01 00:00:00 UTC , modelWithdrawn = Nothing - , modelAliases = [ "CVE-2022-XXXX" ] + , modelAliases = [ "CVE-2022-1234" ] , modelRelated = - [ "CVE-2022-YYYY" - , "CVE-2022-ZZZZ" + [ "CVE-2022-5678" + , "CVE-2022-9012" ] , modelSummary = Just "Advisory Template - Title Goes Here" , modelDetails = Just "# Advisory Template - Title Goes Here @@ -242,7 +243,7 @@ } ], "aliases": [ - "CVE-2022-XXXX" + "CVE-2022-1234" ], "details": "# Advisory Template - Title Goes Here\n\nThis is an example template.\n\n * Markdown\n * TOML \"front matter\".\n\n > Acme Broken.\n", "id": "HSEC-0000-0000", @@ -255,8 +256,8 @@ } ], "related": [ - "CVE-2022-YYYY", - "CVE-2022-ZZZZ" + "CVE-2022-5678", + "CVE-2022-9012" ], "schema_version": "1.5.0", "summary": "Advisory Template - Title Goes Here" diff --git a/test/golden/EXAMPLE_ADVISORY_REPO.md b/test/golden/EXAMPLE_ADVISORY_REPO.md --- a/test/golden/EXAMPLE_ADVISORY_REPO.md +++ b/test/golden/EXAMPLE_ADVISORY_REPO.md @@ -4,8 +4,8 @@ id = "HSEC-0000-0000" cwe = [] keywords = ["example", "freeform", "keywords"] -aliases = ["CVE-2022-XXXX"] -related = ["CVE-2022-YYYY", "CVE-2022-ZZZZ"] +aliases = ["CVE-2022-1234"] +related = ["CVE-2022-5678", "CVE-2022-9012"] [[affected]] repository-url = "https://hackage.example.org/" 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 @@ -10,10 +10,11 @@ , "freeform" , "keywords" ] - , advisoryAliases = [ "CVE-2022-XXXX" ] + , advisoryAliases = + [ OsvId "CVE-2022-1234" ] , advisoryRelated = - [ "CVE-2022-YYYY" - , "CVE-2022-ZZZZ" + [ OsvId "CVE-2022-5678" + , OsvId "CVE-2022-9012" ] , advisoryAffected = [ Affected @@ -118,8 +119,8 @@ id = "HSEC-0000-0000" cwe = [] keywords = ["example", "freeform", "keywords"] - aliases = ["CVE-2022-XXXX"] - related = ["CVE-2022-YYYY", "CVE-2022-ZZZZ"] + aliases = ["CVE-2022-1234"] + related = ["CVE-2022-5678", "CVE-2022-9012"] [[affected]] repository-url = "https://hackage.example.org/" @@ -167,10 +168,10 @@ , modelModified = 1970-01-01 00:00:00 UTC , modelPublished = Just 1970-01-01 00:00:00 UTC , modelWithdrawn = Nothing - , modelAliases = [ "CVE-2022-XXXX" ] + , modelAliases = [ "CVE-2022-1234" ] , modelRelated = - [ "CVE-2022-YYYY" - , "CVE-2022-ZZZZ" + [ "CVE-2022-5678" + , "CVE-2022-9012" ] , modelSummary = Just "Advisory Template - Title Goes Here" , modelDetails = Just "# Advisory Template - Title Goes Here @@ -244,7 +245,7 @@ } ], "aliases": [ - "CVE-2022-XXXX" + "CVE-2022-1234" ], "details": "# Advisory Template - Title Goes Here\n\nThis is an example template.\n\n * Markdown\n * TOML \"front matter\".\n\n > Acme Broken.\n", "id": "HSEC-0000-0000", @@ -257,8 +258,8 @@ } ], "related": [ - "CVE-2022-YYYY", - "CVE-2022-ZZZZ" + "CVE-2022-5678", + "CVE-2022-9012" ], "schema_version": "1.5.0", "summary": "Advisory Template - Title Goes Here"