-- |Stream the creation of a zip file, e.g., as it's being uploaded.
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BangPatterns #-}
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.DeepSeq (force)
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, Word32, 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
  { zipOpt64 :: Bool
zipOpt64 = Bool
False
  , zipOptCompressLevel :: Int
zipOptCompressLevel = -Int
1
  , zipOptInfo :: ZipInfo
zipOptInfo = ZipInfo
    { zipComment :: ByteString
zipComment = ByteString
BS.empty
    }
  }

infixr 7 ?*
(?*) :: Num a => Bool -> a -> a
Bool
True ?* :: forall a. Num a => 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 :: forall (m :: * -> *). MonadResource m => FilePath -> ZipData m
zipFileData = forall (m :: * -> *). ConduitM () ByteString m () -> ZipData m
ZipDataSource forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *).
Monad m =>
ZipData m -> Either (ConduitM () ByteString m ()) ByteString
zipData (ZipDataByteString ByteString
b) = forall a b. b -> Either a b
Right ByteString
b
zipData (ZipDataSource ConduitM () ByteString m ()
s) = forall a b. a -> Either a b
Left ConduitM () ByteString m ()
s

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

toDOSTime :: LocalTime -> (Word16, Word16)
toDOSTime :: LocalTime -> (Word16, Word16)
toDOSTime (LocalTime (Day -> (Year, Int, Int)
toGregorian -> (Year
year, Int
month, Int
day)) (TimeOfDay Int
hour Int
mins Pico
secs)) =
  ( forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hour forall a. Bits a => a -> Int -> a
`shiftL` Int
11 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mins forall a. Bits a => a -> Int -> a
`shiftL` Int
5 forall a. Bits a => a -> a -> a
.|. forall a b. (RealFrac a, Integral b) => a -> b
truncate Pico
secs forall a. Bits a => a -> Int -> a
`shiftR` Int
1
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral (Year
year forall a. Num a => a -> a -> a
- Year
1980) forall a. Bits a => a -> Int -> a
`shiftL` Int
9 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
month forall a. Bits a => a -> Int -> a
`shiftL` Int
5 forall a. Bits a => a -> a -> a
.|. 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 :: forall (m :: * -> *) i.
Monad m =>
ConduitM i ByteString m ()
-> ConduitM i ByteString (StateT Word64 m) ()
countOutput ConduitM i ByteString m ()
c = forall (m :: * -> *) s i o a.
Monad m =>
(s -> ConduitT i o m (a, s)) -> ConduitT i o (StateT s m) a
stateC forall a b. (a -> b) -> a -> b
$ \Word64
s -> (,) () forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64
s forall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output = forall (m :: * -> *) i.
Monad m =>
ConduitM i ByteString m ()
-> ConduitM i ByteString (StateT Word64 m) ()
countOutput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) z.
Monad m =>
Put -> ConduitT z ByteString m ()
sourcePut

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

data CommonFileHeaderInfo = CommonFileHeaderInfo
  { CommonFileHeaderInfo -> Bool
cfhiIsStreamingEntry :: !Bool
  , CommonFileHeaderInfo -> Bool
cfhiHasUtf8Filename :: !Bool
  , CommonFileHeaderInfo -> Bool
cfhiIsCompressed :: !Bool
  , CommonFileHeaderInfo -> Word16
cfhiTime :: !Word16
  , CommonFileHeaderInfo -> Word16
cfhiDate :: !Word16
  } deriving (CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
$c/= :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
== :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
$c== :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
Eq, Eq CommonFileHeaderInfo
CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
CommonFileHeaderInfo -> CommonFileHeaderInfo -> Ordering
CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo
$cmin :: CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo
max :: CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo
$cmax :: CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo
>= :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
$c>= :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
> :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
$c> :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
<= :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
$c<= :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
< :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
$c< :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
compare :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Ordering
$ccompare :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Ordering
Ord, Int -> CommonFileHeaderInfo -> ShowS
[CommonFileHeaderInfo] -> ShowS
CommonFileHeaderInfo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CommonFileHeaderInfo] -> ShowS
$cshowList :: [CommonFileHeaderInfo] -> ShowS
show :: CommonFileHeaderInfo -> FilePath
$cshow :: CommonFileHeaderInfo -> FilePath
showsPrec :: Int -> CommonFileHeaderInfo -> ShowS
$cshowsPrec :: Int -> CommonFileHeaderInfo -> ShowS
Show)

putCommonFileHeaderPart :: CommonFileHeaderInfo -> P.PutM ()
putCommonFileHeaderPart :: CommonFileHeaderInfo -> Put
putCommonFileHeaderPart CommonFileHeaderInfo{Bool
Word16
cfhiDate :: Word16
cfhiTime :: Word16
cfhiIsCompressed :: Bool
cfhiHasUtf8Filename :: Bool
cfhiIsStreamingEntry :: Bool
cfhiDate :: CommonFileHeaderInfo -> Word16
cfhiTime :: CommonFileHeaderInfo -> Word16
cfhiIsCompressed :: CommonFileHeaderInfo -> Bool
cfhiHasUtf8Filename :: CommonFileHeaderInfo -> Bool
cfhiIsStreamingEntry :: CommonFileHeaderInfo -> Bool
..} = do
  Word16 -> Put
P.putWord16le forall a b. (a -> b) -> a -> b
$ Bool
cfhiIsStreamingEntry forall a. Num a => Bool -> a -> a
?* forall a. Bits a => Int -> a
bit Int
3 forall a. Bits a => a -> a -> a
.|. Bool
cfhiHasUtf8Filename forall a. Num a => Bool -> a -> a
?* forall a. Bits a => Int -> a
bit Int
11
  Word16 -> Put
P.putWord16le forall a b. (a -> b) -> a -> b
$ Bool
cfhiIsCompressed forall a. Num a => Bool -> a -> a
?* Word16
8
  Word16 -> Put
P.putWord16le forall a b. (a -> b) -> a -> b
$ Word16
cfhiTime
  Word16 -> Put
P.putWord16le forall a b. (a -> b) -> a -> b
$ Word16
cfhiDate

-- | This is retained in memory until the end of the archive is written.
--
-- To avoid space leaks, this should contain only strict data.
data CentralDirectoryInfo = CentralDirectoryInfo
  { CentralDirectoryInfo -> Word64
cdiOff :: !Word64
  , CentralDirectoryInfo -> Bool
cdiZ64 :: !Bool
  , CentralDirectoryInfo -> CommonFileHeaderInfo
cdiCommonFileHeaderInfo :: !CommonFileHeaderInfo
  , CentralDirectoryInfo -> Word32
cdiCrc :: !Word32
  , CentralDirectoryInfo -> Word64
cdiUsz :: !Word64
  , CentralDirectoryInfo -> ByteString
cdiName :: !BSC.ByteString
  , CentralDirectoryInfo -> Word64
cdiCsz :: !Word64
  , CentralDirectoryInfo -> Maybe Word32
cdiZipEntryExternalAttributes :: !(Maybe Word32) -- lazy Maybe must be e.g. via `force` at creation
  } deriving (CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
$c/= :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
== :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
$c== :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
Eq, Eq CentralDirectoryInfo
CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
CentralDirectoryInfo -> CentralDirectoryInfo -> Ordering
CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo
$cmin :: CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo
max :: CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo
$cmax :: CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo
>= :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
$c>= :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
> :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
$c> :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
<= :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
$c<= :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
< :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
$c< :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
compare :: CentralDirectoryInfo -> CentralDirectoryInfo -> Ordering
$ccompare :: CentralDirectoryInfo -> CentralDirectoryInfo -> Ordering
Ord, Int -> CentralDirectoryInfo -> ShowS
[CentralDirectoryInfo] -> ShowS
CentralDirectoryInfo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CentralDirectoryInfo] -> ShowS
$cshowList :: [CentralDirectoryInfo] -> ShowS
show :: CentralDirectoryInfo -> FilePath
$cshow :: CentralDirectoryInfo -> FilePath
showsPrec :: Int -> CentralDirectoryInfo -> ShowS
$cshowsPrec :: Int -> CentralDirectoryInfo -> ShowS
Show)

putCentralDirectory :: CentralDirectoryInfo -> P.PutM ()
putCentralDirectory :: CentralDirectoryInfo -> Put
putCentralDirectory CentralDirectoryInfo{Bool
Maybe Word32
Word32
Word64
ByteString
CommonFileHeaderInfo
cdiZipEntryExternalAttributes :: Maybe Word32
cdiCsz :: Word64
cdiName :: ByteString
cdiUsz :: Word64
cdiCrc :: Word32
cdiCommonFileHeaderInfo :: CommonFileHeaderInfo
cdiZ64 :: Bool
cdiOff :: Word64
cdiZipEntryExternalAttributes :: CentralDirectoryInfo -> Maybe Word32
cdiCsz :: CentralDirectoryInfo -> Word64
cdiName :: CentralDirectoryInfo -> ByteString
cdiUsz :: CentralDirectoryInfo -> Word64
cdiCrc :: CentralDirectoryInfo -> Word32
cdiCommonFileHeaderInfo :: CentralDirectoryInfo -> CommonFileHeaderInfo
cdiZ64 :: CentralDirectoryInfo -> Bool
cdiOff :: CentralDirectoryInfo -> Word64
..} = do
  -- central directory
  let o64 :: Bool
o64 = Word64
cdiOff forall a. Ord a => a -> a -> Bool
>= forall n. Integral n => n
maxBound32
      l64 :: Word16
l64 = Bool
cdiZ64 forall a. Num a => Bool -> a -> a
?* Word16
16 forall a. Num a => a -> a -> a
+ Bool
o64 forall a. Num a => Bool -> a -> a
?* Word16
8
      a64 :: Bool
a64 = Bool
cdiZ64 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 forall a b. (a -> b) -> a -> b
$ if Bool
a64 then Word8
45 else Word8
20
  Word8 -> Put
P.putWord8 Word8
osVersion
  CommonFileHeaderInfo -> Put
putCommonFileHeaderPart CommonFileHeaderInfo
cdiCommonFileHeaderInfo
  Word32 -> Put
P.putWord32le Word32
cdiCrc
  Word32 -> Put
P.putWord32le forall a b. (a -> b) -> a -> b
$ if Bool
cdiZ64 then forall n. Integral n => n
maxBound32 else forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
cdiCsz
  Word32 -> Put
P.putWord32le forall a b. (a -> b) -> a -> b
$ if Bool
cdiZ64 then forall n. Integral n => n
maxBound32 else forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
cdiUsz
  Word16 -> Put
P.putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
cdiName)
  Word16 -> Put
P.putWord16le forall a b. (a -> b) -> a -> b
$ Bool
a64 forall a. Num a => Bool -> a -> a
?* (Word16
4 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 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Word32
0 Maybe Word32
cdiZipEntryExternalAttributes
  Word32 -> Put
P.putWord32le forall a b. (a -> b) -> a -> b
$ if Bool
o64 then forall n. Integral n => n
maxBound32 else forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
cdiOff
  ByteString -> Put
P.putByteString ByteString
cdiName
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
a64 forall a b. (a -> b) -> a -> b
$ do
    Word16 -> Put
P.putWord16le Word16
0x0001
    Word16 -> Put
P.putWord16le Word16
l64
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cdiZ64 forall a b. (a -> b) -> a -> b
$ do
      Word64 -> Put
P.putWord64le Word64
cdiUsz
      Word64 -> Put
P.putWord64le Word64
cdiCsz
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
o64 forall a b. (a -> b) -> a -> b
$
      Word64 -> Put
P.putWord64le Word64
cdiOff

-- |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 :: forall (m :: * -> *).
(MonadThrow m, PrimMonad m) =>
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
..} = forall (m :: * -> *) s i o r.
Monad m =>
s -> ConduitT i o (StateT s m) r -> ConduitT i o m s
execStateC Word64
0 forall a b. (a -> b) -> a -> b
$ do
  (Word64
cnt, Put
cdir) <- forall {m :: * -> *} {t}.
(PrimMonad m, MonadThrow m, Enum t) =>
t
-> Put
-> ConduitT
     (ZipEntry, ZipData m) ByteString (StateT Word64 m) (t, Put)
next Word64
0 (forall (m :: * -> *) a. Monad m => a -> m a
return ())
  Word64
cdoff <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output Put
cdir
  Word64
eoff <- forall s (m :: * -> *). MonadState s m => m s
get
  forall {m :: * -> *} {i}.
MonadThrow m =>
Word64
-> Word64 -> Word64 -> ConduitT i ByteString (StateT Word64 m) ()
endDirectory Word64
cdoff (Word64
eoff 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 = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
C.await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (forall (m :: * -> *) a. Monad m => a -> m a
return (t
cnt, Put
dir))
    (\(ZipEntry, ZipData m)
e -> do
      Put
d <- 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 (forall a. Enum a => a -> a
succ t
cnt) forall a b. (a -> b) -> a -> b
$ Put
dir 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
..}, forall (m :: * -> *).
Monad m =>
ZipData m -> Either (ConduitM () ByteString m ()) ByteString
zipData -> Either (ConduitM () ByteString m ()) ByteString
dat) = do
    let usiz :: Maybe Word64
usiz = forall a. Either a ByteString -> Maybe Word64
dataSize Either (ConduitM () ByteString m ()) ByteString
dat
        sdat :: Either (ConduitT a ByteString m (Word64, Word32)) ByteString
sdat = forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (\ConduitM () ByteString m ()
x -> forall (m :: * -> *) a i.
Monad m =>
ConduitT () a m () -> ConduitT i a m ()
C.toProducer ConduitM () ByteString m ()
x forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m (Word64, Word32)
sizeCRC) Either (ConduitM () ByteString m ()) ByteString
dat
        cfhiIsCompressed :: Bool
cfhiIsCompressed = Int
zipOptCompressLevel forall a. Eq a => a -> a -> Bool
/= Int
0
               Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word64
0 forall a. Eq a => a -> a -> Bool
/=) Maybe Word64
usiz
               Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word64
0 forall a. Eq a => a -> a -> Bool
/=) Maybe Word64
zipEntrySize
        cfhiIsStreamingEntry :: Bool
cfhiIsStreamingEntry = forall a b. Either a b -> Bool
isLeft Either (ConduitM () ByteString m ()) ByteString
dat
        compressPlainBs :: ByteString -> ByteString
compressPlainBs =
          CompressParams -> ByteString -> ByteString
Z.compressWith
            CompressParams
Z.defaultCompressParams
              { compressLevel :: CompressionLevel
Z.compressLevel =
                  if Int
zipOptCompressLevel forall a. Eq a => a -> a -> Bool
== -Int
1
                    then CompressionLevel
Z.defaultCompression
                    else Int -> CompressionLevel
Z.compressionLevel Int
zipOptCompressLevel
              }
        (Either
  (ConduitT a ByteString m ((Word64, Word32), Word64)) ByteString
cdat, Maybe Word64
csiz)
          | Bool
cfhiIsCompressed =
            ( ((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` (forall (m :: * -> *) i.
Monad m =>
ConduitT i ByteString m () -> ConduitT i ByteString m Word64
outputSize forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
Int -> WindowBits -> ConduitT ByteString ByteString m ()
CZ.compress Int
zipOptCompressLevel WindowBits
deflateWindowBits))
              forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ ByteString -> ByteString
compressPlainBs) forall {a}.
Either (ConduitT a ByteString m (Word64, Word32)) ByteString
sdat
            , forall a. Either a ByteString -> Maybe Word64
dataSize Either
  (ConduitT a ByteString m ((Word64, Word32), Word64)) ByteString
cdat)
          | Bool
otherwise = (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a b. (a, b) -> a
fst)) forall {a}.
Either (ConduitT a ByteString m (Word64, Word32)) ByteString
sdat, Maybe Word64
usiz)
        cdiZ64 :: Bool
cdiZ64 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
zipOpt64 Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall n. Integral n => n
maxBound32 forall a. Ord a => a -> a -> Bool
<) Maybe Word64
zipEntrySize)
          (forall n. Integral n => n
maxBound32 forall a. Ord a => a -> a -> Bool
<) (forall a. Ord a => a -> a -> a
max forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word64
usiz forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Word64
csiz)
        cfhiHasUtf8Filename :: Bool
cfhiHasUtf8Filename = forall a b. Either a b -> Bool
isLeft Either Text ByteString
zipEntryName
        cdiName :: ByteString
cdiName = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> ByteString
TE.encodeUtf8 forall a. a -> a
id Either Text ByteString
zipEntryName
        namelen :: Int
namelen = ByteString -> Int
BS.length ByteString
cdiName
        (Word16
cfhiTime, Word16
cfhiDate) = LocalTime -> (Word16, Word16)
toDOSTime LocalTime
zipEntryTime
        mcrc :: Maybe Word32
mcrc = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CRC32 a => a -> Word32
crc32) Either (ConduitM () ByteString m ()) ByteString
dat
        !cdiCommonFileHeaderInfo :: CommonFileHeaderInfo
cdiCommonFileHeaderInfo = CommonFileHeaderInfo{Bool
Word16
cfhiDate :: Word16
cfhiTime :: Word16
cfhiHasUtf8Filename :: Bool
cfhiIsStreamingEntry :: Bool
cfhiIsCompressed :: Bool
cfhiDate :: Word16
cfhiTime :: Word16
cfhiIsCompressed :: Bool
cfhiHasUtf8Filename :: Bool
cfhiIsStreamingEntry :: Bool
..}
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
namelen forall a. Ord a => a -> a -> Bool
> forall n. Integral n => n
maxBound16) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadThrow m => FilePath -> m a
zipError forall a b. (a -> b) -> a -> b
$ 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 forall a. [a] -> [a] -> [a]
++ FilePath
": entry name too long"
    Word64
cdiOff <- forall s (m :: * -> *). MonadState s m => m s
get
    forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output forall a b. (a -> b) -> a -> b
$ do
      Word32 -> Put
P.putWord32le Word32
0x04034b50
      Word8 -> Put
P.putWord8 forall a b. (a -> b) -> a -> b
$ if Bool
cdiZ64 then Word8
45 else Word8
20
      Word8 -> Put
P.putWord8 Word8
osVersion
      CommonFileHeaderInfo -> Put
putCommonFileHeaderPart CommonFileHeaderInfo
cdiCommonFileHeaderInfo
      Word32 -> Put
P.putWord32le forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Word32
0 Maybe Word32
mcrc
      Word32 -> Put
P.putWord32le forall a b. (a -> b) -> a -> b
$ if Bool
cdiZ64 then forall n. Integral n => n
maxBound32 else forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word64
csiz
      Word32 -> Put
P.putWord32le forall a b. (a -> b) -> a -> b
$ if Bool
cdiZ64 then forall n. Integral n => n
maxBound32 else forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word64
usiz
      Word16 -> Put
P.putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
namelen
      Word16 -> Put
P.putWord16le forall a b. (a -> b) -> a -> b
$ Bool
cdiZ64 forall a. Num a => Bool -> a -> a
?* Word16
20
      ByteString -> Put
P.putByteString ByteString
cdiName
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cdiZ64 forall a b. (a -> b) -> a -> b
$ do
        Word16 -> Put
P.putWord16le Word16
0x0001
        Word16 -> Put
P.putWord16le Word16
16
        Word64 -> Put
P.putWord64le forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Word64
0 Maybe Word64
usiz
        Word64 -> Put
P.putWord64le forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) s i o a.
Monad m =>
(s -> ConduitT i o m (a, s)) -> ConduitT i o (StateT s m) a
stateC forall a b. (a -> b) -> a -> b
$ \(!c
o) -> (forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (c
o forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT i o m (a, c)
c
    ((Word64
cdiUsz, Word32
cdiCrc), Word64
cdiCsz) <- 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) <- 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
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
cdiZ64 Bool -> Bool -> Bool
&& (Word64
usz forall a. Ord a => a -> a -> Bool
> forall n. Integral n => n
maxBound32 Bool -> Bool -> Bool
|| Word64
csz forall a. Ord a => a -> a -> Bool
> forall n. Integral n => n
maxBound32)) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadThrow m => FilePath -> m a
zipError forall a b. (a -> b) -> a -> b
$ 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 forall a. [a] -> [a] -> [a]
++ FilePath
": file too large and zipOpt64 disabled"
        forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output 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
cdiZ64 = Word64 -> Put
P.putWord64le
                | Bool
otherwise = Word32 -> Put
P.putWord32le forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
          Word64 -> Put
putsz Word64
csz
          Word64 -> Put
putsz Word64
usz
        forall (m :: * -> *) a. Monad m => a -> m a
return ((Word64, Word32), Word64)
r)
      (\ByteString
b -> 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 forall a b. (a -> b) -> a -> b
$ ((forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word64
usiz, forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word32
mcrc), forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word64
csiz) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i ByteString m ()
CB.sourceLbs ByteString
b)
      forall {a}.
Either
  (ConduitT a ByteString m ((Word64, Word32), Word64)) ByteString
cdat
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Word64
cdiUsz forall a. Eq a => a -> a -> Bool
/=) Maybe Word64
zipEntrySize) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadThrow m => FilePath -> m a
zipError forall a b. (a -> b) -> a -> b
$ 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 forall a. [a] -> [a] -> [a]
++ FilePath
": incorrect zipEntrySize"
    let !centralDirectoryInfo :: CentralDirectoryInfo
centralDirectoryInfo = CentralDirectoryInfo
          { cdiZipEntryExternalAttributes :: Maybe Word32
cdiZipEntryExternalAttributes = forall a. NFData a => a -> a
force Maybe Word32
zipEntryExternalAttributes
          , Bool
Word32
Word64
ByteString
CommonFileHeaderInfo
cdiCsz :: Word64
cdiCrc :: Word32
cdiUsz :: Word64
cdiOff :: Word64
cdiCommonFileHeaderInfo :: CommonFileHeaderInfo
cdiName :: ByteString
cdiZ64 :: Bool
cdiCsz :: Word64
cdiName :: ByteString
cdiUsz :: Word64
cdiCrc :: Word32
cdiCommonFileHeaderInfo :: CommonFileHeaderInfo
cdiZ64 :: Bool
cdiOff :: Word64
.. }
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CentralDirectoryInfo -> Put
putCentralDirectory CentralDirectoryInfo
centralDirectoryInfo

  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 forall a. Ord a => a -> a -> Bool
> forall n. Integral n => n
maxBound32 Bool -> Bool -> Bool
|| Word64
cnt forall a. Ord a => a -> a -> Bool
> forall n. Integral n => n
maxBound16
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z64 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output 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 forall a b. (a -> b) -> a -> b
$ Word64
cdoff 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
commlen forall a. Ord a => a -> a -> Bool
> forall n. Integral n => n
maxBound16) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadThrow m => FilePath -> m a
zipError FilePath
"comment too long"
    forall (m :: * -> *) i.
MonadThrow m =>
Put -> ConduitM i ByteString (StateT Word64 m) ()
output 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 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min forall n. Integral n => n
maxBound16 Word64
cnt
      Word16 -> Put
P.putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min forall n. Integral n => n
maxBound16 Word64
cnt
      Word32 -> Put
P.putWord32le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min forall n. Integral n => n
maxBound32 Word64
cdlen
      Word32 -> Put
P.putWord32le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min forall n. Integral n => n
maxBound32 Word64
cdoff
      Word16 -> Put
P.putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
commlen
      ByteString -> Put
P.putByteString ByteString
comment