{-# 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 = 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 :: forall (m :: * -> *).
Monad m =>
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 :: forall a. 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 -> (Year, Int, Int)
toGregorian -> (Year
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 b. Integral b => Pico -> b
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
, Year -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Year
year Year -> Year -> Year
forall a. Num a => a -> a -> a
- Year
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 :: forall (m :: * -> *) i.
Monad m =>
ConduitM i ByteString m ()
-> ConduitM i ByteString (StateT Word64 m) ()
countOutput ConduitM i ByteString m ()
c = (Word64 -> ConduitT i ByteString m ((), Word64))
-> ConduitT 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))
-> ConduitT i ByteString (StateT Word64 m) ())
-> (Word64 -> ConduitT i ByteString m ((), Word64))
-> ConduitT 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 :: forall (m :: * -> *) i.
MonadThrow m =>
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 :: forall n. Integral n => n
maxBound16 = Word16 -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
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
(CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool)
-> (CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool)
-> Eq CommonFileHeaderInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
== :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
$c/= :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
/= :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
Eq, Eq CommonFileHeaderInfo
Eq CommonFileHeaderInfo =>
(CommonFileHeaderInfo -> CommonFileHeaderInfo -> Ordering)
-> (CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool)
-> (CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool)
-> (CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool)
-> (CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool)
-> (CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo)
-> (CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo)
-> Ord 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
$ccompare :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Ordering
compare :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Ordering
$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
>= :: CommonFileHeaderInfo -> CommonFileHeaderInfo -> Bool
$cmax :: CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo
max :: CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo
$cmin :: CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo
min :: CommonFileHeaderInfo
-> CommonFileHeaderInfo -> CommonFileHeaderInfo
Ord, Int -> CommonFileHeaderInfo -> ShowS
[CommonFileHeaderInfo] -> ShowS
CommonFileHeaderInfo -> FilePath
(Int -> CommonFileHeaderInfo -> ShowS)
-> (CommonFileHeaderInfo -> FilePath)
-> ([CommonFileHeaderInfo] -> ShowS)
-> Show CommonFileHeaderInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommonFileHeaderInfo -> ShowS
showsPrec :: Int -> CommonFileHeaderInfo -> ShowS
$cshow :: CommonFileHeaderInfo -> FilePath
show :: CommonFileHeaderInfo -> FilePath
$cshowList :: [CommonFileHeaderInfo] -> ShowS
showList :: [CommonFileHeaderInfo] -> ShowS
Show)
putCommonFileHeaderPart :: CommonFileHeaderInfo -> P.PutM ()
CommonFileHeaderInfo{Bool
Word16
cfhiIsStreamingEntry :: CommonFileHeaderInfo -> Bool
cfhiHasUtf8Filename :: CommonFileHeaderInfo -> Bool
cfhiIsCompressed :: CommonFileHeaderInfo -> Bool
cfhiTime :: CommonFileHeaderInfo -> Word16
cfhiDate :: CommonFileHeaderInfo -> Word16
cfhiIsStreamingEntry :: Bool
cfhiHasUtf8Filename :: Bool
cfhiIsCompressed :: Bool
cfhiTime :: Word16
cfhiDate :: Word16
..} = do
Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Bool
cfhiIsStreamingEntry 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
.|. Bool
cfhiHasUtf8Filename 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
cfhiIsCompressed 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
cfhiTime
Word16 -> Put
P.putWord16le (Word16 -> Put) -> Word16 -> Put
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
(CentralDirectoryInfo -> CentralDirectoryInfo -> Bool)
-> (CentralDirectoryInfo -> CentralDirectoryInfo -> Bool)
-> Eq CentralDirectoryInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
== :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
$c/= :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
/= :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
Eq, Eq CentralDirectoryInfo
Eq CentralDirectoryInfo =>
(CentralDirectoryInfo -> CentralDirectoryInfo -> Ordering)
-> (CentralDirectoryInfo -> CentralDirectoryInfo -> Bool)
-> (CentralDirectoryInfo -> CentralDirectoryInfo -> Bool)
-> (CentralDirectoryInfo -> CentralDirectoryInfo -> Bool)
-> (CentralDirectoryInfo -> CentralDirectoryInfo -> Bool)
-> (CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo)
-> (CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo)
-> Ord 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
$ccompare :: CentralDirectoryInfo -> CentralDirectoryInfo -> Ordering
compare :: CentralDirectoryInfo -> CentralDirectoryInfo -> Ordering
$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
>= :: CentralDirectoryInfo -> CentralDirectoryInfo -> Bool
$cmax :: CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo
max :: CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo
$cmin :: CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo
min :: CentralDirectoryInfo
-> CentralDirectoryInfo -> CentralDirectoryInfo
Ord, Int -> CentralDirectoryInfo -> ShowS
[CentralDirectoryInfo] -> ShowS
CentralDirectoryInfo -> FilePath
(Int -> CentralDirectoryInfo -> ShowS)
-> (CentralDirectoryInfo -> FilePath)
-> ([CentralDirectoryInfo] -> ShowS)
-> Show CentralDirectoryInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CentralDirectoryInfo -> ShowS
showsPrec :: Int -> CentralDirectoryInfo -> ShowS
$cshow :: CentralDirectoryInfo -> FilePath
show :: CentralDirectoryInfo -> FilePath
$cshowList :: [CentralDirectoryInfo] -> ShowS
showList :: [CentralDirectoryInfo] -> ShowS
Show)
putCentralDirectory :: CentralDirectoryInfo -> P.PutM ()
putCentralDirectory :: CentralDirectoryInfo -> Put
putCentralDirectory CentralDirectoryInfo{Bool
Maybe Word32
Word32
Word64
ByteString
CommonFileHeaderInfo
cdiOff :: CentralDirectoryInfo -> Word64
cdiZ64 :: CentralDirectoryInfo -> Bool
cdiCommonFileHeaderInfo :: CentralDirectoryInfo -> CommonFileHeaderInfo
cdiCrc :: CentralDirectoryInfo -> Word32
cdiUsz :: CentralDirectoryInfo -> Word64
cdiName :: CentralDirectoryInfo -> ByteString
cdiCsz :: CentralDirectoryInfo -> Word64
cdiZipEntryExternalAttributes :: CentralDirectoryInfo -> Maybe Word32
cdiOff :: Word64
cdiZ64 :: Bool
cdiCommonFileHeaderInfo :: CommonFileHeaderInfo
cdiCrc :: Word32
cdiUsz :: Word64
cdiName :: ByteString
cdiCsz :: Word64
cdiZipEntryExternalAttributes :: Maybe Word32
..} = do
let o64 :: Bool
o64 = Word64
cdiOff Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
forall n. Integral n => n
maxBound32
l64 :: Word16
l64 = Bool
cdiZ64 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
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 (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
CommonFileHeaderInfo -> Put
putCommonFileHeaderPart CommonFileHeaderInfo
cdiCommonFileHeaderInfo
Word32 -> Put
P.putWord32le Word32
cdiCrc
Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ if Bool
cdiZ64 then Word32
forall n. Integral n => n
maxBound32 else Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
cdiCsz
Word32 -> Put
P.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ if Bool
cdiZ64 then Word32
forall n. Integral n => n
maxBound32 else Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
cdiUsz
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 (ByteString -> Int
BS.length ByteString
cdiName)
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
Word16 -> Put
P.putWord16le Word16
0
Word16 -> Put
P.putWord16le Word16
0
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
cdiZipEntryExternalAttributes
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
cdiOff
ByteString -> Put
P.putByteString ByteString
cdiName
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
cdiZ64 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
Word64 -> Put
P.putWord64le Word64
cdiUsz
Word64 -> Put
P.putWord64le Word64
cdiCsz
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
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
zipOpt64 :: ZipOptions -> Bool
zipOptCompressLevel :: ZipOptions -> Int
zipOptInfo :: ZipOptions -> ZipInfo
zipOpt64 :: Bool
zipOptCompressLevel :: Int
zipOptInfo :: ZipInfo
..} = Word64
-> ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) ()
-> ConduitT (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) ()
-> ConduitT (ZipEntry, ZipData m) ByteString m Word64)
-> ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) ()
-> ConduitT (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 a. a -> PutM a
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 o. Monad m => ConduitT i o 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 a b.
ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) a
-> (a
-> ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) b)
-> ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) b
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 a.
a -> ConduitT (ZipEntry, ZipData m) ByteString (StateT Word64 m) a
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 a b. PutM a -> PutM b -> PutM b
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
zipEntrySize :: ZipEntry -> Maybe Word64
zipEntryName :: Either Text ByteString
zipEntryTime :: LocalTime
zipEntrySize :: Maybe Word64
zipEntryExternalAttributes :: Maybe Word32
zipEntryName :: ZipEntry -> Either Text ByteString
zipEntryTime :: ZipEntry -> LocalTime
zipEntryExternalAttributes :: ZipEntry -> Maybe Word32
..}, 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 (ConduitT a ByteString m (Word64, Word32)) ByteString
sdat = (ConduitM () ByteString m ()
-> ConduitT a ByteString m (Word64, Word32))
-> Either (ConduitM () ByteString m ()) ByteString
-> Either (ConduitT a ByteString m (Word64, Word32)) ByteString
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (\ConduitM () ByteString m ()
x -> ConduitM () ByteString m () -> ConduitT a ByteString m ()
forall (m :: * -> *) a i.
Monad m =>
ConduitT () a m () -> ConduitT i a m ()
C.toProducer ConduitM () ByteString m ()
x ConduitT a ByteString m ()
-> ConduitT ByteString ByteString m (Word64, Word32)
-> ConduitT a ByteString m (Word64, Word32)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| ConduitT ByteString ByteString m (Word64, Word32)
forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m (Word64, Word32)
sizeCRC) Either (ConduitM () ByteString m ()) ByteString
dat
cfhiIsCompressed :: Bool
cfhiIsCompressed = 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
cfhiIsStreamingEntry :: Bool
cfhiIsStreamingEntry = Either (ConduitM () ByteString m ()) ByteString -> Bool
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
{ Z.compressLevel =
if zipOptCompressLevel == -1
then Z.defaultCompression
else Z.compressionLevel zipOptCompressLevel
}
(Either
(ConduitT a ByteString m ((Word64, Word32), Word64)) ByteString
cdat, Maybe Word64
csiz)
| Bool
cfhiIsCompressed =
( ((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 b c b' c'.
(b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ ByteString -> ByteString
compressPlainBs) Either (ConduitT a ByteString m (Word64, Word32)) ByteString
forall {a}.
Either (ConduitT a ByteString m (Word64, Word32)) ByteString
sdat
, 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 b c d. (b -> c) -> Either b d -> Either c d
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 a b.
(a -> b) -> ConduitT a ByteString m a -> ConduitT a ByteString m b
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 b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
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 (ConduitT a ByteString m (Word64, Word32)) ByteString
sdat, Maybe Word64
usiz)
cdiZ64 :: Bool
cdiZ64 = 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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Word64
csiz)
cfhiHasUtf8Filename :: Bool
cfhiHasUtf8Filename = Either Text ByteString -> Bool
forall a b. Either a b -> Bool
isLeft Either Text ByteString
zipEntryName
cdiName :: ByteString
cdiName = (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
cdiName
(Word16
cfhiTime, Word16
cfhiDate) = 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
!cdiCommonFileHeaderInfo :: CommonFileHeaderInfo
cdiCommonFileHeaderInfo = CommonFileHeaderInfo{Bool
Word16
cfhiIsStreamingEntry :: Bool
cfhiHasUtf8Filename :: Bool
cfhiIsCompressed :: Bool
cfhiTime :: Word16
cfhiDate :: Word16
cfhiIsCompressed :: Bool
cfhiIsStreamingEntry :: Bool
cfhiHasUtf8Filename :: Bool
cfhiTime :: Word16
cfhiDate :: Word16
..}
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": entry name too long"
Word64
cdiOff <- 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
cdiZ64 then Word8
45 else Word8
20
Word8 -> Put
P.putWord8 Word8
osVersion
CommonFileHeaderInfo -> Put
putCommonFileHeaderPart CommonFileHeaderInfo
cdiCommonFileHeaderInfo
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
cdiZ64 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
cdiZ64 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
cdiZ64 Bool -> Word16 -> Word16
forall a. Num a => Bool -> a -> a
?* Word16
20
ByteString -> Put
P.putByteString ByteString
cdiName
Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cdiZ64 (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 b c c'. (b -> c) -> (b -> c') -> b -> (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
cdiUsz, Word32
cdiCrc), Word64
cdiCsz) <- (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
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
cdiZ64 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 -> ShowS
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
cdiZ64 = 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 a. a -> ConduitT i ByteString (StateT Word64 m) a
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 a b.
a -> ConduitT i ByteString m b -> ConduitT i ByteString m a
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
cdiUsz 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": incorrect zipEntrySize"
let !centralDirectoryInfo :: CentralDirectoryInfo
centralDirectoryInfo = CentralDirectoryInfo
{ cdiZipEntryExternalAttributes :: Maybe Word32
cdiZipEntryExternalAttributes = Maybe Word32 -> Maybe Word32
forall a. NFData a => a -> a
force Maybe Word32
zipEntryExternalAttributes
, Bool
Word32
Word64
ByteString
CommonFileHeaderInfo
cdiOff :: Word64
cdiZ64 :: Bool
cdiCommonFileHeaderInfo :: CommonFileHeaderInfo
cdiCrc :: Word32
cdiUsz :: Word64
cdiName :: ByteString
cdiCsz :: Word64
cdiZ64 :: Bool
cdiName :: ByteString
cdiCommonFileHeaderInfo :: CommonFileHeaderInfo
cdiOff :: Word64
cdiUsz :: Word64
cdiCrc :: Word32
cdiCsz :: Word64
.. }
Put -> ConduitT i ByteString (StateT Word64 m) Put
forall a. a -> ConduitT i ByteString (StateT Word64 m) a
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
$ 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 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
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 (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
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
Word16 -> Put
P.putWord16le Word16
0
Word16 -> Put
P.putWord16le Word16
0
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