streaming-brotli (empty) → 0.0.0.0
raw patch · 5 files changed
+257/−0 lines, 5 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, brotli, bytestring, streaming, streaming-brotli, streaming-bytestring, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src-tests/test.hs +47/−0
- src/Streaming/Brotli.hs +120/−0
- streaming-brotli.cabal +58/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 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 name of Ben Gamari nor the names of other+ 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
+ src-tests/test.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main(main) where++import Streaming.Brotli++import qualified Data.ByteString as BS+import qualified Data.ByteString.Streaming as S+import qualified Streaming as S+import qualified Streaming.Prelude as PP++import Test.QuickCheck (Arbitrary (arbitrary), Property,+ counterexample, quickCheck,+ withMaxSuccess)+import Test.QuickCheck.Monadic (assert, monadicIO, monitor, run)++-- | roundtrip without trailing extra data+prop_roundTrip :: [BS.ByteString] -> Property+prop_roundTrip bss = monadicIO $ do+ bss' <- run $ pipeline bss+ monitor $ counterexample $ show bss'+ assert (BS.concat bss' == BS.concat bss)+ where+ pipeline :: S.MonadIO m => [BS.ByteString] -> m [BS.ByteString]+ pipeline = PP.toList_ . S.toChunks . decompress_ . compress . S.fromChunks . PP.each++-- | roundtrip with trailing extra data+prop_roundTrip2 :: [BS.ByteString] -> [BS.ByteString] -> Property+prop_roundTrip2 bss trailer = monadicIO $ do+ (bss',trailer') <- run $ pipeline (bss,trailer)+ monitor $ counterexample $ show (bss',trailer')+ assert ((BS.concat bss', BS.concat trailer') == (BS.concat bss, BS.concat trailer))+ where+ pipeline :: S.MonadIO m => ([BS.ByteString],[BS.ByteString]) -> m ([BS.ByteString],[BS.ByteString])+ pipeline (ibs,itl) = do+ let itls = S.fromChunks . PP.each $ itl+ obs PP.:> tbss <- PP.toList . S.toChunks . decompress . (`S.append` itls) . compress . S.fromChunks . PP.each $ ibs+ tbs <- PP.toList_ . S.toChunks $ tbss+ pure (obs,tbs)++main :: IO ()+main = do+ quickCheck (withMaxSuccess 10000 prop_roundTrip)+ quickCheck (withMaxSuccess 10000 prop_roundTrip2)++instance Arbitrary BS.ByteString where+ arbitrary = BS.pack <$> arbitrary
+ src/Streaming/Brotli.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE Trustworthy #-}++-- |+-- Module : Streaming.Brotli+-- Copyright : © 2019 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 Streaming.Brotli+ ( -- * Simple interface+ compress+ , decompress+ , 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.Exception (throwIO)+import qualified Data.ByteString as B+import Data.ByteString.Streaming (ByteString, chunk, effects,+ nextChunk, null_)+import Streaming (MonadIO (liftIO), lift)++-- | Decompress a compressed Brotli stream.+--+-- The monadic return value is a stream representing the possibly+-- unconsumed leftover data from the input stream; see also 'decompress_'.+decompress :: MonadIO m+ => ByteString m r -- ^ compressed stream+ -> ByteString m (ByteString m r) -- ^ uncompressed stream+decompress = decompressWith Brotli.defaultDecompressParams++-- | Convenience wrapper around 'decompress' which fails eagerly if+-- the compressed stream contains any trailing data+decompress_ :: MonadIO m+ => ByteString m r -- ^ compressed stream+ -> ByteString m r -- ^ uncompressed stream+decompress_ is = do+ mr <- decompress is+ lift $ do+ noLeftovers <- null_ mr+ if noLeftovers+ then effects mr+ else liftIO (throwIO (Brotli.BrotliException "extra trailing data"))++-- | Like 'decompress' but with the ability to specify various decompression+-- parameters. Typical usage:+--+-- > decompressWith defaultDecompressParams { decompress... = ... }+decompressWith :: MonadIO m+ => Brotli.DecompressParams+ -> ByteString m r -- ^ compressed stream+ -> ByteString m (ByteString m r) -- ^ uncompressed stream+decompressWith params stream0 =+ go stream0 =<< liftIO (Brotli.decompressIO params)+ where+ go stream enc@(Brotli.DecompressInputRequired cont) = do+ lift (nextChunk stream) >>= \case+ Right (ibs,stream')+ | B.null ibs -> go stream' enc -- should not happen+ | otherwise -> go stream' =<< liftIO (cont ibs)+ Left r -> go (pure r) =<< liftIO (cont B.empty)+ go stream (Brotli.DecompressOutputAvailable obs cont) = do+ chunk obs+ go stream =<< liftIO cont+ go stream (Brotli.DecompressStreamEnd leftover) =+ pure (chunk leftover >> stream)+ go _stream (Brotli.DecompressStreamError ecode) =+ liftIO (throwIO ecode)++-- | Compress into a Brotli compressed stream.+compress :: MonadIO m+ => ByteString m r -- ^ compressed stream+ -> ByteString m r -- ^ uncompressed stream+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+ -> ByteString m r -- ^ uncompressed stream+ -> ByteString m r -- ^ compressed stream+compressWith params stream0 =+ go stream0 =<< liftIO (Brotli.compressIO params)+ where+ go stream enc@(Brotli.CompressInputRequired _flush cont) = do+ lift (nextChunk stream) >>= \case+ Right (x, stream')+ | B.null x -> go stream' enc -- should not happen+ | otherwise -> go stream' =<< liftIO (cont x)+ Left r -> go (pure r) =<< liftIO (cont B.empty)+ go stream (Brotli.CompressOutputAvailable obs cont) = do+ chunk obs+ go stream =<< liftIO cont+ go stream Brotli.CompressStreamEnd = stream
+ streaming-brotli.cabal view
@@ -0,0 +1,58 @@+cabal-version: 1.12+build-type: Simple+name: streaming-brotli+version: 0.0.0.0++synopsis: Streaming interface for Brotli (RFC7932) compression+homepage: https://github.com/hvr/streaming-brotli+bug-reports: https://github.com/hvr/streaming-brotli/issues+license: BSD3+license-file: LICENSE+author: Herbert Valerio Riedel+maintainer: hvr@gnu.org+category: Codec, Compression, Streaming++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 <http://hackage.haskell.org/package/streaming streaming> API for the Brotli compression algorithm.+ .++source-repository head+ type: git+ location: https://github.com/hvr/streaming-brotli.git++library+ default-language: Haskell2010+ other-extensions: Trustworthy LambdaCase++ hs-source-dirs: src+ exposed-modules: Streaming.Brotli++ build-depends: base >= 4.8 && < 4.13+ , bytestring >= 0.10.6 && < 0.11+ , brotli == 0.0.*+ , streaming-bytestring >= 0.1.6 && < 0.2+ , streaming == 0.2.*++ ghc-options: -Wall++test-suite test+ default-language: Haskell2010+ hs-source-dirs: src-tests+ main-is: test.hs+ type: exitcode-stdio-1.0++ build-depends: base+ , bytestring+ , streaming+ , streaming-brotli+ , streaming-bytestring++ , HUnit == 1.6.*+ , QuickCheck == 2.13.*+ , test-framework == 0.8.*+ , test-framework-hunit == 0.3.*+ , test-framework-quickcheck2 == 0.3.*++ ghc-options: -Wall -threaded