From fb30717e70952d086665736a17764269c195a663 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Wed, 3 Aug 2022 18:30:20 +0200 Subject: [PATCH 01/11] Add check for upper bound on any package fixes https://github.com/haskell/cabal/issues/8291 presumably this will make it nag at anyone for forgetting to add upper bounds to their packages. add changelog (presumably) --- .../Distribution/PackageDescription/Check.hs | 60 +++++++++---------- changelog.d/pr-8339 | 4 ++ 2 files changed, 33 insertions(+), 31 deletions(-) create mode 100644 changelog.d/pr-8339 diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 198ee83658a..221edb890f6 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -227,6 +227,7 @@ data CheckExplanation = | UnknownArch [String] | UnknownCompiler [String] | BaseNoUpperBounds + | MissingUpperBounds PackageName | SuspiciousFlagName [String] | DeclaredUsedFlags (Set FlagName) (Set FlagName) | NonASCIICustomField [String] @@ -669,6 +670,9 @@ ppExplanation (UnknownArch unknownArches) = "Unknown architecture name " ++ commaSep (map quote unknownArches) ppExplanation (UnknownCompiler unknownImpls) = "Unknown compiler name " ++ commaSep (map quote unknownImpls) +ppExplanation (MissingUpperBounds pname) = + "'" ++ unPackageName pname ++ "' misses upper bounds, add them" + ++ " with `cabal gen-bounds`." ppExplanation BaseNoUpperBounds = "The dependency 'build-depends: base' does not specify an upper " ++ "bound on the version number. Each major release of the 'base' " @@ -1813,30 +1817,19 @@ checkCabalVersion pkg = -- | Check the build-depends fields for any weirdness or bad practice. -- checkPackageVersions :: GenericPackageDescription -> [PackageCheck] -checkPackageVersions pkg = - catMaybes [ - - -- Check that the version of base is bounded above. - -- For example this bans "build-depends: base >= 3". - -- It should probably be "build-depends: base >= 3 && < 4" - -- which is the same as "build-depends: base == 3.*" - check (not (hasUpperBound baseDependency)) $ - PackageDistInexcusable BaseNoUpperBounds - - ] +checkPackageVersions pkg = do + (name, vr) <- Map.toList deps + -- Check that the version of base is bounded above. + -- For example this bans "build-depends: base >= 3". + -- It should probably be "build-depends: base >= 3 && < 4" + -- which is the same as "build-depends: base == 3.*" + maybe [] pure $ check (not (hasUpperBound vr)) $ + if unPackageName name == "base" then + PackageDistInexcusable BaseNoUpperBounds + else + PackageDistSuspiciousWarn $ MissingUpperBounds name where - baseDependency = case typicalPkg pkg of - Right (pkg', _) | not (null baseDeps) -> - foldr intersectVersionRanges anyVersion baseDeps - where - baseDeps = - [ vr | Dependency pname vr _ <- allBuildDepends pkg' - , pname == mkPackageName "base" ] - - -- Just in case finalizePD fails for any reason, - -- or if the package doesn't depend on the base package at all, - -- then we will just skip the check, since hasUpperBound noVersion = True - _ -> noVersion + deps = toDependencyVersionsMap allBuildDepends pkg checkConditionals :: GenericPackageDescription -> [PackageCheck] checkConditionals pkg = @@ -2398,6 +2391,18 @@ checkGlobFiles verbosity pkg root = getWarning field glob (GlobMissingDirectory dir) = [ PackageDistSuspiciousWarn (GlobNoDir field glob dir) ] +toDependencyVersionsMap :: (PackageDescription -> [Dependency]) -> GenericPackageDescription -> Map PackageName VersionRange +toDependencyVersionsMap lens pkg = case typicalPkg pkg of + Right (pkgs', _) -> + Map.fromListWith intersectVersionRanges + [ (pname, vr) + | Dependency pname vr _ <- lens pkgs' + ] + -- Just in case finalizePD fails for any reason, + -- or if the package doesn't depend on the base package at all, + -- no deps is no checks. + _ -> Map.empty + -- | Check that setup dependencies, have proper bounds. -- In particular, @base@ and @Cabal@ upper bounds are mandatory. checkSetupVersions :: GenericPackageDescription -> [PackageCheck] @@ -2410,14 +2415,7 @@ checkSetupVersions pkg = ] where criticalPkgs = ["Cabal", "base"] - deps = case typicalPkg pkg of - Right (pkgs', _) -> - Map.fromListWith intersectVersionRanges - [ (pname, vr) - | sbi <- maybeToList $ setupBuildInfo pkgs' - , Dependency pname vr _ <- setupDepends sbi - ] - _ -> Map.empty + deps = toDependencyVersionsMap ((=<<) setupDepends . maybeToList . setupBuildInfo) pkg emitError nm = PackageDistInexcusable (UpperBoundSetup nm) diff --git a/changelog.d/pr-8339 b/changelog.d/pr-8339 new file mode 100644 index 00000000000..1e602c1e985 --- /dev/null +++ b/changelog.d/pr-8339 @@ -0,0 +1,4 @@ +synopsis: Add check for upper bound on any dependency in cabal check +report, list, init, fetch, info, upload, get. +prs: #8339 +issues: #8291 From ea851dc28cb5290f4e03061f168c6c8142261fc9 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Wed, 3 Aug 2022 21:50:21 +0200 Subject: [PATCH 02/11] wait what? --- .../tests/ParserTests/regressions/public-multilib-1.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal-tests/tests/ParserTests/regressions/public-multilib-1.cabal b/Cabal-tests/tests/ParserTests/regressions/public-multilib-1.cabal index ba10ba6ea73..b11b8fcdbe6 100644 --- a/Cabal-tests/tests/ParserTests/regressions/public-multilib-1.cabal +++ b/Cabal-tests/tests/ParserTests/regressions/public-multilib-1.cabal @@ -7,7 +7,7 @@ license: MIT library default-language: Haskell2010 - build-depends: base ^>=4.14, internal + build-depends: base ^>=4.14, internal ^=0 exposed-modules: Foo library internal From 755470fe566d7245340b481af0a0975737530a95 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Thu, 4 Aug 2022 20:27:46 +0200 Subject: [PATCH 03/11] move toDependencyVersionsMap to utils section --- .../Distribution/PackageDescription/Check.hs | 25 ++++++++++--------- 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 221edb890f6..26602f49076 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -2391,18 +2391,6 @@ checkGlobFiles verbosity pkg root = getWarning field glob (GlobMissingDirectory dir) = [ PackageDistSuspiciousWarn (GlobNoDir field glob dir) ] -toDependencyVersionsMap :: (PackageDescription -> [Dependency]) -> GenericPackageDescription -> Map PackageName VersionRange -toDependencyVersionsMap lens pkg = case typicalPkg pkg of - Right (pkgs', _) -> - Map.fromListWith intersectVersionRanges - [ (pname, vr) - | Dependency pname vr _ <- lens pkgs' - ] - -- Just in case finalizePD fails for any reason, - -- or if the package doesn't depend on the base package at all, - -- no deps is no checks. - _ -> Map.empty - -- | Check that setup dependencies, have proper bounds. -- In particular, @base@ and @Cabal@ upper bounds are mandatory. checkSetupVersions :: GenericPackageDescription -> [PackageCheck] @@ -2454,6 +2442,19 @@ checkDuplicateModules pkg = -- * Utils -- ------------------------------------------------------------ +toDependencyVersionsMap :: (PackageDescription -> [Dependency]) -> GenericPackageDescription -> Map PackageName VersionRange +toDependencyVersionsMap lens pkg = case typicalPkg pkg of + Right (pkgs', _) -> + Map.fromListWith intersectVersionRanges + [ (pname, vr) + | Dependency pname vr _ <- lens pkgs' + ] + -- Just in case finalizePD fails for any reason, + -- or if the package doesn't depend on the base package at all, + -- no deps is no checks. + _ -> Map.empty + + quote :: String -> String quote s = "'" ++ s ++ "'" From b8a9ad31646f496f2948b2e4e52530b52fd59b5a Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Thu, 4 Aug 2022 21:01:03 +0200 Subject: [PATCH 04/11] add nicer error message --- .../Distribution/PackageDescription/Check.hs | 32 ++++++++++--------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 26602f49076..ba55417acee 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -227,7 +227,7 @@ data CheckExplanation = | UnknownArch [String] | UnknownCompiler [String] | BaseNoUpperBounds - | MissingUpperBounds PackageName + | MissingUpperBounds [PackageName] | SuspiciousFlagName [String] | DeclaredUsedFlags (Set FlagName) (Set FlagName) | NonASCIICustomField [String] @@ -670,9 +670,12 @@ ppExplanation (UnknownArch unknownArches) = "Unknown architecture name " ++ commaSep (map quote unknownArches) ppExplanation (UnknownCompiler unknownImpls) = "Unknown compiler name " ++ commaSep (map quote unknownImpls) -ppExplanation (MissingUpperBounds pname) = - "'" ++ unPackageName pname ++ "' misses upper bounds, add them" - ++ " with `cabal gen-bounds`." +ppExplanation (MissingUpperBounds names) = + "These packages miss upper bounds '" + ++ (intercalate "','" (unPackageName <$> names)) ++ "'" + ++ " please add them with with `cabal gen-bounds`." + ++ " For more information see: " + ++ " https://www.parsonsmatt.org/2020/05/07/on_pvp_restrictive_bounds.html" ppExplanation BaseNoUpperBounds = "The dependency 'build-depends: base' does not specify an upper " ++ "bound on the version number. Each major release of the 'base' " @@ -1817,19 +1820,18 @@ checkCabalVersion pkg = -- | Check the build-depends fields for any weirdness or bad practice. -- checkPackageVersions :: GenericPackageDescription -> [PackageCheck] -checkPackageVersions pkg = do - (name, vr) <- Map.toList deps - -- Check that the version of base is bounded above. - -- For example this bans "build-depends: base >= 3". - -- It should probably be "build-depends: base >= 3 && < 4" - -- which is the same as "build-depends: base == 3.*" - maybe [] pure $ check (not (hasUpperBound vr)) $ - if unPackageName name == "base" then - PackageDistInexcusable BaseNoUpperBounds - else - PackageDistSuspiciousWarn $ MissingUpperBounds name +checkPackageVersions pkg = + PackageDistSuspiciousWarn (MissingUpperBounds others) : + (PackageDistInexcusable BaseNoUpperBounds <$ bases) where deps = toDependencyVersionsMap allBuildDepends pkg + (bases, others) = partition (("base" ==) . unPackageName) $ do + (name, vr) <- Map.toList deps + -- Check that the version of base is bounded above. + -- For example this bans "build-depends: base >= 3". + -- It should probably be "build-depends: base >= 3 && < 4" + -- which is the same as "build-depends: base == 3.*" + if (not (hasUpperBound vr)) then pure name else [] checkConditionals :: GenericPackageDescription -> [PackageCheck] checkConditionals pkg = From 969743a733d7221a0f620a69dd7b524348be14aa Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Thu, 4 Aug 2022 21:07:39 +0200 Subject: [PATCH 05/11] simplify checking logic, add more comments --- Cabal/src/Distribution/PackageDescription/Check.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index ba55417acee..e53caec1e5d 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -1825,13 +1825,14 @@ checkPackageVersions pkg = (PackageDistInexcusable BaseNoUpperBounds <$ bases) where deps = toDependencyVersionsMap allBuildDepends pkg + -- base gets special treatment (it's more critical) (bases, others) = partition (("base" ==) . unPackageName) $ do (name, vr) <- Map.toList deps - -- Check that the version of base is bounded above. + -- Check that the version of a package is bounded above. -- For example this bans "build-depends: base >= 3". -- It should probably be "build-depends: base >= 3 && < 4" -- which is the same as "build-depends: base == 3.*" - if (not (hasUpperBound vr)) then pure name else [] + if hasUpperBound vr then [] else pure name -- emit for the error checkConditionals :: GenericPackageDescription -> [PackageCheck] checkConditionals pkg = From 4925aa72e96cf7784a20282db78fb424878d1446 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Thu, 4 Aug 2022 21:13:13 +0200 Subject: [PATCH 06/11] only emit missing upper bounds if bigger then one --- Cabal/src/Distribution/PackageDescription/Check.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index e53caec1e5d..83d5f2c7f47 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -1821,9 +1821,13 @@ checkCabalVersion pkg = -- checkPackageVersions :: GenericPackageDescription -> [PackageCheck] checkPackageVersions pkg = - PackageDistSuspiciousWarn (MissingUpperBounds others) : - (PackageDistInexcusable BaseNoUpperBounds <$ bases) + if length others > 0 + then + PackageDistSuspiciousWarn (MissingUpperBounds others) : baseErrors + else + baseErrors where + baseErrors = (PackageDistInexcusable BaseNoUpperBounds <$ bases) deps = toDependencyVersionsMap allBuildDepends pkg -- base gets special treatment (it's more critical) (bases, others) = partition (("base" ==) . unPackageName) $ do From d267e4246af89e3842cecf6ec6d5db517e30bb0e Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Wed, 10 Aug 2022 14:30:34 +0200 Subject: [PATCH 07/11] don't add bound to internal libraries --- .../tests/ParserTests/regressions/public-multilib-1.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal-tests/tests/ParserTests/regressions/public-multilib-1.cabal b/Cabal-tests/tests/ParserTests/regressions/public-multilib-1.cabal index b11b8fcdbe6..ba10ba6ea73 100644 --- a/Cabal-tests/tests/ParserTests/regressions/public-multilib-1.cabal +++ b/Cabal-tests/tests/ParserTests/regressions/public-multilib-1.cabal @@ -7,7 +7,7 @@ license: MIT library default-language: Haskell2010 - build-depends: base ^>=4.14, internal ^=0 + build-depends: base ^>=4.14, internal exposed-modules: Foo library internal From 032172abb5717c0cc9afab73f1434eb5b72c4738 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Wed, 10 Aug 2022 15:30:15 +0200 Subject: [PATCH 08/11] filter out self from the dependency map --- .../src/Distribution/PackageDescription/Check.hs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 83d5f2c7f47..643af5e6b4e 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -2450,12 +2450,17 @@ checkDuplicateModules pkg = -- ------------------------------------------------------------ toDependencyVersionsMap :: (PackageDescription -> [Dependency]) -> GenericPackageDescription -> Map PackageName VersionRange -toDependencyVersionsMap lens pkg = case typicalPkg pkg of +toDependencyVersionsMap selectDependencies pkg = case typicalPkg pkg of Right (pkgs', _) -> - Map.fromListWith intersectVersionRanges - [ (pname, vr) - | Dependency pname vr _ <- lens pkgs' - ] + let + self :: PackageName + self = pkgName $ package pkgs' + in + Map.fromListWith intersectVersionRanges $ do + Dependency pname vr _ <- selectDependencies pkgs' + if pname == self then + [] + else [(pname, vr)] -- Just in case finalizePD fails for any reason, -- or if the package doesn't depend on the base package at all, -- no deps is no checks. From a4e67ee95256cd883dd619df4818cfbeaf1e1b47 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Wed, 10 Aug 2022 16:59:19 +0200 Subject: [PATCH 09/11] I think this is an external library so it needs an upper bound now? --- .../tests/ParserTests/regressions/public-multilib-2.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal b/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal index fe0d60a561c..13d6c72f2de 100644 --- a/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal +++ b/Cabal-tests/tests/ParserTests/regressions/public-multilib-2.cabal @@ -9,6 +9,6 @@ library default-language: Haskell2010 build-depends: , base ^>=4.14 - , somelib:internal + , somelib:internal ^>=1.0 exposed-modules: Foo From d19f1caccb37aa603e71fb3565495b5a80f78d0a Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Wed, 10 Aug 2022 17:02:08 +0200 Subject: [PATCH 10/11] add test for multilib --- Cabal-tests/tests/CheckTests.hs | 1 + .../regressions/public-multilib-3.cabal | 14 ++++++++++++++ .../regressions/public-multilib-3.check | 3 +++ 3 files changed, 18 insertions(+) create mode 100644 Cabal-tests/tests/ParserTests/regressions/public-multilib-3.cabal create mode 100644 Cabal-tests/tests/ParserTests/regressions/public-multilib-3.check diff --git a/Cabal-tests/tests/CheckTests.hs b/Cabal-tests/tests/CheckTests.hs index b9b5d6d94f2..01370fc2395 100644 --- a/Cabal-tests/tests/CheckTests.hs +++ b/Cabal-tests/tests/CheckTests.hs @@ -45,6 +45,7 @@ checkTests = testGroup "regressions" , checkTest "assoc-cpp-options.cabal" , checkTest "public-multilib-1.cabal" , checkTest "public-multilib-2.cabal" + , checkTest "public-multilib-3.cabal" , checkTest "issue-6288-a.cabal" , checkTest "issue-6288-b.cabal" , checkTest "issue-6288-c.cabal" diff --git a/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.cabal b/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.cabal new file mode 100644 index 00000000000..cde78b61b52 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.cabal @@ -0,0 +1,14 @@ +cabal-version: 3.0 +name: public-multilib3 +version: 0 +synopsis: public-multilibs +category: Tests +license: MIT + +library + default-language: Haskell2010 + build-depends: + , base ^>=4.14 + , somelib + + exposed-modules: Foo diff --git a/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.check b/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.check new file mode 100644 index 00000000000..7707ab0eab6 --- /dev/null +++ b/Cabal-tests/tests/ParserTests/regressions/public-multilib-3.check @@ -0,0 +1,3 @@ +No 'maintainer' field. +No 'description' field. +These packages miss upper bounds 'somelib' please add them with with `cabal gen-bounds`. For more information see: https://www.parsonsmatt.org/2020/05/07/on_pvp_restrictive_bounds.html From d408e91ee8fe06b2e41621fbd38592f0a6c67ea8 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Wed, 10 Aug 2022 19:26:20 +0200 Subject: [PATCH 11/11] fix test suite by ignoring the warning ... probably not the best approach --- .../tests/UnitTests/Distribution/Solver/Modular/DSL.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 157f5c3cc2f..e29e3223f3f 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -478,7 +478,7 @@ exAvSrcPkg ex = -- solver allows unknown extensions/languages when the compiler -- supports them. let checks = C.checkPackage (srcpkgDescription package) Nothing - in filter (not . isUnknownLangExt) checks + in filter (not . isMissingUpperBound) $ filter (not . isUnknownLangExt) checks in if null pkgCheckErrors then package else error $ "invalid GenericPackageDescription for package " @@ -671,6 +671,10 @@ exAvSrcPkg ex = C.UnknownExtensions {} -> True C.UnknownLanguages {} -> True _ -> False + isMissingUpperBound :: C.PackageCheck -> Bool + isMissingUpperBound pc = case C.explanation pc of + C.MissingUpperBounds {} -> True + _ -> False mkSimpleVersion :: ExamplePkgVersion -> C.Version