{-# LINE 1 "src/Codec/Compression/LZ4/Conduit.hsc" #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}

{-|
Module      : Codec.Compression.LZ4.Conduit
Description : Conduit for the lz4 compression codec.
Copyright   : (c) Niklas Hambüchen, 2020
License     : MIT
Maintainer  : mail@nh2.me
Stability   : stable


Help Wanted / TODOs

Please feel free to send me a pull request for any of the following items:

* TODO Block checksumming

* TODO Dictionary support

* TODO Performance:
   Write a version of `compress` that emits ByteStrings of known
   constant length. That will allow us to do compression in a zero-copy
   fashion, writing compressed bytes directly into a the ByteStrings
   (e.g using `unsafePackMallocCString` or equivalent).
   We currently don't do that (instead, use allocaBytes + copying packCStringLen)
   to ensure that the ByteStrings generated are as compact as possible
   (for the case that `written < size`), since the current `compress`
   conduit directly yields the outputs of LZ4F_compressUpdate()
   (unless they are of 0 length when they are buffered in the context
   tmp buffer).

* TODO Try enabling checksums, then corrupt a bit and see if lz4c detects it.

* TODO Add `with*` style bracketed functions for creating the
   LZ4F_createCompressionContext and Lz4FramePreferencesPtr
   for prompt resource release,
   in addition to the GC'd variants below.
   This would replace our use of `finalizeForeignPtr` in the conduit.
   `finalizeForeignPtr` seems almost as good, but note that it
   doesn't guarantee prompt resource release on exceptions;
   a `with*` style function that uses `bracket` does.
   However, it isn't clear yet which one would be faster
   (what the cost of `mask` is compared to foreign pointer finalizers).
   Also note that prompt freeing has side benefits,
   such as reduced malloc() fragmentation (the closer malloc()
   and free() are to each other, the smaller is the chance to
   have malloc()s on top of the our malloc() in the heap,
   thus the smaller the chance that we cannot decrease the
   heap pointer upon free() (because "mallocs on top" render
   heap memory unreturnable to the OS; memory fragmentation).
-}

module Codec.Compression.LZ4.Conduit
  ( Lz4FrameException(..)
  , BlockSizeID(..)
  , BlockMode(..)
  , ContentChecksum(..)
  , BlockChecksum(..)
  , FrameType(..)
  , FrameInfo(..)
  , Preferences(..)

  , lz4DefaultPreferences

  , compress
  , compressYieldImmediately
  , compressWithOutBufferSize

  , decompress

  , bsChunksOf

  -- * Internals
  , Lz4FrameCompressionContext(..)
  , ScopedLz4FrameCompressionContext(..)
  , ScopedLz4FramePreferencesPtr(..)
  , Lz4FramePreferencesPtr(..)
  , Lz4FrameDecompressionContext(..)
  , lz4fCreatePreferences
  , lz4fCreateCompressonContext
  , lz4fCreateDecompressionContext
  , withScopedLz4fPreferences
  , withScopedLz4fCompressionContext
  ) where

import           UnliftIO.Exception (throwString, bracket)
import           Control.Monad (foldM, when)
import           Control.Monad.IO.Unlift (MonadUnliftIO)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.Resource (MonadResource)
import           Data.Bits (testBit)
import           Data.ByteString (ByteString, packCStringLen)
import           Data.ByteString.Unsafe (unsafePackCString, unsafeUseAsCStringLen)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import           Data.Conduit
import qualified Data.Conduit.Binary as CB
import           Data.Monoid ((<>))
import           Foreign.C.Types (CChar, CSize)
import           Foreign.ForeignPtr (ForeignPtr, addForeignPtrFinalizer, mallocForeignPtr, mallocForeignPtrBytes, finalizeForeignPtr, withForeignPtr)
import           Foreign.Marshal.Alloc (alloca, allocaBytes, malloc, free)
import           Foreign.Marshal.Array (mallocArray, reallocArray)
import           Foreign.Marshal.Utils (with, new)
import           Foreign.Ptr (Ptr, nullPtr, FunPtr, plusPtr)
import           Foreign.Storable (Storable(..), poke)
import           GHC.Stack (HasCallStack)
import qualified Language.C.Inline as C
import qualified Language.C.Inline.Context as C
import qualified Language.C.Inline.Unsafe as CUnsafe
import           Text.RawString.QQ

import           Codec.Compression.LZ4.CTypes (LZ4F_cctx, LZ4F_dctx, lz4FrameTypesTable, Lz4FrameException(..), BlockSizeID(..), BlockMode(..), ContentChecksum(..), BlockChecksum(..), FrameType(..), FrameInfo(..), Preferences(..))



C.context (C.baseCtx <> C.fptrCtx <> mempty { C.ctxTypesTable = lz4FrameTypesTable })

C.include "<lz4frame.h>"
C.include "<stdlib.h>"
C.include "<stdio.h>"


newtype Lz4FrameCompressionContext = Lz4FrameCompressionContext { Lz4FrameCompressionContext -> ForeignPtr (Ptr LZ4F_cctx)
unLz4FrameCompressionContext :: ForeignPtr (Ptr LZ4F_cctx) }
  deriving (Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
(Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool)
-> (Lz4FrameCompressionContext
    -> Lz4FrameCompressionContext -> Bool)
-> Eq Lz4FrameCompressionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
== :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
$c/= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
/= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
Eq, Eq Lz4FrameCompressionContext
Eq Lz4FrameCompressionContext =>
(Lz4FrameCompressionContext
 -> Lz4FrameCompressionContext -> Ordering)
-> (Lz4FrameCompressionContext
    -> Lz4FrameCompressionContext -> Bool)
-> (Lz4FrameCompressionContext
    -> Lz4FrameCompressionContext -> Bool)
-> (Lz4FrameCompressionContext
    -> Lz4FrameCompressionContext -> Bool)
-> (Lz4FrameCompressionContext
    -> Lz4FrameCompressionContext -> Bool)
-> (Lz4FrameCompressionContext
    -> Lz4FrameCompressionContext -> Lz4FrameCompressionContext)
-> (Lz4FrameCompressionContext
    -> Lz4FrameCompressionContext -> Lz4FrameCompressionContext)
-> Ord Lz4FrameCompressionContext
Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Ordering
Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Ordering
compare :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Ordering
$c< :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
< :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
$c<= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
<= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
$c> :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
> :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
$c>= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
>= :: Lz4FrameCompressionContext -> Lz4FrameCompressionContext -> Bool
$cmax :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext
max :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext
$cmin :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext
min :: Lz4FrameCompressionContext
-> Lz4FrameCompressionContext -> Lz4FrameCompressionContext
Ord, Int -> Lz4FrameCompressionContext -> ShowS
[Lz4FrameCompressionContext] -> ShowS
Lz4FrameCompressionContext -> String
(Int -> Lz4FrameCompressionContext -> ShowS)
-> (Lz4FrameCompressionContext -> String)
-> ([Lz4FrameCompressionContext] -> ShowS)
-> Show Lz4FrameCompressionContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lz4FrameCompressionContext -> ShowS
showsPrec :: Int -> Lz4FrameCompressionContext -> ShowS
$cshow :: Lz4FrameCompressionContext -> String
show :: Lz4FrameCompressionContext -> String
$cshowList :: [Lz4FrameCompressionContext] -> ShowS
showList :: [Lz4FrameCompressionContext] -> ShowS
Show)

newtype ScopedLz4FrameCompressionContext = ScopedLz4FrameCompressionContext { ScopedLz4FrameCompressionContext -> Ptr LZ4F_cctx
unScopedLz4FrameCompressionContext :: Ptr LZ4F_cctx }
  deriving (ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
(ScopedLz4FrameCompressionContext
 -> ScopedLz4FrameCompressionContext -> Bool)
-> (ScopedLz4FrameCompressionContext
    -> ScopedLz4FrameCompressionContext -> Bool)
-> Eq ScopedLz4FrameCompressionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
== :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
$c/= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
/= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
Eq, Eq ScopedLz4FrameCompressionContext
Eq ScopedLz4FrameCompressionContext =>
(ScopedLz4FrameCompressionContext
 -> ScopedLz4FrameCompressionContext -> Ordering)
-> (ScopedLz4FrameCompressionContext
    -> ScopedLz4FrameCompressionContext -> Bool)
-> (ScopedLz4FrameCompressionContext
    -> ScopedLz4FrameCompressionContext -> Bool)
-> (ScopedLz4FrameCompressionContext
    -> ScopedLz4FrameCompressionContext -> Bool)
-> (ScopedLz4FrameCompressionContext
    -> ScopedLz4FrameCompressionContext -> Bool)
-> (ScopedLz4FrameCompressionContext
    -> ScopedLz4FrameCompressionContext
    -> ScopedLz4FrameCompressionContext)
-> (ScopedLz4FrameCompressionContext
    -> ScopedLz4FrameCompressionContext
    -> ScopedLz4FrameCompressionContext)
-> Ord ScopedLz4FrameCompressionContext
ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Ordering
ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Ordering
compare :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Ordering
$c< :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
< :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
$c<= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
<= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
$c> :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
> :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
$c>= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
>= :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext -> Bool
$cmax :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
max :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
$cmin :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
min :: ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
-> ScopedLz4FrameCompressionContext
Ord, Int -> ScopedLz4FrameCompressionContext -> ShowS
[ScopedLz4FrameCompressionContext] -> ShowS
ScopedLz4FrameCompressionContext -> String
(Int -> ScopedLz4FrameCompressionContext -> ShowS)
-> (ScopedLz4FrameCompressionContext -> String)
-> ([ScopedLz4FrameCompressionContext] -> ShowS)
-> Show ScopedLz4FrameCompressionContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScopedLz4FrameCompressionContext -> ShowS
showsPrec :: Int -> ScopedLz4FrameCompressionContext -> ShowS
$cshow :: ScopedLz4FrameCompressionContext -> String
show :: ScopedLz4FrameCompressionContext -> String
$cshowList :: [ScopedLz4FrameCompressionContext] -> ShowS
showList :: [ScopedLz4FrameCompressionContext] -> ShowS
Show)

newtype ScopedLz4FramePreferencesPtr = ScopedLz4FramePreferencesPtr { ScopedLz4FramePreferencesPtr -> Ptr Preferences
unScopedLz4FramePreferencesPtr :: Ptr Preferences }
  deriving (ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
(ScopedLz4FramePreferencesPtr
 -> ScopedLz4FramePreferencesPtr -> Bool)
-> (ScopedLz4FramePreferencesPtr
    -> ScopedLz4FramePreferencesPtr -> Bool)
-> Eq ScopedLz4FramePreferencesPtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
== :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
$c/= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
/= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
Eq, Eq ScopedLz4FramePreferencesPtr
Eq ScopedLz4FramePreferencesPtr =>
(ScopedLz4FramePreferencesPtr
 -> ScopedLz4FramePreferencesPtr -> Ordering)
-> (ScopedLz4FramePreferencesPtr
    -> ScopedLz4FramePreferencesPtr -> Bool)
-> (ScopedLz4FramePreferencesPtr
    -> ScopedLz4FramePreferencesPtr -> Bool)
-> (ScopedLz4FramePreferencesPtr
    -> ScopedLz4FramePreferencesPtr -> Bool)
-> (ScopedLz4FramePreferencesPtr
    -> ScopedLz4FramePreferencesPtr -> Bool)
-> (ScopedLz4FramePreferencesPtr
    -> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr)
-> (ScopedLz4FramePreferencesPtr
    -> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr)
-> Ord ScopedLz4FramePreferencesPtr
ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Ordering
ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Ordering
compare :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Ordering
$c< :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
< :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
$c<= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
<= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
$c> :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
> :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
$c>= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
>= :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> Bool
$cmax :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr
max :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr
$cmin :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr
min :: ScopedLz4FramePreferencesPtr
-> ScopedLz4FramePreferencesPtr -> ScopedLz4FramePreferencesPtr
Ord, Int -> ScopedLz4FramePreferencesPtr -> ShowS
[ScopedLz4FramePreferencesPtr] -> ShowS
ScopedLz4FramePreferencesPtr -> String
(Int -> ScopedLz4FramePreferencesPtr -> ShowS)
-> (ScopedLz4FramePreferencesPtr -> String)
-> ([ScopedLz4FramePreferencesPtr] -> ShowS)
-> Show ScopedLz4FramePreferencesPtr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScopedLz4FramePreferencesPtr -> ShowS
showsPrec :: Int -> ScopedLz4FramePreferencesPtr -> ShowS
$cshow :: ScopedLz4FramePreferencesPtr -> String
show :: ScopedLz4FramePreferencesPtr -> String
$cshowList :: [ScopedLz4FramePreferencesPtr] -> ShowS
showList :: [ScopedLz4FramePreferencesPtr] -> ShowS
Show)

newtype Lz4FramePreferencesPtr = Lz4FramePreferencesPtr { Lz4FramePreferencesPtr -> ForeignPtr Preferences
unLz4FramePreferencesPtr :: ForeignPtr Preferences }
  deriving (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
(Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> Eq Lz4FramePreferencesPtr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
== :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
$c/= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
/= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
Eq, Eq Lz4FramePreferencesPtr
Eq Lz4FramePreferencesPtr =>
(Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Ordering)
-> (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> (Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool)
-> (Lz4FramePreferencesPtr
    -> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr)
-> (Lz4FramePreferencesPtr
    -> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr)
-> Ord Lz4FramePreferencesPtr
Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Ordering
Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Ordering
compare :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Ordering
$c< :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
< :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
$c<= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
<= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
$c> :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
> :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
$c>= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
>= :: Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr -> Bool
$cmax :: Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr
max :: Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr
$cmin :: Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr
min :: Lz4FramePreferencesPtr
-> Lz4FramePreferencesPtr -> Lz4FramePreferencesPtr
Ord, Int -> Lz4FramePreferencesPtr -> ShowS
[Lz4FramePreferencesPtr] -> ShowS
Lz4FramePreferencesPtr -> String
(Int -> Lz4FramePreferencesPtr -> ShowS)
-> (Lz4FramePreferencesPtr -> String)
-> ([Lz4FramePreferencesPtr] -> ShowS)
-> Show Lz4FramePreferencesPtr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lz4FramePreferencesPtr -> ShowS
showsPrec :: Int -> Lz4FramePreferencesPtr -> ShowS
$cshow :: Lz4FramePreferencesPtr -> String
show :: Lz4FramePreferencesPtr -> String
$cshowList :: [Lz4FramePreferencesPtr] -> ShowS
showList :: [Lz4FramePreferencesPtr] -> ShowS
Show)

newtype Lz4FrameDecompressionContext = Lz4FrameDecompressionContext { Lz4FrameDecompressionContext -> ForeignPtr (Ptr LZ4F_dctx)
unLz4FrameDecompressionContext :: ForeignPtr (Ptr LZ4F_dctx) }
  deriving (Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
(Lz4FrameDecompressionContext
 -> Lz4FrameDecompressionContext -> Bool)
-> (Lz4FrameDecompressionContext
    -> Lz4FrameDecompressionContext -> Bool)
-> Eq Lz4FrameDecompressionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
== :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
$c/= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
/= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
Eq, Eq Lz4FrameDecompressionContext
Eq Lz4FrameDecompressionContext =>
(Lz4FrameDecompressionContext
 -> Lz4FrameDecompressionContext -> Ordering)
-> (Lz4FrameDecompressionContext
    -> Lz4FrameDecompressionContext -> Bool)
-> (Lz4FrameDecompressionContext
    -> Lz4FrameDecompressionContext -> Bool)
-> (Lz4FrameDecompressionContext
    -> Lz4FrameDecompressionContext -> Bool)
-> (Lz4FrameDecompressionContext
    -> Lz4FrameDecompressionContext -> Bool)
-> (Lz4FrameDecompressionContext
    -> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext)
-> (Lz4FrameDecompressionContext
    -> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext)
-> Ord Lz4FrameDecompressionContext
Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Ordering
Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Ordering
compare :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Ordering
$c< :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
< :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
$c<= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
<= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
$c> :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
> :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
$c>= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
>= :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Bool
$cmax :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext
max :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext
$cmin :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext
min :: Lz4FrameDecompressionContext
-> Lz4FrameDecompressionContext -> Lz4FrameDecompressionContext
Ord, Int -> Lz4FrameDecompressionContext -> ShowS
[Lz4FrameDecompressionContext] -> ShowS
Lz4FrameDecompressionContext -> String
(Int -> Lz4FrameDecompressionContext -> ShowS)
-> (Lz4FrameDecompressionContext -> String)
-> ([Lz4FrameDecompressionContext] -> ShowS)
-> Show Lz4FrameDecompressionContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lz4FrameDecompressionContext -> ShowS
showsPrec :: Int -> Lz4FrameDecompressionContext -> ShowS
$cshow :: Lz4FrameDecompressionContext -> String
show :: Lz4FrameDecompressionContext -> String
$cshowList :: [Lz4FrameDecompressionContext] -> ShowS
showList :: [Lz4FrameDecompressionContext] -> ShowS
Show)


handleLz4Error :: (HasCallStack, MonadUnliftIO m) => IO CSize -> m CSize
handleLz4Error :: forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error IO CSize
f = do
  CSize
ret <- IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CSize
f
  -- We use an unsafe foreign call here so that it's fast (it cannot block).
  Ptr CChar
staticErrMsgPtr <- IO (Ptr CChar) -> m (Ptr CChar)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO [CUnsafe.exp| const char * {
    LZ4F_isError($(size_t ret))
      ? LZ4F_getErrorName($(size_t ret))
      : NULL
  } |]
  if Ptr CChar
staticErrMsgPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
    then CSize -> m CSize
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
ret
    else do
      -- LZ4F error strings are static memory so they don't need to be GC'd,
      -- so we should use `unsafePackCString` here.
      ByteString
errMsgBs <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO ByteString
unsafePackCString Ptr CChar
staticErrMsgPtr
      String -> m CSize
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String
"lz4frame error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS8.unpack ByteString
errMsgBs)


C.verbatim [r|
void haskell_lz4_freeCompressionContext(LZ4F_cctx** ctxPtr)
{
  // We know ctxPtr can be dereferenced because it was created with
  // mallocForeignPtr, so it is always pointing to something valid
  // during the lifetime of the ForeignPtr (and this function is
  // a finalizer function, which is called only at the very end
  // inside this lifetime).
  LZ4F_cctx* ctx = *ctxPtr;
  // See note [Initialize LZ4 context pointer to NULL]:
  // If ctx is null, we never made a successful call to
  // LZ4F_createCompressionContext().
  // Note at the time of writing the implementation of
  // LZ4F_createCompressionContext() handles null pointers gracefully,
  // but that is an undocumented implementation detail so we don't
  // rely on it here.
  if (ctx != NULL)
  {
    size_t err = LZ4F_freeCompressionContext(ctx);
    if (LZ4F_isError(err))
    {
      fprintf(stderr, "LZ4F_freeCompressionContext failed: %s\n", LZ4F_getErrorName(err));
      exit(1);
    }
  }
}
|]

foreign import ccall "&haskell_lz4_freeCompressionContext" haskell_lz4_freeCompressionContext :: FunPtr (Ptr (Ptr LZ4F_cctx) -> IO ())


allocateLz4fScopedCompressionContext :: IO ScopedLz4FrameCompressionContext
allocateLz4fScopedCompressionContext :: IO ScopedLz4FrameCompressionContext
allocateLz4fScopedCompressionContext = do
  (Ptr (Ptr LZ4F_cctx) -> IO ScopedLz4FrameCompressionContext)
-> IO ScopedLz4FrameCompressionContext
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr LZ4F_cctx) -> IO ScopedLz4FrameCompressionContext)
 -> IO ScopedLz4FrameCompressionContext)
-> (Ptr (Ptr LZ4F_cctx) -> IO ScopedLz4FrameCompressionContext)
-> IO ScopedLz4FrameCompressionContext
forall a b. (a -> b) -> a -> b
$ \(Ptr (Ptr LZ4F_cctx)
ctxPtrPtr :: Ptr (Ptr LZ4F_cctx)) -> do
    CSize
_ <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
      LZ4F_cctx** ctxPtr = $(LZ4F_cctx** ctxPtrPtr);
      LZ4F_errorCode_t err = LZ4F_createCompressionContext(ctxPtr, LZ4F_VERSION);
      return err;
    } |]
    Ptr LZ4F_cctx
ctxPtr <- Ptr (Ptr LZ4F_cctx) -> IO (Ptr LZ4F_cctx)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr LZ4F_cctx)
ctxPtrPtr
    ScopedLz4FrameCompressionContext
-> IO ScopedLz4FrameCompressionContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr LZ4F_cctx -> ScopedLz4FrameCompressionContext
ScopedLz4FrameCompressionContext Ptr LZ4F_cctx
ctxPtr)


freeLz4ScopedCompressionContext :: ScopedLz4FrameCompressionContext -> IO ()
freeLz4ScopedCompressionContext :: ScopedLz4FrameCompressionContext -> IO ()
freeLz4ScopedCompressionContext (ScopedLz4FrameCompressionContext Ptr LZ4F_cctx
ctxPtr) = do
  CSize
_ <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error
    [C.block| size_t {
      return LZ4F_freeCompressionContext($(LZ4F_cctx* ctxPtr));
    } |]
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


withScopedLz4fCompressionContext :: (HasCallStack) => (ScopedLz4FrameCompressionContext -> IO a) -> IO a
withScopedLz4fCompressionContext :: forall a.
HasCallStack =>
(ScopedLz4FrameCompressionContext -> IO a) -> IO a
withScopedLz4fCompressionContext ScopedLz4FrameCompressionContext -> IO a
f =
  IO ScopedLz4FrameCompressionContext
-> (ScopedLz4FrameCompressionContext -> IO ())
-> (ScopedLz4FrameCompressionContext -> IO a)
-> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    IO ScopedLz4FrameCompressionContext
allocateLz4fScopedCompressionContext
    ScopedLz4FrameCompressionContext -> IO ()
freeLz4ScopedCompressionContext
    ScopedLz4FrameCompressionContext -> IO a
f


lz4fCreateCompressonContext :: (HasCallStack) => IO Lz4FrameCompressionContext
lz4fCreateCompressonContext :: HasCallStack => IO Lz4FrameCompressionContext
lz4fCreateCompressonContext = do
  ForeignPtr (Ptr LZ4F_cctx)
ctxForeignPtr :: ForeignPtr (Ptr LZ4F_cctx) <- IO (ForeignPtr (Ptr LZ4F_cctx))
forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
  -- Note [Initialize LZ4 context pointer to NULL]:
  -- We explicitly set it to NULL so that in the finalizer we know
  -- whether there is a context to free or not.
  ForeignPtr (Ptr LZ4F_cctx)
-> (Ptr (Ptr LZ4F_cctx) -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (Ptr LZ4F_cctx)
ctxForeignPtr ((Ptr (Ptr LZ4F_cctx) -> IO ()) -> IO ())
-> (Ptr (Ptr LZ4F_cctx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr LZ4F_cctx)
ptr -> Ptr (Ptr LZ4F_cctx) -> Ptr LZ4F_cctx -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr LZ4F_cctx)
ptr Ptr LZ4F_cctx
forall a. Ptr a
nullPtr

  -- Attach finalizer *before* we call LZ4F_createCompressionContext(),
  -- to ensure there cannot be a time where the context was created
  -- but not finalizer is attached (receiving an async exception at
  -- that time would make us leak memory).
  FinalizerPtr (Ptr LZ4F_cctx) -> ForeignPtr (Ptr LZ4F_cctx) -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr (Ptr LZ4F_cctx)
haskell_lz4_freeCompressionContext ForeignPtr (Ptr LZ4F_cctx)
ctxForeignPtr
  -- TODO The whole idea above is to avoid `mask`.
  --      But we should check if `addForeignPtrFinalizer` itself is actually
  --      async exception safe; if not, this is pointless.

  CSize
_ <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
    LZ4F_cctx** ctxPtr = $fptr-ptr:(LZ4F_cctx** ctxForeignPtr);
    LZ4F_errorCode_t err = LZ4F_createCompressionContext(ctxPtr, LZ4F_VERSION);
    return err;
  } |]
  Lz4FrameCompressionContext -> IO Lz4FrameCompressionContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr (Ptr LZ4F_cctx) -> Lz4FrameCompressionContext
Lz4FrameCompressionContext ForeignPtr (Ptr LZ4F_cctx)
ctxForeignPtr)


lz4DefaultPreferences :: Preferences
lz4DefaultPreferences :: Preferences
lz4DefaultPreferences =
  Preferences
    { frameInfo :: FrameInfo
frameInfo = FrameInfo
      { blockSizeID :: BlockSizeID
blockSizeID = BlockSizeID
LZ4F_default
      , blockMode :: BlockMode
blockMode = BlockMode
LZ4F_blockLinked
      , contentChecksumFlag :: ContentChecksum
contentChecksumFlag = ContentChecksum
LZ4F_noContentChecksum
      , frameType :: FrameType
frameType = FrameType
LZ4F_frame
      , contentSize :: Word64
contentSize = Word64
0
      , dictID :: Word32
dictID = Word32
0
      , blockChecksumFlag :: BlockChecksum
blockChecksumFlag = BlockChecksum
LZ4F_noBlockChecksum
      }
    , compressionLevel :: Int
compressionLevel = Int
0
    , autoFlush :: Bool
autoFlush = Bool
False
    , favorDecSpeed :: Bool
favorDecSpeed = Bool
False
    }


newForeignPtr :: (Storable a) => a -> IO (ForeignPtr a)
newForeignPtr :: forall a. Storable a => a -> IO (ForeignPtr a)
newForeignPtr a
x = do
  ForeignPtr a
fptr <- IO (ForeignPtr a)
forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
  ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fptr ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x
  ForeignPtr a -> IO (ForeignPtr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr a
fptr


lz4fCreatePreferences :: IO Lz4FramePreferencesPtr
lz4fCreatePreferences :: IO Lz4FramePreferencesPtr
lz4fCreatePreferences =
  ForeignPtr Preferences -> Lz4FramePreferencesPtr
Lz4FramePreferencesPtr (ForeignPtr Preferences -> Lz4FramePreferencesPtr)
-> IO (ForeignPtr Preferences) -> IO Lz4FramePreferencesPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Preferences -> IO (ForeignPtr Preferences)
forall a. Storable a => a -> IO (ForeignPtr a)
newForeignPtr Preferences
lz4DefaultPreferences


withScopedLz4fPreferences :: (HasCallStack) => (ScopedLz4FramePreferencesPtr -> IO a) -> IO a
withScopedLz4fPreferences :: forall a.
HasCallStack =>
(ScopedLz4FramePreferencesPtr -> IO a) -> IO a
withScopedLz4fPreferences ScopedLz4FramePreferencesPtr -> IO a
f =
  IO ScopedLz4FramePreferencesPtr
-> (ScopedLz4FramePreferencesPtr -> IO ())
-> (ScopedLz4FramePreferencesPtr -> IO a)
-> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (Ptr Preferences -> ScopedLz4FramePreferencesPtr
ScopedLz4FramePreferencesPtr (Ptr Preferences -> ScopedLz4FramePreferencesPtr)
-> IO (Ptr Preferences) -> IO ScopedLz4FramePreferencesPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Preferences -> IO (Ptr Preferences)
forall a. Storable a => a -> IO (Ptr a)
new Preferences
lz4DefaultPreferences)
    (\(ScopedLz4FramePreferencesPtr Ptr Preferences
ptr) -> Ptr Preferences -> IO ()
forall a. Ptr a -> IO ()
free Ptr Preferences
ptr)
    ScopedLz4FramePreferencesPtr -> IO a
f


lz4fCompressBegin :: (HasCallStack) => ScopedLz4FrameCompressionContext -> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
lz4fCompressBegin :: HasCallStack =>
ScopedLz4FrameCompressionContext
-> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
lz4fCompressBegin (ScopedLz4FrameCompressionContext Ptr LZ4F_cctx
ctx) (ScopedLz4FramePreferencesPtr Ptr Preferences
prefsPtr) Ptr CChar
headerBuf CSize
headerBufLen = do
  CSize
headerSize <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {

    LZ4F_preferences_t* lz4_preferences_ptr = $(LZ4F_preferences_t* prefsPtr);

    size_t err_or_headerSize = LZ4F_compressBegin($(LZ4F_cctx* ctx), $(char* headerBuf), $(size_t headerBufLen), lz4_preferences_ptr);
    return err_or_headerSize;
  } |]

  CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
headerSize


lz4fCompressBound :: (HasCallStack) => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound :: HasCallStack => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound CSize
srcSize (ScopedLz4FramePreferencesPtr Ptr Preferences
prefsPtr) = do
  IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
    size_t err_or_frame_size = LZ4F_compressBound($(size_t srcSize), $(LZ4F_preferences_t* prefsPtr));
    return err_or_frame_size;
  } |]


-- | TODO allow passing in cOptPtr instead of NULL.
lz4fCompressUpdate :: (HasCallStack) => ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
lz4fCompressUpdate :: HasCallStack =>
ScopedLz4FrameCompressionContext
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
lz4fCompressUpdate (ScopedLz4FrameCompressionContext Ptr LZ4F_cctx
ctx) Ptr CChar
destBuf CSize
destBufLen Ptr CChar
srcBuf CSize
srcBufLen = do
  CSize
written <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
    size_t err_or_written = LZ4F_compressUpdate($(LZ4F_cctx* ctx), $(char* destBuf), $(size_t destBufLen), $(char* srcBuf), $(size_t srcBufLen), NULL);
    return err_or_written;
  } |]
  CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
written


-- | TODO allow passing in cOptPtr instead of NULL.
lz4fCompressEnd :: (HasCallStack) => ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
lz4fCompressEnd :: HasCallStack =>
ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
lz4fCompressEnd (ScopedLz4FrameCompressionContext Ptr LZ4F_cctx
ctx) Ptr CChar
footerBuf CSize
footerBufLen = do
  CSize
footerWritten <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
    size_t err_or_footerWritten = LZ4F_compressEnd($(LZ4F_cctx* ctx), $(char* footerBuf), $(size_t footerBufLen), NULL);
    return err_or_footerWritten;
  } |]
  CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
footerWritten


-- | Note [Single call to LZ4F_compressUpdate() can create multiple blocks]
-- A single call to LZ4F_compressUpdate() can create multiple blocks,
-- and handles buffers > 32-bit sizes; see:
--   https://github.com/lz4/lz4/blob/52cac9a97342641315c76cfb861206d6acd631a8/lib/lz4frame.c#L601
-- So we don't need to loop around LZ4F_compressUpdate() to compress
-- an arbitrarily large amount of input data, as long as the destination
-- buffer is large enough.


compress :: (MonadUnliftIO m, MonadResource m) => ConduitT ByteString ByteString m ()
compress :: forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
ConduitT ByteString ByteString m ()
compress = CSize -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
CSize -> ConduitT ByteString ByteString m ()
compressWithOutBufferSize CSize
0


withLz4CtxAndPrefsConduit ::
  (MonadUnliftIO m, MonadResource m)
  => ((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr) -> ConduitT i o m r)
  -> ConduitT i o m r
withLz4CtxAndPrefsConduit :: forall (m :: * -> *) i o r.
(MonadUnliftIO m, MonadResource m) =>
((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
 -> ConduitT i o m r)
-> ConduitT i o m r
withLz4CtxAndPrefsConduit (ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT i o m r
f = IO (ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ((ScopedLz4FrameCompressionContext,
     ScopedLz4FramePreferencesPtr)
    -> IO ())
-> ((ScopedLz4FrameCompressionContext,
     ScopedLz4FramePreferencesPtr)
    -> ConduitT i o m r)
-> ConduitT i o m r
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
  (do
    ScopedLz4FrameCompressionContext
ctx <- IO ScopedLz4FrameCompressionContext
allocateLz4fScopedCompressionContext
    Ptr Preferences
prefPtr <- Preferences -> IO (Ptr Preferences)
forall a. Storable a => a -> IO (Ptr a)
new Preferences
lz4DefaultPreferences
    (ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> IO
     (ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScopedLz4FrameCompressionContext
ctx, Ptr Preferences -> ScopedLz4FramePreferencesPtr
ScopedLz4FramePreferencesPtr Ptr Preferences
prefPtr)
  )
  (\(ScopedLz4FrameCompressionContext
ctx, ScopedLz4FramePreferencesPtr Ptr Preferences
prefPtr) -> do
    ScopedLz4FrameCompressionContext -> IO ()
freeLz4ScopedCompressionContext ScopedLz4FrameCompressionContext
ctx
    Ptr Preferences -> IO ()
forall a. Ptr a -> IO ()
free Ptr Preferences
prefPtr
  )
  (ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
-> ConduitT i o m r
f


-- | Compresses the incoming stream of ByteStrings with the lz4 frame format.
--
-- Yields every LZ4 output as a ByteString as soon as the lz4 frame
-- library produces it.
--
-- Note that this does not imply ZL4 frame autoFlush (which affects
-- when the lz4 frame library produces outputs).
compressYieldImmediately :: (MonadUnliftIO m, MonadResource m) => ConduitT ByteString ByteString m ()
compressYieldImmediately :: forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
ConduitT ByteString ByteString m ()
compressYieldImmediately =
  ((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
 -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i o r.
(MonadUnliftIO m, MonadResource m) =>
((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
 -> ConduitT i o m r)
-> ConduitT i o m r
withLz4CtxAndPrefsConduit (((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
  -> ConduitT ByteString ByteString m ())
 -> ConduitT ByteString ByteString m ())
-> ((ScopedLz4FrameCompressionContext,
     ScopedLz4FramePreferencesPtr)
    -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ \(ScopedLz4FrameCompressionContext
ctx, ScopedLz4FramePreferencesPtr
prefs) -> do
    let _LZ4F_HEADER_SIZE_MAX :: CSize
_LZ4F_HEADER_SIZE_MAX = CSize
19
{-# LINE 368 "src/Codec/Compression/LZ4/Conduit.hsc" #-}

    -- Header

    ByteString
headerBs <- IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ConduitT ByteString ByteString m ByteString)
-> IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
_LZ4F_HEADER_SIZE_MAX) ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
headerBuf -> do
      CSize
headerSize <- HasCallStack =>
ScopedLz4FrameCompressionContext
-> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext
-> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
lz4fCompressBegin ScopedLz4FrameCompressionContext
ctx ScopedLz4FramePreferencesPtr
prefs Ptr CChar
headerBuf CSize
_LZ4F_HEADER_SIZE_MAX
      CStringLen -> IO ByteString
packCStringLen (Ptr CChar
headerBuf, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
headerSize)

    ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
headerBs

    -- Chunks

    (ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((ByteString -> ConduitT ByteString ByteString m ())
 -> ConduitT ByteString ByteString m ())
-> (ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> do


      Maybe ByteString
m'outBs <- IO (Maybe ByteString)
-> ConduitT ByteString ByteString m (Maybe ByteString)
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString)
 -> ConduitT ByteString ByteString m (Maybe ByteString))
-> IO (Maybe ByteString)
-> ConduitT ByteString ByteString m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
bsPtr, Int
bsLen) -> do
        let bsLenSize :: CSize
bsLenSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bsLen

        CSize
size <- HasCallStack => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound CSize
bsLenSize ScopedLz4FramePreferencesPtr
prefs

        -- TODO Performance: Check if reusing this buffer obtained with `allocaBytes`
        --      makes it faster.
        --      LZ4F_compressBound() always returns a number > the block size (e.g. 256K),
        --      even when the input size passed to it is just a few bytes.
        --      As a result, we allocate at least a full block size each time
        --      (and `allocaBytes` calls `malloc()`), but not using most of it.
        --      Worse, with autoflush=0, most small inputs go into the context buffer,
        --      in which case the `allocaBytes` is completely wasted.
        --      This could be avoided by keeping the last `allocaBytes` buffer around,
        --      and reusing it if it is big enough for the number returned by
        --      LZ4F_compressUpdate() next time.
        --      That should avoid most allocations in the case that we `await` lots of
        --      small ByteStrings.
        Maybe ByteString
m'outBs <- IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> IO (Maybe ByteString))
-> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Int
-> (Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
size) ((Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> do

          -- See note [Single call to LZ4F_compressUpdate() can create multiple blocks].
          CSize
written <- HasCallStack =>
ScopedLz4FrameCompressionContext
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
lz4fCompressUpdate ScopedLz4FrameCompressionContext
ctx Ptr CChar
buf CSize
size Ptr CChar
bsPtr CSize
bsLenSize

          if CSize
written CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
== CSize
0 -- everything fit into the context buffer, no new compressed data was emitted
            then Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
            else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
packCStringLen (Ptr CChar
buf, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
written)

        Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
m'outBs

      case Maybe ByteString
m'outBs of
        Maybe ByteString
Nothing -> () -> ConduitT ByteString ByteString m ()
forall a. a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ByteString
outBs -> ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
outBs

    -- Footer

    -- Passing srcSize==0 provides bound for LZ4F_compressEnd(),
    -- see docs of LZ4F_compressBound() for that.
    CSize
footerSize <- IO CSize -> ConduitT ByteString ByteString m CSize
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> ConduitT ByteString ByteString m CSize)
-> IO CSize -> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ HasCallStack => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound CSize
0 ScopedLz4FramePreferencesPtr
prefs

    ByteString
footerBs <- IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ConduitT ByteString ByteString m ByteString)
-> IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
footerSize) ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
footerBuf -> do
      CSize
footerWritten <- HasCallStack =>
ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
lz4fCompressEnd ScopedLz4FrameCompressionContext
ctx Ptr CChar
footerBuf CSize
footerSize
      CStringLen -> IO ByteString
packCStringLen (Ptr CChar
footerBuf, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
footerWritten)

    ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
footerBs


bsChunksOf :: Int -> ByteString -> [ByteString]
bsChunksOf :: Int -> ByteString -> [ByteString]
bsChunksOf Int
chunkSize ByteString
bs
  | Int
chunkSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> [ByteString]
forall a. HasCallStack => String -> a
error (String -> [ByteString]) -> String -> [ByteString]
forall a b. (a -> b) -> a -> b
$ String
"bsChunksOf: chunkSize < 1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
chunkSize
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
chunkSize = [ByteString
bs]
  | Bool
otherwise =
      let (ByteString
x, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
chunkSize ByteString
bs in ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> ByteString -> [ByteString]
bsChunksOf Int
chunkSize ByteString
rest


-- | Compresses the incoming stream of ByteStrings with the lz4 frame format.
--
-- This function implements two optimisations to reduce unnecessary
-- allocations:
--
-- * Incoming ByteStrings are processed in blocks of 16 KB, allowing us
--   to use a single intermediate output buffer through the lifetime of
--   the conduit.
-- * The `bufferSize` of the output buffer can controlled by the caller
--   via the `bufferSize` argument, to reduce the number of small
--   `ByteString`s being `yield`ed (especially in the case that the
--   input data compresses very well, e.g. a stream of zeros).
--
-- Note that the given `bufferSize` is not a hard limit, it can only be
-- used to *increase* the amount of output buffer we're allowed to use:
-- The function will choose `max(bufferSize, minBufferSizeNeededByLz4)`
-- as the eventual output buffer size.
--
-- Setting `bufferSize = 0` is the legitimate way to set the output buffer
-- size to be the minimum required to compress 16 KB inputs and is still a
-- fast default.
compressWithOutBufferSize :: forall m . (MonadUnliftIO m, MonadResource m) => CSize -> ConduitT ByteString ByteString m ()
compressWithOutBufferSize :: forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
CSize -> ConduitT ByteString ByteString m ()
compressWithOutBufferSize CSize
bufferSize =
  ((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
 -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i o r.
(MonadUnliftIO m, MonadResource m) =>
((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
 -> ConduitT i o m r)
-> ConduitT i o m r
withLz4CtxAndPrefsConduit (((ScopedLz4FrameCompressionContext, ScopedLz4FramePreferencesPtr)
  -> ConduitT ByteString ByteString m ())
 -> ConduitT ByteString ByteString m ())
-> ((ScopedLz4FrameCompressionContext,
     ScopedLz4FramePreferencesPtr)
    -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ \(ScopedLz4FrameCompressionContext
ctx, ScopedLz4FramePreferencesPtr
prefs) -> do

    -- We split any incoming ByteString into chunks of this size, so that
    -- we can pass this size to `lz4fCompressBound` once and reuse a buffer
    -- of constant size for the compression.
    let bsInChunkSize :: CSize
bsInChunkSize = CSize
16CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
*CSize
1024

    CSize
compressBound <- IO CSize -> ConduitT ByteString ByteString m CSize
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> ConduitT ByteString ByteString m CSize)
-> IO CSize -> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ HasCallStack => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound (CSize
19 CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CSize
bsInChunkSize) ScopedLz4FramePreferencesPtr
prefs
{-# LINE 467 "src/Codec/Compression/LZ4/Conduit.hsc" #-}
    let outBufferSize = max bufferSize compressBound

    ForeignPtr CChar
outBuf <- IO (ForeignPtr CChar)
-> ConduitT ByteString ByteString m (ForeignPtr CChar)
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ForeignPtr CChar)
 -> ConduitT ByteString ByteString m (ForeignPtr CChar))
-> IO (ForeignPtr CChar)
-> ConduitT ByteString ByteString m (ForeignPtr CChar)
forall a b. (a -> b) -> a -> b
$ Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
outBufferSize)
    let withOutBuf :: (Ptr CChar -> IO a) -> m a
withOutBuf Ptr CChar -> IO a
f = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar -> (Ptr CChar -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
outBuf Ptr CChar -> IO a
f
    let yieldOutBuf :: a -> ConduitT i ByteString m ()
yieldOutBuf a
outBufLen = do
          ByteString
outBs <- (Ptr CChar -> IO ByteString) -> ConduitT i ByteString m ByteString
forall {m :: * -> *} {a}. MonadIO m => (Ptr CChar -> IO a) -> m a
withOutBuf ((Ptr CChar -> IO ByteString)
 -> ConduitT i ByteString m ByteString)
-> (Ptr CChar -> IO ByteString)
-> ConduitT i ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> CStringLen -> IO ByteString
packCStringLen (Ptr CChar
buf, a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
outBufLen)
          ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
outBs

    CSize
headerSize <- (Ptr CChar -> IO CSize) -> ConduitT ByteString ByteString m CSize
forall {m :: * -> *} {a}. MonadIO m => (Ptr CChar -> IO a) -> m a
withOutBuf ((Ptr CChar -> IO CSize) -> ConduitT ByteString ByteString m CSize)
-> (Ptr CChar -> IO CSize)
-> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> HasCallStack =>
ScopedLz4FrameCompressionContext
-> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext
-> ScopedLz4FramePreferencesPtr -> Ptr CChar -> CSize -> IO CSize
lz4fCompressBegin ScopedLz4FrameCompressionContext
ctx ScopedLz4FramePreferencesPtr
prefs Ptr CChar
buf CSize
outBufferSize

    let writeFooterAndYield :: CSize -> ConduitT i ByteString m ()
writeFooterAndYield CSize
remainingCapacity = do
          let offset :: Int
offset = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> CSize -> Int
forall a b. (a -> b) -> a -> b
$ CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
remainingCapacity
          CSize
footerWritten <- (Ptr CChar -> IO CSize) -> ConduitT i ByteString m CSize
forall {m :: * -> *} {a}. MonadIO m => (Ptr CChar -> IO a) -> m a
withOutBuf ((Ptr CChar -> IO CSize) -> ConduitT i ByteString m CSize)
-> (Ptr CChar -> IO CSize) -> ConduitT i ByteString m CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> HasCallStack =>
ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext -> Ptr CChar -> CSize -> IO CSize
lz4fCompressEnd ScopedLz4FrameCompressionContext
ctx (Ptr CChar
buf Ptr CChar -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset) CSize
remainingCapacity
          let outBufLen :: CSize
outBufLen = CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
remainingCapacity CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CSize
footerWritten
          CSize -> ConduitT i ByteString m ()
forall {m :: * -> *} {a} {i}.
(MonadIO m, Integral a) =>
a -> ConduitT i ByteString m ()
yieldOutBuf CSize
outBufLen

    let loop :: CSize -> ConduitT ByteString ByteString m ()
loop CSize
remainingCapacity = do
          ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe ByteString
Nothing -> do
              -- Done, write footer.

              -- Passing srcSize==0 provides bound for LZ4F_compressEnd(),
              -- see docs of LZ4F_compressBound() for that.
              CSize
footerSize <- IO CSize -> ConduitT ByteString ByteString m CSize
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> ConduitT ByteString ByteString m CSize)
-> IO CSize -> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ HasCallStack => CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
CSize -> ScopedLz4FramePreferencesPtr -> IO CSize
lz4fCompressBound CSize
0 ScopedLz4FramePreferencesPtr
prefs

              if CSize
remainingCapacity CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
>= CSize
footerSize
                then do
                  CSize -> ConduitT ByteString ByteString m ()
forall {m :: * -> *} {i}.
MonadIO m =>
CSize -> ConduitT i ByteString m ()
writeFooterAndYield CSize
remainingCapacity
                else do
                  -- Footer doesn't fit: Yield buffer, put footer into now-free buffer
                  CSize -> ConduitT ByteString ByteString m ()
forall {m :: * -> *} {a} {i}.
(MonadIO m, Integral a) =>
a -> ConduitT i ByteString m ()
yieldOutBuf (CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
remainingCapacity)
                  CSize -> ConduitT ByteString ByteString m ()
forall {m :: * -> *} {i}.
MonadIO m =>
CSize -> ConduitT i ByteString m ()
writeFooterAndYield CSize
outBufferSize

            Just ByteString
bs -> do
              let bss :: [ByteString]
bss = Int -> ByteString -> [ByteString]
bsChunksOf (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
bsInChunkSize) ByteString
bs
              CSize
newRemainingCapacity <- (CSize -> ByteString -> ConduitT ByteString ByteString m CSize)
-> CSize -> [ByteString] -> ConduitT ByteString ByteString m CSize
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM CSize -> ByteString -> ConduitT ByteString ByteString m CSize
forall i. CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBs CSize
remainingCapacity [ByteString]
bss
              CSize -> ConduitT ByteString ByteString m ()
loop CSize
newRemainingCapacity

        compressSingleBs :: CSize -> ByteString -> ConduitM i ByteString m CSize
        compressSingleBs :: forall i. CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBs CSize
remainingCapacity ByteString
bs
          | CSize
remainingCapacity CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
< CSize
compressBound = do
              -- Not enough space in outBuf to guarantee that the next call
              -- to `lz4fCompressUpdate` will fit; so yield (a copy of) the
              -- current outBuf, then it's all free again.
              CSize -> ConduitT i ByteString m ()
forall {m :: * -> *} {a} {i}.
(MonadIO m, Integral a) =>
a -> ConduitT i ByteString m ()
yieldOutBuf (CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
remainingCapacity)
              CSize -> ByteString -> ConduitM i ByteString m CSize
forall i. CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBsFitting CSize
outBufferSize ByteString
bs
          | Bool
otherwise = do
              CSize -> ByteString -> ConduitM i ByteString m CSize
forall i. CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBsFitting CSize
remainingCapacity ByteString
bs

        compressSingleBsFitting :: CSize -> ByteString -> ConduitM i ByteString m CSize
        compressSingleBsFitting :: forall i. CSize -> ByteString -> ConduitM i ByteString m CSize
compressSingleBsFitting CSize
remainingCapacity ByteString
bs = do
          Bool -> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
remainingCapacity CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
< CSize
compressBound) (ConduitT i ByteString m () -> ConduitT i ByteString m ())
-> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall a b. (a -> b) -> a -> b
$ String -> ConduitT i ByteString m ()
forall a. HasCallStack => String -> a
error String
"precondition violated"

          CSize
written <- IO CSize -> ConduitM i ByteString m CSize
forall a. IO a -> ConduitT i ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> ConduitM i ByteString m CSize)
-> IO CSize -> ConduitM i ByteString m CSize
forall a b. (a -> b) -> a -> b
$ ByteString -> (CStringLen -> IO CSize) -> IO CSize
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO CSize) -> IO CSize)
-> (CStringLen -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
bsPtr, Int
bsLen) -> do
            let bsLenSize :: CSize
bsLenSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bsLen

            -- See note [Single call to LZ4F_compressUpdate() can create multiple blocks]
            let offset :: Int
offset = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> CSize -> Int
forall a b. (a -> b) -> a -> b
$ CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
remainingCapacity
            (Ptr CChar -> IO CSize) -> IO CSize
forall {m :: * -> *} {a}. MonadIO m => (Ptr CChar -> IO a) -> m a
withOutBuf ((Ptr CChar -> IO CSize) -> IO CSize)
-> (Ptr CChar -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> HasCallStack =>
ScopedLz4FrameCompressionContext
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
ScopedLz4FrameCompressionContext
-> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO CSize
lz4fCompressUpdate ScopedLz4FrameCompressionContext
ctx (Ptr CChar
buf Ptr CChar -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset) CSize
remainingCapacity Ptr CChar
bsPtr CSize
bsLenSize

          Bool -> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
written CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
remainingCapacity) (ConduitT i ByteString m () -> ConduitT i ByteString m ())
-> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall a b. (a -> b) -> a -> b
$ do -- sanity check
            String -> ConduitT i ByteString m ()
forall a. HasCallStack => String -> a
error (String -> ConduitT i ByteString m ())
-> String -> ConduitT i ByteString m ()
forall a b. (a -> b) -> a -> b
$ String
"lz4fCompressUpdate wrote past buffer: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (CSize, CSize) -> String
forall a. Show a => a -> String
show (CSize
written, CSize
remainingCapacity)

          let newRemainingCapacity :: CSize
newRemainingCapacity = CSize
remainingCapacity CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
written
          CSize -> ConduitM i ByteString m CSize
forall a. a -> ConduitT i ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
newRemainingCapacity

    CSize -> ConduitT ByteString ByteString m ()
loop (CSize
outBufferSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
headerSize)




-- | All notes that apply to `haskell_lz4_freeCompressionContext` apply here as well.
C.verbatim [r|
void haskell_lz4_freeDecompressionContext(LZ4F_dctx** ctxPtr)
{
  LZ4F_dctx* ctx = *ctxPtr;
  if (ctx != NULL)
  {
    size_t err = LZ4F_freeDecompressionContext(ctx);
    if (LZ4F_isError(err))
    {
      fprintf(stderr, "LZ4F_freeDecompressionContext failed: %s\n", LZ4F_getErrorName(err));
      exit(1);
    }
  }
}
|]

foreign import ccall "&haskell_lz4_freeDecompressionContext" haskell_lz4_freeDecompressionContext :: FunPtr (Ptr (Ptr LZ4F_dctx) -> IO ())


-- | All notes that apply to `lz4fCreateCompressonContext` apply here as well.
lz4fCreateDecompressionContext :: (HasCallStack) => IO Lz4FrameDecompressionContext
lz4fCreateDecompressionContext :: HasCallStack => IO Lz4FrameDecompressionContext
lz4fCreateDecompressionContext = do
  ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr :: ForeignPtr (Ptr LZ4F_dctx) <- IO (ForeignPtr (Ptr LZ4F_dctx))
forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
  ForeignPtr (Ptr LZ4F_dctx)
-> (Ptr (Ptr LZ4F_dctx) -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr ((Ptr (Ptr LZ4F_dctx) -> IO ()) -> IO ())
-> (Ptr (Ptr LZ4F_dctx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr LZ4F_dctx)
ptr -> Ptr (Ptr LZ4F_dctx) -> Ptr LZ4F_dctx -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr LZ4F_dctx)
ptr Ptr LZ4F_dctx
forall a. Ptr a
nullPtr

  FinalizerPtr (Ptr LZ4F_dctx) -> ForeignPtr (Ptr LZ4F_dctx) -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr (Ptr LZ4F_dctx)
haskell_lz4_freeDecompressionContext ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr

  CSize
_ <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
    LZ4F_dctx** ctxPtr = $fptr-ptr:(LZ4F_dctx** ctxForeignPtr);
    LZ4F_errorCode_t err = LZ4F_createDecompressionContext(ctxPtr, LZ4F_VERSION);
    return err;
  } |]
  Lz4FrameDecompressionContext -> IO Lz4FrameDecompressionContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr (Ptr LZ4F_dctx) -> Lz4FrameDecompressionContext
Lz4FrameDecompressionContext ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr)


lz4fGetFrameInfo :: (HasCallStack) => Lz4FrameDecompressionContext -> Ptr FrameInfo -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fGetFrameInfo :: HasCallStack =>
Lz4FrameDecompressionContext
-> Ptr FrameInfo -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fGetFrameInfo (Lz4FrameDecompressionContext ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr) Ptr FrameInfo
frameInfoPtr Ptr CChar
srcBuffer Ptr CSize
srcSizePtr = do

  CSize
decompressSizeHint <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
    LZ4F_dctx* ctxPtr = *$fptr-ptr:(LZ4F_dctx** ctxForeignPtr);
    LZ4F_errorCode_t err_or_decompressSizeHint = LZ4F_getFrameInfo(ctxPtr, $(LZ4F_frameInfo_t* frameInfoPtr), $(char* srcBuffer), $(size_t* srcSizePtr));
    return err_or_decompressSizeHint;
  } |]
  CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
decompressSizeHint


-- TODO allow passing in dOptPtr instead of NULL.
lz4fDecompress :: (HasCallStack) => Lz4FrameDecompressionContext -> Ptr CChar -> Ptr CSize -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fDecompress :: HasCallStack =>
Lz4FrameDecompressionContext
-> Ptr CChar -> Ptr CSize -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fDecompress (Lz4FrameDecompressionContext ForeignPtr (Ptr LZ4F_dctx)
ctxForeignPtr) Ptr CChar
dstBuffer Ptr CSize
dstSizePtr Ptr CChar
srcBuffer Ptr CSize
srcSizePtr = do

  CSize
decompressSizeHint <- IO CSize -> IO CSize
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
IO CSize -> m CSize
handleLz4Error [C.block| size_t {
    LZ4F_dctx* ctxPtr = *$fptr-ptr:(LZ4F_dctx** ctxForeignPtr);
    LZ4F_errorCode_t err_or_decompressSizeHint = LZ4F_decompress(ctxPtr, $(char* dstBuffer), $(size_t* dstSizePtr), $(char* srcBuffer), $(size_t* srcSizePtr), NULL);
    return err_or_decompressSizeHint;
  } |]
  CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
decompressSizeHint


-- | TODO check why decompressSizeHint is always 4
decompress :: forall m . (MonadUnliftIO m, MonadResource m) => ConduitT ByteString ByteString m ()
decompress :: forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
ConduitT ByteString ByteString m ()
decompress = do
  Lz4FrameDecompressionContext
ctx <- IO Lz4FrameDecompressionContext
-> ConduitT ByteString ByteString m Lz4FrameDecompressionContext
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Lz4FrameDecompressionContext
HasCallStack => IO Lz4FrameDecompressionContext
lz4fCreateDecompressionContext

  -- OK, now here it gets a bit ugly.
  -- The lz4frame library provides no function with which we can
  -- determine how large the header is.
  -- It depends on the "Content Size" bit in the "FLG" Byte (first
  -- Byte of the frame descriptor, just after the 4 Byte magic number).
  -- As a solution, we `await` the first 5 Bytes, look at the relevant
  -- bit in the FLG Byte and thus decide how many more bytes to await
  -- for the header.
  -- Is ugly because ideally we would rely only on the lz4frame API
  -- and not on the spec of the frame format, but we have no other
  -- choice in this case.

  ByteString
first5Bytes <- Int -> ConduitT ByteString ByteString m ByteString
forall (m :: * -> *) o.
Monad m =>
Int -> ConduitT ByteString o m ByteString
CB.take Int
5
  Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int64
BSL.length ByteString
first5Bytes Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
5) (ConduitT ByteString ByteString m ()
 -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> ConduitT ByteString ByteString m ())
-> String -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ String
"lz4 decompress error: not enough bytes for header; expected 5, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show (ByteString -> Int64
BSL.length ByteString
first5Bytes)

  let byteFLG :: Word8
byteFLG = HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
BSL.index ByteString
first5Bytes Int64
4
  let contentSizeBit :: Bool
contentSizeBit = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byteFLG Int
3

  let numRemainingHeaderBytes :: Int
numRemainingHeaderBytes
        | Bool
contentSizeBit = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8
        | Bool
otherwise      = Int
2

  ByteString
remainingHeaderBytes <- Int -> ConduitT ByteString ByteString m ByteString
forall (m :: * -> *) o.
Monad m =>
Int -> ConduitT ByteString o m ByteString
CB.take Int
numRemainingHeaderBytes

  let headerBs :: ByteString
headerBs = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BSL.concat [ByteString
first5Bytes, ByteString
remainingHeaderBytes]

  CSize
headerDecompressSizeHint <- IO CSize -> ConduitT ByteString ByteString m CSize
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> ConduitT ByteString ByteString m CSize)
-> IO CSize -> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ (Ptr FrameInfo -> IO CSize) -> IO CSize
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr FrameInfo -> IO CSize) -> IO CSize)
-> (Ptr FrameInfo -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr FrameInfo
frameInfoPtr -> do
    ByteString -> (CStringLen -> IO CSize) -> IO CSize
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
headerBs ((CStringLen -> IO CSize) -> IO CSize)
-> (CStringLen -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
headerBsPtr, Int
headerBsLen) -> do
      CSize -> (Ptr CSize -> IO CSize) -> IO CSize
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
headerBsLen :: CSize) ((Ptr CSize -> IO CSize) -> IO CSize)
-> (Ptr CSize -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
headerBsLenPtr -> do
        HasCallStack =>
Lz4FrameDecompressionContext
-> Ptr FrameInfo -> Ptr CChar -> Ptr CSize -> IO CSize
Lz4FrameDecompressionContext
-> Ptr FrameInfo -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fGetFrameInfo Lz4FrameDecompressionContext
ctx Ptr FrameInfo
frameInfoPtr Ptr CChar
headerBsPtr Ptr CSize
headerBsLenPtr

  let dstBufferSizeDefault :: CSize
      dstBufferSizeDefault :: CSize
dstBufferSizeDefault = CSize
16 CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
* CSize
1024

  IO (Ptr (Ptr CChar), Ptr CSize)
-> ((Ptr (Ptr CChar), Ptr CSize) -> IO ())
-> ((Ptr (Ptr CChar), Ptr CSize)
    -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
    (do
      Ptr (Ptr CChar)
dstBufferPtr <- IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
malloc
      Ptr CSize
dstBufferSizePtr <- IO (Ptr CSize)
forall a. Storable a => IO (Ptr a)
malloc
      Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
dstBufferPtr (Ptr CChar -> IO ()) -> IO (Ptr CChar) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO (Ptr CChar)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
dstBufferSizeDefault)
      Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
dstBufferSizePtr CSize
dstBufferSizeDefault
      (Ptr (Ptr CChar), Ptr CSize) -> IO (Ptr (Ptr CChar), Ptr CSize)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr (Ptr CChar)
dstBufferPtr, Ptr CSize
dstBufferSizePtr)
    )
    (\(Ptr (Ptr CChar)
dstBufferPtr, Ptr CSize
dstBufferSizePtr) -> do
      Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free (Ptr CChar -> IO ()) -> IO (Ptr CChar) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
dstBufferPtr
      Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
free Ptr (Ptr CChar)
dstBufferPtr
      Ptr CSize -> IO ()
forall a. Ptr a -> IO ()
free Ptr CSize
dstBufferSizePtr
    )
    (((Ptr (Ptr CChar), Ptr CSize)
  -> ConduitT ByteString ByteString m ())
 -> ConduitT ByteString ByteString m ())
-> ((Ptr (Ptr CChar), Ptr CSize)
    -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ \(Ptr (Ptr CChar)
dstBufferPtr, Ptr CSize
dstBufferSizePtr) -> do

    let ensureDstBufferSize :: CSize -> IO (Ptr CChar)
        ensureDstBufferSize :: CSize -> IO (Ptr CChar)
ensureDstBufferSize CSize
size = do
          CSize
dstBufferSize <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
dstBufferSizePtr
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
size CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
dstBufferSize) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Ptr CChar
dstBuffer <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
dstBufferPtr
            Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
dstBufferPtr (Ptr CChar -> IO ()) -> IO (Ptr CChar) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CChar -> Int -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray Ptr CChar
dstBuffer (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
size)
            Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
dstBufferSizePtr CSize
size
          Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
dstBufferPtr

    let loopSingleBs :: CSize -> ByteString -> ConduitT ByteString ByteString m CSize
        loopSingleBs :: CSize -> ByteString -> ConduitT ByteString ByteString m CSize
loopSingleBs CSize
decompressSizeHint ByteString
bs = do
          (ByteString
outBs, CSize
srcRead, CSize
newDecompressSizeHint) <- IO (ByteString, CSize, CSize)
-> ConduitT ByteString ByteString m (ByteString, CSize, CSize)
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ByteString, CSize, CSize)
 -> ConduitT ByteString ByteString m (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
-> ConduitT ByteString ByteString m (ByteString, CSize, CSize)
forall a b. (a -> b) -> a -> b
$
            ByteString
-> (CStringLen -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (ByteString, CSize, CSize))
 -> IO (ByteString, CSize, CSize))
-> (CStringLen -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
srcBuffer, Int
srcSize) -> do
              let outBufSize :: CSize
outBufSize = CSize -> CSize -> CSize
forall a. Ord a => a -> a -> a
max CSize
decompressSizeHint CSize
dstBufferSizeDefault -- TODO check why decompressSizeHint is always 4

              -- Increase destination buffer size if necessary.
              Ptr CChar
dstBuffer <- CSize -> IO (Ptr CChar)
ensureDstBufferSize CSize
outBufSize

              CSize
-> (Ptr CSize -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CSize
outBufSize ((Ptr CSize -> IO (ByteString, CSize, CSize))
 -> IO (ByteString, CSize, CSize))
-> (Ptr CSize -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
dstSizePtr -> do
                CSize
-> (Ptr CSize -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcSize :: CSize) ((Ptr CSize -> IO (ByteString, CSize, CSize))
 -> IO (ByteString, CSize, CSize))
-> (Ptr CSize -> IO (ByteString, CSize, CSize))
-> IO (ByteString, CSize, CSize)
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
srcSizePtr -> do
                  CSize
newDecompressSizeHint <-
                    HasCallStack =>
Lz4FrameDecompressionContext
-> Ptr CChar -> Ptr CSize -> Ptr CChar -> Ptr CSize -> IO CSize
Lz4FrameDecompressionContext
-> Ptr CChar -> Ptr CSize -> Ptr CChar -> Ptr CSize -> IO CSize
lz4fDecompress Lz4FrameDecompressionContext
ctx Ptr CChar
dstBuffer Ptr CSize
dstSizePtr Ptr CChar
srcBuffer Ptr CSize
srcSizePtr
                  CSize
srcRead <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
srcSizePtr
                  CSize
dstWritten <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
dstSizePtr
                  ByteString
outBs <- CStringLen -> IO ByteString
packCStringLen (Ptr CChar
dstBuffer, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
dstWritten)
                  (ByteString, CSize, CSize) -> IO (ByteString, CSize, CSize)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
outBs, CSize
srcRead, CSize
newDecompressSizeHint)

          ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
outBs

          let srcReadInt :: Int
srcReadInt = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
srcRead
          if
            | Int
srcReadInt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BS.length ByteString
bs -> CSize -> ByteString -> ConduitT ByteString ByteString m CSize
loopSingleBs CSize
newDecompressSizeHint (Int -> ByteString -> ByteString
BS.drop Int
srcReadInt ByteString
bs)
            | Int
srcReadInt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
BS.length ByteString
bs -> CSize -> ConduitT ByteString ByteString m CSize
forall a. a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
newDecompressSizeHint
            | Bool
otherwise -> String -> ConduitT ByteString ByteString m CSize
forall a. HasCallStack => String -> a
error (String -> ConduitT ByteString ByteString m CSize)
-> String -> ConduitT ByteString ByteString m CSize
forall a b. (a -> b) -> a -> b
$ String
"lz4 decompress: assertion failed: srcRead < BS.length bs: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (CSize, Int) -> String
forall a. Show a => a -> String
show (CSize
srcRead, ByteString -> Int
BS.length ByteString
bs)

    let loop :: CSize -> ConduitT ByteString ByteString m ()
loop CSize
decompressSizeHint =
          ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe ByteString
Nothing -> String -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> ConduitT ByteString ByteString m ())
-> String -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ String
"lz4 decompress error: stream ended before EndMark"
            Just ByteString
bs -> do
              CSize
newDecompressSizeHint <- CSize -> ByteString -> ConduitT ByteString ByteString m CSize
loopSingleBs CSize
decompressSizeHint ByteString
bs

              -- When a frame is fully decoded, LZ4F_decompress returns 0 (no more data expected),
              -- see https://github.com/lz4/lz4/blob/7cf0bb97b2a988cb17435780d19e145147dd9f70/lib/lz4frame.h#L324
              Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
newDecompressSizeHint CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
/= CSize
0) (ConduitT ByteString ByteString m ()
 -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ CSize -> ConduitT ByteString ByteString m ()
loop CSize
newDecompressSizeHint

    CSize -> ConduitT ByteString ByteString m ()
loop CSize
headerDecompressSizeHint

    -- Force resource release here to guarantee memory constantness
    -- of the conduit (and not rely on GC to do it "at some point in the future").
    IO () -> ConduitT ByteString ByteString m ()
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT ByteString ByteString m ())
-> IO () -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr (Ptr LZ4F_dctx) -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr (Lz4FrameDecompressionContext -> ForeignPtr (Ptr LZ4F_dctx)
unLz4FrameDecompressionContext Lz4FrameDecompressionContext
ctx)