[ANE-2123] Add a spec for walkWithFilters' to check that it does not …

…touch excluded dirs

src/App/Fossa/Analyze/Discover.hs

@@ -47,7 +47,7 @@ import Strategy.SwiftPM qualified as SwiftPM
 import Types (DiscoveredProject)
 
 discoverFuncs :: DiscoverTaskEffs sig m => [DiscoverFunc m]
-discoverFuncs = 
+discoverFuncs =
   [ DiscoverFunc Bundler.discover
   , DiscoverFunc Cabal.discover
   , DiscoverFunc Cargo.discover

src/Strategy/SwiftPM.hs

@@ -18,7 +18,7 @@ import Discovery.Simple (simpleDiscover)
 import Discovery.Walk (
   WalkStep (WalkContinue, WalkSkipSome),
   findFileNamed,
-  walk',
+  walkWithFilters',
  )
 import Effect.Logger (Logger, Pretty (pretty), logDebug)
 import Effect.ReadFS (ReadFS)
@@ -54,15 +54,27 @@ instance ToJSON SwiftProject
 discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject SwiftProject]
 discover = simpleDiscover findProjects mkProject SwiftProjectType
 
-findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m) => Path Abs Dir -> m [SwiftProject]
+findProjects ::
+  ( Has ReadFS sig m
+  , Has Diagnostics sig m
+  , Has Logger sig m
+  , Has (Reader AllFilters) sig m
+  ) =>
+  Path Abs Dir ->
+  m [SwiftProject]
 findProjects dir = do
   swiftPackageProjects <- context "Finding swift package projects" $ findSwiftPackageProjects dir
   xCodeProjects <- context "Finding xcode projects using swift package manager" $ findXcodeProjects dir
   pure (swiftPackageProjects <> xCodeProjects)
 
--- TODO: determine if walkWithFilters' is safe here
-findSwiftPackageProjects :: (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs Dir -> m [SwiftProject]
-findSwiftPackageProjects = walk' $ \dir _ files -> do
+findSwiftPackageProjects ::
+  ( Has ReadFS sig m
+  , Has Diagnostics sig m
+  , Has (Reader AllFilters) sig m
+  ) =>
+  Path Abs Dir ->
+  m [SwiftProject]
+findSwiftPackageProjects = walkWithFilters' $ \dir _ files -> do
   let packageManifestFile = findFileNamed "Package.swift" files
   let packageResolvedFile = findFileNamed "Package.resolved" files
   case (packageManifestFile, packageResolvedFile) of
@@ -72,9 +84,15 @@ findSwiftPackageProjects = walk' $ \dir _ files -> do
     -- Package.resolved without Package.swift or Xcode project file is not a valid swift project.
     (Nothing, _) -> pure ([], WalkContinue)
 
--- TODO: determine if walkWithFilters' is safe here
-findXcodeProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m) => Path Abs Dir -> m [SwiftProject]
-findXcodeProjects = walk' $ \dir _ files -> do
+findXcodeProjects ::
+  ( Has ReadFS sig m
+  , Has Diagnostics sig m
+  , Has Logger sig m
+  , Has (Reader AllFilters) sig m
+  ) =>
+  Path Abs Dir ->
+  m [SwiftProject]
+findXcodeProjects = walkWithFilters' $ \dir _ files -> do
   let xcodeProjectFile = findFileNamed "project.pbxproj" files
   case xcodeProjectFile of
     Nothing -> pure ([], WalkContinue)
@@ -89,8 +107,13 @@ findXcodeProjects = walk' $ \dir _ files -> do
 -- XCode projects using swift package manager retain Package.resolved,
 -- not in the same directory as project file, but rather in workspace's xcshareddata/swiftpm directory.
 -- Reference: https://developer.apple.com/documentation/swift_packages/adding_package_dependencies_to_your_app.
-findFirstResolvedFileRecursively :: (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs Dir -> m (Maybe (Path Abs File))
-findFirstResolvedFileRecursively baseDir = listToMaybe <$> walk' findFile baseDir
+findFirstResolvedFileRecursively ::
+  ( Has ReadFS sig m
+  , Has Diagnostics sig m
+  , Has (Reader AllFilters) sig m
+  ) =>
+  Path Abs Dir -> m (Maybe (Path Abs File))
+findFirstResolvedFileRecursively baseDir = listToMaybe <$> walkWithFilters' findFile baseDir
   where
     isParentDirSwiftPm :: Path Abs Dir -> Bool
     isParentDirSwiftPm d = (dirname d) == [reldir|swiftpm|]

test/Discovery/FiltersSpec.hs

@@ -284,6 +284,8 @@ testHarness include exclude = traverse_ testSingle
   where
     testSingle ((buildtool, dir), targets, expected) = applyFilters (AllFilters include exclude) buildtool dir targets `shouldBe` expected
 
+-- This is copy/pasted into WalkSpec.hs
+-- and might deserve a common definition
 excludePath :: Path Rel Dir -> AllFilters
 excludePath path = AllFilters mempty $ comboExclude mempty [path]
 

test/Discovery/WalkSpec.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Avoid restricted function" #-}
 
 module Discovery.WalkSpec (
   spec,
@@ -16,12 +18,52 @@ import Data.Map qualified as Map
 import Discovery.Walk
 import Effect.ReadFS
 import Path
-import Path.IO (createDir, createDirLink)
+import Path.IO (createDir, createDirLink, setPermissions, emptyPermissions, getPermissions)
 import Test.Effect
 import Test.Hspec
+import Discovery.Filters ( AllFilters(AllFilters), comboExclude )
+import Control.Carrier.Reader (runReader)
 
-spec :: Spec
-spec =
+walkWithFilters'Spec :: Spec
+walkWithFilters'Spec =
+  describe "walkWithFilters'" $ do
+    it' "ignores excluded paths" . withTempDir "test-Discovery-Walk-walkWithFilters'" $ \tmpDir -> do
+      let dirs@[foo, bar, baz] =
+            map
+              (tmpDir </>)
+              [ $(mkRelDir "foo")
+              , $(mkRelDir "foo/bar")
+              , $(mkRelDir "foo/baz")
+              ]
+      sendIO $ do
+        traverse_ createDir dirs
+        setPermissions bar emptyPermissions
+
+      case stripProperPrefix tmpDir bar of
+        Nothing -> error "Failed to get a relative path of foo/bar"
+        Just relBar -> do
+          let filters = excludePath relBar
+          paths <- runWalkWithFilters' 100 filters tmpDir
+          pathsToTree paths
+            `shouldBe'` dirTree
+              [
+                ( tmpDir
+                , dirTree
+                  [
+                    (foo
+                    , dirTree
+                        [ (baz, dirTree [])
+                        ]
+                    )
+                  ]
+                )
+              ]
+      sendIO $ do
+        fooPermissions <- getPermissions foo
+        setPermissions bar fooPermissions
+
+walkSpec :: Spec
+walkSpec =
   describe "walk" $ do
     it' "does a pre-order depth-first traversal" . withTempDir "test-Discovery-Walk" $ \tmpDir -> do
       let dirs@[a, ab, c, cd] =
@@ -88,6 +130,11 @@ spec =
             )
           ]
 
+spec :: Spec
+spec = do
+  walkSpec
+  walkWithFilters'Spec
+
 newtype DirTree = DirTree (Map (Path Abs Dir) DirTree) deriving (Show, Eq)
 
 dirTree :: [(Path Abs Dir, DirTree)] -> DirTree
@@ -108,6 +155,31 @@ runWalk ::
   (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs Dir -> m [Path Abs Dir]
 runWalk = runWalkWithCircuitBreaker 100
 
+runWalkWithFilters' ::
+  ( Has ReadFS sig m
+  , Has Diagnostics sig m
+  ) =>
+  Int -> AllFilters -> Path Abs Dir -> m [Path Abs Dir]
+runWalkWithFilters' maxIters filters startDir =
+  do
+    fmap fst
+    . runWriter
+    . fmap snd
+    . runState (0 :: Int)
+    . runReader filters
+    $ walkWithFilters'
+      ( \dir _ _ -> do
+          iterations :: Int <- get
+          if iterations < maxIters
+            then do
+              put (iterations + 1)
+              tell [dir]
+              pure ((), WalkContinue)
+            else do
+              pure ((), WalkStop)
+      )
+      startDir
+
 runWalkWithCircuitBreaker ::
   (Has ReadFS sig m, Has Diagnostics sig m) => Int -> Path Abs Dir -> m [Path Abs Dir]
 runWalkWithCircuitBreaker maxIters startDir =
@@ -128,3 +200,8 @@ runWalkWithCircuitBreaker maxIters startDir =
               pure WalkStop
       )
       startDir
+
+-- This is copy/pasted from FilterSpec.hs
+-- and might deserve a common definition
+excludePath :: Path Rel Dir -> AllFilters
+excludePath path = AllFilters mempty $ comboExclude mempty [path]