-- |Stream the extraction of a zip file, e.g., as it's being downloaded.
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RankNTypes #-}
module Codec.Archive.Zip.Conduit.UnZip
  ( unZipStream
  , ZipEntry(..)
  , ZipInfo(..)
  ) where

import           Control.Applicative ((<|>), empty)
import           Control.Monad (when, unless, guard)
import           Control.Monad.Catch (MonadThrow)
import           Control.Monad.Primitive (PrimMonad)
import qualified Data.Binary.Get as G
import           Data.Bits ((.&.), testBit, clearBit, shiftL, shiftR)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.Conduit as C
import qualified Data.Conduit.Combinators as CC
import           Data.Conduit.Serialization.Binary (sinkGet)
import qualified Data.Conduit.Zlib as CZ
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import           Data.Time (LocalTime(..), TimeOfDay(..), fromGregorian)
import           Data.Word (Word16, Word32, Word64)

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

data Header m
  = FileHeader
    { Header m -> ConduitM ByteString ByteString m ()
fileDecompress :: C.ConduitM BS.ByteString BS.ByteString m ()
    , Header m -> ZipEntry
fileEntry :: !ZipEntry
    , Header m -> Word32
fileCRC :: !Word32
    , Header m -> Word64
fileCSize :: !Word64
    , Header m -> Bool
fileZip64 :: !Bool
    }
  | EndOfCentralDirectory
    { Header m -> ZipInfo
endInfo :: ZipInfo
    }

data ExtField = ExtField
  { ExtField -> Bool
extZip64 :: Bool
  , ExtField -> Word64
extZip64USize
  , ExtField -> Word64
extZip64CSize :: Word64
  }

{- ExtUnix
  { extUnixATime
  , extUnixMTime :: UTCTime
  , extUnixUID
  , extUnixGID :: Word16
  , extUnixData :: BS.ByteString
  }
-}

pass :: (MonadThrow m, Integral n) => n -> C.ConduitM BS.ByteString BS.ByteString m ()
pass :: n -> ConduitM ByteString ByteString m ()
pass n
0 = () -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pass n
n = ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
C.await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitM ByteString ByteString m ())
-> ConduitM ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitM ByteString ByteString m ()
-> (ByteString -> ConduitM ByteString ByteString m ())
-> Maybe ByteString
-> ConduitM ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
  (String -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) a. MonadThrow m => String -> m a
zipError (String -> ConduitM ByteString ByteString m ())
-> String -> ConduitM ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ String
"EOF in file data, expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
ni String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" more bytes")
  (\ByteString
b ->
    let n' :: Integer
n' = Integer
ni Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Int
BS.length ByteString
b) in
    if Integer
n' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
      then do
        let (ByteString
b', ByteString
r) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
n) ByteString
b
        ByteString -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield ByteString
b'
        ByteString -> ConduitM ByteString ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
C.leftover ByteString
r
      else do
        ByteString -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield ByteString
b
        Integer -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) n.
(MonadThrow m, Integral n) =>
n -> ConduitM ByteString ByteString m ()
pass Integer
n')
  where ni :: Integer
ni = n -> Integer
forall a. Integral a => a -> Integer
toInteger n
n

foldGet :: (a -> G.Get a) -> a -> G.Get a
foldGet :: (a -> Get a) -> a -> Get a
foldGet a -> Get a
g a
z = do
  Bool
e <- Get Bool
G.isEmpty
  if Bool
e then a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
z else a -> Get a
g a
z Get a -> (a -> Get a) -> Get a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Get a) -> a -> Get a
forall a. (a -> Get a) -> a -> Get a
foldGet a -> Get a
g

fromDOSTime :: Word16 -> Word16 -> LocalTime
fromDOSTime :: Word16 -> Word16 -> LocalTime
fromDOSTime Word16
time Word16
date = Day -> TimeOfDay -> LocalTime
LocalTime
  (Integer -> Int -> Int -> Day
fromGregorian
    (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Word16 -> Integer
forall a b. (a -> b) -> a -> b
$ Word16
date Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
9 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1980)
    (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Word16
date Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
5 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x0f)
    (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Word16
date            Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x1f))
  (Int -> Int -> Pico -> TimeOfDay
TimeOfDay
    (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Word16
time Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
11)
    (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Word16
time Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
5 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x3f)
    (Word16 -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Pico) -> Word16 -> Pico
forall a b. (a -> b) -> a -> b
$ Word16
time Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
1 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x3f))

-- |Stream process a zip file, producing a sequence of entry headers and data blocks.
-- For example, this might produce: @Left (ZipEntry "directory\/" ...), Left (ZipEntry "directory\/file.txt" ...), Right "hello w", Right "orld!\\n", Left ...@
-- The final result is summary information taken from the end of the zip file.
-- No state is maintained during processing, and, in particular, any information in the central directory is discarded.
--
-- This only supports a limited number of zip file features, including deflate compression and zip64.
-- It does not (ironically) support uncompressed zip files that have been created as streams, where file sizes are not known beforehand.
-- Since it does not use the offset information at the end of the file, it assumes all entries are packed sequentially, which is usually the case.
-- Any errors are thrown in the underlying monad (as 'ZipError's or 'Data.Conduit.Serialization.Binary.ParseError').
unZipStream ::
  ( MonadThrow m
  , PrimMonad m
  ) => C.ConduitM BS.ByteString (Either ZipEntry BS.ByteString) m ZipInfo
unZipStream :: ConduitM ByteString (Either ZipEntry ByteString) m ZipInfo
unZipStream = ConduitM ByteString (Either ZipEntry ByteString) m ZipInfo
next where
  next :: ConduitM ByteString (Either ZipEntry ByteString) m ZipInfo
next = do -- local header, or start central directory
    Header m
h <- Get (Header m)
-> ConduitT ByteString (Either ZipEntry ByteString) m (Header m)
forall (m :: * -> *) b z.
MonadThrow m =>
Get b -> ConduitT ByteString z m b
sinkGet (Get (Header m)
 -> ConduitT ByteString (Either ZipEntry ByteString) m (Header m))
-> Get (Header m)
-> ConduitT ByteString (Either ZipEntry ByteString) m (Header m)
forall a b. (a -> b) -> a -> b
$ do
      Word32
sig <- Get Word32
G.getWord32le
      case Word32
sig of
        Word32
0x04034b50 -> Get (Header m)
fileHeader
        Word32
_ -> Word32 -> Get (Header m)
forall (m :: * -> *). Word32 -> Get (Header m)
centralBody Word32
sig
    case Header m
h of
      FileHeader{Bool
Word32
Word64
ConduitM ByteString ByteString m ()
ZipEntry
fileZip64 :: Bool
fileCSize :: Word64
fileCRC :: Word32
fileEntry :: ZipEntry
fileDecompress :: ConduitM ByteString ByteString m ()
fileZip64 :: forall (m :: * -> *). Header m -> Bool
fileCSize :: forall (m :: * -> *). Header m -> Word64
fileCRC :: forall (m :: * -> *). Header m -> Word32
fileEntry :: forall (m :: * -> *). Header m -> ZipEntry
fileDecompress :: forall (m :: * -> *).
Header m -> ConduitM ByteString ByteString m ()
..} -> do
        Either ZipEntry ByteString
-> ConduitT ByteString (Either ZipEntry ByteString) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield (Either ZipEntry ByteString
 -> ConduitT ByteString (Either ZipEntry ByteString) m ())
-> Either ZipEntry ByteString
-> ConduitT ByteString (Either ZipEntry ByteString) m ()
forall a b. (a -> b) -> a -> b
$ ZipEntry -> Either ZipEntry ByteString
forall a b. a -> Either a b
Left ZipEntry
fileEntry
        Bool
r <- (ByteString -> Either ZipEntry ByteString)
-> ConduitT ByteString ByteString m Bool
-> ConduitT ByteString (Either ZipEntry ByteString) m Bool
forall (m :: * -> *) o1 o2 i r.
Monad m =>
(o1 -> o2) -> ConduitT i o1 m r -> ConduitT i o2 m r
C.mapOutput ByteString -> Either ZipEntry ByteString
forall a b. b -> Either a b
Right (ConduitT ByteString ByteString m Bool
 -> ConduitT ByteString (Either ZipEntry ByteString) m Bool)
-> ConduitT ByteString ByteString m Bool
-> ConduitT ByteString (Either ZipEntry ByteString) m Bool
forall a b. (a -> b) -> a -> b
$
          case ZipEntry -> Maybe Word64
zipEntrySize ZipEntry
fileEntry of
            Maybe Word64
Nothing -> do -- unknown size
              (Word64
csize, (Word64
size, Word32
crc)) <- ConduitM ByteString ByteString m ()
-> ConduitT ByteString ByteString m Word64
forall (m :: * -> *) o.
Monad m =>
ConduitT ByteString o m () -> ConduitT ByteString o m Word64
inputSize ConduitM ByteString ByteString m ()
fileDecompress ConduitT ByteString ByteString m Word64
-> ConduitT ByteString ByteString m (Word64, Word32)
-> ConduitT ByteString ByteString m (Word64, (Word64, Word32))
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 (Word64, Word32)
forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m (Word64, Word32)
sizeCRC
              -- traceM $ "csize=" ++ show csize ++ " size=" ++ show size ++ " crc=" ++ show crc
              -- required data description
              Get Bool -> ConduitT ByteString ByteString m Bool
forall (m :: * -> *) b z.
MonadThrow m =>
Get b -> ConduitT ByteString z m b
sinkGet (Get Bool -> ConduitT ByteString ByteString m Bool)
-> Get Bool -> ConduitT ByteString ByteString m Bool
forall a b. (a -> b) -> a -> b
$ Header m -> Get Bool
forall (m :: * -> *). Header m -> Get Bool
dataDesc Header m
h
                { fileCSize :: Word64
fileCSize = Word64
csize
                , fileCRC :: Word32
fileCRC = Word32
crc
                , fileEntry :: ZipEntry
fileEntry = ZipEntry
fileEntry
                  { zipEntrySize :: Maybe Word64
zipEntrySize = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
size
                  }
                }
            Just Word64
usize -> do -- known size
              (Word64
size, Word32
crc) <- Word64 -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) n.
(MonadThrow m, Integral n) =>
n -> ConduitM ByteString ByteString m ()
pass Word64
fileCSize
                ConduitM ByteString ByteString m ()
-> ConduitT ByteString ByteString m (Word64, Word32)
-> ConduitT ByteString ByteString m (Word64, Word32)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| (ConduitM ByteString ByteString m ()
fileDecompress ConduitM ByteString ByteString m ()
-> ConduitM ByteString ByteString m ()
-> ConduitM ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitM ByteString ByteString m ()
forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
CC.sinkNull)
                ConduitM ByteString ByteString m ()
-> ConduitT ByteString ByteString m (Word64, Word32)
-> ConduitT ByteString ByteString m (Word64, Word32)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitT ByteString ByteString m (Word64, Word32)
forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m (Word64, Word32)
sizeCRC
              -- traceM $ "size=" ++ show size ++ "," ++ show (zipEntrySize fileEntry) ++ " crc=" ++ show crc ++ "," ++ show fileCRC
              -- optional data description (possibly ambiguous!)
              Get () -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) b z.
MonadThrow m =>
Get b -> ConduitT ByteString z m b
sinkGet (Get () -> ConduitM ByteString ByteString m ())
-> Get () -> ConduitM ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> Get Bool -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Header m -> Get Bool
forall (m :: * -> *). Header m -> Get Bool
dataDesc Header m
h) Get () -> Get () -> Get ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Bool -> ConduitT ByteString ByteString m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
size Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
usize Bool -> Bool -> Bool
&& Word32
crc Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
fileCRC)
        Bool
-> ConduitT ByteString (Either ZipEntry ByteString) m ()
-> ConduitT ByteString (Either ZipEntry ByteString) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
r (ConduitT ByteString (Either ZipEntry ByteString) m ()
 -> ConduitT ByteString (Either ZipEntry ByteString) m ())
-> ConduitT ByteString (Either ZipEntry ByteString) m ()
-> ConduitT ByteString (Either ZipEntry ByteString) m ()
forall a b. (a -> b) -> a -> b
$ String -> ConduitT ByteString (Either ZipEntry ByteString) m ()
forall (m :: * -> *) a. MonadThrow m => String -> m a
zipError (String -> ConduitT ByteString (Either ZipEntry ByteString) m ())
-> String -> ConduitT ByteString (Either ZipEntry ByteString) m ()
forall a b. (a -> b) -> a -> b
$ (Text -> String)
-> (ByteString -> String) -> Either Text ByteString -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> String
T.unpack ByteString -> String
BSC.unpack (ZipEntry -> Either Text ByteString
zipEntryName ZipEntry
fileEntry) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": data integrity check failed"
        ConduitM ByteString (Either ZipEntry ByteString) m ZipInfo
next
      EndOfCentralDirectory{ZipInfo
endInfo :: ZipInfo
endInfo :: forall (m :: * -> *). Header m -> ZipInfo
..} -> do
        ZipInfo
-> ConduitM ByteString (Either ZipEntry ByteString) m ZipInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ZipInfo
endInfo
  dataDesc :: Header m -> Get Bool
dataDesc Header m
h = -- this takes a bit of flexibility to account for the various cases
    (do -- with signature
      Word32
sig <- Get Word32
G.getWord32le
      Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word32
sig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x08074b50)
      Header m -> Get Bool
forall (m :: * -> *). Header m -> Get Bool
dataDescBody Header m
h)
    Get Bool -> Get Bool -> Get Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Header m -> Get Bool
forall (m :: * -> *). Header m -> Get Bool
dataDescBody Header m
h -- without signature
  dataDescBody :: Header m -> Get Bool
dataDescBody FileHeader{Bool
Word32
Word64
ConduitM ByteString ByteString m ()
ZipEntry
fileZip64 :: Bool
fileCSize :: Word64
fileCRC :: Word32
fileEntry :: ZipEntry
fileDecompress :: ConduitM ByteString ByteString m ()
fileZip64 :: forall (m :: * -> *). Header m -> Bool
fileCSize :: forall (m :: * -> *). Header m -> Word64
fileCRC :: forall (m :: * -> *). Header m -> Word32
fileEntry :: forall (m :: * -> *). Header m -> ZipEntry
fileDecompress :: forall (m :: * -> *).
Header m -> ConduitM ByteString ByteString m ()
..} = do
    Word32
crc <- Get Word32
G.getWord32le
    let getSize :: Get Word64
getSize = if Bool
fileZip64 then Get Word64
G.getWord64le else Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
G.getWord32le
    Word64
csiz <- Get Word64
getSize
    Word64
usiz <- Get Word64
getSize
    -- traceM $ "crc=" ++ show crc ++ "," ++ show fileCRC ++ " csiz=" ++ show csiz ++ "," ++ show fileCSize ++ " usiz=" ++ show usiz ++ "," ++ show (zipEntrySize fileEntry)
    Bool -> Get Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Get Bool) -> Bool -> Get Bool
forall a b. (a -> b) -> a -> b
$ Word32
crc Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
fileCRC Bool -> Bool -> Bool
&& Word64
csiz Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
fileCSize Bool -> Bool -> Bool
&& (Word64
usiz Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==) (Word64 -> Bool) -> Maybe Word64 -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`all` ZipEntry -> Maybe Word64
zipEntrySize ZipEntry
fileEntry
  dataDescBody Header m
_ = Get Bool
forall (f :: * -> *) a. Alternative f => f a
empty
  central :: Get (Header m)
central = Get Word32
G.getWord32le Get Word32 -> (Word32 -> Get (Header m)) -> Get (Header m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Get (Header m)
centralBody
  centralBody :: Word32 -> Get (Header m)
centralBody Word32
0x02014b50 = Get ()
centralHeader Get () -> Get (Header m) -> Get (Header m)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (Header m)
central
  centralBody Word32
0x06064b50 = Get ()
zip64EndDirectory Get () -> Get (Header m) -> Get (Header m)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (Header m)
central
  centralBody Word32
0x07064b50 = Int -> Get ()
G.skip Int
16 Get () -> Get (Header m) -> Get (Header m)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (Header m)
central
  centralBody Word32
0x06054b50 = ZipInfo -> Header m
forall (m :: * -> *). ZipInfo -> Header m
EndOfCentralDirectory (ZipInfo -> Header m) -> Get ZipInfo -> Get (Header m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ZipInfo
endDirectory
  centralBody Word32
sig = String -> Get (Header m)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Header m)) -> String -> Get (Header m)
forall a b. (a -> b) -> a -> b
$ String
"Unknown header signature: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
sig
  fileHeader :: Get (Header m)
fileHeader = do
    Word8
ver <- Get Word8
G.getWord8
    Word8
_os <- Get Word8
G.getWord8 -- OS Version (could require 0 = DOS, but we ignore ext attrs altogether)
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
ver Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
zipVersion) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"Unsupported version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
ver
    Word16
gpf <- Get Word16
G.getWord16le
    -- when (gpf .&. complement (bit 1 .|. bit 2 .|. bit 3) /= 0) $ fail $ "Unsupported flags: " ++ show gpf
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
gpf Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`clearBit` Int
1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`clearBit` Int
2 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`clearBit` Int
3 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`clearBit` Int
11 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"Unsupported flags: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
gpf
    Word16
comp <- Get Word16
G.getWord16le
    ConduitM ByteString ByteString m ()
dcomp <- case Word16
comp of
      Word16
0 | Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
gpf Int
3 -> String -> Get (ConduitM ByteString ByteString m ())
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unsupported uncompressed streaming file data"
        | Bool
otherwise -> ConduitM ByteString ByteString m ()
-> Get (ConduitM ByteString ByteString m ())
forall (m :: * -> *) a. Monad m => a -> m a
return ConduitM ByteString ByteString m ()
forall (m :: * -> *) a. Monad m => ConduitT a a m ()
idConduit
      Word16
8 -> ConduitM ByteString ByteString m ()
-> Get (ConduitM ByteString ByteString m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitM ByteString ByteString m ()
 -> Get (ConduitM ByteString ByteString m ()))
-> ConduitM ByteString ByteString m ()
-> Get (ConduitM ByteString ByteString m ())
forall a b. (a -> b) -> a -> b
$ WindowBits -> ConduitM ByteString ByteString m ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
WindowBits -> ConduitT ByteString ByteString m ()
CZ.decompress WindowBits
deflateWindowBits
      Word16
_ -> String -> Get (ConduitM ByteString ByteString m ())
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (ConduitM ByteString ByteString m ()))
-> String -> Get (ConduitM ByteString ByteString m ())
forall a b. (a -> b) -> a -> b
$ String
"Unsupported compression method: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
comp
    LocalTime
time <- Word16 -> Word16 -> LocalTime
fromDOSTime (Word16 -> Word16 -> LocalTime)
-> Get Word16 -> Get (Word16 -> LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
G.getWord16le Get (Word16 -> LocalTime) -> Get Word16 -> Get LocalTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
G.getWord16le
    Word32
crc <- Get Word32
G.getWord32le
    Word32
csiz <- Get Word32
G.getWord32le
    Word32
usiz <- Get Word32
G.getWord32le
    Int
nlen <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
G.getWord16le
    Int
elen <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
G.getWord16le
    ByteString
name <- Int -> Get ByteString
G.getByteString Int
nlen
    let getExt :: ExtField -> Get ExtField
getExt ExtField
ext = do
          Word16
t <- Get Word16
G.getWord16le
          Int
z <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
G.getWord16le
          Int -> Get ExtField -> Get ExtField
forall a. Int -> Get a -> Get a
G.isolate Int
z (Get ExtField -> Get ExtField) -> Get ExtField -> Get ExtField
forall a b. (a -> b) -> a -> b
$ case Word16
t of
            Word16
0x0001 -> do
              -- the zip specs claim "the Local header MUST include BOTH" but "only if the corresponding field is set to 0xFFFFFFFF"
              Word64
usiz' <- if Word32
usiz Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall n. Integral n => n
maxBound32 then Get Word64
G.getWord64le else Word64 -> Get Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Get Word64) -> Word64 -> Get Word64
forall a b. (a -> b) -> a -> b
$ ExtField -> Word64
extZip64USize ExtField
ext
              Word64
csiz' <- if Word32
csiz Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall n. Integral n => n
maxBound32 then Get Word64
G.getWord64le else Word64 -> Get Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Get Word64) -> Word64 -> Get Word64
forall a b. (a -> b) -> a -> b
$ ExtField -> Word64
extZip64CSize ExtField
ext
              ExtField -> Get ExtField
forall (m :: * -> *) a. Monad m => a -> m a
return ExtField
ext
                { extZip64 :: Bool
extZip64 = Bool
True
                , extZip64USize :: Word64
extZip64USize = Word64
usiz'
                , extZip64CSize :: Word64
extZip64CSize = Word64
csiz'
                }
            {-
            0x000d -> do
              atim <- G.getWord32le
              mtim <- G.getWord32le
              uid <- G.getWord16le
              gid <- G.getWord16le
              dat <- G.getByteString $ z - 12
              return ExtUnix
                { extUnixATime = posixSecondsToUTCTime atim
                , extUnixMTime = posixSecondsToUTCTime mtim
                , extUnixUID = uid
                , extUnixGID = gid
                , extUnixData = dat
                }
            -}
            Word16
_ -> ExtField
ext ExtField -> Get () -> Get ExtField
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> Get ()
G.skip Int
z
    ExtField{Bool
Word64
extZip64CSize :: Word64
extZip64USize :: Word64
extZip64 :: Bool
extZip64CSize :: ExtField -> Word64
extZip64USize :: ExtField -> Word64
extZip64 :: ExtField -> Bool
..} <- Int -> Get ExtField -> Get ExtField
forall a. Int -> Get a -> Get a
G.isolate Int
elen (Get ExtField -> Get ExtField) -> Get ExtField -> Get ExtField
forall a b. (a -> b) -> a -> b
$ (ExtField -> Get ExtField) -> ExtField -> Get ExtField
forall a. (a -> Get a) -> a -> Get a
foldGet ExtField -> Get ExtField
getExt ExtField :: Bool -> Word64 -> Word64 -> ExtField
ExtField
      { extZip64 :: Bool
extZip64 = Bool
False
      , extZip64USize :: Word64
extZip64USize = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
usiz
      , extZip64CSize :: Word64
extZip64CSize = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
csiz
      }
    Header m -> Get (Header m)
forall (m :: * -> *) a. Monad m => a -> m a
return FileHeader :: forall (m :: * -> *).
ConduitM ByteString ByteString m ()
-> ZipEntry -> Word32 -> Word64 -> Bool -> Header m
FileHeader
      { fileEntry :: ZipEntry
fileEntry = ZipEntry :: Either Text ByteString
-> LocalTime -> Maybe Word64 -> Maybe Word32 -> ZipEntry
ZipEntry
        { zipEntryName :: Either Text ByteString
zipEntryName = if Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
gpf Int
11 then Text -> Either Text ByteString
forall a b. a -> Either a b
Left (ByteString -> Text
TE.decodeUtf8 ByteString
name) else ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right ByteString
name
        , zipEntryTime :: LocalTime
zipEntryTime = LocalTime
time
        , zipEntrySize :: Maybe Word64
zipEntrySize = if Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
gpf Int
3 then Maybe Word64
forall a. Maybe a
Nothing else Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
extZip64USize
        , zipEntryExternalAttributes :: Maybe Word32
zipEntryExternalAttributes = Maybe Word32
forall a. Maybe a
Nothing
        }
      , fileDecompress :: ConduitM ByteString ByteString m ()
fileDecompress = ConduitM ByteString ByteString m ()
dcomp
      , fileCSize :: Word64
fileCSize = Word64
extZip64CSize
      , fileCRC :: Word32
fileCRC = Word32
crc
      , fileZip64 :: Bool
fileZip64 = Bool
extZip64
      }
  centralHeader :: Get ()
centralHeader = do
    -- ignore everything
    Int -> Get ()
G.skip Int
24
    Int
nlen <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
G.getWord16le
    Int
elen <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
G.getWord16le
    Int
clen <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
G.getWord16le
    Int -> Get ()
G.skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nlen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
elen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
clen
  zip64EndDirectory :: Get ()
zip64EndDirectory = do
    Word64
len <- Get Word64
G.getWord64le
    Int -> Get ()
G.skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len -- would not expect to overflow...
  endDirectory :: Get ZipInfo
endDirectory = do
    Int -> Get ()
G.skip Int
16
    Int
clen <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
G.getWord16le
    ByteString
comm <- Int -> Get ByteString
G.getByteString Int
clen
    ZipInfo -> Get ZipInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ZipInfo :: ByteString -> ZipInfo
ZipInfo
      { zipComment :: ByteString
zipComment = ByteString
comm
      }