{-# LANGUAGE BangPatterns #-}

-- | The functions in this module throw exceptions on error.
--
-- 'decompress' and 'compress' are fully lazy, i.e. memory efficient.
module Codec.Lz4 ( -- * Functions for working with blocks
                   compressBlock
                 , decompressBlockSz
                 , lZ4MaxInputSize
                 , compressBlockHC
                 , lZ4HCClevelMax
                 -- * Functions for working with frames
                 , compress
                 , decompress
                 , decompressBufSz
                 -- * Version info
                 , lZ4VersionNumber
                 , lZ4VersionString
                 ) where

import           Codec.Lz4.Foreign
import           Control.Monad                (when)
import           Control.Monad.ST.Lazy        (runST)
import qualified Control.Monad.ST.Lazy        as LazyST
import qualified Control.Monad.ST.Lazy.Unsafe as LazyST
import qualified Data.ByteString              as BS
import qualified Data.ByteString.Internal     as BS
import qualified Data.ByteString.Lazy         as BSL
import qualified Data.ByteString.Unsafe       as BS
import           Foreign.C.String             (CString)
import           Foreign.C.Types              (CInt)
import           Foreign.ForeignPtr           (ForeignPtr, castForeignPtr,
                                               mallocForeignPtrBytes,
                                               newForeignPtr, withForeignPtr)
import           Foreign.Marshal.Alloc        (alloca)
import           Foreign.Ptr                  (castPtr, nullPtr)
import           Foreign.Storable             (peek, poke)
import           System.IO.Unsafe             (unsafePerformIO)

check :: LZ4FErrorCode -> IO ()
check :: LZ4FErrorCode -> IO ()
check err :: LZ4FErrorCode
err = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LZ4FErrorCode -> Bool
lZ4FIsError LZ4FErrorCode
err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error (LZ4FErrorCode -> [Char]
lZ4FGetErrorName LZ4FErrorCode
err)

-- | Lazily decompress a frame
decompress :: BSL.ByteString -> BSL.ByteString
decompress :: ByteString -> ByteString
decompress = Int -> ByteString -> ByteString
decompressBufSz (64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1014)

-- | @since 0.1.3.0
decompressBufSz :: Int -- ^ Size of the output buffer
                -> BSL.ByteString
                -> BSL.ByteString
decompressBufSz :: Int -> ByteString -> ByteString
decompressBufSz bufSz :: Int
bufSz bs :: ByteString
bs = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteString) -> ByteString)
-> (forall s. ST s ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ do

    let bss :: [ByteString]
bss = ByteString -> [ByteString]
BSL.toChunks ByteString
bs

    (ctx :: ForeignPtr LzDecompressionCtx
ctx, buf :: ForeignPtr Any
buf) <- IO (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
-> ST s (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
 -> ST s (ForeignPtr LzDecompressionCtx, ForeignPtr Any))
-> IO (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
-> ST s (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
forall a b. (a -> b) -> a -> b
$ do
        (err :: LZ4FErrorCode
err, preCtx :: Ptr LzDecompressionCtx
preCtx) <- CUInt -> IO (LZ4FErrorCode, Ptr LzDecompressionCtx)
lZ4FCreateDecompressionContext CUInt
lZ4FGetVersion
        LZ4FErrorCode -> IO ()
check LZ4FErrorCode
err
        ForeignPtr LzDecompressionCtx
ctx <- ForeignPtr () -> ForeignPtr LzDecompressionCtx
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr () -> ForeignPtr LzDecompressionCtx)
-> IO (ForeignPtr ()) -> IO (ForeignPtr LzDecompressionCtx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
lZ4FFreeCompressionContext (Ptr LzDecompressionCtx -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr LzDecompressionCtx
preCtx)
        ForeignPtr Any
dstBuf <- Int -> IO (ForeignPtr Any)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
bufSz
        (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
-> IO (ForeignPtr LzDecompressionCtx, ForeignPtr Any)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr LzDecompressionCtx
ctx, ForeignPtr Any
dstBuf)

    [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString)
-> ST s [ByteString] -> ST s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr LzDecompressionCtx
-> ForeignPtr Any -> [ByteString] -> ST s [ByteString]
forall a s.
ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
loop ForeignPtr LzDecompressionCtx
ctx ForeignPtr Any
buf [ByteString]
bss

    where loop :: LzDecompressionCtxPtr -> ForeignPtr a -> [BS.ByteString] -> LazyST.ST s [BS.ByteString]
          loop :: ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
loop _ _ [] = [ByteString] -> ST s [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          loop ctx :: ForeignPtr LzDecompressionCtx
ctx buf :: ForeignPtr a
buf (b :: ByteString
b:bs' :: [ByteString]
bs') = do
                (nxt :: Maybe ByteString
nxt, res :: ByteString
res) <- ForeignPtr LzDecompressionCtx
-> ForeignPtr a
-> ByteString
-> ST s (Maybe ByteString, ByteString)
forall a s.
ForeignPtr LzDecompressionCtx
-> ForeignPtr a
-> ByteString
-> ST s (Maybe ByteString, ByteString)
stepChunk ForeignPtr LzDecompressionCtx
ctx ForeignPtr a
buf ByteString
b
                case Maybe ByteString
nxt of
                    Nothing   -> (ByteString
resByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> ST s [ByteString] -> ST s [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
forall a s.
ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
loop ForeignPtr LzDecompressionCtx
ctx ForeignPtr a
buf [ByteString]
bs'
                    Just next :: ByteString
next -> (ByteString
resByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> ST s [ByteString] -> ST s [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
forall a s.
ForeignPtr LzDecompressionCtx
-> ForeignPtr a -> [ByteString] -> ST s [ByteString]
loop ForeignPtr LzDecompressionCtx
ctx ForeignPtr a
buf (ByteString
nextByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
bs')


          stepChunk :: LzDecompressionCtxPtr -> ForeignPtr a -> BS.ByteString -> LazyST.ST s (Maybe BS.ByteString, BS.ByteString)
          stepChunk :: ForeignPtr LzDecompressionCtx
-> ForeignPtr a
-> ByteString
-> ST s (Maybe ByteString, ByteString)
stepChunk !ForeignPtr LzDecompressionCtx
ctx !ForeignPtr a
dst b :: ByteString
b = IO (Maybe ByteString, ByteString)
-> ST s (Maybe ByteString, ByteString)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO (Maybe ByteString, ByteString)
 -> ST s (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
-> ST s (Maybe ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$
            ByteString
-> (CStringLen -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO (Maybe ByteString, ByteString))
 -> IO (Maybe ByteString, ByteString))
-> (CStringLen -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \(buf :: Ptr CChar
buf, sz :: Int
sz) ->
                ForeignPtr a
-> (Ptr a -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
dst ((Ptr a -> IO (Maybe ByteString, ByteString))
 -> IO (Maybe ByteString, ByteString))
-> (Ptr a -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \d :: Ptr a
d ->
                    (Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
 -> IO (Maybe ByteString, ByteString))
-> (Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \dSzPtr :: Ptr LZ4FErrorCode
dSzPtr ->
                        (Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
 -> IO (Maybe ByteString, ByteString))
-> (Ptr LZ4FErrorCode -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \szPtr :: Ptr LZ4FErrorCode
szPtr -> do
                            Ptr LZ4FErrorCode -> LZ4FErrorCode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr LZ4FErrorCode
dSzPtr (Int -> LZ4FErrorCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufSz)
                            Ptr LZ4FErrorCode -> LZ4FErrorCode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr LZ4FErrorCode
szPtr (Int -> LZ4FErrorCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
                            LZ4FErrorCode
res <- ForeignPtr LzDecompressionCtx
-> Ptr a
-> Ptr LZ4FErrorCode
-> Ptr CChar
-> Ptr LZ4FErrorCode
-> LzDecompressOptionsPtr
-> IO LZ4FErrorCode
forall a b.
ForeignPtr LzDecompressionCtx
-> Ptr a
-> Ptr LZ4FErrorCode
-> Ptr b
-> Ptr LZ4FErrorCode
-> LzDecompressOptionsPtr
-> IO LZ4FErrorCode
lZ4FDecompress ForeignPtr LzDecompressionCtx
ctx Ptr a
d Ptr LZ4FErrorCode
dSzPtr Ptr CChar
buf Ptr LZ4FErrorCode
szPtr LzDecompressOptionsPtr
forall a. Ptr a
nullPtr
                            LZ4FErrorCode -> IO ()
check LZ4FErrorCode
res
                            LZ4FErrorCode
bRead <- Ptr LZ4FErrorCode -> IO LZ4FErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr LZ4FErrorCode
szPtr
                            LZ4FErrorCode
bWritten <- Ptr LZ4FErrorCode -> IO LZ4FErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr LZ4FErrorCode
dSzPtr
                            ByteString
outBs <- CStringLen -> IO ByteString
BS.packCStringLen (Ptr a -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr a
d, LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
bWritten)
                            let remBs :: Maybe ByteString
remBs = if LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
bRead Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz
                                then Maybe ByteString
forall a. Maybe a
Nothing
                                else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
BS.drop (LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
bRead) ByteString
b)
                            (Maybe ByteString, ByteString) -> IO (Maybe ByteString, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString
remBs, ByteString
outBs)

-- | Lazily compress a frame.
compress :: BSL.ByteString -> BSL.ByteString
compress :: ByteString -> ByteString
compress bs :: ByteString
bs = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteString) -> ByteString)
-> (forall s. ST s ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ do

    let bss :: [ByteString]
bss = ByteString -> [ByteString]
BSL.toChunks ByteString
bs

    (ctx :: LzCtxPtr
ctx, header :: ByteString
header) <- ST s (LzCtxPtr, ByteString)
forall s. ST s (LzCtxPtr, ByteString)
initCtx
    [ByteString]
rest <- LzCtxPtr -> [ByteString] -> ST s [ByteString]
forall s. LzCtxPtr -> [ByteString] -> ST s [ByteString]
loop LzCtxPtr
ctx [ByteString]
bss

    ByteString -> ST s ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ST s ByteString) -> ByteString -> ST s ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BSL.fromChunks (ByteString
headerByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
rest)

    where initCtx :: LazyST.ST s (LzCtxPtr, BS.ByteString)
          initCtx :: ST s (LzCtxPtr, ByteString)
initCtx = IO (LzCtxPtr, ByteString) -> ST s (LzCtxPtr, ByteString)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO (LzCtxPtr, ByteString) -> ST s (LzCtxPtr, ByteString))
-> IO (LzCtxPtr, ByteString) -> ST s (LzCtxPtr, ByteString)
forall a b. (a -> b) -> a -> b
$ do
                (err :: LZ4FErrorCode
err, preCtx :: Ptr LzCtx
preCtx) <- CUInt -> IO (LZ4FErrorCode, Ptr LzCtx)
lZ4FCreateCompressionContext CUInt
lZ4FGetVersion
                LZ4FErrorCode -> IO ()
check LZ4FErrorCode
err
                LzCtxPtr
ctx <- ForeignPtr () -> LzCtxPtr
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr () -> LzCtxPtr) -> IO (ForeignPtr ()) -> IO LzCtxPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
lZ4FFreeCompressionContext (Ptr LzCtx -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr LzCtx
preCtx)
                ForeignPtr Any
dst <- Int -> IO (ForeignPtr Any)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
forall a. Integral a => a
lZ4FHeaderSizeMax
                ByteString
header <- ForeignPtr Any -> (Ptr Any -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Any
dst ((Ptr Any -> IO ByteString) -> IO ByteString)
-> (Ptr Any -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \d :: Ptr Any
d -> do
                    LZ4FErrorCode
res <- LzCtxPtr
-> Ptr Any -> LZ4FErrorCode -> LzPreferencesPtr -> IO LZ4FErrorCode
forall a.
LzCtxPtr
-> Ptr a -> LZ4FErrorCode -> LzPreferencesPtr -> IO LZ4FErrorCode
lZ4FCompressBegin LzCtxPtr
ctx Ptr Any
d LZ4FErrorCode
forall a. Integral a => a
lZ4FHeaderSizeMax LzPreferencesPtr
forall a. Ptr a
nullPtr
                    LZ4FErrorCode -> IO ()
check LZ4FErrorCode
res
                    CStringLen -> IO ByteString
BS.packCStringLen (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
d, LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
res)
                (LzCtxPtr, ByteString) -> IO (LzCtxPtr, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LzCtxPtr
ctx, ByteString
header)

          loop :: LzCtxPtr -> [BS.ByteString] -> LazyST.ST s [BS.ByteString]
          loop :: LzCtxPtr -> [ByteString] -> ST s [ByteString]
loop ctx :: LzCtxPtr
ctx []      = ByteString -> [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> [ByteString])
-> ST s ByteString -> ST s [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LzCtxPtr -> ST s ByteString
forall s. LzCtxPtr -> ST s ByteString
finish LzCtxPtr
ctx
          loop ctx :: LzCtxPtr
ctx (b :: ByteString
b:bs' :: [ByteString]
bs') = (:) (ByteString -> [ByteString] -> [ByteString])
-> ST s ByteString -> ST s ([ByteString] -> [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LzCtxPtr -> ByteString -> ST s ByteString
forall s. LzCtxPtr -> ByteString -> ST s ByteString
update LzCtxPtr
ctx ByteString
b ST s ([ByteString] -> [ByteString])
-> ST s [ByteString] -> ST s [ByteString]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LzCtxPtr -> [ByteString] -> ST s [ByteString]
forall s. LzCtxPtr -> [ByteString] -> ST s [ByteString]
loop LzCtxPtr
ctx [ByteString]
bs'

          finish :: LzCtxPtr -> LazyST.ST s BS.ByteString
          finish :: LzCtxPtr -> ST s ByteString
finish ctx :: LzCtxPtr
ctx = IO ByteString -> ST s ByteString
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO ByteString -> ST s ByteString)
-> IO ByteString -> ST s ByteString
forall a b. (a -> b) -> a -> b
$ do
            let expectedSz :: LZ4FErrorCode
expectedSz = LZ4FErrorCode -> LzPreferencesPtr -> LZ4FErrorCode
lZ4FCompressBound 0 LzPreferencesPtr
forall a. Ptr a
nullPtr
            ForeignPtr Any
dst <- Int -> IO (ForeignPtr Any)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
expectedSz)
            ForeignPtr Any -> (Ptr Any -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Any
dst ((Ptr Any -> IO ByteString) -> IO ByteString)
-> (Ptr Any -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \d :: Ptr Any
d -> do
                LZ4FErrorCode
res <- LzCtxPtr
-> Ptr Any
-> LZ4FErrorCode
-> LzCompressOptionsPtr
-> IO LZ4FErrorCode
forall a.
LzCtxPtr
-> Ptr a
-> LZ4FErrorCode
-> LzCompressOptionsPtr
-> IO LZ4FErrorCode
lZ4FCompressEnd LzCtxPtr
ctx Ptr Any
d LZ4FErrorCode
expectedSz LzCompressOptionsPtr
forall a. Ptr a
nullPtr
                LZ4FErrorCode -> IO ()
check LZ4FErrorCode
res
                CStringLen -> IO ByteString
BS.packCStringLen (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
d, LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
res)

          update :: LzCtxPtr -> BS.ByteString -> LazyST.ST s BS.ByteString
          update :: LzCtxPtr -> ByteString -> ST s ByteString
update !LzCtxPtr
ctx b :: ByteString
b = IO ByteString -> ST s ByteString
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO ByteString -> ST s ByteString)
-> IO ByteString -> ST s ByteString
forall a b. (a -> b) -> a -> b
$
            ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(buf :: Ptr CChar
buf, sz :: Int
sz) -> do
                let expectedSz :: LZ4FErrorCode
expectedSz = LZ4FErrorCode -> LzPreferencesPtr -> LZ4FErrorCode
lZ4FCompressBound (Int -> LZ4FErrorCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) LzPreferencesPtr
forall a. Ptr a
nullPtr
                ForeignPtr Any
dst <- Int -> IO (ForeignPtr Any)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
expectedSz)
                ForeignPtr Any -> (Ptr Any -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Any
dst ((Ptr Any -> IO ByteString) -> IO ByteString)
-> (Ptr Any -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \d :: Ptr Any
d -> do
                    LZ4FErrorCode
res <- LzCtxPtr
-> Ptr Any
-> LZ4FErrorCode
-> Ptr CChar
-> LZ4FErrorCode
-> LzCompressOptionsPtr
-> IO LZ4FErrorCode
forall a b.
LzCtxPtr
-> Ptr a
-> LZ4FErrorCode
-> Ptr b
-> LZ4FErrorCode
-> LzCompressOptionsPtr
-> IO LZ4FErrorCode
lZ4FCompressUpdate LzCtxPtr
ctx Ptr Any
d LZ4FErrorCode
expectedSz Ptr CChar
buf (Int -> LZ4FErrorCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) LzCompressOptionsPtr
forall a. Ptr a
nullPtr
                    LZ4FErrorCode -> IO ()
check LZ4FErrorCode
res
                    CStringLen -> IO ByteString
BS.packCStringLen (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
d, LZ4FErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LZ4FErrorCode
res)

{-# NOINLINE compressBlock #-}
compressBlock :: BS.ByteString -> BS.ByteString
compressBlock :: ByteString -> ByteString
compressBlock = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString)
-> (ByteString -> IO ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt)
-> ByteString -> IO ByteString
compressBlockGeneric Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt
lZ4CompressDefault

{-# NOINLINE compressBlockHC #-}
-- | @since 0.1.1.0
compressBlockHC :: Int -- ^ Compression level (must be less than 'lZ4HCClevelMax')
                -> BS.ByteString
                -> BS.ByteString
compressBlockHC :: Int -> ByteString -> ByteString
compressBlockHC lvl :: Int
lvl = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString)
-> (ByteString -> IO ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt)
-> ByteString -> IO ByteString
compressBlockGeneric (\src :: Ptr CChar
src dst :: Ptr CChar
dst ssz :: CInt
ssz dsz :: CInt
dsz -> Ptr CChar -> Ptr CChar -> CInt -> CInt -> CInt -> IO CInt
lZ4CompressHC Ptr CChar
src Ptr CChar
dst CInt
ssz CInt
dsz (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lvl))

compressBlockGeneric :: (CString -> CString -> CInt -> CInt -> IO CInt) -> BS.ByteString -> IO BS.ByteString
compressBlockGeneric :: (Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt)
-> ByteString -> IO ByteString
compressBlockGeneric cfun :: Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt
cfun bs :: ByteString
bs =
    ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(buf :: Ptr CChar
buf, sz :: Int
sz) -> do
        let resSz :: CInt
resSz = CInt -> CInt
lZ4CompressBound (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
        ForeignPtr CChar
dst <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
resSz)
        ForeignPtr CChar -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
dst ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \d :: Ptr CChar
d -> do
            CInt
bWritten <- Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt
cfun Ptr CChar
buf Ptr CChar
d (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) CInt
resSz
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
bWritten CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error "Compression error"
            ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (ForeignPtr CChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CChar
dst) 0 (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bWritten)

{-# NOINLINE decompressBlockSz #-}
-- | Decompress a block. The size of the uncompressed data must be known.
decompressBlockSz :: BS.ByteString
                  -> Int -- ^ Decompressed size
                  -> BS.ByteString
decompressBlockSz :: ByteString -> Int -> ByteString
decompressBlockSz bs :: ByteString
bs expectedSz :: Int
expectedSz = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(buf :: Ptr CChar
buf, sz :: Int
sz) -> do
        ForeignPtr CChar
dst <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
expectedSz
        ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
dst ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \d :: Ptr CChar
d -> do
            CInt
bWritten <- Ptr CChar -> Ptr CChar -> CInt -> CInt -> IO CInt
lZ4DecompressSafe Ptr CChar
buf Ptr CChar
d (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
expectedSz)
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
bWritten CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error "Decompression error"
        ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (ForeignPtr CChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CChar
dst) 0 Int
expectedSz