packages feed

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 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 = &quot;HSEC-0000-0000&quot;           cwe = []           keywords = [&quot;example&quot;, &quot;freeform&quot;, &quot;keywords&quot;]-          aliases = [&quot;CVE-2022-XXXX&quot;]-          related = [&quot;CVE-2022-YYYY&quot;, &quot;CVE-2022-ZZZZ&quot;]+          aliases = [&quot;CVE-2022-1234&quot;]+          related = [&quot;CVE-2022-5678&quot;, &quot;CVE-2022-9012&quot;]            [[affected]]           ghc-component = &quot;ghci&quot;@@ -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 = &quot;HSEC-0000-0000&quot;           cwe = []           keywords = [&quot;example&quot;, &quot;freeform&quot;, &quot;keywords&quot;]-          aliases = [&quot;CVE-2022-XXXX&quot;]-          related = [&quot;CVE-2022-YYYY&quot;, &quot;CVE-2022-ZZZZ&quot;]+          aliases = [&quot;CVE-2022-1234&quot;]+          related = [&quot;CVE-2022-5678&quot;, &quot;CVE-2022-9012&quot;]            [[affected]]           package = &quot;package-name&quot;@@ -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 = &quot;HSEC-0000-0000&quot;           cwe = []           keywords = [&quot;example&quot;, &quot;freeform&quot;, &quot;keywords&quot;]-          aliases = [&quot;CVE-2022-XXXX&quot;]-          related = [&quot;CVE-2022-YYYY&quot;, &quot;CVE-2022-ZZZZ&quot;]+          aliases = [&quot;CVE-2022-1234&quot;]+          related = [&quot;CVE-2022-5678&quot;, &quot;CVE-2022-9012&quot;]            [[affected]]           repository-url = &quot;https://hackage.example.org/&quot;@@ -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"