Migrate TarPath to PosixPath

Author: Bodigrim

Codec/Archive/Tar/Index/Internal.hs

@@ -285,7 +285,7 @@ type FilePathBS = BS.ByteString
 
 splitTarPath :: TarPath -> [FilePathBS]
 splitTarPath (TarPath name prefix) =
-    splitDirectories prefix ++ splitDirectories name
+    splitDirectories (posixToByteString prefix) ++ splitDirectories (posixToByteString name)
 
 splitDirectories :: FilePathBS -> [FilePathBS]
 splitDirectories bs =

Codec/Archive/Tar/LongNames.hs

@@ -1,15 +1,19 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PackageImports #-}
 
 module Codec.Archive.Tar.LongNames
   ( encodeLongNames
   , decodeLongNames
   , DecodeLongNamesError(..)
   ) where
 
+import Codec.Archive.Tar.PackAscii
 import Codec.Archive.Tar.Types
 import Control.Exception
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as BL
+import "os-string" System.OsString.Posix (PosixString, PosixChar)
+import qualified "os-string" System.OsString.Posix as PS
 
 -- | Errors raised by 'decodeLongNames'.
 --
@@ -71,10 +75,10 @@ encodeLinkPath
 encodeLinkPath lnk = case toTarPath' lnk of
   FileNameEmpty -> (Nothing, LinkTarget mempty)
   FileNameOK (TarPath name prefix)
-    | B.null prefix -> (Nothing, LinkTarget name)
-    | otherwise -> (Just $ longSymLinkEntry lnk, LinkTarget name)
+    | PS.null prefix -> (Nothing, LinkTarget $ posixToByteString name)
+    | otherwise -> (Just $ longSymLinkEntry lnk, LinkTarget $ posixToByteString name)
   FileNameTooLong (TarPath name _) ->
-    (Just $ longSymLinkEntry lnk, LinkTarget name)
+    (Just $ longSymLinkEntry lnk, LinkTarget $ posixToByteString name)
 
 -- | Translate low-level entries (usually freshly deserialized) into
 -- high-level entries with POSIX 'FilePath's for files and symlinks

Codec/Archive/Tar/PackAscii.hs

@@ -1,14 +1,37 @@
+{-# LANGUAGE PackageImports #-}
+
 module Codec.Archive.Tar.PackAscii
   ( packAscii
+  , toPosixString
+  , fromPosixString
+  , posixToByteString
+  , byteToPosixString
   ) where
 
 import qualified Data.ByteString.Char8 as BS.Char8
+import qualified Data.ByteString.Short as Sh
 import Data.Char
 import GHC.Stack
+import System.IO.Unsafe (unsafePerformIO)
+import "os-string" System.OsString.Posix (PosixString)
+import qualified "os-string" System.OsString.Posix as PS
+import qualified "os-string" System.OsString.Internal.Types as PS
 
 -- | We should really migrate to @OsPath@ from @filepath@ package,
 -- but for now let's not corrupt data silently.
 packAscii :: HasCallStack => FilePath -> BS.Char8.ByteString
 packAscii xs
   | all isAscii xs = BS.Char8.pack xs
   | otherwise = error $ "packAscii: only ASCII filenames are supported, but got " ++ xs
+
+toPosixString :: FilePath -> PosixString
+toPosixString = unsafePerformIO . PS.encodeFS
+
+fromPosixString :: PosixString -> FilePath
+fromPosixString = unsafePerformIO . PS.decodeFS
+
+posixToByteString :: PosixString -> BS.Char8.ByteString
+posixToByteString = Sh.fromShort . PS.getPosixString
+
+byteToPosixString :: BS.Char8.ByteString -> PosixString
+byteToPosixString = PS.PosixString . Sh.toShort

Codec/Archive/Tar/Read.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE PackageImports #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Codec.Archive.Tar.Read
@@ -17,6 +18,7 @@ module Codec.Archive.Tar.Read
   , FormatError(..)
   ) where
 
+import Codec.Archive.Tar.PackAscii
 import Codec.Archive.Tar.Types
 
 import Data.Char     (ord)
@@ -33,6 +35,9 @@ import qualified Data.ByteString        as BS
 import qualified Data.ByteString.Char8  as BS.Char8
 import qualified Data.ByteString.Unsafe as BS
 import qualified Data.ByteString.Lazy   as LBS
+import System.IO.Unsafe (unsafePerformIO)
+import "os-string" System.OsString.Posix (PosixString, PosixChar)
+import qualified "os-string" System.OsString.Posix as PS
 
 import Prelude hiding (read)
 
@@ -124,7 +129,7 @@ getEntryStreaming getN getAll = do
           let content = LBS.take size paddedContent
 
           pure $ Right $ Just $ Entry {
-            entryTarPath     = TarPath name prefix,
+            entryTarPath     = TarPath (byteToPosixString name) (byteToPosixString prefix),
             entryContent     = case typecode of
                  '\0' -> NormalFile      content size
                  '0'  -> NormalFile      content size

Codec/Archive/Tar/Types.hs

@@ -1,4 +1,11 @@
-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, BangPatterns, DeriveTraversable, ScopedTypeVariables, RankNTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Codec.Archive.Tar.Types
@@ -88,6 +95,8 @@ import qualified System.FilePath.Windows as FilePath.Windows
          ( joinPath, addTrailingPathSeparator, pathSeparator )
 import System.Posix.Types
          ( FileMode )
+import "os-string" System.OsString.Posix (PosixString, PosixChar)
+import qualified "os-string" System.OsString.Posix as PS
 
 import Codec.Archive.Tar.PackAscii
 
@@ -278,7 +287,7 @@ symlinkEntry name targetLink =
 -- @since 0.6.0.0
 longLinkEntry :: FilePath -> GenEntry TarPath linkTarget
 longLinkEntry tarpath = Entry {
-    entryTarPath     = TarPath (BS.Char8.pack "././@LongLink") BS.empty,
+    entryTarPath     = TarPath [PS.pstr|././@LongLink|] mempty,
     entryContent     = OtherEntryType 'L' (LBS.fromStrict $ packAscii tarpath) (fromIntegral $ length tarpath),
     entryPermissions = ordinaryFilePermissions,
     entryOwnership   = Ownership "" "" 0 0,
@@ -295,7 +304,7 @@ longLinkEntry tarpath = Entry {
 -- @since 0.6.0.0
 longSymLinkEntry :: FilePath -> GenEntry TarPath linkTarget
 longSymLinkEntry linkTarget = Entry {
-    entryTarPath     = TarPath (BS.Char8.pack "././@LongLink") BS.empty,
+    entryTarPath     = TarPath [PS.pstr|././@LongLink|] mempty,
     entryContent     = OtherEntryType 'K' (LBS.fromStrict . packAscii $ linkTarget) (fromIntegral $ length linkTarget),
     entryPermissions = ordinaryFilePermissions,
     entryOwnership   = Ownership "" "" 0 0,
@@ -338,8 +347,11 @@ directoryEntry name = simpleEntry name Directory
 --
 -- * The directory separator between the prefix and name is /not/ stored.
 --
-data TarPath = TarPath {-# UNPACK #-} !BS.ByteString -- path name, 100 characters max.
-                       {-# UNPACK #-} !BS.ByteString -- path prefix, 155 characters max.
+data TarPath = TarPath
+  {-# UNPACK #-} !PosixString
+  -- ^ path name, 100 characters max.
+  {-# UNPACK #-} !PosixString
+  -- ^ path prefix, 155 characters max.
   deriving (Eq, Ord)
 
 instance NFData TarPath where
@@ -362,7 +374,7 @@ instance Show TarPath where
 --   (e.g., using 'Codec.Archive.Tar.Check.checkEntrySecurity').
 --
 fromTarPath :: TarPath -> FilePath
-fromTarPath = BS.Char8.unpack . fromTarPathInternal FilePath.Native.pathSeparator
+fromTarPath = fromPosixString . fromTarPathInternal (PS.unsafeFromChar FilePath.Native.pathSeparator)
 
 -- | Convert a 'TarPath' to a Unix\/Posix 'FilePath'.
 --
@@ -373,7 +385,7 @@ fromTarPath = BS.Char8.unpack . fromTarPathInternal FilePath.Native.pathSeparato
 -- operating system, eg to perform portability checks.
 --
 fromTarPathToPosixPath :: TarPath -> FilePath
-fromTarPathToPosixPath = BS.Char8.unpack . fromTarPathInternal FilePath.Posix.pathSeparator
+fromTarPathToPosixPath = fromPosixString . fromTarPathInternal (PS.unsafeFromChar FilePath.Posix.pathSeparator)
 
 -- | Convert a 'TarPath' to a Windows 'FilePath'.
 --
@@ -384,18 +396,18 @@ fromTarPathToPosixPath = BS.Char8.unpack . fromTarPathInternal FilePath.Posix.pa
 -- operating system, eg to perform portability checks.
 --
 fromTarPathToWindowsPath :: TarPath -> FilePath
-fromTarPathToWindowsPath = BS.Char8.unpack . fromTarPathInternal FilePath.Windows.pathSeparator
+fromTarPathToWindowsPath = fromPosixString . fromTarPathInternal (PS.unsafeFromChar FilePath.Windows.pathSeparator)
 
-fromTarPathInternal :: Char -> TarPath -> BS.ByteString
+fromTarPathInternal :: PosixChar -> TarPath -> PosixString
 fromTarPathInternal sep = go
   where
-    posixSep = FilePath.Posix.pathSeparator
+    posixSep = PS.unsafeFromChar FilePath.Posix.pathSeparator
     adjustSeps = if sep == posixSep then id else
-      BS.Char8.map $ \c -> if c == posixSep then sep else c
+      PS.map $ \c -> if c == posixSep then sep else c
     go (TarPath name prefix)
-     | BS.null prefix = adjustSeps name
-     | BS.null name = adjustSeps prefix
-     | otherwise = adjustSeps prefix <> BS.Char8.cons sep (adjustSeps name)
+     | PS.null prefix = adjustSeps name
+     | PS.null name = adjustSeps prefix
+     | otherwise = adjustSeps prefix <> PS.cons sep (adjustSeps name)
 {-# INLINE fromTarPathInternal #-}
 
 -- | Convert a native 'FilePath' to a 'TarPath'.
@@ -453,12 +465,12 @@ splitLongPath :: FilePath -> ToTarPathResult
 splitLongPath path = case reverse (FilePath.Posix.splitPath path) of
   [] -> FileNameEmpty
   c : cs -> case packName nameMax (c :| cs) of
-    Nothing                 -> FileNameTooLong $ TarPath (packAscii $ take 100 path) BS.empty
-    Just (name, [])         -> FileNameOK $! TarPath (packAscii name) BS.empty
+    Nothing                 -> FileNameTooLong $ TarPath (toPosixString $ take 100 path) mempty
+    Just (name, [])         -> FileNameOK $! TarPath (toPosixString name) mempty
     Just (name, first:rest) -> case packName prefixMax remainder of
-      Nothing               -> FileNameTooLong $ TarPath (packAscii $ take 100 path) BS.empty
-      Just (_     , _:_)    -> FileNameTooLong $ TarPath (packAscii $ take 100 path) BS.empty
-      Just (prefix, [])     -> FileNameOK $! TarPath (packAscii name) (packAscii prefix)
+      Nothing               -> FileNameTooLong $ TarPath (toPosixString $ take 100 path) mempty
+      Just (_     , _:_)    -> FileNameTooLong $ TarPath (toPosixString $ take 100 path) mempty
+      Just (prefix, [])     -> FileNameOK $! TarPath (toPosixString name) (toPosixString prefix)
       where
         -- drop the '/' between the name and prefix:
         remainder = init first :| rest

Codec/Archive/Tar/Write.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Codec.Archive.Tar.Write
@@ -12,6 +13,7 @@
 -----------------------------------------------------------------------------
 module Codec.Archive.Tar.Write (write) where
 
+import Codec.Archive.Tar.PackAscii
 import Codec.Archive.Tar.Types
 
 import Data.Bits
@@ -25,7 +27,8 @@ import qualified Data.ByteString             as BS
 import qualified Data.ByteString.Char8       as BS.Char8
 import qualified Data.ByteString.Lazy        as LBS
 import qualified Data.ByteString.Lazy.Char8  as LBS.Char8
-
+import "os-string" System.OsString.Posix (PosixString)
+import qualified "os-string" System.OsString.Posix as PS
 
 -- | Create the external representation of a tar archive by serialising a list
 -- of tar entries.
@@ -76,7 +79,7 @@ putHeaderNoChkSum Entry {
   } =
 
   concat
-    [ putBString 100 name
+    [ putPosixString 100 name
     , putOct       8 permissions
     , putOct       8 $ ownerId ownership
     , putOct       8 $ groupId ownership
@@ -95,7 +98,7 @@ putHeaderNoChkSum Entry {
     , putString   32 $ groupName ownership
     , putOct       8 deviceMajor
     , putOct       8 deviceMinor
-    , putBString 155 prefix
+    , putPosixString 155 prefix
     , replicate   12 '\NUL'
     ]
   GnuFormat -> concat
@@ -104,7 +107,7 @@ putHeaderNoChkSum Entry {
     , putString   32 $ groupName ownership
     , putGnuDev    8 deviceMajor
     , putGnuDev    8 deviceMinor
-    , putBString 155 prefix
+    , putPosixString 155 prefix
     , replicate   12 '\NUL'
     ]
   where
@@ -142,6 +145,9 @@ type FieldWidth = Int
 putBString :: FieldWidth -> BS.ByteString -> String
 putBString n s = BS.Char8.unpack (BS.take n s) ++ replicate (n - BS.length s) '\NUL'
 
+putPosixString :: FieldWidth -> PosixString -> String
+putPosixString n s = fromPosixString (PS.take n s) ++ replicate (n - PS.length s) '\NUL'
+
 putString :: FieldWidth -> String -> String
 putString n s = take n s ++ replicate (n - length s) '\NUL'
 

tar.cabal

@@ -55,6 +55,7 @@ library tar-internal
                  deepseq    >= 1.1  && < 1.6,
                  directory  >= 1.3.1 && < 1.4,
                  filepath              < 1.6,
+                 os-string  >= 2.0 && < 2.1,
                  time                  < 1.13,
                  transformers          < 0.7,
 

test/Codec/Archive/Tar/Types/Tests.hs

@@ -17,6 +17,7 @@ module Codec.Archive.Tar.Types.Tests
   , prop_fromTarPathToWindowsPath
   ) where
 
+import Codec.Archive.Tar.PackAscii
 import Codec.Archive.Tar.Types
 
 import qualified Data.ByteString       as BS
@@ -49,8 +50,8 @@ fromTarPathRef (TarPath namebs prefixbs) = adjustDirectory $
   FilePath.Native.joinPath $ FilePath.Posix.splitDirectories prefix
                           ++ FilePath.Posix.splitDirectories name
   where
-    name   = BS.Char8.unpack namebs
-    prefix = BS.Char8.unpack prefixbs
+    name   = BS.Char8.unpack $ posixToByteString namebs
+    prefix = BS.Char8.unpack $ posixToByteString prefixbs
     adjustDirectory | FilePath.Posix.hasTrailingPathSeparator name
                     = FilePath.Native.addTrailingPathSeparator
                     | otherwise = id
@@ -60,8 +61,8 @@ fromTarPathToPosixPathRef (TarPath namebs prefixbs) = adjustDirectory $
   FilePath.Posix.joinPath $ FilePath.Posix.splitDirectories prefix
                          ++ FilePath.Posix.splitDirectories name
   where
-    name   = BS.Char8.unpack namebs
-    prefix = BS.Char8.unpack prefixbs
+    name   = BS.Char8.unpack $ posixToByteString namebs
+    prefix = BS.Char8.unpack $ posixToByteString prefixbs
     adjustDirectory | FilePath.Posix.hasTrailingPathSeparator name
                     = FilePath.Posix.addTrailingPathSeparator
                     | otherwise = id
@@ -71,8 +72,8 @@ fromTarPathToWindowsPathRef (TarPath namebs prefixbs) = adjustDirectory $
   FilePath.Windows.joinPath $ FilePath.Posix.splitDirectories prefix
                            ++ FilePath.Posix.splitDirectories name
   where
-    name   = BS.Char8.unpack namebs
-    prefix = BS.Char8.unpack prefixbs
+    name   = BS.Char8.unpack $ posixToByteString namebs
+    prefix = BS.Char8.unpack $ posixToByteString prefixbs
     adjustDirectory | FilePath.Posix.hasTrailingPathSeparator name
                     = FilePath.Windows.addTrailingPathSeparator
                     | otherwise = id
@@ -220,6 +221,6 @@ limitToV7FormatCompat entry@Entry { entryFormat = V7Format } =
       },
 
       entryTarPath = let TarPath name _prefix = entryTarPath entry
-                      in TarPath name BS.empty
+                      in TarPath name mempty
     }
 limitToV7FormatCompat entry = entry