{-# 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
data ZipOptions = ZipOptions
{ ZipOptions -> Bool
zipOpt64 :: !Bool
, ZipOptions -> Int
zipOptCompressLevel :: !Int
, ZipOptions -> ZipInfo
zipOptInfo :: !ZipInfo
}
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
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 -> 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 ()
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
data CentralDirectoryInfo = CentralDirectoryInfo
{ CentralDirectoryInfo -> Word64
cdiOff :: !Word64
, CentralDirectoryInfo -> Bool
cdiZ64 :: !Bool
, :: !CommonFileHeaderInfo
, CentralDirectoryInfo -> Word32
cdiCrc :: !Word32
, CentralDirectoryInfo -> Word64
cdiUsz :: !Word64
, CentralDirectoryInfo -> ByteString
cdiName :: !BSC.ByteString
, CentralDirectoryInfo -> Word64
cdiCsz :: !Word64
, CentralDirectoryInfo -> Maybe Word32
cdiZipEntryExternalAttributes :: !(Maybe Word32)
} 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
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
Word16 -> Put
P.putWord16le Word16
0
Word16 -> Put
P.putWord16le Word16
0
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
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
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
Word64 -> Put
P.putWord64le Word64
44
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
Word32 -> Put
P.putWord32le Word32
0
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
Word32 -> Put
P.putWord32le Word32
0
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
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
Word16 -> Put
P.putWord16le Word16
0
Word16 -> Put
P.putWord16le Word16
0
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