{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Trustworthy        #-}

-- Copyright (C) 2016  Herbert Valerio Riedel
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- |
-- Module      : Codec.Compression.Brotli
-- Copyright   : © 2016 Herbert Valerio Riedel
--
-- Maintainer  : hvr@gnu.org
--
-- Compression and decompression of data streams in the \"Brotli\" format (<https://tools.ietf.org/html/rfc7932 RFC7932>)
--
module Codec.Compression.Brotli
    ( -- * Simple (de)compression with default parameters
      compress
    , decompress

    , BrotliException(..)

      -- * Extended API with control over parameters
    , compressWith
    , decompressWith

      -- * Monadic incremental (de)compression API
      --
      -- | See <http://hackage.haskell.org/package/zlib-0.6.1.1/docs/Codec-Compression-Zlib-Internal.html#g:2 zlib's incremental API documentation> for more information.

      -- ** Compression
    , CompressStream(..)
    , compressIO
    , compressST

      -- ** Decompression
    , DecompressStream(..)
    , decompressIO
    , decompressST

    , BrotliDecoderErrorCode(..)
    , showBrotliDecoderErrorCode

      -- * Parameters
      -- ** Compression parameters
    , defaultCompressParams

    , CompressParams
    , compressLevel
    , compressWindowSize
    , compressMode
    , compressSizeHint

    , CompressionLevel(..)
    , CompressionWindowSize(..)
    , CompressionMode(..)

      -- ** Decompression parameters
    , defaultDecompressParams

    , DecompressParams
    , decompressDisableRingBufferReallocation
    ) where

import           Control.Applicative
import           Prelude
import           Control.Exception
import           Control.Monad
import           Control.Monad.ST              (stToIO)
import           Control.Monad.ST.Lazy         (ST, runST, strictToLazyST)
import qualified Control.Monad.ST.Strict       as ST.Strict (ST)
import           Control.Monad.ST.Unsafe       (unsafeIOToST)
import           Data.ByteString               (ByteString)
import qualified Data.ByteString               as BS
import qualified Data.ByteString.Lazy          as BSL
import qualified Data.ByteString.Lazy.Internal as BSL
#if !MIN_VERSION_base(4,8,0)
import           Data.Monoid                   (Monoid (mempty))
#endif
import           Data.Typeable                 (Typeable)
import           GHC.IO                        (noDuplicate)

import           LibBrotli

-- | 'Exception' thrown on decoding errors or internal erros
--
-- Note that 'BrotliDecoderErrorCode' will be thrown instead of
-- 'BrotliException' when possible.
newtype BrotliException = BrotliException String deriving (Typeable,Int -> BrotliException -> ShowS
[BrotliException] -> ShowS
BrotliException -> String
(Int -> BrotliException -> ShowS)
-> (BrotliException -> String)
-> ([BrotliException] -> ShowS)
-> Show BrotliException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrotliException] -> ShowS
$cshowList :: [BrotliException] -> ShowS
show :: BrotliException -> String
$cshow :: BrotliException -> String
showsPrec :: Int -> BrotliException -> ShowS
$cshowsPrec :: Int -> BrotliException -> ShowS
Show)

instance Exception BrotliException

-- | Compress lazy 'ByteString' into Brotli stream using 'defaultCompressParams'.
compress :: BSL.ByteString -> BSL.ByteString
compress :: ByteString -> ByteString
compress = CompressParams -> ByteString -> ByteString
compressWith CompressParams
defaultCompressParams

-- | Like 'compress' but with the ability to specify various compression
-- parameters. Typical usage:
--
-- > compressWith defaultCompressParams { compress... = ... }
compressWith :: CompressParams -> BSL.ByteString -> BSL.ByteString
compressWith :: CompressParams -> ByteString -> ByteString
compressWith CompressParams
parms ByteString
input = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST (ByteString -> ST s ByteString
forall s. ByteString -> ST s ByteString
compress' ByteString
input)
  where
    compress' :: BSL.ByteString -> ST s BSL.ByteString
    compress' :: ByteString -> ST s ByteString
compress' ByteString
ibs0 = ByteString -> CompressStream (ST s) -> ST s ByteString
forall s. ByteString -> CompressStream (ST s) -> ST s ByteString
loop ByteString
ibs0 (CompressStream (ST s) -> ST s ByteString)
-> ST s (CompressStream (ST s)) -> ST s ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CompressParams -> ST s (CompressStream (ST s))
forall s. CompressParams -> ST s (CompressStream (ST s))
compressST CompressParams
parms
      where
        loop :: ByteString -> CompressStream (ST s) -> ST s ByteString
loop ByteString
BSL.Empty  CompressStream (ST s)
CompressStreamEnd =
            ByteString -> ST s ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BSL.Empty
        loop (BSL.Chunk ByteString
_ ByteString
_) CompressStream (ST s)
CompressStreamEnd =
            BrotliException -> ST s ByteString
forall e s a. Exception e => e -> ST s a
throwST (String -> BrotliException
BrotliException String
"internal error")
        loop ByteString
BSL.Empty (CompressInputRequired ST s (CompressStream (ST s))
_ ByteString -> ST s (CompressStream (ST s))
supply) =
            ByteString -> CompressStream (ST s) -> ST s ByteString
loop ByteString
BSL.Empty (CompressStream (ST s) -> ST s ByteString)
-> ST s (CompressStream (ST s)) -> ST s ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ST s (CompressStream (ST s))
supply ByteString
BS.empty
        loop (BSL.Chunk ByteString
c ByteString
bs') (CompressInputRequired ST s (CompressStream (ST s))
_ ByteString -> ST s (CompressStream (ST s))
supply) =
            ByteString -> CompressStream (ST s) -> ST s ByteString
loop ByteString
bs' (CompressStream (ST s) -> ST s ByteString)
-> ST s (CompressStream (ST s)) -> ST s ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ST s (CompressStream (ST s))
supply ByteString
c
        loop ByteString
ibs (CompressOutputAvailable ByteString
oc ST s (CompressStream (ST s))
next) = do
            ByteString
obs <- ByteString -> CompressStream (ST s) -> ST s ByteString
loop ByteString
ibs (CompressStream (ST s) -> ST s ByteString)
-> ST s (CompressStream (ST s)) -> ST s ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ST s (CompressStream (ST s))
next
            ByteString -> ST s ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteString -> ByteString
BSL.chunk ByteString
oc ByteString
obs)
{-# NOINLINE compressWith #-}


-- | Decompress lazy 'ByteString' from a Brotli stream.
decompress :: BSL.ByteString -> BSL.ByteString
decompress :: ByteString -> ByteString
decompress = DecompressParams -> ByteString -> ByteString
decompressWith DecompressParams
defaultDecompressParams

-- | Like 'decompress' but with the ability to specify various decompression
-- parameters. Typical usage:
--
-- > decompressWith defaultDecompressParams { decompress... = ... }
decompressWith :: DecompressParams -> BSL.ByteString -> BSL.ByteString
decompressWith :: DecompressParams -> ByteString -> ByteString
decompressWith DecompressParams
parms ByteString
input = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST (ByteString -> ST s ByteString
forall s. ByteString -> ST s ByteString
decompress' ByteString
input)
  where
    decompress' :: BSL.ByteString -> ST s BSL.ByteString
    decompress' :: ByteString -> ST s ByteString
decompress' ByteString
ibs0 = ByteString -> DecompressStream (ST s) -> ST s ByteString
forall s. ByteString -> DecompressStream (ST s) -> ST s ByteString
loop ByteString
ibs0 (DecompressStream (ST s) -> ST s ByteString)
-> ST s (DecompressStream (ST s)) -> ST s ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DecompressParams -> ST s (DecompressStream (ST s))
forall s. DecompressParams -> ST s (DecompressStream (ST s))
decompressST DecompressParams
parms
      where
        loop :: ByteString -> DecompressStream (ST s) -> ST s ByteString
loop ByteString
BSL.Empty  (DecompressStreamEnd ByteString
rest)
          | ByteString -> Bool
BS.null ByteString
rest = ByteString -> ST s ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BSL.Empty
          | Bool
otherwise = BrotliException -> ST s ByteString
forall e s a. Exception e => e -> ST s a
throwST (String -> BrotliException
BrotliException String
"extra trailing data")
        loop (BSL.Chunk ByteString
_ ByteString
_) (DecompressStreamEnd ByteString
_) =
            BrotliException -> ST s ByteString
forall e s a. Exception e => e -> ST s a
throwST (String -> BrotliException
BrotliException String
"extra trailing data")
        loop ByteString
_ (DecompressStreamError BrotliDecoderErrorCode
ec) =
            BrotliDecoderErrorCode -> ST s ByteString
forall e s a. Exception e => e -> ST s a
throwST BrotliDecoderErrorCode
ec
        loop ByteString
BSL.Empty (DecompressInputRequired ByteString -> ST s (DecompressStream (ST s))
supply) =
            ByteString -> DecompressStream (ST s) -> ST s ByteString
loop ByteString
BSL.Empty (DecompressStream (ST s) -> ST s ByteString)
-> ST s (DecompressStream (ST s)) -> ST s ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ST s (DecompressStream (ST s))
supply ByteString
BS.empty
        loop (BSL.Chunk ByteString
c ByteString
bs') (DecompressInputRequired ByteString -> ST s (DecompressStream (ST s))
supply) =
            ByteString -> DecompressStream (ST s) -> ST s ByteString
loop ByteString
bs' (DecompressStream (ST s) -> ST s ByteString)
-> ST s (DecompressStream (ST s)) -> ST s ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ST s (DecompressStream (ST s))
supply ByteString
c
        loop ByteString
ibs (DecompressOutputAvailable ByteString
oc ST s (DecompressStream (ST s))
next) = do
            ByteString
obs <- ByteString -> DecompressStream (ST s) -> ST s ByteString
loop ByteString
ibs (DecompressStream (ST s) -> ST s ByteString)
-> ST s (DecompressStream (ST s)) -> ST s ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ST s (DecompressStream (ST s))
next
            ByteString -> ST s ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteString -> ByteString
BSL.chunk ByteString
oc ByteString
obs)
{-# NOINLINE decompressWith #-}

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

data CompressStream m =
     CompressInputRequired {- flush -}  (m (CompressStream m))
                           {- supply -} (ByteString -> m (CompressStream m))
       -- ^ Compression process requires input to proceed. You can
       -- either flush the stream (first field), supply an input chunk
       -- (second field), or signal the end of input (via empty
       -- chunk).
   | CompressOutputAvailable !ByteString (m (CompressStream m)) -- ^ Output chunk available.
   | CompressStreamEnd

-- | Incremental compression in the 'IO' monad.
compressIO :: CompressParams -> IO (CompressStream IO)
compressIO :: CompressParams -> IO (CompressStream IO)
compressIO CompressParams
parms = ST RealWorld (Maybe BrotliEncoder) -> IO (Maybe BrotliEncoder)
forall a. ST RealWorld a -> IO a
stToIO (CompressParams -> ST RealWorld (Maybe BrotliEncoder)
forall s. CompressParams -> ST s (Maybe BrotliEncoder)
newBrotliEncoder CompressParams
parms)
                   IO (Maybe BrotliEncoder)
-> (Maybe BrotliEncoder -> IO (CompressStream IO))
-> IO (CompressStream IO)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (CompressStream IO)
-> (BrotliEncoder -> IO (CompressStream IO))
-> Maybe BrotliEncoder
-> IO (CompressStream IO)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BrotliException -> IO (CompressStream IO)
forall e a. Exception e => e -> IO a
throwIO (String -> BrotliException
BrotliException String
"failed to initialize encoder")) BrotliEncoder -> IO (CompressStream IO)
forall (f :: * -> *).
Applicative f =>
BrotliEncoder -> f (CompressStream IO)
go
  where
    bUFSIZ :: Int
bUFSIZ = Int
32752

    go :: BrotliEncoder -> f (CompressStream IO)
go BrotliEncoder
ls = CompressStream IO -> f (CompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream IO
inputRequired
      where
        inputRequired :: CompressStream IO
inputRequired = IO (CompressStream IO)
-> (ByteString -> IO (CompressStream IO)) -> CompressStream IO
forall (m :: * -> *).
m (CompressStream m)
-> (ByteString -> m (CompressStream m)) -> CompressStream m
CompressInputRequired IO (CompressStream IO)
goFlush (IO (CompressStream IO)
-> (ByteString -> IO (CompressStream IO))
-> ByteString
-> IO (CompressStream IO)
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk IO (CompressStream IO)
goFinish ByteString -> IO (CompressStream IO)
goInput)

        unexpectedState :: IO a
unexpectedState = BrotliException -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> BrotliException
BrotliException String
"internal error (unexpected state)")
        encoderFailure :: IO a
encoderFailure  = BrotliException -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> BrotliException
BrotliException String
"encoder failure")
        internalError :: IO a
internalError   = BrotliException -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> BrotliException
BrotliException String
"internal error")

        goInput :: ByteString -> IO (CompressStream IO)
goInput ByteString
chunk = do -- assert (not $ BS.null chunk)
            (BrotliState
rc, Int
unused) <- ST RealWorld (BrotliState, Int) -> IO (BrotliState, Int)
forall a. ST RealWorld a -> IO a
stToIO (BrotliEncoder
-> ByteString -> BrotliEncOp -> ST RealWorld (BrotliState, Int)
forall s.
BrotliEncoder
-> ByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls ByteString
chunk BrotliEncOp
BrotliEncOpProcess)

            let chunk' :: ByteString
chunk' = Int -> ByteString -> ByteString
BS.drop Int
used ByteString
chunk
                used :: Int
used   = ByteString -> Int
BS.length ByteString
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
unused

            case BrotliState
rc of
                BrotliState
BSFail          -> IO (CompressStream IO)
forall a. IO a
encoderFailure
                BrotliState
BSInternalError -> IO (CompressStream IO)
forall a. IO a
internalError
                BrotliState
BSFinished      -> IO (CompressStream IO)
forall a. IO a
unexpectedState
                BrotliState
BSNeedsInput    -> do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) IO ()
forall a. IO a
internalError
                                      IO (CompressStream IO)
-> (ByteString -> IO (CompressStream IO))
-> ByteString
-> IO (CompressStream IO)
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (CompressStream IO -> IO (CompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream IO
inputRequired) ByteString -> IO (CompressStream IO)
goInput ByteString
chunk'

                BrotliState
BSHasOutput     -> IO (CompressStream IO)
-> IO (CompressStream IO) -> IO (CompressStream IO)
drainOutput (IO (CompressStream IO)
-> (ByteString -> IO (CompressStream IO))
-> ByteString
-> IO (CompressStream IO)
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (CompressStream IO -> IO (CompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream IO
inputRequired) ByteString -> IO (CompressStream IO)
goInput ByteString
chunk') IO (CompressStream IO)
forall a. IO a
unexpectedState

        goFlush :: IO (CompressStream IO)
goFlush  = do
            (BrotliState
rc, Int
0) <- ST RealWorld (BrotliState, Int) -> IO (BrotliState, Int)
forall a. ST RealWorld a -> IO a
stToIO (BrotliEncoder
-> ByteString -> BrotliEncOp -> ST RealWorld (BrotliState, Int)
forall s.
BrotliEncoder
-> ByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls ByteString
forall a. Monoid a => a
mempty BrotliEncOp
BrotliEncOpFlush)
            case BrotliState
rc of
                BrotliState
BSFail          -> IO (CompressStream IO)
forall a. IO a
encoderFailure
                BrotliState
BSInternalError -> IO (CompressStream IO)
forall a. IO a
internalError
                BrotliState
BSFinished      -> IO (CompressStream IO)
forall a. IO a
unexpectedState
                BrotliState
BSNeedsInput    -> IO (CompressStream IO)
forall a. IO a
unexpectedState
                BrotliState
BSHasOutput     -> IO (CompressStream IO)
-> IO (CompressStream IO) -> IO (CompressStream IO)
drainOutput (CompressStream IO -> IO (CompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream IO
inputRequired) IO (CompressStream IO)
forall a. IO a
unexpectedState

        goFinish :: IO (CompressStream IO)
goFinish = do
            (BrotliState
rc, Int
0) <- ST RealWorld (BrotliState, Int) -> IO (BrotliState, Int)
forall a. ST RealWorld a -> IO a
stToIO (BrotliEncoder
-> ByteString -> BrotliEncOp -> ST RealWorld (BrotliState, Int)
forall s.
BrotliEncoder
-> ByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls ByteString
forall a. Monoid a => a
mempty BrotliEncOp
BrotliEncOpFinish)
            case BrotliState
rc of
                BrotliState
BSFail          -> IO (CompressStream IO)
forall a. IO a
encoderFailure
                BrotliState
BSInternalError -> IO (CompressStream IO)
forall a. IO a
internalError
                BrotliState
BSFinished      -> do
                  !() <- ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (BrotliEncoder -> ST RealWorld ()
forall s. BrotliEncoder -> ST s ()
finalizeBrotliEncoder BrotliEncoder
ls)
                  CompressStream IO -> IO (CompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream IO
forall (m :: * -> *). CompressStream m
CompressStreamEnd
                BrotliState
BSNeedsInput    -> IO (CompressStream IO)
forall a. IO a
unexpectedState
                BrotliState
BSHasOutput     -> IO (CompressStream IO)
-> IO (CompressStream IO) -> IO (CompressStream IO)
drainOutput IO (CompressStream IO)
forall a. IO a
unexpectedState (CompressStream IO -> IO (CompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream IO
forall (m :: * -> *). CompressStream m
CompressStreamEnd)

        drainOutput :: IO (CompressStream IO)
-> IO (CompressStream IO) -> IO (CompressStream IO)
drainOutput IO (CompressStream IO)
needsInputCont IO (CompressStream IO)
finishedCont = do
            (BrotliState
rc, ByteString
obuf) <- ST RealWorld (BrotliState, ByteString)
-> IO (BrotliState, ByteString)
forall a. ST RealWorld a -> IO a
stToIO (BrotliEncoder -> Int -> ST RealWorld (BrotliState, ByteString)
forall s. BrotliEncoder -> Int -> ST s (BrotliState, ByteString)
readBrotliEncoder BrotliEncoder
ls Int
bUFSIZ)
            case BrotliState
rc of
                BrotliState
BSFail          -> IO (CompressStream IO)
forall a. IO a
encoderFailure
                BrotliState
BSInternalError -> IO (CompressStream IO)
forall a. IO a
internalError
                BrotliState
BSHasOutput     -> do
                  CompressStream IO -> IO (CompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO (CompressStream IO) -> CompressStream IO
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf (IO (CompressStream IO)
-> IO (CompressStream IO) -> IO (CompressStream IO)
drainOutput IO (CompressStream IO)
needsInputCont IO (CompressStream IO)
finishedCont))
                BrotliState
BSNeedsInput    -> do
                  CompressStream IO -> IO (CompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO (CompressStream IO) -> CompressStream IO
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf IO (CompressStream IO)
needsInputCont)
                BrotliState
BSFinished      -> do
                  !() <- ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (BrotliEncoder -> ST RealWorld ()
forall s. BrotliEncoder -> ST s ()
finalizeBrotliEncoder BrotliEncoder
ls)
                  CompressStream IO -> IO (CompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO (CompressStream IO) -> CompressStream IO
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf IO (CompressStream IO)
finishedCont)


-- | Incremental compression in the lazy 'ST' monad.
compressST :: CompressParams -> ST s (CompressStream (ST s))
compressST :: CompressParams -> ST s (CompressStream (ST s))
compressST CompressParams
parms = ST s (Maybe BrotliEncoder) -> ST s (Maybe BrotliEncoder)
forall s a. ST s a -> ST s a
strictToLazyST (CompressParams -> ST s (Maybe BrotliEncoder)
forall s. CompressParams -> ST s (Maybe BrotliEncoder)
newBrotliEncoder CompressParams
parms)
                   ST s (Maybe BrotliEncoder)
-> (Maybe BrotliEncoder -> ST s (CompressStream (ST s)))
-> ST s (CompressStream (ST s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ST s (CompressStream (ST s))
-> (BrotliEncoder -> ST s (CompressStream (ST s)))
-> Maybe BrotliEncoder
-> ST s (CompressStream (ST s))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BrotliException -> ST s (CompressStream (ST s))
forall e s a. Exception e => e -> ST s a
throwST (String -> BrotliException
BrotliException String
"failed to initialize encoder")) BrotliEncoder -> ST s (CompressStream (ST s))
forall (f :: * -> *) s.
Applicative f =>
BrotliEncoder -> f (CompressStream (ST s))
go
  where
    bUFSIZ :: Int
bUFSIZ = Int
32752

    go :: BrotliEncoder -> f (CompressStream (ST s))
go BrotliEncoder
ls = CompressStream (ST s) -> f (CompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream (ST s)
forall s. CompressStream (ST s)
inputRequired
      where
        inputRequired :: CompressStream (ST s)
inputRequired = ST s (CompressStream (ST s))
-> (ByteString -> ST s (CompressStream (ST s)))
-> CompressStream (ST s)
forall (m :: * -> *).
m (CompressStream m)
-> (ByteString -> m (CompressStream m)) -> CompressStream m
CompressInputRequired ST s (CompressStream (ST s))
forall s. ST s (CompressStream (ST s))
goFlush (ST s (CompressStream (ST s))
-> (ByteString -> ST s (CompressStream (ST s)))
-> ByteString
-> ST s (CompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk ST s (CompressStream (ST s))
forall s. ST s (CompressStream (ST s))
goFinish ByteString -> ST s (CompressStream (ST s))
forall s. ByteString -> ST s (CompressStream (ST s))
goInput)

        unexpectedState :: ST s a
unexpectedState = BrotliException -> ST s a
forall e s a. Exception e => e -> ST s a
throwST (String -> BrotliException
BrotliException String
"internal error (unexpected state)")
        encoderFailure :: ST s a
encoderFailure  = BrotliException -> ST s a
forall e s a. Exception e => e -> ST s a
throwST (String -> BrotliException
BrotliException String
"encoder failure")
        internalError :: ST s a
internalError   = BrotliException -> ST s a
forall e s a. Exception e => e -> ST s a
throwST (String -> BrotliException
BrotliException String
"internal error")

        goInput :: ByteString -> ST s (CompressStream (ST s))
        goInput :: ByteString -> ST s (CompressStream (ST s))
goInput ByteString
chunk = do -- assert (not $ BS.null chunk)
            (BrotliState
rc, Int
unused) <- ST s (BrotliState, Int) -> ST s (BrotliState, Int)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s () -> ST s (BrotliState, Int) -> ST s (BrotliState, Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder
-> ByteString -> BrotliEncOp -> ST s (BrotliState, Int)
forall s.
BrotliEncoder
-> ByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls ByteString
chunk BrotliEncOp
BrotliEncOpProcess)

            let chunk' :: ByteString
chunk' = Int -> ByteString -> ByteString
BS.drop Int
used ByteString
chunk
                used :: Int
used   = ByteString -> Int
BS.length ByteString
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
unused

            case BrotliState
rc of
                BrotliState
BSFail          -> ST s (CompressStream (ST s))
forall s a. ST s a
encoderFailure
                BrotliState
BSInternalError -> ST s (CompressStream (ST s))
forall s a. ST s a
internalError
                BrotliState
BSFinished      -> ST s (CompressStream (ST s))
forall s a. ST s a
unexpectedState
                BrotliState
BSNeedsInput    -> do Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ST s ()
forall s a. ST s a
internalError
                                      ST s (CompressStream (ST s))
-> (ByteString -> ST s (CompressStream (ST s)))
-> ByteString
-> ST s (CompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream (ST s)
forall s. CompressStream (ST s)
inputRequired) ByteString -> ST s (CompressStream (ST s))
forall s. ByteString -> ST s (CompressStream (ST s))
goInput ByteString
chunk'

                BrotliState
BSHasOutput     -> ST s (CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
forall s.
ST s (CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
drainOutput (ST s (CompressStream (ST s))
-> (ByteString -> ST s (CompressStream (ST s)))
-> ByteString
-> ST s (CompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream (ST s)
forall s. CompressStream (ST s)
inputRequired) ByteString -> ST s (CompressStream (ST s))
forall s. ByteString -> ST s (CompressStream (ST s))
goInput ByteString
chunk') ST s (CompressStream (ST s))
forall s a. ST s a
unexpectedState

        goFlush :: ST s (CompressStream (ST s))
        goFlush :: ST s (CompressStream (ST s))
goFlush  = do
            (BrotliState
rc, Int
n) <- ST s (BrotliState, Int) -> ST s (BrotliState, Int)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s () -> ST s (BrotliState, Int) -> ST s (BrotliState, Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder
-> ByteString -> BrotliEncOp -> ST s (BrotliState, Int)
forall s.
BrotliEncoder
-> ByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls ByteString
forall a. Monoid a => a
mempty BrotliEncOp
BrotliEncOpFlush)
            Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) ST s ()
forall s a. ST s a
internalError
            case BrotliState
rc of
                BrotliState
BSFail          -> ST s (CompressStream (ST s))
forall s a. ST s a
encoderFailure
                BrotliState
BSInternalError -> ST s (CompressStream (ST s))
forall s a. ST s a
internalError
                BrotliState
BSFinished      -> ST s (CompressStream (ST s))
forall s a. ST s a
unexpectedState
                BrotliState
BSNeedsInput    -> ST s (CompressStream (ST s))
forall s a. ST s a
unexpectedState
                BrotliState
BSHasOutput     -> ST s (CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
forall s.
ST s (CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
drainOutput (CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream (ST s)
forall s. CompressStream (ST s)
inputRequired) ST s (CompressStream (ST s))
forall s a. ST s a
unexpectedState

        goFinish :: ST s (CompressStream (ST s))
        goFinish :: ST s (CompressStream (ST s))
goFinish = do
            (BrotliState
rc, Int
n) <- ST s (BrotliState, Int) -> ST s (BrotliState, Int)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s () -> ST s (BrotliState, Int) -> ST s (BrotliState, Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder
-> ByteString -> BrotliEncOp -> ST s (BrotliState, Int)
forall s.
BrotliEncoder
-> ByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls ByteString
forall a. Monoid a => a
mempty BrotliEncOp
BrotliEncOpFinish)
            Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) ST s ()
forall s a. ST s a
internalError
            case BrotliState
rc of
                BrotliState
BSFail          -> ST s (CompressStream (ST s))
forall s a. ST s a
encoderFailure
                BrotliState
BSInternalError -> ST s (CompressStream (ST s))
forall s a. ST s a
internalError
                BrotliState
BSFinished      -> do
                  !() <- ST s () -> ST s ()
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder -> ST s ()
forall s. BrotliEncoder -> ST s ()
finalizeBrotliEncoder BrotliEncoder
ls)
                  CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream (ST s)
forall (m :: * -> *). CompressStream m
CompressStreamEnd
                BrotliState
BSNeedsInput    -> ST s (CompressStream (ST s))
forall s a. ST s a
unexpectedState
                BrotliState
BSHasOutput     -> ST s (CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
forall s.
ST s (CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
drainOutput ST s (CompressStream (ST s))
forall s a. ST s a
unexpectedState (CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream (ST s)
forall (m :: * -> *). CompressStream m
CompressStreamEnd)

        drainOutput :: ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
        drainOutput :: ST s (CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
drainOutput ST s (CompressStream (ST s))
needsInputCont ST s (CompressStream (ST s))
finishedCont = do
            (BrotliState
rc, ByteString
obuf) <- ST s (BrotliState, ByteString) -> ST s (BrotliState, ByteString)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s ()
-> ST s (BrotliState, ByteString) -> ST s (BrotliState, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder -> Int -> ST s (BrotliState, ByteString)
forall s. BrotliEncoder -> Int -> ST s (BrotliState, ByteString)
readBrotliEncoder BrotliEncoder
ls Int
bUFSIZ)
            case BrotliState
rc of
                BrotliState
BSFail          -> ST s (CompressStream (ST s))
forall s a. ST s a
encoderFailure
                BrotliState
BSInternalError -> ST s (CompressStream (ST s))
forall s a. ST s a
internalError
                BrotliState
BSHasOutput     -> do
                  CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf (ST s (CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
forall s.
ST s (CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
drainOutput ST s (CompressStream (ST s))
needsInputCont ST s (CompressStream (ST s))
finishedCont))
                BrotliState
BSNeedsInput    -> do
                  CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf ST s (CompressStream (ST s))
needsInputCont)
                BrotliState
BSFinished      -> do
                  !() <- ST s () -> ST s ()
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder -> ST s ()
forall s. BrotliEncoder -> ST s ()
finalizeBrotliEncoder BrotliEncoder
ls)
                  CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf ST s (CompressStream (ST s))
finishedCont)

data DecompressStream m =
     DecompressInputRequired (ByteString -> m (DecompressStream m)) -- ^ Decoding process requires input to proceed. An empty 'ByteString' chunk signals end of input.
   | DecompressOutputAvailable !ByteString (m (DecompressStream m)) -- ^ Decompressed output chunk available.
   | DecompressStreamEnd ByteString -- ^ Decoded stream is finished. Any unconsumed leftovers from the input stream are returned via the 'ByteString' field
   | DecompressStreamError !BrotliDecoderErrorCode

-- | Incremental decompression in the 'IO' monad.
decompressIO :: DecompressParams -> IO (DecompressStream IO)
decompressIO :: DecompressParams -> IO (DecompressStream IO)
decompressIO DecompressParams
parms = ST RealWorld (Maybe BrotliDecoder) -> IO (Maybe BrotliDecoder)
forall a. ST RealWorld a -> IO a
stToIO (DecompressParams -> ST RealWorld (Maybe BrotliDecoder)
forall s. DecompressParams -> ST s (Maybe BrotliDecoder)
newBrotliDecoder DecompressParams
parms)
                     IO (Maybe BrotliDecoder)
-> (Maybe BrotliDecoder -> IO (DecompressStream IO))
-> IO (DecompressStream IO)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (DecompressStream IO)
-> (BrotliDecoder -> IO (DecompressStream IO))
-> Maybe BrotliDecoder
-> IO (DecompressStream IO)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BrotliException -> IO (DecompressStream IO)
forall e a. Exception e => e -> IO a
throwIO (String -> BrotliException
BrotliException String
"failed to initialize decoder")) BrotliDecoder -> IO (DecompressStream IO)
forall (f :: * -> *).
Applicative f =>
BrotliDecoder -> f (DecompressStream IO)
go
  where
    bUFSIZ :: Int
bUFSIZ = Int
32752

    go :: BrotliDecoder -> f (DecompressStream IO)
go BrotliDecoder
ls = DecompressStream IO -> f (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream IO
inputRequired
      where
        inputRequired :: DecompressStream IO
inputRequired = (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired (IO (DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO))
-> ByteString
-> IO (DecompressStream IO)
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk IO (DecompressStream IO)
goFinish ByteString -> IO (DecompressStream IO)
goInput)

        unexpectedState :: IO a
unexpectedState = BrotliException -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> BrotliException
BrotliException String
"internal error (unexpected state)")
        internalError :: IO a
internalError   = BrotliException -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> BrotliException
BrotliException String
"internal error")

        truncatedError :: DecompressStream m
truncatedError = BrotliDecoderErrorCode -> DecompressStream m
forall (m :: * -> *). BrotliDecoderErrorCode -> DecompressStream m
DecompressStreamError (Int -> BrotliDecoderErrorCode
BrotliDecoderErrorCode Int
2)

        goInput :: ByteString -> IO (DecompressStream IO)
goInput ByteString
chunk = do -- assert (not $ BS.null chunk)
            (BrotliState
rc, BrotliDecoderErrorCode
ecode, Int
unused) <- ST RealWorld (BrotliState, BrotliDecoderErrorCode, Int)
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a. ST RealWorld a -> IO a
stToIO (BrotliDecoder
-> ByteString
-> ST RealWorld (BrotliState, BrotliDecoderErrorCode, Int)
forall s.
BrotliDecoder
-> ByteString -> ST s (BrotliState, BrotliDecoderErrorCode, Int)
runBrotliDecoder BrotliDecoder
ls ByteString
chunk)

            let chunk' :: ByteString
chunk' = Int -> ByteString -> ByteString
BS.drop Int
used ByteString
chunk
                used :: Int
used   = ByteString -> Int
BS.length ByteString
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
unused

            case BrotliState
rc of
                BrotliState
BSFail          -> DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BrotliDecoderErrorCode -> DecompressStream IO
forall (m :: * -> *). BrotliDecoderErrorCode -> DecompressStream m
DecompressStreamError BrotliDecoderErrorCode
ecode)
                BrotliState
BSInternalError -> IO (DecompressStream IO)
forall a. IO a
internalError
                BrotliState
BSFinished      -> DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> DecompressStream IO
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
chunk')
                BrotliState
BSNeedsInput    -> do
                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) IO ()
forall a. IO a
internalError
                  IO (DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO))
-> ByteString
-> IO (DecompressStream IO)
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream IO
inputRequired) ByteString -> IO (DecompressStream IO)
goInput ByteString
chunk'

                BrotliState
BSHasOutput     -> IO (DecompressStream IO)
-> IO (DecompressStream IO) -> IO (DecompressStream IO)
drainOutput (IO (DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO))
-> ByteString
-> IO (DecompressStream IO)
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream IO
inputRequired) ByteString -> IO (DecompressStream IO)
goInput ByteString
chunk')
                                               (DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> DecompressStream IO
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
chunk'))

        goFinish :: IO (DecompressStream IO)
goFinish = do
            (BrotliState
rc, BrotliDecoderErrorCode
ecode, Int
0) <- ST RealWorld (BrotliState, BrotliDecoderErrorCode, Int)
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a. ST RealWorld a -> IO a
stToIO (BrotliDecoder
-> ByteString
-> ST RealWorld (BrotliState, BrotliDecoderErrorCode, Int)
forall s.
BrotliDecoder
-> ByteString -> ST s (BrotliState, BrotliDecoderErrorCode, Int)
runBrotliDecoder BrotliDecoder
ls ByteString
forall a. Monoid a => a
mempty)
            case BrotliState
rc of
                BrotliState
BSFail          -> DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BrotliDecoderErrorCode -> DecompressStream IO
forall (m :: * -> *). BrotliDecoderErrorCode -> DecompressStream m
DecompressStreamError BrotliDecoderErrorCode
ecode)
                BrotliState
BSInternalError -> IO (DecompressStream IO)
forall a. IO a
internalError
                BrotliState
BSFinished      -> do
                  !() <- ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (BrotliDecoder -> ST RealWorld ()
forall s. BrotliDecoder -> ST s ()
finalizeBrotliDecoder BrotliDecoder
ls)
                  DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> DecompressStream IO
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
forall a. Monoid a => a
mempty)
                BrotliState
BSNeedsInput    -> DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream IO
forall (m :: * -> *). DecompressStream m
truncatedError
                BrotliState
BSHasOutput     -> IO (DecompressStream IO)
-> IO (DecompressStream IO) -> IO (DecompressStream IO)
drainOutput (DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream IO
forall (m :: * -> *). DecompressStream m
truncatedError)
                                               (DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> DecompressStream IO
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
forall a. Monoid a => a
mempty))

        drainOutput :: IO (DecompressStream IO)
-> IO (DecompressStream IO) -> IO (DecompressStream IO)
drainOutput IO (DecompressStream IO)
needsInputCont IO (DecompressStream IO)
finishedCont = do
            (BrotliState
rc, ByteString
obuf) <- ST RealWorld (BrotliState, ByteString)
-> IO (BrotliState, ByteString)
forall a. ST RealWorld a -> IO a
stToIO (BrotliDecoder -> Int -> ST RealWorld (BrotliState, ByteString)
forall s. BrotliDecoder -> Int -> ST s (BrotliState, ByteString)
readBrotliDecoder BrotliDecoder
ls Int
bUFSIZ)
            case BrotliState
rc of
              BrotliState
BSFail          -> IO (DecompressStream IO)
forall a. IO a
unexpectedState -- cannot happen
              BrotliState
BSInternalError -> IO (DecompressStream IO)
forall a. IO a
internalError
              BrotliState
BSHasOutput     ->
                DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf (IO (DecompressStream IO)
-> IO (DecompressStream IO) -> IO (DecompressStream IO)
drainOutput IO (DecompressStream IO)
needsInputCont IO (DecompressStream IO)
finishedCont))
              BrotliState
BSNeedsInput    ->
                DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf IO (DecompressStream IO)
needsInputCont)
              BrotliState
BSFinished      -> do
                !() <- ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (BrotliDecoder -> ST RealWorld ()
forall s. BrotliDecoder -> ST s ()
finalizeBrotliDecoder BrotliDecoder
ls)
                DecompressStream IO -> IO (DecompressStream IO)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf IO (DecompressStream IO)
finishedCont)


-- | Incremental decompression in the lazy 'ST' monad.
decompressST :: DecompressParams -> ST s (DecompressStream (ST s))
decompressST :: DecompressParams -> ST s (DecompressStream (ST s))
decompressST DecompressParams
parms = ST s (Maybe BrotliDecoder) -> ST s (Maybe BrotliDecoder)
forall s a. ST s a -> ST s a
strictToLazyST (DecompressParams -> ST s (Maybe BrotliDecoder)
forall s. DecompressParams -> ST s (Maybe BrotliDecoder)
newBrotliDecoder DecompressParams
parms)
                     ST s (Maybe BrotliDecoder)
-> (Maybe BrotliDecoder -> ST s (DecompressStream (ST s)))
-> ST s (DecompressStream (ST s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ST s (DecompressStream (ST s))
-> (BrotliDecoder -> ST s (DecompressStream (ST s)))
-> Maybe BrotliDecoder
-> ST s (DecompressStream (ST s))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BrotliException -> ST s (DecompressStream (ST s))
forall e s a. Exception e => e -> ST s a
throwST (String -> BrotliException
BrotliException String
"failed to initialize decoder")) BrotliDecoder -> ST s (DecompressStream (ST s))
forall (f :: * -> *) s.
Applicative f =>
BrotliDecoder -> f (DecompressStream (ST s))
go
  where
    bUFSIZ :: Int
bUFSIZ = Int
32752

    go :: BrotliDecoder -> f (DecompressStream (ST s))
go BrotliDecoder
ls = DecompressStream (ST s) -> f (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream (ST s)
forall s. DecompressStream (ST s)
inputRequired
      where
        inputRequired :: DecompressStream (ST s)
inputRequired = (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired (ST s (DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> ByteString
-> ST s (DecompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk ST s (DecompressStream (ST s))
forall s. ST s (DecompressStream (ST s))
goFinish ByteString -> ST s (DecompressStream (ST s))
forall s. ByteString -> ST s (DecompressStream (ST s))
goInput)

        unexpectedState :: ST s a
unexpectedState = BrotliException -> ST s a
forall e s a. Exception e => e -> ST s a
throwST (String -> BrotliException
BrotliException String
"internal error (unexpected state)")
        internalError :: ST s a
internalError   = BrotliException -> ST s a
forall e s a. Exception e => e -> ST s a
throwST (String -> BrotliException
BrotliException String
"internal error")

        truncatedError :: DecompressStream m
truncatedError = BrotliDecoderErrorCode -> DecompressStream m
forall (m :: * -> *). BrotliDecoderErrorCode -> DecompressStream m
DecompressStreamError (Int -> BrotliDecoderErrorCode
BrotliDecoderErrorCode Int
2)

        goInput :: ByteString -> ST s (DecompressStream (ST s))
        goInput :: ByteString -> ST s (DecompressStream (ST s))
goInput ByteString
chunk = do -- assert (not $ BS.null chunk)
            (BrotliState
rc, BrotliDecoderErrorCode
ecode, Int
unused) <- ST s (BrotliState, BrotliDecoderErrorCode, Int)
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s ()
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliDecoder
-> ByteString -> ST s (BrotliState, BrotliDecoderErrorCode, Int)
forall s.
BrotliDecoder
-> ByteString -> ST s (BrotliState, BrotliDecoderErrorCode, Int)
runBrotliDecoder BrotliDecoder
ls ByteString
chunk)

            let chunk' :: ByteString
chunk' = Int -> ByteString -> ByteString
BS.drop Int
used ByteString
chunk
                used :: Int
used   = ByteString -> Int
BS.length ByteString
chunk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
unused

            case BrotliState
rc of
                BrotliState
BSFail          -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BrotliDecoderErrorCode -> DecompressStream (ST s)
forall (m :: * -> *). BrotliDecoderErrorCode -> DecompressStream m
DecompressStreamError BrotliDecoderErrorCode
ecode)
                BrotliState
BSInternalError -> ST s (DecompressStream (ST s))
forall s a. ST s a
internalError
                BrotliState
BSFinished      -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> DecompressStream (ST s)
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
chunk')
                BrotliState
BSNeedsInput    -> do
                  Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ST s ()
forall s a. ST s a
internalError
                  ST s (DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> ByteString
-> ST s (DecompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream (ST s)
forall s. DecompressStream (ST s)
inputRequired) ByteString -> ST s (DecompressStream (ST s))
forall s. ByteString -> ST s (DecompressStream (ST s))
goInput ByteString
chunk'

                BrotliState
BSHasOutput     -> ST s (DecompressStream (ST s))
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
forall s.
ST s (DecompressStream (ST s))
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
drainOutput (ST s (DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> ByteString
-> ST s (DecompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream (ST s)
forall s. DecompressStream (ST s)
inputRequired) ByteString -> ST s (DecompressStream (ST s))
forall s. ByteString -> ST s (DecompressStream (ST s))
goInput ByteString
chunk')
                                               (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> DecompressStream (ST s)
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
chunk'))

        goFinish :: ST s (DecompressStream (ST s))
        goFinish :: ST s (DecompressStream (ST s))
goFinish = do
            (BrotliState
rc, BrotliDecoderErrorCode
ecode, Int
n) <- ST s (BrotliState, BrotliDecoderErrorCode, Int)
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s ()
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliDecoder
-> ByteString -> ST s (BrotliState, BrotliDecoderErrorCode, Int)
forall s.
BrotliDecoder
-> ByteString -> ST s (BrotliState, BrotliDecoderErrorCode, Int)
runBrotliDecoder BrotliDecoder
ls ByteString
forall a. Monoid a => a
mempty)
            Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) ST s ()
forall s a. ST s a
internalError
            case BrotliState
rc of
                BrotliState
BSFail          -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BrotliDecoderErrorCode -> DecompressStream (ST s)
forall (m :: * -> *). BrotliDecoderErrorCode -> DecompressStream m
DecompressStreamError BrotliDecoderErrorCode
ecode)
                BrotliState
BSInternalError -> ST s (DecompressStream (ST s))
forall s a. ST s a
internalError
                BrotliState
BSFinished      -> do
                  !() <- ST s () -> ST s ()
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliDecoder -> ST s ()
forall s. BrotliDecoder -> ST s ()
finalizeBrotliDecoder BrotliDecoder
ls)
                  DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> DecompressStream (ST s)
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
forall a. Monoid a => a
mempty)
                BrotliState
BSNeedsInput    -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream (ST s)
forall (m :: * -> *). DecompressStream m
truncatedError
                BrotliState
BSHasOutput     -> ST s (DecompressStream (ST s))
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
forall s.
ST s (DecompressStream (ST s))
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
drainOutput (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream (ST s)
forall (m :: * -> *). DecompressStream m
truncatedError)
                                               (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> DecompressStream (ST s)
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
forall a. Monoid a => a
mempty))

        drainOutput :: ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
        drainOutput :: ST s (DecompressStream (ST s))
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
drainOutput ST s (DecompressStream (ST s))
needsInputCont ST s (DecompressStream (ST s))
finishedCont = do
            (BrotliState
rc, ByteString
obuf) <- ST s (BrotliState, ByteString) -> ST s (BrotliState, ByteString)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s ()
-> ST s (BrotliState, ByteString) -> ST s (BrotliState, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliDecoder -> Int -> ST s (BrotliState, ByteString)
forall s. BrotliDecoder -> Int -> ST s (BrotliState, ByteString)
readBrotliDecoder BrotliDecoder
ls Int
bUFSIZ)
            case BrotliState
rc of
              BrotliState
BSFail          -> ST s (DecompressStream (ST s))
forall s a. ST s a
unexpectedState -- cannot happen
              BrotliState
BSInternalError -> ST s (DecompressStream (ST s))
forall s a. ST s a
internalError
              BrotliState
BSHasOutput     ->
                DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf (ST s (DecompressStream (ST s))
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
forall s.
ST s (DecompressStream (ST s))
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
drainOutput ST s (DecompressStream (ST s))
needsInputCont ST s (DecompressStream (ST s))
finishedCont))
              BrotliState
BSNeedsInput    ->
                DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf ST s (DecompressStream (ST s))
needsInputCont)
              BrotliState
BSFinished      -> do
                !() <- ST s () -> ST s ()
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliDecoder -> ST s ()
forall s. BrotliDecoder -> ST s ()
finalizeBrotliDecoder BrotliDecoder
ls)
                DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf ST s (DecompressStream (ST s))
finishedCont)

-- | Small 'maybe'-ish helper distinguishing between empty and
-- non-empty 'ByteString's
withChunk :: t -> (ByteString -> t) -> ByteString -> t
withChunk :: t -> (ByteString -> t) -> ByteString -> t
withChunk t
emptyChunk ByteString -> t
nemptyChunk ByteString
chunk
  | ByteString -> Bool
BS.null ByteString
chunk = t
emptyChunk
  | Bool
otherwise     = ByteString -> t
nemptyChunk ByteString
chunk

-- | See <https://github.com/haskell/zlib/issues/7>
noDuplicateST :: ST.Strict.ST s ()
noDuplicateST :: ST s ()
noDuplicateST = IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST IO ()
noDuplicate

throwST :: Exception e => e -> ST s a
throwST :: e -> ST s a
throwST = e -> ST s a
forall a e. Exception e => e -> a
throw