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 9 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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
@@ -1,4 +1,5 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ViewPatterns #-}

module Distribution.Solver.Types.ProjectConfigPath
(
Expand All @@ -12,11 +13,13 @@ module Distribution.Solver.Types.ProjectConfigPath
, docProjectConfigPath
, docProjectConfigPaths
, cyclicalImportMsg
, untrimmedUriImportMsg
, docProjectConfigPathFailReason

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

Expand All @@ -31,6 +34,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

-- | Path to a configuration file, either a singleton project root, or a longer
Expand Down Expand Up @@ -60,9 +64,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 @@ -111,6 +119,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 @@ -139,6 +155,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 @@ -153,7 +174,7 @@ consProjectConfigPath p ps = ProjectConfigPath (p <| 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 @@ -232,11 +253,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
@@ -1,6 +1,7 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand Down Expand Up @@ -126,6 +127,7 @@ import Distribution.Simple.Setup
import Distribution.Simple.Utils
( debug
, lowercase
, noticeDoc
)
import Distribution.Types.CondTree
( CondBranch (..)
Expand All @@ -141,6 +143,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 +277,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 +348,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
30 changes: 30 additions & 0 deletions cabal-testsuite/PackageTests/UntrimmedImport/cabal.out
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:
- https://www.stackage.org/nightly-2024-12-05/cabal.config
imported by: trailing-space.project
- trailing-space.project
- with-ghc.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:
- https://www.stackage.org/nightly-2024-12-05/cabal.config
imported by: tabs-and-spaces.project
- tabs-and-spaces.project
- with-ghc.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)
14 changes: 14 additions & 0 deletions cabal-testsuite/PackageTests/UntrimmedImport/cabal.test.hs
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 ()
9 changes: 9 additions & 0 deletions cabal-testsuite/PackageTests/UntrimmedImport/my.cabal
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
7 changes: 7 additions & 0 deletions cabal-testsuite/PackageTests/UntrimmedImport/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
9 changes: 9 additions & 0 deletions changelog.d/pr-10629
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
---
synopsis: "Report trailing spaces in project import URIs"
packages: [cabal-install, cabal-install-solver]
prs: 10629
issues: 10622
---

A URI that has trailing spaces is valid. We now warn about this. Fixes a problem
of mistaking such a URI for a file path.
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/UntrimmedImport/trailing-space.project
- cabal-testsuite/PackageTests/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