parse revision in the config

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

@@ -19,15 +19,17 @@ import App.Fossa.Config.Common (
  )
 import App.Fossa.Config.ConfigFile
 import App.Fossa.Config.EnvironmentVars (EnvVars)
-import App.Fossa.Config.SBOM.Common (SBOMFile, sbomFileArg)
+import App.Fossa.Config.SBOM.Common (SBOMFile, getProjectRevision, sbomFileArg)
 import App.Fossa.Subcommand (GetSeverity, getSeverity)
 import App.Types (
   BaseDir (BaseDir),
   DependencyRebuild (..),
   OverrideProject (OverrideProject),
+  ProjectRevision,
  )
 import Control.Applicative (optional)
 import Control.Effect.Diagnostics (Diagnostics, Has)
+import Control.Effect.Lift (Lift)
 import Data.Aeson (ToJSON, defaultOptions, genericToEncoding)
 import Data.Aeson.Types (ToJSON (toEncoding))
 import Data.Flag (Flag, flagOpt, fromFlag)
@@ -58,6 +60,7 @@ data SBOMAnalyzeConfig = SBOMAnalyzeConfig
   , severity :: Severity
   , sbomRebuild :: DependencyRebuild
   , sbomTeam :: Maybe Text
+  , sbomRevision :: ProjectRevision
   }
   deriving (Eq, Ord, Show, Generic)
 
@@ -95,6 +98,7 @@ cliParser =
 mergeOpts ::
   ( Has Diagnostics sig m
   , Has ReadFS sig m
+  , Has (Lift IO) sig m
   ) =>
   Maybe ConfigFile ->
   EnvVars ->
@@ -114,6 +118,7 @@ mergeOpts cfgfile envvars cliOpts@SBOMAnalyzeOptions{..} = do
             (Nothing)
 
       forceRescans = if fromFlag ForceRescan forceRescan then DependencyRebuildInvalidateCache else DependencyRebuildReuseCache
+  revision <- getProjectRevision fileLoc revOverride
   SBOMAnalyzeConfig
     (BaseDir baseDir)
     <$> scanDest
@@ -122,6 +127,7 @@ mergeOpts cfgfile envvars cliOpts@SBOMAnalyzeOptions{..} = do
     <*> pure severity
     <*> pure forceRescans
     <*> pure team
+    <*> pure revision
 
 collectScanDestination ::
   (Has Diagnostics sig m) =>

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

@@ -1,12 +1,24 @@
 module App.Fossa.Config.SBOM.Common (
   SBOMFile (..),
   sbomFileArg,
+  getProjectRevision,
 ) where
 
+import App.Fossa.ProjectInference (InferredProject (..), inferProjectDefaultFromFile)
+import App.Types (OverrideProject (..), ProjectRevision (..))
+import Control.Algebra (Has)
+import Control.Carrier.Diagnostics (fromEitherShow)
+import Control.Effect.Diagnostics (context)
+import Control.Effect.Diagnostics qualified as Diag
+import Control.Effect.Lift (Lift)
 import Data.Aeson (ToJSON (toEncoding), defaultOptions, genericToEncoding)
+import Data.Maybe (fromMaybe)
+import Data.String.Conversion (toString)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Options.Applicative (Parser, argument, metavar, str)
+import Path (parseSomeFile)
+import Path.Posix (SomeBase (..))
 import Style (applyFossaStyle, stringToHelpDoc)
 
 newtype SBOMFile = SBOMFile
@@ -19,3 +31,21 @@ instance ToJSON SBOMFile where
 
 sbomFileArg :: Parser SBOMFile
 sbomFileArg = SBOMFile <$> argument str (applyFossaStyle <> metavar "SBOM" <> stringToHelpDoc "Path to the SBOM file to scan")
+
+getProjectRevision ::
+  ( Has Diag.Diagnostics sig m
+  , Has (Lift IO) sig m
+  ) =>
+  SBOMFile ->
+  OverrideProject ->
+  m ProjectRevision
+getProjectRevision sbomPath override = 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
+
+  let name = fromMaybe (inferredName inferred) $ overrideName override
+  let version = fromMaybe (inferredRevision inferred) $ overrideRevision override
+  pure $ ProjectRevision name version Nothing

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

@@ -22,24 +22,20 @@ import App.Fossa.Config.Common (
  )
 import App.Fossa.Config.ConfigFile (ConfigFile)
 import App.Fossa.Config.EnvironmentVars (EnvVars)
-import App.Fossa.Config.SBOM.Common (SBOMFile (unSBOMFile), sbomFileArg)
+import App.Fossa.Config.SBOM.Common (SBOMFile, getProjectRevision, sbomFileArg)
 import App.Fossa.Config.Test (DiffRevision (DiffRevision), TestConfig (TestConfig), TestOutputFormat (..))
-import App.Fossa.ProjectInference (InferredProject (inferredName, inferredRevision), inferProjectDefaultFromFile)
 import App.Fossa.Subcommand (GetCommonOpts (getCommonOpts), GetSeverity (getSeverity))
-import App.Types (BaseDir (BaseDir), IssueLocatorType (..), OverrideProject (..), ProjectRevision (..))
-import Control.Carrier.Diagnostics (context)
+import App.Types (BaseDir (BaseDir), IssueLocatorType (..), OverrideProject (..))
 import Control.Carrier.Diagnostics qualified as Diag
 import Control.Effect.Diagnostics (
   Diagnostics,
   Has,
   ToDiagnostic,
-  fromEitherShow,
  )
 import Control.Effect.Lift (Lift)
 import Control.Timeout (Duration (..))
 import Data.List (intercalate)
-import Data.Maybe (fromMaybe)
-import Data.String.Conversion (ToString (toString), toText)
+import Data.String.Conversion (toText)
 import Data.Text (Text)
 import Diag.Diagnostic (ToDiagnostic (renderDiagnostic))
 import Effect.Logger (Severity (SevDebug, SevInfo), vsep)
@@ -56,8 +52,6 @@ import Options.Applicative (
   strOption,
  )
 import Options.Applicative.Builder (CommandFields, Mod, command, info)
-import Path (SomeBase (..))
-import Path.Posix (parseSomeFile)
 import Prettyprinter (Doc, punctuate, viaShow)
 import Prettyprinter.Render.Terminal (AnsiStyle, Color (Green))
 import Style (applyFossaStyle, boldItalicized, coloredBoldItalicized, formatDoc, formatStringToDoc, stringToHelpDoc, styledDivider)
@@ -106,7 +100,7 @@ data SBOMTestCliOpts = SBOMTestCliOpts
   , testTimeout :: Maybe Int
   , testOutputFmt :: Maybe String
   , testDiffRevision :: Maybe Text
-  , sbomFile :: SBOMFile
+  , sbomFile :: App.Fossa.Config.SBOM.Common.SBOMFile
   }
   deriving (Eq, Ord, Show)
 
@@ -131,7 +125,7 @@ parser =
     <*> optional (option auto (applyFossaStyle <> long "timeout" <> helpDoc timeoutHelp))
     <*> optional (strOption (applyFossaStyle <> long "format" <> helpDoc testFormatHelp))
     <*> optional (strOption (applyFossaStyle <> long "diff" <> stringToHelpDoc "Checks for new issues of the revision that does not exist in provided diff revision"))
-    <*> sbomFileArg
+    <*> App.Fossa.Config.SBOM.Common.sbomFileArg
   where
     timeoutHelp :: Maybe (Doc AnsiStyle)
     timeoutHelp =
@@ -163,15 +157,7 @@ mergeOpts maybeConfig envvars SBOMTestCliOpts{..} = do
             (optProjectRevision testCommons)
             (Nothing)
 
-  let path = unSBOMFile sbomFile
-  parsedPath <- context "Parsing `sbom` path" $ fromEitherShow $ parseSomeFile (toString path)
-  inferred <- case parsedPath of
-    Abs f -> inferProjectDefaultFromFile f
-    Rel f -> inferProjectDefaultFromFile f
-
-  let depVersion = fromMaybe (inferredRevision inferred) (overrideRevision revOverride)
-  let vendoredName = fromMaybe (inferredName inferred) (overrideName revOverride)
-  let revision = ProjectRevision vendoredName depVersion Nothing
+  revision <- App.Fossa.Config.SBOM.Common.getProjectRevision sbomFile revOverride
   testOutputFormat <- validateOutputFormat testOutputFmt
 
   TestConfig

src/App/Fossa/SBOM/Analyze.hs

@@ -6,24 +6,18 @@ import App.Fossa.API.BuildLink (getFossaBuildUrl)
 import App.Fossa.Config.SBOM
 import App.Fossa.Config.SBOM.Analyze (SBOMScanDestination (..))
 import App.Fossa.PreflightChecks (PreflightCommandChecks (..), preflightChecks)
-import App.Fossa.ProjectInference (InferredProject (..), inferProjectDefaultFromFile)
-import App.Types (ComponentUploadFileType (..), OverrideProject (..), ProjectMetadata (..), ProjectRevision (..))
+import App.Types (ComponentUploadFileType (..), ProjectMetadata (..), ProjectRevision (..))
 import Control.Carrier.Debug (Debug)
-import Control.Carrier.Diagnostics (fromEitherShow)
 import Control.Carrier.Diagnostics qualified as Diag
 import Control.Carrier.FossaApiClient (runFossaApiClient)
 import Control.Carrier.StickyLogger (StickyLogger, logSticky, runStickyLogger)
-import Control.Effect.Diagnostics (context)
 import Control.Effect.FossaApiClient (FossaApiClient, PackageRevision (PackageRevision), getOrganization, getSignedUploadUrl, queueSBOMBuild, uploadArchive)
 import Control.Effect.Lift
 import Data.Foldable (traverse_)
-import Data.Maybe (fromMaybe)
 import Data.String.Conversion
 import Data.Text (Text)
 import Effect.Logger (Logger, logDebug, logInfo)
 import Fossa.API.Types
-import Path (parseSomeFile)
-import Path.Posix (SomeBase (..))
 import Prettyprinter (Pretty (pretty))
 import Srclib.Types (Locator (..))
 
@@ -33,9 +27,9 @@ uploadSBOM ::
   , Has Logger sig m
   ) =>
   SBOMAnalyzeConfig ->
-  ProjectRevision ->
   m ()
-uploadSBOM conf revision = do
+uploadSBOM conf = do
+  let revision = sbomRevision conf
   signedURL <- getSignedUploadUrl SBOMUpload $ PackageRevision (projectName revision) (projectRevision revision)
   let path = unSBOMFile $ sbomPath conf
 
@@ -45,23 +39,6 @@ uploadSBOM conf revision = do
 
   pure ()
 
-getProjectRevision ::
-  ( Has Diag.Diagnostics sig m
-  , Has (Lift IO) sig m
-  ) =>
-  SBOMAnalyzeConfig ->
-  m ProjectRevision
-getProjectRevision conf = do
-  let path = unSBOMFile $ sbomPath conf
-  parsedPath <- context "Parsing `sbom` path" $ fromEitherShow $ parseSomeFile (toString path)
-  inferred <- case parsedPath of
-    Abs f -> inferProjectDefaultFromFile f
-    Rel f -> inferProjectDefaultFromFile f
-
-  let name = fromMaybe (inferredName inferred) $ overrideName (revisionOverride conf)
-  let version = fromMaybe (inferredRevision inferred) $ overrideRevision (revisionOverride conf)
-  pure $ ProjectRevision name version Nothing
-
 -- analyze receives a path to an SBOM file, a root path, and API settings.
 -- Using this information, it uploads the SBOM and queues a build for it.
 analyze ::
@@ -74,27 +51,24 @@ analyze ::
   m ()
 analyze config = do
   let emptyMetadata = ProjectMetadata Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing
-  revision <- getProjectRevision config
   _ <- case sbomScanDestination config of
     SBOMOutputStdout -> pure ()
-    SBOMUploadScan apiOpts -> runFossaApiClient apiOpts $ preflightChecks $ AnalyzeChecks revision emptyMetadata
+    SBOMUploadScan apiOpts -> runFossaApiClient apiOpts $ preflightChecks $ AnalyzeChecks (sbomRevision config) emptyMetadata
   case sbomScanDestination config of
     SBOMOutputStdout -> pure ()
-    SBOMUploadScan apiOpts -> (runFossaApiClient apiOpts) . runStickyLogger (severity config) $ analyzeInternal config revision
-
+    SBOMUploadScan apiOpts -> (runFossaApiClient apiOpts) . runStickyLogger (severity config) $ analyzeInternal config
 analyzeInternal ::
   ( Has Diag.Diagnostics sig m
   , Has StickyLogger sig m
   , Has Logger sig m
   , Has FossaApiClient sig m
   ) =>
   SBOMAnalyzeConfig ->
-  ProjectRevision ->
   m ()
-analyzeInternal config revision = do
+analyzeInternal config = do
   -- First, upload the SBOM to S3
-  _ <- uploadSBOM config revision
-
+  let revision = sbomRevision config
+  _ <- uploadSBOM config
   -- Second, trigger a build
   let archive = Archive (projectName revision) (projectRevision revision)
   _ <- queueSBOMBuild archive (sbomTeam config) (sbomRebuild config)