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.

Author: hasufell

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

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
+