tools: add reserve command

Add the `hsec-tools reserve` command, which reserves an HSEC ID.

The `--id-mode` option specifies whether to use a placeholder ID, or
allocate the next available ID.  This option is currently required,
but we might change this in the future as we enhance our tooling and
PR automation.

The command operates in the context of the current working
directory.  That is, determines that it is running within an
hsec-tools Git clone, and then creates the file in the appropriate
place.  The user can override the repo location via an optional
positional argument.

Also create the directory in the repo (via the `.gitkeep` idiom).

Author: frasertweedale

advisories/reserved/.gitkeep

@@ -0,0 +1,54 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Command.Reserve where
+
+import Control.Monad (unless)
+import Data.Maybe (fromMaybe)
+import System.Exit (die)
+import System.FilePath ((</>), (<.>))
+
+import Security.Advisories.Git (getRepoRoot)
+import Security.Advisories.HsecId
+  ( placeholder
+  , printHsecId
+  , getNextHsecId
+  )
+import Security.Advisories.Filesystem
+  ( dirNameAdvisories
+  , dirNameReserved
+  , isSecurityAdvisoriesRepo
+  , getGreatestId
+  )
+
+-- | How to choose IDs when creating advisories or
+-- reservations.
+data IdMode
+  = IdModePlaceholder
+  -- ^ Create a placeholder ID (e.g. HSEC-0000-0000).  Real IDs
+  -- will be assigned later.
+  | IdModeAuto
+  -- ^ Use the next available ID.  This option is more likely to
+  -- result in conflicts when submitting advisories or reservations.
+
+runReserveCommand :: Maybe FilePath -> IdMode -> IO ()
+runReserveCommand mPath idMode = do
+  let
+    path = fromMaybe "." mPath
+  repoPath <- getRepoRoot path >>= \case
+    Left _ -> die "Not a git repo"
+    Right a -> pure a
+  isRepo <- isSecurityAdvisoriesRepo repoPath
+  unless isRepo $
+    die "Not a security-advisories repo"
+
+  hsid <- case idMode of
+    IdModePlaceholder -> pure placeholder
+    IdModeAuto -> do
+      curMax <- getGreatestId repoPath
+      getNextHsecId curMax
+
+  let
+    advisoriesPath = repoPath </> dirNameAdvisories
+    fileName = printHsecId hsid <.> "md"
+    filePath = advisoriesPath </> dirNameReserved </> fileName
+  writeFile filePath ""  -- write empty file

code/hsec-tools/app/Command/Reserve.hs

@@ -7,7 +7,7 @@ import Control.Monad (join, void, when)
 import qualified Data.ByteString.Lazy as L
 import Data.Foldable (for_)
 import Data.Functor ((<&>))
-import Data.List (isPrefixOf)
+import Data.List (intercalate, isPrefixOf)
 import qualified Data.Text.IO as T
 import Options.Applicative
 import System.Exit (die, exitFailure, exitSuccess)
@@ -21,6 +21,8 @@ import qualified Security.Advisories.Convert.OSV as OSV
 import Security.Advisories.Git
 import Security.Advisories.Generate.HTML
 
+import qualified Command.Reserve
+
 main :: IO ()
 main = join $ execParser cliOpts
 
@@ -31,12 +33,32 @@ cliOpts = info (commandsParser <**> helper) (fullDesc <> header "Haskell Advisor
     commandsParser =
       subparser
         (  command "check" (info commandCheck (progDesc "Syntax check a single advisory"))
+        <> command "reserve" (info commandReserve (progDesc "Reserve an HSEC ID"))
         <> command "osv" (info commandOsv (progDesc "Convert a single advisory to OSV"))
         <> command "render" (info commandRender (progDesc "Render a single advisory as HTML"))
         <> command "generate-index" (info commandGenerateIndex (progDesc "Generate an HTML index"))
         <> command "help" (info commandHelp (progDesc "Show command help"))
         )
 
+-- | Create an option with a fixed set of values
+multiOption :: [(String, a)] -> Mod OptionFields a -> Parser a
+multiOption kvs m = option rdr (m <> metavar choices)
+  where
+  choices = "{" <> intercalate "|" (fmap fst kvs) <> "}"
+  errMsg = "must be one of " <> choices
+  rdr = eitherReader (maybe (Left errMsg) Right . flip lookup kvs)
+
+commandReserve :: Parser (IO ())
+commandReserve =
+  Command.Reserve.runReserveCommand
+  <$> optional (argument str (metavar "REPO"))
+  <*> multiOption
+        [ ("placeholder", Command.Reserve.IdModePlaceholder)
+        , ("auto",        Command.Reserve.IdModeAuto)
+        ]
+        ( long "id-mode" <> help "How to assign IDs" )
+  <**> helper
+
 commandCheck :: Parser (IO ())
 commandCheck =
   withAdvisory go

code/hsec-tools/app/Main.hs

@@ -68,6 +68,8 @@ library
 
 executable hsec-tools
     main-is:          Main.hs
+    other-modules:
+      Command.Reserve
 
     -- Modules included in this executable, other than Main.
     -- other-modules: