diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, 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 Herbert Valerio Riedel 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/brotli-streams.cabal b/brotli-streams.cabal new file mode 100644 --- /dev/null +++ b/brotli-streams.cabal @@ -0,0 +1,60 @@ +cabal-version: 1.12 +build-type: Simple +name: brotli-streams +version: 0.0.0.0 + +synopsis: IO-Streams interface for Brotli (RFC7932) compression +homepage: https://github.com/hvr/brotli-streams +bug-reports: https://github.com/hvr/brotli-streams/issues +license: BSD3 +license-file: LICENSE +author: Herbert Valerio Riedel +maintainer: hvr@gnu.org +copyright: (c) 2016, Herbert Valerio Riedel +category: Codec, Compression, IO-Streams + +description: + () is a generic-purpose lossless compression algorithm suitable for 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 IO-Streams interface for the Brotli compression algorithm. + . + Decompressing Brotli 'InputStreams' and compressing 'OutputStreams' + to Brotli streams with tunable (de)compression parameters is supported. + . + +source-repository head + type: git + location: https://github.com/hvr/brotli-streams.git + +library + default-language: Haskell2010 + other-extensions: Trustworthy + + hs-source-dirs: src + exposed-modules: System.IO.Streams.Brotli + + build-depends: base >=4.5 && <4.13, + bytestring >=0.9.2 && <0.11, + io-streams >=1.3 && <1.6, + brotli ==0.0.* + + ghc-options: -Wall + +test-suite lzma-streams-test + default-language: Haskell2010 + hs-source-dirs: src-tests + main-is: lzma-streams-test.hs + type: exitcode-stdio-1.0 + + build-depends: base, + bytestring, + io-streams, + brotli-streams, + + HUnit == 1.6.*, + QuickCheck == 2.13.*, + test-framework == 0.8.*, + test-framework-hunit == 0.3.*, + test-framework-quickcheck2 == 0.3.* + + ghc-options: -Wall -threaded diff --git a/src-tests/lzma-streams-test.hs b/src-tests/lzma-streams-test.hs new file mode 100644 --- /dev/null +++ b/src-tests/lzma-streams-test.hs @@ -0,0 +1,64 @@ +import qualified System.IO.Streams.Brotli as Brotli +import qualified System.IO.Streams as Streams +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 +import Test.HUnit hiding (Test) +import qualified Data.ByteString as BS + +import System.IO.Unsafe + +main :: IO () +main = defaultMain [ testGroup "System.IO.Streams.Brotli" tests ] + where + tests = [ test0, test1, test2, prop1 ] + +test0 :: Test +test0 = testCase "empty" $ (decode . encode) BS.empty @?= BS.empty + +test1 :: Test +test1 = testCase "hello" $ (decode . encode) bs @?= bs + where + bs = BS.pack [104,101,108,108,111] + +test2 :: Test +test2 = testCase "10MiB" $ (decode . encode) bs @?= bs + where + bs = BS.replicate (10*1024*1024) 0xaa + +prop1 :: Test +prop1 = testProperty "random" go + where + go s = (decode . encode) bs == bs + where + bs = BS.pack s + +{- concat not supported yet +prop2 :: Test +prop2 = testProperty "random-concat" go + where + go s s2 = decode (encode bs `BS.append` encode bs2) == bs `BS.append` bs2 + where + bs = BS.pack s + bs2 = BS.pack s2 +-} + +encode :: BS.ByteString -> BS.ByteString +encode bs = unsafePerformIO $ do + lst <- Streams.outputToList $ \obs -> do + ibs <- Streams.fromByteString bs + obs' <- Brotli.compress obs + Streams.connect ibs obs' + + return (BS.concat lst) +{-# NOINLINE encode #-} + +decode :: BS.ByteString -> BS.ByteString +decode bs = unsafePerformIO $ do + lst <- Streams.outputToList $ \obs -> do + ibs <- Streams.fromByteString bs + ibs' <- Brotli.decompress ibs + Streams.connect ibs' obs + + return (BS.concat lst) +{-# NOINLINE decode #-} diff --git a/src/System/IO/Streams/Brotli.hs b/src/System/IO/Streams/Brotli.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/Streams/Brotli.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE Trustworthy #-} + +-- | +-- Module : System.IO.Streams.Brotli +-- Copyright : © 2016 Herbert Valerio Riedel +-- License : BSD3 +-- +-- Maintainer : hvr@gnu.org +-- +-- Simple IO-Streams interface for Brotli compression (). +-- +module System.IO.Streams.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 Codec.Compression.Brotli (DecompressStream(..), CompressStream(..)) +import qualified Codec.Compression.Brotli as Brotli + +import Control.Exception +import Control.Monad +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.IORef +import Data.Maybe +import System.IO.Streams (InputStream, OutputStream, + makeInputStream, makeOutputStream) +import qualified System.IO.Streams as Streams + +-- | Decompress a Brotli-compressed 'InputStream' of strict 'ByteString's +decompress :: InputStream ByteString -> IO (InputStream ByteString) +decompress = decompressWith Brotli.defaultDecompressParams + +-- | Like 'decompress' but with the ability to specify various decompression +-- parameters. Typical usage: +-- +-- > decompressWith defaultDecompressParams { decompress... = ... } +decompressWith :: Brotli.DecompressParams -> InputStream ByteString -> IO (InputStream ByteString) +decompressWith parms ibs = do + st <- newIORef =<< Brotli.decompressIO parms + makeInputStream (go st) + where + go stref = do + st' <- goFeed =<< readIORef stref + case st' of + DecompressInputRequired _ -> do + writeIORef stref st' + fail "the impossible happened" + + DecompressOutputAvailable outb next -> do + writeIORef stref =<< next + return (Just outb) + + DecompressStreamEnd leftover -> do + unless (BS.null leftover) $ do + Streams.unRead leftover ibs + writeIORef stref (DecompressStreamEnd BS.empty) + return Nothing + + DecompressStreamError rc -> do + writeIORef stref st' + throwIO rc + + -- feed engine + goFeed (DecompressInputRequired supply) = + goFeed =<< supply . fromMaybe BS.empty =<< getChunk + goFeed s = return s + + -- wrapper around 'read ibs' to retry until a non-empty ByteString or Nothing is returned + getChunk = do + mbs <- Streams.read ibs + case mbs of + Just bs | BS.null bs -> getChunk + _ -> return mbs + +---------------------------------------------------------------------------- +---------------------------------------------------------------------------- + +-- | Convert an 'OutputStream' that consumes compressed 'ByteString's +-- (in the Brotli format) into an 'OutputStream' that consumes +-- uncompressed 'ByteString's +compress :: OutputStream ByteString -> IO (OutputStream ByteString) +compress = compressWith Brotli.defaultCompressParams + +-- | Like 'compress' but with the ability to specify various compression +-- parameters. Typical usage: +-- +-- > compressWith defaultCompressParams { compress... = ... } +compressWith :: Brotli.CompressParams -> OutputStream ByteString -> IO (OutputStream ByteString) +compressWith parms obs = do + st <- newIORef =<< Brotli.compressIO parms + makeOutputStream (go st) + where + go stref (Just chunk) = do + st <- readIORef stref + st' <- case st of + CompressInputRequired flush supply + | BS.null chunk -> goOutput True =<< flush + | otherwise -> goOutput False =<< supply chunk + _ -> fail "compressWith: unexpected state" + writeIORef stref st' + case st' of + CompressInputRequired _ _ -> return () + _ -> fail "compressWith: unexpected state" + + -- EOF + go stref Nothing = do + st <- readIORef stref + st' <- case st of + CompressInputRequired _ supply -> goOutput False =<< supply BS.empty + _ -> fail "compressWith[EOF]: unexpected state" + writeIORef stref st' + case st' of + CompressStreamEnd -> return () + _ -> fail "compressWith[EOF]: unexpected state" + + -- Drain output from CompressStream + goOutput flush st@(CompressInputRequired _ _) = do + when flush $ + Streams.write (Just BS.empty) obs + return st + goOutput flush (CompressOutputAvailable obuf next) = do + Streams.write (Just obuf) obs + goOutput flush =<< next + goOutput _ st@CompressStreamEnd = do + Streams.write Nothing obs + return st