{-# LINE 1 "Z/IO/BIO/Zlib.hsc" #-}
module Z.IO.BIO.Zlib(
newCompress, compressReset
, compress
, compressBlocks
, ZStream
, CompressConfig(..)
, defaultCompressConfig
, newDecompress, decompressReset
, decompress
, decompressBlocks
, DecompressConfig(..)
, defaultDecompressConfig
, WindowBits
, defaultWindowBits
, MemLevel
, defaultMemLevel
, Strategy
, pattern Z_FILTERED
, pattern Z_HUFFMAN_ONLY
, pattern Z_RLE
, pattern Z_FIXED
, pattern Z_DEFAULT_STRATEGY
, CompressLevel
, pattern Z_BEST_SPEED
, pattern Z_BEST_COMPRESSION
, pattern Z_DEFAULT_COMPRESSION
) where
import Control.Monad
import Data.IORef
import Data.Word
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.JSON (JSON)
import Z.Data.Text.Print (Print)
import Z.Data.Vector.Base as V
import Z.Foreign
import Z.Foreign.CPtr
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 81 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_HUFFMAN_ONLY = 2
{-# LINE 82 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_RLE = 3
{-# LINE 83 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_FIXED = 4
{-# LINE 84 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_DEFAULT_STRATEGY = 0
{-# LINE 85 "Z/IO/BIO/Zlib.hsc" #-}
type CompressLevel = CInt
pattern Z_BEST_SPEED :: CompressLevel
pattern Z_BEST_COMPRESSION :: CompressLevel
pattern Z_DEFAULT_COMPRESSION :: CompressLevel
pattern Z_BEST_SPEED = 1
{-# LINE 93 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_BEST_COMPRESSION = 9
{-# LINE 94 "Z/IO/BIO/Zlib.hsc" #-}
pattern Z_DEFAULT_COMPRESSION = -1
{-# LINE 95 "Z/IO/BIO/Zlib.hsc" #-}
type WindowBits = CInt
defaultWindowBits :: WindowBits
defaultWindowBits = 15
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 (Print, JSON)
defaultCompressConfig :: CompressConfig
defaultCompressConfig =
CompressConfig Z_DEFAULT_COMPRESSION defaultWindowBits
defaultMemLevel V.empty Z_DEFAULT_STRATEGY V.defaultChunkSize
newtype ZStream = ZStream (CPtr ZStream) deriving (Eq, Ord, Show)
deriving newtype Print
newCompress :: HasCallStack
=> CompressConfig
-> IO (ZStream, BIO V.Bytes V.Bytes)
newCompress (CompressConfig level windowBits memLevel dict strategy bufSiz) = do
zs <- newCPtr'
(do ps <- throwOOMIfNull create_z_stream
throwZlibIfMinus_ $ deflate_init2 ps level windowBits memLevel strategy
return ps)
free_z_stream_deflate
unless (V.null dict) . withCPtr zs $ \ ps -> do
throwZlibIfMinus_ . withPrimVectorUnsafe dict $ \ pdict off len ->
deflate_set_dictionary ps pdict off (fromIntegral $ len)
buf <- A.newPinnedPrimArray bufSiz
bufRef <- newIORef buf
set_avail_out zs buf bufSiz
let newOutBuffer = do
buf' <- A.newPinnedPrimArray bufSiz
writeIORef bufRef buf'
set_avail_out zs buf' bufSiz
return (ZStream zs, \ k mbs -> case mbs of
Just bs -> do
set_avail_in zs bs (V.length bs)
let loop = do
oavail :: CUInt <- withCPtr zs $ \ ps -> do
throwZlibIfMinus_ (deflate ps (0))
{-# LINE 163 "Z/IO/BIO/Zlib.hsc" #-}
((\hsc_ptr -> peekByteOff hsc_ptr 32)) ps
{-# LINE 164 "Z/IO/BIO/Zlib.hsc" #-}
when (oavail == 0) $ do
oarr <- A.unsafeFreezeArr =<< readIORef bufRef
k (Just (V.PrimVector oarr 0 bufSiz))
newOutBuffer
loop
loop
_ ->
let loop = do
(r, osiz) <- withCPtr zs $ \ ps -> do
r <- throwZlibIfMinus (deflate ps (4))
{-# LINE 174 "Z/IO/BIO/Zlib.hsc" #-}
oavail :: CUInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ps
{-# LINE 175 "Z/IO/BIO/Zlib.hsc" #-}
return (r, bufSiz - fromIntegral oavail)
if (r /= (1) && osiz /= 0)
{-# LINE 177 "Z/IO/BIO/Zlib.hsc" #-}
then do
oarr <- A.unsafeFreezeArr =<< readIORef bufRef
k (Just (V.PrimVector oarr 0 osiz))
newOutBuffer
loop
else do
when (osiz /= 0) $ do
oarr <- A.unsafeFreezeArr =<< readIORef bufRef
k (Just (V.PrimVector oarr 0 osiz))
k EOF
in loop)
compressReset :: ZStream -> IO ()
compressReset (ZStream fp) = do
throwZlibIfMinus_ (withCPtr fp deflateReset)
compress :: HasCallStack => CompressConfig -> V.Bytes -> V.Bytes
compress conf = V.concat . unsafeRunBlock (snd <$> newCompress conf)
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 (Print, JSON)
defaultDecompressConfig :: DecompressConfig
defaultDecompressConfig = DecompressConfig defaultWindowBits V.empty V.defaultChunkSize
newDecompress :: DecompressConfig -> IO (ZStream, BIO V.Bytes V.Bytes)
newDecompress (DecompressConfig windowBits dict bufSiz) = do
zs <- newCPtr'
(do ps <- throwOOMIfNull create_z_stream
throwZlibIfMinus_ $ inflate_init2 ps windowBits
return ps)
free_z_stream_inflate
buf <- A.newPinnedPrimArray bufSiz
bufRef <- newIORef buf
set_avail_out zs buf bufSiz
let newOutBuffer = do
buf' <- A.newPinnedPrimArray bufSiz
writeIORef bufRef buf'
set_avail_out zs buf' bufSiz
return (ZStream zs, \ k mbs -> case mbs of
Just bs -> do
set_avail_in zs bs (V.length bs)
let loop = do
oavail :: CUInt <- withCPtr zs $ \ ps -> do
r <- throwZlibIfMinus (inflate ps (0))
{-# LINE 240 "Z/IO/BIO/Zlib.hsc" #-}
when (r == (2)) $
{-# LINE 241 "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 247 "Z/IO/BIO/Zlib.hsc" #-}
((\hsc_ptr -> peekByteOff hsc_ptr 32)) ps
{-# LINE 248 "Z/IO/BIO/Zlib.hsc" #-}
when (oavail == 0) $ do
oarr <- A.unsafeFreezeArr =<< readIORef bufRef
k (Just (V.PrimVector oarr 0 bufSiz))
newOutBuffer
loop
loop
_ ->
let loop = do
(r, osiz) <- withCPtr zs $ \ ps -> do
r <- throwZlibIfMinus (inflate ps (4))
{-# LINE 260 "Z/IO/BIO/Zlib.hsc" #-}
r' <- if r == (2)
{-# LINE 261 "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 267 "Z/IO/BIO/Zlib.hsc" #-}
else return r
oavail :: CUInt <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ps
{-# LINE 269 "Z/IO/BIO/Zlib.hsc" #-}
return (r', bufSiz - fromIntegral oavail)
if (r /= (1) && osiz /= 0)
{-# LINE 271 "Z/IO/BIO/Zlib.hsc" #-}
then do
oarr <- A.unsafeFreezeArr =<< readIORef bufRef
k (Just (V.PrimVector oarr 0 osiz))
newOutBuffer
loop
else do
when (osiz /= 0) $ do
oarr <- A.unsafeFreezeArr =<< readIORef bufRef
k (Just (V.PrimVector oarr 0 osiz))
k EOF
in loop)
decompressReset :: ZStream -> IO ()
decompressReset (ZStream fp) = do
throwZlibIfMinus_ (withCPtr fp inflateReset)
decompress :: HasCallStack => DecompressConfig -> V.Bytes -> V.Bytes
decompress conf = V.concat . unsafeRunBlock (snd <$> newDecompress conf)
decompressBlocks :: HasCallStack => DecompressConfig -> [V.Bytes] -> [V.Bytes]
decompressBlocks conf = unsafeRunBlocks (snd <$> newDecompress conf)
toZErrorMsg :: CInt -> CBytes
toZErrorMsg (0) = "Z_OK"
{-# LINE 301 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (1) = "Z_STREAM_END"
{-# LINE 302 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (2) = "Z_NEED_DICT"
{-# LINE 303 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-1) = "Z_ERRNO"
{-# LINE 304 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-2) = "Z_STREAM_ERROR"
{-# LINE 305 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-3) = "Z_DATA_ERROR"
{-# LINE 306 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-4) = "Z_MEM_ERROR"
{-# LINE 307 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-5) = "Z_BUF_ERROR"
{-# LINE 308 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg (-6) = "Z_VERSION_ERROR"
{-# LINE 309 "Z/IO/BIO/Zlib.hsc" #-}
toZErrorMsg _ = "Z_UNEXPECTED"
data ZlibException = ZlibException CBytes CallStack deriving Show
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 321 "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 :: CPtr ZStream -> V.Bytes -> Int -> IO ()
set_avail_in zs buf buflen = do
withPrimVectorSafe buf $ \ pbuf _ ->
withCPtr zs $ \ ps -> do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ps pbuf
{-# LINE 365 "Z/IO/BIO/Zlib.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ps (fromIntegral buflen :: CUInt)
{-# LINE 366 "Z/IO/BIO/Zlib.hsc" #-}
set_avail_out :: CPtr ZStream -> MutablePrimArray RealWorld Word8 -> Int -> IO ()
set_avail_out zs buf bufSiz = do
withMutablePrimArrayContents buf $ \ pbuf ->
withCPtr zs $ \ ps -> do
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ps pbuf
{-# LINE 372 "Z/IO/BIO/Zlib.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ps (fromIntegral bufSiz :: CUInt)
{-# LINE 373 "Z/IO/BIO/Zlib.hsc" #-}