IAT: Register and resolve revision assertions (#333)

Changelog.md

@@ -5,6 +5,8 @@
 - Adds a new hidden subcommand `experimental-vsi-register-binary-custom-dependency`. ([#323](https://github.com/fossas/spectrometer/pull/323))
   This subcommand is intended to be used with direct support from FOSSA engineering when working with specific projects.
 - Support identifying previously registered binary custom dependencies when running analysis in VSI mode. ([#328](https://github.com/fossas/spectrometer/pull/328))
+- Support asserting fingerprints for binaries produced by a project being analyzed ([#333](https://github.com/fossas/spectrometer/pull/333))
+- Support resolving asserted top-level projects as a dependencies of downstream projects ([#333](https://github.com/fossas/spectrometer/pull/333))
 
 ## v2.14.5
 

spectrometer.cabal

@@ -161,6 +161,7 @@ library
     App.Fossa.VPS.Scan.ScotlandYard
     App.Fossa.VPS.Test
     App.Fossa.VPS.Types
+    App.Fossa.VSI.IAT.AssertRevisionBinaries
     App.Fossa.VSI.IAT.AssertUserDefinedBinaries
     App.Fossa.VSI.IAT.Fingerprint
     App.Fossa.VSI.IAT.Resolve

src/App/Fossa/Analyze.hs

@@ -6,6 +6,7 @@ module App.Fossa.Analyze (
   UnpackArchives (..),
   JsonOutput (..),
   VSIAnalysisMode (..),
+  IATAssertionMode (..),
   discoverFuncs,
   RecordMode (..),
 ) where
@@ -17,6 +18,7 @@ import App.Fossa.Analyze.Record (AnalyzeEffects (..), AnalyzeJournal (..), loadR
 import App.Fossa.FossaAPIV1 (UploadResponse (..), uploadAnalysis, uploadContributors)
 import App.Fossa.ManualDeps (analyzeFossaDepsFile)
 import App.Fossa.ProjectInference (inferProjectDefault, inferProjectFromVCS, mergeOverride, saveRevision)
+import App.Fossa.VSI.IAT.AssertRevisionBinaries (assertRevisionBinaries)
 import App.Fossa.VSIDeps (analyzeVSIDeps)
 import App.Types (
   BaseDir (..),
@@ -61,7 +63,7 @@ import Path (Abs, Dir, Path, fromAbsDir, toFilePath)
 import Path.IO (makeRelative)
 import Path.IO qualified as P
 import Srclib.Converter qualified as Srclib
-import Srclib.Types (SourceUnit, parseLocator)
+import Srclib.Types (Locator, SourceUnit, parseLocator)
 import Strategy.Bundler qualified as Bundler
 import Strategy.Cargo qualified as Cargo
 import Strategy.Carthage qualified as Carthage
@@ -122,6 +124,13 @@ data VSIAnalysisMode
   | -- | disable the VSI analysis strategy
     VSIAnalysisDisabled
 
+-- | "IAT Assertion" modes
+data IATAssertionMode
+  = -- | assertion enabled, reading binaries from this directory
+    IATAssertionEnabled (Path Abs Dir)
+  | -- | assertion not enabled
+    IATAssertionDisabled
+
 -- | "Replay logging" modes
 data RecordMode
   = -- | record effect invocations
@@ -131,8 +140,8 @@ data RecordMode
   | -- | don't record or replay
     RecordModeNone
 
-analyzeMain :: FilePath -> RecordMode -> Severity -> ScanDestination -> OverrideProject -> Flag UnpackArchives -> Flag JsonOutput -> VSIAnalysisMode -> AllFilters -> IO ()
-analyzeMain workdir recordMode logSeverity destination project unpackArchives jsonOutput enableVSI filters =
+analyzeMain :: FilePath -> RecordMode -> Severity -> ScanDestination -> OverrideProject -> Flag UnpackArchives -> Flag JsonOutput -> VSIAnalysisMode -> IATAssertionMode -> AllFilters -> IO ()
+analyzeMain workdir recordMode logSeverity destination project unpackArchives jsonOutput enableVSI assertionMode filters =
   withDefaultLogger logSeverity
     . Diag.logWithExit_
     . runReadFSIO
@@ -159,7 +168,7 @@ analyzeMain workdir recordMode logSeverity destination project unpackArchives js
               . runReplay @Exec (effectsExec effects)
               $ doAnalyze basedir
   where
-    doAnalyze basedir = analyze basedir destination project unpackArchives jsonOutput enableVSI filters
+    doAnalyze basedir = analyze basedir destination project unpackArchives jsonOutput enableVSI assertionMode filters
 
 discoverFuncs :: (TaskEffs sig m, TaskEffs rsig run) => [Path Abs Dir -> m [DiscoveredProject run]]
 discoverFuncs =
@@ -234,9 +243,10 @@ analyze ::
   Flag UnpackArchives ->
   Flag JsonOutput ->
   VSIAnalysisMode ->
+  IATAssertionMode ->
   AllFilters ->
   m ()
-analyze (BaseDir basedir) destination override unpackArchives jsonOutput enableVSI filters = do
+analyze (BaseDir basedir) destination override unpackArchives jsonOutput enableVSI iatAssertion filters = do
   capabilities <- sendIO getNumCapabilities
 
   let apiOpts = case destination of
@@ -262,7 +272,9 @@ analyze (BaseDir basedir) destination override unpackArchives jsonOutput enableV
     FilteredAll count -> Diag.fatal (ErrFilteredAllProjects count projectResults)
     FoundSome sourceUnits -> case destination of
       OutputStdout -> logStdout . decodeUtf8 . Aeson.encode $ buildResult manualSrcUnits filteredProjects
-      UploadScan opts metadata -> uploadSuccessfulAnalysis (BaseDir basedir) opts metadata jsonOutput override sourceUnits
+      UploadScan opts metadata -> do
+        locator <- uploadSuccessfulAnalysis (BaseDir basedir) opts metadata jsonOutput override sourceUnits
+        doAssertRevisionBinaries iatAssertion opts locator
 
 analyzeVSI :: (MonadIO m, Has Diag.Diagnostics sig m, Has Exec sig m, Has (Lift IO) sig m, Has Logger sig m) => VSIAnalysisMode -> Maybe ApiOpts -> Path Abs Dir -> AllFilters -> m (Maybe SourceUnit)
 analyzeVSI VSIAnalysisEnabled (Just apiOpts) dir filters = do
@@ -271,6 +283,10 @@ analyzeVSI VSIAnalysisEnabled (Just apiOpts) dir filters = do
   pure $ Just results
 analyzeVSI _ _ _ _ = pure Nothing
 
+doAssertRevisionBinaries :: (Has Diag.Diagnostics sig m, Has ReadFS sig m, Has (Lift IO) sig m, Has Logger sig m) => IATAssertionMode -> ApiOpts -> Locator -> m ()
+doAssertRevisionBinaries (IATAssertionEnabled dir) apiOpts locator = assertRevisionBinaries dir apiOpts locator
+doAssertRevisionBinaries _ _ _ = pure ()
+
 data AnalyzeError
   = ErrNoProjectsDiscovered
   | ErrFilteredAllProjects Int [ProjectResult]
@@ -301,7 +317,7 @@ uploadSuccessfulAnalysis ::
   Flag JsonOutput ->
   OverrideProject ->
   NE.NonEmpty SourceUnit ->
-  m ()
+  m Locator
 uploadSuccessfulAnalysis (BaseDir basedir) apiOpts metadata jsonOutput override units = do
   revision <- mergeOverride override <$> (inferProjectFromVCS basedir <||> inferProjectDefault basedir)
   saveRevision revision
@@ -313,7 +329,8 @@ uploadSuccessfulAnalysis (BaseDir basedir) apiOpts metadata jsonOutput override
   logInfo ("Using branch: `" <> pretty branchText <> "`")
 
   uploadResult <- uploadAnalysis apiOpts revision metadata units
-  buildUrl <- getFossaBuildUrl revision apiOpts . parseLocator $ uploadLocator uploadResult
+  let locator = parseLocator $ uploadLocator uploadResult
+  buildUrl <- getFossaBuildUrl revision apiOpts locator
   logInfo $
     vsep
       [ "============================================================"
@@ -331,6 +348,8 @@ uploadSuccessfulAnalysis (BaseDir basedir) apiOpts metadata jsonOutput override
     then logStdout . decodeUtf8 . Aeson.encode $ buildProjectSummary revision (uploadLocator uploadResult) buildUrl
     else pure ()
 
+  pure locator
+
 data CountedResult
   = NoneDiscovered
   | FilteredAll Int

src/App/Fossa/FossaAPIV1.hs

@@ -25,13 +25,16 @@ module App.Fossa.FossaAPIV1 (
   archiveUpload,
   archiveBuildUpload,
   assertUserDefinedBinaries,
+  assertRevisionBinaries,
   resolveUserDefinedBinary,
+  resolveProjectDependencies,
 ) where
 
 import App.Fossa.Container (ContainerScan (..))
 import App.Fossa.Report.Attribution qualified as Attr
 import App.Fossa.VSI.IAT.Types
 import App.Fossa.VSI.IAT.Types qualified as IAT
+import App.Fossa.VSI.Types qualified as VSI
 import App.Types
 import App.Version (versionNumber)
 import Control.Carrier.Empty.Maybe (Empty, EmptyC, runEmpty)
@@ -502,10 +505,39 @@ assertUserDefinedBinaries apiOpts UserDefinedAssertionMeta{..} fingerprints = fo
   _ <- req POST (assertUserDefinedBinariesEndpoint baseUrl) (ReqBodyJson body) ignoreResponse baseOpts
   pure ()
 
+assertRevisionBinariesEndpoint :: Url scheme -> Locator -> Url scheme
+assertRevisionBinariesEndpoint baseurl locator = baseurl /: "api" /: "iat" /: "binary" /: renderLocator locator
+
+assertRevisionBinaries :: (Has (Lift IO) sig m, Has Diagnostics sig m) => ApiOpts -> Locator -> [Fingerprint] -> m ()
+assertRevisionBinaries apiOpts locator fingerprints = fossaReq $ do
+  (baseUrl, baseOpts) <- useApiOpts apiOpts
+  let body = FingerprintSet <$> fingerprints
+  _ <- req POST (assertRevisionBinariesEndpoint baseUrl locator) (ReqBodyJson body) ignoreResponse baseOpts
+  pure ()
+
 resolveUserDefinedBinaryEndpoint :: Url scheme -> IAT.UserDep -> Url scheme
 resolveUserDefinedBinaryEndpoint baseurl dep = baseurl /: "api" /: "iat" /: "resolve" /: "user-defined" /: IAT.renderUserDep dep
 
 resolveUserDefinedBinary :: (Has (Lift IO) sig m, Has Diagnostics sig m) => ApiOpts -> IAT.UserDep -> m UserDefinedAssertionMeta
 resolveUserDefinedBinary apiOpts dep = fossaReq $ do
   (baseUrl, baseOpts) <- useApiOpts apiOpts
   responseBody <$> req GET (resolveUserDefinedBinaryEndpoint baseUrl dep) NoReqBody jsonResponse baseOpts
+
+-- | The revision dependencies endpoint contains a lot of information we don't need. This intermediate type allows us to throw it away.
+newtype ResolvedDependency = ResolvedDependency {unwrapResolvedDependency :: VSI.Locator}
+
+instance FromJSON ResolvedDependency where
+  parseJSON = withObject "ResolvedProjectDependencies" $ \obj -> do
+    ResolvedDependency <$> obj .: "loc"
+
+resolveProjectDependenciesEndpoint :: Url scheme -> VSI.Locator -> Url scheme
+resolveProjectDependenciesEndpoint baseurl locator = baseurl /: "api" /: "revisions" /: VSI.renderLocator locator /: "dependencies"
+
+resolveProjectDependencies :: (Has (Lift IO) sig m, Has Diagnostics sig m) => ApiOpts -> VSI.Locator -> m [VSI.Locator]
+resolveProjectDependencies apiOpts locator = fossaReq $ do
+  (baseUrl, baseOpts) <- useApiOpts apiOpts
+
+  let opts = baseOpts <> "include_ignored" =: False
+  (dependencies :: [ResolvedDependency]) <- responseBody <$> req GET (resolveProjectDependenciesEndpoint baseUrl locator) NoReqBody jsonResponse opts
+
+  pure $ map unwrapResolvedDependency dependencies

src/App/Fossa/Main.hs

@@ -4,7 +4,7 @@ module App.Fossa.Main (
   appMain,
 ) where
 
-import App.Fossa.Analyze (JsonOutput (..), RecordMode (..), ScanDestination (..), UnpackArchives (..), VSIAnalysisMode (..), analyzeMain)
+import App.Fossa.Analyze (IATAssertionMode (..), JsonOutput (..), RecordMode (..), ScanDestination (..), UnpackArchives (..), VSIAnalysisMode (..), analyzeMain)
 import App.Fossa.Compatibility (Argument, argumentParser, compatibilityMain)
 import App.Fossa.Configuration (
   ConfigFile (
@@ -183,9 +183,15 @@ appMain = do
         then pure ()
         else withDefaultLogger logSeverity $ logWarn "The --filter option has been deprecated. Refer to the new target exclusion feature for upgrading. --filter will be removed by v2.20.0"
 
+      assertionMode <- case analyzeAssertMode of
+        AnalyzeVSIAssertionDisabled -> pure IATAssertionDisabled
+        AnalyzeVSIAssertionEnabled p -> do
+          dir <- validateDir p
+          pure $ IATAssertionEnabled (unBaseDir dir)
+
       let analyzeOverride = override{overrideBranch = analyzeBranch <|> ((fileConfig >>= configRevision) >>= configBranch)}
           combinedFilters = normalizedFilters fileConfig analyzeOptions
-          doAnalyze destination = analyzeMain analyzeBaseDir analyzeRecordMode logSeverity destination analyzeOverride analyzeUnpackArchives analyzeJsonOutput analyzeVSIMode combinedFilters
+          doAnalyze destination = analyzeMain analyzeBaseDir analyzeRecordMode logSeverity destination analyzeOverride analyzeUnpackArchives analyzeJsonOutput analyzeVSIMode assertionMode combinedFilters
 
       if analyzeOutput
         then doAnalyze OutputStdout
@@ -408,6 +414,7 @@ analyzeOpts =
     <*> many (option (eitherReader pathOpt) (long "only-path" <> help "Only scan these paths. See paths.only in the fossa.yml spec." <> metavar "PATH"))
     <*> many (option (eitherReader pathOpt) (long "exclude-path" <> help "Exclude these paths from scanning. See paths.exclude in the fossa.yml spec." <> metavar "PATH"))
     <*> vsiAnalyzeOpt
+    <*> iatAssertionOpt
     <*> monorepoOpts
     <*> analyzeReplayOpt
     <*> baseDirArg
@@ -417,6 +424,11 @@ vsiAnalyzeOpt =
   flag' VSIAnalysisEnabled (long "enable-vsi" <> hidden)
     <|> pure VSIAnalysisDisabled
 
+iatAssertionOpt :: Parser AnalyzeVSIAssertionMode
+iatAssertionOpt =
+  (AnalyzeVSIAssertionEnabled <$> strOption (long "experimental-vsi-generated-binary-dir" <> hidden))
+    <|> pure AnalyzeVSIAssertionDisabled
+
 analyzeReplayOpt :: Parser RecordMode
 analyzeReplayOpt =
   flag' RecordModeRecord (long "record" <> hidden)
@@ -691,11 +703,21 @@ data AnalyzeOptions = AnalyzeOptions
   , analyzeOnlyPaths :: [Path Rel Dir]
   , analyzeExcludePaths :: [Path Rel Dir]
   , analyzeVSIMode :: VSIAnalysisMode
+  , analyzeAssertMode :: AnalyzeVSIAssertionMode
   , monorepoAnalysisOpts :: MonorepoAnalysisOpts
   , analyzeRecordMode :: RecordMode
   , analyzeBaseDir :: FilePath
   }
 
+-- | "IAT Assertion" modes
+-- This type translates to IATAssertionMode, but exists so that the flag parser can work with FilePath
+-- until the FilePath can be converted to a Path Abs Dir in appMain.
+data AnalyzeVSIAssertionMode
+  = -- | assertion enabled, reading binaries from this directory
+    AnalyzeVSIAssertionEnabled FilePath
+  | -- | assertion not enabled
+    AnalyzeVSIAssertionDisabled
+
 data TestOptions = TestOptions
   { testTimeout :: Int
   , testOutputType :: Test.TestOutputType

src/App/Fossa/VSI/IAT/AssertRevisionBinaries.hs

@@ -0,0 +1,24 @@
+module App.Fossa.VSI.IAT.AssertRevisionBinaries (
+  assertRevisionBinaries,
+) where
+
+import App.Fossa.FossaAPIV1 qualified as Fossa
+import App.Fossa.VSI.IAT.Fingerprint
+import Control.Algebra
+import Control.Carrier.Diagnostics
+import Control.Effect.Lift
+import Effect.Logger
+import Effect.ReadFS
+import Fossa.API.Types
+import Path
+import Srclib.Types (Locator)
+
+assertRevisionBinaries :: (Has Diagnostics sig m, Has ReadFS sig m, Has (Lift IO) sig m, Has Logger sig m) => Path Abs Dir -> ApiOpts -> Locator -> m ()
+assertRevisionBinaries dir apiOpts locator = do
+  logInfo "Fingerprinting assertion directory contents"
+  fingerprints <- fingerprintContentsRaw dir
+
+  logInfo "Uploading assertion to FOSSA"
+  Fossa.assertRevisionBinaries apiOpts locator fingerprints
+
+  pure ()

src/App/Fossa/VSI/IAT/Resolve.hs

@@ -2,28 +2,58 @@
 
 module App.Fossa.VSI.IAT.Resolve (
   resolveUserDefined,
+  resolveRevision,
+  resolveGraph,
 ) where
 
 import App.Fossa.FossaAPIV1 qualified as Fossa
 import App.Fossa.VSI.IAT.Types (
   UserDefinedAssertionMeta (..),
   UserDep,
  )
+import App.Fossa.VSI.IAT.Types qualified as IAT
+import App.Fossa.VSI.Types qualified as VSI
 import Control.Algebra (Has)
-import Control.Effect.Diagnostics (Diagnostics)
+import Control.Effect.Diagnostics (Diagnostics, context)
 import Control.Effect.Lift (Lift)
+import Data.String.Conversion (toText)
 import Fossa.API.Types (ApiOpts)
+import Graphing (Graphing, direct, edges)
 import Srclib.Types (
   SourceUserDefDep (..),
  )
 
 resolveUserDefined :: (Has (Lift IO) sig m, Has Diagnostics sig m) => ApiOpts -> [UserDep] -> m (Maybe [SourceUserDefDep])
-resolveUserDefined apiOpts deps = do
+resolveUserDefined apiOpts deps = context ("Resolving user defined dependencies " <> toText (show $ map IAT.renderUserDep deps)) $ do
   assertions <- traverse (Fossa.resolveUserDefinedBinary apiOpts) deps
   if null assertions
     then pure Nothing
     else pure . Just $ map toUserDefDep assertions
 
+resolveRevision :: (Has (Lift IO) sig m, Has Diagnostics sig m) => ApiOpts -> VSI.Locator -> m [VSI.Locator]
+resolveRevision apiOpts locator =
+  context ("Resolving dependencies for " <> VSI.renderLocator locator) $
+    -- In the future we plan to support either returning a partial graph to the server for resolution there,
+    -- or expanding this into a full fledged graph resolver for any dependency using dedicated endpoints.
+    -- For the initial version of IAT however we're just resolving dependencies for top level projects.
+    -- Since users may only register revision assertions as a byproduct of running CLI analysis,
+    -- revision assertions are always for "custom" projects.
+    if VSI.isTopLevelProject locator
+      then Fossa.resolveProjectDependencies apiOpts locator
+      else pure []
+
+resolveGraph :: (Has (Lift IO) sig m, Has Diagnostics sig m) => ApiOpts -> [VSI.Locator] -> m (Graphing VSI.Locator)
+resolveGraph apiOpts locators = context ("Resolving graph for " <> toText (show $ fmap VSI.renderLocator locators)) $ do
+  subgraphs <- traverse (resolveSubgraph apiOpts) locators
+  pure $ mconcat subgraphs
+
+resolveSubgraph :: (Has (Lift IO) sig m, Has Diagnostics sig m) => ApiOpts -> VSI.Locator -> m (Graphing VSI.Locator)
+resolveSubgraph apiOpts locator = do
+  resolved <- resolveRevision apiOpts locator
+  pure $ direct locator <> edges (map edge resolved)
+  where
+    edge dep = (locator, dep)
+
 toUserDefDep :: UserDefinedAssertionMeta -> SourceUserDefDep
 toUserDefDep UserDefinedAssertionMeta{..} =
   SourceUserDefDep

src/App/Fossa/VSI/Types.hs

@@ -1,17 +1,22 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module App.Fossa.VSI.Types (
   Locator (..),
   LocatorParseError (..),
   parseLocator,
+  renderLocator,
   isUserDefined,
   userDefinedFetcher,
+  isTopLevelProject,
   toDependency,
 ) where
 
 import Control.Effect.Diagnostics (ToDiagnostic, renderDiagnostic)
+import Data.Aeson (FromJSON (parseJSON), withObject, (.:))
 import Data.Text (Text)
 import DepTypes (DepType (..), Dependency (..), VerConstraint (CEq))
 import Effect.Logger (Pretty (pretty), viaShow)
-import Srclib.Converter (fetcherToDepType)
+import Srclib.Converter (depTypeToFetcher, fetcherToDepType)
 import Srclib.Types qualified as Srclib
 
 -- | VSI supports a subset of possible Locators.
@@ -23,9 +28,19 @@ data Locator = Locator
   }
   deriving (Eq, Ord, Show)
 
+instance FromJSON Locator where
+  parseJSON = withObject "Locator" $ \obj -> do
+    Locator
+      <$> obj .: "fetcher"
+      <*> obj .: "package"
+      <*> obj .: "revision"
+
 parseLocator :: Text -> Either LocatorParseError Locator
 parseLocator = validateLocator . Srclib.parseLocator
 
+renderLocator :: Locator -> Text
+renderLocator Locator{..} = locatorFetcher <> "+" <> locatorProject <> "$" <> locatorRevision
+
 newtype LocatorParseError = RevisionRequired Srclib.Locator
   deriving (Eq, Ord, Show)
 
@@ -71,3 +86,6 @@ isUserDefined loc = locatorFetcher loc == userDefinedFetcher
 
 userDefinedFetcher :: Text
 userDefinedFetcher = "iat"
+
+isTopLevelProject :: Locator -> Bool
+isTopLevelProject loc = locatorFetcher loc == depTypeToFetcher CustomType