Ane 1425 maven analysis hanging (#1381)

* Fix hanging maven analysis

* update submodule docs

Changelog.md

@@ -1,5 +1,8 @@
 # FOSSA CLI Changelog
 
+## v3.9.5
+- Maven: Fix hanging maven analysis [#1381](https://github.com/fossas/fossa-cli/pull/1381)
+
 ## v3.9.4
 - Reachability: Includes reachability analysis in scan summary [#1379](https://github.com/fossas/fossa-cli/pull/1379)
 

src/Discovery/Filters.hs

@@ -26,6 +26,7 @@ module Discovery.Filters (
   FilterSet (..),
   setInclude,
   setExclude,
+  mavenScopeFilterSet,
 ) where
 
 import Control.Effect.Reader (Has, Reader, ask)
@@ -123,6 +124,10 @@ instance Semigroup (FilterCombination a) where
 instance Monoid (FilterCombination a) where
   mempty = FilterCombination mempty mempty
 
+mavenScopeFilterSet :: MavenScopeFilters -> Set Text
+mavenScopeFilterSet (MavenScopeIncludeFilters filterSet) = scopes filterSet
+mavenScopeFilterSet (MavenScopeExcludeFilters filterSet) = scopes filterSet
+
 withMultiToolFilter :: Has (Reader AllFilters) sig m => [DiscoveredProjectType] -> m [a] -> m [a]
 withMultiToolFilter tools act = do
   filters <- ask

src/Graphing.hs

@@ -396,26 +396,8 @@ subGraphOf n (Graphing gr) =
     keepPredicate Root = True
     keepPredicate (Node ty) = Set.member (Node ty) reachableNodes
 
--- | Adds color to all nodesToColor, with the color being 'a's extractedProperty
---
--- data SimpleDep = SimpleDep{ name :: Text, colorTag :: Text, colors :: Set Text}
---
--- updateColors :: Set Text -> SimpleDep -> SimpleDep
--- updateColors newColor dep = dep{colors = newColor}
-
--- extractColors :: SimpleDep -> Set Text
--- extractColors = colors
-
--- extractColorTag :: SimpleDep -> Text
--- extractColorTag = colorTag
-
--- Example
---
---  d1("d1", "blue" mempty) -> d2("d2", "green" mempty) -> d3("d3", "red" mempty)
---
--- color gr extractColors updateColors d1 extractColorTag nodesToColor= Set.fromList["blue", "green", "red"] =
---
--- d1("d1", "blue" Set("blue")) -> d2("d2", "green" Set("blue")) -> d3("d3", "red" Set("blue"))
+-- | Coloring a graph allows you to attach arbitrary context to nodes.
+--   Coloring should be used when the attached context is only relevant inside the graph.
 color :: forall a b. (Ord a, Ord b) => Graphing a -> (a -> Set.Set b) -> (Set.Set b -> a -> a) -> a -> (a -> b) -> Set.Set b -> Graphing a
 color graph extractSet update origin extractProperty nodesToColor = gmap applyColor graph
   where
@@ -425,22 +407,24 @@ color graph extractSet update origin extractProperty nodesToColor = gmap applyCo
           coloredNodeSet = if (extractProperty node) `Set.member` nodesToColor then nodeSet `Set.union` Set.fromList [extractProperty origin] else nodeSet
       update coloredNodeSet node
 
--- | Gets all successors originating from 'a' on condition (excluding a)
+-- | Gets all successors originating from 'a' (excluding a) that satisfy a condition
 --
--- Example
+--   Given the graph:
 --
---   1 -> 2
---    \    \
---     3    \
---      \    4
---       6    \
---             5
+-- >    1 -> 2
+-- >     \     \
+-- >      3     \
+-- >       \      4
+-- >         6     \
+-- >                5
 --
--- reachableSuccessorsWithCondition [(1, 2), (1, 3), (2, 4), (3, 6), (4, 5)]  1  (\x -> x `Set.notMember conditionalSet) conditionalSet= Set.fromList [2] =
+--   Here is an example to retrieve all reachable of nodes from 1, where the reachable nodes are not 2:
 --
--- Set (3, 6)
-reachableSuccessorsWithCondition :: forall a. (Ord a) => [(a, a)] -> a -> (a -> Set.Set a -> Bool) -> Set.Set a -> Set.Set a
-reachableSuccessorsWithCondition edgeList' origin f conditionalSet =
-  let directDependencies = [child | (parent, child) <- edgeList', parent == origin && f child conditionalSet]
-      transitiveDependencies = Set.unions $ map (\node -> reachableSuccessorsWithCondition edgeList' node f conditionalSet) directDependencies
+-- >  reachableSuccessorsWithCondition [(1, 2), (1, 3), (2, 4), (3, 6), (4, 5)]  1  (\x -> x `Set.notMember conditionalSet) conditionalSet= Set.fromList [2]
+-- >  Returns: Set (3, 6)
+reachableSuccessorsWithCondition :: forall a. (Ord a) => [(a, a)] -> a -> (a -> Set.Set a -> Bool) -> Set.Set a -> Set.Set a -> Set.Set a
+reachableSuccessorsWithCondition edgeList' origin f conditionalSet visitedSet =
+  let visitedSet' = Set.insert origin visitedSet
+      directDependencies = [child | (parent, child) <- edgeList', parent == origin && f child conditionalSet && child `Set.notMember` visitedSet']
+      transitiveDependencies = Set.unions $ map (\node -> reachableSuccessorsWithCondition edgeList' node f conditionalSet visitedSet') directDependencies
    in Set.fromList directDependencies `Set.union` transitiveDependencies

src/Strategy/Maven.hs

@@ -18,7 +18,7 @@ import Data.Set.NonEmpty (nonEmpty, toSet)
 import Data.Text hiding (group, map)
 import DepTypes (Dependency)
 import Diag.Common (MissingDeepDeps (MissingDeepDeps), MissingEdges (MissingEdges))
-import Discovery.Filters (AllFilters, MavenScopeFilters)
+import Discovery.Filters (AllFilters, MavenScopeFilters, mavenScopeFilterSet)
 import Discovery.Simple (simpleDiscover)
 import Effect.Exec (CandidateCommandEffs)
 import Effect.ReadFS (ReadFS)
@@ -129,8 +129,8 @@ getDepsDynamicAnalysis submoduleTargets closure = do
   where
     -- shrinkRoots is applied on all dynamic strategies.
     -- The root deps are either the toplevel package or submodules in a multi-module project.
-    --  We don't want to consider those because they're the users' packages.
-    --  Promote them to direct when building the graph using `shrinkRoots`.
+    -- We don't want to consider those because they're the users' packages.
+    -- Promote them to direct when building the graph using `shrinkRoots`.
     withoutProjectAsDep = shrinkRoots
 
 getDepsPlugin ::
@@ -177,12 +177,17 @@ getStaticAnalysis submoduleTargets closure = do
   filteredGraph <- applyMavenFilters submoduleTargets allSubmodules graph
   pure (filteredGraph, graphBreadth)
 
-applyMavenFilters :: Has (Reader MavenScopeFilters) sig m => Set Text -> Set Text -> Graphing MavenDependency -> m (Graphing Dependency)
+applyMavenFilters :: (Has Diagnostics sig m, Has (Reader MavenScopeFilters) sig m) => Set Text -> Set Text -> Graphing MavenDependency -> m (Graphing Dependency)
 applyMavenFilters targetSet submoduleSet graph = do
   mavenScopeFilters <- ask @(MavenScopeFilters)
-  let filteredSubmoduleGraph = filterMavenSubmodules targetSet submoduleSet graph
-      filteredSubmoduleScopeGraph = filterMavenDependencyByScope mavenScopeFilters filteredSubmoduleGraph
-
+  filteredSubmoduleGraph <-
+    if targetSet == submoduleSet
+      then pure graph
+      else context "Filter maven submodules" $ pure (filterMavenSubmodules targetSet submoduleSet graph)
+  filteredSubmoduleScopeGraph <-
+    if Set.null $ mavenScopeFilterSet mavenScopeFilters
+      then pure filteredSubmoduleGraph
+      else context "Filter maven scopes" $ pure (filterMavenDependencyByScope mavenScopeFilters filteredSubmoduleGraph)
   pure $ gmap mavenDependencyToDependency filteredSubmoduleScopeGraph
 
 submoduleTargetSet :: FoundTargets -> Set Text

src/Strategy/Maven/Common.hs

@@ -28,6 +28,75 @@ data MavenDependency = MavenDependency
 mavenDependencyToDependency :: MavenDependency -> Dependency
 mavenDependencyToDependency MavenDependency{..} = dependency
 
+-- | Filter all submodules (including their dependencies) that are not in `includedSubmoduleSet`.
+--
+--   This is achieved by:
+--      1. Retrieving every submodule dependency in the graph
+--      2. Traversing each submodule's children dependencies
+--      3. Coloring every dependency with contextual information about which submodules they belong to
+--
+--  NOTE: We cannot naively perform submodule filtering by removing every dependency originating from a filtered submodule dependency
+--
+--  In this example:
+--
+--    MavenDependency graph:
+--
+-- >        d1
+-- >        |    \
+-- >        |      \
+-- >        d2  ->   d3
+-- >        |
+-- >        d4
+-- >    d1 has edges to d2 & d3
+-- >    d2 has edges to d3 & d4
+--
+--    Where d1, d2, d3, and d4 are instantiated as:
+--
+-- >      d1 = MavenDependency
+-- >        { dependency : Dependency {dependencyName: "exec"}
+-- >        , dependencySubmodules : Set.empty
+-- >        }
+--
+-- >      d2 = MavenDependency
+-- >        { dependency : Dependency {dependencyName: "lib"}
+-- >        , dependencySubmodules : Set.empty
+-- >        }
+--
+-- >      d3 = MavenDependency
+-- >        { dependency : Dependency {dependencyName: "junit"}
+-- >        , dependencySubmodules : Set.empty
+-- >        }
+--
+-- >      d4 = MavenDependency
+-- >        { dependency : Dependency {dependencyName: "joda-time"}
+-- >        , dependencySubmoduls : Set.empty
+-- >        }
+--
+-- >   completeSubmoduleSet = Set ("exec", "lib")
+-- >   includedSubmoduleSet = Set ("lib")
+--
+--   Naively filtering the `lib` submodule and its dependencies would result in a graph only containing d1.
+--   This is incorrect as d3 should have been included as it was a dependency to d1, irrespective to its transitive dependencies from d2.
+--
+--   For these reasons, we need a different mechanism to accurately filter submodules, which is described above.
+--
+--   We use `reachableSuccessorsWithCondition` to retrieve a submodule's dependencies so long as the dependency is not
+--   also a submodule in the project. If we do not check if a child dependency is a submodule when calling
+--   `reachableSuccessorsWithCondition` it can lead to including dependencies that should have been excluded in the final graph!
+--
+--        Consider the following scenario using the same MavenDependency graph:
+--
+-- >          completeSubmoduleSet = Set ("exec", "lib")
+-- >          includedSubmoduleSet = Set ("exec")
+--
+--        If we did not check if a child was submodule, then d2's `dependencySubmodules` would be:
+--
+-- >          Set ("exec" , "lib")
+--
+--        This means that nothing would be filtered as d1 can reach every node in the graph.
+--        Instead, the final graph should consist of d1 and d3.
+--        d2 and d4 are filtered because d2 is not in `includedSubmoduleSet`.
+--        d3 remains because d1 has a direct edge to d3.
 filterMavenSubmodules :: Set Text -> Set Text -> Graphing MavenDependency -> Graphing MavenDependency
 filterMavenSubmodules includedSubmoduleSet completeSubmoduleSet graph = do
   let submoduleNodes = Set.fromList $ filter (\dep -> depNameFromMavenDependency dep `Set.member` completeSubmoduleSet) $ vertexList graph
@@ -55,13 +124,13 @@ filterMavenSubmodules includedSubmoduleSet completeSubmoduleSet graph = do
     -- reachableNodesOnCondition returns all of the submodule's children, so we need to union the set with the submodule to get a complete set (origin + children)
     reachableNodesFromSubmodule :: Text -> Set Text
     reachableNodesFromSubmodule mavenDep = do
-      let children = reachableSuccessorsWithCondition edgeList mavenDep notSubmodule completeSubmoduleSet
+      let children = reachableSuccessorsWithCondition edgeList mavenDep notSubmodule completeSubmoduleSet Set.empty
       children `Set.union` Set.fromList [mavenDep]
 
     -- For each submodule, color all of its dependencies.
     -- Tag each dependency with the submodule that it belongs to.
     -- If a submodule has a dependency to another submodule it will not tag the dependency submodule and their successors.
-    -- This allows us to maintain shared depenedencies between filtered and included submodules
+    -- This allows us to maintain shared depenedencies between filtered and included submodules.
     coloredGraph :: Set MavenDependency -> Graphing MavenDependency -> Graphing MavenDependency
     coloredGraph submodules g =
       foldr (\submodule acc -> color acc dependencySubmodules updateDependencySubmodules submodule depNameFromMavenDependency (reachableNodesFromSubmodule $ depNameFromMavenDependency submodule)) g submodules

test/GraphingSpec.hs

@@ -430,17 +430,23 @@ reachableSuccessorsWithConditionSpec = do
   --       6    \
   --             5
   let graph :: Graphing Int = Graphing.directs [1, 2] <> Graphing.edges [(1, 2), (1, 3), (2, 4), (3, 6), (4, 5)]
-  let condition :: Int -> Set Int -> Bool
-      condition x excluded = x `Set.notMember` excluded
+
+  --   1 -> 2 -> 3
+  --        |    |
+  --        5 <- 4
+  let cyclicGraph :: Graphing Int = Graphing.directs [1] <> Graphing.edges [(1, 2), (2, 3), (3, 4), (4, 5), (5, 2)]
 
   describe "reachableSuccessorsWithCondition" $ do
     it "should return the successors of 1 excluding 2 and its successors" $ do
       let excludedVals = Set.fromList [2]
-      reachableSuccessorsWithCondition (edgesList graph) 1 condition excludedVals `shouldBe` Set.fromList [3, 6]
+      reachableSuccessorsWithCondition (edgesList graph) 1 Set.notMember excludedVals Set.empty `shouldBe` Set.fromList [3, 6]
 
     it "should return no successors" $ do
       let excludedVals = Set.fromList [2, 3]
-      reachableSuccessorsWithCondition (edgesList graph) 1 condition excludedVals `shouldBe` Set.fromList []
+      reachableSuccessorsWithCondition (edgesList graph) 1 Set.notMember excludedVals Set.empty `shouldBe` Set.empty
+
+    it "should return successors of 1 when the graph is cyclic" $ do
+      reachableSuccessorsWithCondition (edgesList cyclicGraph) 1 Set.notMember Set.empty Set.empty `shouldBe` Set.fromList [2, 3, 4, 5]
 
 data SimpleDep = SimpleDep
   { name :: Text