[fix] some minor fixes

cabal.project

@@ -4,3 +4,5 @@ package hsec-core
 package hsec-tools
 package cvss
 package osv
+
+test-show-details: direct

code/hsec-core/hsec-core.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               hsec-core
-version:            0.1.0.0
+version:            0.2.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

@@ -14,20 +14,20 @@ module Security.Advisories.Core.Advisory
   where
 
 import Data.Text (Text)
-import Data.Time (ZonedTime)
+import Data.Time (UTCTime)
 import Distribution.Types.Version (Version)
 import Distribution.Types.VersionRange (VersionRange)
 
 import Text.Pandoc.Definition (Pandoc)
 
-import Security.Advisories.Core.HsecId
+import Security.Advisories.Core.HsecId (HsecId)
 import qualified Security.CVSS as CVSS
 import Security.OSV (Reference)
 
 data Advisory = Advisory
   { advisoryId :: HsecId
-  , advisoryModified :: ZonedTime
-  , advisoryPublished :: ZonedTime
+  , advisoryModified :: UTCTime
+  , advisoryPublished :: UTCTime
   , advisoryCAPECs :: [CAPEC]
   , advisoryCWEs :: [CWE]
   , advisoryKeywords :: [Keyword]

code/hsec-sync/hsec-sync.cabal

@@ -35,7 +35,7 @@ library
     , extra        >=1.7   && <1.8
     , feed         >=1.3   && <1.4
     , filepath     >=1.4   && <1.5
-    , hsec-core    >= 0.1  && < 0.2
+    , hsec-core    ^>= 0.2
     , http-client  >=0.7.0 && <0.8
     , lens         >=5.1   && <5.3
     , process      >=1.6   && <1.7

code/hsec-tools/app/Main.hs

@@ -1,13 +1,13 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Main where
 
 import Control.Monad (forM_, join, void, when)
+import Control.Monad.Trans.Except (runExceptT, ExceptT (ExceptT), withExceptT, throwE)
+import Control.Monad.IO.Class (liftIO)
 import qualified Data.ByteString.Lazy as L
 import Data.Maybe (fromMaybe)
 import Data.Foldable (for_)
-import Data.Functor ((<&>))
 import Data.List (intercalate, isPrefixOf)
 import Distribution.Parsec (eitherParsec)
 import Distribution.Types.VersionRange (VersionRange, anyVersion)
@@ -19,6 +19,7 @@ import Validation (Validation(..))
 import qualified Data.Aeson
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
+import Control.Exception (Exception(displayException))
 import Options.Applicative
 
 import Security.Advisories
@@ -153,24 +154,18 @@ withAdvisory :: (Maybe FilePath -> Advisory -> IO ()) -> Maybe FilePath -> IO ()
 withAdvisory go file = do
   input <- maybe T.getContents T.readFile file
 
-  oob <- ($ emptyOutOfBandAttributes) <$> case file of
-    Nothing -> pure id
-    Just path ->
-      getAdvisoryGitInfo path <&> \case
-        Left _ -> id
-        Right gitInfo -> \oob -> oob
-          { oobPublished = Just (firstAppearanceCommitDate gitInfo)
-          , oobModified = Just (lastModificationCommitDate gitInfo)
-          }
+  oob <- runExceptT $ case file of
+    Nothing -> throwE StdInHasNoOOB
+    Just path -> withExceptT GitHasNoOOB $ do 
+      gitInfo <- ExceptT $ liftIO $ getAdvisoryGitInfo path 
+      pure OutOfBandAttributes
+        { oobPublished = firstAppearanceCommitDate gitInfo
+        , oobModified = lastModificationCommitDate gitInfo
+        }
 
   case parseAdvisory NoOverrides oob input of
     Left e -> do
-      T.hPutStrLn stderr $
-        case e of
-          MarkdownError _ explanation -> "Markdown parsing error:\n" <> explanation
-          MarkdownFormatError explanation -> "Markdown structure error:\n" <> explanation
-          TomlError _ explanation -> "Couldn't parse front matter as TOML:\n" <> explanation
-          AdvisoryError _ explanation -> "Advisory structure error:\n" <> explanation
+      hPutStrLn stderr (displayException e)
       exitFailure
     Right advisory -> do
       go file advisory

code/hsec-tools/hsec-tools.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               hsec-tools
-version:            0.1.0.0
+version:            0.2.0.0
 
 -- A short (one-line) description of the package.
 synopsis:
@@ -50,7 +50,7 @@ library
     , directory             <2
     , extra                 ^>=1.7.5
     , filepath              >=1.4      && <1.5
-    , hsec-core             >= 0.1     && < 0.2
+    , hsec-core             ^>= 0.2
     , feed                  ==1.3.*
     , lucid                 >=2.9.0    && < 3
     , mtl                   >=2.2      && <2.4
@@ -62,7 +62,7 @@ library
     , safe                  >=0.3      && < 0.4
     , text                  >=1.2      && <3
     , time                  >=1.9      && <1.14
-    , toml-parser           ^>=2.0.0.0
+    , toml-parser           ^>=2.0.1.0
     , validation-selective  >=0.1      && <1
 
   hs-source-dirs:   src
@@ -86,10 +86,11 @@ executable hsec-tools
     , bytestring            >=0.10    && <0.13
     , Cabal-syntax          >=3.8.1.0 && <3.11
     , filepath              >=1.4     && <1.5
-    , hsec-core             >= 0.1    && < 0.2
+    , hsec-core             ^>= 0.2
     , hsec-tools
     , optparse-applicative  >=0.17    && <0.19
     , text                  >=1.2     && <3
+    , transformers
     , validation-selective  >=0.1     && <1
 
   hs-source-dirs:   app

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

@@ -6,7 +6,6 @@ module Security.Advisories.Convert.OSV
   where
 
 import qualified Data.Text as T
-import Data.Time (zonedTimeToUTC)
 import Data.Void
 import Distribution.Pretty (prettyShow)
 
@@ -17,9 +16,9 @@ convert :: Advisory -> OSV.Model Void Void Void Void
 convert adv =
   ( OSV.newModel'
     (T.pack . printHsecId $ advisoryId adv)
-    (zonedTimeToUTC $ advisoryModified adv)
+    (advisoryModified adv)
   )
-  { OSV.modelPublished = Just $ zonedTimeToUTC (advisoryPublished adv)
+  { OSV.modelPublished = Just $ advisoryPublished adv
   , OSV.modelAliases = advisoryAliases adv
   , OSV.modelRelated = advisoryRelated adv
   , OSV.modelSummary = Just $ advisorySummary adv

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

@@ -1,5 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
-
 {-|
 
 Helpers for the /security-advisories/ file system.
@@ -25,9 +23,7 @@ module Security.Advisories.Filesystem
   ) where
 
 import Control.Applicative (liftA2)
-import Data.Bifunctor (bimap)
 import Data.Foldable (fold)
-import Data.Functor ((<&>))
 import Data.Semigroup (Max(Max, getMax))
 import Data.Traversable (for)
 
@@ -37,11 +33,13 @@ import qualified Data.Text.IO as T
 import System.FilePath ((</>), takeBaseName)
 import System.Directory (doesDirectoryExist, pathIsSymbolicLink)
 import System.Directory.PathWalk
-import Validation (Validation, eitherToValidation)
+import Validation (Validation (..))
 
-import Security.Advisories (Advisory, AttributeOverridePolicy (NoOverrides), OutOfBandAttributes (..), ParseAdvisoryError, emptyOutOfBandAttributes, parseAdvisory)
+import Security.Advisories (Advisory, AttributeOverridePolicy (NoOverrides), OutOfBandAttributes (..), ParseAdvisoryError, parseAdvisory)
 import Security.Advisories.Core.HsecId (HsecId, parseHsecId, placeholder)
 import Security.Advisories.Git(firstAppearanceCommitDate, getAdvisoryGitInfo, lastModificationCommitDate)
+import Control.Monad.Except (runExceptT, ExceptT (ExceptT), withExceptT)
+import Security.Advisories.Parse (OOBError(GitHasNoOOB))
 
 
 dirNameAdvisories :: FilePath
@@ -128,16 +126,16 @@ listAdvisories root =
     if isSym
       then return $ pure []
       else do
-        oob <-
-          liftIO (getAdvisoryGitInfo advisoryPath) <&> \case
-            Left _ -> emptyOutOfBandAttributes
-            Right gitInfo ->
-              emptyOutOfBandAttributes
-                { oobPublished = Just (firstAppearanceCommitDate gitInfo),
-                  oobModified = Just (lastModificationCommitDate gitInfo)
-                }
+        oob <- runExceptT $ withExceptT GitHasNoOOB $ do
+          gitInfo <- ExceptT $ liftIO $ getAdvisoryGitInfo advisoryPath
+          pure OutOfBandAttributes
+            { oobPublished = firstAppearanceCommitDate gitInfo
+            , oobModified = lastModificationCommitDate gitInfo
+            }
         fileContent <- liftIO $ T.readFile advisoryPath
-        return $ eitherToValidation $ bimap return return $ parseAdvisory NoOverrides oob fileContent
+        pure 
+          $ either (Failure . (: [])) (Success . (: [])) 
+          $ parseAdvisory NoOverrides oob fileContent
 
 -- | Get names (not paths) of subdirectories of the given directory
 -- (one level).  There's no monoidal, interruptible variant of

code/hsec-tools/src/Security/Advisories/Generate/HTML.hs

@@ -16,7 +16,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import qualified Data.Text.Lazy as TL
-import Data.Time (ZonedTime, zonedTimeToUTC)
+import Data.Time (UTCTime)
 import Data.Time.Format.ISO8601
 import System.Directory (createDirectoryIfMissing)
 import System.Exit (exitFailure)
@@ -73,7 +73,7 @@ data AdvisoryR = AdvisoryR
   { advisoryId :: Advisories.HsecId,
     advisorySummary :: Text,
     advisoryAffected :: [AffectedPackageR],
-    advisoryModified :: ZonedTime
+    advisoryModified :: UTCTime
   }
   deriving stock (Show)
 
@@ -233,7 +233,7 @@ feed advisories =
   ( Feed.nullFeed
       atomFeedUrl
       (Feed.TextString "Haskell Security Advisory DB") -- Title
-      (maybe "" (T.pack . iso8601Show) . maximumMay . fmap (zonedTimeToUTC . Advisories.advisoryModified) $ advisories)
+      (maybe "" (T.pack . iso8601Show) . maximumMay . fmap Advisories.advisoryModified $ advisories)
   )
     { Feed.feedEntries = fmap toEntry advisories
     , Feed.feedLinks = [(Feed.nullLink atomFeedUrl) { Feed.linkRel = Just (Left "self") }]

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DerivingStrategies #-}
 
 {-|
 
@@ -18,21 +19,22 @@ module Security.Advisories.Git
 
 import Data.Char (isSpace)
 import Data.List (dropWhileEnd)
-import Data.Time (ZonedTime)
+import Data.Time (UTCTime, zonedTimeToUTC)
 import Data.Time.Format.ISO8601 (iso8601ParseM)
 import System.Exit (ExitCode(ExitSuccess))
 import System.FilePath (splitFileName)
 import System.Process (readProcessWithExitCode)
+import Control.Applicative ((<|>))
 
 data AdvisoryGitInfo = AdvisoryGitInfo
-  { firstAppearanceCommitDate :: ZonedTime
-  , lastModificationCommitDate :: ZonedTime
+  { firstAppearanceCommitDate :: UTCTime
+  , lastModificationCommitDate :: UTCTime
   }
 
 data GitError
   = GitProcessError ExitCode String String -- ^ exit code, stdout and stderr
   | GitTimeParseError String -- ^ unable to parse this input as a datetime
-  deriving (Show)
+  deriving stock (Eq, Ord, Show)
 
 explainGitError :: GitError -> String
 explainGitError = \case
@@ -117,4 +119,7 @@ getAdvisoryGitInfo path = do
       -- the same as `ExitFailure`
       pure . Left $ GitProcessError status stdout stderr
   where
-    parseTime s = maybe (Left $ GitTimeParseError s) Right $ iso8601ParseM s
+    parseTime :: String -> Either GitError UTCTime
+    parseTime s = maybe (Left $ GitTimeParseError s) Right $
+       iso8601ParseM s
+         <|> zonedTimeToUTC <$> iso8601ParseM s