bsb-http-chunked 0.0.0.2 → 0.0.0.3
raw patch · 9 files changed
+329/−330 lines, 9 filesdep +attoparsecdep +blaze-builderdep +bsb-http-chunkeddep ~basedep ~bytestringdep ~bytestring-builderPVP ok
version bump matches the API change (PVP)
Dependencies added: attoparsec, blaze-builder, bsb-http-chunked, deepseq, doctest, gauge, hedgehog, semigroups, tasty, tasty-hedgehog, tasty-hunit
Dependency ranges changed: base, bytestring, bytestring-builder
API changes (from Hackage documentation)
Files
- Blaze/ByteString/Builder/Char8.hs +0/−32
- Blaze/ByteString/Builder/Compat/Write.hs +0/−23
- Blaze/ByteString/Builder/Internal/Write.hs +0/−168
- CHANGELOG.md +7/−1
- Data/ByteString/Builder/HTTP/Chunked.hs +91/−96
- bench/Bench.hs +69/−0
- bsb-http-chunked.cabal +48/−10
- tests/Doctests.hs +6/−0
- tests/Tests.hs +108/−0
− Blaze/ByteString/Builder/Char8.hs
@@ -1,32 +0,0 @@---------------------------------------------------------------------------------- |--- Module: Blaze.ByteString.Builder.Char8--- Copyright: (c) 2013 Leon P Smith--- License: BSD3--- Maintainer: Leon P Smith <leon@melding-monads.com>--- Stability: experimental------ //Note:// This package is intended for low-level use like implementing--- protocols. If you need to //serialize// Unicode characters use one of the--- UTF encodings (e.g. 'Blaze.ByteString.Builder.Char.UTF-8').------ 'Write's and 'Builder's for serializing the lower 8-bits of characters.------ This corresponds to what the 'bytestring' package offer in--- 'Data.ByteString.Char8'.------------------------------------------------------------------------------------module Blaze.ByteString.Builder.Char8- (- -- * Writing Latin-1 (ISO 8859-1) encodable characters to a buffer- writeChar- ) where--import Blaze.ByteString.Builder.Compat.Write ( Write, writePrimFixed )-import qualified Data.ByteString.Builder.Prim as P---- | Write the lower 8-bits of a character to a buffer.-writeChar :: Char -> Write-writeChar = writePrimFixed P.char8-{-# INLINE writeChar #-}
− Blaze/ByteString/Builder/Compat/Write.hs
@@ -1,23 +0,0 @@---------------------------------------------------------------------------------- |--- Module: Blaze.ByteString.Builder.Compat.Write--- Copyright: (c) 2013 Leon P Smith--- License: BSD3--- Maintainer: Leon P Smith <leon@melding-monads.com>--- Stability: experimental------ Conversions from the new Prims to the old Writes.------------------------------------------------------------------------------------module Blaze.ByteString.Builder.Compat.Write- ( Write- , writePrimFixed- ) where--import Data.ByteString.Builder.Prim.Internal (FixedPrim, runF, size)-import Blaze.ByteString.Builder.Internal.Write (Write, exactWrite)--writePrimFixed :: FixedPrim a -> a -> Write-writePrimFixed fe a = exactWrite (size fe) (runF fe a)-{-# INLINE writePrimFixed #-}
− Blaze/ByteString/Builder/Internal/Write.hs
@@ -1,168 +0,0 @@-{-# LANGUAGE CPP, BangPatterns #-}---- |--- Module : Blaze.ByteString.Builder.Internal.Poke--- Copyright : (c) 2010 Simon Meier--- (c) 2010 Jasper van der Jeugt--- License : BSD3-style (see LICENSE)------ Maintainer : Leon Smith <leon@melding-monads.com>--- Stability : experimental--- Portability : tested on GHC only------ A general and efficient write type that allows for the easy construction of--- builders for (smallish) bounded size writes to a buffer.------ FIXME: Improve documentation.----module Blaze.ByteString.Builder.Internal.Write (- -- * Poking a buffer- Poke(..)- , pokeN-- -- * Writing to abuffer- , Write(..)- , getPoke-- , exactWrite- , boundedWrite-- -- * Constructing builders from writes- , fromWrite-- -- * Writing 'Storable's- ) where--import Foreign--import Control.Monad--import Data.ByteString.Builder.Internal--import Data.Monoid (Monoid(..))-#if MIN_VERSION_base(4,9,0)-import Data.Semigroup-#endif----------------------------------------------------------------------------------- Poking a buffer and writing to a buffer----------------------------------------------------------------------------------- Sadly GHC is not smart enough: code where we branch and each branch should--- execute a few IO actions and then return a value cannot be taught to GHC. At--- least not such that it returns the value of the branches unpacked.------ Hmm.. at least he behaves much better for the Monoid instance of Write--- than the one for Poke. Serializing UTF-8 chars gets a slowdown of a--- factor 2 when 2 chars are composed. Perhaps I should try out the writeList--- instances also, as they may be more sensitive to to much work per Char.------- | Changing a sequence of bytes starting from the given pointer. 'Poke's are--- the most primitive buffer manipulation. In most cases, you don't use the--- explicitely but as part of a 'Write', which also tells how many bytes will--- be changed at most.-newtype Poke =- Poke { runPoke :: Ptr Word8 -> IO (Ptr Word8) }---- | A write of a bounded number of bytes.------ When defining a function @write :: a -> Write@ for some @a@, then it is--- important to ensure that the bound on the number of bytes written is--- data-independent. Formally,------ @ forall x y. getBound (write x) = getBound (write y) @------ The idea is that this data-independent bound is specified such that the--- compiler can optimize the check, if there are enough free bytes in the buffer,--- to a single subtraction between the pointer to the next free byte and the--- pointer to the end of the buffer with this constant bound of the maximal--- number of bytes to be written.----data Write = Write {-# UNPACK #-} !Int Poke---- | Extract the 'Poke' action of a write.-{-# INLINE getPoke #-}-getPoke :: Write -> Poke-getPoke (Write _ wio) = wio--#if MIN_VERSION_base(4,9,0)-instance Semigroup Poke where- {-# INLINE (<>) #-}- (Poke po1) <> (Poke po2) = Poke $ po1 >=> po2-- {-# INLINE sconcat #-}- sconcat = foldr (<>) mempty-#endif--instance Monoid Poke where- {-# INLINE mempty #-}- mempty = Poke return--#if !(MIN_VERSION_base(4,11,0))- {-# INLINE mappend #-}- (Poke po1) `mappend` (Poke po2) = Poke $ po1 >=> po2-#endif-- {-# INLINE mconcat #-}- mconcat = foldr mappend mempty--#if MIN_VERSION_base(4,9,0)-instance Semigroup Write where- {-# INLINE (<>) #-}- (Write bound1 w1) <> (Write bound2 w2) =- Write (bound1 + bound2) (w1 <> w2)-- {-# INLINE sconcat #-}- sconcat = foldr (<>) mempty-#endif--instance Monoid Write where- {-# INLINE mempty #-}- mempty = Write 0 mempty--#if !(MIN_VERSION_base(4,11,0))- {-# INLINE mappend #-}- (Write bound1 w1) `mappend` (Write bound2 w2) =- Write (bound1 + bound2) (w1 `mappend` w2)-#endif-- {-# INLINE mconcat #-}- mconcat = foldr mappend mempty---- | @pokeN size io@ creates a write that denotes the writing of @size@ bytes--- to a buffer using the IO action @io@. Note that @io@ MUST write EXACTLY @size@--- bytes to the buffer!-{-# INLINE pokeN #-}-pokeN :: Int- -> (Ptr Word8 -> IO ()) -> Poke-pokeN size io = Poke $ \op -> io op >> (return $! (op `plusPtr` size))----- | @exactWrite size io@ creates a bounded write that can later be converted to--- a builder that writes exactly @size@ bytes. Note that @io@ MUST write--- EXACTLY @size@ bytes to the buffer!-{-# INLINE exactWrite #-}-exactWrite :: Int- -> (Ptr Word8 -> IO ())- -> Write-exactWrite size io = Write size (pokeN size io)---- | @boundedWrite size write@ creates a bounded write from a @write@ that does--- not write more than @size@ bytes.-{-# INLINE boundedWrite #-}-boundedWrite :: Int -> Poke -> Write-boundedWrite = Write---- | Create a builder that execute a single 'Write'.-{-# INLINE fromWrite #-}-fromWrite :: Write -> Builder-fromWrite (Write maxSize wio) =- builder step- where- step k (BufferRange op ope)- | op `plusPtr` maxSize <= ope = do- op' <- runPoke wio op- let !br' = BufferRange op' ope- k br'- | otherwise = return $ bufferFull maxSize op (step k)
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Changelog for the `bsb-http-chunked` package +## [0.0.0.3] – 2018-09-01++- Compatibility with GHC-8.6+- Documentation improvements+ ## [0.0.0.2] – 2018-03-13 - A lot of unused code was removed@@ -18,6 +23,7 @@ The format of this changelog is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) -[Unreleased]: https://github.com/sjakobi/bsb-http-chunked/compare/v0.0.0.2...HEAD+[Unreleased]: https://github.com/sjakobi/bsb-http-chunked/compare/v0.0.0.3...HEAD+[0.0.0.3]: https://github.com/sjakobi/bsb-http-chunked/compare/v0.0.0.2...v0.0.0.3 [0.0.0.2]: https://github.com/sjakobi/bsb-http-chunked/compare/v0.0.0.1...v0.0.0.2 [0.0.0.1]: https://github.com/sjakobi/bsb-http-chunked/compare/v0...v0.0.0.1
Data/ByteString/Builder/HTTP/Chunked.hs view
@@ -1,168 +1,165 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings #-}--- | Chunked HTTP transfer encoding+{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings #-}+-- | HTTP/1.1 chunked transfer encoding as defined+-- in [RFC 7230 Section 4.1](https://tools.ietf.org/html/rfc7230#section-4.1) module Data.ByteString.Builder.HTTP.Chunked ( chunkedTransferEncoding , chunkedTransferTerminator ) where -#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-#include "MachDeps.h"-#endif--#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-import GHC.Base-import GHC.Word (Word32(..))-#else-import Data.Word-#endif--import Foreign--import qualified Data.ByteString as S-import Data.ByteString.Char8 ()--import Blaze.ByteString.Builder.Internal.Write-import Data.ByteString.Builder-import Data.ByteString.Builder.Internal--import qualified Blaze.ByteString.Builder.Char8 as Char8--#if !MIN_VERSION_base(4,8,0)-import Data.Monoid-#endif---{-# INLINE shiftr_w32 #-}-shiftr_w32 :: Word32 -> Int -> Word32+import Control.Applicative (pure)+import Control.Monad (void)+import Foreign (Ptr, Word8, (.&.))+import qualified Foreign as F+import GHC.Base (Int(..), uncheckedShiftRL#)+import GHC.Word (Word32(..)) -#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)-#else-shiftr_w32 = shiftR-#endif+import qualified Data.ByteString as S+import Data.ByteString.Builder (Builder)+import Data.ByteString.Builder.Internal (BufferRange(..), BuildSignal)+import qualified Data.ByteString.Builder.Internal as B+import qualified Data.ByteString.Builder.Prim as P+import qualified Data.ByteString.Builder.Prim.Internal as P+import Data.ByteString.Char8 () -- For the IsString instance +------------------------------------------------------------------------------+-- CRLF utils+------------------------------------------------------------------------------ --- | Write a CRLF sequence.-writeCRLF :: Write-writeCRLF = Char8.writeChar '\r' `mappend` Char8.writeChar '\n' {-# INLINE writeCRLF #-}---- | Execute a write-{-# INLINE execWrite #-}-execWrite :: Write -> Ptr Word8 -> IO ()-execWrite w op = do- _ <- runPoke (getPoke w) op- return ()+writeCRLF :: Ptr Word8 -> IO (Ptr Word8)+writeCRLF op = do+ P.runF (P.char8 P.>*< P.char8) ('\r', '\n') op+ pure $! op `F.plusPtr` 2 +{-# INLINE crlfBuilder #-}+crlfBuilder :: Builder+crlfBuilder = P.primFixed (P.char8 P.>*< P.char8) ('\r', '\n') ------------------------------------------------------------------------------ -- Hex Encoding Infrastructure ------------------------------------------------------------------------------ -pokeWord32HexN :: Int -> Word32 -> Ptr Word8 -> IO ()-pokeWord32HexN n0 w0 op0 =- go w0 (op0 `plusPtr` (n0 - 1))+{-# INLINE shiftr_w32 #-}+shiftr_w32 :: Word32 -> Int -> Word32+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)++-- | @writeWord32Hex len w op@ writes the hex encoding of @w@ to @op@ and +-- returns @op `'F.plusPtr'` len@.+--+-- If writing @w@ doesn't consume all @len@ bytes, leading zeros are added. +{-# INLINE writeWord32Hex #-}+writeWord32Hex :: Int -> Word32 -> Ptr Word8 -> IO (Ptr Word8)+writeWord32Hex len w0 op0 = do+ go w0 (op0 `F.plusPtr` (len - 1))+ pure $! op0 `F.plusPtr` len where go !w !op- | op < op0 = return ()+ | op < op0 = pure () | otherwise = do let nibble :: Word8 nibble = fromIntegral w .&. 0xF hex | nibble < 10 = 48 + nibble | otherwise = 55 + nibble- poke op hex- go (w `shiftr_w32` 4) (op `plusPtr` (-1))-{-# INLINE pokeWord32HexN #-}+ F.poke op hex+ go (w `shiftr_w32` 4) (op `F.plusPtr` (-1)) +{-# INLINE iterationsUntilZero #-} iterationsUntilZero :: Integral a => (a -> a) -> a -> Int iterationsUntilZero f = go 0 where go !count 0 = count go !count !x = go (count+1) (f x)-{-# INLINE iterationsUntilZero #-} -- | Length of the hex-string required to encode the given 'Word32'.+{-# INLINE word32HexLength #-} word32HexLength :: Word32 -> Int word32HexLength = max 1 . iterationsUntilZero (`shiftr_w32` 4)-{-# INLINE word32HexLength #-} -writeWord32Hex :: Word32 -> Write-writeWord32Hex w =- boundedWrite (2 * sizeOf w) (pokeN len $ pokeWord32HexN len w)- where- len = word32HexLength w-{-# INLINE writeWord32Hex #-}-- ------------------------------------------------------------------------------ -- Chunked transfer encoding ------------------------------------------------------------------------------ -- | Transform a builder such that it uses chunked HTTP transfer encoding.+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.ByteString.Builder as B+-- >>> let f = B.toLazyByteString . chunkedTransferEncoding . B.lazyByteString+-- >>> f "data"+-- "004\r\ndata\r\n"+--+-- >>> f ""+-- ""+--+-- /Note/: While for many inputs, the bytestring chunks that can be obtained from the output+-- via @'Data.ByteString.Lazy.toChunks' . 'Data.ByteString.Builder.toLazyByteString'@+-- each form a chunk in the sense+-- of [RFC 7230 Section 4.1](https://tools.ietf.org/html/rfc7230#section-4.1),+-- this correspondence doesn't hold in general. chunkedTransferEncoding :: Builder -> Builder chunkedTransferEncoding innerBuilder =- builder transferEncodingStep+ B.builder transferEncodingStep where transferEncodingStep k =- go (runBuilder innerBuilder)+ go (B.runBuilder innerBuilder) where go innerStep (BufferRange op ope) -- FIXME: Assert that outRemaining < maxBound :: Word32 | outRemaining < minimalBufferSize =- return $ bufferFull minimalBufferSize op (go innerStep)+ pure $ B.bufferFull minimalBufferSize op (go innerStep) | otherwise = do let !brInner@(BufferRange opInner _) = BufferRange- (op `plusPtr` (chunkSizeLength + 2)) -- leave space for chunk header- (ope `plusPtr` (-maxAfterBufferOverhead)) -- leave space at end of data+ (op `F.plusPtr` (maxChunkSizeLength + 2)) -- leave space for chunk header+ (ope `F.plusPtr` (-maxAfterBufferOverhead)) -- leave space at end of data -- wraps the chunk, if it is non-empty, and returns the -- signal constructed with the correct end-of-data pointer {-# INLINE wrapChunk #-} wrapChunk :: Ptr Word8 -> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)- wrapChunk !opInner' mkSignal- | opInner' == opInner = mkSignal op+ wrapChunk !chunkDataEnd mkSignal+ | chunkDataEnd == opInner = mkSignal op | otherwise = do- pokeWord32HexN chunkSizeLength- (fromIntegral $ opInner' `minusPtr` opInner)- op- execWrite writeCRLF (opInner `plusPtr` (-2))- execWrite writeCRLF opInner'- mkSignal (opInner' `plusPtr` 2)+ let chunkSize = fromIntegral $ chunkDataEnd `F.minusPtr` opInner+ -- If the hex of chunkSize requires less space than+ -- maxChunkSizeLength, we get leading zeros.+ void $ writeWord32Hex maxChunkSizeLength chunkSize op+ void $ writeCRLF (opInner `F.plusPtr` (-2))+ void $ writeCRLF chunkDataEnd+ mkSignal (chunkDataEnd `F.plusPtr` 2) - -- prepare handlers doneH opInner' _ = wrapChunk opInner' $ \op' -> do let !br' = BufferRange op' ope k br' fullH opInner' minRequiredSize nextInnerStep = wrapChunk opInner' $ \op' ->- return $! bufferFull+ pure $! B.bufferFull (minRequiredSize + maxEncodingOverhead) op' (go nextInnerStep)-+ insertChunkH opInner' bs nextInnerStep | S.null bs = -- flush wrapChunk opInner' $ \op' ->- return $! insertChunk op' S.empty (go nextInnerStep)+ pure $! B.insertChunk op' S.empty (go nextInnerStep) | otherwise = -- insert non-empty bytestring wrapChunk opInner' $ \op' -> do -- add header for inserted bytestring -- FIXME: assert(S.length bs < maxBound :: Word32)- !op'' <- (`runPoke` op') $ getPoke $- writeWord32Hex (fromIntegral $ S.length bs)- `mappend` writeCRLF+ let chunkSize = fromIntegral $ S.length bs+ hexLength = word32HexLength chunkSize+ !op'' <- writeWord32Hex hexLength chunkSize op'+ !op''' <- writeCRLF op'' -- insert bytestring and write CRLF in next buildstep- return $! insertChunk- op'' bs- (runBuilderWith (fromWrite writeCRLF) $ go nextInnerStep)+ pure $! B.insertChunk+ op''' bs+ (B.runBuilderWith crlfBuilder $ go nextInnerStep) -- execute inner builder with reduced boundaries- fillWithBuildStep innerStep doneH fullH insertChunkH brInner+ B.fillWithBuildStep innerStep doneH fullH insertChunkH brInner where -- minimal size guaranteed for actual data no need to require more -- than 1 byte to guarantee progress the larger sizes will be@@ -171,20 +168,18 @@ minimalChunkSize = 1 -- overhead computation- maxBeforeBufferOverhead = sizeOf (undefined :: Int) + 2 -- max chunk size and CRLF after header- maxAfterBufferOverhead = 2 + -- CRLF after data- sizeOf (undefined :: Int) + 2 -- max bytestring size, CRLF after header+ maxBeforeBufferOverhead = F.sizeOf (undefined :: Int) + 2 -- max chunk size and CRLF after header+ maxAfterBufferOverhead = 2 + -- CRLF after data+ F.sizeOf (undefined :: Int) + 2 -- max bytestring size, CRLF after header maxEncodingOverhead = maxBeforeBufferOverhead + maxAfterBufferOverhead minimalBufferSize = minimalChunkSize + maxEncodingOverhead -- remaining and required space computation- outRemaining :: Int- outRemaining = ope `minusPtr` op- chunkSizeLength = word32HexLength $ fromIntegral outRemaining-+ outRemaining = ope `F.minusPtr` op+ maxChunkSizeLength = word32HexLength $ fromIntegral outRemaining --- | The zero-length chunk '0\r\n\r\n' signaling the termination of the data transfer.+-- | The zero-length chunk @0\\r\\n\\r\\n@ signaling the termination of the data transfer. chunkedTransferTerminator :: Builder-chunkedTransferTerminator = byteStringCopy "0\r\n\r\n"+chunkedTransferTerminator = B.byteStringCopy "0\r\n\r\n"
+ bench/Bench.hs view
@@ -0,0 +1,69 @@+{-# language DeriveAnyClass, DeriveGeneric, OverloadedStrings #-}+module Main where++import Gauge++import qualified Blaze.ByteString.Builder.HTTP as Blaze+import Data.ByteString.Builder.HTTP.Chunked++import Control.DeepSeq+import qualified Data.ByteString as S+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Extra as B+import qualified Data.ByteString.Lazy as L+import Data.Semigroup+import GHC.Generics++main :: IO ()+main = defaultMain+ [ benchEncode "clone village"+ cloneVillage+ (foldMap fromPerson)+ , benchEncode "100 4kB chunks"+ (S.replicate 4096 95)+ (stimes (100 :: Int) . B.byteString)+ , benchEncode "200kB strict bytestring"+ (S.replicate (200 * 1000) 95)+ B.byteString+ , benchEncode "1000 small chunks"+ "Hello"+ (stimes (1000 :: Int) . B.byteString)+ , benchEncode "1000 small chunks nocopy"+ "Hello"+ (stimes (1000 :: Int) . B.byteStringInsert)+ ]++-- Example adapted from+-- http://lambda-view.blogspot.de/2010/11/blaze-builder-library-faster.html++data Person = Person { pName :: String, pAge :: Int }+ deriving (Generic, NFData)++people :: [Person]+people = zipWith Person ["Haskell 98", "Switzerland", "λ-bot"] [12, 719, 7]++fromStringLen32le :: String -> B.Builder+fromStringLen32le cs =+ B.int32LE (fromIntegral $ length cs) <> B.stringUtf8 cs++fromPerson :: Person -> B.Builder+fromPerson p =+ fromStringLen32le (pName p) <> B.int32LE (fromIntegral $ pAge p)++cloneVillage :: [Person]+cloneVillage = take 10000 $ cycle $ people++-- Utils++benchEncode :: NFData input => String -> input -> (input -> B.Builder) -> Benchmark+benchEncode name input mkBuilder =+ env (return input) $ \input' -> bgroup name+ [ bench "bsbhc" $ nf (encode . mkBuilder) input'+ , bench "Blaze" $ nf (encodeBlaze . mkBuilder) input'+ ]++encode :: B.Builder -> L.ByteString+encode = B.toLazyByteString . chunkedTransferEncoding++encodeBlaze :: B.Builder -> L.ByteString+encodeBlaze = B.toLazyByteString . Blaze.chunkedTransferEncoding
bsb-http-chunked.cabal view
@@ -1,5 +1,5 @@ Name: bsb-http-chunked-Version: 0.0.0.2+Version: 0.0.0.3 Synopsis: Chunked HTTP transfer encoding for bytestring builders Description: This library contains functions for encoding [bytestring@@ -10,10 +10,11 @@ the [blaze-builder](http://hackage.haskell.org/package/blaze-builder) package. -Author: Jasper Van der Jeugt, Simon Meier, Leon P Smith+Author: Jasper Van der Jeugt, Simon Meier, Leon P Smith, Simon Jakobi Copyright: (c) 2010-2014 Simon Meier (c) 2010 Jasper Van der Jeugt (c) 2013-2015 Leon P Smith+ (c) 2018 Simon Jakobi Maintainer: Simon Jakobi <simon.jakobi@gmail.com> License: BSD3@@ -34,14 +35,51 @@ Location: https://github.com/sjakobi/bsb-http-chunked.git Library- ghc-options: -Wall- exposed-modules: Data.ByteString.Builder.HTTP.Chunked-- other-modules: Blaze.ByteString.Builder.Char8- Blaze.ByteString.Builder.Compat.Write- Blaze.ByteString.Builder.Internal.Write-- build-depends: base >= 4.3 && < 4.12,+ build-depends: base >= 4.3 && < 4.13, bytestring >= 0.9 && < 0.11, bytestring-builder < 0.11+ ghc-options: -Wall -O2+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat++test-suite tests+ hs-source-dirs: tests+ main-is: Tests.hs+ build-depends: attoparsec+ , base+ , bsb-http-chunked+ , blaze-builder >= 0.2.1.4+ , bytestring+ , bytestring-builder+ , hedgehog+ , tasty+ , tasty-hedgehog+ , tasty-hunit+ ghc-options: -Wall -rtsopts+ if impl(ghc < 7.10)+ buildable: False+ type: exitcode-stdio-1.0++test-suite doctests+ hs-source-dirs: tests+ main-is: Doctests.hs+ build-depends: base+ , doctest >= 0.8+ ghc-options: -Wall+ type: exitcode-stdio-1.0++benchmark bench+ hs-source-dirs: bench+ main-is: Bench.hs+ build-depends: base+ , blaze-builder+ , bsb-http-chunked+ , bytestring+ , deepseq+ , gauge+ , semigroups+ ghc-options: -O2 -Wall -rtsopts+ if impl(ghc < 7.10)+ buildable: False+ type: exitcode-stdio-1.0
+ tests/Doctests.hs view
@@ -0,0 +1,6 @@+import Test.DocTest++main :: IO ()+main = doctest ["-isrc", "Data/ByteString/Builder/HTTP/Chunked.hs"]++
+ tests/Tests.hs view
@@ -0,0 +1,108 @@+{-# language OverloadedStrings, MultiWayIf #-}+module Main where++import qualified Data.ByteString.Builder as B++import Control.Applicative+import Data.Attoparsec.ByteString.Char8 (Parser, (<?>))+import qualified Data.Attoparsec.ByteString.Char8 as A+import qualified Data.Attoparsec.ByteString.Lazy as AL+import qualified Blaze.ByteString.Builder.HTTP as Blaze+import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import Data.ByteString.Builder.HTTP.Chunked+import qualified Data.ByteString.Lazy as L+import Data.Functor+import Data.Maybe++import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Tasty+import Test.Tasty.Hedgehog+import Test.Tasty.HUnit (testCase, (@?=))++main :: IO ()+main = defaultMain $ testGroup "Tests" [properties, unitTests]++chunkedTransferEncodingL :: L.ByteString -> L.ByteString+chunkedTransferEncodingL = B.toLazyByteString . chunkedTransferEncoding . B.lazyByteString++chunkedTransferEncodingLBlaze :: L.ByteString -> L.ByteString+chunkedTransferEncodingLBlaze = B.toLazyByteString . Blaze.chunkedTransferEncoding . B.lazyByteString++properties :: TestTree+properties = testGroup "Properties"+ [ p "Encoding and parsing roundtrips" $ do+ lbs <- forAll genLS+ tripping lbs+ chunkedTransferEncodingL+ parseTransferChunks+ -- This is about detecting differences in output,+ -- not about bug-to-bug compatibility.+ , p "Identical output as Blaze" $ do+ lbs <- forAll genLS+ chunkedTransferEncodingL lbs === chunkedTransferEncodingLBlaze lbs+ ]+ where+ p name = testProperty name . property++genLS :: Gen L.ByteString+genLS = L.fromChunks <$> genSs++genSs :: Gen [ByteString]+genSs = Gen.list (Range.linear 0 100) genSnippedS++genSnippedS :: Gen ByteString+genSnippedS = do+ d <- genOffSet+ e <- genOffSet+ S.drop d . dropEnd e <$> genPackedS+ where+ genOffSet = Gen.int (Range.linear 0 100)+ dropEnd n bs = S.take m bs+ where m = S.length bs - n++genPackedS :: Gen ByteString+genPackedS =+ S.replicate+ <$> Gen.int (Range.linear 0 mAX_CHUNK_SIZE)+ <*> Gen.word8 (Range.constantFrom 95 minBound maxBound)++parseTransferChunks :: L.ByteString -> Either String L.ByteString+parseTransferChunks = AL.eitherResult .+ fmap (L.fromChunks . catMaybes) .+ AL.parse (many transferChunkParser)++-- Adapted from snap-server+transferChunkParser :: Parser (Maybe ByteString)+transferChunkParser = parser <?> "encodedChunkParser"+ where+ parser = do+ hex <- A.hexadecimal <?> "hexadecimal"+ -- skipWhile (/= '\r') <?> "skipToEOL" -- We don't add chunk extensions+ void crlf <?> "linefeed"+ if | hex > mAX_CHUNK_SIZE+ -> fail $ "Chunk of size " ++ show hex +++ " is too long. Max chunk size is " ++ show mAX_CHUNK_SIZE+ | hex < 0+ -> fail $ "Negative chunk size: " ++ show hex+ | hex == 0+ -> (crlf >> return Nothing) <?> "terminal crlf after 0 length"+ | otherwise+ -> do+ x <- A.take hex <?> "reading data chunk"+ void crlf <?> "linefeed after data chunk"+ return $! Just x++ crlf = A.string "\r\n"++-- Chunks larger than this may indicate denial-of-service attack.+mAX_CHUNK_SIZE :: Int+mAX_CHUNK_SIZE = 256 * 1024 - 1++unitTests :: TestTree+unitTests = testGroup "Unit tests"+ [ testCase "Encoding an empty builder returns an empty builder" $+ chunkedTransferEncodingL "" @?= ""+ ]