{-# LANGUAGE BangPatterns #-}
module Codec.Archive.Zip.Conduit.Internal
  ( osVersion, zipVersion
  , zipError
  , idConduit
  , sizeCRC
  , outputSize
  , inputSize
  , maxBound32
  , deflateWindowBits
  ) where

import           Codec.Compression.Zlib.Raw (WindowBits(..))
import           Control.Monad.Catch (MonadThrow, throwM)
import qualified Data.ByteString as BS
import qualified Data.Conduit as C
import qualified Data.Conduit.Internal as CI
import           Data.Digest.CRC32 (crc32Update)
import           Data.Word (Word8, Word32, Word64)

import           Codec.Archive.Zip.Conduit.Types

-- | The version of this zip program, really just rough indicator of compatibility
zipVersion :: Word8
zipVersion :: Word8
zipVersion = Word8
48

-- | The OS this implementation tries to be compatible to
osVersion :: Word8
osVersion :: Word8
osVersion = Word8
0 -- DOS

zipError :: MonadThrow m => String -> m a
zipError :: String -> m a
zipError = ZipError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ZipError -> m a) -> (String -> ZipError) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ZipError
ZipError

idConduit :: Monad m => C.ConduitT a a m ()
idConduit :: ConduitT a a m ()
idConduit = (a -> ConduitT a a m ()) -> ConduitT a a m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
C.awaitForever a -> ConduitT a a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield

passthroughFold :: Monad m => (a -> b -> a) -> a -> C.ConduitT b b m a
passthroughFold :: (a -> b -> a) -> a -> ConduitT b b m a
passthroughFold a -> b -> a
f !a
z = ConduitT b b m (Maybe b)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
C.await ConduitT b b m (Maybe b)
-> (Maybe b -> ConduitT b b m a) -> ConduitT b b m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT b b m a
-> (b -> ConduitT b b m a) -> Maybe b -> ConduitT b b m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
  (a -> ConduitT b b m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
z)
  (\b
x -> do
    b -> ConduitT b b m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield b
x
    (a -> b -> a) -> a -> ConduitT b b m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> a) -> a -> ConduitT b b m a
passthroughFold a -> b -> a
f (a -> b -> a
f a
z b
x))

sizeCRC :: Monad m => C.ConduitT BS.ByteString BS.ByteString m (Word64, Word32)
sizeCRC :: ConduitT ByteString ByteString m (Word64, Word32)
sizeCRC = ((Word64, Word32) -> ByteString -> (Word64, Word32))
-> (Word64, Word32)
-> ConduitT ByteString ByteString m (Word64, Word32)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> a) -> a -> ConduitT b b m a
passthroughFold (\(!Word64
l, !Word32
c) ByteString
b -> (Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
b), Word32 -> ByteString -> Word32
forall a. CRC32 a => Word32 -> a -> Word32
crc32Update Word32
c ByteString
b)) (Word64
0, Word32
0)

sizeC :: Monad m => C.ConduitT BS.ByteString BS.ByteString m Word64
sizeC :: ConduitT ByteString ByteString m Word64
sizeC = (Word64 -> ByteString -> Word64)
-> Word64 -> ConduitT ByteString ByteString m Word64
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> a) -> a -> ConduitT b b m a
passthroughFold (\Word64
l ByteString
b -> Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
b)) Word64
0 -- fst <$> sizeCRC

outputSize :: Monad m => C.ConduitT i BS.ByteString m () -> C.ConduitT i BS.ByteString m Word64
outputSize :: ConduitT i ByteString m () -> ConduitT i ByteString m Word64
outputSize = (ConduitT i ByteString m ()
-> ConduitM ByteString ByteString m Word64
-> ConduitT i ByteString m Word64
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM ByteString ByteString m Word64
forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m Word64
sizeC)

inputSize :: Monad m => C.ConduitT BS.ByteString o m () -> C.ConduitT BS.ByteString o m Word64
-- inputSize = fuseUpstream sizeC -- won't work because we need to deal with leftovers properly
inputSize :: ConduitT ByteString o m () -> ConduitT ByteString o m Word64
inputSize (CI.ConduitT forall b.
(() -> Pipe ByteString ByteString o () m b)
-> Pipe ByteString ByteString o () m b
src) = (forall b.
 (Word64 -> Pipe ByteString ByteString o () m b)
 -> Pipe ByteString ByteString o () m b)
-> ConduitT ByteString o m Word64
forall i o (m :: * -> *) r.
(forall b. (r -> Pipe i i o () m b) -> Pipe i i o () m b)
-> ConduitT i o m r
CI.ConduitT ((forall b.
  (Word64 -> Pipe ByteString ByteString o () m b)
  -> Pipe ByteString ByteString o () m b)
 -> ConduitT ByteString o m Word64)
-> (forall b.
    (Word64 -> Pipe ByteString ByteString o () m b)
    -> Pipe ByteString ByteString o () m b)
-> ConduitT ByteString o m Word64
forall a b. (a -> b) -> a -> b
$ \Word64 -> Pipe ByteString ByteString o () m b
rest -> let
  go :: Word64
-> Pipe ByteString ByteString o () m ()
-> Pipe ByteString ByteString o () m b
go Word64
n (CI.Done ()) = Word64 -> Pipe ByteString ByteString o () m b
rest Word64
n
  go Word64
n (CI.PipeM m (Pipe ByteString ByteString o () m ())
m) = m (Pipe ByteString ByteString o () m b)
-> Pipe ByteString ByteString o () m b
forall l i o u (m :: * -> *) r.
m (Pipe l i o u m r) -> Pipe l i o u m r
CI.PipeM (m (Pipe ByteString ByteString o () m b)
 -> Pipe ByteString ByteString o () m b)
-> m (Pipe ByteString ByteString o () m b)
-> Pipe ByteString ByteString o () m b
forall a b. (a -> b) -> a -> b
$ Word64
-> Pipe ByteString ByteString o () m ()
-> Pipe ByteString ByteString o () m b
go Word64
n (Pipe ByteString ByteString o () m ()
 -> Pipe ByteString ByteString o () m b)
-> m (Pipe ByteString ByteString o () m ())
-> m (Pipe ByteString ByteString o () m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Pipe ByteString ByteString o () m ())
m
  go Word64
n (CI.Leftover Pipe ByteString ByteString o () m ()
p ByteString
b) = Pipe ByteString ByteString o () m b
-> ByteString -> Pipe ByteString ByteString o () m b
forall l i o u (m :: * -> *) r.
Pipe l i o u m r -> l -> Pipe l i o u m r
CI.Leftover (Word64
-> Pipe ByteString ByteString o () m ()
-> Pipe ByteString ByteString o () m b
go (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
b)) Pipe ByteString ByteString o () m ()
p) ByteString
b
  go Word64
n (CI.HaveOutput Pipe ByteString ByteString o () m ()
p o
o) = Pipe ByteString ByteString o () m b
-> o -> Pipe ByteString ByteString o () m b
forall l i o u (m :: * -> *) r.
Pipe l i o u m r -> o -> Pipe l i o u m r
CI.HaveOutput (Word64
-> Pipe ByteString ByteString o () m ()
-> Pipe ByteString ByteString o () m b
go Word64
n Pipe ByteString ByteString o () m ()
p) o
o
  go Word64
n (CI.NeedInput ByteString -> Pipe ByteString ByteString o () m ()
p () -> Pipe ByteString ByteString o () m ()
q) = (ByteString -> Pipe ByteString ByteString o () m b)
-> (() -> Pipe ByteString ByteString o () m b)
-> Pipe ByteString ByteString o () m b
forall l i o u (m :: * -> *) r.
(i -> Pipe l i o u m r)
-> (u -> Pipe l i o u m r) -> Pipe l i o u m r
CI.NeedInput (\ByteString
b -> Word64
-> Pipe ByteString ByteString o () m ()
-> Pipe ByteString ByteString o () m b
go (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
b)) (ByteString -> Pipe ByteString ByteString o () m ()
p ByteString
b)) (Word64
-> Pipe ByteString ByteString o () m ()
-> Pipe ByteString ByteString o () m b
go Word64
n (Pipe ByteString ByteString o () m ()
 -> Pipe ByteString ByteString o () m b)
-> (() -> Pipe ByteString ByteString o () m ())
-> ()
-> Pipe ByteString ByteString o () m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Pipe ByteString ByteString o () m ()
q)
  in Word64
-> Pipe ByteString ByteString o () m ()
-> Pipe ByteString ByteString o () m b
go Word64
0 ((() -> Pipe ByteString ByteString o () m ())
-> Pipe ByteString ByteString o () m ()
forall b.
(() -> Pipe ByteString ByteString o () m b)
-> Pipe ByteString ByteString o () m b
src () -> Pipe ByteString ByteString o () m ()
forall l i o u (m :: * -> *) r. r -> Pipe l i o u m r
CI.Done)

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

deflateWindowBits :: WindowBits
deflateWindowBits :: WindowBits
deflateWindowBits = Int -> WindowBits
WindowBits (-Int
15)