Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Have projects import trimmed URIs #10629

Open
wants to merge 13 commits into
base: master
Choose a base branch
from
Open
2 changes: 1 addition & 1 deletion Cabal/src/Distribution/Simple/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -14,11 +14,13 @@ module Distribution.Solver.Types.ProjectConfigPath
, docProjectConfigPath
, docProjectConfigFiles
, cyclicalImportMsg
, untrimmedUriImportMsg
, docProjectConfigPathFailReason

-- * Checks and Normalization
, isCyclicConfigPath
, isTopLevelConfigPath
, isUntrimmedUriConfigPath
, canonicalizeConfigPath
) where

Expand All @@ -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)

Expand Down Expand Up @@ -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
philderbeast marked this conversation as resolved.
Show resolved Hide resolved

-- | Renders the paths as a list without showing which path imports another,
-- like this;
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand All @@ -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.
Expand Down Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -126,6 +126,7 @@ import Distribution.Simple.Setup
import Distribution.Simple.Utils
( debug
, lowercase
, noticeDoc
)
import Distribution.Types.CondTree
( CondBranch (..)
Expand All @@ -141,6 +142,7 @@ import Distribution.Utils.NubList
, overNubList
, toNubList
)
import Distribution.Utils.String (trim)

import Distribution.Client.HttpUtils
import Distribution.Client.ParseUtils
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
@@ -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)
Original file line number Diff line number Diff line change
@@ -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 ()
Original file line number Diff line number Diff line change
@@ -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
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
packages: .
import: https://www.stackage.org/nightly-2024-12-05/cabal.config
import: with-ghc.config
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
packages: .
import: https://www.stackage.org/nightly-2024-12-05/cabal.config
import: with-ghc.config
Original file line number Diff line number Diff line change
@@ -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
13 changes: 13 additions & 0 deletions changelog.d/pr-10629
Original file line number Diff line number Diff line change
@@ -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.
2 changes: 2 additions & 0 deletions fix-whitespace.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -94,6 +94,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
Expand Down
Loading