{-# LINE 1 "Z/IO/BIO/Zlib.hsc" #-}
{-|
Module      : Z.IO.BIO.Zlib
Description : The zlib
Copyright   : (c) Dong Han, 2017-2018
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides <https://zlib.net zlib> bindings using 'BIO' interface.
-}

module Z.IO.BIO.Zlib(
  -- * Compression
    CompressConfig(..)
  , defaultCompressConfig
  , newCompress, compressReset
  , compress
  , compressBlocks
  , WindowBits
  , defaultWindowBits
  , MemLevel
  , defaultMemLevel
  -- * Decompression
  , DecompressConfig(..)
  , defaultDecompressConfig
  , newDecompress, decompressReset
  , decompress
  , decompressBlocks
  -- * Constants
  -- ** Strategy
  , Strategy
  , pattern Z_FILTERED
  , pattern Z_HUFFMAN_ONLY
  , pattern Z_RLE
  , pattern Z_FIXED
  , pattern Z_DEFAULT_STRATEGY
  -- ** CompressLevel
  , CompressLevel
  , pattern Z_BEST_SPEED
  , pattern Z_BEST_COMPRESSION
  , pattern Z_DEFAULT_COMPRESSION
  ) where

import           Control.Monad
import           Data.IORef
import           Data.Typeable
import           Data.Word
import qualified Data.List          as List
import           Foreign            hiding (void)
import           Foreign.C
import           GHC.Generics
import           Z.Data.Array       as A
import           Z.Data.CBytes      as CBytes
import           Z.Data.Vector.Base as V
import           Z.Data.Text.ShowT  (ShowT)
import           Z.Foreign
import           Z.IO.BIO
import           Z.IO.Exception



type Strategy = CInt

pattern Z_FILTERED           :: Strategy
pattern Z_HUFFMAN_ONLY       :: Strategy
pattern Z_RLE                :: Strategy
pattern Z_FIXED              :: Strategy
pattern Z_DEFAULT_STRATEGY   :: Strategy
pattern Z_FILTERED           = 1
{-# LINE 71 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_HUFFMAN_ONLY       = 2
{-# LINE 72 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_RLE                = 3
{-# LINE 73 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_FIXED              = 4
{-# LINE 74 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_DEFAULT_STRATEGY   = 0
{-# LINE 75 "Z/IO/BIO/Zlib.hsc" #-}

type CompressLevel = CInt

-- pattern Z_NO_COMPRESSION       =  CompressLevel (#const Z_NO_COMPRESSION     )
pattern Z_BEST_SPEED          :: CompressLevel
pattern Z_BEST_COMPRESSION    :: CompressLevel
pattern Z_DEFAULT_COMPRESSION :: CompressLevel
pattern Z_BEST_SPEED          = 1
{-# LINE 83 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_BEST_COMPRESSION    = 9
{-# LINE 84 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_DEFAULT_COMPRESSION = -1
{-# LINE 85 "Z/IO/BIO/Zlib.hsc" #-}

{- | The 'WindowBits' is the base two logarithm of the maximum window size (the size of the history buffer).
It should be in the range 8..15 for this version of the library. The 'defaultWindowBits' value is 15. Decompressing windowBits must be greater than or equal to the compressing windowBits. If a compressed stream with a larger window size is given as input, decompress will throw 'ZDataError'
windowBits can also be –8..–15 for raw inflate. In this case, -windowBits determines the window size. inflate() will then process raw deflate data, not looking for a zlib or gzip header, not generating a check value, and not looking for any check values for comparison at the end of the stream.
windowBits can also be greater than 15 for optional gzip decoding. Add 32 to windowBits to enable zlib and gzip decoding with automatic header detection, or add 16 to decode only the gzip format.
-}
type WindowBits = CInt

defaultWindowBits :: WindowBits
defaultWindowBits = 15

-- | The 'MemLevel' specifies how much memory should be allocated for the internal compression state. 1 uses minimum memory but is slow and reduces compression ratio; 9 uses maximum memory for optimal speed. The default value is 8.
type MemLevel = CInt

defaultMemLevel :: MemLevel
defaultMemLevel = 9

data CompressConfig = CompressConfig
    { compressLevel :: CompressLevel
    , compressWindowBits :: WindowBits
    , compressMemoryLevel :: MemLevel
    , compressDictionary :: V.Bytes
    , compressStrategy :: Strategy
    , compressBufferSize :: Int
    }   deriving (Show, Eq, Ord, Generic)
        deriving anyclass ShowT

defaultCompressConfig :: CompressConfig
defaultCompressConfig =
    CompressConfig Z_DEFAULT_COMPRESSION  defaultWindowBits
        defaultMemLevel V.empty Z_DEFAULT_STRATEGY V.defaultChunkSize

data ZStream = ZStream (ForeignPtr ZStream) (IORef Bool)

-- | Compress all the data written to a output.
--
-- The returned 'BIO' node can be reused only if you call 'compressReset' on the 'ZStream'.
newCompress :: HasCallStack
            => CompressConfig
            -> IO (ZStream, BIO V.Bytes V.Bytes)
newCompress (CompressConfig level windowBits memLevel dict strategy bufSiz) = do
    zs <- newForeignPtr free_z_stream_deflate =<< create_z_stream
    buf <- A.newPinnedPrimArray bufSiz
    set_avail_out zs buf bufSiz
    bufRef <- newIORef buf

    withForeignPtr zs $ \ ps -> do
        throwZlibIfMinus_ $ deflate_init2 ps level windowBits memLevel strategy
        unless (V.null dict) $
            throwZlibIfMinus_ . withPrimVectorUnsafe dict $ \ pdict off len ->
            deflate_set_dictionary ps pdict off (fromIntegral $ len)

    finRef <- newIORef False
    return (ZStream zs finRef, BIO (zwrite zs bufRef) (zflush finRef zs bufRef []))
  where
    zwrite zs bufRef input = do
        set_avail_in zs input (V.length input)
        zloop zs bufRef []

    zloop zs bufRef acc = do
        oavail :: CUInt <- withForeignPtr zs $ \ ps -> do
            throwZlibIfMinus_ (deflate ps (0))
{-# LINE 147 "Z/IO/BIO/Zlib.hsc" #-}
            ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ps
{-# LINE 148 "Z/IO/BIO/Zlib.hsc" #-}
        if oavail == 0
        then do
            oarr <- A.unsafeFreezeArr =<< readIORef bufRef
            buf' <- A.newPinnedPrimArray bufSiz
            set_avail_out zs buf' bufSiz
            writeIORef bufRef buf'
            zloop zs bufRef (V.PrimVector oarr 0 bufSiz : acc)
        else do
            let output = V.concat (List.reverse acc)
            if V.null output then return Nothing
                             else return (Just output)

    zflush finRef zs bufRef acc = do
        fin <- readIORef finRef
        if fin 
        then return Nothing
        else do
            buf <- readIORef bufRef
            (r, osiz) <- withForeignPtr zs $ \ ps -> do
                r <- throwZlibIfMinus (deflate ps (4))
{-# LINE 168 "Z/IO/BIO/Zlib.hsc" #-}
                oavail :: CUInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ps
{-# LINE 169 "Z/IO/BIO/Zlib.hsc" #-}
                return (r, bufSiz - fromIntegral oavail)
            if (r /= (1) && osiz /= 0)
{-# LINE 171 "Z/IO/BIO/Zlib.hsc" #-}
            then do
                oarr <- A.unsafeFreezeArr buf
                buf' <- A.newPinnedPrimArray bufSiz
                set_avail_out zs buf' bufSiz
                writeIORef bufRef buf'
                zflush finRef zs bufRef (V.PrimVector oarr 0 osiz : acc)
            else do
                oarr <- A.unsafeFreezeArr buf
                let trailing = V.concat . List.reverse $ V.PrimVector oarr 0 osiz : acc
                -- stream ends 
                writeIORef finRef True
                if V.null trailing then return Nothing else return (Just trailing)

-- | Reset compressor's state so that related 'BIO' can be reused.
compressReset :: ZStream -> IO ()
compressReset (ZStream fp finRef) = do
    throwZlibIfMinus_ (withForeignPtr fp deflateReset)
    writeIORef finRef False

-- | Decompress some bytes.
compress :: HasCallStack => CompressConfig -> V.Bytes -> V.Bytes
compress conf = V.concat . unsafeRunBlock (snd <$> newCompress conf)

-- | Decompress some bytes list.
compressBlocks :: HasCallStack => CompressConfig -> [V.Bytes] -> [V.Bytes]
compressBlocks conf = unsafeRunBlocks (snd <$> newCompress conf)

data DecompressConfig = DecompressConfig
    { decompressWindowBits :: WindowBits
    , decompressDictionary :: V.Bytes
    , decompressBufferSize :: Int
    }   deriving (Show, Eq, Ord, Generic)
        deriving anyclass ShowT

defaultDecompressConfig :: DecompressConfig
defaultDecompressConfig = DecompressConfig defaultWindowBits V.empty V.defaultChunkSize

-- | Decompress bytes from source.
--
-- The returned 'BIO' node can be reused only if you call 'decompressReset' on the 'ZStream'.
newDecompress :: DecompressConfig -> IO (ZStream, BIO V.Bytes V.Bytes)
newDecompress (DecompressConfig windowBits dict bufSiz) = do
    zs <- newForeignPtr free_z_stream_inflate =<< create_z_stream
    buf <- A.newPinnedPrimArray bufSiz
    set_avail_out zs buf bufSiz
    bufRef <- newIORef buf
    withForeignPtr zs $ \ ps -> do
        throwZlibIfMinus_ $ inflate_init2 ps windowBits
    finRef <- newIORef False
    return (ZStream zs finRef, BIO (zwrite zs bufRef) (zflush finRef zs bufRef []))
  where
    zwrite zs bufRef input = do
        set_avail_in zs input (V.length input)
        zloop zs bufRef []

    zloop zs bufRef acc = do
        oavail :: CUInt <- withForeignPtr zs $ \ ps -> do
            r <- throwZlibIfMinus (inflate ps (0))
{-# LINE 229 "Z/IO/BIO/Zlib.hsc" #-}
            when (r == (2)) $
{-# LINE 230 "Z/IO/BIO/Zlib.hsc" #-}
                if V.null dict
                then throwIO (ZlibException "Z_NEED_DICT" callStack)
                else do
                    throwZlibIfMinus_ . withPrimVectorUnsafe dict $ \ pdict off len ->
                        inflate_set_dictionary ps pdict off (fromIntegral len)
                    throwZlibIfMinus_ (inflate ps (0))
{-# LINE 236 "Z/IO/BIO/Zlib.hsc" #-}
            ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ps
{-# LINE 237 "Z/IO/BIO/Zlib.hsc" #-}
        if oavail == 0
        then do
            oarr <- A.unsafeFreezeArr =<< readIORef bufRef
            buf' <- A.newPinnedPrimArray bufSiz
            set_avail_out zs buf' bufSiz
            writeIORef bufRef buf'
            zloop zs bufRef (V.PrimVector oarr 0 bufSiz : acc)
        else do
            let output = V.concat (List.reverse acc)
            if V.null output then return Nothing
                             else return (Just output)

    zflush finRef zs bufRef acc = do
        fin <- readIORef finRef
        if fin
        then return Nothing
        else do
            buf <- readIORef bufRef
            (r, osiz) <- withForeignPtr zs $ \ ps -> do
                r <- throwZlibIfMinus (inflate ps (4))
{-# LINE 257 "Z/IO/BIO/Zlib.hsc" #-}
                r' <- if r == (2)
{-# LINE 258 "Z/IO/BIO/Zlib.hsc" #-}
                then if V.null dict
                    then throwIO (ZlibException "Z_NEED_DICT" callStack)
                    else do
                        throwZlibIfMinus_ . withPrimVectorUnsafe dict $ \ pdict off len ->
                            inflate_set_dictionary ps pdict off (fromIntegral len)
                        throwZlibIfMinus (inflate ps (4))
{-# LINE 264 "Z/IO/BIO/Zlib.hsc" #-}
                else return r
                oavail :: CUInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ps
{-# LINE 266 "Z/IO/BIO/Zlib.hsc" #-}
                return (r', bufSiz - fromIntegral oavail)
            if (r /= (1) && osiz /= 0)
{-# LINE 268 "Z/IO/BIO/Zlib.hsc" #-}
            then do
                oarr <- A.unsafeFreezeArr buf
                buf' <- A.newPinnedPrimArray bufSiz
                set_avail_out zs buf' bufSiz
                writeIORef bufRef buf'
                zflush finRef zs bufRef (V.PrimVector oarr 0 osiz : acc)
            else do
                oarr <- A.unsafeFreezeArr buf
                let trailing = V.concat . List.reverse $ V.PrimVector oarr 0 osiz : acc
                -- stream ends
                writeIORef finRef True
                if V.null trailing then return Nothing else return (Just trailing)

-- | Reset decompressor's state so that related 'BIO' can be reused.
decompressReset :: ZStream -> IO ()
decompressReset (ZStream fp finRef) = do
    throwZlibIfMinus_ (withForeignPtr fp inflateReset)
    writeIORef finRef False

-- | Decompress some bytes.
decompress :: HasCallStack => DecompressConfig -> V.Bytes -> V.Bytes
decompress conf = V.concat . unsafeRunBlock (snd <$> newDecompress conf)

-- | Decompress some bytes list.
decompressBlocks :: HasCallStack => DecompressConfig -> [V.Bytes] -> [V.Bytes]
decompressBlocks conf = unsafeRunBlocks (snd <$> newDecompress conf)

--------------------------------------------------------------------------------

toZErrorMsg :: CInt -> CBytes
toZErrorMsg (0) =  "Z_OK"
{-# LINE 299 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (1) =  "Z_STREAM_END"
{-# LINE 300 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (2) =  "Z_NEED_DICT"
{-# LINE 301 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-1) =  "Z_ERRNO"
{-# LINE 302 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-2) =  "Z_STREAM_ERROR"
{-# LINE 303 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-3) =  "Z_DATA_ERROR"
{-# LINE 304 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-4) =  "Z_MEM_ERROR"
{-# LINE 305 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-5) =  "Z_BUF_ERROR"
{-# LINE 306 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-6) =  "Z_VERSION_ERROR"
{-# LINE 307 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg _                        =  "Z_UNEXPECTED"

-- | Zlib exceptions, a sub exception type to 'SomeIOException'.
data ZlibException = ZlibException CBytes CallStack deriving (Show, Typeable)
instance Exception ZlibException where
    toException = ioExceptionToException
    fromException = ioExceptionFromException

throwZlibIfMinus :: HasCallStack => IO CInt -> IO CInt
throwZlibIfMinus f = do
    r <- f
    if r < 0 && r /= (-5)
{-# LINE 319 "Z/IO/BIO/Zlib.hsc" #-}
    then throwIO (ZlibException (toZErrorMsg r) callStack)
    else return r

throwZlibIfMinus_ :: HasCallStack => IO CInt -> IO ()
throwZlibIfMinus_ = void . throwZlibIfMinus

foreign import ccall unsafe
    create_z_stream :: IO (Ptr ZStream)

foreign import ccall unsafe "hs_zlib.c &free_z_stream_inflate"
    free_z_stream_inflate :: FunPtr (Ptr ZStream -> IO ())

foreign import ccall unsafe "hs_zlib.c &free_z_stream_deflate"
    free_z_stream_deflate :: FunPtr (Ptr ZStream -> IO ())

foreign import ccall unsafe
    deflate_init2 :: Ptr ZStream -> CompressLevel -> WindowBits -> MemLevel -> Strategy -> IO CInt

foreign import ccall unsafe
    deflate_set_dictionary :: Ptr ZStream -> BA# Word8 -> Int -> Int -> IO CInt

foreign import ccall unsafe
    deflate :: Ptr ZStream -> CInt -> IO CInt

foreign import ccall unsafe
    deflateReset :: Ptr ZStream -> IO CInt

foreign import ccall unsafe
    inflate_init2 :: Ptr ZStream -> WindowBits -> IO CInt

foreign import ccall unsafe
    inflate_set_dictionary :: Ptr ZStream -> BA# Word8 -> Int -> Int -> IO CInt

foreign import ccall unsafe
    inflate :: Ptr ZStream -> CInt -> IO CInt

foreign import ccall unsafe
    inflateReset :: Ptr ZStream -> IO CInt

set_avail_in :: ForeignPtr ZStream -> V.Bytes -> Int -> IO ()
set_avail_in zs buf buflen = do
    withPrimVectorSafe buf $ \ pbuf _ ->
        withForeignPtr zs $ \ ps -> do
            ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ps pbuf
{-# LINE 363 "Z/IO/BIO/Zlib.hsc" #-}
            ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ps (fromIntegral buflen :: CUInt)
{-# LINE 364 "Z/IO/BIO/Zlib.hsc" #-}

set_avail_out :: ForeignPtr ZStream -> MutablePrimArray RealWorld Word8 -> Int -> IO ()
set_avail_out zs buf bufSiz = do
    withMutablePrimArrayContents buf $ \ pbuf ->
        withForeignPtr zs $ \ ps -> do
            ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ps pbuf
{-# LINE 370 "Z/IO/BIO/Zlib.hsc" #-}
            ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ps (fromIntegral bufSiz :: CUInt)
{-# LINE 371 "Z/IO/BIO/Zlib.hsc" #-}