zlib 0.6.0.2 → 0.6.1.0
raw patch · 7 files changed
+395/−165 lines, 7 filesdep ~base
Dependency ranges changed: base
Files
- Codec/Compression/Zlib/Internal.hs +271/−131
- Codec/Compression/Zlib/Stream.hsc +31/−13
- changelog +0/−8
- test/Test.hs +90/−5
- test/Test/Codec/Compression/Zlib/Internal.hs +1/−5
- test/Test/Codec/Compression/Zlib/Stream.hs +0/−2
- zlib.cabal +2/−1
Codec/Compression/Zlib/Internal.hs view
@@ -83,6 +83,7 @@ import qualified Data.ByteString.Lazy.Internal as L import qualified Data.ByteString as S import qualified Data.ByteString.Internal as S+import Data.Word (Word8) import qualified Codec.Compression.Zlib.Stream as Stream import Codec.Compression.Zlib.Stream (Stream)@@ -105,7 +106,7 @@ compressStrategy :: !Stream.CompressionStrategy, compressBufferSize :: !Int, compressDictionary :: Maybe S.ByteString-}+} deriving Show -- | The full set of parameters for decompression. The defaults are -- 'defaultDecompressParams'.@@ -129,8 +130,9 @@ data DecompressParams = DecompressParams { decompressWindowBits :: !Stream.WindowBits, decompressBufferSize :: !Int,- decompressDictionary :: Maybe S.ByteString-}+ decompressDictionary :: Maybe S.ByteString,+ decompressAllMembers :: Bool+} deriving Show -- | The default set of parameters for compression. This is typically used with -- the @compressWith@ function with specific parameters overridden.@@ -153,7 +155,8 @@ defaultDecompressParams = DecompressParams { decompressWindowBits = Stream.defaultWindowBits, decompressBufferSize = defaultDecompressBufferSize,- decompressDictionary = Nothing+ decompressDictionary = Nothing,+ decompressAllMembers = True } -- | The default chunk sizes for the output of compression and decompression@@ -168,13 +171,33 @@ -- data chunks as output. The process is incremental, in that the demand for -- input and provision of output are interleaved. ---data DecompressStream m- = DecompressInputRequired (S.ByteString -> m (DecompressStream m))- | DecompressOutputAvailable S.ByteString (m (DecompressStream m))+-- To indicate the end of the input supply an empty input chunk. Note that+-- for 'gzipFormat' with the default 'decompressAllMembers' @True@ you will+-- have to do this, as the decompressor will look for any following members.+-- With 'decompressAllMembers' @False@ the decompressor knows when the data+-- ends and will produce 'DecompressStreamEnd' without you having to supply an+-- empty chunk to indicate the end of the input.+--+data DecompressStream m =++ DecompressInputRequired {+ decompressSupplyInput :: S.ByteString -> m (DecompressStream m)+ }++ | DecompressOutputAvailable {+ decompressOutput :: !S.ByteString,+ decompressNext :: m (DecompressStream m)+ }+ -- | Includes any trailing unconsumed /input/ data.- | DecompressStreamEnd S.ByteString+ | DecompressStreamEnd {+ decompressUnconsumedInput :: S.ByteString+ }+ -- | An error code- | DecompressStreamError DecompressError+ | DecompressStreamError {+ decompressStreamError :: DecompressError+ } -- | The possible error cases when decompressing a stream. --@@ -280,9 +303,9 @@ -- appropriate in all cicumstances. -- -- For these cases an incremental interface is more appropriate. This interface--- allows both incremental input and output. Chunks of input data to be--- supplied one by one (e.g. as they are obtained from an input source like a--- file or network source). Output is also produced chunk by chunk.+-- allows both incremental input and output. Chunks of input data are supplied+-- one by one (e.g. as they are obtained from an input source like a file or+-- network source). Output is also produced chunk by chunk. -- -- The incremental input and output is managed via the 'CompressStream' and -- 'DecompressStream' types. They represents the unfolding of the process of@@ -346,9 +369,16 @@ -- data chunks as output. The process is incremental, in that the demand for -- input and provision of output are interleaved. ---data CompressStream m- = CompressInputRequired (S.ByteString -> m (CompressStream m))- | CompressOutputAvailable S.ByteString (m (CompressStream m))+data CompressStream m =+ CompressInputRequired {+ compressSupplyInput :: S.ByteString -> m (CompressStream m)+ }++ | CompressOutputAvailable {+ compressOutput :: !S.ByteString,+ compressNext :: m (CompressStream m)+ }+ | CompressStreamEnd -- | A fold over the 'CompressStream' in the given monad.@@ -421,15 +451,18 @@ -- compressIO :: Stream.Format -> CompressParams -> CompressStream IO -compress format params = compressStreamToLBS (compressStream format params)-compressST format params = compressStreamToST (compressStream format params)-compressIO format params = compressStreamToIO (compressStream format params)+compress format params = foldCompressStreamWithInput+ L.Chunk L.Empty+ (compressStreamST format params)+compressST format params = compressStreamST format params+compressIO format params = compressStreamIO format params -compressStream :: Stream.Format -> CompressParams -> CompressStream Stream+compressStream :: Stream.Format -> CompressParams -> S.ByteString+ -> Stream (CompressStream Stream) compressStream format (CompressParams compLevel method bits memLevel strategy initChunkSize mdict) = - CompressInputRequired $ \chunk -> do+ \chunk -> do Stream.deflateInit format compLevel method bits memLevel strategy setDictionary mdict case chunk of@@ -547,23 +580,46 @@ -- decompressIO :: Stream.Format -> DecompressParams -> DecompressStream IO -decompress format params = decompressStreamToLBS (decompressStream format params)-decompressST format params = decompressStreamToST (decompressStream format params)-decompressIO format params = decompressStreamToIO (decompressStream format params)+decompress format params = foldDecompressStreamWithInput+ L.Chunk (const L.Empty) throw+ (decompressStreamST format params)+decompressST format params = decompressStreamST format params+decompressIO format params = decompressStreamIO format params -decompressStream :: Stream.Format -> DecompressParams -> DecompressStream Stream-decompressStream format (DecompressParams bits initChunkSize mdict) =+decompressStream :: Stream.Format -> DecompressParams+ -> Bool -> S.ByteString+ -> Stream (DecompressStream Stream)+decompressStream format (DecompressParams bits initChunkSize mdict allMembers)+ resume = - DecompressInputRequired $ \chunk -> do- Stream.inflateInit format bits+ \chunk -> do+ inputBufferEmpty <- Stream.inputBufferEmpty+ outputBufferFull <- Stream.outputBufferFull+ assert inputBufferEmpty $+ if resume then assert (format == Stream.gzipFormat && allMembers) $+ Stream.inflateReset+ else assert outputBufferFull $+ Stream.inflateInit format bits case chunk of- _ | S.null chunk ->- fillBuffers 4 --always an error anyway+ _ | S.null chunk -> do+ -- special case to avoid demanding more input again+ -- always an error anyway+ when outputBufferFull $ do+ let outChunkSize = 1+ outFPtr <- Stream.unsafeLiftIO (S.mallocByteString outChunkSize)+ Stream.pushOutputBuffer outFPtr 0 outChunkSize+ drainBuffers True S.PS inFPtr offset length -> do Stream.pushInputBuffer inFPtr offset length- fillBuffers initChunkSize+ -- Normally we start with no output buffer (so counts as full) but+ -- if we're resuming then we'll usually still have output buffer+ -- space available+ assert (if not resume then outputBufferFull else True) $ return ()+ if outputBufferFull+ then fillBuffers initChunkSize+ else drainBuffers False where -- we flick between two states:@@ -632,7 +688,7 @@ inputBufferEmpty <- Stream.inputBufferEmpty if inputBufferEmpty then do finish (DecompressStreamEnd S.empty)- else do (inFPtr, offset, length) <- Stream.remainingInputBuffer+ else do (inFPtr, offset, length) <- Stream.popRemainingInputBuffer let inchunk = S.PS inFPtr offset length finish (DecompressStreamEnd inchunk) @@ -652,10 +708,8 @@ outputBufferBytesAvailable <- Stream.outputBufferBytesAvailable if outputBufferBytesAvailable > 0 then do (outFPtr, offset, length) <- Stream.popOutputBuffer- Stream.finalise return (DecompressOutputAvailable (S.PS outFPtr offset length) (return end))- else do Stream.finalise- return end+ else return end setDictionary :: Stream.DictionaryHash -> Maybe S.ByteString -> Stream (Maybe (DecompressStream Stream))@@ -670,138 +724,224 @@ _ -> fail "error when setting inflate dictionary" -compressStreamToLBS :: CompressStream Stream -> L.ByteString -> L.ByteString-compressStreamToLBS = \strm inchunks ->- runST (do zstate <- strictToLazyST $ Stream.mkState- go strm zstate inchunks)- where- go :: CompressStream Stream -> Stream.State s- -> L.ByteString -> ST s L.ByteString- go (CompressInputRequired next) zstate L.Empty = do- (strm', zstate') <- strictToLazyST $ Stream.runStream (next S.empty) zstate- go strm' zstate' L.Empty-- go (CompressInputRequired next) zstate (L.Chunk inchunk inchunks') = do- (strm', zstate') <- strictToLazyST $ Stream.runStream (next inchunk) zstate- go strm' zstate' inchunks'+------------------------------------------------------------------------------ - go (CompressOutputAvailable outchunk next) zstate inchunks = do- (strm', zstate') <- strictToLazyST $ Stream.runStream next zstate- outchunks <- go strm' zstate' inchunks- return (L.Chunk outchunk outchunks)+mkStateST :: ST s (Stream.State s)+mkStateIO :: IO (Stream.State RealWorld)+mkStateST = strictToLazyST Stream.mkState+mkStateIO = stToIO Stream.mkState - go CompressStreamEnd _ _ = return L.Empty+runStreamST :: Stream a -> Stream.State s -> ST s (a, Stream.State s)+runStreamIO :: Stream a -> Stream.State RealWorld -> IO (a, Stream.State RealWorld)+runStreamST strm zstate = strictToLazyST (Stream.runStream strm zstate)+runStreamIO strm zstate = stToIO (Stream.runStream strm zstate) -compressStreamToIO :: CompressStream Stream -> CompressStream IO-compressStreamToIO =- \(CompressInputRequired next) ->- CompressInputRequired $ \chunk -> do- zstate <- stToIO Stream.mkState- (strm', zstate') <- stToIO $ Stream.runStream (next chunk) zstate+compressStreamIO :: Stream.Format -> CompressParams -> CompressStream IO+compressStreamIO format params =+ CompressInputRequired {+ compressSupplyInput = \chunk -> do+ zstate <- mkStateIO+ let next = compressStream format params+ (strm', zstate') <- runStreamIO (next chunk) zstate return (go strm' zstate')+ } where go :: CompressStream Stream -> Stream.State RealWorld -> CompressStream IO go (CompressInputRequired next) zstate =- CompressInputRequired $ \chunk -> do- (strm', zstate') <- stToIO $ Stream.runStream (next chunk) zstate- return (go strm' zstate')+ CompressInputRequired {+ compressSupplyInput = \chunk -> do+ (strm', zstate') <- runStreamIO (next chunk) zstate+ return (go strm' zstate')+ } go (CompressOutputAvailable chunk next) zstate = CompressOutputAvailable chunk $ do- (strm', zstate') <- stToIO $ Stream.runStream next zstate+ (strm', zstate') <- runStreamIO next zstate return (go strm' zstate') go CompressStreamEnd _ = CompressStreamEnd -compressStreamToST :: CompressStream Stream -> CompressStream (ST s)-compressStreamToST =- \(CompressInputRequired next) ->- CompressInputRequired $ \chunk -> do- zstate <- strictToLazyST $ Stream.mkState- (strm', zstate') <- strictToLazyST $ Stream.runStream (next chunk) zstate+compressStreamST :: Stream.Format -> CompressParams -> CompressStream (ST s)+compressStreamST format params =+ CompressInputRequired {+ compressSupplyInput = \chunk -> do+ zstate <- mkStateST+ let next = compressStream format params+ (strm', zstate') <- runStreamST (next chunk) zstate return (go strm' zstate')+ } where go :: CompressStream Stream -> Stream.State s -> CompressStream (ST s) go (CompressInputRequired next) zstate =- CompressInputRequired $ \chunk -> do- (strm', zstate') <- strictToLazyST $ Stream.runStream (next chunk) zstate- return (go strm' zstate')+ CompressInputRequired {+ compressSupplyInput = \chunk -> do+ (strm', zstate') <- runStreamST (next chunk) zstate+ return (go strm' zstate')+ } go (CompressOutputAvailable chunk next) zstate = CompressOutputAvailable chunk $ do- (strm', zstate') <- strictToLazyST $ Stream.runStream next zstate+ (strm', zstate') <- runStreamST next zstate return (go strm' zstate') go CompressStreamEnd _ = CompressStreamEnd -decompressStreamToLBS :: DecompressStream Stream -> L.ByteString -> L.ByteString-decompressStreamToLBS = \strm inchunks ->- runST (do zstate <- strictToLazyST Stream.mkState- go strm zstate inchunks)+decompressStreamIO :: Stream.Format -> DecompressParams -> DecompressStream IO+decompressStreamIO format params =+ DecompressInputRequired $ \chunk -> do+ zstate <- mkStateIO+ let next = decompressStream format params False+ (strm', zstate') <- runStreamIO (next chunk) zstate+ go strm' zstate' (S.null chunk) where- go :: DecompressStream Stream -> Stream.State s- -> L.ByteString -> ST s L.ByteString- go (DecompressInputRequired next) zstate L.Empty = do- (strm', zstate') <- strictToLazyST $ Stream.runStream (next S.empty) zstate- go strm' zstate' L.Empty+ go :: DecompressStream Stream -> Stream.State RealWorld -> Bool+ -> IO (DecompressStream IO)+ go (DecompressInputRequired next) zstate !_ =+ return $ DecompressInputRequired $ \chunk -> do+ (strm', zstate') <- runStreamIO (next chunk) zstate+ go strm' zstate' (S.null chunk) - go (DecompressInputRequired next) zstate (L.Chunk inchunk inchunks') = do- (strm', zstate') <- strictToLazyST $ Stream.runStream (next inchunk) zstate- go strm' zstate' inchunks'+ go (DecompressOutputAvailable chunk next) zstate !eof =+ return $ DecompressOutputAvailable chunk $ do+ (strm', zstate') <- runStreamIO next zstate+ go strm' zstate' eof - go (DecompressOutputAvailable outchunk next) zstate inchunks = do- (strm', zstate') <- strictToLazyST $ Stream.runStream next zstate- outchunks <- go strm' zstate' inchunks- return (L.Chunk outchunk outchunks)+ go (DecompressStreamEnd unconsumed) zstate !eof+ | format == Stream.gzipFormat+ , decompressAllMembers params+ , not eof = tryFollowingStream unconsumed zstate+ | otherwise = finaliseStreamEnd unconsumed zstate - -- the decompressor will actually never demand the tail of the input (in- -- the usual case where it's empty) because the zlib and gzip formats know- -- their own length. So we force the tail of the input here because this- -- can be important for closing file handles etc.- go (DecompressStreamEnd _) _ !_inchunks = return L.Empty- go (DecompressStreamError err) _ _ = throw err+ go (DecompressStreamError err) zstate !_ = finaliseStreamError err zstate -decompressStreamToIO :: DecompressStream Stream -> DecompressStream IO-decompressStreamToIO =- \(DecompressInputRequired next) ->- DecompressInputRequired $ \chunk -> do- zstate <- stToIO Stream.mkState- (strm', zstate') <- stToIO $ Stream.runStream (next chunk) zstate- return (go strm' zstate')- where- go :: DecompressStream Stream -> Stream.State RealWorld -> DecompressStream IO- go (DecompressInputRequired next) zstate =- DecompressInputRequired $ \chunk -> do- (strm', zstate') <- stToIO $ Stream.runStream (next chunk) zstate- return (go strm' zstate')+ tryFollowingStream :: S.ByteString -> Stream.State RealWorld -> IO (DecompressStream IO)+ tryFollowingStream chunk zstate = case S.length chunk of+ 0 -> return $ DecompressInputRequired $ \chunk' -> case S.length chunk' of+ 0 -> finaliseStreamEnd S.empty zstate+ 1 | S.head chunk' /= 0x1f+ -> finaliseStreamEnd chunk' zstate+ 1 -> return $ DecompressInputRequired $ \chunk'' -> case S.length chunk'' of+ 0 -> finaliseStreamEnd chunk' zstate+ _ -> checkHeaderSplit (S.head chunk') chunk'' zstate+ _ -> checkHeader chunk' zstate+ 1 -> return $ DecompressInputRequired $ \chunk' -> case S.length chunk' of+ 0 -> finaliseStreamEnd chunk zstate+ _ -> checkHeaderSplit (S.head chunk) chunk' zstate+ _ -> checkHeader chunk zstate - go (DecompressOutputAvailable chunk next) zstate =- DecompressOutputAvailable chunk $ do- (strm', zstate') <- stToIO $ Stream.runStream next zstate- return (go strm' zstate')+ checkHeaderSplit :: Word8 -> S.ByteString -> Stream.State RealWorld -> IO (DecompressStream IO)+ checkHeaderSplit 0x1f chunk zstate+ | S.head chunk == 0x8b = do+ let resume = decompressStream format params True (S.pack [0x1f, 0x8b])+ if S.length chunk > 1+ then do+ -- have to handle the remaining data in this chunk+ (DecompressInputRequired next, zstate') <- runStreamIO resume zstate+ (strm', zstate'') <- runStreamIO (next (S.tail chunk)) zstate'+ go strm' zstate'' False+ else do+ -- subtle special case when the chunk tail is empty+ -- yay for QC tests+ (strm, zstate') <- runStreamIO resume zstate+ go strm zstate' False+ checkHeaderSplit byte chunk zstate =+ finaliseStreamEnd (S.cons byte chunk) zstate - go (DecompressStreamEnd chunk) _ = DecompressStreamEnd chunk- go (DecompressStreamError err) _ = DecompressStreamError err+ checkHeader :: S.ByteString -> Stream.State RealWorld -> IO (DecompressStream IO)+ checkHeader chunk zstate+ | S.index chunk 0 == 0x1f+ , S.index chunk 1 == 0x8b = do+ let resume = decompressStream format params True chunk+ (strm', zstate') <- runStreamIO resume zstate+ go strm' zstate' False+ checkHeader chunk zstate = finaliseStreamEnd chunk zstate -decompressStreamToST :: DecompressStream Stream -> DecompressStream (ST s)-decompressStreamToST =- \(DecompressInputRequired next) ->+ finaliseStreamEnd unconsumed zstate = do+ _ <- runStreamIO Stream.finalise zstate+ return (DecompressStreamEnd unconsumed)++ finaliseStreamError err zstate = do+ _ <- runStreamIO Stream.finalise zstate+ return (DecompressStreamError err)+++decompressStreamST :: Stream.Format -> DecompressParams -> DecompressStream (ST s)+decompressStreamST format params = DecompressInputRequired $ \chunk -> do- zstate <- strictToLazyST Stream.mkState- (strm', zstate') <- strictToLazyST $ Stream.runStream (next chunk) zstate- return (go strm' zstate')+ zstate <- mkStateST+ let next = decompressStream format params False+ (strm', zstate') <- runStreamST (next chunk) zstate+ go strm' zstate' (S.null chunk) where- go :: DecompressStream Stream -> Stream.State s -> DecompressStream (ST s)- go (DecompressInputRequired next) zstate =- DecompressInputRequired $ \chunk -> do- (strm', zstate') <- strictToLazyST $ Stream.runStream (next chunk) zstate- return (go strm' zstate')+ go :: DecompressStream Stream -> Stream.State s -> Bool+ -> ST s (DecompressStream (ST s))+ go (DecompressInputRequired next) zstate !_ =+ return $ DecompressInputRequired $ \chunk -> do+ (strm', zstate') <- runStreamST (next chunk) zstate+ go strm' zstate' (S.null chunk) - go (DecompressOutputAvailable chunk next) zstate =- DecompressOutputAvailable chunk $ do- (strm', zstate') <- strictToLazyST $ Stream.runStream next zstate- return (go strm' zstate')+ go (DecompressOutputAvailable chunk next) zstate !eof =+ return $ DecompressOutputAvailable chunk $ do+ (strm', zstate') <- runStreamST next zstate+ go strm' zstate' eof - go (DecompressStreamEnd chunk) _ = DecompressStreamEnd chunk- go (DecompressStreamError err) _ = DecompressStreamError err+ go (DecompressStreamEnd unconsumed) zstate !eof+ | format == Stream.gzipFormat+ , decompressAllMembers params+ , not eof = tryFollowingStream unconsumed zstate+ | otherwise = finaliseStreamEnd unconsumed zstate++ go (DecompressStreamError err) zstate !_ = finaliseStreamError err zstate+++ tryFollowingStream :: S.ByteString -> Stream.State s -> ST s (DecompressStream (ST s))+ tryFollowingStream chunk zstate = + case S.length chunk of+ 0 -> return $ DecompressInputRequired $ \chunk' -> case S.length chunk' of+ 0 -> finaliseStreamEnd S.empty zstate+ 1 | S.head chunk' /= 0x1f+ -> finaliseStreamEnd chunk' zstate+ 1 -> return $ DecompressInputRequired $ \chunk'' -> case S.length chunk'' of+ 0 -> finaliseStreamEnd chunk' zstate+ _ -> checkHeaderSplit (S.head chunk') chunk'' zstate+ _ -> checkHeader chunk' zstate+ 1 -> return $ DecompressInputRequired $ \chunk' -> case S.length chunk' of+ 0 -> finaliseStreamEnd chunk zstate+ _ -> checkHeaderSplit (S.head chunk) chunk' zstate+ _ -> checkHeader chunk zstate++ checkHeaderSplit :: Word8 -> S.ByteString -> Stream.State s -> ST s (DecompressStream (ST s))+ checkHeaderSplit 0x1f chunk zstate+ | S.head chunk == 0x8b = do+ let resume = decompressStream format params True (S.pack [0x1f, 0x8b])+ if S.length chunk > 1+ then do+ -- have to handle the remaining data in this chunk+ (DecompressInputRequired next, zstate') <- runStreamST resume zstate+ (strm', zstate'') <- runStreamST (next (S.tail chunk)) zstate'+ go strm' zstate'' False+ else do+ -- subtle special case when the chunk tail is empty+ -- yay for QC tests+ (strm, zstate') <- runStreamST resume zstate+ go strm zstate' False+ checkHeaderSplit byte chunk zstate =+ finaliseStreamEnd (S.cons byte chunk) zstate++ checkHeader :: S.ByteString -> Stream.State s -> ST s (DecompressStream (ST s))+ checkHeader chunk zstate+ | S.index chunk 0 == 0x1f+ , S.index chunk 1 == 0x8b = do+ let resume = decompressStream format params True chunk+ (strm', zstate') <- runStreamST resume zstate+ go strm' zstate' False+ checkHeader chunk zstate = finaliseStreamEnd chunk zstate++ finaliseStreamEnd unconsumed zstate = do+ _ <- runStreamST Stream.finalise zstate+ return (DecompressStreamEnd unconsumed)++ finaliseStreamError err zstate = do+ _ <- runStreamST Stream.finalise zstate+ return (DecompressStreamError err)
Codec/Compression/Zlib/Stream.hsc view
@@ -60,12 +60,14 @@ Status(..), Flush(..), ErrorCode(..),+ -- ** Special operations+ inflateReset, -- * Buffer management -- ** Input buffer pushInputBuffer, inputBufferEmpty,- remainingInputBuffer,+ popRemainingInputBuffer, -- ** Output buffer pushOutputBuffer,@@ -92,15 +94,11 @@ ) where --- Note we don't use the MIN_VERSION_* macros here for compatability with--- old Cabal versions that come with old GHC, that didn't provide these--- macros for .hsc files. So we use __GLASGOW_HASKELL__ as a proxy.- import Foreign ( Word8, Ptr, nullPtr, plusPtr, peekByteOff, pokeByteOff , ForeignPtr, FinalizerPtr, mallocForeignPtrBytes, addForeignPtrFinalizer , withForeignPtr, touchForeignPtr, minusPtr )-#if __GLASGOW_HASKELL__ >= 702+#if MIN_VERSION_base(4,4,0) import Foreign.ForeignPtr.Unsafe ( unsafeForeignPtrToPtr ) import System.IO.Unsafe ( unsafePerformIO ) #else@@ -114,12 +112,12 @@ import Data.ByteString.Internal (nullForeignPtr) import qualified Data.ByteString.Unsafe as B import Data.ByteString (ByteString)-#if !(__GLASGOW_HASKELL__ >= 710)+#if !(MIN_VERSION_base(4,8,0)) import Control.Applicative (Applicative(..)) #endif import Control.Monad (ap,liftM)-#if __GLASGOW_HASKELL__ >= 702-#if __GLASGOW_HASKELL__ >= 708+#if MIN_VERSION_base(4,4,0)+#if MIN_VERSION_base(4,7,0) import Control.Monad.ST.Strict #else import Control.Monad.ST.Strict hiding (unsafeIOToST)@@ -168,8 +166,8 @@ inputBufferEmpty = getInAvail >>= return . (==0) -remainingInputBuffer :: Stream (ForeignPtr Word8, Int, Int)-remainingInputBuffer = do+popRemainingInputBuffer :: Stream (ForeignPtr Word8, Int, Int)+popRemainingInputBuffer = do inBuf <- getInBuf inNext <- getInNext@@ -177,6 +175,7 @@ -- there really should be something to pop, otherwise it's silly assert (inAvail > 0) $ return ()+ setInAvail 0 return (inBuf, inNext `minusPtr` unsafeForeignPtrToPtr inBuf, inAvail) @@ -283,6 +282,23 @@ setOutAvail (outAvail + outExtra) return result ++inflateReset :: Stream ()+inflateReset = do++ outAvail <- getOutAvail+ inAvail <- getInAvail+ -- At the point where this is used, all the output should have been consumed+ -- and any trailing input should be extracted and resupplied explicitly, not+ -- just left.+ assert (outAvail == 0 && inAvail == 0) $ return ()++ err <- withStreamState $ \zstream ->+ c_inflateReset zstream+ failIfError err+++ deflateSetDictionary :: ByteString -> Stream Status deflateSetDictionary dict = do err <- withStreamState $ \zstream ->@@ -698,10 +714,10 @@ data WindowBits = WindowBits Int | DefaultWindowBits -- This constructor must be last to make -- the Ord instance work. The Ord instance- -- is defined with and used by the tests.+ -- is used by the tests. -- It makse sense because the default value -- is is also the max value at 15.- deriving (Eq, Show, Typeable+ deriving (Eq, Ord, Show, Typeable #if __GLASGOW_HASKELL__ >= 702 , Generic #endif@@ -1002,6 +1018,8 @@ foreign import ccall unsafe "zlib.h &inflateEnd" c_inflateEnd :: FinalizerPtr StreamState +foreign import ccall unsafe "zlib.h inflateReset"+ c_inflateReset :: StreamState -> IO CInt foreign import ccall unsafe "zlib.h deflateInit2_" c_deflateInit2_ :: StreamState
changelog view
@@ -1,11 +1,3 @@-0.6.1.1 Duncan Coutts <duncan@community.haskell.org> April 2015-- * Fixed building with GHC 7.0 and 7.2--0.6.0.2 Duncan Coutts <duncan@community.haskell.org> April 2015-- * Fixed building with GHC 7.0 and 7.2- 0.6.1.0 Duncan Coutts <duncan@community.haskell.org> April 2015 * Support for concatenated gzip files (multiple back-to-back streams)
test/Test.hs view
@@ -28,7 +28,6 @@ #endif - main :: IO () main = defaultMain $ testGroup "zlib tests" [@@ -36,6 +35,9 @@ testProperty "decompress . compress = id (standard)" prop_decompress_after_compress, testProperty "decompress . compress = id (Zlib -> GZipOrZLib)" prop_gziporzlib1, testProperty "decompress . compress = id (GZip -> GZipOrZlib)" prop_gziporzlib2,+ testProperty "concatenated gzip members" prop_gzip_concat,+ testProperty "multiple gzip members, boundaries (all 2-chunks)" prop_multiple_members_boundary2,+ testProperty "multiple gzip members, boundaries (all 3-chunks)" prop_multiple_members_boundary3, testProperty "prefixes of valid stream detected as truncated" prop_truncated ], testGroup "unit tests" [@@ -46,7 +48,9 @@ testCase "dectect inflate with wrong dict" test_wrong_dictionary, testCase "dectect inflate with right dict" test_right_dictionary, testCase "handle trailing data" test_trailing_data,+ testCase "multiple gzip members" test_multiple_members, testCase "check small input chunks" test_small_chunks,+ testCase "check empty input" test_empty, testCase "check exception raised" test_exception ] ]@@ -83,6 +87,42 @@ decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==> liftM2 (==) (decompress gzipOrZlibFormat dp . compress gzipFormat cp) id +prop_gzip_concat :: CompressParams+ -> DecompressParams+ -> BL.ByteString+ -> Property+prop_gzip_concat cp dp input =+ decompressWindowBits dp >= compressWindowBits cp &&+ decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==>+ let catComp = BL.concat (replicate 5 (compress gzipFormat cp input))+ compCat = compress gzipFormat cp (BL.concat (replicate 5 input))++ in decompress gzipFormat dp { decompressAllMembers = True } catComp+ == decompress gzipFormat dp { decompressAllMembers = True } compCat++prop_multiple_members_boundary2 :: Property+prop_multiple_members_boundary2 =+ forAll shortStrings $ \bs ->+ all (\c -> decomp c == BL.append bs bs)+ (twoChunkSplits (comp bs `BL.append` comp bs))+ where+ comp = compress gzipFormat defaultCompressParams+ decomp = decompress gzipFormat defaultDecompressParams++ shortStrings = fmap BL.pack $ listOf arbitrary++prop_multiple_members_boundary3 :: Property+prop_multiple_members_boundary3 =+ forAll shortStrings $ \bs ->+ all (\c -> decomp c == BL.append bs bs)+ (threeChunkSplits (comp bs `BL.append` comp bs))+ where+ comp = compress gzipFormat defaultCompressParams+ decomp = decompress gzipFormat defaultDecompressParams++ shortStrings = sized $ \sz -> resize (sz `div` 10) $+ fmap BL.pack $ listOf arbitrary+ prop_truncated :: Format -> Property prop_truncated format = forAll shortStrings $ \bs ->@@ -170,12 +210,27 @@ test_trailing_data :: Assertion test_trailing_data = withSampleData "two-files.gz" $ \hnd -> do- let decomp = decompressIO gzipFormat defaultDecompressParams+ let decomp = decompressIO gzipFormat defaultDecompressParams {+ decompressAllMembers = False+ } chunks <- assertDecompressOkChunks hnd decomp case chunks of [chunk] -> chunk @?= BS.Char8.pack "Test 1" _ -> assertFailure "expected single chunk" +test_multiple_members :: Assertion+test_multiple_members =+ withSampleData "two-files.gz" $ \hnd -> do+ let decomp = decompressIO gzipFormat defaultDecompressParams {+ decompressAllMembers = True+ }+ chunks <- assertDecompressOkChunks hnd decomp+ case chunks of+ [chunk1,+ chunk2] -> do chunk1 @?= BS.Char8.pack "Test 1"+ chunk2 @?= BS.Char8.pack "Test 2"+ _ -> assertFailure "expected two chunks"+ test_small_chunks :: Assertion test_small_chunks = do uncompressedFile <- readSampleData "not-gzip"@@ -190,10 +245,21 @@ compressedFile <- readSampleData "hello.gz" (GZip.decompress . smallChunks) compressedFile @?= GZip.decompress compressedFile - where- smallChunks :: BL.ByteString -> BL.ByteString- smallChunks = BL.fromChunks . map (\c -> BS.pack [c]) . BL.unpack+test_empty :: Assertion+test_empty = do+ -- Regression test to make sure we only ask for input once in the case of+ -- initially empty input. We previously asked for input twice before+ -- returning the error.+ let decomp = decompressIO zlibFormat defaultDecompressParams+ case decomp of+ DecompressInputRequired next -> do+ decomp' <- next BS.empty+ case decomp' of+ DecompressStreamError TruncatedInput -> return ()+ _ -> assertFailure "expected truncated error" + _ -> assertFailure "expected input"+ test_exception :: Assertion test_exception = (do@@ -211,6 +277,25 @@ #else toStrict = BS.concat . BL.toChunks #endif++-----------------------+-- Chunk boundary utils++smallChunks :: BL.ByteString -> BL.ByteString+smallChunks = BL.fromChunks . map (\c -> BS.pack [c]) . BL.unpack++twoChunkSplits :: BL.ByteString -> [BL.ByteString]+twoChunkSplits bs = zipWith (\a b -> BL.fromChunks [a,b]) (BS.inits sbs) (BS.tails sbs)+ where+ sbs = toStrict bs++threeChunkSplits :: BL.ByteString -> [BL.ByteString]+threeChunkSplits bs =+ [ BL.fromChunks [a,b,c]+ | (a,x) <- zip (BS.inits sbs) (BS.tails sbs)+ , (b,c) <- zip (BS.inits x) (BS.tails x) ]+ where+ sbs = toStrict bs -------------- -- HUnit Utils
test/Test/Codec/Compression/Zlib/Internal.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Test code and properties for "Codec.Compression.Zlib.Internal"@@ -12,8 +11,6 @@ import Control.Monad (ap) -deriving instance Show CompressParams- instance Arbitrary CompressParams where arbitrary = return CompressParams `ap` arbitrary `ap` arbitrary `ap` arbitrary `ap` arbitrary@@ -27,10 +24,9 @@ [(1, return n) | n <- [131072..1048576]] -deriving instance Show DecompressParams- instance Arbitrary DecompressParams where arbitrary = return DecompressParams `ap` arbitrary `ap` arbitraryBufferSize `ap` return Nothing+ `ap` arbitrary
test/Test/Codec/Compression/Zlib/Stream.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Test code and properties for "Codec.Compression.Zlib.Stream"@@ -24,7 +23,6 @@ ++ map compressionLevel [1..9] -deriving instance Ord WindowBits instance Arbitrary WindowBits where arbitrary = elements $ defaultWindowBits:map windowBits [8..15]
zlib.cabal view
@@ -1,5 +1,5 @@ name: zlib-version: 0.6.0.2+version: 0.6.1.0 copyright: (c) 2006-2015 Duncan Coutts license: BSD3 license-file: LICENSE@@ -42,6 +42,7 @@ other-modules: Codec.Compression.Zlib.Stream if impl(ghc < 7) default-language: Haskell98+ default-extensions: PatternGuards else default-language: Haskell2010 other-extensions: CPP, ForeignFunctionInterface, RankNTypes, BangPatterns,