├── .gitignore ├── README.md ├── brotli-conduit ├── LICENSE ├── README.md ├── Setup.hs ├── brotli-conduit.cabal ├── src │ └── Data │ │ └── Conduit │ │ └── Brotli.hs └── test │ └── Spec.hs ├── brotli ├── LICENSE ├── README.md ├── Setup.hs ├── hs-brotli.cabal ├── src │ └── Codec │ │ └── Compression │ │ ├── Brotli.hs │ │ └── Brotli │ │ └── Internal.hs └── test │ └── Spec.hs ├── docs └── CODE_OF_CONDUCT.md ├── pipes-brotli ├── LICENSE ├── README.md ├── Setup.hs ├── pipes-brotli.cabal ├── src │ └── Pipes │ │ └── Brotli.hs └── test │ └── Spec.hs ├── stack.yaml ├── streaming-brotli ├── LICENSE ├── README.md ├── Setup.hs ├── src │ └── Lib.hs ├── streaming-brotli.cabal └── test │ └── Spec.hs └── wai-middleware-brotli ├── LICENSE ├── README.md ├── Setup.hs ├── app └── Main.hs ├── src └── Network │ └── Wai │ └── Middleware │ └── Brotli.hs ├── test ├── Spec.hs ├── sample.txt └── words.br └── wai-middleware-brotli.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work 2 | .\#* 3 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # 🥦 Brotli compression for Haskell 🥦 2 | 3 | Brotli is a compression format that can achieve higher compression 4 | ratios and compress faster than gzip and deflate. It is supported 5 | natively by [all modern browsers](https://caniuse.com/#search=brotli). 6 | 7 | This monorepo contains: 8 | 9 | - Primitive FFI bindings to Google's official C API 10 | - Higher level strict, lazy, and streaming compression and decompression 11 | interfaces. 12 | - Convenience wrappers for the popular Conduit, Pipes libraries 13 | - WAI middleware to quickly drop in support for Haskell web 14 | applications. 15 | 16 | All of these projects are still alpha quality, so use at your own risk. 17 | 18 | ## Installation 19 | 20 | These libraries are not currently uploaded to Hackage, you can add them 21 | to your stack.yaml: 22 | 23 | ``` yaml 24 | 25 | packages: 26 | - location: 27 | git: https://github.com/iand675/brotli 28 | commit: PRESENT_COMMIT_HERE 29 | subdirs: 30 | - brotli 31 | - brotli-conduit 32 | - wai-middleware-brotli 33 | extra-dep: true 34 | 35 | ``` 36 | 37 | You will also need to install the C library >= 0.6 in a location where 38 | pkg-config can find it. You can run `pkg-config --static --libs --cflags libbrotlienc` to see if it's installed appropriately. 39 | 40 | You can find the C library [here](https://github.com/google/brotli). 41 | 42 | Or install from your package manager: 43 | 44 | | Platform | Installation Command | 45 | |----------------|--------------------------| 46 | | MacOS | `brew install brotli` | 47 | | Ubuntu Xenial | `apt-get install brotli` | 48 | 49 | 50 | ## Roadmap 51 | 52 | All of the base `brotli` package high level bindings are functional, but 53 | it's possible that error cases could presently cause memory leaks. 54 | Any contributions that find and/or fix these situations would be very 55 | welcome. 56 | 57 | More documentation examples are always welcome. 58 | 59 | `streaming-brotli` and `pipes-brotli` aren't really actually implemented 60 | yet. 61 | 62 | It would be great to have benchmarks in place to compare compression 63 | performance with Haskell's gzip bindings. 64 | 65 | ## Contributing 66 | 67 | Please use `hint` and `hindent` on pull requests prior to opening them 68 | up. If fixing any bugs, please implement regression test cases. 69 | 70 | If you have node installed locally, you can run `npm install` or `yarn 71 | install` to set up shared git hooks to to automate these validations. 72 | 73 | Please respect and follow the [Code of Conduct](docs/CODE_OF_CONDUCT.md) 74 | 75 | -------------------------------------------------------------------------------- /brotli-conduit/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Ian Duncan (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Ian Duncan nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /brotli-conduit/README.md: -------------------------------------------------------------------------------- 1 | # brotli-conduit 2 | -------------------------------------------------------------------------------- /brotli-conduit/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /brotli-conduit/brotli-conduit.cabal: -------------------------------------------------------------------------------- 1 | name: brotli-conduit 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | homepage: https://github.com/iand675/hs-brotli#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Ian Duncan 9 | maintainer: ian@iankduncan.com 10 | copyright: Ian Duncan 11 | category: Web 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Data.Conduit.Brotli 19 | build-depends: base >= 4.7 && < 5, 20 | hs-brotli, 21 | conduit, 22 | mtl, 23 | bytestring 24 | default-language: Haskell2010 25 | 26 | test-suite brotli-conduit-test 27 | type: exitcode-stdio-1.0 28 | hs-source-dirs: test 29 | main-is: Spec.hs 30 | build-depends: base 31 | , brotli-conduit 32 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 33 | default-language: Haskell2010 34 | 35 | source-repository head 36 | type: git 37 | location: https://github.com/iand675/hs-brotli 38 | -------------------------------------------------------------------------------- /brotli-conduit/src/Data/Conduit/Brotli.hs: -------------------------------------------------------------------------------- 1 | module Data.Conduit.Brotli 2 | ( compress 3 | , compress' 4 | , Codec.Compression.Brotli.Chunk(..) 5 | , decompress 6 | , decompress' 7 | ) where 8 | 9 | import Codec.Compression.Brotli hiding (compress, decompress) 10 | import Control.Monad.Trans 11 | import qualified Data.ByteString as B 12 | import Data.Conduit 13 | 14 | compress :: MonadIO m => Conduit Codec.Compression.Brotli.Chunk m B.ByteString 15 | compress = compress' defaultCompressionSettings 16 | 17 | compress' :: MonadIO m => CompressionSettings -> Conduit Codec.Compression.Brotli.Chunk m B.ByteString 18 | compress' settings = do 19 | c <- liftIO $ compressor settings 20 | go c 21 | where 22 | go c = case c of 23 | Produce bs next -> do 24 | yield bs 25 | c' <- liftIO next 26 | go c' 27 | Consume f -> do 28 | mres <- await 29 | case mres of 30 | Nothing -> do 31 | c' <- liftIO $ f $ Codec.Compression.Brotli.Chunk B.empty 32 | go c' 33 | Just chnk -> case chnk of 34 | Codec.Compression.Brotli.Chunk bs -> if B.null bs 35 | then go c 36 | else do 37 | c' <- liftIO $ f chnk 38 | go c' 39 | Codec.Compression.Brotli.Flush -> do 40 | c' <- liftIO $ f chnk 41 | go c' 42 | 43 | Error -> error "TODO" 44 | Done -> return () 45 | 46 | decompress :: MonadIO m => Conduit B.ByteString m B.ByteString 47 | decompress = decompress' 48 | 49 | decompress' :: MonadIO m => Conduit B.ByteString m B.ByteString 50 | decompress' = do 51 | dc <- liftIO decompressor 52 | go dc 53 | where 54 | go dc = case dc of 55 | Produce bs next -> do 56 | yield bs 57 | c' <- liftIO next 58 | go c' 59 | Consume f -> do 60 | mres <- await 61 | case mres of 62 | Nothing -> do 63 | c' <- liftIO $ f B.empty 64 | go c' 65 | Just bs -> if B.null bs 66 | then go dc 67 | else do 68 | c' <- liftIO $ f bs 69 | go c' 70 | Error -> error "TODO" 71 | Done -> return () 72 | -------------------------------------------------------------------------------- /brotli-conduit/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /brotli/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Ian Duncan (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Ian Duncan nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /brotli/README.md: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iand675/hs-brotli/d7bce54b265883fb30a14d39d00cbf1c1308b2b1/brotli/README.md -------------------------------------------------------------------------------- /brotli/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /brotli/hs-brotli.cabal: -------------------------------------------------------------------------------- 1 | name: hs-brotli 2 | version: 0.1.0.0 3 | synopsis: Compression and decompression in the brotli format 4 | description: This package provides a pure interface for compressing and 5 | decompressing streams of data represented as strict or lazy 6 | 'ByteString's. It uses the 7 | 8 | so it has high performance. It supports the \"brotli\", 9 | compression format. 10 | . 11 | It provides a convenient high level API suitable for most 12 | tasks and for the few cases where more control is needed it 13 | provides access to the full brotli feature set 14 | homepage: https://github.com/iand675/hs-brotli#readme 15 | license: BSD3 16 | license-file: LICENSE 17 | author: Ian Duncan 18 | maintainer: ian@iankduncan.com 19 | copyright: Ian Duncan 20 | category: Web 21 | build-type: Simple 22 | extra-source-files: README.md 23 | cabal-version: >=1.10 24 | 25 | library 26 | hs-source-dirs: src 27 | exposed-modules: Codec.Compression.Brotli, 28 | Codec.Compression.Brotli.Internal 29 | build-depends: base >= 4.7 && < 5, ghc-prim, bytestring 30 | extra-libraries: brotlidec, brotlienc 31 | pkgconfig-depends: libbrotlidec, libbrotlienc 32 | default-language: Haskell2010 33 | 34 | test-suite brotli-test 35 | type: exitcode-stdio-1.0 36 | hs-source-dirs: test 37 | main-is: Spec.hs 38 | build-depends: base 39 | , hs-brotli 40 | , bytestring 41 | , tasty 42 | , QuickCheck 43 | , tasty-quickcheck 44 | , quickcheck-instances 45 | , tasty-hunit 46 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 47 | default-language: Haskell2010 48 | 49 | source-repository head 50 | type: git 51 | location: https://github.com/iand675/hs-brotli 52 | -------------------------------------------------------------------------------- /brotli/src/Codec/Compression/Brotli.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FunctionalDependencies #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE MagicHash #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE BangPatterns #-} 7 | module Codec.Compression.Brotli ( 8 | Compress(..) 9 | , compress 10 | , decompress 11 | , BrotliStream(..) 12 | , Chunk(..) 13 | , compressor 14 | , decompressor 15 | , maxCompressedSize 16 | , CompressionSettings(..) 17 | , defaultCompressionSettings 18 | , setCompressionSettings 19 | , I.minWindowBits 20 | , I.maxWindowBits 21 | , I.minInputBlockBits 22 | , I.maxInputBlockBits 23 | , I.minQuality 24 | , I.maxQuality 25 | , I.encoderModeGeneric 26 | , I.encoderModeText 27 | , I.encoderModeFont 28 | ) where 29 | import Control.Monad (when, unless, forM) 30 | import Control.Exception (SomeException, assert, handle, bracket, throw) 31 | import qualified Codec.Compression.Brotli.Internal as I 32 | import qualified Data.ByteString as B 33 | import qualified Data.ByteString.Unsafe as B 34 | import qualified Data.ByteString.Internal as BI 35 | import qualified Data.ByteString.Lazy as L 36 | import qualified Data.ByteString.Lazy.Internal as LI 37 | import Foreign.ForeignPtr 38 | import Data.Maybe (catMaybes) 39 | import Data.IORef 40 | import Data.Int 41 | import Data.Word 42 | import Foreign.C 43 | import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr) 44 | import Foreign.Marshal (alloca, allocaBytes, callocBytes, free) 45 | import Foreign.Storable (sizeOf, peek, poke) 46 | import GHC.Int 47 | import GHC.Types 48 | import System.IO.Unsafe 49 | 50 | data CompressionSettings = CompressionSettings 51 | { compressionQuality :: !Word32 52 | , compressionWindow :: !Word32 53 | , compressionMode :: !I.BrotliEncoderMode 54 | , compressionBufferSize :: !Int 55 | , compressionBlockSize :: !(Maybe Word32) 56 | , compressionDisableLiteralContextModeling :: !(Maybe Word32) 57 | , compressionSizeHint :: !(Maybe Word32) 58 | } 59 | 60 | -- | The default set of parameters for compression. This is typically used with the compressWith function with specific parameters overridden. 61 | defaultCompressionSettings :: CompressionSettings 62 | defaultCompressionSettings = CompressionSettings 63 | { compressionQuality = I.defaultQuality 64 | , compressionWindow = I.defaultWindow 65 | , compressionMode = I.defaultMode 66 | , compressionBufferSize = 0 67 | , compressionBlockSize = Nothing 68 | , compressionDisableLiteralContextModeling = Nothing 69 | , compressionSizeHint = Nothing 70 | } 71 | 72 | setCompressionSettings :: I.BrotliEncoderState -> CompressionSettings -> IO () 73 | setCompressionSettings st CompressionSettings{..}= do 74 | r1 <- I.encoderSetParameter st I.mode $ fromIntegral $ I.fromBrotliEncoderMode compressionMode 75 | r2 <- I.encoderSetParameter st I.quality compressionQuality 76 | r3 <- I.encoderSetParameter st I.lz77WindowSize compressionWindow 77 | mr4 <- forM compressionBlockSize $ I.encoderSetParameter st I.lz77BlockSize 78 | mr5 <- forM compressionDisableLiteralContextModeling $ I.encoderSetParameter st I.disableLiteralContextModeling 79 | mr6 <- forM compressionSizeHint $ I.encoderSetParameter st I.brotliParamSizeHint 80 | if any (/= 1) $ r1 : r2 : r3 : catMaybes [mr4, mr5, mr6] 81 | then error "Invalid compression setting parameter" 82 | else pure () 83 | 84 | -- | Like compress but with the ability to specify various compression parameters. Typical usage: 85 | -- 86 | -- > compressWith defaultCompressionSettings { ... } 87 | -- 88 | -- In particular you can set the compression level: 89 | -- 90 | -- > compressWith defaultCompressParams { compressionQuality = minQuality } 91 | class Compress a b where 92 | compressWith :: CompressionSettings -> a-> b 93 | 94 | -- | Compress a stream of data into the brotli format. 95 | -- 96 | -- This uses the default compression parameters. In particular it uses the highest compression level which favours a higher compression ratio over compression speed. 97 | -- 98 | -- Use compressWith to adjust the compression level or other compression parameters. 99 | compress :: Compress a b => a -> b 100 | compress = compressWith defaultCompressionSettings 101 | 102 | instance Compress B.ByteString B.ByteString where 103 | compressWith CompressionSettings{..} b = unsafePerformIO $ do 104 | let estBufSize = fromIntegral $ I.maxCompressedSize $ fromIntegral $ B.length b 105 | res <- alloca $ \outSize -> do 106 | poke outSize estBufSize 107 | BI.createAndTrim (fromIntegral estBufSize) $ \outBuf -> B.unsafeUseAsCStringLen b $ \(inPtr, inLen) -> do 108 | 109 | ok <- I.encoderCompress (fromIntegral compressionQuality) (fromIntegral compressionWindow) compressionMode (fromIntegral inLen) (castPtr inPtr) outSize outBuf 110 | os <- peek outSize 111 | if (ok /= 1) 112 | then error "Compression error or output buffer is too small" 113 | else pure $ fromIntegral os 114 | pure res 115 | 116 | isTrue :: CInt -> Bool 117 | isTrue (CInt (I32# x)) = isTrue# x 118 | 119 | maxCompressedSize :: Int -> Int 120 | maxCompressedSize = fromIntegral . I.maxCompressedSize . fromIntegral 121 | 122 | hasMoreOutput :: I.BrotliEncoderState -> IO Bool 123 | hasMoreOutput = fmap isTrue . I.encoderHasMoreOutput 124 | 125 | isFinished :: I.BrotliEncoderState -> IO Bool 126 | isFinished = fmap isTrue . I.encoderIsFinished 127 | 128 | takeOutput :: I.BrotliEncoderState -> IO B.ByteString 129 | takeOutput st = alloca $ \sizeP -> do 130 | poke sizeP 0 131 | ptr <- I.encoderTakeOutput st sizeP 132 | takeSize <- peek sizeP 133 | B.packCStringLen (castPtr ptr, fromIntegral takeSize) 134 | 135 | data StreamVars = StreamVars 136 | { availableIn :: !(Ptr CSize) 137 | , availableOut :: !(Ptr CSize) 138 | , totalOut :: !(Ptr CSize) 139 | , nextIn :: !(Ptr (Ptr Word8)) 140 | , nextOut :: !(Ptr (Ptr Word8)) 141 | } deriving (Show) 142 | 143 | 144 | freeStreamVars :: StreamVars -> IO () 145 | freeStreamVars = free . availableIn 146 | 147 | createStreamVars :: IO StreamVars 148 | createStreamVars = do 149 | bs <- callocBytes (3 * sizeOf (0 :: CSize) + 2 * sizeOf (nullPtr :: Ptr Word8)) 150 | let aiPtr = bs 151 | aoPtr = plusPtr aiPtr (sizeOf (0 :: CSize)) 152 | toPtr = plusPtr aoPtr (sizeOf (0 :: CSize)) 153 | niPtr = castPtr $ plusPtr toPtr (sizeOf (nullPtr :: Ptr Word8)) 154 | noPtr = plusPtr niPtr (sizeOf (nullPtr :: Ptr Word8)) 155 | vs@StreamVars{..} = StreamVars aiPtr aoPtr toPtr niPtr noPtr 156 | pure vs 157 | 158 | newtype EncoderFeedResponse = EncoderFeedResponse 159 | { pendingInput :: B.ByteString 160 | } 161 | 162 | -- CAUTION: we aren't ensuring that bytestrings stay alive since the contents are 163 | -- poked in and outlive the function (streaming and all) 164 | -- 165 | -- Must use only within the context of the bytestring be alive via an external unsafeUseAsCStringLen 166 | feedEncoder' :: I.BrotliEncoderState -> StreamVars -> Int -> B.ByteString -> IO CSize 167 | feedEncoder' st vs@StreamVars{..} bufSize bs = B.unsafeUseAsCStringLen bs $ \(bsP, len) -> do 168 | poke availableIn (fromIntegral len) 169 | poke nextIn (castPtr bsP) 170 | res <- isTrue <$> I.encoderCompressStream st I.encoderOperationProcess availableIn nextIn availableOut nextOut totalOut 171 | unless res $ error "Unknown stream encoding failure" 172 | peek availableIn 173 | 174 | -- CAUTION: we aren't ensuring that bytestrings stay alive since the contents are 175 | -- poked in and outlive the function (streaming and all) 176 | -- 177 | -- Must use only within the context of the bytestring be alive via an external unsafeUseAsCStringLen 178 | feedEncoder :: I.BrotliEncoderState -> StreamVars -> Int -> B.ByteString -> IO EncoderFeedResponse 179 | feedEncoder st vs@StreamVars{..} bufSize bs = B.unsafeUseAsCStringLen bs $ \(bsP, len) -> do 180 | poke availableIn (fromIntegral len) 181 | poke nextIn (castPtr bsP) 182 | res <- isTrue <$> I.encoderCompressStream st I.encoderOperationProcess availableIn nextIn availableOut nextOut totalOut 183 | unless res $ error "Unknown stream encoding failure" 184 | unconsumedBytesCount <- peek availableIn 185 | unconsumedBytesP <- peek nextIn 186 | unusedInput <- if unconsumedBytesCount == 0 187 | then pure B.empty 188 | else B.packCStringLen (castPtr unconsumedBytesP, fromIntegral unconsumedBytesCount) 189 | pure $ EncoderFeedResponse unusedInput 190 | 191 | encoderMaybeTakeOutput :: I.BrotliEncoderState -> Int -> IO (Maybe B.ByteString) 192 | encoderMaybeTakeOutput st bufSize = do 193 | takeOut <- isTrue <$> I.encoderHasMoreOutput st 194 | if takeOut 195 | then alloca $ \s -> do 196 | poke s $ fromIntegral bufSize 197 | bsp <- I.encoderTakeOutput st s 198 | len <- peek s 199 | Just <$> B.packCStringLen (castPtr bsp, fromIntegral len) 200 | else pure Nothing 201 | 202 | encoderTakeRestAvailable :: I.BrotliEncoderState -> IO () -> Int -> L.ByteString -> IO L.ByteString 203 | encoderTakeRestAvailable st cleanup bufSize graft = do 204 | out <- encoderMaybeTakeOutput st bufSize 205 | case out of 206 | Nothing -> pure graft 207 | Just bs -> do 208 | rest <- unsafeInterleaveIO $ encoderTakeRestAvailable st cleanup bufSize graft 209 | pure $ LI.Chunk bs rest 210 | 211 | -- | Note that this should be called until returned bytestring is empty. Once is not enough. 212 | finishStream :: I.BrotliEncoderState -> StreamVars -> IO () -> Int -> IO L.ByteString 213 | finishStream st StreamVars{..} cleanup bufSize = do 214 | poke availableIn 0 215 | poke nextIn nullPtr 216 | res <- isTrue <$> I.encoderCompressStream st I.encoderOperationFinish availableIn nextIn availableOut nextOut totalOut 217 | unless res $ error "Unknown stream encoding failure" 218 | encoderTakeRestAvailable st cleanup bufSize L.empty 219 | 220 | 221 | pOff :: Int -> Ptr a -> Ptr b 222 | pOff n p = castPtr $ plusPtr p (n * sizeOf p) 223 | 224 | pushNoCheck :: B.ByteString -> L.ByteString -> L.ByteString 225 | pushNoCheck = LI.Chunk 226 | 227 | instance Compress L.ByteString L.ByteString where 228 | compressWith settings b = unsafePerformIO $ do 229 | inst <- I.createEncoder 230 | setCompressionSettings inst settings 231 | vars <- createStreamVars 232 | poke (availableOut vars) 0 233 | poke (nextOut vars) nullPtr 234 | let cleanup = freeStreamVars vars >> I.destroyEncoder inst 235 | lazyCompress cleanup inst vars b 236 | where 237 | lazyCompress cleanup st vars c = unsafeInterleaveIO $ readChunks cleanup st vars c 238 | readChunks cleanup st vars c = do 239 | case c of 240 | LI.Chunk bs next -> handle (\(e :: SomeException) -> cleanup >> throw e) $ do 241 | (EncoderFeedResponse unusedInput) <- feedEncoder st vars (compressionBufferSize settings) bs 242 | -- NOTE: LI.chunk checks for empty string results so we don't have to worry about empty chunks ourselves. 243 | rest <- lazyCompress cleanup st vars $ LI.chunk unusedInput next 244 | encoderTakeRestAvailable st cleanup (compressionBufferSize settings) rest 245 | LI.Empty -> finishStream st vars (freeStreamVars vars >> I.destroyEncoder st) $ compressionBufferSize settings 246 | 247 | data DecompressionVars = DecompressionVars 248 | { dAvailableInput :: !(Ptr CSize) 249 | , dAvailableOut :: !(Ptr CSize) 250 | , dTotalOut :: !(Ptr CSize) 251 | , dNextIn :: !(Ptr (Ptr Word8)) 252 | , dNextOut :: !(Ptr (Ptr Word8)) 253 | } 254 | 255 | createDecompressionVars :: IO DecompressionVars 256 | createDecompressionVars = do 257 | bs <- callocBytes (3 * sizeOf (0 :: CSize) + 2 * sizeOf (nullPtr :: Ptr Word8)) 258 | let aiPtr = bs 259 | aoPtr = plusPtr aiPtr (sizeOf (0 :: CSize)) 260 | toPtr = plusPtr aoPtr (sizeOf (0 :: CSize)) 261 | niPtr = castPtr $ plusPtr toPtr (sizeOf (nullPtr :: Ptr Word8)) 262 | noPtr = plusPtr niPtr (sizeOf (nullPtr :: Ptr Word8)) 263 | pure $ DecompressionVars aiPtr aoPtr toPtr niPtr noPtr 264 | 265 | destroyDecompressionVars :: DecompressionVars -> IO () 266 | destroyDecompressionVars = free . dAvailableInput 267 | 268 | -- | Decompress a stream of data in the brotli format. 269 | -- 270 | -- There are a number of errors that can occur. In each case an exception will 271 | -- be thrown. 272 | -- 273 | -- Note that the decompression is performed /lazily/. Errors in the data stream 274 | -- may not be detected until the end of the stream is demanded (since it is 275 | -- only at the end that the final checksum can be checked). If this is 276 | -- important to you, you must make sure to consume the whole decompressed 277 | -- stream before doing any IO action that depends on it. 278 | -- 279 | decompress :: L.ByteString -> L.ByteString 280 | decompress b = unsafePerformIO $ do 281 | st <- I.createDecoder 282 | vs <- createDecompressionVars 283 | poke (dAvailableOut vs) 0 284 | poke (dNextOut vs) nullPtr 285 | lazyDecompress st vs b 286 | where 287 | lazyDecompress st vs rest = unsafeInterleaveIO $ writeChunks st vs rest 288 | writeChunks st vs@DecompressionVars{..} lbs = do 289 | case lbs of 290 | LI.Chunk bs rest -> do 291 | v@(res, unconsumed') <- B.unsafeUseAsCStringLen bs $ \(strP, strLen) -> do 292 | poke dAvailableInput $ fromIntegral strLen 293 | poke dNextIn $ castPtr strP 294 | res <- I.decoderDecompressStream st dAvailableInput dNextIn dAvailableOut dNextOut dTotalOut 295 | remainingInputBytes <- peek dAvailableInput 296 | compressedBytesPtr <- peek dNextIn 297 | unconsumed' <- B.packCStringLen (castPtr compressedBytesPtr, fromIntegral remainingInputBytes) 298 | pure (res, unconsumed') 299 | case I.decoderResult res of 300 | I.Success -> do 301 | -- allTheRest <- takeRestAvailable st (I.destroyDecoder st >> destroyDecompressionVars vs) L.empty 302 | -- return allTheRest 303 | pure L.empty 304 | I.NeedsMoreInput -> do 305 | lazyDecompress st vs $ LI.chunk unconsumed' rest 306 | I.NeedsMoreOutput -> do 307 | -- Sneak invariant breaking here by pushing what is quite possibly an empty Chunk. 308 | -- this is intentional because we need one last empty string to trigger either success or error 309 | -- depending on whether the string shouldn't have ended there 310 | afterOut <- lazyDecompress st vs $ LI.Chunk unconsumed' rest 311 | decoderTakeRestAvailable st (pure ()) afterOut 312 | -- TODO need a safe version of decompress too 313 | I.DecoderError e -> I.destroyDecoder st >> throw e 314 | LI.Empty -> do 315 | I.destroyDecoder st 316 | destroyDecompressionVars vs 317 | throw $ I.BrotliDecoderErrorCode 2 318 | 319 | decoderMaybeTakeOutput :: I.BrotliDecoderState -> IO (Maybe B.ByteString) 320 | decoderMaybeTakeOutput st = do 321 | takeIn <- isTrue <$> I.decoderHasMoreOutput st 322 | if takeIn 323 | then alloca $ \s -> do 324 | poke s 0 -- TODO settings 325 | bsp <- I.decoderTakeOutput st s 326 | len <- peek s 327 | Just <$> B.packCStringLen (castPtr bsp, fromIntegral len) 328 | else pure Nothing 329 | 330 | decoderTakeRestAvailable :: I.BrotliDecoderState -> IO () -> L.ByteString -> IO L.ByteString 331 | decoderTakeRestAvailable st cleanup graft = do 332 | out <- decoderMaybeTakeOutput st 333 | case out of 334 | Nothing -> cleanup >> pure graft 335 | Just bs -> do 336 | rest <- unsafeInterleaveIO $ decoderTakeRestAvailable st cleanup graft 337 | pure $ LI.Chunk bs rest 338 | 339 | data Chunk 340 | = Chunk !B.ByteString 341 | | Flush 342 | deriving (Show, Eq) 343 | 344 | data BrotliStream input 345 | = Produce !B.ByteString (IO (BrotliStream input)) 346 | | Consume (input -> IO (BrotliStream input)) 347 | | Error 348 | | Done 349 | 350 | withEncoder :: ForeignPtr I.BrotliEncoderState -> (I.BrotliEncoderState -> IO a) -> IO a 351 | withEncoder p f = withForeignPtr p (f . I.BrotliEncoderState) 352 | 353 | -- | A strict, streaming compressor. This allows compressing 354 | -- values in constant memory in addition to giving fine-grained 355 | -- control of when to flush data in the stream. 356 | compressor :: CompressionSettings -> IO (BrotliStream Chunk) 357 | compressor settings = do 358 | (I.BrotliEncoderState encoder) <- I.createEncoder 359 | efp <- newForeignPtr I.destroyEncoder_ptr encoder 360 | withEncoder efp $ \encoder -> setCompressionSettings encoder settings 361 | vars <- createStreamVars 362 | pure $ go efp vars 363 | where 364 | go efp vars = Consume (consume B.empty) 365 | where 366 | consume 367 | :: B.ByteString 368 | {- ^ Presently poked bytestring 369 | Must `touch` underlying ForeignPtr until 370 | the underlying contents have been consumed 371 | 372 | In other words, consumption must be wrapped in an unsafeUseAsCStringLen to keep it alive. 373 | We could be a bit more fine-grained on things if we use bytestring internals, but maybe 374 | not worth the hassle? 375 | -} 376 | -> Chunk 377 | -> IO (BrotliStream Chunk) 378 | consume !currentBs !chunk = B.unsafeUseAsCStringLen currentBs $ \_ -> do 379 | let StreamVars{..} = vars 380 | case chunk of 381 | Chunk bs -> do 382 | -- print vars 383 | previousUnconsumedSize <- peek availableIn 384 | if previousUnconsumedSize == 0 && B.null bs 385 | then done 386 | else withEncoder efp $ \encoder -> do 387 | unconsumedSize <- 388 | if previousUnconsumedSize == 0 389 | then feedEncoder' 390 | encoder 391 | vars 392 | (compressionBufferSize settings) 393 | bs 394 | else do 395 | _ <- I.encoderCompressStream 396 | encoder 397 | I.encoderOperationProcess 398 | availableIn 399 | nextIn 400 | availableOut 401 | nextOut 402 | totalOut 403 | -- TODO assert result 404 | peek availableIn 405 | 406 | let bytestringRef = if unconsumedSize > 0 then currentBs else B.empty 407 | moreOutput <- hasMoreOutput encoder 408 | if moreOutput 409 | then produce bytestringRef $ if previousUnconsumedSize == 0 410 | then Just chunk 411 | else Nothing 412 | else pure $ Consume (consume bytestringRef) 413 | Flush -> withEncoder efp $ \encoder -> do 414 | -- TODO make appropriate assertions here 415 | -- around in state & out state 416 | I.encoderCompressStream 417 | encoder 418 | I.encoderOperationFlush 419 | availableIn 420 | nextIn 421 | availableOut 422 | nextOut 423 | totalOut 424 | -- ls <- (,) <$> peek availableOut <*> peek availableIn 425 | -- print ls 426 | hasMore <- hasMoreOutput encoder 427 | produce B.empty Nothing 428 | 429 | produce :: B.ByteString -> Maybe Chunk -> IO (BrotliStream Chunk) 430 | produce currentInput unusedInput = withEncoder efp $ \encoder -> do 431 | -- assert: this function is only called from other functions 432 | -- when output is guaranteed 433 | out <- takeOutput encoder 434 | hasMore <- hasMoreOutput encoder 435 | pure $ Produce out $ if hasMore 436 | then produce currentInput unusedInput 437 | else 438 | maybe 439 | (pure $ Consume $ consume B.empty) 440 | (\c -> consume (case c of 441 | Chunk bs -> bs 442 | Flush -> B.empty) c) 443 | unusedInput 444 | 445 | -- err = undefined 446 | done :: IO (BrotliStream Chunk) 447 | done = withEncoder efp $ \encoder -> do 448 | let StreamVars {..} = vars 449 | poke availableIn 0 450 | poke nextIn nullPtr 451 | I.encoderCompressStream 452 | encoder 453 | I.encoderOperationFinish 454 | availableIn 455 | nextIn 456 | availableOut 457 | nextOut 458 | totalOut 459 | done' 460 | 461 | done' = withEncoder efp $ \encoder -> do 462 | out <- encoderMaybeTakeOutput encoder (compressionBufferSize settings) 463 | case out of 464 | Nothing -> do 465 | freeStreamVars vars 466 | pure Done 467 | Just str -> pure $ Produce str done' 468 | 469 | -- | A strict, streaming decompressor. This allows decompressing 470 | -- values in constant memory as long as you don't need the full output 471 | -- at one time. 472 | decompressor :: IO (BrotliStream B.ByteString) 473 | decompressor = do 474 | st <- I.createDecoder 475 | vs <- createDecompressionVars 476 | poke (dAvailableOut vs) 0 477 | poke (dNextOut vs) nullPtr 478 | go st vs 479 | where 480 | go st vs@DecompressionVars {..} = pure $ consume B.empty 481 | where 482 | consume :: B.ByteString -> BrotliStream B.ByteString 483 | consume leftover = 484 | Consume $ \bs -> do 485 | v@(res, unconsumed') <- 486 | B.unsafeUseAsCStringLen 487 | (if B.null leftover 488 | then bs 489 | else if B.null bs 490 | then B.empty 491 | else leftover `mappend` bs) $ \(strP, strLen) -> do 492 | poke dAvailableInput (fromIntegral strLen) 493 | poke dNextIn (castPtr strP) 494 | res <- 495 | I.decoderDecompressStream 496 | st 497 | dAvailableInput 498 | dNextIn 499 | dAvailableOut 500 | dNextOut 501 | dTotalOut 502 | remainingInputBytes <- peek dAvailableInput 503 | compressedBytesPtr <- peek dNextIn 504 | unconsumed' <- 505 | B.packCStringLen 506 | ( castPtr compressedBytesPtr 507 | , fromIntegral remainingInputBytes) 508 | pure (res, unconsumed') 509 | case I.decoderResult res of 510 | I.Success -> done 511 | I.NeedsMoreInput -> pure $ consume B.empty 512 | I.NeedsMoreOutput -> produce unconsumed' 513 | I.DecoderError e -> err -- I.destroyDecoder st >> throw e 514 | produce rem = do 515 | out <- decoderMaybeTakeOutput st 516 | case out of 517 | Nothing -> pure (consume rem) 518 | Just bs -> pure $ Produce bs (produce rem) 519 | err = pure Error 520 | done = do 521 | I.destroyDecoder st 522 | destroyDecompressionVars vs 523 | pure Done 524 | 525 | -------------------------------------------------------------------------------- /brotli/src/Codec/Compression/Brotli/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | module Codec.Compression.Brotli.Internal where 3 | import Control.Exception 4 | import Data.Typeable (Typeable(..)) 5 | import Data.Word 6 | import Foreign.C 7 | import Foreign.Marshal 8 | import Foreign.Ptr 9 | import System.IO.Unsafe 10 | 11 | type BrotliAlloc a = FunPtr (Ptr a -> CSize -> IO (Ptr ())) 12 | type BrotliFree a = FunPtr (Ptr a -> Ptr () -> IO ()) 13 | 14 | minWindowBits, maxWindowBits, minInputBlockBits, maxInputBlockBits, minQuality, maxQuality, defaultQuality, defaultWindow :: Num a => a 15 | minWindowBits = 10 16 | maxWindowBits = 24 17 | minInputBlockBits = 16 18 | maxInputBlockBits = 24 19 | minQuality = 0 20 | maxQuality = 11 21 | defaultQuality = 11 22 | defaultWindow = 22 23 | defaultMode = encoderModeGeneric 24 | 25 | newtype BrotliEncoderMode = BrotliEncoderMode { fromBrotliEncoderMode :: CInt } 26 | deriving (Show) 27 | 28 | -- | Default compression mode. 29 | -- 30 | -- In this mode compressor does not know anything in advance about the 31 | -- properties of the input. 32 | encoderModeGeneric = BrotliEncoderMode 0 33 | -- | Compression mode for UTF-8 formatted text input. 34 | encoderModeText = BrotliEncoderMode 1 35 | -- | Compression mode used in WOFF 2.0 36 | encoderModeFont = BrotliEncoderMode 2 37 | 38 | newtype BrotliEncoderState = BrotliEncoderState (Ptr BrotliEncoderState) 39 | deriving (Show) 40 | 41 | newtype BrotliEncoderOperation = BrotliEncoderOperation CInt 42 | deriving (Show) 43 | 44 | encoderOperationProcess = BrotliEncoderOperation 0 45 | encoderOperationFlush = BrotliEncoderOperation 1 46 | encoderOperationFinish = BrotliEncoderOperation 2 47 | encoderOperationEmitMetadata = BrotliEncoderOperation 3 48 | 49 | newtype BrotliEncoderParameter = BrotliEncoderParameter CInt 50 | deriving (Show) 51 | 52 | mode = BrotliEncoderParameter 0 53 | quality = BrotliEncoderParameter 1 54 | lz77WindowSize = BrotliEncoderParameter 2 55 | lz77BlockSize = BrotliEncoderParameter 3 56 | disableLiteralContextModeling = BrotliEncoderParameter 4 57 | brotliParamSizeHint = BrotliEncoderParameter 5 58 | 59 | foreign import ccall unsafe "BrotliEncoderCreateInstance" brotliEncoderCreateInstance :: BrotliAlloc a -> BrotliFree a -> Ptr a -> IO BrotliEncoderState 60 | 61 | createEncoder :: IO BrotliEncoderState 62 | createEncoder = brotliEncoderCreateInstance nullFunPtr nullFunPtr nullPtr 63 | 64 | foreign import ccall unsafe "BrotliEncoderSetParameter" encoderSetParameter 65 | :: BrotliEncoderState 66 | -> BrotliEncoderParameter 67 | -> Word32 68 | -> IO CInt -- ^ Bool 69 | 70 | foreign import ccall unsafe "BrotliEncoderDestroyInstance" destroyEncoder :: BrotliEncoderState -> IO () 71 | 72 | foreign import ccall unsafe "&BrotliEncoderDestroyInstance" destroyEncoder_ptr :: FunPtr (Ptr BrotliEncoderState -> IO ()) 73 | 74 | 75 | foreign import ccall unsafe "BrotliEncoderMaxCompressedSize" maxCompressedSize :: CSize -> CSize 76 | 77 | foreign import ccall safe "BrotliEncoderCompress" encoderCompress 78 | :: CInt 79 | -> CInt 80 | -> BrotliEncoderMode -- Sizeof? 81 | -> CSize 82 | -> Ptr Word8 83 | -> Ptr CSize 84 | -> Ptr Word8 85 | -> IO CInt -- ^ Bool 86 | 87 | foreign import ccall safe "BrotliEncoderCompressStream" encoderCompressStream 88 | :: BrotliEncoderState 89 | -> BrotliEncoderOperation 90 | -> Ptr CSize 91 | -> Ptr (Ptr Word8) 92 | -> Ptr CSize 93 | -> Ptr (Ptr Word8) 94 | -> Ptr CSize 95 | -> IO CInt -- ^ Bool 96 | 97 | foreign import ccall unsafe "BrotliEncoderIsFinished" encoderIsFinished 98 | :: BrotliEncoderState 99 | -> IO CInt -- ^ Bool 100 | 101 | foreign import ccall unsafe "BrotliEncoderHasMoreOutput" encoderHasMoreOutput 102 | :: BrotliEncoderState 103 | -> IO CInt -- ^ Bool 104 | 105 | foreign import ccall unsafe "BrotliEncoderTakeOutput" encoderTakeOutput 106 | :: BrotliEncoderState 107 | -> Ptr CSize 108 | -> IO (Ptr Word8) 109 | 110 | foreign import ccall unsafe "BrotliEncoderVersion" encoderVersion 111 | :: IO Word32 112 | 113 | 114 | newtype BrotliDecoderState = BrotliDecoderState (Ptr BrotliDecoderState) 115 | 116 | foreign import ccall unsafe "BrotliDecoderCreateInstance" brotliDecoderCreateInstance 117 | :: BrotliAlloc a 118 | -> BrotliFree a 119 | -> Ptr a 120 | -> IO BrotliDecoderState 121 | 122 | createDecoder :: IO BrotliDecoderState 123 | createDecoder = brotliDecoderCreateInstance nullFunPtr nullFunPtr nullPtr 124 | 125 | foreign import ccall unsafe "BrotliDecoderDestroyInstance" destroyDecoder 126 | :: BrotliDecoderState 127 | -> IO () 128 | 129 | foreign import ccall unsafe "&BrotliDecoderDestroyInstance" destroyDecoder_ptr 130 | :: FunPtr (Ptr BrotliDecoderState -> IO ()) 131 | 132 | foreign import ccall safe "BrotliDecoderDecompress" decoderDecompress 133 | :: CSize 134 | -> Ptr Word8 135 | -> Ptr CSize 136 | -> Ptr Word8 137 | -> IO CInt -- TODO result proper value 138 | 139 | foreign import ccall safe "BrotliDecoderDecompressStream" decoderDecompressStream 140 | :: BrotliDecoderState 141 | -> Ptr CSize 142 | -> Ptr (Ptr Word8) 143 | -> Ptr CSize 144 | -> Ptr (Ptr Word8) 145 | -> Ptr CSize 146 | -> IO BrotliDecoderErrorCode -- TODO result proper value 147 | 148 | foreign import ccall unsafe "BrotliDecoderHasMoreOutput" decoderHasMoreOutput 149 | :: BrotliDecoderState 150 | -> IO CInt -- Bool 151 | 152 | foreign import ccall unsafe "BrotliDecoderTakeOutput" decoderTakeOutput 153 | :: BrotliDecoderState 154 | -> Ptr CSize 155 | -> IO (Ptr Word8) 156 | 157 | foreign import ccall unsafe "BrotliDecoderIsUsed" decoderIsUsed 158 | :: BrotliDecoderState 159 | -> IO CInt 160 | 161 | foreign import ccall unsafe "BrotliDecoderIsFinished" decoderIsFinished 162 | :: BrotliDecoderState 163 | -> IO CInt 164 | 165 | newtype BrotliDecoderErrorCode = BrotliDecoderErrorCode CInt 166 | deriving (Eq, Typeable) 167 | 168 | instance Show BrotliDecoderErrorCode where 169 | show c = unsafePerformIO (decoderErrorString c >>= peekCString) 170 | 171 | instance Exception BrotliDecoderErrorCode 172 | 173 | data DecoderResult 174 | = Success 175 | | NeedsMoreInput 176 | | NeedsMoreOutput 177 | | DecoderError BrotliDecoderErrorCode 178 | 179 | decoderResult :: BrotliDecoderErrorCode -> DecoderResult 180 | decoderResult c@(BrotliDecoderErrorCode n) = case n of 181 | 1 -> Success 182 | 2 -> NeedsMoreInput 183 | 3 -> NeedsMoreOutput 184 | _ -> DecoderError c 185 | {-# INLINE decoderResult #-} 186 | 187 | foreign import ccall unsafe "BrotliDecoderGetErrorCode" decoderGetError 188 | :: BrotliDecoderState 189 | -> IO BrotliDecoderErrorCode 190 | 191 | foreign import ccall unsafe "BrotliDecoderErrorString" decoderErrorString 192 | :: BrotliDecoderErrorCode 193 | -> IO CString 194 | 195 | foreign import ccall unsafe "BrotliDecoderVersion" decoderVersion 196 | :: IO Word32 197 | -------------------------------------------------------------------------------- /brotli/test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Control.Concurrent 3 | import Data.ByteString.Char8 (ByteString) 4 | import qualified Data.ByteString as B 5 | import qualified Data.ByteString.Char8 as C 6 | import qualified Data.ByteString.Lazy as L 7 | import qualified Data.ByteString.Lazy.Char8 as CL 8 | import Codec.Compression.Brotli 9 | import Codec.Compression.Brotli.Internal 10 | import System.IO.Error 11 | import Test.Tasty 12 | import Test.Tasty.HUnit 13 | import Test.Tasty.QuickCheck 14 | import Test.QuickCheck 15 | import Test.QuickCheck.Instances 16 | 17 | fastSettings :: CompressionSettings 18 | fastSettings = defaultCompressionSettings { compressionQuality = 4 } 19 | 20 | main :: IO () 21 | main = do 22 | putStrLn "" 23 | defaultMain $ testGroup "Tests" 24 | [ testProperty "Round-trip" $ \bs -> 25 | let cbs = (compressWith fastSettings (bs :: L.ByteString)) :: L.ByteString 26 | dbs = (decompress cbs) :: L.ByteString 27 | in dbs == bs 28 | , testCase "Semicolon" $ sampleRoundTrip ";" 29 | , testCase (show "\139\NUL\128\SOH\NUL\ETX") $ sampleRoundTrip "\139\NUL\128\SOH\NUL\ETX" 30 | , testCase "Empty string" $ sampleRoundTrip "" 31 | , testCase "Paragraph" $ sampleRoundTrip "What you need is an eclipse. However being a tidally locked planet you're not going to have a moon, at least your people would have been idiots for settling on a tidally locked planet with a moon as it would be unstable as discussed in this question: " 32 | , testCase "The dictionary" $ do 33 | catchIOError (L.readFile "/usr/share/dict/words") (const $ pure "") >>= sampleRoundTrip 34 | , testCase "Long, really compressable" longReallyCompressable 35 | , testCase "Streaming" $ do 36 | (Consume c) <- compressor fastSettings 37 | -- putStrLn "Got consumer" 38 | -- bs <- B.readFile "/usr/share/dict/words" -- B.replicate (2 ^ 18) 0 39 | -- putStrLn "Feed once" 40 | (Consume c) <- c $ Chunk "Hello " 41 | -- putStrLn "Flush" 42 | (Produce compressedPt1 followup) <- c Flush 43 | -- putStrLn "Got flush triggered produce" 44 | (Consume c) <- followup 45 | -- putStrLn "Back to consuming" 46 | (Consume c) <- c $ Chunk "World" 47 | -- putStrLn "Fed it some more" 48 | (Produce compressedPt2 followup) <- c $ Chunk "" 49 | -- putStrLn "Done, so should signal that now" 50 | Done <- followup 51 | -- putStrLn "Yup, hit the end" 52 | "Hello World" @?= decompress (CL.fromStrict (compressedPt1 `mappend` compressedPt2)) 53 | ] 54 | {- 55 | quickCheck $ \bs -> 56 | let cbs = (compress (bs :: B.ByteString)) :: B.ByteString 57 | dbs = (decompress cbs) :: B.ByteString 58 | in dbs == bs 59 | -} 60 | 61 | {- 62 | sampleRoundTrip ";" 63 | sampleRoundTrip "\139\NUL\128\SOH\NUL\ETX" 64 | sampleRoundTrip "" 65 | sampleRoundTrip "What you need is an eclipse. However being a tidally locked planet you're not going to have a moon, at least your people would have been idiots for settling on a tidally locked planet with a moon as it would be unstable as discussed in this question: " 66 | L.readFile "/usr/share/dict/words" >>= sampleRoundTrip 67 | longReallyCompressable 68 | -} 69 | {- 70 | needsOutputL 71 | let comped = compress f 72 | print (L.length f, L.length comped, map B.length $ L.toChunks comped) 73 | -} 74 | -- print (compress str :: ByteString) 75 | -- print (compress lstr :: L.ByteString) 76 | -- 77 | {- 78 | -} 79 | -- threadDelay 10000000 80 | 81 | sampleRoundTrip :: L.ByteString -> IO () 82 | sampleRoundTrip l = do 83 | let rt = decompress $ compressWith fastSettings l 84 | L.toStrict l @?= L.toStrict rt 85 | 86 | sample :: IO () 87 | sample = do 88 | putStrLn "Creating encoder" 89 | enc <- createEncoder 90 | print enc 91 | putStrLn "Destroying encoder" 92 | destroyEncoder enc 93 | encoderVersion >>= print 94 | 95 | longReallyCompressable :: IO () 96 | longReallyCompressable = sampleRoundTrip (L.replicate (2 ^ 22) 0) 97 | -------------------------------------------------------------------------------- /docs/CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as 6 | contributors and maintainers pledge to making participation in our project and 7 | our community a harassment-free experience for everyone, regardless of age, body 8 | size, disability, ethnicity, gender identity and expression, level of experience, 9 | nationality, personal appearance, race, religion, or sexual identity and 10 | orientation. 11 | 12 | ## Our Standards 13 | 14 | Examples of behavior that contributes to creating a positive environment 15 | include: 16 | 17 | * Using welcoming and inclusive language 18 | * Being respectful of differing viewpoints and experiences 19 | * Gracefully accepting constructive criticism 20 | * Focusing on what is best for the community 21 | * Showing empathy towards other community members 22 | 23 | Examples of unacceptable behavior by participants include: 24 | 25 | * The use of sexualized language or imagery and unwelcome sexual attention or 26 | advances 27 | * Trolling, insulting/derogatory comments, and personal or political attacks 28 | * Public or private harassment 29 | * Publishing others' private information, such as a physical or electronic 30 | address, without explicit permission 31 | * Other conduct which could reasonably be considered inappropriate in a 32 | professional setting 33 | 34 | ## Our Responsibilities 35 | 36 | Project maintainers are responsible for clarifying the standards of acceptable 37 | behavior and are expected to take appropriate and fair corrective action in 38 | response to any instances of unacceptable behavior. 39 | 40 | Project maintainers have the right and responsibility to remove, edit, or 41 | reject comments, commits, code, wiki edits, issues, and other contributions 42 | that are not aligned to this Code of Conduct, or to ban temporarily or 43 | permanently any contributor for other behaviors that they deem inappropriate, 44 | threatening, offensive, or harmful. 45 | 46 | ## Scope 47 | 48 | This Code of Conduct applies both within project spaces and in public spaces 49 | when an individual is representing the project or its community. Examples of 50 | representing a project or community include using an official project e-mail 51 | address, posting via an official social media account, or acting as an appointed 52 | representative at an online or offline event. Representation of a project may be 53 | further defined and clarified by project maintainers. 54 | 55 | ## Enforcement 56 | 57 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 58 | reported by contacting the project team at 59 | [ian@iankduncan.com](mailto:ian@iankduncan.com). All 60 | complaints will be reviewed and investigated and will result in a response that 61 | is deemed necessary and appropriate to the circumstances. The project team is 62 | obligated to maintain confidentiality with regard to the reporter of an incident. 63 | Further details of specific enforcement policies may be posted separately. 64 | 65 | Project maintainers who do not follow or enforce the Code of Conduct in good 66 | faith may face temporary or permanent repercussions as determined by other 67 | members of the project's leadership. 68 | 69 | ## Attribution 70 | 71 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, 72 | available at https://www.contributor-covenant.org/version/1/4/code-of-conduct.html 73 | 74 | [homepage]: https://www.contributor-covenant.org 75 | 76 | -------------------------------------------------------------------------------- /pipes-brotli/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Ian Duncan (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Ian Duncan nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /pipes-brotli/README.md: -------------------------------------------------------------------------------- 1 | # pipes-brotli 2 | -------------------------------------------------------------------------------- /pipes-brotli/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /pipes-brotli/pipes-brotli.cabal: -------------------------------------------------------------------------------- 1 | name: pipes-brotli 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | homepage: https://github.com/iand675/hs-brotli#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Ian Duncan 9 | maintainer: ian@iankduncan.com 10 | copyright: Ian Duncan 11 | category: Web 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Pipes.Brotli 19 | build-depends: base >= 4.7 && < 5, 20 | hs-brotli, 21 | pipes, 22 | pipes-parse, 23 | mtl, 24 | bytestring 25 | default-language: Haskell2010 26 | 27 | test-suite pipes-brotli-test 28 | type: exitcode-stdio-1.0 29 | hs-source-dirs: test 30 | main-is: Spec.hs 31 | build-depends: base 32 | , pipes-brotli 33 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 34 | default-language: Haskell2010 35 | 36 | source-repository head 37 | type: git 38 | location: https://github.com/iand675/hs-brotli 39 | -------------------------------------------------------------------------------- /pipes-brotli/src/Pipes/Brotli.hs: -------------------------------------------------------------------------------- 1 | module Pipes.Brotli 2 | ( compress 3 | , compress' 4 | ) where 5 | 6 | import Codec.Compression.Brotli hiding (compress, decompress) 7 | import Control.Monad.Trans 8 | import Data.ByteString as B 9 | import Pipes 10 | 11 | compress :: MonadIO m => Pipe Chunk B.ByteString m () 12 | compress = compress' defaultCompressionSettings 13 | 14 | compress' :: MonadIO m => CompressionSettings -> Pipe Chunk B.ByteString m () 15 | compress' settings = do 16 | c <- liftIO $ compressor settings 17 | go c 18 | where 19 | go c = case c of 20 | Produce bs next -> do 21 | yield bs 22 | c' <- liftIO next 23 | go c' 24 | Consume f -> do 25 | chunk <- await 26 | c' <- liftIO $ f chunk 27 | go c' 28 | Error -> error "TODO" 29 | Done -> return () 30 | 31 | decompress :: MonadIO m => Pipe B.ByteString B.ByteString m () 32 | decompress = do 33 | c <- liftIO decompressor 34 | go c 35 | where 36 | go c = case c of 37 | Produce bs next -> do 38 | yield bs 39 | c' <- liftIO next 40 | go c' 41 | Consume f -> do 42 | bs <- await 43 | c' <- liftIO $ f bs 44 | go c' 45 | Error -> error "TODO" 46 | Done -> return () 47 | -------------------------------------------------------------------------------- /pipes-brotli/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-8.2 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - 'brotli' 40 | - 'brotli-conduit' 41 | - 'pipes-brotli' 42 | - 'streaming-brotli' 43 | - 'wai-middleware-brotli' 44 | 45 | # Dependency packages to be pulled from upstream that are not in the resolver 46 | # (e.g., acme-missiles-0.3) 47 | extra-deps: [] 48 | 49 | # Override default flag values for local packages and extra-deps 50 | flags: {} 51 | 52 | # Extra package databases containing global packages 53 | extra-package-dbs: [] 54 | 55 | # Control whether we use the GHC we find on the path 56 | # system-ghc: true 57 | # 58 | # Require a specific version of stack, using version ranges 59 | # require-stack-version: -any # Default 60 | # require-stack-version: ">=1.3" 61 | # 62 | # Override the architecture used by stack, especially useful on Windows 63 | # arch: i386 64 | # arch: x86_64 65 | # 66 | # Extra directories used by stack for building 67 | # extra-include-dirs: [/path/to/dir] 68 | # extra-lib-dirs: [/path/to/dir] 69 | # 70 | # Allow a newer minor version of GHC than the snapshot specifies 71 | # compiler-check: newer-minor 72 | -------------------------------------------------------------------------------- /streaming-brotli/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Ian Duncan (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Ian Duncan nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /streaming-brotli/README.md: -------------------------------------------------------------------------------- 1 | # streaming-brotli 2 | -------------------------------------------------------------------------------- /streaming-brotli/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /streaming-brotli/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) where 4 | 5 | someFunc :: IO () 6 | someFunc = putStrLn "someFunc" 7 | -------------------------------------------------------------------------------- /streaming-brotli/streaming-brotli.cabal: -------------------------------------------------------------------------------- 1 | name: streaming-brotli 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | homepage: https://github.com/iand675/hs-brotli#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Ian Duncan 9 | maintainer: ian@iankduncan.com 10 | copyright: Ian Duncan 11 | category: Web 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Lib 19 | build-depends: base >= 4.7 && < 5 20 | default-language: Haskell2010 21 | 22 | test-suite streaming-brotli-test 23 | type: exitcode-stdio-1.0 24 | hs-source-dirs: test 25 | main-is: Spec.hs 26 | build-depends: base 27 | , streaming-brotli 28 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 29 | default-language: Haskell2010 30 | 31 | source-repository head 32 | type: git 33 | location: https://github.com/iand675/hs-brotli 34 | -------------------------------------------------------------------------------- /streaming-brotli/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /wai-middleware-brotli/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Ian Duncan (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Ian Duncan nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /wai-middleware-brotli/README.md: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iand675/hs-brotli/d7bce54b265883fb30a14d39d00cbf1c1308b2b1/wai-middleware-brotli/README.md -------------------------------------------------------------------------------- /wai-middleware-brotli/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /wai-middleware-brotli/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Main where 3 | 4 | import Control.Concurrent 5 | import Network.HTTP.Types.Status 6 | import Network.Wai 7 | import qualified Network.Wai.Middleware.Brotli as B 8 | import Network.Wai.Handler.Warp 9 | import Network.Wai.Application.Static 10 | import Network.Wai.Middleware.Gzip 11 | 12 | main :: IO () 13 | main = do 14 | let settings = 15 | B.defaultSettings 16 | {B.brotliFilesBehavior = B.BrotliPreCompressed (B.BrotliCacheFolder "."), B.brotliMinimumSize = 5} 17 | -- app = staticApp $ defaultFileServerSettings "." 18 | app = \req respond -> respond $ responseStream ok200 [("Content-Type", "text/wow")] $ \send flush -> do 19 | send "Hello" 20 | flush 21 | threadDelay 10000000 22 | send "World" 23 | 24 | runEnv 3000 (gzip def {- TODO replace gzip with zopfli -} $ B.brotli settings {- $ sdch sdchSettings -} $ app) 25 | -------------------------------------------------------------------------------- /wai-middleware-brotli/src/Network/Wai/Middleware/Brotli.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | --------------------------------------------------------- 4 | -- | 5 | -- Module : Network.Wai.Middleware.Brotli 6 | -- Copyright : Ian Duncan 7 | -- License : BSD3 8 | -- 9 | -- Maintainer : Ian Duncan 10 | -- Stability : Unstable 11 | -- Portability : portable 12 | -- 13 | -- Automatic brotli compression of responses. 14 | -- 15 | -- If you are using this middleware with wai-extra's @gzip@ middleware, 16 | -- it is important that @brotli@ wraps your application before gzip does 17 | -- or your responses will be compressed by both, which is not beneficial. 18 | -- 19 | -- Correct: 20 | -- 21 | -- > gzip def . brotli defaultSettings 22 | -- 23 | -- Incorrect: 24 | -- 25 | -- > brotli defaultSettings . gzip def 26 | --------------------------------------------------------- 27 | module Network.Wai.Middleware.Brotli 28 | ( brotli 29 | , defaultSettings 30 | , BrotliSettings(..) 31 | , defaultShouldCompress 32 | , BrotliFiles(..) 33 | ) where 34 | 35 | import Codec.Compression.Brotli 36 | import Control.Exception 37 | import Control.Monad 38 | import Data.Binary.Builder (toLazyByteString, fromLazyByteString, fromByteString, Builder) 39 | import qualified Data.ByteString.Char8 as B 40 | import qualified Data.ByteString.Lazy as L 41 | import Data.IORef 42 | import Data.Maybe 43 | import Data.Monoid 44 | import Network.HTTP.Types.Header 45 | import Network.HTTP.Types.Status 46 | import Network.Wai 47 | import Network.Wai.Internal 48 | import System.Directory 49 | import System.FilePath 50 | import System.IO 51 | import System.Posix 52 | 53 | data BrotliFiles 54 | = BrotliIgnore -- ^ Do not compress file responses 55 | | BrotliCompress 56 | -- ^ Compress files on the fly. Note that this may counteract zero-copy 57 | -- response optimizations on some platforms. 58 | | BrotliCacheFolder FilePath 59 | -- ^ Compress files, caching them in the specified directory. Note that 60 | -- changes to the original files will not invalidate existing cached files, 61 | -- so it is important to clear the cache directory appropriately if the 62 | -- original file has changed 63 | | BrotliPreCompressed BrotliFiles 64 | -- ^ Look for the original file, only with the ".br" extension appended to it. Will fall back 65 | -- to the provided file setting if the file doesn't exist. 66 | deriving (Read, Eq, Show) 67 | 68 | data BrotliSettings = BrotliSettings 69 | { brotliCompressionSettings :: Request -> Response -> CompressionSettings 70 | , brotliMinimumSize :: Int 71 | , brotliFilesBehavior :: BrotliFiles 72 | , brotliShouldCompress :: BrotliSettings -> Request -> Response -> Bool 73 | , brotliMimePrefixes :: [B.ByteString] 74 | , brotliMimeSuffixes :: [B.ByteString] 75 | } 76 | 77 | -- | It is recommended that you combine your custom logic around 78 | -- deciding to compress with this function, such as: 79 | -- 80 | -- > \settings req resp -> defaultShouldCompress settings req resp && customPredicate 81 | defaultShouldCompress :: BrotliSettings -> Request -> Response -> Bool 82 | defaultShouldCompress settings req resp = 83 | let (mclb, hs) = pluckHeader hContentLength (responseHeaders resp) 84 | (mctb, hs') = pluckHeader hContentType hs 85 | in case mctb of 86 | Nothing -> False 87 | Just ctb -> 88 | case mclb of 89 | Nothing -> checkMime settings ctb 90 | Just clb -> 91 | (fromMaybe True $ do 92 | (x, rest) <- B.readInt clb 93 | return $ 94 | if x >= brotliMinimumSize settings 95 | then True 96 | else False) && 97 | checkMime settings ctb 98 | 99 | checkMime :: BrotliSettings -> B.ByteString -> Bool 100 | checkMime settings ctb = 101 | any (\b -> b `B.isPrefixOf` ctb) (brotliMimePrefixes settings) || 102 | any (\b -> b `B.isSuffixOf` ctb) (brotliMimeSuffixes settings) 103 | 104 | -- A sane set of starting defaults. Tuned to use faster / better compression 105 | -- than GZip defaults for non-file responses. Compresses most common text-based formats, 106 | -- skips compression on responses with known Content-Lengths that already fit 107 | -- within one TCP packet. 108 | -- 109 | -- Note that this configuration does *not* compress file responses. Customizing 110 | -- @brotliFilesBehavior@ will use brotli's maximum compression quality by default, which is 111 | -- quite slow (albeit achieves very good compression ratios). It is highly recommended that 112 | -- you have an appropriate caching strategy to avoid compression of files on each request. 113 | defaultSettings :: BrotliSettings 114 | defaultSettings = 115 | BrotliSettings 116 | (\_ resp -> 117 | case resp of 118 | ResponseFile _ _ _ _ -> 119 | defaultCompressionSettings {compressionQuality = 11} 120 | _ -> defaultCompressionSettings {compressionQuality = 4}) 121 | 860 122 | BrotliIgnore 123 | defaultShouldCompress 124 | [ "text/" 125 | , "application/json" 126 | , "application/javascript" 127 | , "application/x-javascript" 128 | , "application/ecmascript" 129 | , "application/xml" 130 | , "application/x-font-ttf" 131 | , "image/x-icon" 132 | , "image/vnd.microsoft.icon" 133 | , "application/vnd.ms-fontobject" 134 | , "application/x-font-opentype" 135 | , "application/x-font-truetype" 136 | , "font/eot" 137 | , "font/otf" 138 | , "font/ttf" 139 | , "font/opentype" 140 | ] 141 | ["+json", "+xml"] 142 | 143 | 144 | pluckHeader :: HeaderName -> [Header] -> (Maybe B.ByteString, [Header]) 145 | pluckHeader hName = foldr go (Nothing, []) 146 | where 147 | go h@(hKey, hVal) (mh, hs) = if hKey == hName 148 | then (Just hVal, hs) 149 | else (mh, h:hs) 150 | 151 | splitCommas :: B.ByteString -> [B.ByteString] 152 | splitCommas = B.split ',' . B.filter (/= ' ') 153 | 154 | -- SDCH + brotli may be better together than separate, but gzip and brotli together aren't useful 155 | canUseReqEncoding :: [B.ByteString] -> (Bool, [B.ByteString]) 156 | canUseReqEncoding = foldr go (False, []) 157 | where 158 | go :: B.ByteString -> (Bool, [B.ByteString]) -> (Bool, [B.ByteString]) 159 | go bs (seenBr, encs) = if bs == "br" 160 | then (True, encs) 161 | else if seenBr && bs == "gzip" 162 | then (seenBr, encs) 163 | else (seenBr, bs:encs) 164 | 165 | decodeRequestBody :: Request -> IO Request 166 | decodeRequestBody req = do 167 | let (encoding, hs) = pluckHeader "Content-Encoding" $ requestHeaders req 168 | case encoding of 169 | Nothing -> return req 170 | Just enc -> 171 | let encs = splitCommas enc 172 | getBs = requestBody req 173 | in case encs of 174 | ("br":encs) -> do 175 | bodyDecompressor <- decomp getBs 176 | return $ 177 | req 178 | { requestHeaders = 179 | ("Content-Encoding", B.intercalate ", " encs) : hs 180 | , requestBody = bodyDecompressor 181 | } 182 | _ -> return req 183 | where 184 | decomp :: IO B.ByteString -> IO (IO B.ByteString) 185 | decomp popper = do 186 | dc <- decompressor 187 | ref <- newIORef dc 188 | return $ step ref 189 | where 190 | step ref = do 191 | c <- readIORef ref 192 | case c of 193 | Done -> return "" 194 | Consume f -> do 195 | bs <- popper 196 | r <- f bs 197 | writeIORef ref r 198 | step ref 199 | Produce bs act -> do 200 | r <- act 201 | writeIORef ref r 202 | return bs 203 | Error -> error "Brotli stream decoding error in request body" 204 | 205 | -- | Use brotli to decompress request bodies & compress response bodies. 206 | -- 207 | -- Analyzes the Accept-Encoding and Content-Type headers to determine if 208 | -- brotli is supported. 209 | brotli :: BrotliSettings -> Middleware 210 | brotli settings app req sendResponse = do 211 | decodedReq <- 212 | decodeRequestBody $ 213 | (reqWithoutBrotliAcceptEnc 214 | { requestHeaders = 215 | (hAcceptEncoding, B.intercalate ", " remainingReqEncs) : 216 | requestHeaders reqWithoutBrotliAcceptEnc 217 | }) 218 | app decodedReq $ \res -> 219 | if isBrotliResp 220 | then wrapResponse settings req res sendResponse 221 | else sendResponse res 222 | where 223 | (mEncs, reqWithoutBrotliAcceptEnc) = 224 | case pluckHeader hAcceptEncoding $ requestHeaders req of 225 | (ms, hs) -> (ms, req {requestHeaders = hs}) 226 | (isBrotliResp, remainingReqEncs) = 227 | case mEncs of 228 | Nothing -> (False, []) 229 | Just ebs -> canUseReqEncoding $ splitCommas ebs 230 | 231 | fixHeaders :: [Header] -> [Header] 232 | fixHeaders = filter (\(k, _) -> k /= hContentLength) 233 | 234 | wrapResponse :: BrotliSettings -> Request -> Response -> (Response -> IO a) -> IO a 235 | wrapResponse settings req res sendResponse = 236 | let shouldCompress = (brotliShouldCompress settings) settings req 237 | in if shouldCompress res 238 | then case res of 239 | ResponseFile status hs fp bp -> 240 | compressedFileResponse 241 | settings 242 | addBrotliToContentEnc 243 | req 244 | status 245 | hs 246 | fp 247 | bp 248 | sendResponse 249 | 250 | ResponseBuilder status hs b -> do 251 | let compressedResp = 252 | compressWith 253 | (brotliCompressionSettings settings req res) 254 | (toLazyByteString b) 255 | sendResponse $ 256 | responseLBS status (addBrotliToContentEnc hs) compressedResp 257 | 258 | ResponseStream status hs f -> 259 | sendResponse $ 260 | ResponseStream status (addBrotliToContentEnc hs) $ \send flush -> do 261 | c <- compressor (brotliCompressionSettings settings req res) 262 | ref <- newIORef c 263 | f (compressSend send flush ref) (compressFlush send flush ref) 264 | c' <- readIORef ref 265 | case c' of 266 | Consume consumer -> 267 | consumer (Chunk B.empty) >>= finishStreaming send 268 | Produce _ _ -> error "Shouldn't be producing right now" 269 | Error -> error "Shouldn't be in an error state right now" 270 | Done -> return () 271 | 272 | ResponseRaw act fallback -> sendResponse $ responseRaw act fallback 273 | 274 | else sendResponse res 275 | where 276 | addBrotliToContentEnc hs = 277 | let (respEncs, hsWithoutBrotliEnc) = pluckHeader hContentEncoding hs 278 | in fixHeaders $ 279 | ((hContentEncoding, maybe "br" (<> ", br") respEncs) : 280 | hsWithoutBrotliEnc) 281 | finishStreaming send c = 282 | case c of 283 | Consume _ -> error "Shouldn't be consuming right now" 284 | Produce b next -> 285 | send (fromByteString b) >> next >>= finishStreaming send 286 | Error -> error "Encountered error while finishing stream" 287 | Done -> return () 288 | 289 | compressSend :: (Builder -> IO ()) -> IO () -> IORef (BrotliStream Chunk) -> Builder -> IO () 290 | compressSend innerSend innerFlush st bs = do 291 | let steps = L.toChunks $ toLazyByteString bs 292 | 293 | action <- readIORef st 294 | action' <- foldM step action steps 295 | writeIORef st action' 296 | 297 | where 298 | step c bs = case c of 299 | Produce b n -> do 300 | innerSend $ fromByteString b 301 | r <- n 302 | step r bs 303 | Consume consumer -> consumer $ Chunk bs 304 | Error -> error "Streaming send of response body failed in brotli compression phase" 305 | Done -> error "Should not be done compressing while still sending data. Did you send an empty bytestring?" 306 | 307 | performFlush :: (Builder -> IO ()) -> IO () -> BrotliStream Chunk -> IO (BrotliStream Chunk) 308 | performFlush innerSend innerFlush c = case c of 309 | Consume consumer -> consumer Flush >>= performFlush' 310 | _ -> error "Shouldn't be flushing value when not in consumption state" 311 | where 312 | performFlush' c = case c of 313 | Produce b n -> do 314 | innerSend $ fromByteString b 315 | r <- n 316 | performFlush' r 317 | _ -> innerFlush >> pure c 318 | 319 | compressFlush :: (Builder -> IO ()) -> IO () -> IORef (BrotliStream Chunk) -> IO () 320 | compressFlush innerSend innerFlush ref = do 321 | action <- readIORef ref 322 | r <- performFlush innerSend innerFlush action 323 | writeIORef ref r 324 | 325 | compressedFileResponse :: 326 | BrotliSettings 327 | -> (ResponseHeaders -> ResponseHeaders) 328 | -> Request 329 | -> Status 330 | -> ResponseHeaders 331 | -> FilePath 332 | -> Maybe FilePart 333 | -> (Response -> IO a) 334 | -> IO a 335 | compressedFileResponse settings addBrotliHeaders req status hs p mfp sendResponse = 336 | case mfp of 337 | Nothing -> 338 | case brotliFilesBehavior settings of 339 | BrotliIgnore -> sendResponse $ responseFile status hs p Nothing 340 | BrotliCompress -> do 341 | size <- fileSize <$> getFileStatus p 342 | if fromIntegral size >= brotliMinimumSize settings 343 | then do 344 | let (status', hs', f) = 345 | responseToStream $ responseFile status hs p Nothing 346 | f $ \body -> 347 | wrapResponse 348 | settings 349 | req 350 | (responseStream status' hs' body) 351 | sendResponse 352 | else sendResponse $ responseFile status hs p Nothing 353 | BrotliCacheFolder cachePath 354 | -- TODO check file size here maybe 355 | -> do 356 | createDirectoryIfMissing True cachePath 357 | let normalized = normalizeOriginalFile p <.> "br" 358 | adjustedFile = (cachePath normalizeOriginalFile p <.> "br") 359 | exists <- doesFileExist adjustedFile 360 | when (not exists) $ do 361 | (tmpPath, h) <- openBinaryTempFile cachePath ("XXXXX" ++ normalized) 362 | (flip onException) (removeFile tmpPath) $ do 363 | original <- L.readFile p 364 | L.hPut h $ compressWith (brotliCompressionSettings settings req (responseFile status hs p mfp)) original 365 | hClose h 366 | rename tmpPath adjustedFile 367 | sendResponse $ 368 | responseFile status (addBrotliHeaders hs) adjustedFile Nothing 369 | BrotliPreCompressed fallback -> do 370 | let modifiedPath = p <.> "br" 371 | exists <- doesFileExist modifiedPath 372 | if exists 373 | then sendResponse $ 374 | responseFile status (addBrotliHeaders hs) modifiedPath Nothing 375 | else compressedFileResponse 376 | (settings {brotliFilesBehavior = fallback}) 377 | addBrotliHeaders 378 | req 379 | status 380 | hs 381 | p 382 | mfp 383 | sendResponse 384 | _ -> do 385 | let (status', hs', f) = responseToStream $ responseFile status hs p mfp 386 | f $ \body -> do 387 | wrapResponse settings req (responseStream status' hs' body) sendResponse 388 | 389 | normalizeOriginalFile :: FilePath -> FilePath 390 | normalizeOriginalFile file = map safe file 391 | where 392 | safe c 393 | | 'A' <= c && c <= 'Z' = c 394 | | 'a' <= c && c <= 'z' = c 395 | | '0' <= c && c <= '9' = c 396 | safe '-' = '-' 397 | safe '_' = '_' 398 | safe '.' = '.' 399 | safe _ = '_' 400 | 401 | -------------------------------------------------------------------------------- /wai-middleware-brotli/test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Network.HTTP.Types 3 | import Codec.Compression.Brotli (decompress, compress) 4 | import Control.Monad.Trans 5 | import Control.Concurrent.MVar 6 | import qualified Data.ByteString.Char8 as B 7 | import qualified Data.ByteString.Lazy as L 8 | import qualified Data.ByteString.Builder as Builder 9 | import Data.IORef 10 | import Data.Monoid 11 | import Data.String 12 | import Network.Wai 13 | import Network.Wai.Middleware.Brotli 14 | import Network.Wai.Internal 15 | import Network.Wai.Test 16 | import Test.Tasty 17 | import Test.Tasty.HUnit 18 | import Test.Tasty.Hspec 19 | import System.IO 20 | import System.IO.Error 21 | 22 | main :: IO () 23 | main = do 24 | putStrLn "" 25 | 26 | bod <- catchIOError (L.readFile "/usr/share/dict/words") (const . pure . fromString $ "Hello World " ++ replicate 860 '0') 27 | let app req respond = respond $ responseLBS status200 [("Content-Type", "text/whatever")] bod 28 | 29 | specs <- testSpecs $ parallel $ do 30 | 31 | it "Encodes text" $ do 32 | -- app :: Application 33 | putStr "Encoding text: " 34 | var <- newEmptyMVar 35 | (brotli defaultSettings app) 36 | (defaultRequest {requestHeaders = [("Accept-Encoding", "br")]}) 37 | (\resp -> do 38 | putMVar var resp 39 | return ResponseReceived) 40 | resp <- takeMVar var 41 | case resp of 42 | ResponseBuilder stats hs b -> do 43 | assert (decompress (Builder.toLazyByteString b) == bod) 44 | _ -> error "Not what we expected" 45 | 46 | it "Does not encode if brotli not in Accept-Encoding header" $ do 47 | var <- newEmptyMVar 48 | (brotli defaultSettings app) 49 | (defaultRequest {requestHeaders = [("Accept-Encoding", "gzip"), ("Content-Type", "text/whatever")]}) 50 | (\resp -> do 51 | putMVar var resp 52 | return ResponseReceived) 53 | resp <- takeMVar var 54 | case resp of 55 | ResponseBuilder stats hs b -> do 56 | assert (Builder.toLazyByteString b == bod) 57 | _ -> error "Not what we expected" 58 | 59 | it "Decode request body if it's encoded" $ do 60 | var <- newEmptyMVar 61 | let reqWithBody = 62 | defaultRequest 63 | { requestMethod = "POST" 64 | , requestHeaders = [("Content-Encoding", "br")] 65 | , requestBody = 66 | return $ L.toStrict $ compress ("Hello World" :: L.ByteString) 67 | } 68 | (brotli defaultSettings $ \req resp -> do 69 | reqBod <- requestBody req 70 | resp $ responseLBS status200 [] (L.fromStrict reqBod)) 71 | reqWithBody 72 | (\resp -> do 73 | putMVar var resp 74 | return ResponseReceived) 75 | resp <- takeMVar var 76 | case resp of 77 | ResponseBuilder stats hs b -> 78 | assert (Builder.toLazyByteString b == "Hello World") 79 | _ -> error "Not what we expected" 80 | 81 | it "Streaming response body encoding" $ do 82 | var <- newEmptyMVar 83 | (brotli defaultSettings $ \req respond -> do 84 | respond $ responseStream status200 [("Content-Type", "text/whatever")] $ \send flush -> do 85 | send "Hello world\n" 86 | flush 87 | send "Goodbye world" 88 | ) 89 | (defaultRequest {requestHeaders = [("Accept-Encoding", "br")]}) 90 | (\resp -> do 91 | putMVar var resp 92 | return ResponseReceived) 93 | resp <- takeMVar var 94 | r <- newIORef mempty 95 | case resp of 96 | ResponseStream stats hs f -> do 97 | f (\b -> modifyIORef r (<> b)) (return ()) 98 | b <- readIORef r 99 | assert (decompress (Builder.toLazyByteString b) == "Hello world\nGoodbye world") 100 | _ -> error "Not what we expected" 101 | 102 | it "Don't encode non-textual content" $ do 103 | let app req respond = respond $ responseLBS status200 [("Content-Type", "application/binary")] bod 104 | var <- newEmptyMVar 105 | (brotli defaultSettings app) 106 | (defaultRequest {requestHeaders = [("Accept-Encoding", "br")]}) 107 | (\resp -> do 108 | putMVar var resp 109 | return ResponseReceived) 110 | resp <- takeMVar var 111 | case resp of 112 | ResponseBuilder stats hs b -> do 113 | assert (Builder.toLazyByteString b == bod) 114 | _ -> error "Not what we expected" 115 | 116 | it "Don't encode if content length is too low" $ do 117 | let app req respond = respond $ responseLBS status200 [("Content-Type", "application/json"), ("Content-Length", "2")] "{}" 118 | var <- newEmptyMVar 119 | (brotli defaultSettings app) 120 | (defaultRequest {requestHeaders = [("Accept-Encoding", "br")]}) 121 | (\resp -> do 122 | putMVar var resp 123 | return ResponseReceived) 124 | resp <- takeMVar var 125 | case resp of 126 | ResponseBuilder stats hs b -> do 127 | assert (Builder.toLazyByteString b == "{}") 128 | _ -> error "Not what we expected" 129 | 130 | it "Do encode if content length is long enough" $ do 131 | let app req respond = respond $ responseLBS status200 [("Content-Type", "text/whatever"), ("Content-Length", B.pack $ show $ L.length bod)] bod 132 | var <- newEmptyMVar 133 | (brotli defaultSettings app) 134 | (defaultRequest {requestHeaders = [("Accept-Encoding", "br")]}) 135 | (\resp -> do 136 | putMVar var resp 137 | return ResponseReceived) 138 | resp <- takeMVar var 139 | case resp of 140 | ResponseBuilder stats hs b -> do 141 | assert (decompress (Builder.toLazyByteString b) == bod) 142 | _ -> error "Not what we expected" 143 | 144 | it "Performs on-the-fly compression of files if set to compress or requesting appropriate content range size" onTheFlyFileCompressTest 145 | it "Serves precomputed compressed files if appropriate & they exist" precompressedTest 146 | 147 | defaultMain $ testGroup "Tests" specs 148 | 149 | 150 | {- 151 | 152 | putStrLn "" 153 | 154 | putStrLn "" 155 | 156 | putStr ": " 157 | putStrLn "" 158 | 159 | putStrLn "" 160 | 161 | putStrLn "Compress fallback response for responseRaw if appropriate: Pending" 162 | putStrLn "Don't compress files if set to ignore: Pending" 163 | onTheFlyFileCompressTest 164 | precompressedTest 165 | putStrLn "Create cached file versions in given folder if appropriate: Pending" 166 | 167 | putStrLn "Support flushing compressed data: Pending" 168 | putStrLn "Return appropriate error statuses for malformed compressed input: Pending" 169 | -} 170 | 171 | onTheFlyFileCompressTest :: IO () 172 | onTheFlyFileCompressTest = do 173 | let settings = defaultSettings { brotliFilesBehavior = BrotliCompress, brotliMinimumSize = 5 } 174 | let app req respond = 175 | respond $ 176 | responseFile 177 | status200 178 | [ ("Content-Type", "text/whatever") 179 | ] 180 | "test/sample.txt" 181 | Nothing 182 | runSession session $ brotli settings app 183 | where 184 | session = do 185 | resp <- request (defaultRequest {requestHeaders = [("Accept-Encoding", "br")]}) 186 | liftIO $ assert (decompress (simpleBody resp) @=? "Hello world\n") 187 | 188 | precompressedTest :: IO () 189 | precompressedTest = do 190 | let settings = defaultSettings { brotliFilesBehavior = BrotliPreCompressed BrotliIgnore } 191 | let app req respond = 192 | respond $ 193 | responseFile 194 | status200 195 | [ ("Content-Type", "text/whatever") 196 | ] 197 | "test/words" 198 | Nothing 199 | var <- newEmptyMVar 200 | (brotli settings app) 201 | (defaultRequest {requestHeaders = [("Accept-Encoding", "br")]}) 202 | (\resp -> do 203 | putMVar var resp 204 | return ResponseReceived) 205 | resp <- takeMVar var 206 | case resp of 207 | ResponseFile stats hs fp Nothing -> do 208 | assert (fp == "test/words.br") 209 | _ -> error "Not what we expected" 210 | -------------------------------------------------------------------------------- /wai-middleware-brotli/test/sample.txt: -------------------------------------------------------------------------------- 1 | Hello world 2 | -------------------------------------------------------------------------------- /wai-middleware-brotli/test/words.br: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iand675/hs-brotli/d7bce54b265883fb30a14d39d00cbf1c1308b2b1/wai-middleware-brotli/test/words.br -------------------------------------------------------------------------------- /wai-middleware-brotli/wai-middleware-brotli.cabal: -------------------------------------------------------------------------------- 1 | name: wai-middleware-brotli 2 | version: 0.1.0.0 3 | synopsis: WAI middleware for brotli compression 4 | -- description: 5 | homepage: https://github.com/iand675/hs-brotli#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Ian Duncan 9 | maintainer: ian@iankduncan.com 10 | copyright: Ian Duncan 11 | category: Web 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Network.Wai.Middleware.Brotli 19 | build-depends: base >= 4.7 && < 5 20 | , wai 21 | , http-types 22 | , hs-brotli 23 | , bytestring 24 | , directory 25 | , filepath 26 | , binary 27 | , unix 28 | default-language: Haskell2010 29 | 30 | -- executable wai-middleware-brotli-server 31 | -- hs-source-dirs: app 32 | -- main-is: Main.hs 33 | -- build-depends: base 34 | -- , http-types 35 | -- , warp 36 | -- , wai-extra 37 | -- , wai-middleware-brotli 38 | -- , wai 39 | -- , wai-app-static 40 | -- default-language: Haskell2010 41 | 42 | test-suite wai-middleware-brotli-test 43 | type: exitcode-stdio-1.0 44 | hs-source-dirs: test 45 | main-is: Spec.hs 46 | build-depends: base 47 | , hs-brotli 48 | , bytestring 49 | , http-types 50 | , mtl 51 | , tasty 52 | , tasty-hspec 53 | , tasty-hunit 54 | , wai 55 | , wai-extra 56 | , wai-middleware-brotli 57 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 58 | default-language: Haskell2010 59 | 60 | source-repository head 61 | type: git 62 | location: https://github.com/iand675/hs-brotli 63 | --------------------------------------------------------------------------------