feat: add support for other namespaces (#240)

EXAMPLE_ADVISORY.md

@@ -30,7 +30,12 @@ related = ["CVE-2022-YYYY", "CVE-2022-ZZZZ"]
 # OPTION 1: package = hackage-package-name
 package = "package-name"
 #
-# OPTION 2: ghc-component = {ghc,ghci,rts,ghc-pkg,runghc,ghc-iserv,hp2ps,hpc,hsc2hs,haddock}
+# OPTION 2: alternative-hackage-package = hackage-package-name
+# repository-url = "https//hackage.example.org/"
+# repository-name = "example"
+# package = "package-name"
+#
+# OPTION 3: ghc-component = {ghc,ghci,rts,ghc-pkg,runghc,ghc-iserv,hp2ps,hpc,hsc2hs,haddock}
 # ghc-component = "ghci"
 
 # CVSS vector.  Accepted versions: 2.0, 3.0, 3.1

code/hsec-core/CHANGELOG.md

@@ -1,3 +1,7 @@
+## 0.3.0.0
+
+* Add `Repository` and `ComponentIdentifier` in `Security.Advisories.Core.Advisory`
+
 ## 0.2.1.0
 
 * Introduce `isVersionAffectedBy` and `isVersionRangeAffectedBy` in `Security.Advisories.Core`

code/hsec-core/hsec-core.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               hsec-core
-version:            0.2.1.0
+version:            0.3.0.0
 
 -- A short (one-line) description of the package.
 synopsis:           Core package representing Haskell advisories

code/hsec-core/src/Security/Advisories/Core/Advisory.hs

@@ -12,8 +12,14 @@ module Security.Advisories.Core.Advisory
   , Keyword(..)
   , ComponentIdentifier(..)
   , GHCComponent(..)
+  , RepositoryURL(..)
+  , RepositoryName(..)
+  , PackageName
+  , mkPackageName
+  , unPackageName
   , ghcComponentToText
   , ghcComponentFromText
+  , hackage
     -- * Queries
   , isVersionAffectedBy
   , isVersionRangeAffectedBy
@@ -22,6 +28,7 @@ module Security.Advisories.Core.Advisory
 
 import Data.Text (Text)
 import Data.Time (UTCTime)
+import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName)
 import Distribution.Types.Version (Version)
 import Distribution.Types.VersionInterval (asVersionIntervals)
 import Distribution.Types.VersionRange (VersionRange, anyVersion, earlierVersion, intersectVersionRanges, noVersion, orLaterVersion, unionVersionRanges, withinRange)
@@ -52,9 +59,22 @@ data Advisory = Advisory
   }
   deriving stock (Show)
 
-data ComponentIdentifier = Hackage Text | GHC GHCComponent
+data ComponentIdentifier
+  = Repository RepositoryURL RepositoryName PackageName
+  | GHC GHCComponent
   deriving stock (Show, Eq)
 
+hackage :: PackageName -> ComponentIdentifier
+hackage = Repository (RepositoryURL "https://hackage.haskell.org") (RepositoryName "hackage")
+
+newtype RepositoryURL
+  = RepositoryURL { unRepositoryURL :: Text }
+  deriving stock (Eq, Ord, Show)
+
+newtype RepositoryName
+  = RepositoryName { unRepositoryName :: Text }
+  deriving stock (Eq, Ord, Show)
+
 -- Keep this list in sync with the 'ghcComponentFromText' below
 data GHCComponent = GHCCompiler | GHCi | GHCRTS | GHCPkg | RunGHC | IServ | HP2PS | HPC | HSC2HS | Haddock
   deriving stock (Show, Eq, Enum, Bounded)

code/hsec-core/test/Spec/QueriesSpec.hs

@@ -186,7 +186,7 @@ mkAffectedVersions vr =
       ]
 
 component :: ComponentIdentifier
-component = Hackage "package-name"
+component = hackage $ mkPackageName "package-name"
 
 -- | Parse 'VersionRange' as given to the CLI
 parseVersionRange :: Maybe Text -> Either Text VersionRange

code/hsec-tools/CHANGELOG.md

@@ -1,3 +1,7 @@
+## 0.3.0.1
+
+* Bump `hsec-core` `0.3.0.0`
+
 ## 0.3.0.0
 
 * Move `isVersionAffectedBy` and `isVersionRangeAffectedBy` to `Security.Advisories.Core` (`hsec-core`)

code/hsec-tools/app/Main.hs

@@ -135,14 +135,18 @@ commandQuery =
     isAffected :: Parser (IO ())
     isAffected =
       go
-        <$> argument (parseComponent <$> str) (metavar "PACKAGE|GHC:COMPONENT")
+        <$> argument (parseComponent <$> str) (metavar "PACKAGE|REPO:PACKAGE|GHC:COMPONENT")
         <*> optional (option versionRangeReader (metavar "VERSION-RANGE" <> short 'v' <> long "version-range"))
         <*> optional (option str (metavar "ADVISORIES-PATH" <> short 'p' <> long "advisories-path"))
       where
         parseComponent raw =
-          fromMaybe (Hackage raw) $ do
-            ghcComponentRaw <- T.stripPrefix "ghc:" $ T.toLower raw
-            GHC <$> ghcComponentFromText ghcComponentRaw
+          case T.breakOn ":" raw of
+            (pkg, "") -> hackage $ mkPackageName $ T.unpack pkg
+            (p, pkg) ->
+              let pkgName = mkPackageName $ T.unpack pkg
+              in if T.toCaseFold p == T.toCaseFold "ghc"
+                  then fromMaybe (hackage pkgName) $ GHC <$> ghcComponentFromText p
+                  else Repository (RepositoryURL "") (RepositoryName p) pkgName
         go :: ComponentIdentifier -> Maybe VersionRange -> Maybe FilePath -> IO ()
         go component versionRange advisoriesPath = do
           let versionRange' = fromMaybe anyVersion versionRange

code/hsec-tools/hsec-tools.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               hsec-tools
-version:            0.3.0.0
+version:            0.3.0.1
 
 -- A short (one-line) description of the package.
 synopsis:
@@ -65,7 +65,7 @@ library
     , directory             <2
     , extra                 >=1.7      && <1.9
     , filepath              >=1.4      && <1.6
-    , hsec-core             >= 0.2.1.0 && <0.3
+    , hsec-core             >= 0.3.0.0 && <0.4
     , file-embed            >=0.0.13.0 && <0.0.17
     , lucid                 >=2.9.0    && < 3
     , mtl                   >=2.2      && <2.4
@@ -109,7 +109,7 @@ executable hsec-tools
     , bytestring            >=0.10     && <0.13
     , Cabal-syntax          >=3.8.1.0  && <3.15
     , filepath              >=1.4      && <1.6
-    , hsec-core             >= 0.2.1.0 && <0.3
+    , hsec-core             >= 0.3.0.0 && <0.4
     , hsec-tools
     , optparse-applicative  >=0.17     && <0.19
     , text                  >=1.2      && <3

code/hsec-tools/src/Security/Advisories/Convert/OSV.hs

@@ -52,7 +52,9 @@ mkPackage ecosystem =
         }
   where
     (ecosystemName, packageName) = case ecosystem of
-        Hackage n -> ("Hackage", n)
+        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

code/hsec-tools/src/Security/Advisories/Format.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -15,7 +16,7 @@ module Security.Advisories.Format
   )
 where
 
-import Control.Applicative ((<|>))
+import Control.Applicative (asum)
 import Commonmark.Types (HasAttributes (..), IsBlock (..), IsInline (..), Rangeable (..), SourceRange (..))
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
@@ -157,9 +158,15 @@ instance Toml.ToValue GHCComponent where
   toValue = Toml.Text' () . ghcComponentToText
 
 instance Toml.FromValue Affected where
-  fromValue = Toml.parseTableFromValue $
-   do ecosystem   <- (Hackage <$> Toml.reqKey "package") <|> (GHC <$> Toml.reqKey "ghc-component")
-      cvss      <- Toml.reqKey "cvss" -- TODO validate CVSS format
+  fromValue =
+   Toml.parseTableFromValue $ do
+      ecosystem   <-
+        asum [
+            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"
@@ -187,7 +194,9 @@ instance Toml.ToTable Affected where
     [ "declarations" Toml..= asTable (affectedDeclarations x) | not (null (affectedDeclarations x))]
     where
       ecosystem = case affectedComponentIdentifier x of
-        Hackage pkg -> ["package" Toml..= pkg]
+        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]
 
@@ -337,6 +346,20 @@ instance Toml.FromValue CVSS.CVSS where
 instance Toml.ToValue CVSS.CVSS where
   toValue = Toml.toValue . CVSS.cvssVectorString
 
+instance Toml.ToValue PackageName where
+  toValue = Toml.toValue . unPackageName
+
+instance Toml.FromValue PackageName where
+  fromValue = fmap mkPackageName . Toml.fromValue
+
+deriving newtype instance Toml.ToValue RepositoryURL
+
+deriving newtype instance Toml.FromValue RepositoryURL
+
+deriving newtype instance Toml.ToValue RepositoryName
+
+deriving newtype instance Toml.FromValue RepositoryName
+
 -- | A solution to an awkward problem: how to delete the TOML
 -- block.  We parse into this type to get the source range of
 -- the first block element.  We can use it to delete the lines