bsb-http-chunked-0.0.0.4/0000755000000000000000000000000013353705254013210 5ustar0000000000000000bsb-http-chunked-0.0.0.4/LICENSE0000644000000000000000000000302613353705254014216 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.4/bsb-http-chunked.cabal0000644000000000000000000000503313353705254017337 0ustar0000000000000000Name: bsb-http-chunked Version: 0.0.0.4 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.8 && < 4.13, bytestring >= 0.10.2 && < 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 , hedgehog , tasty , tasty-hedgehog , tasty-hunit ghc-options: -Wall -rtsopts 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 type: exitcode-stdio-1.0 bsb-http-chunked-0.0.0.4/Setup.hs0000644000000000000000000000005613353705254014645 0ustar0000000000000000import Distribution.Simple main = defaultMain bsb-http-chunked-0.0.0.4/CHANGELOG.md0000644000000000000000000000216013353705254015020 0ustar0000000000000000# Changelog for the `bsb-http-chunked` package ## [0.0.0.4] – 2018-09-29 - Fix an issue with file modification times in the tarball that prevented installation on Windows 10. [#22] - Remove compatibility with GHC < 7.10 (prompted by internal refactorings) ## [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.4...HEAD [0.0.0.4]: https://github.com/sjakobi/bsb-http-chunked/compare/v0.0.0.3...v0.0.0.4 [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 [#22]: https://github.com/sjakobi/bsb-http-chunked/issues/22 bsb-http-chunked-0.0.0.4/Data/0000755000000000000000000000000013353705254014061 5ustar0000000000000000bsb-http-chunked-0.0.0.4/Data/ByteString/0000755000000000000000000000000013353705254016153 5ustar0000000000000000bsb-http-chunked-0.0.0.4/Data/ByteString/Builder/0000755000000000000000000000000013353705254017541 5ustar0000000000000000bsb-http-chunked-0.0.0.4/Data/ByteString/Builder/HTTP/0000755000000000000000000000000013353705254020320 5ustar0000000000000000bsb-http-chunked-0.0.0.4/Data/ByteString/Builder/HTTP/Chunked.hs0000644000000000000000000001756413353705254022252 0ustar0000000000000000{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, ScopedTypeVariables #-} -- | 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.Monad (void, when) import Foreign (Ptr, Word8, Word32, (.&.)) import qualified Foreign as F import Data.ByteString (ByteString) import qualified Data.ByteString as S import Data.ByteString.Builder (Builder) import Data.ByteString.Builder.Internal (BufferRange(..), BuildSignal, BuildStep) 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` crlfLength {-# INLINE crlfBuilder #-} crlfBuilder :: Builder crlfBuilder = P.primFixed (P.char8 P.>*< P.char8) ('\r', '\n') ------------------------------------------------------------------------------ -- Hex Encoding Infrastructure ------------------------------------------------------------------------------ -- | Pad the chunk size with leading zeros? data Padding = NoPadding | PadTo !Int {-# INLINE writeWord32Hex #-} writeWord32Hex :: Padding -> Word32 -> Ptr Word8 -> IO (Ptr Word8) writeWord32Hex NoPadding w op = writeWord32Hex' (word32HexLength w) w op writeWord32Hex (PadTo len) w op = writeWord32Hex' len w op -- | @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 = when (op >= op0) $ do let nibble :: Word8 nibble = fromIntegral w .&. 0xF hex | nibble < 10 = 48 + nibble | otherwise = 55 + nibble F.poke op hex go (w `F.unsafeShiftR` 4) (op `F.plusPtr` (-1)) -- | Length of the hex-string required to encode the given 'Word32'. {-# INLINE word32HexLength #-} word32HexLength :: Word32 -> Int word32HexLength w = maxW32HexLength - (F.countLeadingZeros w `F.unsafeShiftR` 2) ------------------------------------------------------------------------------ -- Constants ------------------------------------------------------------------------------ crlfLength, maxW32HexLength, minimalChunkSize, maxBeforeBufferOverhead, maxAfterBufferOverhead, maxEncodingOverhead, minimalBufferSize :: Int crlfLength = 2 maxW32HexLength = 8 -- 4 bytes, 2 hex digits per byte minimalChunkSize = 1 maxBeforeBufferOverhead = maxW32HexLength + crlfLength maxAfterBufferOverhead = crlfLength + maxW32HexLength + crlfLength maxEncodingOverhead = maxBeforeBufferOverhead + maxAfterBufferOverhead minimalBufferSize = minimalChunkSize + maxEncodingOverhead ------------------------------------------------------------------------------ -- 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 :: forall a. BuildStep a -> BuildStep a transferEncodingStep k = go (B.runBuilder innerBuilder) where go :: (BufferRange -> IO (BuildSignal _x)) -> BuildStep a go innerStep (BufferRange op ope) -- FIXME: Assert that outRemaining < maxBound :: Word32 | outRemaining < minimalBufferSize = pure $ B.bufferFull minimalBufferSize op (go innerStep) | otherwise = -- execute inner builder with reduced boundaries B.fillWithBuildStep innerStep doneH fullH insertChunkH brInner where outRemaining = ope `F.minusPtr` op maxChunkSizeLength = word32HexLength $ fromIntegral outRemaining !brInner@(BufferRange opInner _) = BufferRange (op `F.plusPtr` (maxChunkSizeLength + crlfLength)) -- leave space for chunk header (ope `F.plusPtr` (-maxAfterBufferOverhead)) -- leave space at end of data doneH :: Ptr Word8 -> _x -> IO (BuildSignal a) doneH opInner' _ = wrapChunk opInner' $ \op' -> k $! BufferRange op' ope fullH :: Ptr Word8 -> Int -> BuildStep _x -> IO (BuildSignal a) fullH opInner' minRequiredSize nextInnerStep = wrapChunk opInner' $ \op' -> pure $! B.bufferFull (minRequiredSize + maxEncodingOverhead) op' (go nextInnerStep) insertChunkH :: Ptr Word8 -> ByteString -> BuildStep _x -> IO (BuildSignal a) insertChunkH opInner' bs nextInnerStep = wrapChunk opInner' $ \op' -> if S.null bs -- flush then pure $! B.insertChunk op' S.empty (go nextInnerStep) else do -- insert non-empty bytestring -- add header for inserted bytestring -- FIXME: assert(S.length bs < maxBound :: Word32) let chunkSize = fromIntegral $ S.length bs !op'' <- writeWord32Hex NoPadding chunkSize op' !op''' <- writeCRLF op'' -- insert bytestring and write CRLF in next buildstep pure $! B.insertChunk op''' bs (B.runBuilderWith crlfBuilder $ go nextInnerStep) -- 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 void $ writeWord32Hex (PadTo maxChunkSizeLength) chunkSize op void $ writeCRLF (opInner `F.plusPtr` (-crlfLength)) void $ writeCRLF chunkDataEnd mkSignal (chunkDataEnd `F.plusPtr` crlfLength) -- | The zero-length chunk @0\\r\\n\\r\\n@ signalling the termination of the data transfer. chunkedTransferTerminator :: Builder chunkedTransferTerminator = B.byteStringCopy "0\r\n\r\n" bsb-http-chunked-0.0.0.4/tests/0000755000000000000000000000000013353705254014352 5ustar0000000000000000bsb-http-chunked-0.0.0.4/tests/Doctests.hs0000644000000000000000000000015113353705254016473 0ustar0000000000000000import Test.DocTest main :: IO () main = doctest ["-isrc", "Data/ByteString/Builder/HTTP/Chunked.hs"] bsb-http-chunked-0.0.0.4/tests/Tests.hs0000644000000000000000000000676113353705254016022 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 "" @?= "" ] bsb-http-chunked-0.0.0.4/bench/0000755000000000000000000000000013353705254014267 5ustar0000000000000000bsb-http-chunked-0.0.0.4/bench/Bench.hs0000644000000000000000000000414013353705254015641 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