{-# LANGUAGE NamedFieldPuns #-}
-- |
-- Module      : Streamly.Internal.LZ4
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : Apache-2.0
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- LZ4 compression and decompression routines.
--
module Streamly.Internal.LZ4
    (
    -- * Foreign
      c_createStream
    , c_freeStream
    , c_createStreamDecode
    , c_freeStreamDecode

    -- * Block compression and decompression
    , compressChunk
    , decompressChunk

    -- * Stream compression and decompression
    , compressChunksD
    , resizeChunksD
    , decompressChunksRawD
    , decompressChunksWithD

    -- * Parsing LZ4 Frames
    , simpleFrameParserD
    )

where

--------------------------------------------------------------------------------
-- Imports
--------------------------------------------------------------------------------

import Control.Monad (when)
import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bifunctor (second)
import Data.Bits (Bits(..))
import Data.Coerce (coerce)
import Data.Int (Int32)
import Data.Word (Word32, Word8, byteSwap32)
import Foreign.C (CInt(..), CString)
import Foreign.Ptr (Ptr, castPtr, plusPtr)
import Foreign.Storable (peek, poke)
import Fusion.Plugin.Types (Fuse (..))
import System.IO.Unsafe (unsafePerformIO)

import qualified Streamly.Internal.Data.Array.Foreign as Array
import qualified Streamly.Internal.Data.Array.Foreign.Type as Array
import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MArray
import qualified Streamly.Internal.Data.Parser.ParserD as Parser
import qualified Streamly.Internal.Data.Fold as Fold
import qualified Streamly.Internal.Data.Stream.StreamD as Stream
import qualified Streamly.Internal.Data.Stream.IsStream as IsStream
import qualified Streamly.Internal.Data.Array.Stream.Foreign as ArrayStream
import qualified Streamly.Internal.Data.Array.Stream.Fold.Foreign as ArrayFold

import Streamly.Internal.LZ4.Config

--------------------------------------------------------------------------------
-- CPP helpers
--------------------------------------------------------------------------------

-- Simple helpers for more informative inline statements.

#define INLINE_EARLY  INLINE [2]
#define INLINE_NORMAL INLINE [1]
#define INLINE_LATE   INLINE [0]

--------------------------------------------------------------------------------
-- Endianess
--------------------------------------------------------------------------------

{-# NOINLINE isLittleEndianMachine #-}
isLittleEndianMachine :: Bool
isLittleEndianMachine :: Bool
isLittleEndianMachine =
    let lsb :: Word8
lsb = [Word8] -> Word8
forall a. [a] -> a
head ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$ Array Word8 -> [Word8]
forall a. Storable a => Array a -> [a]
Array.toList (Array Word8 -> [Word8]) -> Array Word8 -> [Word8]
forall a b. (a -> b) -> a -> b
$ Array Word32 -> Array Word8
forall a. Array a -> Array Word8
Array.asBytes (Array Word32 -> Array Word8) -> Array Word32 -> Array Word8
forall a b. (a -> b) -> a -> b
$ [Word32] -> Array Word32
forall a. Storable a => [a] -> Array a
Array.fromList [Word32
1 :: Word32]
     in Word8
lsb Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1

{-# INLINE toLittleEndian #-}
toLittleEndian :: Int32 -> Int32
toLittleEndian :: Int32 -> Int32
toLittleEndian Int32
i32
    | Bool
isLittleEndianMachine = Int32
i32
    | Bool
otherwise = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32
byteSwap32 (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i32))

{-# INLINE fromLittleEndian #-}
fromLittleEndian :: Int32 -> Int32
fromLittleEndian :: Int32 -> Int32
fromLittleEndian = Int32 -> Int32
toLittleEndian

--------------------------------------------------------------------------------
-- Foreign
--------------------------------------------------------------------------------

data C_LZ4Stream

data C_LZ4StreamDecode

-- | Exported for unit tests
foreign import ccall unsafe "lz4.h LZ4_createStream"
    c_createStream :: IO (Ptr C_LZ4Stream)

-- | Exported for unit tests
foreign import ccall unsafe "lz4.h LZ4_freeStream"
    c_freeStream :: Ptr C_LZ4Stream -> IO ()

-- | Exported for unit tests
foreign import ccall unsafe "lz4.h LZ4_createStreamDecode"
    c_createStreamDecode :: IO (Ptr C_LZ4StreamDecode)

-- | Exported for unit tests
foreign import ccall unsafe "lz4.h LZ4_freeStreamDecode"
    c_freeStreamDecode :: Ptr C_LZ4StreamDecode -> IO ()

foreign import ccall unsafe "lz4.h LZ4_compressBound"
    c_compressBound :: CInt -> IO CInt

foreign import ccall unsafe "lz4.h LZ4_compress_fast_continue"
    c_compressFastContinue
        :: Ptr C_LZ4Stream
        -> CString
        -> Ptr Word8
        -> CInt
        -> CInt
        -> CInt
        -> IO CInt

foreign import ccall unsafe "lz4.h LZ4_decompress_safe_continue"
    c_decompressSafeContinue
        :: Ptr C_LZ4StreamDecode
        -> CString
        -> Ptr Word8
        -> CInt
        -> CInt
        -> IO CInt

foreign import capi
    "lz4.h value LZ4_MAX_INPUT_SIZE" lz4_MAX_INPUT_SIZE :: CInt

lz4_MAX_OUTPUT_SIZE :: CInt
lz4_MAX_OUTPUT_SIZE :: CInt
lz4_MAX_OUTPUT_SIZE =
    CInt -> CInt -> CInt
forall a. Ord a => a -> a -> a
min (IO CInt -> CInt
forall a. IO a -> a
unsafePerformIO (IO CInt -> CInt) -> IO CInt -> CInt
forall a b. (a -> b) -> a -> b
$ CInt -> IO CInt
c_compressBound CInt
lz4_MAX_INPUT_SIZE) CInt
forall a. Bounded a => a
maxBound

--------------------------------------------------------------------------------
-- Conversion helpers
--------------------------------------------------------------------------------

{-# INLINE cIntToInt #-}
cIntToInt :: CInt -> Int
cIntToInt :: CInt -> Int
cIntToInt = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE unsafeIntToCInt #-}
unsafeIntToCInt :: Int -> CInt
unsafeIntToCInt :: Int -> CInt
unsafeIntToCInt = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE i32ToInt #-}
i32ToInt :: Int32 -> Int
i32ToInt :: Int32 -> Int
i32ToInt = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE cIntToI32 #-}
cIntToI32 :: CInt -> Int32
cIntToI32 :: CInt -> Int32
cIntToI32 = CInt -> Int32
coerce

{-# INLINE i32ToCInt #-}
i32ToCInt :: Int32 -> CInt
i32ToCInt :: Int32 -> CInt
i32ToCInt = Int32 -> CInt
coerce

-------------------------------------------------------------------------------
-- Block Configuration access
-------------------------------------------------------------------------------

metaSize :: BlockConfig -> Int
metaSize :: BlockConfig -> Int
metaSize BlockConfig {BlockSize
blockSize :: BlockConfig -> BlockSize
blockSize :: BlockSize
blockSize} =
    case BlockSize
blockSize of
        BlockSize
BlockHasSize -> Int
8
        BlockSize
_ -> Int
4

setUncompSize :: BlockConfig -> Ptr Word8 -> Int32 -> IO ()
setUncompSize :: BlockConfig -> Ptr Word8 -> Int32 -> IO ()
setUncompSize BlockConfig {BlockSize
blockSize :: BlockSize
blockSize :: BlockConfig -> BlockSize
blockSize} =
    case BlockSize
blockSize of
        BlockSize
BlockHasSize -> \Ptr Word8
src -> Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
src Ptr Any -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (Int32 -> IO ()) -> (Int32 -> Int32) -> Int32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
toLittleEndian
        BlockSize
_ -> \Ptr Word8
_ Int32
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

getUncompSize :: BlockConfig -> Ptr Word8 -> IO Int32
getUncompSize :: BlockConfig -> Ptr Word8 -> IO Int32
getUncompSize BlockConfig {BlockSize
blockSize :: BlockSize
blockSize :: BlockConfig -> BlockSize
blockSize} =
    case BlockSize
blockSize of
        BlockSize
BlockHasSize ->
            \Ptr Word8
src ->
                Int32 -> Int32
fromLittleEndian (Int32 -> Int32) -> IO Int32 -> IO Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
src Ptr Any -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Int32)
        BlockSize
BlockMax64KB -> \Ptr Word8
_ -> Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> IO Int32) -> Int32 -> IO Int32
forall a b. (a -> b) -> a -> b
$ Int32
64 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
1024
        BlockSize
BlockMax256KB -> \Ptr Word8
_ -> Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> IO Int32) -> Int32 -> IO Int32
forall a b. (a -> b) -> a -> b
$ Int32
256 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
1024
        BlockSize
BlockMax1MB -> \Ptr Word8
_ -> Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> IO Int32) -> Int32 -> IO Int32
forall a b. (a -> b) -> a -> b
$ Int32
1024 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
1024
        BlockSize
BlockMax4MB -> \Ptr Word8
_ -> Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> IO Int32) -> Int32 -> IO Int32
forall a b. (a -> b) -> a -> b
$ Int32
4 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
1024 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
1024

dataOffset :: BlockConfig -> Int
dataOffset :: BlockConfig -> Int
dataOffset BlockConfig {BlockSize
blockSize :: BlockSize
blockSize :: BlockConfig -> BlockSize
blockSize} =
    case BlockSize
blockSize of
        BlockSize
BlockHasSize -> Int
8
        BlockSize
_ -> Int
4

compSizeOffset :: BlockConfig -> Int
compSizeOffset :: BlockConfig -> Int
compSizeOffset BlockConfig
_ = Int
0

--------------------------------------------------------------------------------
-- Block level compression and decompression
--------------------------------------------------------------------------------

-- Having NOINLINE here does not effect the performance a lot. Every
-- iteration of the loop is a little slower (< 1us) but the entire loop
-- fuses.
-- On a stream with 404739 elements of 10 bytes each,
-- With NOINLINE: 96.14 ms
-- With INLINE:   81.07 ms
--
-- With INLINE statement and the usage of fusion-plugin results in an
-- enormous code size when used with other combinators.
--
-- | Compress an array of Word8. The compressed block header depends on the
-- 'BlockConfig' setting.
{-# NOINLINE compressChunk #-}
compressChunk ::
       BlockConfig
    -> Int
    -> Ptr C_LZ4Stream
    -> Array.Array Word8
    -> IO (Array.Array Word8)
compressChunk :: BlockConfig
-> Int -> Ptr C_LZ4Stream -> Array Word8 -> IO (Array Word8)
compressChunk BlockConfig
cfg Int
speed Ptr C_LZ4Stream
ctx Array Word8
arr = do
    Array Word8 -> (Ptr CChar -> IO (Array Word8)) -> IO (Array Word8)
forall a b c. Array a -> (Ptr b -> IO c) -> IO c
Array.unsafeAsPtr Array Word8
arr
        ((Ptr CChar -> IO (Array Word8)) -> IO (Array Word8))
-> (Ptr CChar -> IO (Array Word8)) -> IO (Array Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
src -> do
              let uncompLen :: Int
uncompLen = Array Word8 -> Int
forall a. Array a -> Int
Array.byteLength Array Word8
arr
                  speedC :: CInt
speedC = Int -> CInt
unsafeIntToCInt Int
speed
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
uncompLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxBlockSize)
                (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"compressChunk: Source array length "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
uncompLen
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" exceeds the maximum block size of "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
maxBlockSize
              -- The size is safe to downcast
              let uncompLenC :: CInt
uncompLenC = Int -> CInt
unsafeIntToCInt Int
uncompLen
              CInt
maxCompLenC <- CInt -> IO CInt
c_compressBound CInt
uncompLenC
              let maxCompLen :: Int
maxCompLen = CInt -> Int
cIntToInt CInt
maxCompLenC
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
maxCompLenC CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
0)
                (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"compressChunk: compressed length <= 0."
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" maxCompLenC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
maxCompLenC
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" uncompLenC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
uncompLenC
              (MArray.Array ArrayContents
cont Ptr Word8
dstBegin_ Ptr Word8
dstBegin Ptr Word8
dstMax) <-
                  Int -> IO (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> m (Array a)
MArray.newArray (Int
maxCompLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
metaSize_)
              let hdrCompLen :: Ptr b
hdrCompLen = Ptr Word8
dstBegin Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
compSizeOffset_
                  compData :: Ptr b
compData = Ptr Word8
dstBegin Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
dataOffset_
              CInt
compLenC <-
                  Ptr C_LZ4Stream
-> Ptr CChar -> Ptr Word8 -> CInt -> CInt -> CInt -> IO CInt
c_compressFastContinue
                      Ptr C_LZ4Stream
ctx Ptr CChar
src Ptr Word8
forall b. Ptr b
compData CInt
uncompLenC CInt
maxCompLenC CInt
speedC
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
compLenC CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
0)
                (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"compressChunk: c_compressFastContinue failed. "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"uncompLenC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
uncompLenC
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"compLenC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
compLenC
              Ptr Word8 -> Int32 -> IO ()
setUncompSize_ Ptr Word8
dstBegin (CInt -> Int32
cIntToI32 CInt
uncompLenC)
              Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int32
forall b. Ptr b
hdrCompLen (Int32 -> Int32
toLittleEndian (CInt -> Int32
cIntToI32 CInt
compLenC))
              let compLen :: Int
compLen = CInt -> Int
cIntToInt CInt
compLenC
                  dstEnd :: Ptr b
dstEnd = Ptr Word8
dstBegin Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
compLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
metaSize_)
                  compArr :: Array Word8
compArr = ArrayContents -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Array Word8
forall a. ArrayContents -> Ptr a -> Ptr a -> Ptr a -> Array a
MArray.Array ArrayContents
cont Ptr Word8
dstBegin_ Ptr Word8
forall b. Ptr b
dstEnd Ptr Word8
dstMax
              -- It is safe to shrink here as we need to hold the last 64KB of
              -- the previous uncompressed array and not the compressed one.
              Array Word8 -> Array Word8
forall a. Array a -> Array a
Array.unsafeFreeze (Array Word8 -> Array Word8)
-> IO (Array Word8) -> IO (Array Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array Word8 -> IO (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> m (Array a)
MArray.rightSize Array Word8
compArr
    where

    metaSize_ :: Int
metaSize_ = BlockConfig -> Int
metaSize BlockConfig
cfg
    compSizeOffset_ :: Int
compSizeOffset_ = BlockConfig -> Int
compSizeOffset BlockConfig
cfg
    dataOffset_ :: Int
dataOffset_ = BlockConfig -> Int
dataOffset BlockConfig
cfg
    setUncompSize_ :: Ptr Word8 -> Int32 -> IO ()
setUncompSize_ = BlockConfig -> Ptr Word8 -> Int32 -> IO ()
setUncompSize BlockConfig
cfg
    maxBlockSize :: Int
maxBlockSize =
        case BlockConfig -> BlockSize
blockSize BlockConfig
cfg of
             BlockSize
BlockHasSize -> CInt -> Int
cIntToInt CInt
lz4_MAX_INPUT_SIZE
             BlockSize
BlockMax64KB -> Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024
             BlockSize
BlockMax256KB -> Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024
             BlockSize
BlockMax1MB -> Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024
             BlockSize
BlockMax4MB -> Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

-- Having NOINLINE here does not effect the performance a lot. Every
-- iteration of the loop is a little slower (< 1us) but the entire loop
-- fuses.
--
-- With INLINE statement and the usage of fusion-plugin results in an
-- enormous code size when used with other combinators.
-- | Primitive function to decompress a chunk of Word8.
{-# NOINLINE decompressChunk #-}
decompressChunk ::
       BlockConfig
    -> Ptr C_LZ4StreamDecode
    -> Array.Array Word8
    -> IO (Array.Array Word8)
decompressChunk :: BlockConfig
-> Ptr C_LZ4StreamDecode -> Array Word8 -> IO (Array Word8)
decompressChunk BlockConfig
cfg Ptr C_LZ4StreamDecode
ctx Array Word8
arr = do
    Array Word8 -> (Ptr Word8 -> IO (Array Word8)) -> IO (Array Word8)
forall a b c. Array a -> (Ptr b -> IO c) -> IO c
Array.unsafeAsPtr Array Word8
arr
        ((Ptr Word8 -> IO (Array Word8)) -> IO (Array Word8))
-> (Ptr Word8 -> IO (Array Word8)) -> IO (Array Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> do
              let Ptr Int32
hdrCompLen :: Ptr Int32 = Ptr Word8
src Ptr Word8 -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` BlockConfig -> Int
compSizeOffset BlockConfig
cfg
                  compData :: Ptr b
compData = Ptr Word8
src Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` BlockConfig -> Int
dataOffset BlockConfig
cfg
                  arrDataLen :: Int
arrDataLen = Array Word8 -> Int
forall a. Array a -> Int
Array.byteLength Array Word8
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- BlockConfig -> Int
metaSize BlockConfig
cfg
              CInt
uncompLenC <- Int32 -> CInt
i32ToCInt (Int32 -> CInt) -> IO Int32 -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockConfig -> Ptr Word8 -> IO Int32
getUncompSize BlockConfig
cfg Ptr Word8
src
              CInt
compLenC <- Int32 -> CInt
i32ToCInt (Int32 -> CInt) -> (Int32 -> Int32) -> Int32 -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
fromLittleEndian (Int32 -> CInt) -> IO Int32 -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
hdrCompLen
              let compLen :: Int
compLen = CInt -> Int
cIntToInt CInt
compLenC
                  maxCompLenC :: CInt
maxCompLenC = CInt
lz4_MAX_OUTPUT_SIZE
                  uncompLen :: Int
uncompLen = CInt -> Int
cIntToInt CInt
uncompLenC

              -- Error checks
              if CInt
compLenC CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
0
              then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"decompressChunk: compressed data length > 2GB"
              else if Int
compLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrDataLen
              then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"decompressChunk: input array data length "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arrDataLen [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is less than "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"the compressed data length specified in the header "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
compLen
              else Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
compLenC CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
maxCompLenC) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                  [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"decompressChunk: compressed data length is more "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"than the max limit: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
maxCompLenC

              (MArray.Array ArrayContents
cont Ptr Word8
dstBegin_ Ptr Word8
dstBegin Ptr Word8
dstMax)
                  <- Int -> IO (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> m (Array a)
MArray.newArray Int
uncompLen
              CInt
decompLenC <-
                  Ptr C_LZ4StreamDecode
-> Ptr CChar -> Ptr Word8 -> CInt -> CInt -> IO CInt
c_decompressSafeContinue
                        Ptr C_LZ4StreamDecode
ctx Ptr CChar
forall b. Ptr b
compData Ptr Word8
dstBegin CInt
compLenC CInt
uncompLenC
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
decompLenC CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0)
                (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"decompressChunk: c_decompressSafeContinue failed. "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\narrDataLen = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
arrDataLen
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\ncompLenC = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
compLenC
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\nuncompLenC = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
uncompLenC
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\ndecompLenC = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
decompLenC
              let decompLen :: Int
decompLen = CInt -> Int
cIntToInt CInt
decompLenC
                  dstEnd :: Ptr b
dstEnd = Ptr Word8
dstBegin Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
decompLen
                  decompArr :: Array Word8
decompArr = ArrayContents -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Array Word8
forall a. ArrayContents -> Ptr a -> Ptr a -> Ptr a -> Array a
MArray.Array ArrayContents
cont Ptr Word8
dstBegin_ Ptr Word8
forall b. Ptr b
dstEnd Ptr Word8
dstMax
              -- We cannot shrink the array here, because that would reallocate
              -- the array invalidating the cached dictionary.
              Array Word8 -> IO (Array Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array Word8 -> IO (Array Word8))
-> Array Word8 -> IO (Array Word8)
forall a b. (a -> b) -> a -> b
$ Array Word8 -> Array Word8
forall a. Array a -> Array a
Array.unsafeFreeze Array Word8
decompArr

--------------------------------------------------------------------------------
-- Stream compression
--------------------------------------------------------------------------------

{-# ANN type CompressState Fuse #-}
data CompressState st ctx prev
    = CompressInit st
    | CompressDo st ctx prev
    | CompressDone ctx

-- 64KB blocks are optimal as the dictionary max size is 64KB. We can rechunk
-- the stream into 64KB blocks before compression.
--
-- | See 'Streamly.LZ4.compress' for documentation.
{-# INLINE_NORMAL compressChunksD #-}
compressChunksD ::
       MonadIO m
    => BlockConfig
    -> Int
    -> Stream.Stream m (Array.Array Word8)
    -> Stream.Stream m (Array.Array Word8)
compressChunksD :: BlockConfig
-> Int -> Stream m (Array Word8) -> Stream m (Array Word8)
compressChunksD BlockConfig
cfg Int
speed0 (Stream.Stream State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step0 s
state0) =
    (State Stream m (Array Word8)
 -> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
 -> m (Step
         (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
         (Array Word8)))
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
-> Stream m (Array Word8)
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream.Stream State Stream m (Array Word8)
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
step (s -> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
forall st ctx prev. st -> CompressState st ctx prev
CompressInit s
state0)

    where

    speed :: Int
speed = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
speed0 Int
0

    {-# INLINE_LATE step #-}
    step :: State Stream m (Array Word8)
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
step State Stream m (Array Word8)
_ (CompressInit s
st) =
        IO
  (Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8))
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            (IO
   (Step
      (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
      (Array Word8))
 -> m (Step
         (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
         (Array Word8)))
-> IO
     (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ do
                Ptr C_LZ4Stream
ctx <- IO (Ptr C_LZ4Stream)
c_createStream
                -- Instead of using an external dictionary we could just hold
                -- the previous chunks. However, the dictionary is only 64KB,
                -- if the chunk size is bigger we would be holding a lot more
                -- data than required. Also, the perf advantage does not seem
                -- much.
                Step
  (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
  (Array Word8)
-> IO
     (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
   (Array Word8)
 -> IO
      (Step
         (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
         (Array Word8)))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
-> IO
     (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
forall s a. s -> Step s a
Stream.Skip (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
 -> Step
      (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
      (Array Word8))
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
forall a b. (a -> b) -> a -> b
$ s
-> Ptr C_LZ4Stream
-> Maybe (Array Word8)
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
forall st ctx prev. st -> ctx -> prev -> CompressState st ctx prev
CompressDo s
st Ptr C_LZ4Stream
ctx Maybe (Array Word8)
forall a. Maybe a
Nothing
    step State Stream m (Array Word8)
gst (CompressDo s
st Ptr C_LZ4Stream
ctx Maybe (Array Word8)
prev) = do
        Step s (Array Word8)
r <- State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step0 State Stream m (Array Word8)
gst s
st
        case Step s (Array Word8)
r of
            Stream.Yield Array Word8
arr s
st1 ->
                -- The compression primitives use 32-bit signed int (CInt) to
                -- represent the length of the array. The maximum value of a
                -- 32-bit signed int is 2GB.
                if Array Word8 -> Int
forall a. Array a -> Int
Array.byteLength Array Word8
arr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024
                then [Char]
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall a. HasCallStack => [Char] -> a
error [Char]
"compressChunksD: Array element > 2 GB encountered"
                else do
                    Array Word8
arr1 <- IO (Array Word8) -> m (Array Word8)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array Word8) -> m (Array Word8))
-> IO (Array Word8) -> m (Array Word8)
forall a b. (a -> b) -> a -> b
$ BlockConfig
-> Int -> Ptr C_LZ4Stream -> Array Word8 -> IO (Array Word8)
compressChunk BlockConfig
cfg Int
speed Ptr C_LZ4Stream
ctx Array Word8
arr
                    -- XXX touch the "prev" array to keep it alive?
                    Step
  (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
  (Array Word8)
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
   (Array Word8)
 -> m (Step
         (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
         (Array Word8)))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ Array Word8
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
forall s a. a -> s -> Step s a
Stream.Yield Array Word8
arr1 (s
-> Ptr C_LZ4Stream
-> Maybe (Array Word8)
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
forall st ctx prev. st -> ctx -> prev -> CompressState st ctx prev
CompressDo s
st1 Ptr C_LZ4Stream
ctx (Array Word8 -> Maybe (Array Word8)
forall a. a -> Maybe a
Just Array Word8
arr))
            Stream.Skip s
st1 ->
                Step
  (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
  (Array Word8)
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
   (Array Word8)
 -> m (Step
         (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
         (Array Word8)))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
forall s a. s -> Step s a
Stream.Skip (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
 -> Step
      (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
      (Array Word8))
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
forall a b. (a -> b) -> a -> b
$ s
-> Ptr C_LZ4Stream
-> Maybe (Array Word8)
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
forall st ctx prev. st -> ctx -> prev -> CompressState st ctx prev
CompressDo s
st1 Ptr C_LZ4Stream
ctx Maybe (Array Word8)
prev
            Step s (Array Word8)
Stream.Stop -> Step
  (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
  (Array Word8)
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
   (Array Word8)
 -> m (Step
         (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
         (Array Word8)))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
forall s a. s -> Step s a
Stream.Skip (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
 -> Step
      (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
      (Array Word8))
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
-> Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8)
forall a b. (a -> b) -> a -> b
$ Ptr C_LZ4Stream
-> CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8))
forall st ctx prev. ctx -> CompressState st ctx prev
CompressDone Ptr C_LZ4Stream
ctx
    step State Stream m (Array Word8)
_ (CompressDone Ptr C_LZ4Stream
ctx) =
        IO
  (Step
     (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
     (Array Word8))
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Step
      (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
      (Array Word8))
 -> m (Step
         (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
         (Array Word8)))
-> IO
     (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
-> m (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ Ptr C_LZ4Stream -> IO ()
c_freeStream Ptr C_LZ4Stream
ctx IO ()
-> IO
     (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
-> IO
     (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
  (Array Word8)
-> IO
     (Step
        (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (CompressState s (Ptr C_LZ4Stream) (Maybe (Array Word8)))
  (Array Word8)
forall s a. Step s a
Stream.Stop

--------------------------------------------------------------------------------
-- Stream decompression
--------------------------------------------------------------------------------

{-# INLINE endMark #-}
endMark :: Int32
endMark :: Int32
endMark = Int32
0

footerSize :: FrameConfig -> Int
footerSize :: FrameConfig -> Int
footerSize FrameConfig {Bool
hasEndMark :: FrameConfig -> Bool
hasEndMark :: Bool
hasEndMark} =
    if Bool
hasEndMark
    then Int
4
    else Int
0

validateFooter :: FrameConfig -> Array.Array Word8 -> IO Bool
validateFooter :: FrameConfig -> Array Word8 -> IO Bool
validateFooter FrameConfig
_ Array Word8
_ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

{-# ANN type ResizeState Fuse #-}
data ResizeState st arr
    = RInit st
    | RProcess st arr
    | RAccumulate st arr
    | RFooter st arr
    | RYield arr (ResizeState st arr)
    | RDone

-- | Look for a compressed block header and compact the arrays in the input
-- stream to the compressed length specified in the header. The output contains
-- arrays, where each array represents a full single compressed block along
-- with the compression header.
--
-- The resize operation is idempotent:
--
-- @resizeChunksD . resizeChunksD = resizeChunksD@
--
{-# INLINE_NORMAL resizeChunksD #-}
resizeChunksD ::
       MonadIO m
    => BlockConfig
    -> FrameConfig
    -> Stream.Stream m (Array.Array Word8)
    -> Stream.Stream m (Array.Array Word8)
resizeChunksD :: BlockConfig
-> FrameConfig -> Stream m (Array Word8) -> Stream m (Array Word8)
resizeChunksD BlockConfig
cfg FrameConfig
conf (Stream.Stream State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step0 s
state0) =
    (State Stream m (Array Word8)
 -> ResizeState s (Array Word8)
 -> m (Step (ResizeState s (Array Word8)) (Array Word8)))
-> ResizeState s (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream.Stream State Stream m (Array Word8)
-> ResizeState s (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
step (s -> ResizeState s (Array Word8)
forall st arr. st -> ResizeState st arr
RInit s
state0)

    where

    metaSize_ :: Int
metaSize_ = BlockConfig -> Int
metaSize BlockConfig
cfg
    compSizeOffset_ :: Int
compSizeOffset_ = BlockConfig -> Int
compSizeOffset BlockConfig
cfg

    hasEndMark_ :: Bool
hasEndMark_ = FrameConfig -> Bool
hasEndMark FrameConfig
conf
    footerSize_ :: Int
footerSize_ = FrameConfig -> Int
footerSize FrameConfig
conf
    validateFooter_ :: Array Word8 -> IO Bool
validateFooter_ = FrameConfig -> Array Word8 -> IO Bool
validateFooter FrameConfig
conf

    -- Unsafe function
    {-# INLINE isEndMark #-}
    isEndMark :: Ptr a -> IO Bool
isEndMark Ptr a
src
        | Bool
hasEndMark_ = do
              Int32
em <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr a -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr Ptr a
src :: Ptr Int32)
              Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int32
em Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
endMark
        | Bool
otherwise = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    {-# INLINE process #-}
    process :: st -> Array a -> IO (Step (ResizeState st (Array a)) a)
process st
st arr :: Array a
arr@(Array.Array ArrayContents
cont Ptr a
b Ptr a
e) = do
        let len :: Int
len = Array a -> Int
forall a. Array a -> Int
Array.byteLength Array a
arr
        if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4
        then Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState st (Array a)) a
 -> IO (Step (ResizeState st (Array a)) a))
-> Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall a b. (a -> b) -> a -> b
$ ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall s a. s -> Step s a
Stream.Skip (ResizeState st (Array a) -> Step (ResizeState st (Array a)) a)
-> ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall a b. (a -> b) -> a -> b
$ st -> Array a -> ResizeState st (Array a)
forall st arr. st -> arr -> ResizeState st arr
RAccumulate st
st Array a
arr
        else do
               Bool
res <- Ptr a -> IO Bool
forall a. Ptr a -> IO Bool
isEndMark Ptr a
b
               if Bool
res
               then Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState st (Array a)) a
 -> IO (Step (ResizeState st (Array a)) a))
-> Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall a b. (a -> b) -> a -> b
$ ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall s a. s -> Step s a
Stream.Skip (ResizeState st (Array a) -> Step (ResizeState st (Array a)) a)
-> ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall a b. (a -> b) -> a -> b
$ st -> Array a -> ResizeState st (Array a)
forall st arr. st -> arr -> ResizeState st arr
RFooter st
st Array a
arr
               else do
                   if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
metaSize_
                   then Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState st (Array a)) a
 -> IO (Step (ResizeState st (Array a)) a))
-> Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall a b. (a -> b) -> a -> b
$ ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall s a. s -> Step s a
Stream.Skip (ResizeState st (Array a) -> Step (ResizeState st (Array a)) a)
-> ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall a b. (a -> b) -> a -> b
$ st -> Array a -> ResizeState st (Array a)
forall st arr. st -> arr -> ResizeState st arr
RAccumulate st
st Array a
arr
                   else do
                       let compLenPtr :: Ptr b
compLenPtr = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr a
b Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
compSizeOffset_)
                       Int
compressedSize <-
                           Int32 -> Int
i32ToInt (Int32 -> Int) -> (Int32 -> Int32) -> Int32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
fromLittleEndian (Int32 -> Int) -> IO Int32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
forall b. Ptr b
compLenPtr
                       let required :: Int
required = Int
compressedSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
metaSize_
                       if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
required
                       then Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState st (Array a)) a
 -> IO (Step (ResizeState st (Array a)) a))
-> Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall a b. (a -> b) -> a -> b
$ ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall s a. s -> Step s a
Stream.Skip (ResizeState st (Array a) -> Step (ResizeState st (Array a)) a)
-> ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall a b. (a -> b) -> a -> b
$ Array a -> ResizeState st (Array a) -> ResizeState st (Array a)
forall st arr. arr -> ResizeState st arr -> ResizeState st arr
RYield Array a
arr (ResizeState st (Array a) -> ResizeState st (Array a))
-> ResizeState st (Array a) -> ResizeState st (Array a)
forall a b. (a -> b) -> a -> b
$ st -> ResizeState st (Array a)
forall st arr. st -> ResizeState st arr
RInit st
st
                       else if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
required
                       then Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState st (Array a)) a
 -> IO (Step (ResizeState st (Array a)) a))
-> Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall a b. (a -> b) -> a -> b
$ ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall s a. s -> Step s a
Stream.Skip (ResizeState st (Array a) -> Step (ResizeState st (Array a)) a)
-> ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall a b. (a -> b) -> a -> b
$ st -> Array a -> ResizeState st (Array a)
forall st arr. st -> arr -> ResizeState st arr
RAccumulate st
st Array a
arr
                       else do
                           let arr1E :: Ptr b
arr1E = Ptr a
b Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
required
                               arr1 :: Array a
arr1 = ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array.Array ArrayContents
cont Ptr a
b Ptr a
forall b. Ptr b
arr1E
                               arr2 :: Array a
arr2 = ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array.Array ArrayContents
cont Ptr a
forall b. Ptr b
arr1E Ptr a
e
                           ArrayContents -> IO ()
MArray.touch ArrayContents
cont
                           Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState st (Array a)) a
 -> IO (Step (ResizeState st (Array a)) a))
-> Step (ResizeState st (Array a)) a
-> IO (Step (ResizeState st (Array a)) a)
forall a b. (a -> b) -> a -> b
$ ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall s a. s -> Step s a
Stream.Skip (ResizeState st (Array a) -> Step (ResizeState st (Array a)) a)
-> ResizeState st (Array a) -> Step (ResizeState st (Array a)) a
forall a b. (a -> b) -> a -> b
$ Array a -> ResizeState st (Array a) -> ResizeState st (Array a)
forall st arr. arr -> ResizeState st arr -> ResizeState st arr
RYield Array a
arr1 (ResizeState st (Array a) -> ResizeState st (Array a))
-> ResizeState st (Array a) -> ResizeState st (Array a)
forall a b. (a -> b) -> a -> b
$ st -> Array a -> ResizeState st (Array a)
forall st arr. st -> arr -> ResizeState st arr
RProcess st
st Array a
arr2

    {-# INLINE_LATE step #-}
    step :: State Stream m (Array Word8)
-> ResizeState s (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
step State Stream m (Array Word8)
_ (RYield Array Word8
r ResizeState s (Array Word8)
next) = Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState s (Array Word8)) (Array Word8)
 -> m (Step (ResizeState s (Array Word8)) (Array Word8)))
-> Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ Array Word8
-> ResizeState s (Array Word8)
-> Step (ResizeState s (Array Word8)) (Array Word8)
forall s a. a -> s -> Step s a
Stream.Yield Array Word8
r ResizeState s (Array Word8)
next
    step State Stream m (Array Word8)
gst (RInit s
st) = do
        Step s (Array Word8)
r <- State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step0 State Stream m (Array Word8)
gst s
st
        case Step s (Array Word8)
r of
            Stream.Yield Array Word8
arr s
st1 -> IO (Step (ResizeState s (Array Word8)) (Array Word8))
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Step (ResizeState s (Array Word8)) (Array Word8))
 -> m (Step (ResizeState s (Array Word8)) (Array Word8)))
-> IO (Step (ResizeState s (Array Word8)) (Array Word8))
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ s
-> Array Word8
-> IO (Step (ResizeState s (Array Word8)) (Array Word8))
forall st a a.
st -> Array a -> IO (Step (ResizeState st (Array a)) a)
process s
st1 Array Word8
arr
            Stream.Skip s
st1 -> Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState s (Array Word8)) (Array Word8)
 -> m (Step (ResizeState s (Array Word8)) (Array Word8)))
-> Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ ResizeState s (Array Word8)
-> Step (ResizeState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
Stream.Skip (ResizeState s (Array Word8)
 -> Step (ResizeState s (Array Word8)) (Array Word8))
-> ResizeState s (Array Word8)
-> Step (ResizeState s (Array Word8)) (Array Word8)
forall a b. (a -> b) -> a -> b
$ s -> ResizeState s (Array Word8)
forall st arr. st -> ResizeState st arr
RInit s
st1
            Step s (Array Word8)
Stream.Stop ->
                if Bool
hasEndMark_
                then [Char] -> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a. HasCallStack => [Char] -> a
error [Char]
"resizeChunksD: No end mark found"
                else Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ResizeState s (Array Word8)) (Array Word8)
forall s a. Step s a
Stream.Stop
    step State Stream m (Array Word8)
_ (RProcess s
st Array Word8
arr) = IO (Step (ResizeState s (Array Word8)) (Array Word8))
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Step (ResizeState s (Array Word8)) (Array Word8))
 -> m (Step (ResizeState s (Array Word8)) (Array Word8)))
-> IO (Step (ResizeState s (Array Word8)) (Array Word8))
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ s
-> Array Word8
-> IO (Step (ResizeState s (Array Word8)) (Array Word8))
forall st a a.
st -> Array a -> IO (Step (ResizeState st (Array a)) a)
process s
st Array Word8
arr
    step State Stream m (Array Word8)
gst (RAccumulate s
st Array Word8
buf) = do
        Step s (Array Word8)
r <- State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step0 State Stream m (Array Word8)
gst s
st
        case Step s (Array Word8)
r of
            Stream.Yield Array Word8
arr s
st1 -> do
                Array Word8
arr1 <- Array Word8 -> Array Word8 -> m (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
Array.splice Array Word8
buf Array Word8
arr
                IO (Step (ResizeState s (Array Word8)) (Array Word8))
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Step (ResizeState s (Array Word8)) (Array Word8))
 -> m (Step (ResizeState s (Array Word8)) (Array Word8)))
-> IO (Step (ResizeState s (Array Word8)) (Array Word8))
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ s
-> Array Word8
-> IO (Step (ResizeState s (Array Word8)) (Array Word8))
forall st a a.
st -> Array a -> IO (Step (ResizeState st (Array a)) a)
process s
st1 Array Word8
arr1
            Stream.Skip s
st1 -> Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState s (Array Word8)) (Array Word8)
 -> m (Step (ResizeState s (Array Word8)) (Array Word8)))
-> Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ ResizeState s (Array Word8)
-> Step (ResizeState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
Stream.Skip (ResizeState s (Array Word8)
 -> Step (ResizeState s (Array Word8)) (Array Word8))
-> ResizeState s (Array Word8)
-> Step (ResizeState s (Array Word8)) (Array Word8)
forall a b. (a -> b) -> a -> b
$ s -> Array Word8 -> ResizeState s (Array Word8)
forall st arr. st -> arr -> ResizeState st arr
RAccumulate s
st1 Array Word8
buf
            Step s (Array Word8)
Stream.Stop -> [Char] -> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a. HasCallStack => [Char] -> a
error [Char]
"resizeChunksD: Incomplete block"
    step State Stream m (Array Word8)
gst (RFooter s
st Array Word8
buf) = do
        -- Warn if len > footerSize
        let len :: Int
len = Array Word8 -> Int
forall a. Array a -> Int
Array.byteLength Array Word8
buf
        if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
footerSize_
        then do
            Step s (Array Word8)
r <- State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step0 State Stream m (Array Word8)
gst s
st
            case Step s (Array Word8)
r of
                Stream.Yield Array Word8
arr s
st1 -> do
                    Array Word8
arr1 <- Array Word8 -> Array Word8 -> m (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
Array.splice Array Word8
buf Array Word8
arr
                    Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState s (Array Word8)) (Array Word8)
 -> m (Step (ResizeState s (Array Word8)) (Array Word8)))
-> Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ ResizeState s (Array Word8)
-> Step (ResizeState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
Stream.Skip (ResizeState s (Array Word8)
 -> Step (ResizeState s (Array Word8)) (Array Word8))
-> ResizeState s (Array Word8)
-> Step (ResizeState s (Array Word8)) (Array Word8)
forall a b. (a -> b) -> a -> b
$ s -> Array Word8 -> ResizeState s (Array Word8)
forall st arr. st -> arr -> ResizeState st arr
RFooter s
st1 Array Word8
arr1
                Stream.Skip s
st1 -> Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ResizeState s (Array Word8)) (Array Word8)
 -> m (Step (ResizeState s (Array Word8)) (Array Word8)))
-> Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ ResizeState s (Array Word8)
-> Step (ResizeState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
Stream.Skip (ResizeState s (Array Word8)
 -> Step (ResizeState s (Array Word8)) (Array Word8))
-> ResizeState s (Array Word8)
-> Step (ResizeState s (Array Word8)) (Array Word8)
forall a b. (a -> b) -> a -> b
$ s -> Array Word8 -> ResizeState s (Array Word8)
forall st arr. st -> arr -> ResizeState st arr
RFooter s
st1 Array Word8
buf
                Step s (Array Word8)
Stream.Stop -> [Char] -> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a. HasCallStack => [Char] -> a
error [Char]
"resizeChunksD: Incomplete footer"
        else do
            Bool
res <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Array Word8 -> IO Bool
validateFooter_ Array Word8
buf
            if Bool
res
            then Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ResizeState s (Array Word8)) (Array Word8)
forall s a. Step s a
Stream.Stop
            else [Char] -> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall a. HasCallStack => [Char] -> a
error [Char]
"resizeChunksD: Invalid footer"
    step State Stream m (Array Word8)
_ ResizeState s (Array Word8)
RDone = Step (ResizeState s (Array Word8)) (Array Word8)
-> m (Step (ResizeState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ResizeState s (Array Word8)) (Array Word8)
forall s a. Step s a
Stream.Stop

{-# ANN type DecompressState Fuse #-}
data DecompressState st ctx prev
    = DecompressInit st
    | DecompressDo st ctx prev
    | DecompressDone ctx

-- | This combinator assumes all the arrays in the incoming stream are properly
-- resized.
--
-- This combinator works well with untouched arrays compressed with
-- 'compressChunksD'.  A random compressed stream would first need to be
-- resized properly with 'resizeChunksD'.
--
{-# INLINE_NORMAL decompressChunksRawD #-}
decompressChunksRawD ::
       MonadIO m
    => BlockConfig
    -> Stream.Stream m (Array.Array Word8)
    -> Stream.Stream m (Array.Array Word8)
decompressChunksRawD :: BlockConfig -> Stream m (Array Word8) -> Stream m (Array Word8)
decompressChunksRawD BlockConfig
cfg (Stream.Stream State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step0 s
state0) =
    (State Stream m (Array Word8)
 -> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
 -> m (Step
         (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
         (Array Word8)))
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
-> Stream m (Array Word8)
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream.Stream State Stream m (Array Word8)
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
step (s
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
forall st ctx prev. st -> DecompressState st ctx prev
DecompressInit s
state0)

   where

    {-# INLINE_LATE step #-}
    step :: State Stream m (Array Word8)
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
step State Stream m (Array Word8)
_ (DecompressInit s
st) =
        IO
  (Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8))
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            (IO
   (Step
      (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
      (Array Word8))
 -> m (Step
         (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
         (Array Word8)))
-> IO
     (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ do
                Ptr C_LZ4StreamDecode
lz4Ctx <- IO (Ptr C_LZ4StreamDecode)
c_createStreamDecode
                Step
  (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
  (Array Word8)
-> IO
     (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
   (Array Word8)
 -> IO
      (Step
         (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
         (Array Word8)))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
-> IO
     (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
forall s a. s -> Step s a
Stream.Skip (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
 -> Step
      (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
      (Array Word8))
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
forall a b. (a -> b) -> a -> b
$ s
-> Ptr C_LZ4StreamDecode
-> Maybe (Array Word8)
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
forall st ctx prev.
st -> ctx -> prev -> DecompressState st ctx prev
DecompressDo s
st Ptr C_LZ4StreamDecode
lz4Ctx Maybe (Array Word8)
forall a. Maybe a
Nothing
    step State Stream m (Array Word8)
_ (DecompressDone Ptr C_LZ4StreamDecode
lz4Ctx) =
        IO
  (Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8))
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Step
      (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
      (Array Word8))
 -> m (Step
         (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
         (Array Word8)))
-> IO
     (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ Ptr C_LZ4StreamDecode -> IO ()
c_freeStreamDecode Ptr C_LZ4StreamDecode
lz4Ctx IO ()
-> IO
     (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
-> IO
     (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
  (Array Word8)
-> IO
     (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
  (Array Word8)
forall s a. Step s a
Stream.Stop
    step State Stream m (Array Word8)
gst (DecompressDo s
st Ptr C_LZ4StreamDecode
lz4Ctx Maybe (Array Word8)
prev) = do
        Step s (Array Word8)
r <- State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step0 State Stream m (Array Word8)
gst s
st
        case Step s (Array Word8)
r of
            Stream.Yield Array Word8
arr s
st1 -> do
                Array Word8
arr1 <- IO (Array Word8) -> m (Array Word8)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array Word8) -> m (Array Word8))
-> IO (Array Word8) -> m (Array Word8)
forall a b. (a -> b) -> a -> b
$ BlockConfig
-> Ptr C_LZ4StreamDecode -> Array Word8 -> IO (Array Word8)
decompressChunk BlockConfig
cfg Ptr C_LZ4StreamDecode
lz4Ctx Array Word8
arr
                -- Instead of the input array chunk we need to hold the output
                -- array chunk here.
                Step
  (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
  (Array Word8)
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
   (Array Word8)
 -> m (Step
         (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
         (Array Word8)))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ Array Word8
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
forall s a. a -> s -> Step s a
Stream.Yield Array Word8
arr1 (s
-> Ptr C_LZ4StreamDecode
-> Maybe (Array Word8)
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
forall st ctx prev.
st -> ctx -> prev -> DecompressState st ctx prev
DecompressDo s
st1 Ptr C_LZ4StreamDecode
lz4Ctx (Array Word8 -> Maybe (Array Word8)
forall a. a -> Maybe a
Just Array Word8
arr1))
            Stream.Skip s
st1 ->
                Step
  (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
  (Array Word8)
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
   (Array Word8)
 -> m (Step
         (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
         (Array Word8)))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
forall s a. s -> Step s a
Stream.Skip (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
 -> Step
      (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
      (Array Word8))
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
forall a b. (a -> b) -> a -> b
$ s
-> Ptr C_LZ4StreamDecode
-> Maybe (Array Word8)
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
forall st ctx prev.
st -> ctx -> prev -> DecompressState st ctx prev
DecompressDo s
st1 Ptr C_LZ4StreamDecode
lz4Ctx Maybe (Array Word8)
prev
            Step s (Array Word8)
Stream.Stop -> Step
  (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
  (Array Word8)
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
   (Array Word8)
 -> m (Step
         (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
         (Array Word8)))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
-> m (Step
        (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
        (Array Word8))
forall a b. (a -> b) -> a -> b
$ DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
forall s a. s -> Step s a
Stream.Skip (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
 -> Step
      (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
      (Array Word8))
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
-> Step
     (DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8)))
     (Array Word8)
forall a b. (a -> b) -> a -> b
$ Ptr C_LZ4StreamDecode
-> DecompressState s (Ptr C_LZ4StreamDecode) (Maybe (Array Word8))
forall st ctx prev. ctx -> DecompressState st ctx prev
DecompressDone Ptr C_LZ4StreamDecode
lz4Ctx

decompressChunksWithD ::
       (MonadThrow m, MonadIO m)
    => Parser.Parser m Word8 (BlockConfig, FrameConfig)
    -> Stream.Stream m (Array.Array Word8)
    -> Stream.Stream m (Array.Array Word8)
decompressChunksWithD :: Parser m Word8 (BlockConfig, FrameConfig)
-> Stream m (Array Word8) -> Stream m (Array Word8)
decompressChunksWithD Parser m Word8 (BlockConfig, FrameConfig)
p Stream m (Array Word8)
s = do
    ((BlockConfig
cfg, FrameConfig
config), Stream m (Array Word8)
next) <- m ((BlockConfig, FrameConfig), Stream m (Array Word8))
-> Stream m ((BlockConfig, FrameConfig), Stream m (Array Word8))
forall (m :: * -> *) a. Applicative m => m a -> Stream m a
Stream.fromEffect (m ((BlockConfig, FrameConfig), Stream m (Array Word8))
 -> Stream m ((BlockConfig, FrameConfig), Stream m (Array Word8)))
-> m ((BlockConfig, FrameConfig), Stream m (Array Word8))
-> Stream m ((BlockConfig, FrameConfig), Stream m (Array Word8))
forall a b. (a -> b) -> a -> b
$ (SerialT m (Array Word8) -> Stream m (Array Word8))
-> ((BlockConfig, FrameConfig), SerialT m (Array Word8))
-> ((BlockConfig, FrameConfig), Stream m (Array Word8))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second SerialT m (Array Word8) -> Stream m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
IsStream.toStreamD
        (((BlockConfig, FrameConfig), SerialT m (Array Word8))
 -> ((BlockConfig, FrameConfig), Stream m (Array Word8)))
-> m ((BlockConfig, FrameConfig), SerialT m (Array Word8))
-> m ((BlockConfig, FrameConfig), Stream m (Array Word8))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold m Word8 (BlockConfig, FrameConfig)
-> SerialT m (Array Word8)
-> m ((BlockConfig, FrameConfig), SerialT m (Array Word8))
forall (m :: * -> *) a b.
(MonadIO m, MonadThrow m, Storable a) =>
Fold m a b -> SerialT m (Array a) -> m (b, SerialT m (Array a))
ArrayStream.foldArr_ (Parser m Word8 (BlockConfig, FrameConfig)
-> Fold m Word8 (BlockConfig, FrameConfig)
forall (m :: * -> *) a b.
(MonadIO m, Storable a) =>
Parser m a b -> Fold m a b
ArrayFold.fromParser Parser m Word8 (BlockConfig, FrameConfig)
p) (Stream m (Array Word8) -> SerialT m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
IsStream.fromStreamD Stream m (Array Word8)
s)
    BlockConfig -> Stream m (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *).
MonadIO m =>
BlockConfig -> Stream m (Array Word8) -> Stream m (Array Word8)
decompressChunksRawD BlockConfig
cfg (BlockConfig
-> FrameConfig -> Stream m (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *).
MonadIO m =>
BlockConfig
-> FrameConfig -> Stream m (Array Word8) -> Stream m (Array Word8)
resizeChunksD BlockConfig
cfg FrameConfig
config Stream m (Array Word8)
next)

-- XXX Merge this with BlockConfig?
data FLG =
    FLG
        { FLG -> Bool
isBlockIndependent :: Bool
        , FLG -> Bool
hasBlockChecksum :: Bool
        , FLG -> Bool
hasContentSize :: Bool
        , FLG -> Bool
hasContentChecksum :: Bool
        , FLG -> Bool
hasDict :: Bool
        }

-- XXX Support Skippable frames
simpleFrameParserD ::
       (Monad m, MonadThrow m)
    => Parser.Parser m Word8 (BlockConfig, FrameConfig)
simpleFrameParserD :: Parser m Word8 (BlockConfig, FrameConfig)
simpleFrameParserD = do
    ()
_ <- Parser m Word8 ()
assertMagic
    FLG
_flg <- Parser m Word8 FLG
parseFLG
    BlockSize
blockMaxSize <- Parser m Word8 BlockSize
parseBD
    Word8
_ <- Parser m Word8 Word8
forall b. Parser m b b
assertHeaderChecksum
    let config :: (BlockConfig, FrameConfig)
config =
            (BlockConfig :: BlockSize -> BlockConfig
BlockConfig {blockSize :: BlockSize
blockSize = BlockSize
blockMaxSize}
            , FrameConfig :: Bool -> FrameConfig
FrameConfig {hasEndMark :: Bool
hasEndMark = Bool
True})
    (BlockConfig, FrameConfig)
-> Parser m Word8 (BlockConfig, FrameConfig)
forall (m :: * -> *) b a. Monad m => b -> Parser m a b
Parser.fromPure (BlockConfig, FrameConfig)
config

    where

    assertHeaderChecksum :: Parser m b b
assertHeaderChecksum = (b -> Bool) -> Parser m b b
forall (m :: * -> *) a. MonadThrow m => (a -> Bool) -> Parser m a a
Parser.satisfy (Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True)

    assertMagic :: Parser m Word8 ()
assertMagic = do
        let magic :: Int
magic = Int
407708164 :: Int
        Int
magic_ <-
            let w8ToInt :: Word8 -> Int
w8ToInt = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word8 -> Int
                stp :: (Int, Int) -> Word8 -> (Int, Int)
stp (Int
i, Int
b) Word8
a = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8, Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
w8ToInt Word8
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i) :: (Int, Int)
                fld :: Fold m Word8 (Int, Int)
fld = ((Int, Int) -> Word8 -> (Int, Int))
-> (Int, Int) -> Fold m Word8 (Int, Int)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
Fold.foldl' (Int, Int) -> Word8 -> (Int, Int)
stp (Int
0, Int
0)
             in Int -> Fold m Word8 Int -> Parser m Word8 Int
forall (m :: * -> *) a b.
MonadThrow m =>
Int -> Fold m a b -> Parser m a b
Parser.takeEQ Int
4 ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> Fold m Word8 (Int, Int) -> Fold m Word8 Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold m Word8 (Int, Int)
fld)
        if Int
magic_ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
magic
        then () -> Parser m Word8 ()
forall (m :: * -> *) b a. Monad m => b -> Parser m a b
Parser.fromPure ()
        else [Char] -> Parser m Word8 ()
forall (m :: * -> *) a b. MonadThrow m => [Char] -> Parser m a b
Parser.die
                 ([Char]
"The parsed magic "
                     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
magic_ [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" does not match " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
magic)

    parseFLG :: Parser m Word8 FLG
parseFLG = do
        Word8
a <- (Word8 -> Bool) -> Parser m Word8 Word8
forall (m :: * -> *) a. MonadThrow m => (a -> Bool) -> Parser m a a
Parser.satisfy (Bool -> Word8 -> Bool
forall a b. a -> b -> a
const Bool
True)
        let isVersion01 :: Bool
isVersion01 = Bool -> Bool
not (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
a Int
7) Bool -> Bool -> Bool
&& Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
a Int
6
        let flg :: FLG
flg =
                Bool -> Bool -> Bool -> Bool -> Bool -> FLG
FLG
                    (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
a Int
5)
                    (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
a Int
4)
                    (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
a Int
3)
                    (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
a Int
2)
                    (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
a Int
0)
        if Bool
isVersion01
        then if FLG -> Bool
isBlockIndependent FLG
flg
        then [Char] -> Parser m Word8 FLG
forall (m :: * -> *) a b. MonadThrow m => [Char] -> Parser m a b
Parser.die [Char]
"Block independence is not yet supported"
        else if FLG -> Bool
hasBlockChecksum FLG
flg
        then [Char] -> Parser m Word8 FLG
forall (m :: * -> *) a b. MonadThrow m => [Char] -> Parser m a b
Parser.die [Char]
"Block checksum is not yet supported"
        else if FLG -> Bool
hasContentSize FLG
flg
        then [Char] -> Parser m Word8 FLG
forall (m :: * -> *) a b. MonadThrow m => [Char] -> Parser m a b
Parser.die [Char]
"Content size is not yet supported"
        else if FLG -> Bool
hasContentChecksum FLG
flg
        then [Char] -> Parser m Word8 FLG
forall (m :: * -> *) a b. MonadThrow m => [Char] -> Parser m a b
Parser.die [Char]
"Content checksum is not yet supported"
        else if FLG -> Bool
hasDict FLG
flg
        then [Char] -> Parser m Word8 FLG
forall (m :: * -> *) a b. MonadThrow m => [Char] -> Parser m a b
Parser.die [Char]
"Dict is not yet supported"
        else FLG -> Parser m Word8 FLG
forall (m :: * -> *) b a. Monad m => b -> Parser m a b
Parser.fromPure FLG
flg
        else [Char] -> Parser m Word8 FLG
forall (m :: * -> *) a b. MonadThrow m => [Char] -> Parser m a b
Parser.die [Char]
"Version is not 01"

    parseBD :: Parser m Word8 BlockSize
parseBD = do
        Word8
a <- (Word8 -> Bool) -> Parser m Word8 Word8
forall (m :: * -> *) a. MonadThrow m => (a -> Bool) -> Parser m a a
Parser.satisfy (Bool -> Word8 -> Bool
forall a b. a -> b -> a
const Bool
True)
        case Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftR Word8
a Int
4 of
            Word8
4 -> BlockSize -> Parser m Word8 BlockSize
forall (m :: * -> *) b a. Monad m => b -> Parser m a b
Parser.fromPure BlockSize
BlockMax64KB
            Word8
5 -> BlockSize -> Parser m Word8 BlockSize
forall (m :: * -> *) b a. Monad m => b -> Parser m a b
Parser.fromPure BlockSize
BlockMax256KB
            Word8
6 -> BlockSize -> Parser m Word8 BlockSize
forall (m :: * -> *) b a. Monad m => b -> Parser m a b
Parser.fromPure BlockSize
BlockMax1MB
            Word8
7 -> BlockSize -> Parser m Word8 BlockSize
forall (m :: * -> *) b a. Monad m => b -> Parser m a b
Parser.fromPure BlockSize
BlockMax4MB
            Word8
_ -> [Char] -> Parser m Word8 BlockSize
forall (m :: * -> *) a b. MonadThrow m => [Char] -> Parser m a b
Parser.die [Char]
"parseBD: Unknown block max size"