read and write to the revision cache properly

src/App/Fossa/Config/SBOM/Analyze.hs

@@ -12,6 +12,7 @@ module App.Fossa.Config.SBOM.Analyze (
 ) where
 
 import App.Fossa.Config.Common (
+  CacheAction (..),
   CommonOpts (..),
   collectApiOpts,
   collectRevisionOverride,
@@ -55,7 +56,6 @@ instance ToJSON SBOMScanDestination where
 data SBOMAnalyzeConfig = SBOMAnalyzeConfig
   { sbomBaseDir :: BaseDir
   , sbomScanDestination :: SBOMScanDestination
-  , revisionOverride :: OverrideProject
   , sbomPath :: SBOMFile
   , severity :: Severity
   , sbomRebuild :: DependencyRebuild
@@ -118,11 +118,10 @@ mergeOpts cfgfile envvars cliOpts@SBOMAnalyzeOptions{..} = do
             (Nothing)
 
       forceRescans = if fromFlag ForceRescan forceRescan then DependencyRebuildInvalidateCache else DependencyRebuildReuseCache
-  revision <- getProjectRevision fileLoc revOverride
+  revision <- getProjectRevision fileLoc revOverride WriteOnly
   SBOMAnalyzeConfig
     (BaseDir baseDir)
     <$> scanDest
-    <*> pure revOverride
     <*> pure fileLoc
     <*> pure severity
     <*> pure forceRescans

src/App/Fossa/Config/SBOM/Common.hs

@@ -4,17 +4,20 @@ module App.Fossa.Config.SBOM.Common (
   getProjectRevision,
 ) where
 
-import App.Fossa.ProjectInference (InferredProject (..), inferProjectDefaultFromFile)
+import App.Fossa.Config.Common (CacheAction (..))
+import App.Fossa.ProjectInference (InferredProject (..), inferProjectDefaultFromFile, readCachedRevision, saveRevision)
 import App.Types (OverrideProject (..), ProjectRevision (..))
 import Control.Algebra (Has)
-import Control.Carrier.Diagnostics (fromEitherShow)
+import Control.Carrier.Diagnostics (fromEitherShow, (<||>))
 import Control.Effect.Diagnostics (context)
 import Control.Effect.Diagnostics qualified as Diag
 import Control.Effect.Lift (Lift)
+import Control.Monad (when)
 import Data.Aeson (ToJSON (toEncoding), defaultOptions, genericToEncoding)
 import Data.Maybe (fromMaybe)
 import Data.String.Conversion (toString)
 import Data.Text (Text)
+import Effect.ReadFS (ReadFS)
 import GHC.Generics (Generic)
 import Options.Applicative (Parser, argument, metavar, str)
 import Path (parseSomeFile)
@@ -35,17 +38,26 @@ sbomFileArg = SBOMFile <$> argument str (applyFossaStyle <> metavar "SBOM" <> st
 getProjectRevision ::
   ( Has Diag.Diagnostics sig m
   , Has (Lift IO) sig m
+  , Has ReadFS sig m
   ) =>
   SBOMFile ->
   OverrideProject ->
+  CacheAction ->
   m ProjectRevision
-getProjectRevision sbomPath override = do
+getProjectRevision sbomPath override cacheStrategy = do
   let path = unSBOMFile $ sbomPath
   parsedPath <- context "Parsing `sbom` path" $ fromEitherShow $ parseSomeFile (toString path)
   inferred <- case parsedPath of
     Abs f -> inferProjectDefaultFromFile f
     Rel f -> inferProjectDefaultFromFile f
 
+  inferredVersion <- case cacheStrategy of
+    ReadOnly -> do
+      readCachedRevision <||> pure (inferredRevision inferred)
+    WriteOnly -> do
+      pure $ inferredRevision inferred
   let name = fromMaybe (inferredName inferred) $ overrideName override
-  let version = fromMaybe (inferredRevision inferred) $ overrideRevision override
+  let version = fromMaybe inferredVersion $ overrideRevision override
+  let revision = ProjectRevision name version Nothing
+  when (cacheStrategy == WriteOnly) $ saveRevision revision
   pure $ ProjectRevision name version Nothing

src/App/Fossa/Config/SBOM/Test.hs

@@ -14,6 +14,7 @@ module App.Fossa.Config.SBOM.Test (
 ) where
 
 import App.Fossa.Config.Common (
+  CacheAction (..),
   CommonOpts (..),
   collectApiOpts,
   collectRevisionOverride,
@@ -157,7 +158,7 @@ mergeOpts maybeConfig envvars SBOMTestCliOpts{..} = do
             (optProjectRevision testCommons)
             (Nothing)
 
-  revision <- App.Fossa.Config.SBOM.Common.getProjectRevision sbomFile revOverride
+  revision <- App.Fossa.Config.SBOM.Common.getProjectRevision sbomFile revOverride ReadOnly
   testOutputFormat <- validateOutputFormat testOutputFmt
 
   TestConfig