bsb-http-chunked-0.0.0.3/0000755000000000000000000000000000000000000013141 5ustar0000000000000000bsb-http-chunked-0.0.0.3/CHANGELOG.md0000755000000000000000000000141000000000000014751 0ustar0000000000000000# 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 ## [0.0.0.1] – 2018-03-13 - Documentation improvements - `text` and `deepseq` dependencies were removed ## 0 – 2018-03-12 Initial release. --- 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.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 bsb-http-chunked-0.0.0.3/Data/ByteString/Builder/HTTP/0000755000000000000000000000000000000000000020251 5ustar0000000000000000bsb-http-chunked-0.0.0.3/Data/ByteString/Builder/HTTP/Chunked.hs0000644000000000000000000002036100000000000022170 0ustar0000000000000000{-# 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 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(..)) 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 ------------------------------------------------------------------------------ {-# INLINE writeCRLF #-} 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 ------------------------------------------------------------------------------ {-# 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 = pure () | otherwise = do let nibble :: Word8 nibble = fromIntegral w .&. 0xF hex | nibble < 10 = 48 + nibble | otherwise = 55 + nibble 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) -- | Length of the hex-string required to encode the given 'Word32'. {-# INLINE word32HexLength #-} word32HexLength :: Word32 -> Int word32HexLength = max 1 . iterationsUntilZero (`shiftr_w32` 4) ------------------------------------------------------------------------------ -- 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 = B.builder transferEncodingStep where transferEncodingStep k = go (B.runBuilder innerBuilder) where go innerStep (BufferRange op ope) -- FIXME: Assert that outRemaining < maxBound :: Word32 | outRemaining < minimalBufferSize = pure $ B.bufferFull minimalBufferSize op (go innerStep) | otherwise = do let !brInner@(BufferRange opInner _) = BufferRange (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 !chunkDataEnd mkSignal | chunkDataEnd == opInner = mkSignal op | otherwise = do 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) doneH opInner' _ = wrapChunk opInner' $ \op' -> do let !br' = BufferRange op' ope k br' fullH opInner' minRequiredSize nextInnerStep = wrapChunk opInner' $ \op' -> pure $! B.bufferFull (minRequiredSize + maxEncodingOverhead) op' (go nextInnerStep) insertChunkH opInner' bs nextInnerStep | S.null bs = -- flush wrapChunk opInner' $ \op' -> 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) 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 pure $! B.insertChunk op''' bs (B.runBuilderWith crlfBuilder $ go nextInnerStep) -- execute inner builder with reduced boundaries 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 -- hopefully provided by the driver or requested by the wrapped -- builders. minimalChunkSize = 1 -- overhead computation 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 = ope `F.minusPtr` op maxChunkSizeLength = word32HexLength $ fromIntegral outRemaining -- | The zero-length chunk @0\\r\\n\\r\\n@ signaling the termination of the data transfer. chunkedTransferTerminator :: Builder chunkedTransferTerminator = B.byteStringCopy "0\r\n\r\n" bsb-http-chunked-0.0.0.3/LICENSE0000644000000000000000000000302600000000000014147 0ustar0000000000000000Copyright Jasper Van der Jeugt 2010, Simon Meier 2010 & 2011 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Jasper Van der Jeugt nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. bsb-http-chunked-0.0.0.3/Setup.hs0000644000000000000000000000005600000000000014576 0ustar0000000000000000import Distribution.Simple main = defaultMain bsb-http-chunked-0.0.0.3/bench/0000755000000000000000000000000000000000000014220 5ustar0000000000000000bsb-http-chunked-0.0.0.3/bench/Bench.hs0000644000000000000000000000414000000000000015572 0ustar0000000000000000{-# 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-0.0.0.3/bsb-http-chunked.cabal0000644000000000000000000000530400000000000017271 0ustar0000000000000000Name: bsb-http-chunked Version: 0.0.0.3 Synopsis: Chunked HTTP transfer encoding for bytestring builders Description: This library contains functions for encoding [bytestring builders](http://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html#t:Builder) for [chunked HTTP\/1.1 transfer](https://en.wikipedia.org/wiki/Chunked_transfer_encoding). . This functionality was extracted from the [blaze-builder](http://hackage.haskell.org/package/blaze-builder) package. 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 License: BSD3 License-file: LICENSE Homepage: http://github.com/sjakobi/bsb-http-chunked Bug-Reports: http://github.com/sjakobi/bsb-http-chunked/issues Stability: Provisional Category: Data, Network Build-type: Simple Cabal-version: >= 1.8 Extra-source-files: CHANGELOG.md Source-repository head Type: git Location: https://github.com/sjakobi/bsb-http-chunked.git Library exposed-modules: Data.ByteString.Builder.HTTP.Chunked 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 bsb-http-chunked-0.0.0.3/tests/0000755000000000000000000000000000000000000014303 5ustar0000000000000000bsb-http-chunked-0.0.0.3/tests/Doctests.hs0000644000000000000000000000015100000000000016424 0ustar0000000000000000import Test.DocTest main :: IO () main = doctest ["-isrc", "Data/ByteString/Builder/HTTP/Chunked.hs"] bsb-http-chunked-0.0.0.3/tests/Tests.hs0000644000000000000000000000676100000000000015753 0ustar0000000000000000{-# 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 "" @?= "" ]