-- |Stream the creation of a zip file, e.g., as it's being uploaded.
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Codec.Archive.Zip.Conduit.Zip
  ( zipStream
  , ZipOptions(..)
  , ZipInfo(..)
  , defaultZipOptions
  , ZipEntry(..)
  , ZipData(..)
  , zipFileData
  ) where

import qualified Codec.Compression.Zlib.Raw as Z
import           Control.Arrow ((&&&), (+++), left)
import           Control.Monad (when)
import           Control.Monad.Catch (MonadThrow)
import           Control.Monad.Primitive (PrimMonad)
import           Control.Monad.State.Strict (StateT, get)
import           Control.Monad.Trans.Resource (MonadResource)
import qualified Data.Binary.Put as P
import           Data.Bits (bit, shiftL, shiftR, (.|.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Conduit as C
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.Combinators as CC
import           Data.Conduit.Lift (stateC, execStateC)
import           Data.Conduit.Serialization.Binary (sourcePut)
import qualified Data.Conduit.Zlib as CZ
import           Data.Digest.CRC32 (crc32)
import           Data.Either (isLeft)
import           Data.Maybe (fromMaybe, fromJust)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import           Data.Time (LocalTime(..), TimeOfDay(..), toGregorian)
import           Data.Word (Word16, Word64)

import           Codec.Archive.Zip.Conduit.Types
import           Codec.Archive.Zip.Conduit.Internal

-- |Options controlling zip file parameters and features
data ZipOptions = ZipOptions
  { ZipOptions -> Bool
zipOpt64 :: Bool -- ^Allow 'ZipDataSource's over 4GB (reduces compatibility in some cases); this is automatically enabled for any files of known size (e.g., 'zipEntrySize')
  , ZipOptions -> Int
zipOptCompressLevel :: Int -- ^Compress zipped files (0 = store only, 1 = minimal, 9 = best; non-zero improves compatibility, since some unzip programs don't supported stored, streamed files, including the one in this package)
  , ZipOptions -> ZipInfo
zipOptInfo :: ZipInfo -- ^Other parameters to store in the zip file
  }

defaultZipOptions :: ZipOptions
defaultZipOptions :: ZipOptions
defaultZipOptions = ZipOptions :: Bool -> Int -> ZipInfo -> ZipOptions
ZipOptions
  { zipOpt64 :: Bool
zipOpt64 = Bool
False
  , zipOptCompressLevel :: Int
zipOptCompressLevel = -Int
1
  , zipOptInfo :: ZipInfo
zipOptInfo = ZipInfo :: ByteString -> ZipInfo
ZipInfo
    { zipComment :: ByteString
zipComment = ByteString
BS.empty
    }
  }

infixr 7 ?*
(?*) :: Num a => Bool -> a -> a
Bool
True ?* :: Bool -> a -> a
?* a
x = a
x
Bool
False ?* a
_ = a
0

-- |Use a file on disk as 'ZipData' (@'ZipDataSource' . 'CC.sourceFile'@).
zipFileData :: MonadResource m => FilePath -> ZipData m
zipFileData :: FilePath -> ZipData m
zipFileData = ConduitM () ByteString m () -> ZipData m
forall (m :: * -> *). ConduitM () ByteString m () -> ZipData m
ZipDataSource (ConduitM () ByteString m () -> ZipData m)
-> (FilePath -> ConduitM () ByteString m ())
-> FilePath
-> ZipData m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ConduitM () ByteString m ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
CC.sourceFile

zipData :: Monad m => ZipData m -> Either (C.ConduitM () BS.ByteString m ()) BSL.ByteString
zipData :: ZipData m -> Either (ConduitM () ByteString m ()) ByteString
zipData (ZipDataByteString ByteString
b) = ByteString -> Either (ConduitM () ByteString m ()) ByteString
forall a b. b -> Either a b
Right ByteString
b
zipData (ZipDataSource ConduitM () ByteString m ()
s) = ConduitM () ByteString m ()
-> Either (ConduitM () ByteString m ()) ByteString
forall a b. a -> Either a b
Left ConduitM () ByteString m ()
s

dataSize :: Either a BSL.ByteString -> Maybe Word64
dataSize :: Either a ByteString -> Maybe Word64
dataSize (Left a
_) = Maybe Word64
forall a. Maybe a
Nothing
dataSize (Right ByteString
b) = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
b

toDOSTime :: LocalTime -> (Word16, Word16)
toDOSTime :: LocalTime -> (Word16, Word16)
toDOSTime (LocalTime (Day -> (Integer, Int, Int)
toGregorian -> (Integer
year, Int
month, Int
day)) (TimeOfDay Int
hour Int
mins Pico
secs)) =
  ( Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hour Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
11 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mins Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
5 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Pico -> Word16
forall a b. (RealFrac a, Integral b) => a -> b
truncate Pico
secs Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
  , Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
year Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1980) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
9 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
month Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
5 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
day
  )

countOutput :: Monad m => C.ConduitM i BS.ByteString m () -> C.ConduitM i BS.ByteString (StateT Word64 m) ()
countOutput :: ConduitM i ByteString m ()
-> ConduitM i ByteString (StateT Word64 m) ()
countOutput ConduitM i ByteString m ()
c = (Word64 -> ConduitT i ByteString m ((), Word64))
-> ConduitM i ByteString (StateT Word64 m) ()
forall (m :: * -> *) s i o a.
Monad m =>
(s -> ConduitT i o m (a, s)) -> ConduitT i o (StateT s m) a
stateC ((Word64 -> ConduitT i ByteString m ((), Word64))
 -> ConduitM i ByteString (StateT Word64 m) ())
-> (Word64 -> ConduitT i ByteString m ((), Word64))
-> ConduitM i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ \Word64
s -> (,) () (Word64 -> ((), Word64))
-> (Word64 -> Word64) -> Word64 -> ((), Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+) (Word64 -> ((), Word64))
-> ConduitT i ByteString m Word64
-> ConduitT i ByteString m ((), Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitM i ByteString m () -> ConduitT i ByteString m Word64
forall (m :: * -> *) i.
Monad m =>
ConduitT i ByteString m () -> ConduitT i ByteString m Word64
outputSize ConduitM i ByteString m ()
c

output :: MonadThrow m => P.Put -> C.ConduitM i BS.ByteString (StateT Word64 m) ()
output :: Put -> ConduitM i ByteString (StateT Word64 m) ()
output = ConduitM i ByteString m ()
-> ConduitM i ByteString (StateT Word64 m) ()
forall (m :: * -> *) i.
Monad m =>
ConduitM i ByteString m ()
-> ConduitM i ByteString (StateT Word64 m) ()
countOutput (ConduitM i ByteString m ()
 -> ConduitM i ByteString (StateT Word64 m) ())
-> (Put -> ConduitM i ByteString m ())
-> Put
-> ConduitM i ByteString (StateT Word64 m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ConduitM i ByteString m ()
forall (m :: * -> *) z.
Monad m =>
Put -> ConduitT z ByteString m ()
sourcePut

maxBound16 :: Integral n => n
maxBound16 :: n
maxBound16 = Word16 -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
forall a. Bounded a => a
maxBound :: Word16)

-- |Stream produce a zip file, reading a sequence of entries with data.
-- Although file data is never kept in memory (beyond a single 'ZipDataByteString'), the format of zip files requires producing a final directory of entries at the end of the file, consuming an additional ~100 bytes of state per entry during streaming.
-- The final result is the total size of the zip file.
--
-- 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 ::
  ( MonadThrow m
  , PrimMonad m
  ) => ZipOptions -> C.ConduitM (ZipEntry, ZipData m) BS.ByteString m Word64
zipStream :: ZipOptions -> ConduitM (ZipEntry, ZipData m) ByteString m Word64
zipStream ZipOptions{Bool
Int
ZipInfo
zipOptInfo :: ZipInfo
zipOptCompressLevel :: Int
zipOpt64 :: Bool
zipOptInfo :: ZipOptions -> ZipInfo
zipOptCompressLevel :: ZipOptions -> Int
zipOpt64 :: ZipOptions -> Bool
..} = Word64
-> ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) ()
-> ConduitM (ZipEntry, ZipData m) ByteString m Word64
forall (m :: * -> *) s i o r.
Monad m =>
s -> ConduitT i o (StateT s m) r -> ConduitT i o m s
execStateC Word64
0 (ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) ()
 -> ConduitM (ZipEntry, ZipData m) ByteString m Word64)
-> ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) ()
-> ConduitM (ZipEntry, ZipData m) ByteString m Word64
forall a b. (a -> b) -> a -> b
$ do
  (Word64
cnt, Put
cdir) <- Word64
-> Put
-> ConduitT
     (ZipEntry, ZipData m) ByteString (StateT Word64 m) (Word64, Put)
forall (m :: * -> *) t.
(PrimMonad m, MonadThrow m, Enum t) =>
t
-> Put
-> ConduitT
     (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put)
next Word64
0 (() -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  Word64
cdoff <- ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) Word64
forall s (m :: * -> *). MonadState s m => m s
get
  Put
-> ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) ()
forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output Put
cdir
  Word64
eoff <- ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) Word64
forall s (m :: * -> *). MonadState s m => m s
get
  Word64
-> Word64
-> Word64
-> ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) ()
forall (m :: * -> *) i.
MonadThrow m =>
Word64
-> Word64 -> Word64 -> ConduitT i ByteString (StateT Word64 m) ()
endDirectory Word64
cdoff (Word64
eoff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
cdoff) Word64
cnt
  where
  next :: t
-> Put
-> ConduitT
     (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put)
next t
cnt Put
dir = ConduitT
  (ZipEntry, ZipData m)
  ByteString
  (StateT Word64 m)
  (Maybe (ZipEntry, ZipData m))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
C.await ConduitT
  (ZipEntry, ZipData m)
  ByteString
  (StateT Word64 m)
  (Maybe (ZipEntry, ZipData m))
-> (Maybe (ZipEntry, ZipData m)
    -> ConduitT
         (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put))
-> ConduitT
     (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT
  (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put)
-> ((ZipEntry, ZipData m)
    -> ConduitT
         (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put))
-> Maybe (ZipEntry, ZipData m)
-> ConduitT
     (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    ((t, Put)
-> ConduitT
     (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put)
forall (m :: * -> *) a. Monad m => a -> m a
return (t
cnt, Put
dir))
    (\(ZipEntry, ZipData m)
e -> do
      Put
d <- (ZipEntry, ZipData m)
-> ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) Put
forall (m :: * -> *) i.
(PrimMonad m, MonadThrow m) =>
(ZipEntry, ZipData m)
-> ConduitT i ByteString (StateT Word64 m) Put
entry (ZipEntry, ZipData m)
e
      t
-> Put
-> ConduitT
     (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put)
next (t -> t
forall a. Enum a => a -> a
succ t
cnt) (Put
 -> ConduitT
      (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put))
-> Put
-> ConduitT
     (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put)
forall a b. (a -> b) -> a -> b
$ Put
dir Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
d)
  entry :: (ZipEntry, ZipData m)
-> ConduitT i ByteString (StateT Word64 m) Put
entry (ZipEntry{Maybe Word32
Maybe Word64
Either Text ByteString
LocalTime
zipEntryExternalAttributes :: ZipEntry -> Maybe Word32
zipEntrySize :: ZipEntry -> Maybe Word64
zipEntryTime :: ZipEntry -> LocalTime
zipEntryName :: ZipEntry -> Either Text ByteString
zipEntryExternalAttributes :: Maybe Word32
zipEntrySize :: Maybe Word64
zipEntryTime :: LocalTime
zipEntryName :: Either Text ByteString
..}, ZipData m -> Either (ConduitM () ByteString m ()) ByteString
forall (m :: * -> *).
Monad m =>
ZipData m -> Either (ConduitM () ByteString m ()) ByteString
zipData -> Either (ConduitM () ByteString m ()) ByteString
dat) = do
    let usiz :: Maybe Word64
usiz = Either (ConduitM () ByteString m ()) ByteString -> Maybe Word64
forall a. Either a ByteString -> Maybe Word64
dataSize Either (ConduitM () ByteString m ()) ByteString
dat
        sdat :: Either (ConduitM a ByteString m (Word64, Word32)) ByteString
sdat = (ConduitM () ByteString m ()
 -> ConduitM a ByteString m (Word64, Word32))
-> Either (ConduitM () ByteString m ()) ByteString
-> Either (ConduitM a ByteString m (Word64, Word32)) ByteString
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ((ConduitM a ByteString m ()
-> ConduitM ByteString ByteString m (Word64, Word32)
-> ConduitM a ByteString m (Word64, Word32)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM ByteString ByteString m (Word64, Word32)
forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m (Word64, Word32)
sizeCRC) (ConduitM a ByteString m ()
 -> ConduitM a ByteString m (Word64, Word32))
-> (ConduitM () ByteString m () -> ConduitM a ByteString m ())
-> ConduitM () ByteString m ()
-> ConduitM a ByteString m (Word64, Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitM () ByteString m () -> ConduitM a ByteString m ()
forall (m :: * -> *) a. Monad m => Source m a -> Producer m a
C.toProducer) Either (ConduitM () ByteString m ()) ByteString
dat
        comp :: Bool
comp = Int
zipOptCompressLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
               Bool -> Bool -> Bool
&& (Word64 -> Bool) -> Maybe Word64 -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word64
0 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/=) Maybe Word64
usiz
               Bool -> Bool -> Bool
&& (Word64 -> Bool) -> Maybe Word64 -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word64
0 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/=) Maybe Word64
zipEntrySize
        (Either
  (ConduitT a ByteString m ((Word64, Word32), Word64)) ByteString
cdat, Maybe Word64
csiz)
          | Bool
comp =
            ( ((ConduitT a ByteString m (Word64, Word32)
-> ConduitT ByteString ByteString m Word64
-> ConduitT a ByteString m ((Word64, Word32), Word64)
forall (m :: * -> *) a b r1 c r2.
Monad m =>
ConduitT a b m r1 -> ConduitT b c m r2 -> ConduitT a c m (r1, r2)
`C.fuseBoth` (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m Word64
forall (m :: * -> *) i.
Monad m =>
ConduitT i ByteString m () -> ConduitT i ByteString m Word64
outputSize (ConduitT ByteString ByteString m ()
 -> ConduitT ByteString ByteString m Word64)
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m Word64
forall a b. (a -> b) -> a -> b
$ Int -> WindowBits -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
Int -> WindowBits -> ConduitT ByteString ByteString m ()
CZ.compress Int
zipOptCompressLevel WindowBits
deflateWindowBits))
              (ConduitT a ByteString m (Word64, Word32)
 -> ConduitT a ByteString m ((Word64, Word32), Word64))
-> (ByteString -> ByteString)
-> Either (ConduitT a ByteString m (Word64, Word32)) ByteString
-> Either
     (ConduitT a ByteString m ((Word64, Word32), Word64)) ByteString
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ ByteString -> ByteString
Z.compress) Either (ConduitT a ByteString m (Word64, Word32)) ByteString
forall a.
Either (ConduitM a ByteString m (Word64, Word32)) ByteString
sdat -- level for Z.compress?
            , Either
  (ConduitT a ByteString m ((Word64, Word32), Word64)) ByteString
-> Maybe Word64
forall a. Either a ByteString -> Maybe Word64
dataSize Either
  (ConduitT a ByteString m ((Word64, Word32), Word64)) ByteString
cdat)
          | Bool
otherwise = ((ConduitT a ByteString m (Word64, Word32)
 -> ConduitT a ByteString m ((Word64, Word32), Word64))
-> Either (ConduitT a ByteString m (Word64, Word32)) ByteString
-> Either
     (ConduitT a ByteString m ((Word64, Word32), Word64)) ByteString
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (((Word64, Word32) -> ((Word64, Word32), Word64))
-> ConduitT a ByteString m (Word64, Word32)
-> ConduitT a ByteString m ((Word64, Word32), Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word64, Word32) -> (Word64, Word32)
forall a. a -> a
id ((Word64, Word32) -> (Word64, Word32))
-> ((Word64, Word32) -> Word64)
-> (Word64, Word32)
-> ((Word64, Word32), Word64)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Word64, Word32) -> Word64
forall a b. (a, b) -> a
fst)) Either (ConduitT a ByteString m (Word64, Word32)) ByteString
forall a.
Either (ConduitM a ByteString m (Word64, Word32)) ByteString
sdat, Maybe Word64
usiz)
        z64 :: Bool
z64 = Bool -> (Word64 -> Bool) -> Maybe Word64 -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
zipOpt64 Bool -> Bool -> Bool
|| (Word64 -> Bool) -> Maybe Word64 -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Word64
forall n. Integral n => n
maxBound32 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<) Maybe Word64
zipEntrySize)
          (Word64
forall n. Integral n => n
maxBound32 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<) (Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max (Word64 -> Word64 -> Word64)
-> Maybe Word64 -> Maybe (Word64 -> Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word64
usiz Maybe (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Word64
csiz)
        name :: ByteString
name = (Text -> ByteString)
-> (ByteString -> ByteString)
-> Either Text ByteString
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> ByteString
TE.encodeUtf8 ByteString -> ByteString
forall a. a -> a
id Either Text ByteString
zipEntryName
        namelen :: Int
namelen = ByteString -> Int
BS.length ByteString
name
        (Word16
time, Word16
date) = LocalTime -> (Word16, Word16)
toDOSTime LocalTime
zipEntryTime
        mcrc :: Maybe Word32
mcrc = (ConduitM () ByteString m () -> Maybe Word32)
-> (ByteString -> Maybe Word32)
-> Either (ConduitM () ByteString m ()) ByteString
-> Maybe Word32
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Word32 -> ConduitM () ByteString m () -> Maybe Word32
forall a b. a -> b -> a
const Maybe Word32
forall a. Maybe a
Nothing) (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32)
-> (ByteString -> Word32) -> ByteString -> Maybe Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word32
forall a. CRC32 a => a -> Word32
crc32) Either (ConduitM () ByteString m ()) ByteString
dat
    Bool
-> ConduitT i ByteString (StateT Word64 m) ()
-> ConduitT i ByteString (StateT Word64 m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
namelen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
forall n. Integral n => n
maxBound16) (ConduitT i ByteString (StateT Word64 m) ()
 -> ConduitT i ByteString (StateT Word64 m) ())
-> ConduitT i ByteString (StateT Word64 m) ()
-> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ConduitT i ByteString (StateT Word64 m) ()
forall (m :: * -> *) a. MonadThrow m => FilePath -> m a
zipError (FilePath -> ConduitT i ByteString (StateT Word64 m) ())
-> FilePath -> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath)
-> (ByteString -> FilePath) -> Either Text ByteString -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> FilePath
T.unpack ByteString -> FilePath
BSC.unpack Either Text ByteString
zipEntryName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": entry name too long"
    let common :: Put
common = do
          Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Either (ConduitM () ByteString m ()) ByteString -> Bool
forall a b. Either a b -> Bool
isLeft Either (ConduitM () ByteString m ()) ByteString
dat Bool -> Word16 -> Word16
forall a. Num a => Bool -> a -> a
?* Int -> Word16
forall a. Bits a => Int -> a
bit Int
3 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Either Text ByteString -> Bool
forall a b. Either a b -> Bool
isLeft Either Text ByteString
zipEntryName Bool -> Word16 -> Word16
forall a. Num a => Bool -> a -> a
?* Int -> Word16
forall a. Bits a => Int -> a
bit Int
11
          Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Bool
comp Bool -> Word16 -> Word16
forall a. Num a => Bool -> a -> a
?* Word16
8
          Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Word16
time
          Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Word16
date
    Word64
off <- ConduitT i ByteString (StateT Word64 m) Word64
forall s (m :: * -> *). MonadState s m => m s
get
    Put -> ConduitT i ByteString (StateT Word64 m) ()
forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output (Put -> ConduitT i ByteString (StateT Word64 m) ())
-> Put -> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ do
      Word32 -> Put
P.putWord32le Word32
0x04034b50
      Word8 -> Put
P.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ if Bool
z64 then Word8
45 else Word8
20
      Word8 -> Put
P.putWord8 Word8
osVersion
      Put
common
      Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe Word32
0 Maybe Word32
mcrc
      Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ if Bool
z64 then Word32
forall n. Integral n => n
maxBound32 else Word32 -> (Word64 -> Word32) -> Maybe Word64 -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word64
csiz
      Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ if Bool
z64 then Word32
forall n. Integral n => n
maxBound32 else Word32 -> (Word64 -> Word32) -> Maybe Word64 -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word64
usiz
      Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
namelen
      Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Bool
z64 Bool -> Word16 -> Word16
forall a. Num a => Bool -> a -> a
?* Word16
20
      ByteString -> Put
P.putByteString ByteString
name
      Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z64 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
        Word16 -> Put
P.putWord16le Word16
0x0001
        Word16 -> Put
P.putWord16le Word16
16
        Word64 -> Put
P.putWord64le (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 Maybe Word64
usiz
        Word64 -> Put
P.putWord64le (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 Maybe Word64
csiz
    let outsz :: ConduitT i o m (a, c') -> ConduitT i o (StateT c' m) (a, c')
outsz ConduitT i o m (a, c')
c = (c' -> ConduitT i o m ((a, c'), c'))
-> ConduitT i o (StateT c' m) (a, c')
forall (m :: * -> *) s i o a.
Monad m =>
(s -> ConduitT i o m (a, s)) -> ConduitT i o (StateT s m) a
stateC ((c' -> ConduitT i o m ((a, c'), c'))
 -> ConduitT i o (StateT c' m) (a, c'))
-> (c' -> ConduitT i o m ((a, c'), c'))
-> ConduitT i o (StateT c' m) (a, c')
forall a b. (a -> b) -> a -> b
$ \c'
o -> ((a, c') -> (a, c')
forall a. a -> a
id ((a, c') -> (a, c')) -> ((a, c') -> c') -> (a, c') -> ((a, c'), c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (c'
o c' -> c' -> c'
forall a. Num a => a -> a -> a
+) (c' -> c') -> ((a, c') -> c') -> (a, c') -> c'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, c') -> c'
forall a b. (a, b) -> b
snd) ((a, c') -> ((a, c'), c'))
-> ConduitT i o m (a, c') -> ConduitT i o m ((a, c'), c')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT i o m (a, c')
c
    ((Word64
usz, Word32
crc), Word64
csz) <- (ConduitT i ByteString m ((Word64, Word32), Word64)
 -> ConduitT
      i ByteString (StateT Word64 m) ((Word64, Word32), Word64))
-> (ByteString
    -> ConduitT
         i ByteString (StateT Word64 m) ((Word64, Word32), Word64))
-> Either
     (ConduitT i ByteString m ((Word64, Word32), Word64)) ByteString
-> ConduitT
     i ByteString (StateT Word64 m) ((Word64, Word32), Word64)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (\ConduitT i ByteString m ((Word64, Word32), Word64)
cd -> do
        r :: ((Word64, Word32), Word64)
r@((Word64
usz, Word32
crc), Word64
csz) <- ConduitT i ByteString m ((Word64, Word32), Word64)
-> ConduitT
     i ByteString (StateT Word64 m) ((Word64, Word32), Word64)
forall (m :: * -> *) c' i o a.
(Monad m, Num c') =>
ConduitT i o m (a, c') -> ConduitT i o (StateT c' m) (a, c')
outsz ConduitT i ByteString m ((Word64, Word32), Word64)
cd -- write compressed data
        Bool
-> ConduitT i ByteString (StateT Word64 m) ()
-> ConduitT i ByteString (StateT Word64 m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
z64 Bool -> Bool -> Bool
&& (Word64
usz Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
forall n. Integral n => n
maxBound32 Bool -> Bool -> Bool
|| Word64
csz Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
forall n. Integral n => n
maxBound32)) (ConduitT i ByteString (StateT Word64 m) ()
 -> ConduitT i ByteString (StateT Word64 m) ())
-> ConduitT i ByteString (StateT Word64 m) ()
-> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ConduitT i ByteString (StateT Word64 m) ()
forall (m :: * -> *) a. MonadThrow m => FilePath -> m a
zipError (FilePath -> ConduitT i ByteString (StateT Word64 m) ())
-> FilePath -> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath)
-> (ByteString -> FilePath) -> Either Text ByteString -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> FilePath
T.unpack ByteString -> FilePath
BSC.unpack Either Text ByteString
zipEntryName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": file too large and zipOpt64 disabled"
        Put -> ConduitT i ByteString (StateT Word64 m) ()
forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output (Put -> ConduitT i ByteString (StateT Word64 m) ())
-> Put -> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ do
          Word32 -> Put
P.putWord32le Word32
0x08074b50
          Word32 -> Put
P.putWord32le Word32
crc
          let putsz :: Word64 -> Put
putsz
                | Bool
z64 = Word64 -> Put
P.putWord64le
                | Bool
otherwise = Word32 -> Put
P.putWord32le (Word32 -> Put) -> (Word64 -> Word32) -> Word64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
          Word64 -> Put
putsz Word64
csz
          Word64 -> Put
putsz Word64
usz
        ((Word64, Word32), Word64)
-> ConduitT
     i ByteString (StateT Word64 m) ((Word64, Word32), Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word64, Word32), Word64)
r)
      (\ByteString
b -> ConduitT i ByteString m ((Word64, Word32), Word64)
-> ConduitT
     i ByteString (StateT Word64 m) ((Word64, Word32), Word64)
forall (m :: * -> *) c' i o a.
(Monad m, Num c') =>
ConduitT i o m (a, c') -> ConduitT i o (StateT c' m) (a, c')
outsz (ConduitT i ByteString m ((Word64, Word32), Word64)
 -> ConduitT
      i ByteString (StateT Word64 m) ((Word64, Word32), Word64))
-> ConduitT i ByteString m ((Word64, Word32), Word64)
-> ConduitT
     i ByteString (StateT Word64 m) ((Word64, Word32), Word64)
forall a b. (a -> b) -> a -> b
$ ((Maybe Word64 -> Word64
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word64
usiz, Maybe Word32 -> Word32
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word32
mcrc), Maybe Word64 -> Word64
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word64
csiz) ((Word64, Word32), Word64)
-> ConduitT i ByteString m ()
-> ConduitT i ByteString m ((Word64, Word32), Word64)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i ByteString m ()
CB.sourceLbs ByteString
b)
      Either
  (ConduitT i ByteString m ((Word64, Word32), Word64)) ByteString
forall a.
Either
  (ConduitT a ByteString m ((Word64, Word32), Word64)) ByteString
cdat
    Bool
-> ConduitT i ByteString (StateT Word64 m) ()
-> ConduitT i ByteString (StateT Word64 m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Word64 -> Bool) -> Maybe Word64 -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Word64
usz Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/=) Maybe Word64
zipEntrySize) (ConduitT i ByteString (StateT Word64 m) ()
 -> ConduitT i ByteString (StateT Word64 m) ())
-> ConduitT i ByteString (StateT Word64 m) ()
-> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ConduitT i ByteString (StateT Word64 m) ()
forall (m :: * -> *) a. MonadThrow m => FilePath -> m a
zipError (FilePath -> ConduitT i ByteString (StateT Word64 m) ())
-> FilePath -> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath)
-> (ByteString -> FilePath) -> Either Text ByteString -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> FilePath
T.unpack ByteString -> FilePath
BSC.unpack Either Text ByteString
zipEntryName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": incorrect zipEntrySize"
    Put -> ConduitT i ByteString (StateT Word64 m) Put
forall (m :: * -> *) a. Monad m => a -> m a
return (Put -> ConduitT i ByteString (StateT Word64 m) Put)
-> Put -> ConduitT i ByteString (StateT Word64 m) Put
forall a b. (a -> b) -> a -> b
$ do
      -- central directory
      let o64 :: Bool
o64 = Word64
off Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
forall n. Integral n => n
maxBound32
          l64 :: Word16
l64 = Bool
z64 Bool -> Word16 -> Word16
forall a. Num a => Bool -> a -> a
?* Word16
16 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Bool
o64 Bool -> Word16 -> Word16
forall a. Num a => Bool -> a -> a
?* Word16
8
          a64 :: Bool
a64 = Bool
z64 Bool -> Bool -> Bool
|| Bool
o64
      Word32 -> Put
P.putWord32le Word32
0x02014b50
      Word8 -> Put
P.putWord8 Word8
zipVersion
      Word8 -> Put
P.putWord8 Word8
osVersion
      Word8 -> Put
P.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ if Bool
a64 then Word8
45 else Word8
20
      Word8 -> Put
P.putWord8 Word8
osVersion
      Put
common
      Word32 -> Put
P.putWord32le Word32
crc
      Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ if Bool
z64 then Word32
forall n. Integral n => n
maxBound32 else Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
csz
      Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ if Bool
z64 then Word32
forall n. Integral n => n
maxBound32 else Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
usz
      Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
namelen
      Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Bool
a64 Bool -> Word16 -> Word16
forall a. Num a => Bool -> a -> a
?* (Word16
4 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
l64)
      Word16 -> Put
P.putWord16le Word16
0 -- comment length
      Word16 -> Put
P.putWord16le Word16
0 -- disk number
      Word16 -> Put
P.putWord16le Word16
0 -- internal file attributes
      Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe Word32
0 Maybe Word32
zipEntryExternalAttributes
      Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ if Bool
o64 then Word32
forall n. Integral n => n
maxBound32 else Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
off
      ByteString -> Put
P.putByteString ByteString
name
      Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
a64 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
        Word16 -> Put
P.putWord16le Word16
0x0001
        Word16 -> Put
P.putWord16le Word16
l64
        Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z64 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
          Word64 -> Put
P.putWord64le Word64
usz
          Word64 -> Put
P.putWord64le Word64
csz
        Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
o64 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
          Word64 -> Put
P.putWord64le Word64
off
  endDirectory :: Word64
-> Word64 -> Word64 -> ConduitT i ByteString (StateT Word64 m) ()
endDirectory Word64
cdoff Word64
cdlen Word64
cnt = do
    let z64 :: Bool
z64 = Bool
zipOpt64 Bool -> Bool -> Bool
|| Word64
cdoff Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
forall n. Integral n => n
maxBound32 Bool -> Bool -> Bool
|| Word64
cnt Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
forall n. Integral n => n
maxBound16
    Bool
-> ConduitT i ByteString (StateT Word64 m) ()
-> ConduitT i ByteString (StateT Word64 m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z64 (ConduitT i ByteString (StateT Word64 m) ()
 -> ConduitT i ByteString (StateT Word64 m) ())
-> ConduitT i ByteString (StateT Word64 m) ()
-> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ Put -> ConduitT i ByteString (StateT Word64 m) ()
forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output (Put -> ConduitT i ByteString (StateT Word64 m) ())
-> Put -> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ do
      Word32 -> Put
P.putWord32le Word32
0x06064b50 -- zip64 end
      Word64 -> Put
P.putWord64le Word64
44 -- length of this record
      Word8 -> Put
P.putWord8 Word8
zipVersion
      Word8 -> Put
P.putWord8 Word8
osVersion
      Word8 -> Put
P.putWord8 Word8
45
      Word8 -> Put
P.putWord8 Word8
osVersion
      Word32 -> Put
P.putWord32le Word32
0 -- disk
      Word32 -> Put
P.putWord32le Word32
0 -- central disk
      Word64 -> Put
P.putWord64le Word64
cnt
      Word64 -> Put
P.putWord64le Word64
cnt
      Word64 -> Put
P.putWord64le Word64
cdlen
      Word64 -> Put
P.putWord64le Word64
cdoff
      Word32 -> Put
P.putWord32le Word32
0x07064b50 -- locator:
      Word32 -> Put
P.putWord32le Word32
0 -- central disk
      Word64 -> Put
P.putWord64le (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Word64
cdoff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
cdlen
      Word32 -> Put
P.putWord32le Word32
1 -- total disks
    let comment :: ByteString
comment = ZipInfo -> ByteString
zipComment ZipInfo
zipOptInfo
        commlen :: Int
commlen = ByteString -> Int
BS.length ByteString
comment
    Bool
-> ConduitT i ByteString (StateT Word64 m) ()
-> ConduitT i ByteString (StateT Word64 m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
commlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
forall n. Integral n => n
maxBound16) (ConduitT i ByteString (StateT Word64 m) ()
 -> ConduitT i ByteString (StateT Word64 m) ())
-> ConduitT i ByteString (StateT Word64 m) ()
-> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ConduitT i ByteString (StateT Word64 m) ()
forall (m :: * -> *) a. MonadThrow m => FilePath -> m a
zipError FilePath
"comment too long"
    Put -> ConduitT i ByteString (StateT Word64 m) ()
forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output (Put -> ConduitT i ByteString (StateT Word64 m) ())
-> Put -> ConduitT i ByteString (StateT Word64 m) ()
forall a b. (a -> b) -> a -> b
$ do
      Word32 -> Put
P.putWord32le Word32
0x06054b50 -- end
      Word16 -> Put
P.putWord16le Word16
0 -- disk
      Word16 -> Put
P.putWord16le Word16
0 -- central disk
      Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word16) -> Word64 -> Word16
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min Word64
forall n. Integral n => n
maxBound16 Word64
cnt
      Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word16) -> Word64 -> Word16
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min Word64
forall n. Integral n => n
maxBound16 Word64
cnt
      Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min Word64
forall n. Integral n => n
maxBound32 Word64
cdlen
      Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min Word64
forall n. Integral n => n
maxBound32 Word64
cdoff
      Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
commlen
      ByteString -> Put
P.putByteString ByteString
comment