From 4a7be9562c57a2cff626e9d4e919d863c20e4069 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Thu, 29 Jan 2026 14:53:59 +0800 Subject: [PATCH] Fix bug in unPathNative When passing a path like "F:/foo/bar" on windows (both '/' and '\' are valid path separators on windows) we'll get garbage output like so: > mkPathNative "F:/foo/bar" "F:/foo/bar" > unPathNative "F:/foo/bar" "F:foo\\bar" ...effectively turning an absolute path into a relative path ("F:foo\\bar" on windows is the directory "foo\\bar" relative to the current working directory on drive F). This is because Posix and Windows splitDirectories behave differently: > System.FilePath.Posix.splitDirectories $ "F:/foo/bar" ["F:","foo","bar"] > System.FilePath.Windows.splitDirectories $ "F:/foo/bar" ["F:/","foo","bar"] When joining paths on windows, the filepath library does not assume a trailing path separator after the drive (here "F:"). This is because as described above, "F:foo" is valid relative filepath. --- hackage-security/src/Hackage/Security/Util/Path.hs | 14 ++++++++++++-- hackage-security/tests/TestSuite.hs | 13 ++++++++++++- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/hackage-security/src/Hackage/Security/Util/Path.hs b/hackage-security/src/Hackage/Security/Util/Path.hs index 55e15951..381b1b8c 100644 --- a/hackage-security/src/Hackage/Security/Util/Path.hs +++ b/hackage-security/src/Hackage/Security/Util/Path.hs @@ -71,6 +71,9 @@ module Hackage.Security.Util.Path ( , fromURIPath , uriPath , modifyUriPath + -- * Internals + , mkPathNative + , unPathNative -- * Re-exports , IOMode(..) , BufferMode(..) @@ -118,10 +121,17 @@ newtype Path a = Path FilePath -- always a Posix style path internally deriving (Show, Eq, Ord) mkPathNative :: FilePath -> Path a -mkPathNative = Path . FP.Posix.joinPath . FP.Native.splitDirectories +mkPathNative = Path . canonicalizePathSeparator unPathNative :: Path a -> FilePath -unPathNative (Path fp) = FP.Native.joinPath . FP.Posix.splitDirectories $ fp +unPathNative (Path fp) = fp + +canonicalizePathSeparator :: FilePath -> FilePath +canonicalizePathSeparator = map (replaceSeparator) + where + replaceSeparator c + | FP.Native.isPathSeparator c = '/' + | otherwise = c mkPathPosix :: FilePath -> Path a mkPathPosix = Path diff --git a/hackage-security/tests/TestSuite.hs b/hackage-security/tests/TestSuite.hs index 6e5c428d..db780a98 100644 --- a/hackage-security/tests/TestSuite.hs +++ b/hackage-security/tests/TestSuite.hs @@ -9,7 +9,7 @@ import Data.Time ( UTCTime, getCurrentTime ) import Network.URI ( URI, parseURI ) import Test.Tasty ( defaultMain, testGroup, TestTree ) import Test.Tasty.HUnit ( testCase, (@?=), assertEqual, assertFailure, Assertion ) -import Test.Tasty.QuickCheck ( testProperty ) +import Test.Tasty.QuickCheck ( testProperty, Property, (===), property ) import System.IO.Temp (withSystemTempDirectory) import qualified Codec.Archive.Tar.Entry as Tar import qualified Data.ByteString.Lazy.Char8 as BS @@ -72,6 +72,9 @@ tests = testGroup "hackage-security" [ , testProperty "prop_canonical_pretty" JSON.prop_canonical_pretty , testProperty "prop_aeson_canonical" JSON.prop_aeson_canonical ] + , testGroup "Path" [ + testProperty "Hackage.Security.Util.Path.mkPathNative" prop_mkPathNative + ] ] {------------------------------------------------------------------------------- @@ -547,3 +550,11 @@ checkExpiry = Just `fmap` getCurrentTime mkPackageName :: String -> PackageName mkPackageName = PackageName #endif + +{------------------------------------------------------------------------------- + Path tests +-------------------------------------------------------------------------------} + +prop_mkPathNative :: Property +prop_mkPathNative = property $ \(fp :: FilePath) -> (mkPathNative . unPathNative . mkPathNative) fp === mkPathNative fp +