diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +## 0.5.3.0 + +* Add `DecompressError` to export list of `Codec.Compression.BZip.Internal`. +* Copy some documentation from `zlib`. +* Add argument documentation to functions in `Codec.Compression.BZip.Internal`. +* Treat `DataErrorMagic` same as DataError by converting them to `DecompressStreamError`. + ## 0.5.2.0 * Fix CVE-2019-12900 by updating C sources to 1.0.8. diff --git a/Codec/Compression/BZip/Internal.hs b/Codec/Compression/BZip/Internal.hs --- a/Codec/Compression/BZip/Internal.hs +++ b/Codec/Compression/BZip/Internal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, Rank2Types, DeriveDataTypeable #-} +{-# LANGUAGE CPP, Rank2Types #-} ----------------------------------------------------------------------------- -- | -- Copyright : (c) 2006-2008 Duncan Coutts @@ -17,7 +17,11 @@ decompress, -- * Monadic incremental interface + -- $incremental-compression + -- ** Incremental compression + -- $using-incremental-compression + CompressStream(..), compressST, compressIO, @@ -25,7 +29,10 @@ foldCompressStreamWithInput, -- ** Incremental decompression + -- $using-incremental-decompression + DecompressStream(..), + DecompressError(..), decompressST, decompressIO, foldDecompressStream, @@ -46,16 +53,11 @@ import Control.Exception (Exception, throw, assert) import Control.Monad.ST.Lazy hiding (stToIO) import Control.Monad.ST.Strict (stToIO) -#if __GLASGOW_HASKELL__ >= 702 import qualified Control.Monad.ST.Unsafe as Unsafe (unsafeIOToST) -#else -import qualified Control.Monad.ST.Strict as Unsafe (unsafeIOToST) -#endif import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as L import qualified Data.ByteString as S import qualified Data.ByteString.Internal as S -import Data.Typeable (Typeable) import GHC.IO (noDuplicate) import qualified Codec.Compression.BZip.Stream as Stream @@ -127,7 +129,76 @@ defaultCompressBufferSize = 16 * 1024 - L.chunkOverhead defaultDecompressBufferSize = 32 * 1024 - L.chunkOverhead +-- $incremental-compression +-- The pure 'Codec.Compression.BZip.Internal.compress' and +-- 'Codec.Compression.BZip.Internal.decompress' functions are streaming in the sense +-- that they can produce output without demanding all input, however they need +-- the input data stream as a lazy 'L.ByteString'. Having the input data +-- stream as a lazy 'L.ByteString' often requires using lazy I\/O which is not +-- appropriate in all circumstances. +-- +-- For these cases an incremental interface is more appropriate. This interface +-- 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 represent the unfolding of the process of +-- compressing and decompressing. They operates in either the 'ST' or 'IO' +-- monads. They can be lifted into other incremental abstractions like pipes or +-- conduits, or they can be used directly in the following style. +-- $using-incremental-compression +-- +-- In a loop: +-- +-- * Inspect the status of the stream +-- +-- * When it is 'CompressInputRequired' then you should call the action, +-- passing a chunk of input (or 'BS.empty' when no more input is available) +-- to get the next state of the stream and continue the loop. +-- +-- * When it is 'CompressOutputAvailable' then do something with the given +-- chunk of output, and call the action to get the next state of the stream +-- and continue the loop. +-- +-- * When it is 'CompressStreamEnd' then terminate the loop. +-- +-- Note that you cannot stop as soon as you have no more input, you need to +-- carry on until all the output has been collected, i.e. until you get to +-- 'CompressStreamEnd'. +-- +-- Here is an example where we get input from one file handle and send the +-- compressed output to another file handle. +-- +-- > go :: Handle -> Handle -> CompressStream IO -> IO () +-- > go inh outh (CompressInputRequired next) = do +-- > inchunk <- BS.hGet inh 4096 +-- > go inh outh =<< next inchunk +-- > go inh outh (CompressOutputAvailable outchunk next) = +-- > BS.hPut outh outchunk +-- > go inh outh =<< next +-- > go _ _ CompressStreamEnd = return () +-- +-- The same can be achieved with 'foldCompressStream': +-- +-- > foldCompressStream +-- > (\next -> do inchunk <- BS.hGet inh 4096; next inchunk) +-- > (\outchunk next -> do BS.hPut outh outchunk; next) +-- > (return ()) + +-- $using-incremental-decompression +-- +-- The use of 'DecompressStream' is very similar to 'CompressStream' but with +-- a few differences: +-- +-- * There is the extra possibility of a 'DecompressStreamError' +-- +-- * There can be extra trailing data after a compressed stream, and the +-- 'DecompressStreamEnd' includes that. +-- +-- Otherwise the same loop style applies, and there are fold functions. + -- | The unfolding of the compression process, where you provide a sequence -- of uncompressed data chunks as input and receive a sequence of compressed -- data chunks as output. The process is incremental, in that the demand for @@ -150,11 +221,34 @@ -- One way to look at this is that it runs the stream, using callback functions -- for the three stream events. -- -foldCompressStream :: Monad m - => ((S.ByteString -> m a) -> m a) - -> (S.ByteString -> m a -> m a) - -> m a - -> CompressStream m -> m a +foldCompressStream + :: Monad m + => ((S.ByteString -> m a) -> m a) + -- ^ How to obtain more input to be compressed. + -- Typically, this is a lambda of the form + -- + -- > \consume -> do { bs <- obtainData ; consume bs } + -- + -> (S.ByteString -> m a -> m a) + -- ^ The right-folding operation. Note that the + -- second argument is already embedded in the + -- monad. This is typically a lambda of the form + -- + -- > \chunk next -> Data.ByteString.Lazy.chunk chunk <$> next + -- + -- or + -- + -- > \chunk next -> do { writeData chunk ; next} + -- + -> m a + -- ^ The base value of the fold. If the output + -- is itself a 'L.ByteString', this can just + -- be (@return@ 'L.empty'). + -> CompressStream m + -- ^ The input stream. Typically, this is + -- ('compressIO' @params@) or ('compressST' @params@), + -- depending on the choice of monad. + -> m a foldCompressStream input output end = fold where fold (CompressInputRequired next) = @@ -175,11 +269,19 @@ -- -- > toChunks = foldCompressStreamWithInput (:) [] -- -foldCompressStreamWithInput :: (S.ByteString -> a -> a) - -> a - -> (forall s. CompressStream (ST s)) - -> L.ByteString - -> a +foldCompressStreamWithInput + :: (S.ByteString -> a -> a) + -- ^ The right-folding operation, used to create output. + -- In typical usage, this is 'L.chunk'. + -> a + -- ^ The base value of the fold. In typical usage, + -- this is just 'L.empty' or 'mempty'. + -> (forall s. CompressStream (ST s)) + -- ^ The compression stream. Typically, this is + -- ('compressST' @params@). + -> L.ByteString + -- ^ The input lazy 'L.ByteString'. + -> a foldCompressStreamWithInput chunk end = \s lbs -> runST (fold s (L.toChunks lbs)) where @@ -196,8 +298,24 @@ fold CompressStreamEnd _inchunks = return end +-- | Compress a data stream provided as a lazy 'L.ByteString'. +-- +-- There are no expected error conditions. All input data streams are valid. It +-- is possible for unexpected errors to occur, such as running out of memory, +-- or finding the wrong version of the bz2 C library; these are thrown as +-- exceptions. +-- compress :: CompressParams -> L.ByteString -> L.ByteString + +-- | Incremental compression in the 'ST' monad. Using 'ST' makes it possible +-- to write pure /lazy/ functions while making use of incremental compression. +-- +-- Chunk size must fit into t'CUInt'. compressST :: CompressParams -> CompressStream (ST s) + +-- | Incremental compression in the 'IO' monad. +-- +-- Chunk size must fit into t'CUInt'. compressIO :: CompressParams -> CompressStream IO compress params = foldCompressStreamWithInput @@ -206,6 +324,7 @@ compressST params = compressStreamST params compressIO params = compressStreamIO params +-- | Chunk size must fit into t'CUInt'. compressStream :: CompressParams -> S.ByteString -> Stream (CompressStream Stream) compressStream (CompressParams blockSize workFactor initChunkSize) = @@ -289,7 +408,11 @@ Stream.Error _ msg -> fail msg - +-- | The unfolding of the decompression process, where you provide a sequence +-- of compressed data chunks as input and receive a sequence of uncompressed +-- data chunks as output. The process is incremental, in that the demand for +-- input and provision of output are interleaved. +-- data DecompressStream m = DecompressInputRequired { @@ -311,10 +434,18 @@ decompressStreamError :: DecompressError } +-- | The possible error cases when decompressing a stream. +-- +-- This can be 'show'n to give a human readable error message. +-- +-- @since 0.5.3.0 data DecompressError = + -- | The compressed data stream ended prematurely. This may happen if the + -- input data stream was truncated. TruncatedInput + -- | If the compressed data stream is corrupted in any way then you will + -- get this error. | DataFormatError String - deriving (Typeable) instance Show DecompressError where show TruncatedInput = modprefix "premature end of compressed data stream" @@ -325,12 +456,44 @@ instance Exception DecompressError -foldDecompressStream :: Monad m - => ((S.ByteString -> m a) -> m a) - -> (S.ByteString -> m a -> m a) - -> (S.ByteString -> m a) - -> (DecompressError -> m a) - -> DecompressStream m -> m a +-- | A fold over the 'DecompressStream' in the given monad. +-- +-- One way to look at this is that it runs the stream, using callback functions +-- for the four stream events. +-- +foldDecompressStream + :: Monad m + => ((S.ByteString -> m a) -> m a) + -- ^ How to obtain more input for the decompression + -- stream. Typically, this is a lambda of the form + -- + -- > \consume -> do { bs <- obtainData ; consume bs } + -- + -> (S.ByteString -> m a -> m a) + -- ^ The right-folding operation. Note that the + -- second argument is already embedded in the + -- monad. This is typically a lambda of the form + -- + -- > \chunk next -> Data.ByteString.Lazy.Internal.chunk chunk <$> next + -- + -- or + -- + -- > \chunk next -> do { writeData chunk ; next} + -- + -> (S.ByteString -> m a) + -- ^ How to handle any trailing data after + -- decompression is completed. To ignore it, + -- just pass @const (return bas)@, where @bas@ + -- is the base value of the right-fold operation. + -> (DecompressError -> m a) + -- ^ How to handle errors. Typically, this is + -- 'throw', but it can be e.g. (@return@ . 'Left') + -- if the output value is wrapped in 'Either'. + -> DecompressStream m + -- ^ The input stream. Typically, this is + -- ('decompressIO' @params@) or ('decompressST' @params@), + -- depending on the choice of monad. + -> m a foldDecompressStream input output end err = fold where fold (DecompressInputRequired next) = @@ -342,12 +505,38 @@ fold (DecompressStreamEnd inchunk) = end inchunk fold (DecompressStreamError derr) = err derr -foldDecompressStreamWithInput :: (S.ByteString -> a -> a) - -> (L.ByteString -> a) - -> (DecompressError -> a) - -> (forall s. DecompressStream (ST s)) - -> L.ByteString - -> a +-- | A variant on 'foldDecompressStream' that is pure rather than operating in a +-- monad and where the input is provided by a lazy 'L.ByteString'. So we only +-- have to deal with the output, end and error parts, making it like a foldr on +-- a list of output chunks. +-- +-- For example: +-- +-- > toChunks params = foldDecompressStreamWithInput (:) (const []) throw (decompressST params) +-- +-- or +-- +-- > import qualified Data.ByteString.Lazy as L +-- > import qualified Data.ByteString.Lazy.Internal as L +-- > +-- > decompressWith params = foldDecompressStreamWithInput (L.chunk) (const L.empty) throw (decompressST params) +-- +foldDecompressStreamWithInput + :: (S.ByteString -> a -> a) + -- ^ The right-folding operation, used to create output. + -- In typical usage, this is 'L.chunk'. + -> (L.ByteString -> a) + -- ^ How to handle any trailing data; typically, this + -- is discarded. + -> (DecompressError -> a) + -- ^ How to handle any errors. To raise this as an + -- error, just use 'throw'. + -> (forall s. DecompressStream (ST s)) + -- ^ The decompression stream. Typically, this is + -- ('decompressST' @params@). + -> L.ByteString + -- ^ The input lazy `L.ByteString`. + -> a foldDecompressStreamWithInput chunk end err = \s lbs -> runST (fold s (L.toChunks lbs)) where @@ -367,8 +556,23 @@ fold (DecompressStreamError derr) _ = return $ err derr +-- | Decompress a data stream provided as a lazy 'L.ByteString'. +-- +-- It will throw an exception if any error is encountered in the input data. +-- If you need more control over error handling then use one of the incremental +-- versions, 'decompressST' or 'decompressIO'. +-- decompress :: DecompressParams -> L.ByteString -> L.ByteString + +-- | Incremental decompression in the 'ST' monad. Using 'ST' makes it possible +-- to write pure /lazy/ functions while making use of incremental decompression. +-- +-- Chunk size must fit into t'CUInt'. decompressST :: DecompressParams -> DecompressStream (ST s) + +-- | Incremental decompression in the 'IO' monad. +-- +-- Chunk size must fit into t'CUInt'. decompressIO :: DecompressParams -> DecompressStream IO decompress params = foldDecompressStreamWithInput @@ -377,6 +581,7 @@ decompressST params = decompressStreamST params decompressIO params = decompressStreamIO params +-- | Chunk size must fit into t'CUInt'. decompressStream :: DecompressParams -> S.ByteString -> Stream (DecompressStream Stream) decompressStream (DecompressParams memLevel initChunkSize) = @@ -458,6 +663,7 @@ Stream.Error code msg -> case code of Stream.DataError -> finish (DecompressStreamError (DataFormatError msg)) + Stream.DataErrorMagic -> finish (DecompressStreamError (DataFormatError msg)) _ -> fail msg finish end = do diff --git a/Codec/Compression/BZip/Stream.hsc b/Codec/Compression/BZip/Stream.hsc --- a/Codec/Compression/BZip/Stream.hsc +++ b/Codec/Compression/BZip/Stream.hsc @@ -62,27 +62,15 @@ ( Word8, Ptr, nullPtr, plusPtr, peekByteOff, pokeByteOff , ForeignPtr, FinalizerPtr, mallocForeignPtrBytes, addForeignPtrFinalizer , finalizeForeignPtr, withForeignPtr, touchForeignPtr, minusPtr ) -#if __GLASGOW_HASKELL__ >= 702 import Foreign.ForeignPtr.Unsafe ( unsafeForeignPtrToPtr ) -#else -import Foreign ( unsafeForeignPtrToPtr ) -#endif import Foreign.C import Data.ByteString.Internal (nullForeignPtr) import System.IO (hPutStrLn, stderr) import Control.Applicative (Applicative(..)) import Control.Monad (liftM, ap) import qualified Control.Monad.Fail as Fail -#if __GLASGOW_HASKELL__ >= 702 -#if __GLASGOW_HASKELL__ >= 708 import Control.Monad.ST.Strict -#else -import Control.Monad.ST.Strict hiding (unsafeIOToST) -#endif import Control.Monad.ST.Unsafe -#else -import Control.Monad.ST.Strict -#endif import Control.Exception (assert) import Prelude (Int, IO, Bool, String, Functor, Monad(..), Show(..), return, (>>), (>>=), fmap, (.), ($), fromIntegral, error, otherwise, (<=), (&&), (>=), show, (++), (+), (==), (-), (>)) @@ -257,12 +245,8 @@ instance Monad Stream where (>>=) = thenZ --- m >>= f = (m `thenZ` \a -> consistencyCheck `thenZ_` returnZ a) `thenZ` f (>>) = (*>) return = pure -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif instance Fail.MonadFail Stream where fail = (finalise >>) . failZ diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/bzlib.cabal b/bzlib.cabal --- a/bzlib.cabal +++ b/bzlib.cabal @@ -1,5 +1,5 @@ name: bzlib -version: 0.5.2.0 +version: 0.5.3.0 copyright: (c) 2006-2015 Duncan Coutts license: BSD3 license-file: LICENSE @@ -21,7 +21,7 @@ extra-doc-files: README.md CHANGELOG.md extra-source-files: cbits-extra/hs-bzlib.h -tested-with: GHC==9.8.2, GHC==9.6.4, GHC==9.4.8, GHC==9.2.8, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 +tested-with: GHC==9.14.1, GHC==9.12.2, GHC==9.10.3, GHC==9.8.4, GHC==9.6.7, GHC==9.4.8, GHC==9.2.8, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 source-repository head type: git @@ -32,13 +32,10 @@ exposed-modules: Codec.Compression.BZip, Codec.Compression.BZip.Internal other-modules: Codec.Compression.BZip.Stream - build-depends: base >= 3 && < 5, + build-depends: base >= 4.9 && < 5, bytestring >= 0.9 && < 0.13 - if impl(ghc < 8.0) - build-depends: fail < 5 if os(windows) build-depends: base >= 4.11 - includes: bzlib.h ghc-options: -Wall if !(os(windows) || impl(ghcjs) || os(ghcjs) || arch(wasm32)) -- Normally we use the the standard system bz2 lib: @@ -59,6 +56,5 @@ build-depends: base, bytestring, bzlib, QuickCheck == 2.*, tasty >= 0.8 && < 1.6, - tasty-quickcheck >= 0.8 && < 0.11, - tasty-hunit >= 0.8 && < 0.11 + tasty-quickcheck >= 0.8 && < 0.12 ghc-options: -Wall diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,32 +1,49 @@ -{-# LANGUAGE CPP #-} - module Main where -import Codec.Compression.BZip.Internal - +import Codec.Compression.BZip.Internal ( + CompressParams (..), + DecompressParams (..), + DecompressStream (..), + compress, + decompress, + decompressIO, + defaultDecompressParams, + ) +import Control.Monad (liftM2) +import qualified Data.ByteString as B +import Data.Word (Word8) import Test.Codec.Compression.BZip.Internal () import Test.Codec.Compression.BZip.Stream () - -import Test.QuickCheck -import Test.Tasty -import Test.Tasty.QuickCheck +import Test.QuickCheck (Property, Testable (..), ioProperty, (==>)) +import Test.Tasty (defaultMain, testGroup) +import Test.Tasty.QuickCheck (testProperty) import Utils () -import Control.Monad - - main :: IO () -main = defaultMain $ - testGroup "bzip tests" [ - testGroup "property tests" [ - testProperty "decompress . compress = id (standard)" prop_decompress_after_compress - ] - ] - +main = + defaultMain $ + testGroup + "bzip tests" + [ testProperty "decompress . compress = id (standard)" prop_decompress_after_compress + , testProperty "decoding 66 does not throw" $ decodeByte 66 + , testProperty "decoding 67 does not throw" $ decodeByte 67 + ] -prop_decompress_after_compress :: CompressParams - -> DecompressParams - -> Property +prop_decompress_after_compress + :: CompressParams + -> DecompressParams + -> Property prop_decompress_after_compress cp dp = decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==> - liftM2 (==) (decompress dp . compress cp) id + liftM2 (==) (decompress dp . compress cp) id + +decodeByte :: Word8 -> Property +decodeByte w8 = case decompressIO defaultDecompressParams of + DecompressInputRequired cont -> ioProperty $ do + state <- cont (B.singleton w8) + pure $ case state of + DecompressInputRequired {} -> property True + DecompressOutputAvailable {} -> property False + DecompressStreamEnd {} -> property False + DecompressStreamError {} -> property True + _ -> property False