Merge pull request haskell#10629 from cabalism/fix/project-untrimmed-url

Have projects import trimmed URIs

Author: mergify[bot]

Cabal/src/Distribution/Simple/Configure.hs

@@ -114,6 +114,7 @@ import Distribution.Types.MissingDependencyReason (MissingDependencyReason (..))
 import Distribution.Types.PackageVersionConstraint
 import Distribution.Utils.LogProgress
 import Distribution.Utils.NubList
+import Distribution.Utils.String (trim)
 import Distribution.Verbosity
 import Distribution.Version
 
@@ -2397,7 +2398,6 @@ configurePkgconfigPackages verbosity pkg_descr progdb enabled
         pkgconfig ["--modversion", pkg]
           `catchIO` (\_ -> dieWithException verbosity $ PkgConfigNotFound pkg versionRequirement)
           `catchExit` (\_ -> dieWithException verbosity $ PkgConfigNotFound pkg versionRequirement)
-      let trim = dropWhile isSpace . dropWhileEnd isSpace
       let v = PkgconfigVersion (toUTF8BS $ trim version)
       if not (withinPkgconfigVersionRange v range)
         then dieWithException verbosity $ BadVersion pkg versionRequirement v

cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs

@@ -14,11 +14,13 @@ module Distribution.Solver.Types.ProjectConfigPath
     , docProjectConfigPath
     , docProjectConfigFiles
     , cyclicalImportMsg
+    , untrimmedUriImportMsg
     , docProjectConfigPathFailReason
 
     -- * Checks and Normalization
     , isCyclicConfigPath
     , isTopLevelConfigPath
+    , isUntrimmedUriConfigPath
     , canonicalizeConfigPath
     ) where
 
@@ -34,6 +36,7 @@ import System.FilePath
 import qualified Data.List.NonEmpty as NE
 import Distribution.Solver.Modular.Version (VR)
 import Distribution.Pretty (prettyShow)
+import Distribution.Utils.String (trim)
 import Text.PrettyPrint
 import Distribution.Simple.Utils (ordNub)
 
@@ -98,9 +101,13 @@ instance Structured ProjectConfigPath
 -- >>> render . docProjectConfigPath $ ProjectConfigPath $ "D.config" :| ["C.config", "B.config", "A.project"]
 -- "D.config\n  imported by: C.config\n  imported by: B.config\n  imported by: A.project"
 docProjectConfigPath :: ProjectConfigPath -> Doc
-docProjectConfigPath (ProjectConfigPath (p :| [])) = text p
-docProjectConfigPath (ProjectConfigPath (p :| ps)) = vcat $
-    text p : [ text " " <+> text "imported by:" <+> text l | l <- ps ]
+docProjectConfigPath (ProjectConfigPath (p :| [])) = quoteUntrimmed p
+docProjectConfigPath (ProjectConfigPath (p :| ps)) = vcat $ quoteUntrimmed p :
+    [ text " " <+> text "imported by:" <+> quoteUntrimmed l | l <- ps ]
+
+-- | If the path has leading or trailing spaces then show it quoted.
+quoteUntrimmed :: FilePath -> Doc
+quoteUntrimmed s = if trim s /= s then quotes (text s) else text s
 
 -- | Renders the paths as a list without showing which path imports another,
 -- like this;
@@ -150,6 +157,14 @@ cyclicalImportMsg path@(ProjectConfigPath (duplicate :| _)) =
     , nest 2 (docProjectConfigPath path)
     ]
 
+-- | A message for an import that has leading or trailing spaces.
+untrimmedUriImportMsg :: Doc -> ProjectConfigPath -> Doc
+untrimmedUriImportMsg intro path =
+    vcat
+    [ intro <+> text "import has leading or trailing whitespace" <> semi
+    , nest 2 (docProjectConfigPath path)
+    ]
+
 docProjectConfigPathFailReason :: VR -> ProjectConfigPath -> Doc
 docProjectConfigPathFailReason vr pcp
     | ProjectConfigPath (p :| []) <- pcp =
@@ -178,6 +193,11 @@ nullProjectConfigPath = ProjectConfigPath $ "unused" :| []
 isCyclicConfigPath :: ProjectConfigPath -> Bool
 isCyclicConfigPath (ProjectConfigPath p) = length p /= length (NE.nub p)
 
+-- | Check if the last segment of the path (root or importee) is a URI that has
+-- leading or trailing spaces.
+isUntrimmedUriConfigPath :: ProjectConfigPath -> Bool
+isUntrimmedUriConfigPath (ProjectConfigPath (p :| _)) = let p' = trim p in p' /= p && isURI p'
+
 -- | Check if the project config path is top-level, meaning it was not included by
 -- some other project config.
 isTopLevelConfigPath :: ProjectConfigPath -> Bool
@@ -196,7 +216,7 @@ unconsProjectConfigPath ps = fmap ProjectConfigPath <$> NE.uncons (coerce ps)
 makeRelativeConfigPath :: FilePath -> ProjectConfigPath -> ProjectConfigPath
 makeRelativeConfigPath dir (ProjectConfigPath p) =
     ProjectConfigPath
-    $ (\segment -> (if isURI segment then segment else makeRelative dir segment))
+    $ (\segment@(trim -> trimSegment) -> (if isURI trimSegment then trimSegment else makeRelative dir segment))
     <$> p
 
 -- | Normalizes and canonicalizes a path removing '.' and '..' indirections.
@@ -273,11 +293,25 @@ makeRelativeConfigPath dir (ProjectConfigPath p) =
 --     return $ expected == render (docProjectConfigPath p) ++ "\n"
 -- :}
 -- True
+--
+-- "A string is a valid URL potentially surrounded by spaces if, after stripping leading and trailing whitespace from it, it is a valid URL."
+-- [W3C/HTML5/URLs](https://www.w3.org/TR/2010/WD-html5-20100624/urls.html)
+--
+-- Trailing spaces for @ProjectConfigPath@ URLs are trimmed.
+--
+-- >>> p <- canonicalizeConfigPath "" (ProjectConfigPath $ ("https://www.stackage.org/nightly-2024-12-05/cabal.config ") :| [])
+-- >>> render $ docProjectConfigPath p
+-- "https://www.stackage.org/nightly-2024-12-05/cabal.config"
+--
+-- >>> let d = testDir
+-- >>> p <- canonicalizeConfigPath d (ProjectConfigPath $ ("https://www.stackage.org/nightly-2024-12-05/cabal.config ") :| [d </> "cabal.project"])
+-- >>> render $ docProjectConfigPath p
+-- "https://www.stackage.org/nightly-2024-12-05/cabal.config\n  imported by: cabal.project"
 canonicalizeConfigPath :: FilePath -> ProjectConfigPath -> IO ProjectConfigPath
 canonicalizeConfigPath d (ProjectConfigPath p) = do
-    xs <- sequence $ NE.scanr (\importee -> (>>= \importer ->
-            if isURI importee
-                then pure importee
+    xs <- sequence $ NE.scanr (\importee@(trim -> trimImportee) -> (>>= \importer@(trim -> trimImporter) ->
+            if isURI trimImportee || isURI trimImporter
+                then pure trimImportee
                 else canonicalizePath $ d </> takeDirectory importer </> importee))
             (pure ".") p
     return . makeRelativeConfigPath d . ProjectConfigPath . NE.fromList $ NE.init xs

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

@@ -126,6 +126,7 @@ import Distribution.Simple.Setup
 import Distribution.Simple.Utils
   ( debug
   , lowercase
+  , noticeDoc
   )
 import Distribution.Types.CondTree
   ( CondBranch (..)
@@ -141,6 +142,7 @@ import Distribution.Utils.NubList
   , overNubList
   , toNubList
   )
+import Distribution.Utils.String (trim)
 
 import Distribution.Client.HttpUtils
 import Distribution.Client.ParseUtils
@@ -274,6 +276,9 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project
         if isCyclicConfigPath normLocPath
           then pure . parseFail $ ParseUtils.FromString (render $ cyclicalImportMsg normLocPath) Nothing
           else do
+            when
+              (isUntrimmedUriConfigPath importLocPath)
+              (noticeDoc verbosity $ untrimmedUriImportMsg (Disp.text "Warning:") importLocPath)
             normSource <- canonicalizeConfigPath projectDir source
             let fs = (\z -> CondNode z [normLocPath] mempty) <$> fieldsToConfig normSource (reverse acc)
             res <- parseProjectSkeleton cacheDir httpTransport verbosity projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath
@@ -342,7 +347,7 @@ parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (Project
       fetch pci
 
     fetch :: FilePath -> IO BS.ByteString
-    fetch pci = case parseURI pci of
+    fetch pci = case parseURI $ trim pci of
       Just uri -> do
         let fp = cacheDir </> map (\x -> if isPathSeparator x then '_' else x) (makeValid $ show uri)
         createDirectoryIfMissing True cacheDir

cabal-testsuite/PackageTests/ProjectImport/UntrimmedImport/cabal.out

@@ -0,0 +1,30 @@
+# checking project import with trailing space
+# cabal v2-build
+Warning: import has leading or trailing whitespace;
+  'https://www.stackage.org/nightly-2024-12-05/cabal.config '
+    imported by: trailing-space.project
+Configuration is affected by the following files:
+- trailing-space.project
+- with-ghc.config
+    imported by: trailing-space.project
+- https://www.stackage.org/nightly-2024-12-05/cabal.config
+    imported by: trailing-space.project
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following would be built:
+ - my-0.1 (lib:my) (first run)
+# checking project import with tabs and spaces
+# cabal v2-build
+Warning: import has leading or trailing whitespace;
+  'https://www.stackage.org/nightly-2024-12-05/cabal.config		   '
+    imported by: tabs-and-spaces.project
+Configuration is affected by the following files:
+- tabs-and-spaces.project
+- with-ghc.config
+    imported by: tabs-and-spaces.project
+- https://www.stackage.org/nightly-2024-12-05/cabal.config
+    imported by: tabs-and-spaces.project
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following would be built:
+ - my-0.1 (lib:my) (first run)

cabal-testsuite/PackageTests/ProjectImport/UntrimmedImport/cabal.test.hs

@@ -0,0 +1,14 @@
+import Test.Cabal.Prelude
+
+main = cabalTest . recordMode RecordMarked $ do
+  let log = recordHeader . pure
+
+  log "checking project import with trailing space"
+  trailing <- cabal' "v2-build" [ "--dry-run", "--project-file=trailing-space.project" ]
+  assertOutputContains "import has leading or trailing whitespace" trailing
+  assertOutputContains "'https://www.stackage.org/nightly-2024-12-05/cabal.config '" trailing
+
+  log "checking project import with tabs and spaces"
+  cabal "v2-build" [ "--dry-run", "--project-file=tabs-and-spaces.project" ]
+
+  return ()

cabal-testsuite/PackageTests/ProjectImport/UntrimmedImport/my.cabal

@@ -0,0 +1,9 @@
+name:           my
+version:        0.1
+license:        BSD3
+cabal-version:  >= 1.2
+build-type:     Simple
+
+library
+    exposed-modules:    Foo
+    build-depends:      base

cabal-testsuite/PackageTests/ProjectImport/UntrimmedImport/tabs-and-spaces.project

@@ -0,0 +1,3 @@
+packages: .
+import:		https://www.stackage.org/nightly-2024-12-05/cabal.config		   
+import: with-ghc.config

cabal-testsuite/PackageTests/ProjectImport/UntrimmedImport/trailing-space.project

@@ -0,0 +1,3 @@
+packages: .
+import: https://www.stackage.org/nightly-2024-12-05/cabal.config 
+import: with-ghc.config

cabal-testsuite/PackageTests/ProjectImport/UntrimmedImport/with-ghc.config

@@ -0,0 +1,7 @@
+-- WARNING: Override the `with-compiler: ghc-x.y.z` of the stackage import, of
+-- https://www.stackage.org/nightly-yyyy-mm-dd/cabal.config. Otherwise tests
+-- will fail with:
+--   -Error: [Cabal-5490]
+--   -Cannot find the program 'ghc'. User-specified path 'ghc-x.y.z' does not
+--    refer to an executable and the program is not on the system path.
+with-compiler: ghc

changelog.d/pr-10629

@@ -0,0 +1,13 @@
+---
+synopsis: "Report trailing spaces in project import URIs"
+packages: [cabal-install, cabal-install-solver]
+prs: 10629
+issues: 10622
+---
+
+> A string is a valid URL potentially surrounded by spaces if, after stripping
+> leading and trailing whitespace from it, it is a valid URL."
+> SOURCE: [W3C/HTML5/URLs](https://www.w3.org/TR/2010/WD-html5-20100624/urls.html)
+
+Fixes a problem of mistaking a URI for a file path when it has trailing spaces
+and warn about such trailing spaces.

fix-whitespace.yaml

@@ -95,6 +95,8 @@ excluded-files:
   - Cabal-tests/tests/ParserTests/warnings/tab.cabal
   - Cabal-tests/tests/ParserTests/warnings/utf8.cabal
   - cabal-testsuite/PackageTests/Regression/T8507/pkg.cabal
+  - cabal-testsuite/PackageTests/ProjectImport/UntrimmedImport/trailing-space.project
+  - cabal-testsuite/PackageTests/ProjectImport/UntrimmedImport/tabs-and-spaces.project
 
   # These also contain tabs that affect the golden value:
   # Could be removed from exceptions, but then the tab warning