-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Codec/Compression/BZip/Unpack.chs" #-}
{-# LANGUAGE TupleSections #-}

module Codec.Compression.BZip.Unpack ( decompress
                                     , decompressErr
                                     ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Codec.Compression.BZip.Foreign.Common
import Codec.Compression.BZip.Foreign.Decompress
import Codec.Compression.BZip.Common
import Control.Applicative
import Control.Exception (evaluate, throw, try)
import Control.Monad.ST.Lazy as LazyST
import Control.Monad.ST.Lazy.Unsafe as LazyST
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Maybe (isNothing)
import Foreign.ForeignPtr (newForeignPtr, castForeignPtr, ForeignPtr, mallocForeignPtrBytes, withForeignPtr)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import System.IO.Unsafe (unsafePerformIO)



-- | Return an error rather than throwing an exception.
--
-- @since 1.0.1.0
decompressErr :: BSL.ByteString -> Either BZError BSL.ByteString
decompressErr :: ByteString -> Either BZError ByteString
decompressErr = IO (Either BZError ByteString) -> Either BZError ByteString
forall a. IO a -> a
unsafePerformIO (IO (Either BZError ByteString) -> Either BZError ByteString)
-> (ByteString -> IO (Either BZError ByteString))
-> ByteString
-> Either BZError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ByteString -> IO (Either BZError ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either BZError ByteString))
-> (ByteString -> IO ByteString)
-> ByteString
-> IO (Either BZError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ByteString
forall a. a -> IO a
evaluate (ByteString -> IO ByteString)
-> (ByteString -> ByteString) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decompress

-- | Don't use this on pathological input; it may not be secure
--
-- This does not handle nested streams
--
-- @since 0.1.1.0
decompress :: BSL.ByteString -> BSL.ByteString
decompress :: ByteString -> ByteString
decompress ByteString
bsl =
    let bss :: [ByteString]
bss = ByteString -> [ByteString]
BSL.toChunks ByteString
bsl in
    [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (forall s. ST s [ByteString]) -> [ByteString]
forall a. (forall s. ST s a) -> a
LazyST.runST ((forall s. ST s [ByteString]) -> [ByteString])
-> (forall s. ST s [ByteString]) -> [ByteString]
forall a b. (a -> b) -> a -> b
$ do
        (ForeignPtr BzStream
p, ForeignPtr Any
bufOut) <- IO (ForeignPtr BzStream, ForeignPtr Any)
-> ST s (ForeignPtr BzStream, ForeignPtr Any)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO (ForeignPtr BzStream, ForeignPtr Any)
 -> ST s (ForeignPtr BzStream, ForeignPtr Any))
-> IO (ForeignPtr BzStream, ForeignPtr Any)
-> ST s (ForeignPtr BzStream, ForeignPtr Any)
forall a b. (a -> b) -> a -> b
$ do
            Ptr BzStream
ptr <- IO (Ptr BzStream)
bzStreamInit
            ForeignPtr BzStream
p <- ForeignPtr () -> ForeignPtr BzStream
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr () -> ForeignPtr BzStream)
-> IO (ForeignPtr ()) -> IO (ForeignPtr BzStream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
bZ2BzDecompressEnd (Ptr BzStream -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr BzStream
ptr)
            ForeignPtr BzStream -> IO ()
bzDecompressInit ForeignPtr BzStream
p
            ForeignPtr Any
bufOut <- Int -> IO (ForeignPtr Any)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
forall a. Integral a => a
bufSz
            (ForeignPtr BzStream, ForeignPtr Any)
-> IO (ForeignPtr BzStream, ForeignPtr Any)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr BzStream
p, ForeignPtr Any
bufOut)

        ForeignPtr BzStream
-> [ByteString] -> ForeignPtr Any -> ST s [ByteString]
forall a s.
ForeignPtr BzStream
-> [ByteString] -> ForeignPtr a -> ST s [ByteString]
bzDecompressChunks ForeignPtr BzStream
p [ByteString]
bss ForeignPtr Any
bufOut

type Step = Ptr BzStream -> Maybe BS.ByteString -> [BS.ByteString] -> IO BZError -> IO (BZError, Maybe BS.ByteString, [BS.ByteString])

bzDecompressChunks :: ForeignPtr BzStream -> [BS.ByteString] -> ForeignPtr a -> LazyST.ST s [BS.ByteString]
bzDecompressChunks :: forall a s.
ForeignPtr BzStream
-> [ByteString] -> ForeignPtr a -> ST s [ByteString]
bzDecompressChunks ForeignPtr BzStream
ptr' [ByteString]
bs ForeignPtr a
bufO =

    ForeignPtr BzStream
-> Maybe ByteString
-> [ByteString]
-> Step
-> ForeignPtr a
-> ST s [ByteString]
forall a s.
ForeignPtr BzStream
-> Maybe ByteString
-> [ByteString]
-> Step
-> ForeignPtr a
-> ST s [ByteString]
fillBuf ForeignPtr BzStream
ptr' Maybe ByteString
forall a. Maybe a
Nothing [ByteString]
bs Step
pushBytes ForeignPtr a
bufO

    where

        fillBuf :: ForeignPtr BzStream -> Maybe BS.ByteString -> [BS.ByteString] -> Step -> ForeignPtr a -> LazyST.ST s [BS.ByteString]
        fillBuf :: forall a s.
ForeignPtr BzStream
-> Maybe ByteString
-> [ByteString]
-> Step
-> ForeignPtr a
-> ST s [ByteString]
fillBuf ForeignPtr BzStream
pForeign Maybe ByteString
passFwd [ByteString]
bs' Step
step ForeignPtr a
bufOutForeign = do
            (BZError
ret, Int
szOut, [ByteString] -> [ByteString]
newBSAp, [ByteString]
bs'', Maybe ByteString
keepAlive) <- IO
  (BZError, Int, [ByteString] -> [ByteString], [ByteString],
   Maybe ByteString)
-> ST
     s
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a s. IO a -> ST s a
LazyST.unsafeIOToST (IO
   (BZError, Int, [ByteString] -> [ByteString], [ByteString],
    Maybe ByteString)
 -> ST
      s
      (BZError, Int, [ByteString] -> [ByteString], [ByteString],
       Maybe ByteString))
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
-> ST
     s
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
                ForeignPtr BzStream
-> (Ptr BzStream
    -> IO
         (BZError, Int, [ByteString] -> [ByteString], [ByteString],
          Maybe ByteString))
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BzStream
pForeign ((Ptr BzStream
  -> IO
       (BZError, Int, [ByteString] -> [ByteString], [ByteString],
        Maybe ByteString))
 -> IO
      (BZError, Int, [ByteString] -> [ByteString], [ByteString],
       Maybe ByteString))
-> (Ptr BzStream
    -> IO
         (BZError, Int, [ByteString] -> [ByteString], [ByteString],
          Maybe ByteString))
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr BzStream
p ->
                    ForeignPtr a
-> (Ptr a
    -> IO
         (BZError, Int, [ByteString] -> [ByteString], [ByteString],
          Maybe ByteString))
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
bufOutForeign ((Ptr a
  -> IO
       (BZError, Int, [ByteString] -> [ByteString], [ByteString],
        Maybe ByteString))
 -> IO
      (BZError, Int, [ByteString] -> [ByteString], [ByteString],
       Maybe ByteString))
-> (Ptr a
    -> IO
         (BZError, Int, [ByteString] -> [ByteString], [ByteString],
          Maybe ByteString))
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr a
bufOut -> do

                        let act :: IO BZError
act = do

                                (\Ptr BzStream
ptr CUInt
val -> do {Ptr BzStream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
32 (CUInt
val :: C2HSImp.CUInt)}) Ptr BzStream
p CUInt
forall a. Integral a => a
bufSz
                                (\Ptr BzStream
ptr Ptr CChar
val -> do {Ptr BzStream -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
24 (Ptr CChar
val :: (C2HSImp.Ptr C2HSImp.CChar))}) Ptr BzStream
p (Ptr a -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr a
bufOut)

                                ForeignPtr BzStream -> IO BZError
bZ2BzDecompress ForeignPtr BzStream
ptr'

                        (BZError
ret, Maybe ByteString
keepAlive, [ByteString]
bs'') <- Step
step Ptr BzStream
p Maybe ByteString
passFwd [ByteString]
bs' IO BZError
act

                        Int
szOut <- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr BzStream
ptr -> do {Ptr BzStream -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr BzStream
ptr Int
32 :: IO C2HSImp.CUInt}) Ptr BzStream
p

                        let bytesAvail :: Int
bytesAvail = Int
forall a. Integral a => a
bufSz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
szOut

                        [ByteString] -> [ByteString]
newBSAp <- if Int
bytesAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
                            then (:) (ByteString -> [ByteString] -> [ByteString])
-> IO ByteString -> IO ([ByteString] -> [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
BS.packCStringLen (Ptr a -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr a
bufOut, Int
bytesAvail)
                            else ([ByteString] -> [ByteString]) -> IO ([ByteString] -> [ByteString])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ByteString] -> [ByteString]
forall a. a -> a
id

                        (BZError, Int, [ByteString] -> [ByteString], [ByteString],
 Maybe ByteString)
-> IO
     (BZError, Int, [ByteString] -> [ByteString], [ByteString],
      Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BZError
ret, Int
szOut, [ByteString] -> [ByteString]
newBSAp, [ByteString]
bs'', Maybe ByteString
keepAlive)

            let step' :: Step
step' = if Int
szOut Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then Step
keepBytesAlive
                else Step
pushBytes

            if BZError
ret BZError -> BZError -> Bool
forall a. Eq a => a -> a -> Bool
== BZError
BzStreamEnd
                then [ByteString] -> ST s [ByteString]
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> [ByteString]
newBSAp [])
                else if [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
bs' Bool -> Bool -> Bool
&& Maybe ByteString -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ByteString
keepAlive Bool -> Bool -> Bool
&& Int
forall a. Integral a => a
bufSz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
szOut
                    then BZError -> ST s [ByteString]
forall a e. Exception e => e -> a
throw BZError
BzUnexpectedEof
                    else [ByteString] -> [ByteString]
newBSAp ([ByteString] -> [ByteString])
-> ST s [ByteString] -> ST s [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr BzStream
-> Maybe ByteString
-> [ByteString]
-> Step
-> ForeignPtr a
-> ST s [ByteString]
forall a s.
ForeignPtr BzStream
-> Maybe ByteString
-> [ByteString]
-> Step
-> ForeignPtr a
-> ST s [ByteString]
fillBuf ForeignPtr BzStream
pForeign Maybe ByteString
keepAlive [ByteString]
bs'' Step
step' ForeignPtr a
bufOutForeign

        keepBytesAlive :: Ptr BzStream -> Maybe BS.ByteString -> [BS.ByteString] -> IO BZError -> IO (BZError, Maybe BS.ByteString, [BS.ByteString])
        keepBytesAlive :: Step
keepBytesAlive Ptr BzStream
_ Maybe ByteString
Nothing [ByteString]
bs' IO BZError
act = (, Maybe ByteString
forall a. Maybe a
Nothing, [ByteString]
bs') (BZError -> (BZError, Maybe ByteString, [ByteString]))
-> IO BZError -> IO (BZError, Maybe ByteString, [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO BZError
act
        keepBytesAlive Ptr BzStream
_ passFwd :: Maybe ByteString
passFwd@(Just ByteString
b) [ByteString]
bs' IO BZError
act = do
            ByteString
-> (CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
-> IO (BZError, Maybe ByteString, [ByteString])
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
 -> IO (BZError, Maybe ByteString, [ByteString]))
-> (CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
-> IO (BZError, Maybe ByteString, [ByteString])
forall a b. (a -> b) -> a -> b
$ \CStringLen
_ ->

                (, Maybe ByteString
passFwd, [ByteString]
bs') (BZError -> (BZError, Maybe ByteString, [ByteString]))
-> IO BZError -> IO (BZError, Maybe ByteString, [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO BZError
act

        pushBytes :: Ptr BzStream -> Maybe BS.ByteString -> [BS.ByteString] -> IO BZError -> IO (BZError, Maybe BS.ByteString, [BS.ByteString])
        pushBytes :: Step
pushBytes Ptr BzStream
_ Maybe ByteString
_ [] IO BZError
act = (, Maybe ByteString
forall a. Maybe a
Nothing, []) (BZError -> (BZError, Maybe ByteString, [ByteString]))
-> IO BZError -> IO (BZError, Maybe ByteString, [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO BZError
act
        pushBytes Ptr BzStream
p Maybe ByteString
_ (ByteString
b:[ByteString]
bs') IO BZError
act =
            ByteString
-> (CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
-> IO (BZError, Maybe ByteString, [ByteString])
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
 -> IO (BZError, Maybe ByteString, [ByteString]))
-> (CStringLen -> IO (BZError, Maybe ByteString, [ByteString]))
-> IO (BZError, Maybe ByteString, [ByteString])
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
buf, Int
sz) -> do

                (\Ptr BzStream
ptr CUInt
val -> do {Ptr BzStream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
8 (CUInt
val :: C2HSImp.CUInt)}) Ptr BzStream
p (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
                (\Ptr BzStream
ptr Ptr CChar
val -> do {Ptr BzStream -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
0 (Ptr CChar
val :: (C2HSImp.Ptr C2HSImp.CChar))}) Ptr BzStream
p Ptr CChar
buf

                (, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
b, [ByteString]
bs') (BZError -> (BZError, Maybe ByteString, [ByteString]))
-> IO BZError -> IO (BZError, Maybe ByteString, [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO BZError
act

bufSz :: Integral a => a
bufSz :: forall a. Integral a => a
bufSz = a
64 a -> a -> a
forall a. Num a => a -> a -> a
* a
1024

bzDecompressInit :: ForeignPtr BzStream -> IO ()
bzDecompressInit :: ForeignPtr BzStream -> IO ()
bzDecompressInit ForeignPtr BzStream
ptr' = do

    ForeignPtr BzStream -> (Ptr BzStream -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr BzStream
ptr' ((Ptr BzStream -> IO ()) -> IO ())
-> (Ptr BzStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr BzStream
p -> do

        (\Ptr BzStream
ptr Ptr CChar
val -> do {Ptr BzStream -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
0 (Ptr CChar
val :: (C2HSImp.Ptr C2HSImp.CChar))}) Ptr BzStream
p Ptr CChar
forall a. Ptr a
nullPtr
        (\Ptr BzStream
ptr CUInt
val -> do {Ptr BzStream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr BzStream
ptr Int
8 (CUInt
val :: C2HSImp.CUInt)}) Ptr BzStream
p CUInt
0

    ForeignPtr BzStream -> CInt -> Bool -> IO ()
bZ2BzDecompressInit ForeignPtr BzStream
ptr' CInt
0 Bool
False