From 8ee2421bf7b307df9ce473e7f90f8ebfdcca59dc Mon Sep 17 00:00:00 2001
From: Fraser Tweedale <frase@frase.id.au>
Date: Tue, 27 Jun 2023 22:31:39 +1000
Subject: [PATCH] tools: implement OSV conversion

Add the `Security.Advisories.Convert.OSV` module, which defines the
conversion from our `Advisory` data type to the OSV `Model`.
Currently, no database-specific or ecosystem-specific fields are
set.  Whether or how to use those fields is a matter for future
discussion.

Add the `osv` subcommand to `hsec-tools`.  It works in the same way
as `check`, but emits the encoded OSV JSON data.

Later commits will add the CI workflows to generate and publish the
OSV data.

Fixes: https://github.com/haskell/security-advisories/issues/3
---
 code/hsec-tools/app/Main.hs                   | 15 +++++
 code/hsec-tools/hsec-tools.cabal              |  3 +
 .../src/Security/Advisories/Convert/OSV.hs    | 60 +++++++++++++++++++
 3 files changed, 78 insertions(+)
 create mode 100644 code/hsec-tools/src/Security/Advisories/Convert/OSV.hs

diff --git a/code/hsec-tools/app/Main.hs b/code/hsec-tools/app/Main.hs
index 128ef253..85d5633d 100644
--- a/code/hsec-tools/app/Main.hs
+++ b/code/hsec-tools/app/Main.hs
@@ -4,6 +4,7 @@
 module Main where
 
 import Control.Monad (join, void, when)
+import qualified Data.ByteString.Lazy as L
 import Data.Foldable (for_)
 import Data.Functor ((<&>))
 import Data.List (isPrefixOf)
@@ -14,7 +15,10 @@ import System.Exit (die, exitFailure, exitSuccess)
 import System.IO (stderr)
 import System.FilePath (takeBaseName)
 
+import qualified Data.Aeson
+
 import Security.Advisories
+import qualified Security.Advisories.Convert.OSV as OSV
 import Security.Advisories.Git
 
 main :: IO ()
@@ -27,6 +31,7 @@ cliOpts = info (commandsParser <**> helper) (fullDesc <> header "Haskell Advisor
     commandsParser =
       subparser
         (  command "check" (info commandCheck mempty)
+        <> command "osv" (info commandOsv mempty)
         <> command "render" (info commandRender mempty)
         <> command "help" (info commandHelp mempty)
         )
@@ -44,6 +49,16 @@ commandCheck =
           die $ "Filename does not match advisory ID: " <> path
       T.putStrLn "no error"
 
+commandOsv :: Parser (IO ())
+commandOsv =
+  withAdvisory go
+  <$> optional (argument str (metavar "FILE"))
+  <**> helper
+  where
+    go _ adv = do
+      L.putStr (Data.Aeson.encode (OSV.convert adv))
+      putChar '\n'
+
 commandRender :: Parser (IO ())
 commandRender =
   withAdvisory (\_ -> T.putStrLn . advisoryHtml)
diff --git a/code/hsec-tools/hsec-tools.cabal b/code/hsec-tools/hsec-tools.cabal
index 7ee29508..11b782db 100644
--- a/code/hsec-tools/hsec-tools.cabal
+++ b/code/hsec-tools/hsec-tools.cabal
@@ -31,6 +31,7 @@ library
                       , Security.Advisories.Definition
                       , Security.Advisories.Git
                       , Security.Advisories.Parse
+                      , Security.Advisories.Convert.OSV
                       , Security.OSV
     build-depends:    base >=4.14 && < 4.19,
                       filepath >= 1.4 && < 1.5,
@@ -66,6 +67,8 @@ executable hsec-tools
     -- other-extensions:
     build-depends:    hsec-tools,
                       base >=4.14 && < 4.19,
+                      aeson >= 2,
+                      bytestring >= 0.10 && < 0.12,
                       text >= 1.2 && < 3,
                       optparse-applicative == 0.17.* || == 0.18.*,
                       filepath >= 1.4 && < 1.5
diff --git a/code/hsec-tools/src/Security/Advisories/Convert/OSV.hs b/code/hsec-tools/src/Security/Advisories/Convert/OSV.hs
new file mode 100644
index 00000000..d35e1ee2
--- /dev/null
+++ b/code/hsec-tools/src/Security/Advisories/Convert/OSV.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Security.Advisories.Convert.OSV
+  ( convert
+  )
+  where
+
+import qualified Data.Text as T
+import Data.Time (zonedTimeToUTC)
+import Data.Void
+
+import Security.Advisories
+import qualified Security.OSV as OSV
+
+convert :: Advisory -> OSV.Model Void Void Void Void
+convert adv =
+  ( OSV.newModel'
+    (advisoryId adv)
+    (zonedTimeToUTC $ advisoryModified adv)
+  )
+  { OSV.modelPublished = Just $ zonedTimeToUTC (advisoryPublished adv)
+  , OSV.modelAliases = advisoryAliases 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 (affectedPackage aff)
+    , OSV.affectedRanges = pure $ mkRange (affectedVersions aff)
+    , OSV.affectedSeverity = mkSeverity (affectedCVSS aff)
+    , OSV.affectedEcosystemSpecific = Nothing
+    , OSV.affectedDatabaseSpecific = Nothing
+    }
+
+mkPackage :: T.Text -> OSV.Package
+mkPackage name = OSV.Package
+  { OSV.packageName = name
+  , OSV.packageEcosystem = "Hackage"
+  , OSV.packagePurl = Nothing
+  }
+
+-- NOTE: This is unpleasant.  But we will eventually switch to a
+-- proper CVSS type and the unpleasantness will go away.
+--
+mkSeverity :: T.Text -> [OSV.Severity]
+mkSeverity s = case T.take 6 s of
+  "CVSS:2" -> [OSV.SeverityCvss2 s]
+  "CVSS:3" -> [OSV.SeverityCvss3 s]
+  _        -> []  -- unexpected; don't include severity
+
+mkRange :: [AffectedVersionRange] -> OSV.Range Void
+mkRange ranges = OSV.RangeEcosystem (foldMap mkEvs ranges) Nothing
+  where
+  mkEvs range =
+    OSV.EventIntroduced (affectedVersionRangeIntroduced range)
+    : maybe [] (pure . OSV.EventFixed) (affectedVersionRangeFixed range)