Fix pnpm v9 snapshot collisions, optionalDependencies, and env labeling

Changelog.md

@@ -1,5 +1,11 @@
 # FOSSA CLI Changelog
 
+## Unreleased
+
+- PNPM: Fix pnpm v9 lockfile transitive devDependency classification. Dependencies of devDependencies were incorrectly reported as production dependencies in pnpm v9 projects. ([#1668](https://github.com/fossas/fossa-cli/pull/1668))
+- PNPM: Parse `optionalDependencies` from importers, packages, and snapshots across all lockfile versions. Previously, optional dependencies were silently excluded from the dependency graph. ([#1669](https://github.com/fossas/fossa-cli/pull/1669))
+- PNPM: Fix v9 snapshot peer dep suffix collision where packages with multiple peer variants (e.g. different React versions) could silently lose transitive dependencies. ([#1669](https://github.com/fossas/fossa-cli/pull/1669))
+
 ## 3.16.3
 
 - Elixir: Use `MIX_ENV=prod` for accurate production dependency resolution, with fallback to `--only prod` for projects lacking `config/prod.exs` ([#1662](https://github.com/fossas/fossa-cli/pull/1662))

src/Strategy/Node/Pnpm/PnpmLock.hs

@@ -13,11 +13,12 @@ import Control.Effect.Diagnostics (Diagnostics, Has, context)
 import Data.Aeson (FromJSON (..), withObject)
 import Data.Aeson.Extra (TextLike (..))
 import Data.Aeson.KeyMap (toHashMapText)
+import Data.Bifunctor (first)
 import Data.Foldable (for_)
 import Data.HashMap.Strict qualified as HashMap
 import Data.Map (Map, toList)
 import Data.Map qualified as Map
-import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
 import Data.Maybe qualified as Maybe
 import Data.Set qualified as Set
 import Data.String.Conversion (toString)
@@ -28,8 +29,10 @@ import Data.Yaml qualified as Yaml
 import DepTypes (
   DepEnvironment (EnvDevelopment, EnvProduction),
   DepType (GitType, NodeJSType, URLType, UserType),
-  Dependency (Dependency, dependencyType),
+  Dependency (Dependency, dependencyName, dependencyType, dependencyVersion),
   VerConstraint (CEq),
+  hydrateDepEnvs,
+  insertEnvironment,
  )
 import Effect.Grapher (deep, direct, edge, evalGrapher, run)
 import Effect.Logger (
@@ -38,7 +41,8 @@ import Effect.Logger (
   pretty,
  )
 import Effect.ReadFS (ReadFS, readContentsYaml)
-import Graphing (Graphing, shrink)
+import Graphing (Graphing)
+import Graphing qualified
 import Path (Abs, File, Path)
 
 -- | Pnpm Lockfile
@@ -160,12 +164,18 @@ instance FromJSON PnpmLockFileSnapshots where
       let readTransitiveDepPairs = withObject "Parse dependencies" $
             \ds -> do
               deps <- ds .:? "dependencies" .!= mempty
-              pure . HashMap.toList $ deps
+              optDeps <- ds .:? "optionalDependencies" .!= mempty
+              pure . HashMap.toList $ deps <> optDeps
       snapshots <- traverse readTransitiveDepPairs o
 
       -- Remove the peer dependency suffix. It's present in the snapshot entry, but it's not present in packages
       -- section which is where we look the dependency up.
-      let snapshots' = (HashMap.mapKeys withoutPeerDepSuffix) . toHashMapText $ snapshots
+      let snapshots' =
+            HashMap.fromListWith (<>)
+              . map (first withoutPeerDepSuffix)
+              . HashMap.toList
+              . toHashMapText
+              $ snapshots
       pure $
         PnpmLockFileSnapshots{snapshots = snapshots'}
 
@@ -195,7 +205,8 @@ instance FromJSON PnpmLockfile where
 
     dependencies <- obj .:? "dependencies" .!= mempty
     devDependencies <- obj .:? "devDependencies" .!= mempty
-    let virtualRootWs = ProjectMap dependencies devDependencies
+    optionalDependencies <- obj .:? "optionalDependencies" .!= mempty
+    let virtualRootWs = ProjectMap dependencies devDependencies optionalDependencies
     let refinedImporters =
           if Map.null importers
             then Map.insert "." virtualRootWs importers
@@ -216,6 +227,7 @@ instance FromJSON PnpmLockfile where
 data ProjectMap = ProjectMap
   { directDependencies :: Map Text ProjectMapDepMetadata
   , directDevDependencies :: Map Text ProjectMapDepMetadata
+  , directOptionalDependencies :: Map Text ProjectMapDepMetadata
   }
   deriving (Show, Eq, Ord)
 
@@ -224,6 +236,7 @@ instance FromJSON ProjectMap where
     ProjectMap
       <$> obj .:? "dependencies" .!= mempty
       <*> obj .:? "devDependencies" .!= mempty
+      <*> obj .:? "optionalDependencies" .!= mempty
 
 newtype ProjectMapDepMetadata = ProjectMapDepMetadata
   { version :: Text
@@ -242,6 +255,7 @@ data PackageData = PackageData
   , name :: Maybe Text -- only provided when non-registry resolver is used
   , resolution :: Resolution
   , dependencies :: Map Text Text
+  , optionalDependencies :: Map Text Text
   , peerDependencies :: Map Text Text
   }
   deriving (Show, Eq, Ord)
@@ -253,6 +267,7 @@ instance FromJSON PackageData where
       <*> obj .:? "name"
       <*> obj .: "resolution"
       <*> (obj .:? "dependencies" .!= mempty)
+      <*> (obj .:? "optionalDependencies" .!= mempty)
       <*> (obj .:? "peerDependencies" .!= mempty)
 
 data Resolution
@@ -301,15 +316,16 @@ analyze file = context "Analyzing Npm Lockfile (v3)" $ do
   context "Building dependency graph" $ pure $ buildGraph pnpmLockFile
 
 buildGraph :: PnpmLockfile -> Graphing Dependency
-buildGraph lockFile = withoutLocalPackages $
+buildGraph lockFile = withoutLocalPackages . hydrateV9Envs $
   run . evalGrapher $ do
     for_ (toList lockFile.importers) $ \(_, projectImporters) -> do
       let allDirectDependencies =
             toList (directDependencies projectImporters)
+              <> toList (directOptionalDependencies projectImporters)
               <> toList (directDevDependencies projectImporters)
 
       for_ allDirectDependencies $ \(depName, (ProjectMapDepMetadata depVersion)) ->
-        maybe (pure ()) direct $ toResolvedDependency (isPnpm9Dev depName) depName depVersion
+        maybe (pure ()) direct $ toResolvedDependency depName depVersion
 
     -- Add edges and deep dependencies by iterating over all packages.
     --
@@ -332,20 +348,21 @@ buildGraph lockFile = withoutLocalPackages $
     for_ (toList lockFile.packages) $ \(pkgKey, pkgMeta) -> do
       let deepDependencies =
             Map.toList (dependencies pkgMeta)
+              <> Map.toList (optionalDependencies pkgMeta)
               <> Map.toList (peerDependencies pkgMeta)
               <> fromMaybe mempty (HashMap.lookup pkgKey lockFile.lockFileSnapshots.snapshots)
 
       let (depName, depVersion) = case getPkgNameVersion pkgKey of
             Nothing -> (pkgKey, Nothing)
             Just (name, version) -> (name, Just version)
-      let parentDep = toDependency (isPnpm9Dev depName) depName depVersion pkgMeta
+      let parentDep = toDependency depName depVersion pkgMeta
 
       -- It is ok, if this dependency was already graphed as direct
       -- @direct 1 <> deep 1 = direct 1@
       deep parentDep
 
       for_ deepDependencies $ \(deepName, deepVersion) -> do
-        maybe (pure ()) (edge parentDep) (toResolvedDependency (isPnpm9Dev deepName) deepName deepVersion)
+        maybe (pure ()) (edge parentDep) (toResolvedDependency deepName deepVersion)
   where
     getPkgNameVersion :: Text -> Maybe (Text, Text)
     getPkgNameVersion = case lockFileVersion lockFile of
@@ -418,8 +435,8 @@ buildGraph lockFile = withoutLocalPackages $
     --    e.g.
     --      file:../local-package
     --
-    toResolvedDependency :: Bool -> Text -> Text -> Maybe Dependency
-    toResolvedDependency devOverride depName depVersion = do
+    toResolvedDependency :: Text -> Text -> Maybe Dependency
+    toResolvedDependency depName depVersion = do
       -- Some versions of the lockfile remove the peer dep suffix.
       -- Others do not which is why it tries both.
       let strippedVersion = withoutPeerDepSuffix depVersion
@@ -431,25 +448,8 @@ buildGraph lockFile = withoutLocalPackages $
               <|> fmap (depVersion,) (Map.lookup (mkPkgKey depName depVersion) (packages lockFile))
       case (maybeNonRegistrySrcPackage, maybeRegistrySrcPackage) of
         (Nothing, Nothing) -> Nothing
-        (Just nonRegistryPkg, _) -> Just $ toDependency devOverride depName Nothing nonRegistryPkg
-        (Nothing, Just (version, registryPkg)) -> Just $ toDependency devOverride depName (Just version) registryPkg
-
-    -- PNPM lockfile 9 doesn't store information about dev deps directly on package data.
-    -- Use a project map to determine if a package should be marked dev.
-    isPnpm9ProjectDev :: Text -> ProjectMap -> Bool
-    isPnpm9ProjectDev name ProjectMap{directDevDependencies} = Map.member name directDevDependencies
-
-    isPnpm9ProjectDep :: Text -> ProjectMap -> Bool
-    isPnpm9ProjectDep name ProjectMap{directDependencies} = Map.member name directDependencies
-
-    -- Returns true if a dependency is either absent or a dev dependency in each workspace. If it is a
-    -- non-dev dependency in any workspace, then this function returns false. Also returns false if the
-    -- lockfile is not PNPM v9
-    isPnpm9Dev :: Text -> Bool
-    isPnpm9Dev depName =
-      (lockFile.lockFileVersion == PnpmLockV9)
-        && (any (isPnpm9ProjectDev depName) lockFile.importers)
-        && not (any (isPnpm9ProjectDep depName) lockFile.importers)
+        (Just nonRegistryPkg, _) -> Just $ toDependency depName Nothing nonRegistryPkg
+        (Nothing, Just (version, registryPkg)) -> Just $ toDependency depName (Just version) registryPkg
 
     -- Makes representative key if the package was
     -- resolved via registry resolver.
@@ -466,17 +466,17 @@ buildGraph lockFile = withoutLocalPackages $
       PnpmLockV678 _ -> "/" <> name <> "@" <> version
       PnpmLockV9 -> name <> "@" <> version
 
-    toDependency :: Bool -> Text -> Maybe Text -> PackageData -> Dependency
-    toDependency devOverride name maybeVersion (PackageData isDev _ (RegistryResolve _) _ _) =
-      toDep NodeJSType name (withoutPeerDepSuffix . withoutSymConstraint <$> maybeVersion) (isDev || devOverride)
-    toDependency devOverride _ _ (PackageData isDev _ (GitResolve (GitResolution url rev)) _ _) =
-      toDep GitType url (Just rev) (isDev || devOverride)
-    toDependency devOverride _ _ (PackageData isDev _ (TarballResolve (TarballResolution url)) _ _) =
-      toDep URLType url Nothing (isDev || devOverride)
-    toDependency devOverride _ _ (PackageData isDev (Just name) (DirectoryResolve _) _ _) =
-      toDep UserType name Nothing (isDev || devOverride)
-    toDependency devOverride name _ (PackageData isDev Nothing (DirectoryResolve _) _ _) =
-      toDep UserType name Nothing (isDev || devOverride)
+    toDependency :: Text -> Maybe Text -> PackageData -> Dependency
+    toDependency name maybeVersion (PackageData isDev _ (RegistryResolve _) _ _ _) =
+      toDep NodeJSType name (withoutPeerDepSuffix . withoutSymConstraint <$> maybeVersion) isDev
+    toDependency _ _ (PackageData isDev _ (GitResolve (GitResolution url rev)) _ _ _) =
+      toDep GitType url (Just rev) isDev
+    toDependency _ _ (PackageData isDev _ (TarballResolve (TarballResolution url)) _ _ _) =
+      toDep URLType url Nothing isDev
+    toDependency _ _ (PackageData isDev (Just name) (DirectoryResolve _) _ _ _) =
+      toDep UserType name Nothing isDev
+    toDependency name _ (PackageData isDev Nothing (DirectoryResolve _) _ _ _) =
+      toDep UserType name Nothing isDev
 
     -- Sometimes package versions include symlinked paths
     -- of sibling dependencies used for resolution.
@@ -489,8 +489,59 @@ buildGraph lockFile = withoutLocalPackages $
     toDep :: DepType -> Text -> Maybe Text -> Bool -> Dependency
     toDep depType name version isDev = Dependency depType name (CEq <$> version) mempty (toEnv isDev) mempty
 
+    -- For v9, environments start empty and are set later by hydrateV9Envs,
+    -- which seeds direct deps from importer sections and propagates through
+    -- the graph via hydrateDepEnvs. For older versions, isDev from PackageData
+    -- is reliable and environments are set inline.
     toEnv :: Bool -> Set.Set DepEnvironment
-    toEnv isNotRequired = Set.singleton $ if isNotRequired then EnvDevelopment else EnvProduction
+    toEnv isNotRequired =
+      if isV9
+        then mempty
+        else Set.singleton (if isNotRequired then EnvDevelopment else EnvProduction)
+
+    isV9 :: Bool
+    isV9 = lockFile.lockFileVersion == PnpmLockV9
+
+    -- For v9: label direct deps, then propagate via hydrateDepEnvs.
+    -- For non-v9: no-op (environments already set via isDev from PackageData).
+    hydrateV9Envs :: Graphing Dependency -> Graphing Dependency
+    hydrateV9Envs =
+      if isV9
+        then hydrateDepEnvs . labelV9DirectDeps
+        else id
+
+    -- Seed environment labels on direct deps based on their importer section.
+    labelV9DirectDeps :: Graphing Dependency -> Graphing Dependency
+    labelV9DirectDeps = Graphing.gmap $ \dep ->
+      let ident = depIdentity dep
+          withProd = if Set.member ident v9ProdDirectDeps then insertEnvironment EnvProduction else id
+          withDev = if Set.member ident v9DevDirectDeps then insertEnvironment EnvDevelopment else id
+       in withProd . withDev $ dep
+
+    depIdentity :: Dependency -> (DepType, Text, Maybe VerConstraint)
+    depIdentity dep = (dependencyType dep, dependencyName dep, dependencyVersion dep)
+
+    v9ProdDirectDeps :: Set.Set (DepType, Text, Maybe VerConstraint)
+    v9ProdDirectDeps =
+      foldMap
+        ( \proj ->
+            Set.fromList $
+              mapMaybe
+                (\(depName, ProjectMapDepMetadata depVersion) -> depIdentity <$> toResolvedDependency depName depVersion)
+                (Map.toList (directDependencies proj) <> Map.toList (directOptionalDependencies proj))
+        )
+        lockFile.importers
+
+    v9DevDirectDeps :: Set.Set (DepType, Text, Maybe VerConstraint)
+    v9DevDirectDeps =
+      foldMap
+        ( \proj ->
+            Set.fromList $
+              mapMaybe
+                (\(depName, ProjectMapDepMetadata depVersion) -> depIdentity <$> toResolvedDependency depName depVersion)
+                (Map.toList $ directDevDependencies proj)
+        )
+        lockFile.importers
 
     withoutLocalPackages :: Graphing Dependency -> Graphing Dependency
     withoutLocalPackages = Graphing.shrink (\dep -> dependencyType dep /= UserType)