Zip UTF8-support

This commit is contained in:
Gregor Kleen 2017-10-18 15:30:02 +02:00
parent 4a59f9ca64
commit 0cd0425903
2 changed files with 9 additions and 10 deletions

View File

@ -24,9 +24,6 @@ import qualified Data.ByteString.Lazy as Lazy.ByteString
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString import qualified Data.ByteString as ByteString
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import System.FilePath import System.FilePath
import Data.Time import Data.Time
@ -52,14 +49,13 @@ consumeZip = unZipStream `fuseUpstream` consumeZip'
case input of case input of
Nothing -> return () Nothing -> return ()
Just (Right _) -> throw $ userError "Data chunk in unexpected place when parsing ZIP" Just (Right _) -> throw $ userError "Data chunk in unexpected place when parsing ZIP"
Just (Left e) -> do Just (Left ZipEntry{..}) -> do
zipEntryName' <- fmap Text.unpack . either throw return . Text.decodeUtf8' $ zipEntryName e
contentChunks <- toConsumer accContents contentChunks <- toConsumer accContents
let let
fileTitle = normalise $ makeValid zipEntryName' fileTitle = normalise $ makeValid zipEntryName
fileModified = localTimeToUTC utc $ zipEntryTime e fileModified = localTimeToUTC utc zipEntryTime
fileContent fileContent
| hasTrailingPathSeparator zipEntryName' = Nothing | hasTrailingPathSeparator zipEntryName = Nothing
| otherwise = Just $ mconcat contentChunks | otherwise = Just $ mconcat contentChunks
yield $ File{..} yield $ File{..}
consumeZip' consumeZip'
@ -89,7 +85,7 @@ produceZip info = mapC toZipData =$= void (zipStream zipOptions)
toZipEntry :: File -> ZipEntry toZipEntry :: File -> ZipEntry
toZipEntry File{..} = ZipEntry toZipEntry File{..} = ZipEntry
{ zipEntryName = Text.encodeUtf8 . Text.pack . bool (dropWhileEnd isPathSeparator) addTrailingPathSeparator isDir . normalise . makeValid $ fileTitle { zipEntryName = bool (dropWhileEnd isPathSeparator) addTrailingPathSeparator isDir . normalise . makeValid $ fileTitle
, zipEntryTime = utcToLocalTime utc fileModified , zipEntryTime = utcToLocalTime utc fileModified
} }
where where

View File

@ -12,7 +12,7 @@ packages:
extra-dep: true extra-dep: true
- location: - location:
git: https://github.com/pngwjpgh/zip-stream.git git: https://github.com/pngwjpgh/zip-stream.git
commit: f6a40e6d214653cf405186e72d4e1b79065ec2d0 commit: 9272bbed000928d500febad1cdc98d1da29d399e
extra-dep: true extra-dep: true
extra-deps: extra-deps:
- colonnade-1.1.1 - colonnade-1.1.1
@ -21,4 +21,7 @@ extra-deps:
- uuid-crypto-1.3.0.0 - uuid-crypto-1.3.0.0
- cryptoids-0.3.0.0 - cryptoids-0.3.0.0
- cryptoids-types-0.0.0 - cryptoids-types-0.0.0
- encoding-0.8.2
- regex-compat-0.93.1
resolver: lts-9.3 resolver: lts-9.3