{-# 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
$cshowsPrec :: Int -> BrotliException -> ShowS
showsPrec :: Int -> BrotliException -> ShowS
$cshow :: BrotliException -> String
show :: BrotliException -> String
$cshowList :: [BrotliException] -> ShowS
showList :: [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' :: forall s. 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 a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BSL.Empty
        loop (BSL.Chunk StrictByteString
_ 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))
_ StrictByteString -> 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
=<< StrictByteString -> ST s (CompressStream (ST s))
supply StrictByteString
BS.empty
        loop (BSL.Chunk StrictByteString
c ByteString
bs') (CompressInputRequired ST s (CompressStream (ST s))
_ StrictByteString -> 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
=<< StrictByteString -> ST s (CompressStream (ST s))
supply StrictByteString
c
        loop ByteString
ibs (CompressOutputAvailable StrictByteString
oc ST s (CompressStream (ST s))
next) = do
            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
            pure (BSL.chunk oc 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' :: forall s. 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 StrictByteString
rest)
          | StrictByteString -> Bool
BS.null StrictByteString
rest = ByteString -> ST s ByteString
forall a. a -> ST s a
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 StrictByteString
_ ByteString
_) (DecompressStreamEnd StrictByteString
_) =
            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 StrictByteString -> 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
=<< StrictByteString -> ST s (DecompressStream (ST s))
supply StrictByteString
BS.empty
        loop (BSL.Chunk StrictByteString
c ByteString
bs') (DecompressInputRequired StrictByteString -> 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
=<< StrictByteString -> ST s (DecompressStream (ST s))
supply StrictByteString
c
        loop ByteString
ibs (DecompressOutputAvailable StrictByteString
oc ST s (DecompressStream (ST s))
next) = do
            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
            pure (BSL.chunk oc 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 a b. IO a -> (a -> IO b) -> IO b
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. (HasCallStack, 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 a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream IO
inputRequired
      where
        inputRequired :: CompressStream IO
inputRequired = IO (CompressStream IO)
-> (StrictByteString -> IO (CompressStream IO))
-> CompressStream IO
forall (m :: * -> *).
m (CompressStream m)
-> (StrictByteString -> m (CompressStream m)) -> CompressStream m
CompressInputRequired IO (CompressStream IO)
goFlush (IO (CompressStream IO)
-> (StrictByteString -> IO (CompressStream IO))
-> StrictByteString
-> IO (CompressStream IO)
forall t. t -> (StrictByteString -> t) -> StrictByteString -> t
withChunk IO (CompressStream IO)
goFinish StrictByteString -> IO (CompressStream IO)
goInput)

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

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

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

            case 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)
-> (StrictByteString -> IO (CompressStream IO))
-> StrictByteString
-> IO (CompressStream IO)
forall t. t -> (StrictByteString -> t) -> StrictByteString -> t
withChunk (CompressStream IO -> IO (CompressStream IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream IO
inputRequired) StrictByteString -> IO (CompressStream IO)
goInput StrictByteString
chunk'

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

        goFlush :: IO (CompressStream IO)
goFlush  = do
            (rc, 0) <- ST RealWorld (BrotliState, Int) -> IO (BrotliState, Int)
forall a. ST RealWorld a -> IO a
stToIO (BrotliEncoder
-> StrictByteString
-> BrotliEncOp
-> ST RealWorld (BrotliState, Int)
forall s.
BrotliEncoder
-> StrictByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls StrictByteString
forall a. Monoid a => a
mempty BrotliEncOp
BrotliEncOpFlush)
            case 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 a. a -> IO a
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
            (rc, 0) <- ST RealWorld (BrotliState, Int) -> IO (BrotliState, Int)
forall a. ST RealWorld a -> IO a
stToIO (BrotliEncoder
-> StrictByteString
-> BrotliEncOp
-> ST RealWorld (BrotliState, Int)
forall s.
BrotliEncoder
-> StrictByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls StrictByteString
forall a. Monoid a => a
mempty BrotliEncOp
BrotliEncOpFinish)
            case 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)
                  pure 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 a. a -> IO a
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
            (rc, obuf) <- ST RealWorld (BrotliState, StrictByteString)
-> IO (BrotliState, StrictByteString)
forall a. ST RealWorld a -> IO a
stToIO (BrotliEncoder
-> Int -> ST RealWorld (BrotliState, StrictByteString)
forall s.
BrotliEncoder -> Int -> ST s (BrotliState, StrictByteString)
readBrotliEncoder BrotliEncoder
ls Int
bUFSIZ)
            case 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString -> IO (CompressStream IO) -> CompressStream IO
forall (m :: * -> *).
StrictByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable StrictByteString
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString -> IO (CompressStream IO) -> CompressStream IO
forall (m :: * -> *).
StrictByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable StrictByteString
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)
                  pure (CompressOutputAvailable obuf finishedCont)


-- | Incremental compression in the lazy 'ST' monad.
compressST :: CompressParams -> ST s (CompressStream (ST s))
compressST :: forall s. 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 a b. ST s a -> (a -> ST s b) -> ST s b
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 a. a -> f a
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))
-> (StrictByteString -> ST s (CompressStream (ST s)))
-> CompressStream (ST s)
forall (m :: * -> *).
m (CompressStream m)
-> (StrictByteString -> m (CompressStream m)) -> CompressStream m
CompressInputRequired ST s (CompressStream (ST s))
forall s. ST s (CompressStream (ST s))
goFlush (ST s (CompressStream (ST s))
-> (StrictByteString -> ST s (CompressStream (ST s)))
-> StrictByteString
-> ST s (CompressStream (ST s))
forall t. t -> (StrictByteString -> t) -> StrictByteString -> t
withChunk ST s (CompressStream (ST s))
forall s. ST s (CompressStream (ST s))
goFinish StrictByteString -> ST s (CompressStream (ST s))
forall s. StrictByteString -> 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 :: forall s. StrictByteString -> ST s (CompressStream (ST s))
goInput StrictByteString
chunk = do -- assert (not $ BS.null chunk)
            (rc, 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 a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder
-> StrictByteString -> BrotliEncOp -> ST s (BrotliState, Int)
forall s.
BrotliEncoder
-> StrictByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls StrictByteString
chunk BrotliEncOp
BrotliEncOpProcess)

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

            case 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))
-> (StrictByteString -> ST s (CompressStream (ST s)))
-> StrictByteString
-> ST s (CompressStream (ST s))
forall t. t -> (StrictByteString -> t) -> StrictByteString -> t
withChunk (CompressStream (ST s) -> ST s (CompressStream (ST s))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream (ST s)
forall {s}. CompressStream (ST s)
inputRequired) StrictByteString -> ST s (CompressStream (ST s))
forall s. StrictByteString -> ST s (CompressStream (ST s))
goInput StrictByteString
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))
-> (StrictByteString -> ST s (CompressStream (ST s)))
-> StrictByteString
-> ST s (CompressStream (ST s))
forall t. t -> (StrictByteString -> t) -> StrictByteString -> t
withChunk (CompressStream (ST s) -> ST s (CompressStream (ST s))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompressStream (ST s)
forall {s}. CompressStream (ST s)
inputRequired) StrictByteString -> ST s (CompressStream (ST s))
forall s. StrictByteString -> ST s (CompressStream (ST s))
goInput StrictByteString
chunk') ST s (CompressStream (ST s))
forall {s} {a}. ST s a
unexpectedState

        goFlush :: ST s (CompressStream (ST s))
        goFlush :: forall s. ST s (CompressStream (ST s))
goFlush  = do
            (rc, 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 a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder
-> StrictByteString -> BrotliEncOp -> ST s (BrotliState, Int)
forall s.
BrotliEncoder
-> StrictByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls StrictByteString
forall a. Monoid a => a
mempty BrotliEncOp
BrotliEncOpFlush)
            unless (n == 0) internalError
            case 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 a. a -> ST s a
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 :: forall s. ST s (CompressStream (ST s))
goFinish = do
            (rc, 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 a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder
-> StrictByteString -> BrotliEncOp -> ST s (BrotliState, Int)
forall s.
BrotliEncoder
-> StrictByteString -> BrotliEncOp -> ST s (BrotliState, Int)
runBrotliEncoder BrotliEncoder
ls StrictByteString
forall a. Monoid a => a
mempty BrotliEncOp
BrotliEncOpFinish)
            unless (n == 0) internalError
            case 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 a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder -> ST s ()
forall s. BrotliEncoder -> ST s ()
finalizeBrotliEncoder BrotliEncoder
ls)
                  pure 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 a. a -> ST s a
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 :: 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 = do
            (rc, obuf) <- ST s (BrotliState, StrictByteString)
-> ST s (BrotliState, StrictByteString)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s ()
-> ST s (BrotliState, StrictByteString)
-> ST s (BrotliState, StrictByteString)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder -> Int -> ST s (BrotliState, StrictByteString)
forall s.
BrotliEncoder -> Int -> ST s (BrotliState, StrictByteString)
readBrotliEncoder BrotliEncoder
ls Int
bUFSIZ)
            case 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 a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString
-> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall (m :: * -> *).
StrictByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable StrictByteString
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 a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString
-> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall (m :: * -> *).
StrictByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable StrictByteString
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 a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliEncoder -> ST s ()
forall s. BrotliEncoder -> ST s ()
finalizeBrotliEncoder BrotliEncoder
ls)
                  pure (CompressOutputAvailable obuf 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 a b. IO a -> (a -> IO b) -> IO b
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. (HasCallStack, 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 a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream IO
inputRequired
      where
        inputRequired :: DecompressStream IO
inputRequired = (StrictByteString -> IO (DecompressStream IO))
-> DecompressStream IO
forall (m :: * -> *).
(StrictByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired (IO (DecompressStream IO)
-> (StrictByteString -> IO (DecompressStream IO))
-> StrictByteString
-> IO (DecompressStream IO)
forall t. t -> (StrictByteString -> t) -> StrictByteString -> t
withChunk IO (DecompressStream IO)
goFinish StrictByteString -> IO (DecompressStream IO)
goInput)

        unexpectedState :: IO a
unexpectedState = BrotliException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> BrotliException
BrotliException String
"internal error (unexpected state)")
        internalError :: IO a
internalError   = BrotliException -> IO a
forall e a. (HasCallStack, 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 :: StrictByteString -> IO (DecompressStream IO)
goInput StrictByteString
chunk = do -- assert (not $ BS.null chunk)
            (rc, ecode, unused) <- ST RealWorld (BrotliState, BrotliDecoderErrorCode, Int)
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a. ST RealWorld a -> IO a
stToIO (BrotliDecoder
-> StrictByteString
-> ST RealWorld (BrotliState, BrotliDecoderErrorCode, Int)
forall s.
BrotliDecoder
-> StrictByteString
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
runBrotliDecoder BrotliDecoder
ls StrictByteString
chunk)

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

            case rc of
                BrotliState
BSFail          -> DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString -> DecompressStream IO
forall (m :: * -> *). StrictByteString -> DecompressStream m
DecompressStreamEnd StrictByteString
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)
-> (StrictByteString -> IO (DecompressStream IO))
-> StrictByteString
-> IO (DecompressStream IO)
forall t. t -> (StrictByteString -> t) -> StrictByteString -> t
withChunk (DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream IO
inputRequired) StrictByteString -> IO (DecompressStream IO)
goInput StrictByteString
chunk'

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

        goFinish :: IO (DecompressStream IO)
goFinish = do
            (rc, ecode, 0) <- ST RealWorld (BrotliState, BrotliDecoderErrorCode, Int)
-> IO (BrotliState, BrotliDecoderErrorCode, Int)
forall a. ST RealWorld a -> IO a
stToIO (BrotliDecoder
-> StrictByteString
-> ST RealWorld (BrotliState, BrotliDecoderErrorCode, Int)
forall s.
BrotliDecoder
-> StrictByteString
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
runBrotliDecoder BrotliDecoder
ls StrictByteString
forall a. Monoid a => a
mempty)
            case rc of
                BrotliState
BSFail          -> DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
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)
                  pure (DecompressStreamEnd mempty)
                BrotliState
BSNeedsInput    -> DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream IO
forall {m :: * -> *}. DecompressStream m
truncatedError)
                                               (DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString -> DecompressStream IO
forall (m :: * -> *). StrictByteString -> DecompressStream m
DecompressStreamEnd StrictByteString
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
            (rc, obuf) <- ST RealWorld (BrotliState, StrictByteString)
-> IO (BrotliState, StrictByteString)
forall a. ST RealWorld a -> IO a
stToIO (BrotliDecoder
-> Int -> ST RealWorld (BrotliState, StrictByteString)
forall s.
BrotliDecoder -> Int -> ST s (BrotliState, StrictByteString)
readBrotliDecoder BrotliDecoder
ls Int
bUFSIZ)
            case 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
StrictByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable StrictByteString
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
StrictByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable StrictByteString
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)
                pure (DecompressOutputAvailable obuf finishedCont)


-- | Incremental decompression in the lazy 'ST' monad.
decompressST :: DecompressParams -> ST s (DecompressStream (ST s))
decompressST :: forall s. 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 a b. ST s a -> (a -> ST s b) -> ST s b
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 a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream (ST s)
forall {s}. DecompressStream (ST s)
inputRequired
      where
        inputRequired :: DecompressStream (ST s)
inputRequired = (StrictByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(StrictByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired (ST s (DecompressStream (ST s))
-> (StrictByteString -> ST s (DecompressStream (ST s)))
-> StrictByteString
-> ST s (DecompressStream (ST s))
forall t. t -> (StrictByteString -> t) -> StrictByteString -> t
withChunk ST s (DecompressStream (ST s))
forall s. ST s (DecompressStream (ST s))
goFinish StrictByteString -> ST s (DecompressStream (ST s))
forall s. StrictByteString -> 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 :: forall s. StrictByteString -> ST s (DecompressStream (ST s))
goInput StrictByteString
chunk = do -- assert (not $ BS.null chunk)
            (rc, ecode, 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 a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliDecoder
-> StrictByteString
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
forall s.
BrotliDecoder
-> StrictByteString
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
runBrotliDecoder BrotliDecoder
ls StrictByteString
chunk)

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

            case rc of
                BrotliState
BSFail          -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
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 a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString -> DecompressStream (ST s)
forall (m :: * -> *). StrictByteString -> DecompressStream m
DecompressStreamEnd StrictByteString
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))
-> (StrictByteString -> ST s (DecompressStream (ST s)))
-> StrictByteString
-> ST s (DecompressStream (ST s))
forall t. t -> (StrictByteString -> t) -> StrictByteString -> t
withChunk (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream (ST s)
forall {s}. DecompressStream (ST s)
inputRequired) StrictByteString -> ST s (DecompressStream (ST s))
forall s. StrictByteString -> ST s (DecompressStream (ST s))
goInput StrictByteString
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))
-> (StrictByteString -> ST s (DecompressStream (ST s)))
-> StrictByteString
-> ST s (DecompressStream (ST s))
forall t. t -> (StrictByteString -> t) -> StrictByteString -> t
withChunk (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DecompressStream (ST s)
forall {s}. DecompressStream (ST s)
inputRequired) StrictByteString -> ST s (DecompressStream (ST s))
forall s. StrictByteString -> ST s (DecompressStream (ST s))
goInput StrictByteString
chunk')
                                               (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString -> DecompressStream (ST s)
forall (m :: * -> *). StrictByteString -> DecompressStream m
DecompressStreamEnd StrictByteString
chunk'))

        goFinish :: ST s (DecompressStream (ST s))
        goFinish :: forall s. ST s (DecompressStream (ST s))
goFinish = do
            (rc, ecode, 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 a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliDecoder
-> StrictByteString
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
forall s.
BrotliDecoder
-> StrictByteString
-> ST s (BrotliState, BrotliDecoderErrorCode, Int)
runBrotliDecoder BrotliDecoder
ls StrictByteString
forall a. Monoid a => a
mempty)
            unless (n == 0) internalError
            case rc of
                BrotliState
BSFail          -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
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 a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliDecoder -> ST s ()
forall s. BrotliDecoder -> ST s ()
finalizeBrotliDecoder BrotliDecoder
ls)
                  pure (DecompressStreamEnd mempty)
                BrotliState
BSNeedsInput    -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
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 a. a -> ST s a
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 a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString -> DecompressStream (ST s)
forall (m :: * -> *). StrictByteString -> DecompressStream m
DecompressStreamEnd StrictByteString
forall a. Monoid a => a
mempty))

        drainOutput :: ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
        drainOutput :: 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 = do
            (rc, obuf) <- ST s (BrotliState, StrictByteString)
-> ST s (BrotliState, StrictByteString)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s ()
-> ST s (BrotliState, StrictByteString)
-> ST s (BrotliState, StrictByteString)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliDecoder -> Int -> ST s (BrotliState, StrictByteString)
forall s.
BrotliDecoder -> Int -> ST s (BrotliState, StrictByteString)
readBrotliDecoder BrotliDecoder
ls Int
bUFSIZ)
            case 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 a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
StrictByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable StrictByteString
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 a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
StrictByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable StrictByteString
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 a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BrotliDecoder -> ST s ()
forall s. BrotliDecoder -> ST s ()
finalizeBrotliDecoder BrotliDecoder
ls)
                pure (DecompressOutputAvailable obuf finishedCont)

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

-- | See <https://github.com/haskell/zlib/issues/7>
noDuplicateST :: ST.Strict.ST s ()
noDuplicateST :: forall s. 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 :: forall e s a. Exception e => e -> ST s a
throwST = e -> ST s a
forall a e. (HasCallStack, Exception e) => e -> a
throw