{-# 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 :: forall (m :: * -> *) a. MonadThrow m => String -> m a
zipError = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ZipError
ZipError

idConduit :: Monad m => C.ConduitT a a m ()
idConduit :: forall (m :: * -> *) a. Monad m => ConduitT a a m ()
idConduit = forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
C.awaitForever 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 :: forall (m :: * -> *) a b.
Monad m =>
(a -> b -> a) -> a -> ConduitT b b m a
passthroughFold a -> b -> a
f !a
z = 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 a
z)
  (\b
x -> do
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield b
x
    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 :: forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m (Word64, Word32)
sizeCRC = forall (m :: * -> *) a b.
Monad m =>
(a -> b -> a) -> a -> ConduitT b b m a
passthroughFold (\(!Word64
l, !Word32
c) ByteString
b -> (Word64
l forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
b), 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 :: forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m Word64
sizeC = forall (m :: * -> *) a b.
Monad m =>
(a -> b -> a) -> a -> ConduitT b b m a
passthroughFold (\Word64
l ByteString
b -> Word64
l forall a. Num a => a -> a -> a
+ 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 :: forall (m :: * -> *) i.
Monad m =>
ConduitT i ByteString m () -> ConduitT i ByteString m Word64
outputSize = (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
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 :: forall (m :: * -> *) o.
Monad m =>
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 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 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) = forall l i o u (m :: * -> *) r.
m (Pipe l i o u m r) -> Pipe l i o u m r
CI.PipeM forall a b. (a -> b) -> a -> b
$ Word64
-> Pipe ByteString ByteString o () m ()
-> Pipe ByteString ByteString o () m b
go Word64
n 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) = 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 forall a. Num a => a -> a -> a
- 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) = 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) = 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 forall a. Num a => a -> a -> a
+ 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 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 (forall b.
(() -> Pipe ByteString ByteString o () m b)
-> Pipe ByteString ByteString o () m b
src forall l i o u (m :: * -> *) r. r -> Pipe l i o u m r
CI.Done)

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

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