Delete trailing white spaces

There was a space leak when copmuting the CRC for the file. This
basically retained file data so streaming did not happen in constant
memory anymore.

Codec/Archive/Zip/Conduit/Internal.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
 module Codec.Archive.Zip.Conduit.Internal
-  ( zipVersion
+  ( osVersion, zipVersion
   , zipError
   , idConduit
   , sizeCRC
@@ -15,43 +17,54 @@ import qualified Data.ByteString as BS
 import qualified Data.Conduit as C
 import qualified Data.Conduit.Internal as CI
 import           Data.Digest.CRC32 (crc32Update)
-import           Data.Word (Word16, Word32, Word64)
+import           Data.Word (Word8, Word32, Word64)
 
 import           Codec.Archive.Zip.Conduit.Types
 
--- |The version of this zip program, really just rough indicator of compatibility
+#if MIN_VERSION_conduit(1,3,0)
-zipVersion :: Word16
+#define ConduitM ConduitT
+#define PRE13(x)
+#else
+#define PRE13(x) x
+#endif
+
+-- | The version of this zip program, really just rough indicator of compatibility
+zipVersion :: Word8
 zipVersion = 48
 
+-- | The OS this implementation tries to be compatible to
+osVersion :: Word8
+osVersion = 0 -- DOS
+
 zipError :: MonadThrow m => String -> m a
 zipError = throwM . ZipError
 
-idConduit :: Monad m => C.Conduit a m a
+idConduit :: Monad m => C.ConduitM a a m ()
 idConduit = C.awaitForever C.yield
 
 passthroughFold :: Monad m => (a -> b -> a) -> a -> C.ConduitM b b m a
-passthroughFold f z = C.await >>= maybe
+passthroughFold f !z = C.await >>= maybe
   (return z)
   (\x -> do
     C.yield x
     passthroughFold f (f z x))
 
 sizeCRC :: Monad m => C.ConduitM BS.ByteString BS.ByteString m (Word64, Word32)
-sizeCRC = passthroughFold (\(l, c) b -> (l + fromIntegral (BS.length b), crc32Update c b)) (0, 0)
+sizeCRC = passthroughFold (\(!l, !c) b -> (l + fromIntegral (BS.length b), crc32Update c b)) (0, 0)
 
 sizeC :: Monad m => C.ConduitM BS.ByteString BS.ByteString m Word64
 sizeC = passthroughFold (\l b -> l + fromIntegral (BS.length b)) 0 -- fst <$> sizeCRC
 
-outputSize :: Monad m => C.Conduit i m BS.ByteString -> C.ConduitM i BS.ByteString m Word64
+outputSize :: Monad m => C.ConduitM i BS.ByteString m () -> C.ConduitM i BS.ByteString m Word64
 outputSize = (C..| sizeC)
 
-inputSize :: Monad m => C.Conduit BS.ByteString m o -> C.ConduitM BS.ByteString o m Word64
+inputSize :: Monad m => C.ConduitM BS.ByteString o m () -> C.ConduitM BS.ByteString o m Word64
 -- inputSize = fuseUpstream sizeC -- won't work because we need to deal with leftovers properly
 inputSize (CI.ConduitM src) = CI.ConduitM $ \rest -> let
   go n (CI.Done ()) = rest n
   go n (CI.PipeM m) = CI.PipeM $ go n <$> m
   go n (CI.Leftover p b) = CI.Leftover (go (n - fromIntegral (BS.length b)) p) b
-  go n (CI.HaveOutput p f o) = CI.HaveOutput (go n p) f o
+  go n (CI.HaveOutput p PRE13(f) o) = CI.HaveOutput (go n p) PRE13(f) o
   go n (CI.NeedInput p q) = CI.NeedInput (\b -> go (n + fromIntegral (BS.length b)) (p b)) (go n . q)
   in go 0 (src CI.Done)
 

Codec/Archive/Zip/Conduit/Types.hs

@@ -5,10 +5,12 @@ import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.Conduit as C
 import           Data.Conduit.Binary (sourceLbs)
+import           Data.Semigroup (Semigroup(..))
 import           Data.String (IsString(..))
+import qualified Data.Text as T
 import           Data.Time.LocalTime (LocalTime)
 import           Data.Typeable (Typeable)
-import           Data.Word (Word64)
+import           Data.Word (Word32, Word64)
 
 -- |Errors thrown during zip file processing
 newtype ZipError = ZipError String
@@ -28,23 +30,27 @@ data ZipInfo = ZipInfo
 -- |(The beginning of) a single entry in a zip stream, which may be any file or directory.
 -- As per zip file conventions, directory names should end with a slash and have no data, but this library does not ensure that.
 data ZipEntry = ZipEntry
-  { zipEntryName :: ByteString -- ^File name (in posix format, no leading slashes), usually utf-8 encoded, with a trailing slash for directories
+  { zipEntryName :: Either T.Text ByteString -- ^File name (in posix format, no leading slashes), either UTF-8 encoded text or raw bytes (CP437), with a trailing slash for directories
   , zipEntryTime :: LocalTime -- ^Modification time
-  , zipEntrySize :: Maybe Word64 -- ^Size of file data (if known); checked on zipping and also used as hint to enable zip64
+  , zipEntrySize :: Maybe Word64 -- ^Size of file data (if known); checked on zipping and also used as hint to enable zip64. Disables compression for known 0-byte files.
+  , zipEntryExternalAttributes :: Maybe Word32 -- ^Host-dependent attributes, often MS-DOS directory attribute byte (only supported when zipping)
   } deriving (Eq, Show)
 
 -- |The data contents for a 'ZipEntry'. For empty entries (e.g., directories), use 'mempty'.
 data ZipData m
   = ZipDataByteString BSL.ByteString -- ^A known ByteString, which will be fully evaluated (not streamed)
-  | ZipDataSource (C.Source m ByteString) -- ^A byte stream producer, streamed (and compressed) directly into the zip
+  | ZipDataSource (C.ConduitM () ByteString m ()) -- ^A byte stream producer, streamed (and compressed) directly into the zip
+
+instance Monad m => Semigroup (ZipData m) where
+  ZipDataByteString a <> ZipDataByteString b = ZipDataByteString $ mappend a b
+  a <> b = ZipDataSource $ mappend (sourceZipData a) (sourceZipData b)
 
 instance Monad m => Monoid (ZipData m) where
   mempty = ZipDataByteString BSL.empty
-  mappend (ZipDataByteString a) (ZipDataByteString b) = ZipDataByteString $ mappend a b
+  mappend = (<>)
-  mappend a b = ZipDataSource $ mappend (sourceZipData a) (sourceZipData b)
 
 -- |Normalize any 'ZipData' to a simple source
-sourceZipData :: Monad m => ZipData m -> C.Source m ByteString
+sourceZipData :: Monad m => ZipData m -> C.ConduitM () ByteString m ()
 sourceZipData (ZipDataByteString b) = sourceLbs b
 sourceZipData (ZipDataSource s) = s
 

Codec/Archive/Zip/Conduit/UnZip.hs

@@ -1,4 +1,5 @@
 -- |Stream the extraction of a zip file, e.g., as it's being downloaded.
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE RankNTypes #-}
 module Codec.Archive.Zip.Conduit.UnZip
@@ -9,7 +10,9 @@ module Codec.Archive.Zip.Conduit.UnZip
 
 import           Control.Applicative ((<|>), empty)
 import           Control.Monad (when, unless, guard)
+#if !MIN_VERSION_conduit(1,3,0)
 import           Control.Monad.Base (MonadBase)
+#endif
 import           Control.Monad.Catch (MonadThrow)
 import           Control.Monad.Primitive (PrimMonad)
 import qualified Data.Binary.Get as G
@@ -20,6 +23,8 @@ import qualified Data.Conduit as C
 import qualified Data.Conduit.List as CL
 import           Data.Conduit.Serialization.Binary (sinkGet)
 import qualified Data.Conduit.Zlib as CZ
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
 import           Data.Time (LocalTime(..), TimeOfDay(..), fromGregorian)
 import           Data.Word (Word16, Word32, Word64)
 
@@ -28,7 +33,7 @@ import           Codec.Archive.Zip.Conduit.Internal
 
 data Header m
   = FileHeader
-    { fileDecompress :: C.Conduit BS.ByteString m BS.ByteString
+    { fileDecompress :: C.ConduitM BS.ByteString BS.ByteString m ()
     , fileEntry :: !ZipEntry
     , fileCRC :: !Word32
     , fileCSize :: !Word64
@@ -53,7 +58,7 @@ data ExtField = ExtField
   }
 -}
 
-pass :: (MonadThrow m, Integral n) => n -> C.Conduit BS.ByteString m BS.ByteString
+pass :: (MonadThrow m, Integral n) => n -> C.ConduitM BS.ByteString BS.ByteString m ()
 pass 0 = return ()
 pass n = C.await >>= maybe
   (zipError $ "EOF in file data, expecting " ++ show ni ++ " more bytes")
@@ -94,7 +99,14 @@ fromDOSTime time date = LocalTime
 -- It does not (ironically) support uncompressed zip files that have been created as streams, where file sizes are not known beforehand.
 -- Since it does not use the offset information at the end of the file, it assumes all entries are packed sequentially, which is usually the case.
 -- Any errors are thrown in the underlying monad (as 'ZipError's or 'Data.Conduit.Serialization.Binary.ParseError').
-unZipStream :: (MonadBase b m, PrimMonad b, MonadThrow m) => C.ConduitM BS.ByteString (Either ZipEntry BS.ByteString) m ZipInfo
+unZipStream ::
+  ( MonadThrow m
+#if MIN_VERSION_conduit(1,3,0)
+  , PrimMonad m
+#else
+  , MonadBase b m, PrimMonad b
+#endif
+  ) => C.ConduitM BS.ByteString (Either ZipEntry BS.ByteString) m ZipInfo
 unZipStream = next where
   next = do -- local header, or start central directory
     h <- sinkGet $ do
@@ -126,7 +138,7 @@ unZipStream = next where
               -- optional data description (possibly ambiguous!)
               sinkGet $ (guard =<< dataDesc h) <|> return ()
               return (size == usize && crc == fileCRC)
-        unless r $ zipError $ BSC.unpack (zipEntryName fileEntry) ++ ": data integrity check failed"
+        unless r $ zipError $ either T.unpack BSC.unpack (zipEntryName fileEntry) ++ ": data integrity check failed"
         next
       EndOfCentralDirectory{..} -> do
         return endInfo
@@ -151,11 +163,12 @@ unZipStream = next where
   centralBody 0x06054b50 = EndOfCentralDirectory <$> endDirectory
   centralBody sig = fail $ "Unknown header signature: " ++ show sig
   fileHeader = do
-    ver <- G.getWord16le
+    ver <- G.getWord8
+    _os <- G.getWord8 -- OS Version (could require 0 = DOS, but we ignore ext attrs altogether)
     when (ver > zipVersion) $ fail $ "Unsupported version: " ++ show ver
     gpf <- G.getWord16le
     -- when (gpf .&. complement (bit 1 .|. bit 2 .|. bit 3) /= 0) $ fail $ "Unsupported flags: " ++ show gpf
-    when (gpf `clearBit` 1 `clearBit` 2 `clearBit` 3 /= 0) $ fail $ "Unsupported flags: " ++ show gpf
+    when (gpf `clearBit` 1 `clearBit` 2 `clearBit` 3 `clearBit` 11 /= 0) $ fail $ "Unsupported flags: " ++ show gpf
     comp <- G.getWord16le
     dcomp <- case comp of
       0 | testBit gpf 3 -> fail "Unsupported uncompressed streaming file data"
@@ -205,9 +218,10 @@ unZipStream = next where
       }
     return FileHeader
       { fileEntry = ZipEntry
-        { zipEntryName = name
+        { zipEntryName = if testBit gpf 11 then Left (TE.decodeUtf8 name) else Right name
         , zipEntryTime = time
         , zipEntrySize = if testBit gpf 3 then Nothing else Just extZip64USize
+        , zipEntryExternalAttributes = Nothing
         }
       , fileDecompress = dcomp
       , fileCSize = extZip64CSize

Codec/Archive/Zip/Conduit/Zip.hs

@@ -1,4 +1,5 @@
 -- |Stream the creation of a zip file, e.g., as it's being uploaded.
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 module Codec.Archive.Zip.Conduit.Zip
@@ -14,7 +15,9 @@ module Codec.Archive.Zip.Conduit.Zip
 import qualified Codec.Compression.Zlib.Raw as Z
 import           Control.Arrow ((&&&), (+++), left)
 import           Control.Monad (when)
+#if !MIN_VERSION_conduit(1,3,0)
 import           Control.Monad.Base (MonadBase)
+#endif
 import           Control.Monad.Catch (MonadThrow)
 import           Control.Monad.Primitive (PrimMonad)
 import           Control.Monad.State.Strict (StateT, get)
@@ -32,7 +35,8 @@ import qualified Data.Conduit.Zlib as CZ
 import           Data.Digest.CRC32 (crc32)
 import           Data.Either (isLeft)
 import           Data.Maybe (fromMaybe, fromJust)
-import           Data.Monoid ((<>))
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
 import           Data.Time (LocalTime(..), TimeOfDay(..), toGregorian)
 import           Data.Word (Word16, Word64)
 
@@ -64,7 +68,7 @@ False ?* _ = 0
 zipFileData :: MonadResource m => FilePath -> ZipData m
 zipFileData = ZipDataSource . CB.sourceFile
 
-zipData :: Monad m => ZipData m -> Either (C.Source m BS.ByteString) BSL.ByteString
+zipData :: Monad m => ZipData m -> Either (C.ConduitM () BS.ByteString m ()) BSL.ByteString
 zipData (ZipDataByteString b) = Right b
 zipData (ZipDataSource s) = Left s
 
@@ -73,12 +77,12 @@ dataSize (Left _) = Nothing
 dataSize (Right b) = Just $ fromIntegral $ BSL.length b
 
 toDOSTime :: LocalTime -> (Word16, Word16)
-toDOSTime (LocalTime (toGregorian -> (year, month, day)) (TimeOfDay hour mins secs)) = 
+toDOSTime (LocalTime (toGregorian -> (year, month, day)) (TimeOfDay hour mins secs)) =
   ( fromIntegral hour `shiftL` 11 .|. fromIntegral mins `shiftL` 5 .|. truncate secs `shiftR` 1
   , fromIntegral (year - 1980) `shiftL` 9 .|. fromIntegral month `shiftL` 5 .|. fromIntegral day
   )
 
-countOutput :: Monad m => C.Conduit i m BS.ByteString -> C.Conduit i (StateT Word64 m) BS.ByteString
+countOutput :: Monad m => C.ConduitM i BS.ByteString m () -> C.ConduitM i BS.ByteString (StateT Word64 m) ()
 countOutput c = stateC $ \s -> (,) () . (s +) <$> outputSize c
 
 output :: MonadThrow m => P.Put -> C.ConduitM i BS.ByteString (StateT Word64 m) ()
@@ -93,23 +97,32 @@ maxBound16 = fromIntegral (maxBound :: Word16)
 --
 -- Depending on options, the resulting zip file should be compatible with most unzipping applications.
 -- Any errors are thrown in the underlying monad (as 'ZipError's).
-zipStream :: (MonadBase b m, PrimMonad b, MonadThrow m) => ZipOptions -> C.ConduitM (ZipEntry, ZipData m) BS.ByteString m Word64
+zipStream ::
+  ( MonadThrow m
+#if MIN_VERSION_conduit(1,3,0)
+  , PrimMonad m
+#else
+  , MonadBase b m, PrimMonad b
+#endif
+  ) => ZipOptions -> C.ConduitM (ZipEntry, ZipData m) BS.ByteString m Word64
 zipStream ZipOptions{..} = execStateC 0 $ do
-  (cnt, cdir) <- next 0 (mempty :: P.Put)
+  (cnt, cdir) <- next 0 (return ())
   cdoff <- get
   output cdir
   eoff <- get
-  endDirectory cdoff (eoff - cdoff) cnt 
+  endDirectory cdoff (eoff - cdoff) cnt
   where
   next cnt dir = C.await >>= maybe
     (return (cnt, dir))
     (\e -> do
       d <- entry e
-      next (succ cnt) $ dir <> d)
+      next (succ cnt) $ dir >> d)
   entry (ZipEntry{..}, zipData -> dat) = do
     let usiz = dataSize dat
         sdat = left ((C..| sizeCRC) . C.toProducer) dat
-        comp = zipOptCompressLevel /= 0 && all (0 /=) usiz
+        comp = zipOptCompressLevel /= 0
+               && all (0 /=) usiz
+               && all (0 /=) zipEntrySize
         (cdat, csiz)
           | comp =
             ( ((`C.fuseBoth` (outputSize $ CZ.compress zipOptCompressLevel deflateWindowBits))
@@ -118,26 +131,28 @@ zipStream ZipOptions{..} = execStateC 0 $ do
           | otherwise = (left (fmap (id &&& fst)) sdat, usiz)
         z64 = maybe (zipOpt64 || any (maxBound32 <) zipEntrySize)
           (maxBound32 <) (max <$> usiz <*> csiz)
-        namelen = BS.length zipEntryName
+        name = either TE.encodeUtf8 id zipEntryName
+        namelen = BS.length name
         (time, date) = toDOSTime zipEntryTime
         mcrc = either (const Nothing) (Just . crc32) dat
-    when (namelen > maxBound16) $ zipError $ BSC.unpack zipEntryName ++ ": entry name too long"
+    when (namelen > maxBound16) $ zipError $ either T.unpack BSC.unpack zipEntryName ++ ": entry name too long"
     let common = do
-          P.putWord16le $ isLeft dat ?* bit 3
+          P.putWord16le $ isLeft dat ?* bit 3 .|. isLeft zipEntryName ?* bit 11
           P.putWord16le $ comp ?* 8
           P.putWord16le $ time
           P.putWord16le $ date
     off <- get
     output $ do
       P.putWord32le 0x04034b50
-      P.putWord16le $ if z64 then 45 else 20
+      P.putWord8 $ if z64 then 45 else 20
+      P.putWord8 osVersion
       common
       P.putWord32le $ fromMaybe 0 mcrc
       P.putWord32le $ if z64 then maxBound32 else maybe 0 fromIntegral csiz
       P.putWord32le $ if z64 then maxBound32 else maybe 0 fromIntegral usiz
       P.putWord16le $ fromIntegral namelen
       P.putWord16le $ z64 ?* 20
-      P.putByteString zipEntryName
+      P.putByteString name
       when z64 $ do
         P.putWord16le 0x0001
         P.putWord16le 16
@@ -147,7 +162,7 @@ zipStream ZipOptions{..} = execStateC 0 $ do
     ((usz, crc), csz) <- either
       (\cd -> do
         r@((usz, crc), csz) <- outsz cd -- write compressed data
-        when (not z64 && (usz > maxBound32 || csz > maxBound32)) $ zipError $ BSC.unpack zipEntryName ++ ": file too large and zipOpt64 disabled"
+        when (not z64 && (usz > maxBound32 || csz > maxBound32)) $ zipError $ either T.unpack BSC.unpack zipEntryName ++ ": file too large and zipOpt64 disabled"
         output $ do
           P.putWord32le 0x08074b50
           P.putWord32le crc
@@ -159,15 +174,17 @@ zipStream ZipOptions{..} = execStateC 0 $ do
         return r)
       (\b -> outsz $ ((fromJust usiz, fromJust mcrc), fromJust csiz) <$ CB.sourceLbs b)
       cdat
-    when (any (usz /=) zipEntrySize) $ zipError $ BSC.unpack zipEntryName ++ ": incorrect zipEntrySize"
+    when (any (usz /=) zipEntrySize) $ zipError $ either T.unpack BSC.unpack zipEntryName ++ ": incorrect zipEntrySize"
     return $ do
       -- central directory
       let o64 = off >= maxBound32
           l64 = z64 ?* 16 + o64 ?* 8
           a64 = z64 || o64
       P.putWord32le 0x02014b50
-      P.putWord16le zipVersion
+      P.putWord8 zipVersion
-      P.putWord16le $ if a64 then 45 else 20
+      P.putWord8 osVersion
+      P.putWord8 $ if a64 then 45 else 20
+      P.putWord8 osVersion
       common
       P.putWord32le crc
       P.putWord32le $ if z64 then maxBound32 else fromIntegral csz
@@ -177,9 +194,9 @@ zipStream ZipOptions{..} = execStateC 0 $ do
       P.putWord16le 0 -- comment length
       P.putWord16le 0 -- disk number
       P.putWord16le 0 -- internal file attributes
-      P.putWord32le 0 -- external file attributes
+      P.putWord32le $ fromMaybe 0 zipEntryExternalAttributes
       P.putWord32le $ if o64 then maxBound32 else fromIntegral off
-      P.putByteString zipEntryName
+      P.putByteString name
       when a64 $ do
         P.putWord16le 0x0001
         P.putWord16le l64
@@ -193,8 +210,10 @@ zipStream ZipOptions{..} = execStateC 0 $ do
     when z64 $ output $ do
       P.putWord32le 0x06064b50 -- zip64 end
       P.putWord64le 44 -- length of this record
-      P.putWord16le zipVersion
+      P.putWord8 zipVersion
-      P.putWord16le 45
+      P.putWord8 osVersion
+      P.putWord8 45
+      P.putWord8 osVersion
       P.putWord32le 0 -- disk
       P.putWord32le 0 -- central disk
       P.putWord64le cnt

cmd/unzip.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 import           Control.Monad (when, unless)
 import           Control.Monad.IO.Class (liftIO)
@@ -5,8 +6,15 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.Conduit as C
 import qualified Data.Conduit.Binary as CB
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
 import           Data.Time.LocalTime (localTimeToUTC, utc)
-import           System.Directory (createDirectoryIfMissing, setModificationTime)
+import           Data.Void (Void)
+import           System.Directory (createDirectoryIfMissing
+#if MIN_VERSION_directory(1,2,3)
+  , setModificationTime
+#endif
+  )
 import           System.Environment (getProgName, getArgs)
 import           System.Exit (exitFailure)
 import           System.FilePath.Posix (takeDirectory) -- zip files only use forward slashes
@@ -14,20 +22,22 @@ import           System.IO (stdin, openFile, IOMode(WriteMode), hClose, hSetFile
 
 import           Codec.Archive.Zip.Conduit.UnZip
 
-extract :: C.Sink (Either ZipEntry BS.ByteString) IO ()
+extract :: C.ConduitM (Either ZipEntry BS.ByteString) Void IO ()
 extract = C.awaitForever start where
   start (Left ZipEntry{..}) = do
-    liftIO $ BSC.putStrLn zipEntryName
+    liftIO $ either TIO.putStrLn BSC.putStrLn zipEntryName
     liftIO $ createDirectoryIfMissing True (takeDirectory name)
-    if BSC.last zipEntryName == '/'
+    if either T.last BSC.last zipEntryName == '/'
       then when ((0 /=) `any` zipEntrySize) $ fail $ name ++ ": non-empty directory"
       else do -- C.bracketP
         h <- liftIO $ openFile name WriteMode
         mapM_ (liftIO . hSetFileSize h . toInteger) zipEntrySize
         write C..| CB.sinkHandle h
         liftIO $ hClose h
+#if MIN_VERSION_directory(1,2,3)
     liftIO $ setModificationTime name $ localTimeToUTC utc zipEntryTime -- FIXME: timezone
-    where name = BSC.unpack $ BSC.dropWhile ('/' ==) zipEntryName -- should we utf8 decode?
+#endif
+    where name = either (T.unpack . T.dropWhile ('/' ==)) (BSC.unpack . BSC.dropWhile ('/' ==)) zipEntryName
   start (Right _) = fail "Unexpected leading or directory data contents"
   write = C.await >>= maybe
     (return ())
@@ -42,7 +52,7 @@ main = do
   unless (null args) $ do
     hPutStrLn stderr $ "Usage: " ++ prog ++ "\nRead a zip file from stdin and extract it in the current directory."
     exitFailure
-  ZipInfo{..} <- C.runConduit 
+  ZipInfo{..} <- C.runConduit
     $ CB.sourceHandle stdin
     C..| C.fuseUpstream unZipStream extract
   BSC.putStrLn zipComment

cmd/zip.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+import           Control.Arrow ((+++))
 import           Control.Monad (filterM, void)
 import           Control.Monad.IO.Class (MonadIO, liftIO)
 import           Control.Monad.Trans.Resource (MonadResource, runResourceT)
@@ -5,9 +7,21 @@ import qualified Data.ByteString.Char8 as BSC
 import qualified Data.Conduit as C
 import qualified Data.Conduit.Binary as CB
 import           Data.List (foldl')
+import qualified Data.Text as T
 import           Data.Time.LocalTime (utcToLocalTime, utc)
 import qualified System.Console.GetOpt as Opt
-import           System.Directory (doesDirectoryExist, getModificationTime, isSymbolicLink, listDirectory)
+import           System.Directory (doesDirectoryExist, getModificationTime
+#if MIN_VERSION_directory(1,2,6)
+#if MIN_VERSION_directory(1,3,0)
+  , pathIsSymbolicLink
+#else
+  , isSymbolicLink
+#endif
+  , listDirectory
+#else
+  , getDirectoryContents
+#endif
+  )
 import           System.Environment (getProgName, getArgs)
 import           System.Exit (exitFailure)
 import           System.FilePath.Posix ((</>)) -- zip files only want forward slashes
@@ -27,19 +41,31 @@ opts =
     "set zip comment"
   ]
 
-generate :: (MonadIO m, MonadResource m) => [FilePath] -> C.Source m (ZipEntry, ZipData m)
+generate :: (MonadIO m, MonadResource m) => [FilePath] -> C.ConduitM () (ZipEntry, ZipData m) m ()
 generate (p:paths) = do
   t <- liftIO $ getModificationTime p
   let e = ZipEntry
-        { zipEntryName = BSC.pack $ dropWhile ('/' ==) p
+        { zipEntryName = Right $ BSC.pack $ dropWhile ('/' ==) p
         , zipEntryTime = utcToLocalTime utc t -- FIXME: timezone
         , zipEntrySize = Nothing
+        , zipEntryExternalAttributes = Nothing
         }
   isd <- liftIO $ doesDirectoryExist p
   if isd
     then do
-      dl <- liftIO $ filterM (fmap not . isSymbolicLink) . map (p </>) =<< listDirectory p
+      dl <- liftIO $
-      C.yield (e{ zipEntryName = zipEntryName e `BSC.snoc` '/', zipEntrySize = Just 0 }, mempty)
+#if MIN_VERSION_directory(1,2,6)
+        filterM (fmap not .
+#if MIN_VERSION_directory(1,3,0)
+          pathIsSymbolicLink
+#else
+          isSymbolicLink
+#endif
+          ) . map (p </>) =<< listDirectory p
+#else
+        filter (`notElem` [".",".."]) . map (p </>) <$> getDirectoryContents p
+#endif
+      C.yield (e{ zipEntryName = (`T.snoc` '/') +++ (`BSC.snoc` '/') $ zipEntryName e, zipEntrySize = Just 0 }, mempty)
       generate $ dl ++ paths
     else do
       C.yield (e, zipFileData p)

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-8.13
+resolver: lts-12.14
 packages:
 - '.'
 extra-deps: []

zip-stream.cabal

@@ -1,5 +1,5 @@
 name:                zip-stream
-version:             0.1
+version:             0.2.0.1
 synopsis:            ZIP archive streaming using conduits
 description:         Process (extract and create) zip files as streams (e.g., over the network), accessing contained files without having to write the zip file to disk (unlike zip-conduit).
 license:             BSD3
@@ -25,7 +25,7 @@ library
   default-language:    Haskell2010
   ghc-options: -Wall
   build-depends:       
-    base >= 4.8 && < 5,
+    base >= 4.9 && < 5,
     binary >= 0.7.2,
     binary-conduit,
     bytestring,
@@ -36,6 +36,7 @@ library
     mtl,
     primitive,
     resourcet,
+    text,
     time,
     transformers-base,
     zlib
@@ -46,13 +47,15 @@ executable unzip-stream
   default-language:    Haskell2010
   ghc-options: -Wall
   build-depends:
-    base >=4.7 && <5,
+    base >=4.8 && <5,
     bytestring,
     conduit,
     conduit-extra,
     directory,
     filepath,
+    text,
     time,
+    transformers,
     zip-stream
 
 executable zip-stream
@@ -61,12 +64,14 @@ executable zip-stream
   default-language:    Haskell2010
   ghc-options: -Wall
   build-depends:
-    base >=4.7 && <5,
+    base >=4.8 && <5,
     bytestring,
     conduit,
     conduit-extra,
     directory,
     filepath,
     resourcet,
+    text,
     time,
+    transformers,
     zip-stream