hsec-tools 0.3.0.2 → 0.4.0.0
raw patch · 12 files changed
+385/−317 lines, 12 filesdep ~hsec-corePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hsec-core
API changes (from Hackage documentation)
+ Security.Advisories.Format: instance Toml.Schema.FromValue.FromValue Security.Advisories.Core.OsvId.OsvId
+ Security.Advisories.Format: instance Toml.Schema.ToValue.ToValue Security.Advisories.Core.OsvId.OsvId
- Security.Advisories.Format: AdvisoryMetadata :: HsecId -> Maybe UTCTime -> Maybe UTCTime -> [CAPEC] -> [CWE] -> [Keyword] -> [Text] -> [Text] -> AdvisoryMetadata
+ Security.Advisories.Format: AdvisoryMetadata :: HsecId -> Maybe UTCTime -> Maybe UTCTime -> [CAPEC] -> [CWE] -> [Keyword] -> [OsvId] -> [OsvId] -> AdvisoryMetadata
- Security.Advisories.Format: [amdAliases] :: AdvisoryMetadata -> [Text]
+ Security.Advisories.Format: [amdAliases] :: AdvisoryMetadata -> [OsvId]
- Security.Advisories.Format: [amdRelated] :: AdvisoryMetadata -> [Text]
+ Security.Advisories.Format: [amdRelated] :: AdvisoryMetadata -> [OsvId]
Files
- CHANGELOG.md +4/−0
- hsec-tools.cabal +43/−35
- src/Security/Advisories/Convert/OSV.hs +84/−79
- src/Security/Advisories/Format.hs +165/−136
- src/Security/Advisories/Generate/HTML.hs +6/−6
- test/Spec/FormatSpec.hs +41/−22
- test/golden/EXAMPLE_ADVISORY_GHC.md +2/−2
- test/golden/EXAMPLE_ADVISORY_GHC.md.golden +12/−11
- test/golden/EXAMPLE_ADVISORY_HACKAGE.md +2/−2
- test/golden/EXAMPLE_ADVISORY_HACKAGE.md.golden +12/−11
- test/golden/EXAMPLE_ADVISORY_REPO.md +2/−2
- test/golden/EXAMPLE_ADVISORY_REPO.md.golden +12/−11
CHANGELOG.md view
@@ -1,3 +1,7 @@+## 0.4.0.0++* Update `hsec-core` to `0.4.0.0`+ ## 0.3.0.2 * Update `cvss` dependency bounds
hsec-tools.cabal view
@@ -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
src/Security/Advisories/Convert/OSV.hs view
@@ -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"
src/Security/Advisories/Format.hs view
@@ -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 <KNOWN_PREFIX>-<ENTRYID>"+ 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)
src/Security/Advisories/Generate/HTML.hs view
@@ -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
test/Spec/FormatSpec.hs view
@@ -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
test/golden/EXAMPLE_ADVISORY_GHC.md view
@@ -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"
test/golden/EXAMPLE_ADVISORY_GHC.md.golden view
@@ -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"
test/golden/EXAMPLE_ADVISORY_HACKAGE.md view
@@ -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"
test/golden/EXAMPLE_ADVISORY_HACKAGE.md.golden view
@@ -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"
test/golden/EXAMPLE_ADVISORY_REPO.md view
@@ -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/"
test/golden/EXAMPLE_ADVISORY_REPO.md.golden view
@@ -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"