{-# LANGUAGE DeriveDataTypeable #-}
-- | This is a middle-level wrapper around the zlib C API. It allows you to
-- work fully with bytestrings and not touch the FFI at all, but is still
-- low-level enough to allow you to implement high-level abstractions such as
-- enumerators. Significantly, it does not use lazy IO.
--
-- You'll probably need to reference the docs a bit to understand the
-- WindowBits parameters below, but a basic rule of thumb is 15 is for zlib
-- compression, and 31 for gzip compression.
--
-- A simple streaming compressor in pseudo-code would look like:
--
-- > def <- initDeflate ...
-- > popper <- feedDeflate def rawContent
-- > pullPopper popper
-- > ...
-- > finishDeflate def sendCompressedData
--
-- You can see a more complete example is available in the included
-- file-test.hs.
module Data.Streaming.Zlib
    ( -- * Inflate
      Inflate
    , initInflate
    , initInflateWithDictionary
    , feedInflate
    , finishInflate
    , flushInflate
    , getUnusedInflate
    , isCompleteInflate
      -- * Deflate
    , Deflate
    , initDeflate
    , initDeflateWithDictionary
    , feedDeflate
    , finishDeflate
    , flushDeflate
    , fullFlushDeflate
      -- * Data types
    , WindowBits (..)
    , defaultWindowBits
    , ZlibException (..)
    , Popper
    , PopperRes (..)
    ) where

import Data.Streaming.Zlib.Lowlevel
import Foreign.ForeignPtr
import Foreign.C.Types
import Data.ByteString.Unsafe
import Codec.Compression.Zlib (WindowBits(WindowBits), defaultWindowBits)
import qualified Data.ByteString as S
import Data.ByteString.Lazy.Internal (defaultChunkSize)
import Data.Typeable (Typeable)
import Control.Exception (Exception)
import Control.Monad (when)
import Data.IORef

type ZStreamPair = (ForeignPtr ZStreamStruct, ForeignPtr CChar)

-- | The state of an inflation (eg, decompression) process. All allocated
-- memory is automatically reclaimed by the garbage collector.
-- Also can contain the inflation dictionary that is used for decompression.
data Inflate = Inflate
    ZStreamPair
    (IORef S.ByteString) -- last ByteString fed in, needed for getUnusedInflate
    (IORef Bool)         -- set True when zlib indicates that inflation is complete
    (Maybe S.ByteString) -- dictionary

-- | The state of a deflation (eg, compression) process. All allocated memory
-- is automatically reclaimed by the garbage collector.
newtype Deflate = Deflate ZStreamPair

-- | Exception that can be thrown from the FFI code. The parameter is the
-- numerical error code from the zlib library. Quoting the zlib.h file
-- directly:
--
-- * #define Z_OK            0
--
-- * #define Z_STREAM_END    1
--
-- * #define Z_NEED_DICT     2
--
-- * #define Z_ERRNO        (-1)
--
-- * #define Z_STREAM_ERROR (-2)
--
-- * #define Z_DATA_ERROR   (-3)
--
-- * #define Z_MEM_ERROR    (-4)
--
-- * #define Z_BUF_ERROR    (-5)
--
-- * #define Z_VERSION_ERROR (-6)

data ZlibException = ZlibException Int
    deriving (Int -> ZlibException -> ShowS
[ZlibException] -> ShowS
ZlibException -> String
(Int -> ZlibException -> ShowS)
-> (ZlibException -> String)
-> ([ZlibException] -> ShowS)
-> Show ZlibException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZlibException] -> ShowS
$cshowList :: [ZlibException] -> ShowS
show :: ZlibException -> String
$cshow :: ZlibException -> String
showsPrec :: Int -> ZlibException -> ShowS
$cshowsPrec :: Int -> ZlibException -> ShowS
Show, Typeable)
instance Exception ZlibException

-- | Some constants for the error codes, used internally
zStreamEnd :: CInt
zStreamEnd :: CInt
zStreamEnd = CInt
1

zNeedDict :: CInt
zNeedDict :: CInt
zNeedDict = CInt
2

zBufError :: CInt
zBufError :: CInt
zBufError = -CInt
5

-- | Initialize an inflation process with the given 'WindowBits'. You will need
-- to call 'feedInflate' to feed compressed data to this and
-- 'finishInflate' to extract the final chunk of decompressed data.
initInflate :: WindowBits -> IO Inflate
initInflate :: WindowBits -> IO Inflate
initInflate WindowBits
w = do
    ZStream'
zstr <- IO ZStream'
zstreamNew
    ZStream' -> WindowBits -> IO ()
inflateInit2 ZStream'
zstr WindowBits
w
    ForeignPtr ZStreamStruct
fzstr <- FinalizerPtr ZStreamStruct
-> ZStream' -> IO (ForeignPtr ZStreamStruct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ZStreamStruct
c_free_z_stream_inflate ZStream'
zstr
    ForeignPtr CChar
fbuff <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
defaultChunkSize
    ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
fbuff ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buff ->
        ZStream' -> Ptr CChar -> CUInt -> IO ()
c_set_avail_out ZStream'
zstr Ptr CChar
buff (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
defaultChunkSize
    IORef ByteString
lastBS <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
S.empty
    IORef Bool
complete <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
    Inflate -> IO Inflate
forall (m :: * -> *) a. Monad m => a -> m a
return (Inflate -> IO Inflate) -> Inflate -> IO Inflate
forall a b. (a -> b) -> a -> b
$ ZStreamPair
-> IORef ByteString -> IORef Bool -> Maybe ByteString -> Inflate
Inflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
fbuff) IORef ByteString
lastBS IORef Bool
complete Maybe ByteString
forall a. Maybe a
Nothing

-- | Initialize an inflation process with the given 'WindowBits'.
-- Unlike initInflate a dictionary for inflation is set which must
-- match the one set during compression.
initInflateWithDictionary :: WindowBits -> S.ByteString -> IO Inflate
initInflateWithDictionary :: WindowBits -> ByteString -> IO Inflate
initInflateWithDictionary WindowBits
w ByteString
bs = do
    ZStream'
zstr <- IO ZStream'
zstreamNew
    ZStream' -> WindowBits -> IO ()
inflateInit2 ZStream'
zstr WindowBits
w
    ForeignPtr ZStreamStruct
fzstr <- FinalizerPtr ZStreamStruct
-> ZStream' -> IO (ForeignPtr ZStreamStruct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ZStreamStruct
c_free_z_stream_inflate ZStream'
zstr
    ForeignPtr CChar
fbuff <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
defaultChunkSize

    ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
fbuff ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buff ->
        ZStream' -> Ptr CChar -> CUInt -> IO ()
c_set_avail_out ZStream'
zstr Ptr CChar
buff (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
defaultChunkSize
    IORef ByteString
lastBS <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
S.empty
    IORef Bool
complete <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
    Inflate -> IO Inflate
forall (m :: * -> *) a. Monad m => a -> m a
return (Inflate -> IO Inflate) -> Inflate -> IO Inflate
forall a b. (a -> b) -> a -> b
$ ZStreamPair
-> IORef ByteString -> IORef Bool -> Maybe ByteString -> Inflate
Inflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
fbuff) IORef ByteString
lastBS IORef Bool
complete (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)

-- | Initialize a deflation process with the given compression level and
-- 'WindowBits'. You will need to call 'feedDeflate' to feed uncompressed
-- data to this and 'finishDeflate' to extract the final chunks of compressed
-- data.
initDeflate :: Int -- ^ Compression level
            -> WindowBits -> IO Deflate
initDeflate :: Int -> WindowBits -> IO Deflate
initDeflate Int
level WindowBits
w = do
    ZStream'
zstr <- IO ZStream'
zstreamNew
    ZStream' -> Int -> WindowBits -> Int -> Strategy -> IO ()
deflateInit2 ZStream'
zstr Int
level WindowBits
w Int
8 Strategy
StrategyDefault
    ForeignPtr ZStreamStruct
fzstr <- FinalizerPtr ZStreamStruct
-> ZStream' -> IO (ForeignPtr ZStreamStruct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ZStreamStruct
c_free_z_stream_deflate ZStream'
zstr
    ForeignPtr CChar
fbuff <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
defaultChunkSize
    ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
fbuff ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buff ->
        ZStream' -> Ptr CChar -> CUInt -> IO ()
c_set_avail_out ZStream'
zstr Ptr CChar
buff (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
defaultChunkSize
    Deflate -> IO Deflate
forall (m :: * -> *) a. Monad m => a -> m a
return (Deflate -> IO Deflate) -> Deflate -> IO Deflate
forall a b. (a -> b) -> a -> b
$ ZStreamPair -> Deflate
Deflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
fbuff)

-- | Initialize an deflation process with the given compression level and
-- 'WindowBits'.
-- Unlike initDeflate a dictionary for deflation is set.
initDeflateWithDictionary :: Int -- ^ Compression level
                          -> S.ByteString -- ^ Deflate dictionary
                          -> WindowBits -> IO Deflate
initDeflateWithDictionary :: Int -> ByteString -> WindowBits -> IO Deflate
initDeflateWithDictionary Int
level ByteString
bs WindowBits
w = do
    ZStream'
zstr <- IO ZStream'
zstreamNew
    ZStream' -> Int -> WindowBits -> Int -> Strategy -> IO ()
deflateInit2 ZStream'
zstr Int
level WindowBits
w Int
8 Strategy
StrategyDefault
    ForeignPtr ZStreamStruct
fzstr <- FinalizerPtr ZStreamStruct
-> ZStream' -> IO (ForeignPtr ZStreamStruct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ZStreamStruct
c_free_z_stream_deflate ZStream'
zstr
    ForeignPtr CChar
fbuff <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
defaultChunkSize

    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) -> do
        ZStream' -> Ptr CChar -> CUInt -> IO ()
c_call_deflate_set_dictionary ZStream'
zstr Ptr CChar
cstr (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len

    ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
fbuff ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buff ->
        ZStream' -> Ptr CChar -> CUInt -> IO ()
c_set_avail_out ZStream'
zstr Ptr CChar
buff (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
defaultChunkSize
    Deflate -> IO Deflate
forall (m :: * -> *) a. Monad m => a -> m a
return (Deflate -> IO Deflate) -> Deflate -> IO Deflate
forall a b. (a -> b) -> a -> b
$ ZStreamPair -> Deflate
Deflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
fbuff)

-- | Feed the given 'S.ByteString' to the inflater. Return a 'Popper',
-- an IO action that returns the decompressed data a chunk at a time.
-- The 'Popper' must be called to exhaustion before using the 'Inflate'
-- object again.
--
-- Note that this function automatically buffers the output to
-- 'defaultChunkSize', and therefore you won't get any data from the popper
-- until that much decompressed data is available. After you have fed all of
-- the compressed data to this function, you can extract your final chunk of
-- decompressed data using 'finishInflate'.
feedInflate
    :: Inflate
    -> S.ByteString
    -> IO Popper
feedInflate :: Inflate -> ByteString -> IO Popper
feedInflate (Inflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
fbuff) IORef ByteString
lastBS IORef Bool
complete Maybe ByteString
inflateDictionary) ByteString
bs = do
    -- Write the BS to lastBS for use by getUnusedInflate. This is
    -- theoretically unnecessary, since we could just grab the pointer from the
    -- fzstr when needed. However, in that case, we wouldn't be holding onto a
    -- reference to the ForeignPtr, so the GC may decide to collect the
    -- ByteString in the interim.
    IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
lastBS ByteString
bs

    ForeignPtr ZStreamStruct -> (ZStream' -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStreamStruct
fzstr ((ZStream' -> IO ()) -> IO ()) -> (ZStream' -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ZStream'
zstr ->
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) ->
            ZStream' -> Ptr CChar -> CUInt -> IO ()
c_set_avail_in ZStream'
zstr Ptr CChar
cstr (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
    Popper -> IO Popper
forall (m :: * -> *) a. Monad m => a -> m a
return (Popper -> IO Popper) -> Popper -> IO Popper
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar
-> ForeignPtr ZStreamStruct
-> Maybe ByteString
-> (ZStream' -> IO CInt)
-> Bool
-> Popper
drain ForeignPtr CChar
fbuff ForeignPtr ZStreamStruct
fzstr (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs) ZStream' -> IO CInt
inflate Bool
False
  where
    inflate :: ZStream' -> IO CInt
inflate ZStream'
zstr = do
        CInt
res <- ZStream' -> IO CInt
c_call_inflate_noflush ZStream'
zstr
        CInt
res2 <- if (CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
zNeedDict)
            then IO CInt -> (ByteString -> IO CInt) -> Maybe ByteString -> IO CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
zNeedDict)
                       (\ByteString
dict -> (ByteString -> (CStringLen -> IO CInt) -> IO CInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
dict ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) -> do
                                    ZStream' -> Ptr CChar -> CUInt -> IO ()
c_call_inflate_set_dictionary ZStream'
zstr Ptr CChar
cstr (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
                                    ZStream' -> IO CInt
c_call_inflate_noflush ZStream'
zstr))
                       Maybe ByteString
inflateDictionary
            else CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
res2 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
zStreamEnd) (IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
complete Bool
True)
        CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res2

-- | An IO action that returns the next chunk of data, returning 'PRDone' when
-- there is no more data to be popped.
type Popper = IO PopperRes

data PopperRes = PRDone
               | PRNext !S.ByteString
               | PRError !ZlibException
    deriving (Int -> PopperRes -> ShowS
[PopperRes] -> ShowS
PopperRes -> String
(Int -> PopperRes -> ShowS)
-> (PopperRes -> String)
-> ([PopperRes] -> ShowS)
-> Show PopperRes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PopperRes] -> ShowS
$cshowList :: [PopperRes] -> ShowS
show :: PopperRes -> String
$cshow :: PopperRes -> String
showsPrec :: Int -> PopperRes -> ShowS
$cshowsPrec :: Int -> PopperRes -> ShowS
Show, Typeable)

-- | Ensure that the given @ByteString@ is not deallocated.
keepAlive :: Maybe S.ByteString -> IO a -> IO a
keepAlive :: Maybe ByteString -> IO a -> IO a
keepAlive Maybe ByteString
Nothing = IO a -> IO a
forall a. a -> a
id
keepAlive (Just ByteString
bs) = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO a) -> IO a)
-> (IO a -> CStringLen -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> CStringLen -> IO a
forall a b. a -> b -> a
const

drain :: ForeignPtr CChar
      -> ForeignPtr ZStreamStruct
      -> Maybe S.ByteString
      -> (ZStream' -> IO CInt)
      -> Bool
      -> Popper
drain :: ForeignPtr CChar
-> ForeignPtr ZStreamStruct
-> Maybe ByteString
-> (ZStream' -> IO CInt)
-> Bool
-> Popper
drain ForeignPtr CChar
fbuff ForeignPtr ZStreamStruct
fzstr Maybe ByteString
mbs ZStream' -> IO CInt
func Bool
isFinish = ForeignPtr ZStreamStruct -> (ZStream' -> Popper) -> Popper
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStreamStruct
fzstr ((ZStream' -> Popper) -> Popper) -> (ZStream' -> Popper) -> Popper
forall a b. (a -> b) -> a -> b
$ \ZStream'
zstr -> Maybe ByteString -> Popper -> Popper
forall a. Maybe ByteString -> IO a -> IO a
keepAlive Maybe ByteString
mbs (Popper -> Popper) -> Popper -> Popper
forall a b. (a -> b) -> a -> b
$ do
    CInt
res <- ZStream' -> IO CInt
func ZStream'
zstr
    if CInt
res CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 Bool -> Bool -> Bool
&& CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
zBufError
        then PopperRes -> Popper
forall (m :: * -> *) a. Monad m => a -> m a
return (PopperRes -> Popper) -> PopperRes -> Popper
forall a b. (a -> b) -> a -> b
$ ZlibException -> PopperRes
PRError (ZlibException -> PopperRes) -> ZlibException -> PopperRes
forall a b. (a -> b) -> a -> b
$ Int -> ZlibException
ZlibException (Int -> ZlibException) -> Int -> ZlibException
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res
        else do
            CUInt
avail <- ZStream' -> IO CUInt
c_get_avail_out ZStream'
zstr
            let size :: Int
size = Int
defaultChunkSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
avail
                toOutput :: Bool
toOutput = CUInt
avail CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0 Bool -> Bool -> Bool
|| (Bool
isFinish Bool -> Bool -> Bool
&& Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
            if Bool
toOutput
                then ForeignPtr CChar -> (Ptr CChar -> Popper) -> Popper
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
fbuff ((Ptr CChar -> Popper) -> Popper)
-> (Ptr CChar -> Popper) -> Popper
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buff -> do
                    ByteString
bs <- CStringLen -> IO ByteString
S.packCStringLen (Ptr CChar
buff, Int
size)
                    ZStream' -> Ptr CChar -> CUInt -> IO ()
c_set_avail_out ZStream'
zstr Ptr CChar
buff
                        (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
defaultChunkSize
                    PopperRes -> Popper
forall (m :: * -> *) a. Monad m => a -> m a
return (PopperRes -> Popper) -> PopperRes -> Popper
forall a b. (a -> b) -> a -> b
$ ByteString -> PopperRes
PRNext ByteString
bs
                else PopperRes -> Popper
forall (m :: * -> *) a. Monad m => a -> m a
return PopperRes
PRDone


-- | As explained in 'feedInflate', inflation buffers your decompressed
-- data. After you call 'feedInflate' with your last chunk of compressed
-- data, you will likely have some data still sitting in the buffer. This
-- function will return it to you.
finishInflate :: Inflate -> IO S.ByteString
finishInflate :: Inflate -> IO ByteString
finishInflate (Inflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
fbuff) IORef ByteString
_ IORef Bool
_ Maybe ByteString
_) =
    ForeignPtr ZStreamStruct
-> (ZStream' -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStreamStruct
fzstr ((ZStream' -> IO ByteString) -> IO ByteString)
-> (ZStream' -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ZStream'
zstr ->
        ForeignPtr CChar -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
fbuff ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buff -> do
            CUInt
avail <- ZStream' -> IO CUInt
c_get_avail_out ZStream'
zstr
            let size :: Int
size = Int
defaultChunkSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
avail
            ByteString
bs <- CStringLen -> IO ByteString
S.packCStringLen (Ptr CChar
buff, Int
size)
            ZStream' -> Ptr CChar -> CUInt -> IO ()
c_set_avail_out ZStream'
zstr Ptr CChar
buff (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
defaultChunkSize
            ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs

-- | Flush the inflation buffer. Useful for interactive application.
--
-- This is actually a synonym for 'finishInflate'. It is provided for its more
-- semantic name.
--
-- Since 0.0.3
flushInflate :: Inflate -> IO S.ByteString
flushInflate :: Inflate -> IO ByteString
flushInflate = Inflate -> IO ByteString
finishInflate

-- | Retrieve any data remaining after inflating. For more information on motivation, see:
--
-- <https://github.com/fpco/streaming-commons/issues/20>
--
-- Since 0.1.11
getUnusedInflate :: Inflate -> IO S.ByteString
getUnusedInflate :: Inflate -> IO ByteString
getUnusedInflate (Inflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
_) IORef ByteString
ref IORef Bool
_ Maybe ByteString
_) = do
    ByteString
bs <- IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
readIORef IORef ByteString
ref
    CUInt
len <- ForeignPtr ZStreamStruct -> (ZStream' -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStreamStruct
fzstr ZStream' -> IO CUInt
c_get_avail_in
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.drop (ByteString -> Int
S.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
len) ByteString
bs

-- | Returns True if the inflater has reached end-of-stream, or False if
-- it is still expecting more data.
--
-- Since 0.1.18
isCompleteInflate :: Inflate -> IO Bool
isCompleteInflate :: Inflate -> IO Bool
isCompleteInflate (Inflate ZStreamPair
_ IORef ByteString
_ IORef Bool
complete Maybe ByteString
_) = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
complete

-- | Feed the given 'S.ByteString' to the deflater. Return a 'Popper',
-- an IO action that returns the compressed data a chunk at a time.
-- The 'Popper' must be called to exhaustion before using the 'Deflate'
-- object again.
--
-- Note that this function automatically buffers the output to
-- 'defaultChunkSize', and therefore you won't get any data from the popper
-- until that much compressed data is available. After you have fed all of the
-- decompressed data to this function, you can extract your final chunks of
-- compressed data using 'finishDeflate'.
feedDeflate :: Deflate -> S.ByteString -> IO Popper
feedDeflate :: Deflate -> ByteString -> IO Popper
feedDeflate (Deflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
fbuff)) ByteString
bs = do
    ForeignPtr ZStreamStruct -> (ZStream' -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStreamStruct
fzstr ((ZStream' -> IO ()) -> IO ()) -> (ZStream' -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ZStream'
zstr ->
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) -> do
            ZStream' -> Ptr CChar -> CUInt -> IO ()
c_set_avail_in ZStream'
zstr Ptr CChar
cstr (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
    Popper -> IO Popper
forall (m :: * -> *) a. Monad m => a -> m a
return (Popper -> IO Popper) -> Popper -> IO Popper
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar
-> ForeignPtr ZStreamStruct
-> Maybe ByteString
-> (ZStream' -> IO CInt)
-> Bool
-> Popper
drain ForeignPtr CChar
fbuff ForeignPtr ZStreamStruct
fzstr (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs) ZStream' -> IO CInt
c_call_deflate_noflush Bool
False

-- | As explained in 'feedDeflate', deflation buffers your compressed
-- data. After you call 'feedDeflate' with your last chunk of uncompressed
-- data, use this to flush the rest of the data and signal end of input.
finishDeflate :: Deflate -> Popper
finishDeflate :: Deflate -> Popper
finishDeflate (Deflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
fbuff)) =
    ForeignPtr CChar
-> ForeignPtr ZStreamStruct
-> Maybe ByteString
-> (ZStream' -> IO CInt)
-> Bool
-> Popper
drain ForeignPtr CChar
fbuff ForeignPtr ZStreamStruct
fzstr Maybe ByteString
forall a. Maybe a
Nothing ZStream' -> IO CInt
c_call_deflate_finish Bool
True

-- | Flush the deflation buffer. Useful for interactive application.
-- Internally this passes Z_SYNC_FLUSH to the zlib library.
--
-- Unlike 'finishDeflate', 'flushDeflate' does not signal end of input,
-- meaning you can feed more uncompressed data afterward.
--
-- Since 0.0.3
flushDeflate :: Deflate -> Popper
flushDeflate :: Deflate -> Popper
flushDeflate (Deflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
fbuff)) =
    ForeignPtr CChar
-> ForeignPtr ZStreamStruct
-> Maybe ByteString
-> (ZStream' -> IO CInt)
-> Bool
-> Popper
drain ForeignPtr CChar
fbuff ForeignPtr ZStreamStruct
fzstr Maybe ByteString
forall a. Maybe a
Nothing ZStream' -> IO CInt
c_call_deflate_flush Bool
True

-- | Full flush the deflation buffer. Useful for interactive
-- applications where previously streamed data may not be
-- available. Using `fullFlushDeflate` too often can seriously degrade
-- compression. Internally this passes Z_FULL_FLUSH to the zlib
-- library.
--
-- Like 'flushDeflate', 'fullFlushDeflate' does not signal end of input,
-- meaning you can feed more uncompressed data afterward.
--
-- Since 0.1.5
fullFlushDeflate :: Deflate -> Popper
fullFlushDeflate :: Deflate -> Popper
fullFlushDeflate (Deflate (ForeignPtr ZStreamStruct
fzstr, ForeignPtr CChar
fbuff)) =
    ForeignPtr CChar
-> ForeignPtr ZStreamStruct
-> Maybe ByteString
-> (ZStream' -> IO CInt)
-> Bool
-> Popper
drain ForeignPtr CChar
fbuff ForeignPtr ZStreamStruct
fzstr Maybe ByteString
forall a. Maybe a
Nothing ZStream' -> IO CInt
c_call_deflate_full_flush Bool
True