diff --git a/Changelog.md b/Changelog.md index 7d9cd9089..e4e2fc9a7 100644 --- a/Changelog.md +++ b/Changelog.md @@ -1,5 +1,6 @@ -# Unreleased +# 2.7.1 +- Adds support for Yarn v2 lockfiles ([#244](https://github.com/fossas/spectrometer/pull/244)) - Fixes the dependency version parser for `.csproj`, `.vbproj`, and similar .NET files ([#247](https://github.com/fossas/spectrometer/pull/247)) - Re-enables status messages for commands like `fossa test` in CI environments ([#248](https://github.com/fossas/spectrometer/pull/248)) @@ -7,9 +8,13 @@ - Adds support for the Conda package manager ([#226](https://github.com/fossas/spectrometer/pull/226)) +# v2.6.1 + +- Adds --follow to the vps analyze subcommand, which allows for following symbolic links during VPS scans. ([#243](https://github.com/fossas/spectrometer/pull/243)) + # v2.6.0 -- Improves the output of `fossa analyze` by displaying the status of ongoing Project Discovery and Project Analysis tasks ([#241](https://github.com/fossas/spectrometer/pull/241)) +- Improves the output of `fossa analyze` by displaying the status of ongoing Project Discovery and Project Analysis tasks ([#239](https://github.com/fossas/spectrometer/pull/239)) # v2.5.18 diff --git a/devdocs/buildtools/yarnv2.org b/devdocs/buildtools/yarnv2.org new file mode 100644 index 000000000..89ad11421 --- /dev/null +++ b/devdocs/buildtools/yarnv2.org @@ -0,0 +1,189 @@ + +* Overview +Yarn is a buildtool primarily used for building and managing javascript projects. It's functionally a superset of the =npm= cli. + +Yarn uses the same package manifest file as =npm= -- =package.json= -- but uses a novel lockfile format to pin dependencies, saved as =yarn.lock=. + +For dependency analysis, we focus exclusively on the lockfile. + +* Lockfile (=yarn.lock=) +As part of the update from Yarn v1 to Yarn v2, some major changes were made to the lockfile. Most notably: + ++ The lockfile [[https://dev.to/arcanis/introducing-yarn-2-4eh1#new-lockfile-format][is now real yaml]]. Yarn v1 used an almost-but-not-quite pseudo-yaml format. ++ While Yarn v1's lockfile contained information only about dependencies of user projects, Yarn v2's lockfile is much more information-rich. It contains information about first-party user projects ("workspaces"), the version ranges specified in =package.json= for dependencies ("descriptors"), and the resolved version for each dependency ("locators") + +** Concepts +*** Workspaces +Workspaces are first-party package directories (directories that contain =package.json=). Workspaces are always available locally on disk, and are specified by a relative reference to a directory (e.g., =.= or =./foo/bar= or =../baz=) + +A yarn project can have several workspaces, where workspaces may (but *are not required to*) depend on each other in a DAG. This is similar to "multi-module projects" in other buildtools like maven or gomodules. + +Every yarn project will contain at least one workspace. + +See: [[https://yarnpkg.com/features/workspaces]] + +*** Locators +/Somewhat/ similar to fossa locators, a yarn locator is an unambiguous reference to a specific version of a package and where to find it. + +Locators have three components: ++ Package scope (optional) -- like =@babel= -- a scope on npm. ++ Package name -- like =underscore=. ++ Package reference -- which can vary in shape depending on where the package is coming from. For example, this could be a pointer to specific package version on the npm registry, a pointer to a git repo at a specific commit, or a link to a tarball. + +Package scope and name in a locator, for the purposes of dependency resolution, *are unused*. Only the package reference matters. + +Yarn supports a handful of reference types by default, and plugins can be added to support new reference types. See the =Resolvers= section below. + +See: https://yarnpkg.com/advanced/lexicon#locator + +*** Descriptors +Descriptors are similar to locators, but may point to a /range/ of package versions. For the purposes of dependency analysis, we don't care much about the shape and content of descriptors. + +Descriptors have three components: ++ Package scope (optional) -- like =@babel= -- a scope on npm ++ Package name -- like =underscore= ++ Package range -- which can vary in shape depending on where the package is coming from. For example, this could be a semver for a package on the npm registry, a pointer to a git repo on a branch, or a link to a tarball + +All locators are valid descriptors; not all descriptors are valid locators. + +See: https://yarnpkg.com/advanced/lexicon#descriptor + +*** Resolvers +Plugins are the yarn v2 mechanism used to add support for, among other things, new types of locators. + +A plugin can export zero or more "Resolvers", each of which can add support for new types of locator. Yarn itself implements support for "built-in" locator types (npm dependencies, git dependencies, etc) as resolvers in bundled plugins. + +For dependency analysis, we support locators produced by [[https://github.com/yarnpkg/berry/blob/8afcaa2a954e196d6cd997f8ba506f776df83b1f/packages/yarnpkg-cli/package.json#L68-L82][all of the built-in plugins]]. + +See: https://yarnpkg.com/advanced/lexicon#resolver +** Format +#+BEGIN_SRC yaml +# This file is generated by running "yarn install" inside your project. +# Manual changes might be lost - proceed with caution! + +__metadata: + version: 4 + cacheKey: 7 + +"bar@workspace:bar": + version: 0.0.0-use.local + resolution: "bar@workspace:bar" + dependencies: + underscore: 1.13.1 + languageName: unknown + linkType: soft + +"foo@workspace:foo": + version: 0.0.0-use.local + resolution: "foo@workspace:foo" + dependencies: + underscore: ^1.13.0 + languageName: unknown + linkType: soft + +"quux@workspace:quux": + version: 0.0.0-use.local + resolution: "quux@workspace:quux" + dependencies: + underscore: "jashkenas/underscore#tag=1.13.1" + languageName: unknown + linkType: soft + +"toplevel@workspace:.": + version: 0.0.0-use.local + resolution: "toplevel@workspace:." + languageName: unknown + linkType: soft + +"underscore@jashkenas/underscore#tag=1.13.1": + version: 1.13.1 + resolution: "underscore@https://github.com/jashkenas/underscore.git#commit=cbb48b79fc1205aa04feb03dbc055cdd28a12652" + checksum: 560609fdb4ba2c30e79db95ea37269982d1a2788d49b78f0de4f391da711bc2495d5fbddd6d24e7716fccf69959e445916af83eb5de1ad137b215777e2d32e4d + languageName: node + linkType: hard + +"underscore@npm:1.13.1, underscore@npm:^1.13.0": + version: 1.13.1 + resolution: "underscore@npm:1.13.1" + checksum: 19527b2db3d34f783c3f2db9716a2c1221fef2958866925545697c46f430f59d1b384b8105cc7e7c809bdf0dc9075f2bfff90b8fb270b9d3a6c58347de2dd79d + languageName: node + linkType: hard + +#+END_SRC + +Ignoring the =__metadata= field, the yarn lockfile is a mapping from =a comma-separated list of descriptors= to a =package description=. + +*** Package description fields + +Of a package's fields, we only care about =resolution= and =dependencies= + +**** =resolution= +The locator used for this package + +**** =dependencies= +An optional field containing =package: descriptor-range= mappings for each dependency of the package. *This includes dev dependencies* if they were included when running =yarn install=. + +This field is copied functionally identically from a package's =dependencies= and =devDependencies= fields in =package.json=. The code that parses a =Package description= [[https://github.com/yarnpkg/berry/blob/0d9834036d6a3747d6c0dbb5c11e27568f7194dc/packages/yarnpkg-core/sources/Project.ts#L284][is the same code]] that parses dependencies in a =package.json= file + +Full dependency descriptors [[https://github.com/yarnpkg/berry/blob/0d9834036d6a3747d6c0dbb5c11e27568f7194dc/packages/yarnpkg-core/sources/Manifest.ts#L307-L326][can be reconstructed]] by joining key-value pairs on =@=: =underscore: ^1.13.0= is =underscore@^1.13.0=. Each dependency's descriptor is a key for a package at the top level of the yarn lockfile + +#+BEGIN_QUOTE +*NOTE*: a fun note about dependency descriptors + +A keen eye may notice that in the lockfile above, some descriptor keys contain =npm:= at the top-level. For example, there's =underscore@npm:1.13.1= -- but that descriptor isn't used anywhere as a dependency. The closest is =underscore@1.13.1=, a dependency of the =bar= workspace. + +In an interesting design decision, yarn makes the default resolver for packages configurable. When a user provides a raw version (e.g., =1.13.1=) or semver (=^1.13.1=) for a dependency in =package.json=, a "default protocol" string is prepended to the descriptor range. This option [[https://next.yarnpkg.com/configuration/yarnrc#defaultProtocol][is configured]] as =defaultProtocol=, which defaults to =npm:=. + +As a workaround, when using a descriptor =name@range= to look up a package in the lockfile, we must also try =name@npm:range= +#+END_QUOTE + +*** Lockfile sources +The above lockfile was generated from the following files + +=package.json= +#+BEGIN_SRC json +{ + "name": "toplevel", + "private": true, + "workspaces": [ + "foo", + "bar", + "quux" + ] +} +#+END_SRC + +=foo/package.json= +#+BEGIN_SRC json +{ + "name": "foo", + "version": "1.0.0", + "dependencies": { + "underscore": "^1.13.0" + } +} +#+END_SRC + +=bar/package.json= +#+BEGIN_SRC json +{ + "name": "bar", + "version": "1.0.0", + "dependencies": { + "underscore": "1.13.1" + } +} +#+END_SRC + +=quux/package.json= + +Note that =name/repo= is implicitly treated as a github repo reference +#+BEGIN_SRC json +{ + "name": "quux", + "version": "1.0.0", + "dependencies": { + "underscore": "jashkenas/underscore#tag=1.13.1" + } +} +#+END_SRC diff --git a/spectrometer.cabal b/spectrometer.cabal index 81baf2559..eea976d7e 100644 --- a/spectrometer.cabal +++ b/spectrometer.cabal @@ -33,7 +33,6 @@ common lang GADTSyntax GeneralizedNewtypeDeriving HexFloatLiterals - ImportQualifiedPost InstanceSigs KindSignatures MultiParamTypeClasses @@ -46,12 +45,13 @@ common lang RankNTypes ScopedTypeVariables StandaloneDeriving - StandaloneKindSignatures StrictData TupleSections TypeApplications TypeOperators TypeSynonymInstances + ImportQualifiedPost + StandaloneKindSignatures ghc-options: -Wall -Wincomplete-uni-patterns -Wcompat @@ -123,14 +123,15 @@ library -- cabal-fmt: expand src exposed-modules: + Algebra.Graph.AdjacencyMap.Extra + App.Fossa.API.BuildLink + App.Fossa.API.BuildWait App.Fossa.Analyze App.Fossa.Analyze.Graph App.Fossa.Analyze.GraphBuilder App.Fossa.Analyze.GraphMangler App.Fossa.Analyze.Project App.Fossa.Analyze.Record - App.Fossa.API.BuildLink - App.Fossa.API.BuildWait App.Fossa.Compatibility App.Fossa.Configuration App.Fossa.Container @@ -161,20 +162,20 @@ library App.Version App.Version.TH Console.Sticky + Control.Carrier.AtomicCounter Control.Carrier.AtomicState Control.Carrier.Diagnostics Control.Carrier.Diagnostics.StickyContext Control.Carrier.Finally - Control.Carrier.AtomicCounter Control.Carrier.Output.IO Control.Carrier.StickyLogger Control.Carrier.TaskPool Control.Carrier.Threaded + Control.Effect.AtomicCounter Control.Effect.AtomicState Control.Effect.ConsoleRegion Control.Effect.Diagnostics Control.Effect.Finally - Control.Effect.AtomicCounter Control.Effect.Output Control.Effect.Path Control.Effect.Record @@ -184,6 +185,7 @@ library Control.Effect.StickyLogger Control.Effect.TaskPool Control.Exception.Extra + Data.Aeson.Extra Data.FileEmbed.Extra Data.Flag Data.Functor.Extra @@ -242,7 +244,6 @@ library Strategy.Node.NpmList Strategy.Node.NpmLock Strategy.Node.PackageJson - Strategy.Node.YarnLock Strategy.Npm Strategy.NuGet.Nuspec Strategy.NuGet.PackageReference @@ -255,13 +256,17 @@ library Strategy.Python.SetupPy Strategy.Python.Setuptools Strategy.Python.Util - Strategy.Rebar3 Strategy.RPM + Strategy.Rebar3 Strategy.Ruby.BundleShow Strategy.Ruby.GemfileLock Strategy.Scala - Strategy.Yarn Strategy.UserSpecified.YamlDependencies + Strategy.Yarn + Strategy.Yarn.V1.YarnLock + Strategy.Yarn.V2.Lockfile + Strategy.Yarn.V2.Resolvers + Strategy.Yarn.V2.YarnLock Text.URI.Builder Types VCS.Git @@ -292,9 +297,9 @@ test-suite unit-tests -- cabal-fmt: expand test other-modules: App.Fossa.API.BuildLinkSpec + App.Fossa.Configuration.ConfigurationSpec App.Fossa.Report.AttributionSpec App.Fossa.VPS.NinjaGraphSpec - App.Fossa.Configuration.ConfigurationSpec Cargo.MetadataSpec Carthage.CarthageSpec Clojure.ClojureSpec @@ -317,15 +322,14 @@ test-suite unit-tests Go.TransitiveSpec Googlesource.RepoManifestSpec Gradle.GradleSpec - GraphingSpec GraphUtil + GraphingSpec Haskell.CabalSpec Haskell.StackSpec Maven.PluginStrategySpec Maven.PomStrategySpec Node.NpmLockSpec Node.PackageJsonSpec - Node.YarnLockSpec NuGet.NuspecSpec NuGet.PackageReferenceSpec NuGet.PackagesConfigSpec @@ -340,11 +344,15 @@ test-suite unit-tests Ruby.BundleShowSpec Ruby.GemfileLockSpec UserSpecified.YamlDependenciesSpec + Yarn.V2.LockfileSpec + Yarn.V2.ResolversSpec + Yarn.YarnLockV1Spec build-tool-depends: hspec-discover:hspec-discover ^>=2.7.1 build-depends: - , hedgehog ^>=1.0.2 - , hspec ^>=2.7.1 - , hspec-hedgehog ^>=0.0.1.2 - , hspec-megaparsec ^>=2.1 + , hedgehog ^>=1.0.2 + , hspec ^>=2.7.1 + , hspec-expectations-pretty-diff ^>=0.7.2.5 + , hspec-hedgehog ^>=0.0.1.2 + , hspec-megaparsec ^>=2.1 , spectrometer diff --git a/src/Algebra/Graph/AdjacencyMap/Extra.hs b/src/Algebra/Graph/AdjacencyMap/Extra.hs new file mode 100644 index 000000000..9770a3100 --- /dev/null +++ b/src/Algebra/Graph/AdjacencyMap/Extra.hs @@ -0,0 +1,19 @@ +module Algebra.Graph.AdjacencyMap.Extra ( + gtraverse, +) where + +import Algebra.Graph.AdjacencyMap qualified as AM +import Data.Set qualified as S + +-- | It's 'traverse', but for graphs +-- +-- It's also unlawful. 'f' might be called several times for each node in the graph +gtraverse :: + (Applicative f, Ord b) => + (a -> f b) -> + AM.AdjacencyMap a -> + f (AM.AdjacencyMap b) +gtraverse f = fmap mkAdjacencyMap . traverse (\(a, xs) -> (,) <$> f a <*> traverse f xs) . AM.adjacencyList + where + mkAdjacencyMap :: Ord c => [(c, [c])] -> AM.AdjacencyMap c + mkAdjacencyMap = AM.fromAdjacencySets . fmap (fmap S.fromList) diff --git a/src/Control/Effect/Diagnostics.hs b/src/Control/Effect/Diagnostics.hs index 109dae148..cb62c0b1e 100644 --- a/src/Control/Effect/Diagnostics.hs +++ b/src/Control/Effect/Diagnostics.hs @@ -158,19 +158,23 @@ instance Show FailureBundle where show = show . renderFailureBundle renderFailureBundle :: FailureBundle -> Doc AnsiStyle -renderFailureBundle FailureBundle {..} = - vsep - [ annotate (color Yellow) "----------", - annotate (color Yellow) "An error occurred:", - "", - indent 4 (renderSomeDiagnostic failureCause), - "", - ">>>", - "", - indent 2 (annotate (color Yellow) "Relevant warnings include:"), - "", - indent 4 (renderWarnings failureWarnings) +renderFailureBundle FailureBundle{..} = + vsep $ + [ annotate (color Yellow) "----------" + , annotate (color Yellow) "An error occurred:" + , "" + , indent 4 (renderSomeDiagnostic failureCause) + , "" ] + ++ if null failureWarnings + then [] + else + [ ">>>" + , "" + , indent 2 (annotate (color Yellow) "Relevant warnings include:") + , "" + , indent 4 (renderWarnings failureWarnings) + ] renderSomeDiagnostic :: SomeDiagnostic -> Doc AnsiStyle renderSomeDiagnostic (SomeDiagnostic stack cause) = diff --git a/src/Data/Aeson/Extra.hs b/src/Data/Aeson/Extra.hs new file mode 100644 index 000000000..863647910 --- /dev/null +++ b/src/Data/Aeson/Extra.hs @@ -0,0 +1,32 @@ +module Data.Aeson.Extra ( + TextLike (..), +) where + +import Control.Applicative ((<|>)) +import Data.Aeson +import Data.Text (Text) +import Data.Text qualified as T + +-- | A Text-like field +-- +-- Sometimes fields in yaml files get incorrectly classified as numbers instead of text +-- +-- This can happen when you have a field like @two@ in +-- +-- @ +-- myCoolField: +-- one: 1.0.0 +-- two: 2 +-- @ +-- +-- This makes things really hard to parse. +-- +-- As a workaround, we try parsing as Text, then Int, then Double +newtype TextLike = TextLike {unTextLike :: Text} + +instance FromJSON TextLike where + parseJSON val = parseAsText <|> parseAsInt <|> parseAsDouble + where + parseAsText = TextLike <$> parseJSON val + parseAsInt = TextLike . T.pack . show <$> parseJSON @Int val + parseAsDouble = TextLike . T.pack . show <$> parseJSON @Double val diff --git a/src/Data/Text/Extra.hs b/src/Data/Text/Extra.hs index 31b6576ca..412cd3302 100644 --- a/src/Data/Text/Extra.hs +++ b/src/Data/Text/Extra.hs @@ -4,6 +4,7 @@ module Data.Text.Extra breakOnAndRemove, underBS, showT, + dropPrefix, ) where @@ -11,6 +12,7 @@ import Data.ByteString (ByteString) import Data.Text (Text) import qualified Data.Text as T import Data.String.Conversion (decodeUtf8, encodeUtf8) +import Data.Maybe (fromMaybe) splitOnceOn :: Text -> Text -> (Text, Text) splitOnceOn needle haystack = (first, strippedRemaining) @@ -46,3 +48,6 @@ underBS f = decodeUtf8 . f . encodeUtf8 showT :: Show a => a -> Text showT = T.pack . show + +dropPrefix :: Text -> Text -> Text +dropPrefix pre txt = fromMaybe txt (T.stripPrefix pre txt) diff --git a/src/Graphing.hs b/src/Graphing.hs index 379157f4a..1a8b4382d 100644 --- a/src/Graphing.hs +++ b/src/Graphing.hs @@ -18,18 +18,22 @@ module Graphing -- * Manipulating a Graphing , gmap , gtraverse + , induceJust , filter , pruneUnreachable , stripRoot -- * Building simple Graphings + , fromAdjacencyMap , fromList , unfold ) where import Algebra.Graph.AdjacencyMap (AdjacencyMap) import qualified Algebra.Graph.AdjacencyMap as AM +import qualified Algebra.Graph.AdjacencyMap.Extra as AME import qualified Algebra.Graph.AdjacencyMap.Algorithm as AMA +import Data.Maybe (catMaybes) import Data.Set (Set) import qualified Data.Set as S import Prelude hiding (filter) @@ -75,10 +79,14 @@ gtraverse f Graphing{..} = Graphing <$> newSet <*> newAdjacent newSet = fmap S.fromList . traverse f . S.toList $ graphingDirect -- newAdjacent :: f (AM.AdjacencyMap b) - newAdjacent = fmap mkAdjacencyMap . traverse (\(a,xs) -> (,) <$> f a <*> traverse f xs) . AM.adjacencyList $ graphingAdjacent + newAdjacent = AME.gtraverse f graphingAdjacent - -- mkAdjacencyMap :: Ord c => [(c,[c])] -> AM.AdjacencyMap c - mkAdjacencyMap = AM.fromAdjacencySets . fmap (fmap S.fromList) +-- | Like 'AM.induceJust', but for Graphings +induceJust :: Ord a => Graphing (Maybe a) -> Graphing a +induceJust gr = gr { graphingDirect = direct', graphingAdjacent = adjacent' } + where + direct' = S.fromList . catMaybes . S.toList $ graphingDirect gr + adjacent' = AM.induceJust (graphingAdjacent gr) -- | Filter Graphing elements filter :: (ty -> Bool) -> Graphing ty -> Graphing ty @@ -142,6 +150,10 @@ unfold seed getDeps toDependency = Graphing fromList :: Ord ty => [ty] -> Graphing ty fromList nodes = Graphing (S.fromList nodes) (AM.vertices nodes) +-- | Wrap an AdjacencyMap as a Graphing +fromAdjacencyMap :: AM.AdjacencyMap ty -> Graphing ty +fromAdjacencyMap = Graphing S.empty + -- | Remove unreachable vertices from the graph -- -- A vertex is reachable if there's a path from the "direct" vertices to that vertex diff --git a/src/Strategy/Npm.hs b/src/Strategy/Npm.hs index f07fe14bf..c4a398b16 100644 --- a/src/Strategy/Npm.hs +++ b/src/Strategy/Npm.hs @@ -22,19 +22,24 @@ discover dir = context "Npm" $ do findProjects :: (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs Dir -> m [NpmProject] findProjects = walk' $ \dir _ files -> do - case findFileNamed "package.json" files of - Nothing -> pure ([], WalkSkipSome ["node_modules"]) - Just packageJson -> do - let packageLock = findFileNamed "package-lock.json" files + case findFileNamed "yarn.lock" files of + -- When we find yarn.lock, assume this directory and subdirectories are managed by yarn. + -- This prevents duplicate project analysis and noisy failures + Just _ -> pure ([], WalkSkipAll) + Nothing -> + case findFileNamed "package.json" files of + Nothing -> pure ([], WalkSkipSome ["node_modules"]) + Just packageJson -> do + let packageLock = findFileNamed "package-lock.json" files - let project = - NpmProject - { npmDir = dir, - npmPackageJson = packageJson, - npmPackageLock = packageLock - } + let project = + NpmProject + { npmDir = dir, + npmPackageJson = packageJson, + npmPackageLock = packageLock + } - pure ([project], WalkSkipSome ["node_modules"]) + pure ([project], WalkSkipSome ["node_modules"]) data NpmProject = NpmProject { npmDir :: Path Abs Dir, diff --git a/src/Strategy/Yarn.hs b/src/Strategy/Yarn.hs index 97cd3407f..752d5c33d 100644 --- a/src/Strategy/Yarn.hs +++ b/src/Strategy/Yarn.hs @@ -1,15 +1,16 @@ -module Strategy.Yarn - ( discover - ) where +module Strategy.Yarn ( + discover, +) where import Control.Effect.Diagnostics import Discovery.Walk import Effect.ReadFS -import qualified Graphing as G +import Graphing qualified as G import Path +import Strategy.Yarn.V1.YarnLock qualified as V1 +import Strategy.Yarn.V2.YarnLock qualified as V2 import Types import Prelude -import qualified Strategy.Node.YarnLock as YarnLock discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has ReadFS rsig run, Has Diagnostics rsig run) => Path Abs Dir -> m [DiscoveredProject run] discover dir = context "Yarn" $ do @@ -23,26 +24,33 @@ findProjects = walk' $ \dir _ files -> do Just lock -> do let project = YarnProject - { yarnDir = dir - , yarnLock = lock - } + { yarnDir = dir + , yarnLock = lock + } pure ([project], WalkSkipSome ["node_modules"]) mkProject :: (Has ReadFS sig n, Has Diagnostics sig n) => YarnProject -> DiscoveredProject n mkProject project = DiscoveredProject - { projectType = "yarn", - projectBuildTargets = mempty, - projectDependencyGraph = const $ getDeps project, - projectPath = yarnDir project, - projectLicenses = pure [] + { projectType = "yarn" + , projectBuildTargets = mempty + , projectDependencyGraph = const $ getDeps project + , projectPath = yarnDir project + , projectLicenses = pure [] } getDeps :: (Has ReadFS sig m, Has Diagnostics sig m) => YarnProject -> m (G.Graphing Dependency) -getDeps = context "Yarn" . context "Static analysis" . YarnLock.analyze' . yarnLock +getDeps project = context "Yarn" $ getDepsV1 project <||> getDepsV2 project + +getDepsV1 :: (Has ReadFS sig m, Has Diagnostics sig m) => YarnProject -> m (G.Graphing Dependency) +getDepsV1 = V1.analyze . yarnLock + +getDepsV2 :: (Has ReadFS sig m, Has Diagnostics sig m) => YarnProject -> m (G.Graphing Dependency) +getDepsV2 = V2.analyze . yarnLock data YarnProject = YarnProject { yarnDir :: Path Abs Dir , yarnLock :: Path Abs File - } deriving (Eq, Ord, Show) + } + deriving (Eq, Ord, Show) diff --git a/src/Strategy/Node/YarnLock.hs b/src/Strategy/Yarn/V1/YarnLock.hs similarity index 91% rename from src/Strategy/Node/YarnLock.hs rename to src/Strategy/Yarn/V1/YarnLock.hs index a177fb11a..6ecaf4a48 100644 --- a/src/Strategy/Node/YarnLock.hs +++ b/src/Strategy/Yarn/V1/YarnLock.hs @@ -1,5 +1,5 @@ -module Strategy.Node.YarnLock - ( analyze' +module Strategy.Yarn.V1.YarnLock + ( analyze , buildGraph ) where @@ -17,8 +17,8 @@ import Path import qualified Yarn.Lock as YL import qualified Yarn.Lock.Types as YL -analyze' :: (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs File -> m (Graphing Dependency) -analyze' lockfile = do +analyze :: (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs File -> m (Graphing Dependency) +analyze lockfile = context "Lockfile V1 analysis" $ do let path = fromAbsFile lockfile contents <- readContentsText lockfile diff --git a/src/Strategy/Yarn/V2/Lockfile.hs b/src/Strategy/Yarn/V2/Lockfile.hs new file mode 100644 index 000000000..22e9bbcb3 --- /dev/null +++ b/src/Strategy/Yarn/V2/Lockfile.hs @@ -0,0 +1,140 @@ +-- | Types and decoders for the elements found in a yarn v2 lockfile +-- +-- See the yarnv2 devdocs for an overview +module Strategy.Yarn.V2.Lockfile ( + YarnLockfile (..), + Locator (..), + Descriptor (..), + PackageDescription (..), +) where + +import Data.Aeson +import Data.Aeson.Extra (TextLike (..)) +import Data.HashMap.Strict qualified as HM +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as M +import Data.Text (Text) +import Data.Text qualified as T +import Data.Void (Void) +import Text.Megaparsec +import Text.Megaparsec.Char + +---------- Types + +newtype YarnLockfile = YarnLockfile (Map [Descriptor] PackageDescription) + deriving (Eq, Ord, Show) + +data Locator = Locator + { locatorScope :: Maybe Text + , locatorName :: Text + , locatorReference :: Text + } + deriving (Eq, Ord, Show) + +data Descriptor = Descriptor + { descriptorScope :: Maybe Text + , descriptorName :: Text + , descriptorRange :: Text + } + deriving (Eq, Ord, Show) + +data PackageDescription = PackageDescription + { descVersion :: Text + , descResolution :: Locator + , descDependencies :: [Descriptor] + } + deriving (Eq, Ord, Show) + +---------- Decoding from JSON + +-- | The yarn lockfile is a @Map [Descriptor] PackageDescription@ with one +-- additional top-level field: @__metadata@ +-- +-- To decode the lockfile, we kill the metadata field, and run parseJSON again +-- on the object +instance FromJSON YarnLockfile where + parseJSON = withObject "YarnLockfile" (fmap YarnLockfile . parseJSON . Object . HM.delete "__metadata") + +-- | See 'packageRefP'/'locatorP' below +instance FromJSON Locator where + parseJSON = withText "Locator" (tryParse locatorP) + +-- | See 'packageRefP'/'descriptorP' below +instance FromJSON Descriptor where + parseJSON = withText "Descriptor" (tryParse descriptorP) + +-- | Each key at the top level in a yarn lockfile is a comma-separated list of +-- descriptors, in string form. +-- +-- Fortunately, aeson provides a mechanism for us to represent this: +-- 'FromJSONKey', which is used in the 'FromJSON' instance for 'Map'. It allows +-- us to arbitrarily decode any type as a Map key (assuming an 'Ord' instance, +-- of course). +-- +-- See 'parsePackageKeys' for the implementation of the key parser +instance FromJSONKey Descriptor where + fromJSONKey = FromJSONKeyTextParser (tryParse descriptorP) + fromJSONKeyList = FromJSONKeyTextParser parsePackageKeys + +-- | A comma-separated list of descriptors +-- +-- See: https://github.com/yarnpkg/berry/blob/8afcaa2a954e196d6cd997f8ba506f776df83b1f/packages/yarnpkg-core/sources/Project.ts#L303 +parsePackageKeys :: MonadFail m => Text -> m [Descriptor] +parsePackageKeys = traverse (tryParse descriptorP) . splitTrim "," + +-- | 'Data.Text.splitOn', but trims surrounding whitespace from the results +splitTrim :: Text -> Text -> [Text] +splitTrim needle = map T.strip . T.splitOn needle + +instance FromJSON PackageDescription where + parseJSON = withObject "PackageDescription" $ \obj -> + PackageDescription + <$> obj .: "version" + <*> obj .: "resolution" + <*> (obj .:? "dependencies" .!= M.empty >>= parseDependencyDescriptors . M.map unTextLike) + +-- | Rather than storing dependencies as a flat list of Descriptors, the yarn +-- lockfile stores them as key/value pairs, split on the last "@" in a +-- descriptor. This is identical to how they'd be found in a @package.json@ +-- +-- We re-construct the raw descriptor by rejoining on "@" before running the parser +parseDependencyDescriptors :: MonadFail m => Map Text Text -> m [Descriptor] +parseDependencyDescriptors = traverse (\(name, range) -> tryParse descriptorP (name <> "@" <> range)) . M.toList + +---------- Text field Parsers + +type Parser = Parsec Void Text + +tryParse :: MonadFail m => Parser a -> Text -> m a +tryParse p = either (fail . errorBundlePretty) pure . runParser p "" + +-- | Locator and Descriptor fields are both parsed identically. +-- +-- From yarn's structUtils.tryParseDescriptor/tryParselocator (in strict mode): +-- +-- @ +-- string.match(/^(?:@([^/]+?)\/)?([^/]+?)(?:@(.+))$/) +-- @ +-- +-- ..with the three matched fields referring to: +-- - package scope +-- - package name +-- - package range (descriptor) or package reference (locator) +-- +-- See: https://github.com/yarnpkg/berry/blob/8afcaa2a954e196d6cd997f8ba506f776df83b1f/packages/yarnpkg-core/sources/structUtils.ts#L333-L425 +packageRefP :: Parser (Maybe Text, Text, Text) +packageRefP = do + scope <- optional $ char '@' *> segment "Scope" <* char '/' + package <- segment "Package" + _ <- char '@' + rest <- takeRest + pure (scope, package, rest) + where + segment :: String -> Parser Text + segment name = takeWhile1P (Just name) (\c -> c /= '/' && c /= '@') + +descriptorP :: Parser Descriptor +descriptorP = (\(scope, package, range) -> Descriptor scope package range) <$> packageRefP + +locatorP :: Parser Locator +locatorP = (\(scope, package, reference) -> Locator scope package reference) <$> packageRefP diff --git a/src/Strategy/Yarn/V2/Resolvers.hs b/src/Strategy/Yarn/V2/Resolvers.hs new file mode 100644 index 000000000..6a22d0ad1 --- /dev/null +++ b/src/Strategy/Yarn/V2/Resolvers.hs @@ -0,0 +1,281 @@ +-- | Yarn v2 has a handful of default protocols it supports through "Resolvers" +-- in bundled plugins. +-- +-- Protocol documentation can be found here: https://yarnpkg.com/features/protocols +-- +-- Confusingly, the package examples described on that page are /Descriptors/, +-- not Locators. As such, we don't care to support parsing all of these +-- examples: we only care to parse the Locators produced by the related +-- Resolvers +-- +-- See also: default plugins, many of which contain resolvers https://github.com/yarnpkg/berry/blob/8afcaa2a954e196d6cd997f8ba506f776df83b1f/packages/yarnpkg-cli/package.json#L68-L82 +module Strategy.Yarn.V2.Resolvers ( + -- * Primary exports + Resolver (..), + Package (..), + resolveLocatorToPackage, + + -- * Individual resolvers + workspaceResolver, + npmResolver, + gitResolver, + tarResolver, + fileResolver, + linkResolver, + execResolver, + portalResolver, + patchResolver, +) where + +import Control.Effect.Diagnostics +import Data.Foldable (find) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as M +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Extra (dropPrefix, showT) +import Data.Void (Void) +import Strategy.Yarn.V2.Lockfile +import Text.Megaparsec + +data Resolver = Resolver + { -- | Used for error messages + resolverName :: Text + , -- | Does this resolver support the locator? + resolverSupportsLocator :: Locator -> Bool + , -- | Convert this locator to a yarn package + resolverLocatorToPackage :: Locator -> Either Text Package + } + +data Package + = WorkspacePackage Text -- relative reference to a directory. not quite a Path Rel Dir because it may contain '..' + | NpmPackage (Maybe Text) Text Text -- scope, package, version + | GitPackage Text Text -- url, commit + | TarPackage Text -- url + | FilePackage Text + | LinkPackage Text + | PortalPackage Text + | ExecPackage Text + | PatchPackage Text + deriving (Eq, Ord, Show) + +---------- + +-- | Search for a resolver that supports the Locator, and turn it into a Package +resolveLocatorToPackage :: Has Diagnostics sig m => Locator -> m Package +resolveLocatorToPackage locator = context ("Resolving locator " <> showT locator) $ do + resolver <- + fromMaybe @Text "Unsupported locator (no resolver found)" $ + find (`resolverSupportsLocator` locator) allResolvers + + context ("Running resolver: " <> resolverName resolver) . fromEither $ + resolverLocatorToPackage resolver locator + +allResolvers :: [Resolver] +allResolvers = + [ workspaceResolver + , npmResolver + , gitResolver + , tarResolver + , fileResolver + , linkResolver + , execResolver + , portalResolver + , patchResolver + ] + +---------- WorkspaceResolver + +workspaceProtocol :: Text +workspaceProtocol = "workspace:" + +-- | Resolved workspace locators come in the form @workspace:./relative/reference/to/dir@ +-- +-- Relative references may contain '..', so they're not quite @Path Rel Dir@ +-- +-- See: https://github.com/yarnpkg/berry/blob/8afcaa2a954e196d6cd997f8ba506f776df83b1f/packages/yarnpkg-core/sources/WorkspaceResolver.ts +workspaceResolver :: Resolver +workspaceResolver = + Resolver + { resolverName = "WorkspaceResolver" + , resolverSupportsLocator = (workspaceProtocol `T.isPrefixOf`) . locatorReference + , resolverLocatorToPackage = + Right + . WorkspacePackage + . dropPrefix workspaceProtocol + . locatorReference + } + +---------- NpmResolver + +npmProtocol :: Text +npmProtocol = "npm:" + +-- | A resolver for packages that come from npm +-- +-- As a fun implementation detail, this resolver is split across several +-- "resolvers" in the yarn codebase -- though by the time locators are committed +-- to a yarn lockfile, they're always structured the same way +-- +-- ..with one caveat anyway. npm locators are allowed to contain `::selectors` +-- at the end. This is often used for a pinned archive URL from npm: +-- +-- @ +-- npm:8.0.0::__archiveUrl=https://.... +-- @ +-- +-- ..so when converting to a package, we drop anything after we find a colon. +-- +-- See: https://github.com/yarnpkg/berry/blob/8afcaa2a954e196d6cd997f8ba506f776df83b1f/packages/plugin-npm/tests/NpmSemverResolver.test.ts#L7 +-- See: https://github.com/yarnpkg/berry/blob/master/packages/plugin-npm/sources/NpmSemverResolver.ts#L26 +-- See: Npm*Resolver in the yarn codebase (and NpmSemverResolver in particular) +npmResolver :: Resolver +npmResolver = + Resolver + { resolverName = "NpmResolver" + , resolverSupportsLocator = (npmProtocol `T.isPrefixOf`) . locatorReference + , resolverLocatorToPackage = \loc -> + Right $ NpmPackage (locatorScope loc) (locatorName loc) (T.takeWhile (/= ':') (dropPrefix npmProtocol (locatorReference loc))) + } + +---------- GitResolver + +-- | The git resolver in yarn ALWAYS normalizes and resolves git references the same way: +-- +-- @ +-- URL#METADATA +-- +-- -- e.g. +-- +-- https://github.com/foo/bar.git#commit=$COMMITID +-- https://example.com/baz.git#branch=$BRANCH&commit=$COMMITID +-- @ +-- +-- The metadata (string after #) is a set of key/value pairs, separated by & +-- +-- We can always expect to find a commit key, so we use that for the package +-- +-- See: https://github.com/yarnpkg/berry/blob/master/packages/plugin-git/sources/GitResolver.ts +gitResolver :: Resolver +gitResolver = + Resolver + { resolverName = "GitResolver" + , resolverSupportsLocator = ("commit=" `T.isInfixOf`) . locatorReference + , resolverLocatorToPackage = gitResolverLocatorToPackage + } + +gitResolverLocatorToPackage :: Locator -> Either Text Package +gitResolverLocatorToPackage loc = do + (url, metadata) <- + tag ("Invalid git reference: " <> locatorReference loc) $ + splitSingle "#" (locatorReference loc) + + metaMap <- + tag ("Failed to parse git metadata: " <> metadata) $ + parseGitMetadata metadata + + commit <- + tag ("Couldn't find commit in git metadata: " <> showT metaMap) $ + M.lookup "commit" metaMap + + Right $ GitPackage url commit + +tag :: a -> Maybe b -> Either a b +tag a = maybe (Left a) Right + +-- | T.splitOn, but only expects to split once +splitSingle :: Text -> Text -> Maybe (Text, Text) +splitSingle needle txt = + case T.splitOn needle txt of + [a, b] -> pure (a, b) + _ -> Nothing + +-- | Parse a metadata string from a git yarn locator into a Map +-- +-- The metadata string is formatted as "key1=foo&key2=bar&key3=baz" +parseGitMetadata :: Text -> Maybe (Map Text Text) +parseGitMetadata = fmap M.fromList . traverse (splitSingle "=") . T.splitOn "&" + +---------- TarResolver + +type Parser = Parsec Void Text + +matchParser :: Parser a -> Text -> Bool +matchParser p = either (const False) (const True) . runParser p "" + +-- | For a locator to be a valid tar, it must match both of these regexes: +-- +-- @ +-- export const TARBALL_REGEXP = /^[^?]*\.(?:tar\.gz|tgz)(?:\?.*)?$/; +-- export const PROTOCOL_REGEXP = /^https?:/; +-- @ +tarMatchP :: Parser () +tarMatchP = do + _ <- chunk "https:" <|> chunk "http:" + lookForExtension + _ <- optional (single '?' *> takeRest) + eof + where + lookForExtension = do + _ <- takeWhileP Nothing (\c -> c /= '?' && c /= '.') + found <- optional $ chunk ".tar.gz" <|> chunk ".tgz" + case found of + -- if takeWhileP stopped at a '.', we can continue. '?' is still disallowed + Nothing -> single '.' *> lookForExtension + Just _ -> pure () + +-- | The tar resolver supports http/https URLs that point to a tarball (.tar.gz/.tgz) +-- +-- See: https://github.com/yarnpkg/berry/blob/master/packages/plugin-http/sources/TarballHttpResolver.ts +tarResolver :: Resolver +tarResolver = + Resolver + { resolverName = "TarResolver" + , resolverSupportsLocator = matchParser tarMatchP . locatorReference + , resolverLocatorToPackage = Right . TarPackage . locatorReference + } + +---------- Unsupported (by fossa) resolvers + +-- | The file resolver supports local "file:" references on disk +-- +-- Fossa cannot handle these, so we don't do any further parsing of the +-- resolution field +fileResolver :: Resolver +fileResolver = unsupportedResolver "FileResolver" "file:" FilePackage + +-- | The link resolver is similar to the file resolver +-- +-- Fossa cannot handle these, so we don't do any further parsing of the +-- resolution field +linkResolver :: Resolver +linkResolver = unsupportedResolver "LinkResolver" "link:" LinkPackage + +-- | The portal resolver is similar to the link resolver +-- +-- Fossa cannot handle these, so we don't do any further parsing of the +-- resolution field +portalResolver :: Resolver +portalResolver = unsupportedResolver "PortalResolver" "portal:" PortalPackage + +-- | The exec resolver allows you to point to a script to run; the output of the +-- script is used as a package +-- +-- Fossa cannot handle these, so we don't do any further parsing of the +-- resolution field +execResolver :: Resolver +execResolver = unsupportedResolver "ExecResolver" "exec:" ExecPackage + +-- | The patch resolver allows you to modify another package with patch files. +-- The packages appear elsewhere in the lockfile, so we don't do any further +-- processing of the resolution field +patchResolver :: Resolver +patchResolver = unsupportedResolver "PatchResolver" "patch:" PatchPackage + +unsupportedResolver :: Text -> Text -> (Text -> Package) -> Resolver +unsupportedResolver name protocol constructor = + Resolver + { resolverName = name + , resolverSupportsLocator = (protocol `T.isPrefixOf`) . locatorReference + , resolverLocatorToPackage = Right . constructor . dropPrefix protocol . locatorReference + } diff --git a/src/Strategy/Yarn/V2/YarnLock.hs b/src/Strategy/Yarn/V2/YarnLock.hs new file mode 100644 index 000000000..ee10be96e --- /dev/null +++ b/src/Strategy/Yarn/V2/YarnLock.hs @@ -0,0 +1,157 @@ +module Strategy.Yarn.V2.YarnLock ( + analyze, + stitchLockfile, + buildGraph, +) where + +import Algebra.Graph.AdjacencyMap qualified as AM +import Algebra.Graph.AdjacencyMap.Extra qualified as AME +import Control.Applicative ((<|>)) +import Control.Effect.Diagnostics +import Data.Foldable (find) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as M +import Data.Text qualified as T +import DepTypes +import Effect.ReadFS +import Graphing (Graphing) +import Graphing qualified +import Path +import Strategy.Yarn.V2.Lockfile +import Strategy.Yarn.V2.Resolvers + +analyze :: (Has ReadFS sig m, Has Diagnostics sig m) => Path b File -> m (Graphing Dependency) +analyze file = context "Lockfile V2 analysis" $ do + lockfile <- context "Reading lockfile" $ readContentsYaml @YarnLockfile file + stitched <- context "Validating lockfile" $ stitchLockfile lockfile + packageGraph <- context "Resolving yarn locators" $ AME.gtraverse resolveLocatorToPackage stitched + context "Building dependency graph" $ pure (buildGraph packageGraph) + +-- | Validate and stitch together a yarn lockfile into a graph of yarn Locators +-- +-- This ensures that all dependency relationships are valid +stitchLockfile :: Has Diagnostics sig m => YarnLockfile -> m (AM.AdjacencyMap Locator) +stitchLockfile (YarnLockfile lockfile) = graph + where + -- remapping @Map [Descriptor] PackageDescription@ to @Map Descriptor PackageDescription@ + remapped :: Map Descriptor PackageDescription + remapped = M.fromList . concatMap (\(ks, v) -> map (,v) ks) . M.toList $ lockfile + + -- look up a package by trying: + -- 1. the descriptor, verbatim + -- 2. the descriptor with its range prefixed by @npm:@ + -- 3. any other descriptor with a matching scope/name and an @npm:@ prefix to its range + -- + -- For (2), search for "defaultProtocol" in the Resolvers module or in the + -- yarnv2 devdocs for more context about why this is necessary + -- + -- For (3), yarn coalesces matching semver range subsets in descriptors for + -- npm dependencies. For example, given dependencies on @package: ^1.0.0@ + -- and @package: ^2.0.0@, only @package@npm:^2.0.0@ will appear as a + -- descriptor key for a package in the lockfile + lookupPackage :: Has Diagnostics sig m => Descriptor -> m PackageDescription + lookupPackage desc = + fromMaybeText ("Couldn't find package for descriptor: " <> T.pack (show desc)) $ + M.lookup desc remapped <|> M.lookup (desc{descriptorRange = "npm:" <> descriptorRange desc}) remapped <|> lookupAnyNpm desc + + -- find any package with a descriptor with matching scope/name, and an @npm:@ prefix prefix + lookupAnyNpm :: Descriptor -> Maybe PackageDescription + lookupAnyNpm desc = find (\other -> identMatches desc other && "npm:" `T.isPrefixOf` descriptorRange other) (M.keys remapped) >>= (`M.lookup` remapped) + + -- whether the scope and name of the package matches in both descriptors + identMatches :: Descriptor -> Descriptor -> Bool + identMatches one two = descriptorScope one == descriptorScope two && descriptorName one == descriptorName two + + -- look up all of a package's dependencies as locators in the lockfile + lookupPackageDeps :: Has Diagnostics sig m => PackageDescription -> m [Locator] + lookupPackageDeps = fmap (map descResolution) . traverse lookupPackage . descDependencies + + -- build the edges (adjacency list) between a package and its dependencies + packageToEdges :: Has Diagnostics sig m => PackageDescription -> m [(Locator, Locator)] + packageToEdges package = map (descResolution package,) <$> lookupPackageDeps package + + -- combine the edges produced by calling packageToEdges on each package in the lockfile + graphEdges :: Has Diagnostics sig m => m (AM.AdjacencyMap Locator) + graphEdges = fmap (AM.edges . concat) . traverse packageToEdges . M.elems $ lockfile + + -- not all packages will be part of an edge, so add vertices for each package + graphVertices :: AM.AdjacencyMap Locator + graphVertices = AM.vertices (map descResolution (M.elems lockfile)) + + -- combine edges and vertices into a final graph + graph :: Has Diagnostics sig m => m (AM.AdjacencyMap Locator) + graph = AM.overlay graphVertices <$> graphEdges + +-- | Turn a graph of packages into a dependency graph +-- +-- Because workspaces are top-level projects, we set their dependencies as +-- direct in the dependency graph +buildGraph :: AM.AdjacencyMap Package -> Graphing Dependency +buildGraph gr = convertedGraphing + where + isWorkspace WorkspacePackage{} = True + isWorkspace _ = False + + -- workspaces are the "direct" dependencies + directPackages :: [Package] + directPackages = filter isWorkspace (AM.vertexList gr) + + -- a Graphing containing only the direct deps + directGraphing :: Graphing Package + directGraphing = Graphing.fromList directPackages + -- a Graphing containing the full Package graph, but without any deps marked as direct + transitiveGraphing :: Graphing Package + transitiveGraphing = Graphing.fromAdjacencyMap gr + + -- combine direct and transitive graphs; eliminate workspaces by stripping + -- the root (the dependencies of the workspaces become direct dependencies) + completeGraphing :: Graphing Package + completeGraphing = Graphing.stripRoot $ directGraphing <> transitiveGraphing + + -- convert Packages in the graph to Dependencies + convertedGraphing :: Graphing Dependency + convertedGraphing = Graphing.induceJust . Graphing.gmap packageToDependency $ completeGraphing + +-- | Convert a yarn package to a fossa Dependency +-- +-- Dependency types that aren't supported return Nothing +packageToDependency :: Package -> Maybe Dependency +packageToDependency WorkspacePackage{} = Nothing +packageToDependency FilePackage{} = Nothing +packageToDependency LinkPackage{} = Nothing +packageToDependency PortalPackage{} = Nothing +packageToDependency ExecPackage{} = Nothing +packageToDependency PatchPackage{} = Nothing +packageToDependency (NpmPackage maybeScope name version) = + Just + Dependency + { dependencyType = NodeJSType + , dependencyName = + case maybeScope of + Nothing -> name + Just scope -> "@" <> scope <> "/" <> name + , dependencyVersion = Just (CEq version) + , dependencyLocations = [] + , dependencyTags = M.empty + , dependencyEnvironments = [] + } +packageToDependency (GitPackage repo commit) = + Just + Dependency + { dependencyType = GitType + , dependencyName = repo + , dependencyVersion = Just (CEq commit) + , dependencyLocations = [] + , dependencyTags = M.empty + , dependencyEnvironments = [] + } +packageToDependency (TarPackage url) = + Just + Dependency + { dependencyType = URLType + , dependencyName = url + , dependencyVersion = Nothing + , dependencyLocations = [] + , dependencyTags = M.empty + , dependencyEnvironments = [] + } diff --git a/test/Extra/TextSpec.hs b/test/Extra/TextSpec.hs index e3c90ab58..ddaefe61d 100644 --- a/test/Extra/TextSpec.hs +++ b/test/Extra/TextSpec.hs @@ -15,3 +15,12 @@ spec = do Test.describe "Text splitOnceonEnd" $ Test.it "should split a string once from the end" $ splitOnceOnEnd "-" "1-2-3" `Test.shouldBe` ("1-2", "3") + + Test.describe "Text dropPrefix" $ do + Test.it "should drop a prefix when present" $ do + dropPrefix "foo" "foobar" `Test.shouldBe` "bar" + dropPrefix "foo" "foofoobar" `Test.shouldBe` "foobar" + + Test.it "should leave the string unchanged when the prefix is missing" $ do + dropPrefix "foo" "bar" `Test.shouldBe` "bar" + dropPrefix "foo" "" `Test.shouldBe` "" diff --git a/test/Node/YarnLockSpec.hs b/test/Node/YarnLockSpec.hs deleted file mode 100644 index ddbb460d5..000000000 --- a/test/Node/YarnLockSpec.hs +++ /dev/null @@ -1,57 +0,0 @@ -module Node.YarnLockSpec - ( spec - ) where - -import qualified Data.Map.Strict as M -import Data.Text.Encoding -import DepTypes -import GraphUtil -import Strategy.Node.YarnLock -import qualified Data.ByteString as BS -import Test.Hspec -import qualified Yarn.Lock as YL - -packageOne :: Dependency -packageOne = Dependency - { dependencyType = NodeJSType - , dependencyName = "packageOne" - , dependencyVersion = Just (CEq "1.0.0") - , dependencyLocations = ["https://registry.npmjs.org/packageOne"] - , dependencyEnvironments = [] - , dependencyTags = M.empty - } - -packageTwo :: Dependency -packageTwo = Dependency - { dependencyType = NodeJSType - , dependencyName = "packageTwo" - , dependencyVersion = Just (CEq "2.0.0") - , dependencyLocations = ["https://registry.npmjs.org/packageTwo"] - , dependencyEnvironments = [] - , dependencyTags = M.empty - } - -packageThree :: Dependency -packageThree = Dependency - { dependencyType = NodeJSType - , dependencyName = "packageThree" - , dependencyVersion = Just (CEq "3.0.0") - , dependencyLocations = ["https://registry.npmjs.org/packageThree"] - , dependencyEnvironments = [] - , dependencyTags = M.empty - } - -spec :: Spec -spec = do - testFile <- runIO (BS.readFile "test/Node/testdata/yarn.lock") - describe "buildGraph" $ do - it "should produce expected output" $ do - case YL.parse "test/Node/testdata/yarn.lock" (decodeUtf8 testFile) of - Left _ -> expectationFailure "failed to parse" - Right lockfile -> do - let graph = buildGraph lockfile - expectDeps [packageOne, packageTwo, packageThree] graph - expectDirect [] graph - expectEdges [ (packageOne, packageTwo) - , (packageTwo, packageThree) - ] graph diff --git a/test/Yarn/V2/LockfileSpec.hs b/test/Yarn/V2/LockfileSpec.hs new file mode 100644 index 000000000..1b6b73673 --- /dev/null +++ b/test/Yarn/V2/LockfileSpec.hs @@ -0,0 +1,197 @@ +module Yarn.V2.LockfileSpec ( + spec, +) where + +import Algebra.Graph.AdjacencyMap qualified as AM +import Algebra.Graph.AdjacencyMap.Extra qualified as AME +import Control.Carrier.Diagnostics +import Data.Map.Strict qualified as M +import Data.Yaml (decodeFileThrow) +import DepTypes +import GraphUtil +import Strategy.Yarn.V2.Lockfile +import Strategy.Yarn.V2.Resolvers +import Strategy.Yarn.V2.YarnLock (buildGraph, stitchLockfile) +import Test.Hspec hiding (expectationFailure, shouldBe) +import Test.Hspec.Expectations.Pretty + +-- End-to-end test on the example project from the dev docs +spec :: Spec +spec = do + describe "YarnLockfile parser" $ do + it "should be able to parse the example from the dev docs" $ do + lockfile <- decodeFileThrow "test/Yarn/V2/testdata/yarn.lock" + lockfile `shouldBe` exampleLockfile + + describe "stitchLockfile" $ do + it "should work on the example from the dev docs" $ do + case run (runDiagnostics (stitchLockfile exampleLockfile)) of + Left err -> expectationFailure (show (renderFailureBundle err)) + Right stitched -> stitched `shouldBe` exampleStitched + + describe "resolveLocatorToPackage" $ do + it "should work on the example from the dev docs" $ do + case run (runDiagnostics (AME.gtraverse resolveLocatorToPackage exampleStitched)) of + Left err -> expectationFailure (show (renderFailureBundle err)) + Right graph -> graph `shouldBe` exampleResolved + + describe "buildGraph" $ do + it "should work on the example from the dev docs" $ do + let graph = buildGraph exampleResolved + expectDeps [underscoreFromGitDep, underscoreFromNpmDep] graph + expectDirect [underscoreFromGitDep, underscoreFromNpmDep] graph + expectEdges [] graph + +---------- Example: lockfile + +exampleLockfile :: YarnLockfile +exampleLockfile = + YarnLockfile $ + M.fromList + [ + ( [Descriptor Nothing "toplevel" "workspace:."] + , PackageDescription + { descVersion = "0.0.0-use.local" + , descResolution = Locator Nothing "toplevel" "workspace:." + , descDependencies = [] + } + ) + , + ( [Descriptor Nothing "foo" "workspace:foo"] + , PackageDescription + { descVersion = "0.0.0-use.local" + , descResolution = Locator Nothing "foo" "workspace:foo" + , descDependencies = + [ Descriptor Nothing "underscore" "^1.13.0" + ] + } + ) + , + ( [Descriptor Nothing "bar" "workspace:bar"] + , PackageDescription + { descVersion = "0.0.0-use.local" + , descResolution = Locator Nothing "bar" "workspace:bar" + , descDependencies = + [ Descriptor Nothing "underscore" "1.13.1" + ] + } + ) + , + ( [Descriptor Nothing "quux" "workspace:quux"] + , PackageDescription + { descVersion = "0.0.0-use.local" + , descResolution = Locator Nothing "quux" "workspace:quux" + , descDependencies = + [ Descriptor Nothing "underscore" "jashkenas/underscore#tag=1.13.1" + ] + } + ) + , + ( [Descriptor Nothing "underscore" "jashkenas/underscore#tag=1.13.1"] + , PackageDescription + { descVersion = "1.13.1" + , descResolution = Locator Nothing "underscore" "https://github.com/jashkenas/underscore.git#commit=cbb48b79fc1205aa04feb03dbc055cdd28a12652" + , descDependencies = [] + } + ) + , + ( [Descriptor Nothing "underscore" "npm:1.13.1", Descriptor Nothing "underscore" "npm:^1.13.0"] + , PackageDescription + { descVersion = "1.13.1" + , descResolution = Locator Nothing "underscore" "npm:1.13.1" + , descDependencies = [] + } + ) + ] + +---------- Example: stitched lockfile + +exampleStitched :: AM.AdjacencyMap Locator +exampleStitched = + AM.overlays + [ AM.vertex toplevelWorkspaceL + , AM.vertex fooWorkspaceL + , AM.vertex barWorkspaceL + , AM.vertex quuxWorkspaceL + , AM.vertex underscoreFromGitL + , AM.vertex underscoreFromNpmL + , AM.edge fooWorkspaceL underscoreFromNpmL + , AM.edge barWorkspaceL underscoreFromNpmL + , AM.edge quuxWorkspaceL underscoreFromGitL + ] + +toplevelWorkspaceL :: Locator +toplevelWorkspaceL = Locator Nothing "toplevel" "workspace:." + +fooWorkspaceL :: Locator +fooWorkspaceL = Locator Nothing "foo" "workspace:foo" + +barWorkspaceL :: Locator +barWorkspaceL = Locator Nothing "bar" "workspace:bar" + +quuxWorkspaceL :: Locator +quuxWorkspaceL = Locator Nothing "quux" "workspace:quux" + +underscoreFromGitL :: Locator +underscoreFromGitL = Locator Nothing "underscore" "https://github.com/jashkenas/underscore.git#commit=cbb48b79fc1205aa04feb03dbc055cdd28a12652" + +underscoreFromNpmL :: Locator +underscoreFromNpmL = Locator Nothing "underscore" "npm:1.13.1" + +---------- Example: resolved lockfile + +exampleResolved :: AM.AdjacencyMap Package +exampleResolved = + AM.overlays + [ AM.vertex toplevelWorkspace + , AM.vertex fooWorkspace + , AM.vertex barWorkspace + , AM.vertex quuxWorkspace + , AM.vertex underscoreFromGit + , AM.vertex underscoreFromNpm + , AM.edge fooWorkspace underscoreFromNpm + , AM.edge barWorkspace underscoreFromNpm + , AM.edge quuxWorkspace underscoreFromGit + ] + +toplevelWorkspace :: Package +toplevelWorkspace = WorkspacePackage "." + +fooWorkspace :: Package +fooWorkspace = WorkspacePackage "foo" + +barWorkspace :: Package +barWorkspace = WorkspacePackage "bar" + +quuxWorkspace :: Package +quuxWorkspace = WorkspacePackage "quux" + +underscoreFromGit :: Package +underscoreFromGit = GitPackage "https://github.com/jashkenas/underscore.git" "cbb48b79fc1205aa04feb03dbc055cdd28a12652" + +underscoreFromNpm :: Package +underscoreFromNpm = NpmPackage Nothing "underscore" "1.13.1" + +---------- Example: built graph + +underscoreFromGitDep :: Dependency +underscoreFromGitDep = + Dependency + { dependencyType = GitType + , dependencyName = "https://github.com/jashkenas/underscore.git" + , dependencyVersion = Just (CEq "cbb48b79fc1205aa04feb03dbc055cdd28a12652") + , dependencyEnvironments = [] + , dependencyLocations = [] + , dependencyTags = M.empty + } + +underscoreFromNpmDep :: Dependency +underscoreFromNpmDep = + Dependency + { dependencyType = NodeJSType + , dependencyName = "underscore" + , dependencyVersion = Just (CEq "1.13.1") + , dependencyEnvironments = [] + , dependencyLocations = [] + , dependencyTags = M.empty + } diff --git a/test/Yarn/V2/ResolversSpec.hs b/test/Yarn/V2/ResolversSpec.hs new file mode 100644 index 000000000..ec1532f99 --- /dev/null +++ b/test/Yarn/V2/ResolversSpec.hs @@ -0,0 +1,76 @@ +module Yarn.V2.ResolversSpec ( + spec, +) where + +import Data.Foldable (for_) +import Data.Text +import Data.Text qualified as T +import Strategy.Yarn.V2.Lockfile +import Strategy.Yarn.V2.Resolvers +import Test.Hspec + +spec :: Spec +spec = do + testResolver + workspaceResolver + [ (Locator Nothing "unused" "workspace:.", WorkspacePackage ".") + , (Locator Nothing "unused" "workspace:bar", WorkspacePackage "bar") + , (Locator Nothing "unused" "workspace:../baz", WorkspacePackage "../baz") + ] + + testResolver + npmResolver + [ -- without a scope + (Locator Nothing "packagename" "npm:1.0.0", NpmPackage Nothing "packagename" "1.0.0") + , -- with a scope + (Locator (Just "withscope") "packagename" "npm:1.0.0", NpmPackage (Just "withscope") "packagename" "1.0.0") + ] + + testResolver + gitResolver + [ (Locator Nothing "unused" "https://example.com/foo.git#commit=abcdef", GitPackage "https://example.com/foo.git" "abcdef") + , -- a case where there are several keys after # + (Locator Nothing "unused" "https://example.com/foo.git#branch=something&commit=abcdef&otherkey=somethingelse", GitPackage "https://example.com/foo.git" "abcdef") + ] + + testResolver + tarResolver + [ -- https url, .tar.gz + (Locator Nothing "unused" "https://link.to/tarball.tar.gz", TarPackage "https://link.to/tarball.tar.gz") + , -- http url, .tgz + (Locator Nothing "unused" "http://link.to/tarball.tar.gz", TarPackage "http://link.to/tarball.tar.gz") + , -- https url, .tgz + (Locator Nothing "unused" "https://link.to/tarball.tgz", TarPackage "https://link.to/tarball.tgz") + , -- awkward input + (Locator Nothing "unused" "https://link.to/tarball..tgz?foo=bar", TarPackage "https://link.to/tarball..tgz?foo=bar") + ] + + testUnsupportedResolver fileResolver "file:" FilePackage + testUnsupportedResolver linkResolver "link:" LinkPackage + testUnsupportedResolver portalResolver "portal:" PortalPackage + testUnsupportedResolver execResolver "exec:" ExecPackage + testUnsupportedResolver patchResolver "patch:" PatchPackage + +testResolver :: + Resolver -> + -- | A list of (locator, expected package resolution) pairs + [(Locator, Package)] -> + Spec +testResolver resolver supported = + describe (T.unpack (resolverName resolver)) $ do + it "Should work for supported locators" $ do + for_ supported $ \(locator, result) -> do + resolverSupportsLocator resolver locator `shouldBe` True + resolverLocatorToPackage resolver locator `shouldBe` Right result + +testUnsupportedResolver :: + Resolver -> + -- | Protocol prefix + Text -> + -- | Constructor for packages + (Text -> Package) -> + Spec +testUnsupportedResolver resolver protocol constructor = + testResolver + resolver + [(Locator Nothing "unused" (protocol <> "somepackage"), constructor "somepackage")] diff --git a/test/Yarn/V2/testdata/yarn.lock b/test/Yarn/V2/testdata/yarn.lock new file mode 100644 index 000000000..2edf5c165 --- /dev/null +++ b/test/Yarn/V2/testdata/yarn.lock @@ -0,0 +1,47 @@ +__metadata: + version: 4 + cacheKey: 7 + +"bar@workspace:bar": + version: 0.0.0-use.local + resolution: "bar@workspace:bar" + dependencies: + underscore: 1.13.1 + languageName: unknown + linkType: soft + +"foo@workspace:foo": + version: 0.0.0-use.local + resolution: "foo@workspace:foo" + dependencies: + underscore: ^1.13.0 + languageName: unknown + linkType: soft + +"quux@workspace:quux": + version: 0.0.0-use.local + resolution: "quux@workspace:quux" + dependencies: + underscore: "jashkenas/underscore#tag=1.13.1" + languageName: unknown + linkType: soft + +"toplevel@workspace:.": + version: 0.0.0-use.local + resolution: "toplevel@workspace:." + languageName: unknown + linkType: soft + +"underscore@jashkenas/underscore#tag=1.13.1": + version: 1.13.1 + resolution: "underscore@https://github.com/jashkenas/underscore.git#commit=cbb48b79fc1205aa04feb03dbc055cdd28a12652" + checksum: 560609fdb4ba2c30e79db95ea37269982d1a2788d49b78f0de4f391da711bc2495d5fbddd6d24e7716fccf69959e445916af83eb5de1ad137b215777e2d32e4d + languageName: node + linkType: hard + +"underscore@npm:1.13.1, underscore@npm:^1.13.0": + version: 1.13.1 + resolution: "underscore@npm:1.13.1" + checksum: 19527b2db3d34f783c3f2db9716a2c1221fef2958866925545697c46f430f59d1b384b8105cc7e7c809bdf0dc9075f2bfff90b8fb270b9d3a6c58347de2dd79d + languageName: node + linkType: hard diff --git a/test/Yarn/YarnLockV1Spec.hs b/test/Yarn/YarnLockV1Spec.hs new file mode 100644 index 000000000..a12025318 --- /dev/null +++ b/test/Yarn/YarnLockV1Spec.hs @@ -0,0 +1,62 @@ +module Yarn.YarnLockV1Spec ( + spec, +) where + +import Data.ByteString qualified as BS +import Data.Map.Strict qualified as M +import Data.Text.Encoding +import DepTypes +import GraphUtil +import Strategy.Yarn.V1.YarnLock +import Test.Hspec +import Yarn.Lock qualified as YL + +packageOne :: Dependency +packageOne = + Dependency + { dependencyType = NodeJSType + , dependencyName = "packageOne" + , dependencyVersion = Just (CEq "1.0.0") + , dependencyLocations = ["https://registry.npmjs.org/packageOne"] + , dependencyEnvironments = [] + , dependencyTags = M.empty + } + +packageTwo :: Dependency +packageTwo = + Dependency + { dependencyType = NodeJSType + , dependencyName = "packageTwo" + , dependencyVersion = Just (CEq "2.0.0") + , dependencyLocations = ["https://registry.npmjs.org/packageTwo"] + , dependencyEnvironments = [] + , dependencyTags = M.empty + } + +packageThree :: Dependency +packageThree = + Dependency + { dependencyType = NodeJSType + , dependencyName = "packageThree" + , dependencyVersion = Just (CEq "3.0.0") + , dependencyLocations = ["https://registry.npmjs.org/packageThree"] + , dependencyEnvironments = [] + , dependencyTags = M.empty + } + +spec :: Spec +spec = do + testFile <- runIO (BS.readFile "test/Yarn/testdata/yarn.lock") + describe "buildGraph" $ do + it "should produce expected output" $ do + case YL.parse "test/Yarn/testdata/yarn.lock" (decodeUtf8 testFile) of + Left _ -> expectationFailure "failed to parse" + Right lockfile -> do + let graph = buildGraph lockfile + expectDeps [packageOne, packageTwo, packageThree] graph + expectDirect [] graph + expectEdges + [ (packageOne, packageTwo) + , (packageTwo, packageThree) + ] + graph diff --git a/test/Node/testdata/yarn.lock b/test/Yarn/testdata/yarn.lock similarity index 100% rename from test/Node/testdata/yarn.lock rename to test/Yarn/testdata/yarn.lock