lib/advisories: add function to get Git repo root

We want to expand the capabilities of `hsec-tools` so that the tool
can be used to:

- reserve advisories
- prepare new advisory templates
- assign IDs to placeholder IDs (e.g. in CI)
- "fsck" the database

For tolerable(?) user experience, it should be possible to run the
tool anywhere within the *security-advisories* repository, or point
it to (somewhere within) the repository.  To help with this, add:

```haskell
getRepoRoot :: FilePath -> IO (Either GitError FilePath)
```

CLI commands can apply this function to the current working
directory, or a user-specified argument, to find the root of the
repository.

Author: frasertweedale

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

@@ -7,9 +7,12 @@ module Security.Advisories.Git
   ( AdvisoryGitInfo(..)
   , GitError(..)
   , getAdvisoryGitInfo
+  , getRepoRoot
   )
   where
 
+import Data.Char (isSpace)
+import Data.List (dropWhileEnd)
 import Data.Time (ZonedTime)
 import Data.Time.Format.ISO8601 (iso8601ParseM)
 import System.Exit (ExitCode(ExitSuccess))
@@ -26,6 +29,23 @@ data GitError
   | GitTimeParseError String -- ^ unable to parse this input as a datetime
   deriving (Show)
 
+-- | Get top-level directory of the working tree.
+--
+getRepoRoot :: FilePath -> IO (Either GitError FilePath)
+getRepoRoot path = do
+  (status, stdout, stderr) <- readProcessWithExitCode
+    "git"
+    [ "-C", path
+    , "rev-parse"
+    , "--show-toplevel"
+    ]
+    "" -- standard input
+  pure $ case status of
+    ExitSuccess -> Right $ trim stdout
+    _ -> Left $ GitProcessError status stdout stderr
+  where
+    trim = dropWhileEnd isSpace . dropWhile isSpace
+
 getAdvisoryGitInfo :: FilePath -> IO (Either GitError AdvisoryGitInfo)
 getAdvisoryGitInfo path = do
   let (dir, file) = splitFileName path