Merge pull request haskell#10746 from jasagredo/js/local-noindex-2

Fix file+noindex URI usage on Windows

Author: mergify[bot]

Cabal-syntax/src/Distribution/Utils/Path.hs

@@ -67,9 +67,6 @@ module Distribution.Utils.Path
 
     -- ** Module names
   , moduleNameSymbolicPath
-
-    -- * Windows
-  , asPosixPath
   ) where
 
 import Distribution.Compat.Prelude
@@ -89,8 +86,6 @@ import qualified Distribution.Compat.CharParsing as P
 
 import qualified System.Directory as Directory
 import qualified System.FilePath as FilePath
-import qualified System.FilePath.Posix as Posix
-import qualified System.FilePath.Windows as Windows
 
 import Data.Kind
   ( Type
@@ -536,38 +531,3 @@ data Response
 --
 -- See Note [Symbolic paths] in Distribution.Utils.Path.
 data PkgConf
-
--------------------------------------------------------------------------------
-
--- * Windows utils
-
--------------------------------------------------------------------------------
-
--- | Sometimes we need to represent a Windows path (that might have been
--- normalized) as a POSIX path, for example in URIs, as that is what
--- @network-uri@ understands. Furthermore they need to use the @\\\\.\\@ DOS
--- device syntax or otherwise the filepath will be unusable.
---
--- >>> import Network.URI
--- >>> uriPath <$> parseURI "file+noindex://C:/foo.txt"
--- Just "/foo.txt"
--- >>> parseURI "file+noindex://C:\foo.txt"
--- Nothing
--- >>> uriPath <$> parseURI "file+noindex:///C:/foo.txt"
--- Just "/C:/foo.txt"
--- >>> uriPath <$> parseURI "file+noindex:////./C:/foo.txt"
--- Just "//./C:/foo.txt"
---
--- Out of the ones above, only the last one can be used from anywhere in the
--- system, after normalization into @"\\\\.\\C:/foo.txt"@ (see filepath#247 for
--- why there is a forward slash there):
---
--- >>> import Network.URI
--- >>> import qualified System.FilePath.Windows as Windows
--- >>> Windows.normalise . uriPath <$> parseURI "file+noindex:////./C:/foo.txt"
--- Just "\\\\.\\C:/foo.txt"
-asPosixPath :: FilePath -> FilePath
-asPosixPath p =
-  -- We don't use 'isPathSeparator' because @Windows.isPathSeparator
-  -- Posix.pathSeparator == True@.
-  [if x == Windows.pathSeparator then Posix.pathSeparator else x | x <- p]

Makefile

@@ -125,7 +125,7 @@ ghcid-cli: ## Run ghcid for the cabal-install executable.
 
 .PHONY: doctest
 doctest: ## Run doctests.
-	cd Cabal-syntax && $(DOCTEST) --build-depends=network-uri
+	cd Cabal-syntax && $(DOCTEST)
 	cd Cabal-described && $(DOCTEST)
 	cd Cabal && $(DOCTEST)
 	cd cabal-install-solver && $(DOCTEST)

cabal-install/src/Distribution/Client/Config.hs

@@ -1698,8 +1698,6 @@ postProcessRepo lineno reponameStr repo0 = do
         Left $
           LocalRepo
             reponame
-            -- Normalization of Windows paths that use @//./@ does not fully
-            -- normalize the path (see filepath#247), but it is still usable.
             (normalise (uriPath uri))
             (uriFragment uri == "#shared-cache")
     _ -> do

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

@@ -39,7 +39,7 @@ import Distribution.Types.Flag (FlagName, parsecFlagAssignment)
 
 import Distribution.Client.ProjectConfig.Types
 import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..))
-import Distribution.Client.Types.Repo (LocalRepo (..), RemoteRepo (..), emptyRemoteRepo)
+import Distribution.Client.Types.Repo (LocalRepo (..), RemoteRepo (..), emptyRemoteRepo, normaliseFileNoIndexURI)
 import Distribution.Client.Types.RepoName (RepoName (..), unRepoName)
 import Distribution.Client.Types.SourceRepo (SourceRepoList, sourceRepositoryPackageGrammar)
 
@@ -175,7 +175,7 @@ import Distribution.Simple.Command
   , option
   , reqArg'
   )
-import Distribution.System (Arch, OS (Windows), buildOS)
+import Distribution.System (Arch, OS, buildOS)
 import Distribution.Types.PackageVersionConstraint
   ( PackageVersionConstraint
   )
@@ -2050,20 +2050,6 @@ remoteRepoSectionDescr =
                 (if sharedCache then "#shared-cache" else "")
         }
 
--- | When on Windows, we need to convert the path to be POSIX-style.
---
--- >>> normaliseFileNoIndexURI Windows (URI "file+noindex:" (Just nullURIAuth) "\\\\.\\C:\\dev\\foo" "" "")
--- file+noindex:////./C:/dev/foo
---
--- See haddocks of 'asPosixPath' for some examples of why this is needed for
--- @network-uri@.
-normaliseFileNoIndexURI :: OS -> URI -> URI
-normaliseFileNoIndexURI os uri@(URI scheme auth path query fragment)
-  | "file+noindex:" <- scheme
-  , Windows <- os =
-      URI scheme auth (asPosixPath path) query fragment
-  | otherwise = uri
-
 -------------------------------
 -- Local field utils
 --

cabal-install/src/Distribution/Client/Types/Repo.hs

@@ -15,6 +15,9 @@ module Distribution.Client.Types.Repo
   , repoName
   , isRepoRemote
   , maybeRepoRemote
+
+    -- * Windows
+  , normaliseFileNoIndexURI
   ) where
 
 import Distribution.Client.Compat.Prelude
@@ -23,6 +26,7 @@ import Prelude ()
 import Network.URI (URI (..), nullURI, parseAbsoluteURI, uriToString)
 
 import Distribution.Simple.Utils (toUTF8BS)
+import Distribution.System (OS (Windows))
 
 import Distribution.Client.HashValue (hashValue, showHashValue, truncateHash)
 
@@ -32,6 +36,9 @@ import qualified Text.PrettyPrint as Disp
 
 import Distribution.Client.Types.RepoName
 
+import qualified System.FilePath.Posix as Posix
+import qualified System.FilePath.Windows as Windows
+
 -------------------------------------------------------------------------------
 -- Remote repository
 -------------------------------------------------------------------------------
@@ -190,3 +197,41 @@ repoName :: Repo -> RepoName
 repoName (RepoLocalNoIndex r _) = localRepoName r
 repoName (RepoRemote r _) = remoteRepoName r
 repoName (RepoSecure r _) = remoteRepoName r
+
+-------------------------------------------------------------------------------
+
+-- * Windows utils
+
+-------------------------------------------------------------------------------
+
+-- | When on Windows, we need to convert the paths in URIs to be POSIX-style.
+--
+-- >>> import Network.URI
+-- >>> normaliseFileNoIndexURI Windows (URI "file+noindex:" (Just nullURIAuth) "C:\\dev\\foo" "" "")
+-- file+noindex:C:/dev/foo
+--
+-- Other formats of file paths are not understood by @network-uri@:
+--
+-- >>> import Network.URI
+-- >>> uriPath <$> parseURI "file+noindex://C:/foo.txt"
+-- Just "/foo.txt"
+-- >>> parseURI "file+noindex://C:\foo.txt"
+-- Nothing
+-- >>> uriPath <$> parseURI "file+noindex:///C:/foo.txt"
+-- Just "/C:/foo.txt"
+-- >>> uriPath <$> parseURI "file+noindex:C:/foo.txt"
+-- Just "C:/foo.txt"
+--
+-- Out of the ones above, only the last one can be used from anywhere in the
+-- system.
+normaliseFileNoIndexURI :: OS -> URI -> URI
+normaliseFileNoIndexURI os uri@(URI scheme _auth path query fragment)
+  | "file+noindex:" <- scheme
+  , Windows <- os =
+      URI scheme Nothing (asPosixPath path) query fragment
+  | otherwise = uri
+  where
+    asPosixPath p =
+      -- We don't use 'isPathSeparator' because @Windows.isPathSeparator
+      -- Posix.pathSeparator == True@.
+      [if x == Windows.pathSeparator then Posix.pathSeparator else x | x <- p]

cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs

@@ -1018,7 +1018,7 @@ instance Arbitrary LocalRepo where
     LocalRepo
       <$> arbitrary
       <*> elements
-        ( (if buildOS == Windows then map (normalise . ("//./C:" ++)) else id)
+        ( (if buildOS == Windows then map (normalise . ("C:" ++)) else id)
             ["/tmp/foo", "/tmp/bar"]
         ) -- TODO: generate valid absolute paths
       <*> arbitrary

cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs

@@ -78,14 +78,6 @@ normalizeOutput nenv =
         else id)
   . normalizeBuildInfoJson
   . maybe id normalizePathCmdOutput (normalizerCabalInstallVersion nenv)
-    -- Munge away \\.\C:/ prefix on paths (Windows). We convert @\\.\C:/@ to
-    -- @\@. We need to do this before the step above as that one would convert
-    -- @\\.\@ to @\.\@.
-    --
-    -- These paths might come up in file+noindex URIs due to @filepath@
-    -- normalizing @//./C:/foo.txt@ paths to @\\.\C:/foo.txt@, see
-    -- (filepath#247).
-  . (if buildOS == Windows then resub "\\\\\\\\\\.\\\\([A-Z]):/" "\\\\" else id)
   -- hackage-security locks occur non-deterministically
   . resub "(Released|Acquired|Waiting) .*hackage-security-lock\n" ""
   . resub "installed: [0-9]+(\\.[0-9]+)*" "installed: <VERSION>"

cabal-testsuite/src/Test/Cabal/Prelude.hs

@@ -48,7 +48,7 @@ import Distribution.PackageDescription
 import Test.Utils.TempTestDir (withTestDir)
 import Distribution.Verbosity (normal)
 import Distribution.Utils.Path
-  ( asPosixPath, makeSymbolicPath, relativeSymbolicPath, interpretSymbolicPathCWD )
+  ( makeSymbolicPath, relativeSymbolicPath, interpretSymbolicPathCWD )
 
 import Distribution.Compat.Stack
 
@@ -77,6 +77,8 @@ import System.Environment
 import qualified System.FilePath.Glob as Glob (globDir1, compile)
 import System.Process
 import System.IO
+import qualified System.FilePath.Posix as Posix
+import qualified System.FilePath.Windows as Windows
 
 #ifndef mingw32_HOST_OS
 import System.Posix.Resource
@@ -612,9 +614,12 @@ withRepoNoUpdate repo_dir m = do
     withReaderT (\env' -> env' { testHaveRepo = True }) m
     -- TODO: Arguably should undo everything when we're done...
   where
-    repoUri env ="file+noindex://" ++ (if isWindows
-                                        then joinDrive "//./" . asPosixPath
-                                        else id) (testRepoDir env)
+    repoUri env ="file+noindex:" ++ (if isWindows
+                                        then map (\x -> if x == Windows.pathSeparator
+                                                        then Posix.pathSeparator
+                                                        else x
+                                                 )
+                                        else ("//" ++)) (testRepoDir env)
 
 -- | Given a directory (relative to the 'testCurrentDir') containing
 -- a series of directories representing packages, generate an

changelog.d/pr-10728

@@ -1,14 +1,14 @@
 synopsis: Fix `file+noindex` URI usage on Windows
 packages: cabal-install
-prs: #10728
+prs: #10728 #10746
 issues: #10703
 significance:
 
 description: {
 
-- `file+noindex` repositories in Windows systems must use the format `file+noindex:////./C:/path/to/repo`.
-  This syntax comes from https://learn.microsoft.com/en-us/dotnet/standard/io/file-path-formats#dos-device-paths,
-  and is the only syntax for DOS paths fully supported by the `network-uri` package, which Cabal uses to
-  interpret URIs in repository stanzas.
+- `file+noindex` repositories in Windows systems must use the format
+  `file+noindex:C:/path/to/repo`.  This is the only syntax for DOS paths fully
+  supported by the `network-uri` package, which Cabal uses to interpret URIs in
+  repository stanzas.
 
 }

doc/config.rst

@@ -201,8 +201,8 @@ repository.
 corresponding ``package-name-version.cabal`` files as new revisions.
 
 .. note::
-   On Windows systems, the path has to be prefixed by ``//./`` as in
-   ``url: file+noindex:////./C:/absolute/path/to/directory``.
+   On Windows systems, the URL must start directly with the absolute path as in
+   ``url: file+noindex:C:/absolute/path/to/directory``.
 
 For example, if ``/absolute/path/to/directory`` looks like
 ::