brotli-conduit (empty) → 0.0.0.0
raw patch · 5 files changed
+297/−0 lines, 5 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, brotli, brotli-conduit, bytestring, conduit, resourcet, test-framework, test-framework-hunit, test-framework-quickcheck2, transformers
Files
- LICENSE +27/−0
- Setup.hs +2/−0
- brotli-conduit.cabal +59/−0
- src/Data/Conduit/Brotli.hs +104/−0
- tests/Main.hs +105/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2012, Alpha Heavy Industries+ 2019, Herbert Valerio Riedel+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.+- Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+- Neither the names of the copyright owners nor the names of the+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ brotli-conduit.cabal view
@@ -0,0 +1,59 @@+cabal-version: 1.12+build-type: Simple+name: brotli-conduit+version: 0.0.0.0++synopsis: Conduit interface for Brotli (RFC7932) compression.+description:+ <http://brotli.org Brotli> (<https://tools.ietf.org/html/rfc7932 RFC7932>) is a generic-purpose lossless compression algorithm suitable for <https://en.wikipedia.org/wiki/HTTP_compression HTTP compression> that compresses data using a combination of a modern variant of the LZ77 algorithm, Huffman coding and 2nd order context modeling.+ .+ This package provides an Conduit interface for the <https://brotli.org Brotli compression algorithm>.++license: BSD3+license-file: LICENSE+author: Nathan Howell, Herbert Valerio Riedel+maintainer: hvr@gnu.org+homepage: http://github.com/hvr/brotli-conduit+bug-reports: http://github.com/hvr/brotli-conduit/issues+category: Codec, Compression, Conduit++source-repository head+ type: git+ location: https://github.com/hvr/brotli-conduit.git++library+ default-language: Haskell2010+ other-extensions: Trustworthy+ hs-source-dirs: src+ exposed-modules: Data.Conduit.Brotli+ build-depends:+ base >= 4.5 && < 4.13,+ bytestring >= 0.9.2 && < 0.11,+ conduit >= 1.1.0 && < 1.4,+ brotli >= 0.0.0.0 && < 0.1,+ resourcet >= 1.1.0 && < 1.3,+ transformers >= 0.3.0.0 && < 0.6++ ghc-options: -Wall++test-suite brotli-conduit-tests+ default-language: Haskell2010+ hs-source-dirs: tests+ type: exitcode-stdio-1.0+ main-is: Main.hs++ build-depends:+ -- dependencies with version bounds inherited from the library stanza+ base,+ brotli-conduit,+ bytestring,+ conduit,+ resourcet,+ -- additional dependencies that require version bounds+ test-framework == 0.8.*,+ test-framework-hunit == 0.3.*,+ test-framework-quickcheck2 == 0.3.*,+ HUnit == 1.6.*,+ QuickCheck == 2.13.*++ ghc-options: -threaded -fno-warn-deprecations
+ src/Data/Conduit/Brotli.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE Trustworthy #-}++-- |+-- Module : Data.Conduit.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 Data.Conduit.Brotli+ ( -- * Simple interface+ compress+ , decompress++ -- * Extended interface+ -- ** Compression+ , compressWith++ , Brotli.defaultCompressParams+ , Brotli.CompressParams+ , Brotli.compressLevel+ , Brotli.compressWindowSize+ , Brotli.compressMode+ , Brotli.compressSizeHint+ , Brotli.CompressionLevel(..)+ , Brotli.CompressionWindowSize(..)+ , Brotli.CompressionMode(..)++ -- ** Decompression+ , decompressWith++ , Brotli.defaultDecompressParams+ , Brotli.DecompressParams+ , Brotli.decompressDisableRingBufferReallocation++ ) where++import qualified Codec.Compression.Brotli as Brotli+import Control.Applicative as App+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.Trans.Resource+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Conduit+import Data.Conduit.List (peek)++-- | Decompress a 'ByteString' from a compressed Brotli stream.+decompress :: (MonadThrow m, MonadIO m) => ConduitM ByteString ByteString m ()+decompress = decompressWith Brotli.defaultDecompressParams++-- | Like 'decompress' but with the ability to specify various decompression+-- parameters. Typical usage:+--+-- > decompressWith defaultDecompressParams { decompress... = ... }+decompressWith :: (MonadThrow m, MonadIO m) => Brotli.DecompressParams -> ConduitM ByteString ByteString m ()+decompressWith parms = do+ c <- peek+ case c of+ Nothing -> throwM $ userError $ "Data.Conduit.Brotli.decompress: invalid empty input"+ Just _ -> liftIO (Brotli.decompressIO parms) >>= go+ where+ go s@(Brotli.DecompressInputRequired more) = do+ mx <- await+ case mx of+ Just x+ | B.null x -> go s -- ignore/skip empty bytestring chunks+ | otherwise -> liftIO (more x) >>= go+ Nothing -> liftIO (more B.empty) >>= go+ go (Brotli.DecompressOutputAvailable output cont) = do+ yield output+ liftIO cont >>= go+ go (Brotli.DecompressStreamEnd rest) = do+ if B.null rest+ then App.pure ()+ else leftover rest+ go (Brotli.DecompressStreamError ecode) =+ throwM $ userError $ "Data.Conduit.Brotli.decompress: error (" ++ Brotli.showBrotliDecoderErrorCode ecode ++ ")"+++-- | Compress a 'ByteString' into a Brotli container stream.+compress :: (MonadIO m) => ConduitM ByteString ByteString m ()+compress = compressWith Brotli.defaultCompressParams++-- | Like 'compress' but with the ability to specify various compression+-- parameters. Typical usage:+--+-- > compressWith defaultCompressParams { compress... = ... }+compressWith :: MonadIO m => Brotli.CompressParams -> ConduitM ByteString ByteString m ()+compressWith parms = do+ s <- liftIO (Brotli.compressIO parms)+ go s+ where+ go s@(Brotli.CompressInputRequired _flush more) = do+ mx <- await+ case mx of+ Just x+ | B.null x -> go s -- ignore/skip empty bytestring chunks+ | otherwise -> liftIO (more x) >>= go+ Nothing -> liftIO (more B.empty) >>= go+ go (Brotli.CompressOutputAvailable output cont) = do+ yield output+ liftIO cont >>= go+ go Brotli.CompressStreamEnd = pure ()
+ tests/Main.hs view
@@ -0,0 +1,105 @@+import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck+import Test.QuickCheck.Monadic+import Control.Monad.Trans.Resource++import qualified Data.ByteString as B+import qualified Data.Conduit as C+import qualified Data.Conduit.List as Cl+import Data.List+import Data.Word+import Data.Conduit.Brotli+import System.IO.Error (tryIOError)+++main = defaultMain tests++tests =+ [ testGroup "Compress" compressTests+ , testGroup "Decompress" decompressTests+ , testGroup "Chained" chainedTests+ ]++compressTests =+ [ testProperty "compressAndDiscard" prop_compressAndDiscard+ , testProperty "compressAndCheckLength" prop_compressAndCheckLength+ ]++decompressTests =+ [ testProperty "decompressEmpty" prop_decompressEmpty+-- TODO: redesign these tests+-- , testProperty "decompressRandom" prop_decompressRandom+-- , testProperty "decompressCorrupt" prop_decompressCorrupt+ ]++chainedTests =+ [ testProperty "chain" prop_chain+ , testProperty "compressThenDecompress" prop_compressThenDecompress+ ]++someString :: Gen B.ByteString+someString = do+ val <- listOf $ elements [0..255::Word8]+ return $ B.pack val++someBigString :: Gen B.ByteString+someBigString = resize (8*1024) someString++prop_compressAndDiscard :: Property+prop_compressAndDiscard = monadicIO . forAllM someBigString $ \ str -> do+ run . runResourceT $ Cl.sourceList [str] C.$$ compress C.=$= Cl.sinkNull++prop_compressAndCheckLength :: Property+prop_compressAndCheckLength = monadicIO . forAllM someBigString $ \ str -> do+ len <- run . runResourceT $ Cl.sourceList [str] C.$$ compress C.=$= Cl.fold (\ acc el -> acc + B.length el) 0+ -- random strings don't compress very well+ assert (len > B.length str `div` 2)+ assert (len - 64 < B.length str * 2)++prop_chain :: Property+prop_chain = monadicIO . forAllM someBigString $ \ str -> do+ str' <- run . runResourceT $ Cl.sourceList [str] C.$$ compress C.=$= decompress C.=$= Cl.consume+ return $ str == B.concat str'++prop_compressThenDecompress :: Property+prop_compressThenDecompress = monadicIO . forAllM someBigString $ \ str -> do+ blob <- run . runResourceT $ Cl.sourceList [str] C.$$ compress C.=$= Cl.consume+ let blob' = B.concat blob+ randIdx <- pick $ elements [0..B.length blob'-1]+ let resplit = let (x,y) = B.splitAt randIdx blob' in [x,y]+ str' <- run . runResourceT $ Cl.sourceList resplit C.$$ decompress C.=$= Cl.consume+ return $ str == B.concat str'++prop_decompressRandom :: Property+prop_decompressRandom = monadicIO . forAllM someBigString $ \ str -> do+ header <- run . runResourceT $ Cl.sourceList [] C.$$ compress C.=$= Cl.consume+ let blob = header ++ [str]+ ioErrorE <- run $+ tryIOError (runResourceT $ Cl.sourceList blob C.$$ decompress C.=$= Cl.sinkNull)+ assert $ isLeft' ioErrorE++prop_decompressCorrupt :: Property+prop_decompressCorrupt = monadicIO . forAllM someBigString $ \ str -> do+ header <- run . runResourceT $ Cl.sourceList [] C.$$ compress C.=$= Cl.consume+ let header' = B.concat header+ randVal <- pick $ elements [0..255::Word8]+ randIdx <- pick $ elements [0..B.length header'-1]+ let (left, right) = B.splitAt randIdx header'+ updated = left `B.append` (randVal `B.cons` B.tail right)+ blob = [updated, str]+ ioErrorE <- run $+ tryIOError (runResourceT $ Cl.sourceList blob C.$$ decompress C.=$= Cl.sinkNull)+ assert $ isLeft' ioErrorE++prop_decompressEmpty :: Property+prop_decompressEmpty = monadicIO . forAllM someBigString $ \ str -> do+ count <- pick $ elements [0..10]+ let blob = replicate count B.empty+ ioErrorE <- run $+ tryIOError (runResourceT $ Cl.sourceList blob C.$$ decompress C.=$= Cl.sinkNull)+ assert $ isLeft' ioErrorE+++isLeft' = either (const True) (const False)