Draft implementation of strict mode

src/App/Fossa/Analyze.hs

@@ -45,6 +45,7 @@ import App.Fossa.Config.Analyze (
   IncludeAll (IncludeAll),
   NoDiscoveryExclusion (NoDiscoveryExclusion),
   ScanDestination (..),
+  StrictMode (..),
   UnpackArchives (UnpackArchives),
   WithoutDefaultFilters (..),
  )
@@ -189,6 +190,7 @@ runDependencyAnalysis ::
   , Has Stack sig m
   , Has (Reader ExperimentalAnalyzeConfig) sig m
   , Has (Reader MavenScopeFilters) sig m
+  , Has (Reader (Flag StrictMode)) sig m
   , Has (Reader AllFilters) sig m
   , Has (Reader OverrideDynamicAnalysisBinary) sig m
   , Has Telemetry sig m
@@ -294,6 +296,7 @@ analyze cfg = Diag.context "fossa-analyze" $ do
       shouldAnalyzePathDependencies = resolvePathDependencies $ Config.experimental cfg
       allowedTactics = Config.allowedTacticTypes cfg
       withoutDefaultFilters = Config.withoutDefaultFilters cfg
+  -- strictMode = Config.strictMode cfg
 
   manualSrcUnits <-
     Diag.errorBoundaryIO . diagToDebug $
@@ -361,7 +364,7 @@ analyze cfg = Diag.context "fossa-analyze" $ do
           pure Nothing
         else Diag.context "first-party-scans" . runStickyLogger SevInfo $ runFirstPartyScan basedir maybeApiOpts cfg
   let firstPartyScanResults = join . resultToMaybe $ maybeFirstPartyScanResults
-
+  -- logDebug $ "Is in strict mode ------------- " <> pretty (show strictMode)
   let discoveryFilters = if fromFlag NoDiscoveryExclusion noDiscoveryExclusion then mempty else filters
   (projectScans, ()) <-
     Diag.context "discovery/analysis tasks"
@@ -372,6 +375,7 @@ analyze cfg = Diag.context "fossa-analyze" $ do
       . runAtomicCounter
       . runReader (Config.experimental cfg)
       . runReader (Config.mavenScopeFilterSet cfg)
+      . runReader (Config.strictMode cfg)
       . runReader discoveryFilters
       . runReader (Config.overrideDynamicAnalysis cfg)
       $ do

src/App/Fossa/Analyze/Discover.hs

@@ -4,6 +4,7 @@ module App.Fossa.Analyze.Discover (
 ) where
 
 import App.Fossa.Analyze.Types (AnalyzeProject, DiscoverTaskEffs)
+import App.Fossa.Config.Analyze (StrictMode)
 import Control.Effect.Reader (Has, Reader)
 import Data.Aeson qualified as Aeson
 import Discovery.Filters (AllFilters)

src/App/Fossa/Analyze/Types.hs

@@ -11,14 +11,15 @@ module App.Fossa.Analyze.Types (
 ) where
 
 import App.Fossa.Analyze.Project (ProjectResult)
-import App.Fossa.Config.Analyze (ExperimentalAnalyzeConfig)
+import App.Fossa.Config.Analyze (ExperimentalAnalyzeConfig, StrictMode (..))
 import App.Fossa.Lernie.Types (LernieResults)
 import App.Fossa.Reachability.Types (SourceUnitReachability (..))
 import Control.Effect.Debug (Debug)
 import Control.Effect.Diagnostics (Diagnostics, Has)
 import Control.Effect.Lift (Lift)
 import Control.Effect.Reader (Reader)
 import Control.Effect.Telemetry (Telemetry)
+import Data.Flag (Flag)
 import Data.Set (Set)
 import Data.Text (Text)
 import Diag.Result (Result (Failure, Success))
@@ -44,6 +45,7 @@ type DiscoverTaskEffs sig m =
   , Has Debug sig m
   , Has (Reader ExperimentalAnalyzeConfig) sig m
   , Has (Reader MavenScopeFilters) sig m
+  , Has (Reader (Flag StrictMode)) sig m
   , Has (Reader AllFilters) sig m
   , Has Telemetry sig m
   )
@@ -69,6 +71,7 @@ type AnalyzeStaticTaskEffs sig m =
   , Has Debug sig m
   , Has (Reader ExperimentalAnalyzeConfig) sig m
   , Has (Reader MavenScopeFilters) sig m
+  , Has (Reader (Flag StrictMode)) sig m
   , Has (Reader AllFilters) sig m
   , Has Telemetry sig m
   )

src/App/Fossa/Config/Analyze.hs

@@ -23,6 +23,7 @@ module App.Fossa.Config.Analyze (
   GoDynamicTactic (..),
   StaticOnlyTactics (..),
   WithoutDefaultFilters (..),
+  StrictMode (..),
   mkSubCommand,
   loadConfig,
   cliParser,
@@ -135,6 +136,7 @@ data ForceFirstPartyScans = ForceFirstPartyScans deriving (Generic)
 data ForceNoFirstPartyScans = ForceNoFirstPartyScans deriving (Generic)
 data IgnoreOrgWideCustomLicenseScanConfigs = IgnoreOrgWideCustomLicenseScanConfigs deriving (Generic)
 data StaticOnlyTactics = StaticOnlyTactics deriving (Generic)
+data StrictMode = StrictMode deriving (Generic, Show)
 
 data BinaryDiscovery = BinaryDiscovery deriving (Generic)
 data IncludeAll = IncludeAll deriving (Generic)
@@ -226,6 +228,7 @@ data AnalyzeCliOpts = AnalyzeCliOpts
   , analyzeCustomFossaDepsFile :: Maybe FilePath
   , analyzeStaticOnlyTactics :: Flag StaticOnlyTactics
   , analyzeWithoutDefaultFilters :: Flag WithoutDefaultFilters
+  , analyzeStrictMode :: Flag StrictMode
   }
   deriving (Eq, Ord, Show)
 
@@ -264,6 +267,7 @@ data AnalyzeConfig = AnalyzeConfig
   , allowedTacticTypes :: AnalysisTacticTypes
   , reachabilityConfig :: ReachabilityConfig
   , withoutDefaultFilters :: Flag WithoutDefaultFilters
+  , strictMode :: Flag StrictMode
   }
   deriving (Eq, Ord, Show, Generic)
 
@@ -333,6 +337,7 @@ cliParser =
     <*> optional (strOption (applyFossaStyle <> long "fossa-deps-file" <> helpDoc fossaDepsFileHelp <> metavar "FILEPATH"))
     <*> flagOpt StaticOnlyTactics (applyFossaStyle <> long "static-only-analysis" <> stringToHelpDoc "Only analyze the project using static strategies.")
     <*> withoutDefaultFilterParser fossaAnalyzeDefaultFilterDocUrl
+    <*> flagOpt StrictMode (applyFossaStyle <> long "strict" <> stringToHelpDoc "Strict mode")
   where
     fossaDepsFileHelp :: Maybe (Doc AnsiStyle)
     fossaDepsFileHelp =
@@ -541,6 +546,7 @@ mergeStandardOpts maybeConfig envvars cliOpts@AnalyzeCliOpts{..} = do
     <*> pure allowedTacticType
     <*> resolveReachabilityOptions reachabilityConfig
     <*> pure analyzeWithoutDefaultFilters
+    <*> pure analyzeStrictMode
 
 collectMavenScopeFilters ::
   ( Has Diagnostics sig m

src/App/Fossa/Container/Sources/DockerArchive.hs

@@ -16,7 +16,7 @@ import App.Fossa.Analyze.Types (
   DiscoveredProjectIdentifier (..),
   DiscoveredProjectScan (..),
  )
-import App.Fossa.Config.Analyze (ExperimentalAnalyzeConfig (ExperimentalAnalyzeConfig), GoDynamicTactic (GoModulesBasedTactic), WithoutDefaultFilters (..))
+import App.Fossa.Config.Analyze (ExperimentalAnalyzeConfig (ExperimentalAnalyzeConfig), GoDynamicTactic (GoModulesBasedTactic), StrictMode (..), WithoutDefaultFilters (..))
 import App.Fossa.Container.Sources.Discovery (layerAnalyzers, renderLayerTarget)
 import App.Fossa.Container.Sources.JarAnalysis (analyzeContainerJars)
 import Codec.Archive.Tar.Index (TarEntryOffset)
@@ -59,7 +59,7 @@ import Control.Monad (join, void, when)
 import Data.Bifunctor (bimap)
 import Data.ByteString.Lazy qualified as BS
 import Data.FileTree.IndexFileTree (SomeFileTree, fixedVfsRoot)
-import Data.Flag (Flag, fromFlag)
+import Data.Flag (Flag, fromFlag, toFlag)
 import Data.Foldable (traverse_)
 import Data.Map qualified as Map
 import Data.Maybe (isNothing, listToMaybe, mapMaybe)
@@ -202,6 +202,7 @@ analyzeLayer systemDepsOnly filters withoutDefaultFilters capabilities osInfo la
             runTarballReadFSIO layerFs tarball
               . runReader noExperimental
               . runReader noMavenScopeFilters
+              . runReader testFlag
               . Diag.context "discovery/analysis tasks"
               . runOutput @DiscoveredProjectScan
               . runStickyLogger SevInfo
@@ -213,6 +214,8 @@ analyzeLayer systemDepsOnly filters withoutDefaultFilters capabilities osInfo la
           pure projectResults
       )
   where
+    testFlag :: Flag StrictMode
+    testFlag = toFlag StrictMode False
     noMavenScopeFilters :: MavenScopeFilters
     noMavenScopeFilters = MavenScopeIncludeFilters mempty
     noExperimental :: ExperimentalAnalyzeConfig
@@ -256,6 +259,7 @@ runDependencyAnalysis ::
   , Has (Output DiscoveredProjectScan) sig m
   , Has (Reader ExperimentalAnalyzeConfig) sig m
   , Has (Reader MavenScopeFilters) sig m
+  , Has (Reader (Flag StrictMode)) sig m
   , Has (Reader AllFilters) sig m
   , Has Stack sig m
   , Has Telemetry sig m
@@ -373,6 +377,7 @@ listTargetLayer capabilities osInfo layerFs tarball layerType = do
           False -- Targets are not impacted by path dependencies.
       )
     . runReader (MavenScopeIncludeFilters mempty)
+    . runReader (toFlag StrictMode False)
     . runReader (mempty :: AllFilters)
     $ run
   where

src/App/Fossa/ListTargets.hs

@@ -6,7 +6,7 @@ module App.Fossa.ListTargets (
 ) where
 
 import App.Fossa.Analyze.Discover (DiscoverFunc (DiscoverFunc), discoverFuncs)
-import App.Fossa.Config.Analyze (ExperimentalAnalyzeConfig)
+import App.Fossa.Config.Analyze (ExperimentalAnalyzeConfig, StrictMode (..))
 import App.Fossa.Config.ListTargets (
   ListTargetOutputFormat (..),
   ListTargetsCliOpts,
@@ -36,6 +36,7 @@ import Control.Effect.Stack (Stack)
 import Control.Effect.Telemetry (Telemetry)
 import Data.Aeson (ToJSON, encode, object, (.=))
 import Data.Aeson.Extra (encodeJSONToText)
+import Data.Flag (Flag (..), toFlag)
 import Data.Foldable (for_, traverse_)
 import Data.Set.NonEmpty (toSet)
 import Data.String.Conversion (decodeUtf8, toText)
@@ -83,10 +84,14 @@ listTargetsMain ListTargetsConfig{..} = do
     . runReader experimental
     -- `fossa list-targets` does not support maven scope filters.
     . runReader (MavenScopeIncludeFilters mempty)
+    . runReader (testFlag)
     -- The current version of `fossa list-targets` does not support filters.
     -- TODO: support both discovery and post-discovery filtering.
     . runReader (mempty :: AllFilters)
     $ runAll listTargetOutputFormat (unBaseDir baseDir)
+  where
+    testFlag :: Flag StrictMode
+    testFlag = toFlag StrictMode False
 
 runAll ::
   ( Has ReadFS sig m
@@ -99,6 +104,7 @@ runAll ::
   , Has Stack sig m
   , Has (Reader ExperimentalAnalyzeConfig) sig m
   , Has (Reader MavenScopeFilters) sig m
+  , Has (Reader (Flag StrictMode)) sig m
   , Has (Reader AllFilters) sig m
   , Has Telemetry sig m
   ) =>

src/Strategy/Bundler.hs

@@ -11,6 +11,7 @@ import App.Fossa.Analyze.LicenseAnalyze (
   LicenseAnalyzeProject (licenseAnalyzeProject),
  )
 import App.Fossa.Analyze.Types (AnalyzeProject (analyzeProjectStaticOnly), analyzeProject)
+import App.Fossa.Config.Analyze (StrictMode (..))
 import Control.Effect.Diagnostics (
   Diagnostics,
   context,
@@ -21,8 +22,9 @@ import Control.Effect.Diagnostics (
   (<||>),
  )
 import Control.Effect.Diagnostics qualified as Diag
-import Control.Effect.Reader (Reader)
+import Control.Effect.Reader (Reader, ask)
 import Data.Aeson (ToJSON)
+import Data.Flag (Flag, fromFlag)
 import Data.Glob as Glob (toGlob, (</>))
 import Data.Text (isSuffixOf)
 import Diag.Common (AllDirectDeps (AllDirectDeps), MissingEdges (MissingEdges))
@@ -35,6 +37,7 @@ import Discovery.Walk (
   walkWithFilters',
  )
 import Effect.Exec (Exec, Has)
+import Effect.Logger (Logger, logDebug)
 import Effect.ReadFS (ReadFS, readContentsParser)
 import GHC.Generics (Generic)
 import Path (Abs, Dir, File, Path, toFilePath)
@@ -119,8 +122,16 @@ mkProject project =
     , projectData = project
     }
 
-getDeps :: (Has Exec sig m, Has ReadFS sig m, Has Diagnostics sig m) => BundlerProject -> m DependencyResults
-getDeps project = analyzeGemfileLock project <||> context "Bundler" (analyzeBundleShow project)
+getDeps :: (Has Exec sig m, Has ReadFS sig m, Has Diagnostics sig m, Has (Reader (Flag StrictMode)) sig m, Has Logger sig m) => BundlerProject -> m DependencyResults
+getDeps project = do
+  strictMode <- ask @((Flag StrictMode))
+  if fromFlag StrictMode strictMode
+    then do
+      logDebug "Ruby strict mode"
+      analyzeGemfileLock project
+    else do
+      logDebug "Ruby NOT IN STRICT MODE ==========="
+      analyzeGemfileLock project <||> context "Bundler" (analyzeBundleShow project)
 
 analyzeBundleShow :: (Has Exec sig m, Has Diagnostics sig m) => BundlerProject -> m DependencyResults
 analyzeBundleShow project = do
@@ -132,15 +143,11 @@ analyzeBundleShow project = do
       , dependencyManifestFiles = maybe [bundlerGemfile project] pure (bundlerGemfileLock project)
       }
 
-analyzeGemfileLock :: (Has ReadFS sig m, Has Diagnostics sig m) => BundlerProject -> m DependencyResults
-analyzeGemfileLock project =
-  warnOnErr AllDirectDeps
-    . warnOnErr MissingEdges
-    . errCtx (BundlerMissingLockFileCtx $ bundlerGemfile project)
-    . errHelp BundlerMissingLockFileHelp
-    . errDoc bundlerLockFileRationaleUrl
-    . errDoc rubyFossaDocUrl
-    $ do
+analyzeGemfileLock :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader (Flag StrictMode)) sig m) => BundlerProject -> m DependencyResults
+analyzeGemfileLock project = do
+  strictMode <- ask @((Flag StrictMode))
+  if fromFlag StrictMode strictMode
+    then do
       lockFile <- context "Retrieve Gemfile.lock" (Diag.fromMaybeText "No Gemfile.lock present in the project" (bundlerGemfileLock project))
       graph <- context "Gemfile.lock analysis" . GemfileLock.analyze' $ lockFile
       pure $
@@ -149,3 +156,35 @@ analyzeGemfileLock project =
           , dependencyGraphBreadth = Complete
           , dependencyManifestFiles = [lockFile]
           }
+    else do
+      warnOnErr AllDirectDeps
+        . warnOnErr MissingEdges
+        . errCtx (BundlerMissingLockFileCtx $ bundlerGemfile project)
+        . errHelp BundlerMissingLockFileHelp
+        . errDoc bundlerLockFileRationaleUrl
+        . errDoc rubyFossaDocUrl
+        $ do
+          lockFile <- context "Retrieve Gemfile.lock" (Diag.fromMaybeText "No Gemfile.lock present in the project" (bundlerGemfileLock project))
+          graph <- context "Gemfile.lock analysis" . GemfileLock.analyze' $ lockFile
+          pure $
+            DependencyResults
+              { dependencyGraph = graph
+              , dependencyGraphBreadth = Complete
+              , dependencyManifestFiles = [lockFile]
+              }
+
+-- warnOnErr AllDirectDeps
+--   . warnOnErr MissingEdges
+--   . errCtx (BundlerMissingLockFileCtx $ bundlerGemfile project)
+--   . errHelp BundlerMissingLockFileHelp
+--   . errDoc bundlerLockFileRationaleUrl
+--   . errDoc rubyFossaDocUrl
+--   $ do
+--     lockFile <- context "Retrieve Gemfile.lock" (Diag.fromMaybeText "No Gemfile.lock present in the project" (bundlerGemfileLock project))
+--     graph <- context "Gemfile.lock analysis" . GemfileLock.analyze' $ lockFile
+--     pure $
+--       DependencyResults
+--         { dependencyGraph = graph
+--         , dependencyGraphBreadth = Complete
+--         , dependencyManifestFiles = [lockFile]
+--         }