bsb-http-chunked 0.0.0.3 → 0.0.0.4
raw patch · 3 files changed
+104/−104 lines, 3 filesdep −bytestring-builderdep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies removed: bytestring-builder
Dependency ranges changed: base, bytestring
API changes (from Hackage documentation)
Files
- CHANGELOG.md +10/−1
- Data/ByteString/Builder/HTTP/Chunked.hs +91/−94
- bsb-http-chunked.cabal +3/−9
CHANGELOG.md view
@@ -1,5 +1,11 @@ # 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@@ -23,7 +29,10 @@ 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+[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
Data/ByteString/Builder/HTTP/Chunked.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings #-}+{-# 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) @@ -7,16 +7,14 @@ , chunkedTransferTerminator ) where -import Control.Applicative (pure)-import Control.Monad (void)-import Foreign (Ptr, Word8, (.&.))+import Control.Monad (void, when)+import Foreign (Ptr, Word8, Word32, (.&.)) import qualified Foreign as F-import GHC.Base (Int(..), uncheckedShiftRL#)-import GHC.Word (Word32(..)) +import Data.ByteString (ByteString) import qualified Data.ByteString as S import Data.ByteString.Builder (Builder)-import Data.ByteString.Builder.Internal (BufferRange(..), BuildSignal)+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@@ -30,7 +28,7 @@ writeCRLF :: Ptr Word8 -> IO (Ptr Word8) writeCRLF op = do P.runF (P.char8 P.>*< P.char8) ('\r', '\n') op- pure $! op `F.plusPtr` 2+ pure $ op `F.plusPtr` crlfLength {-# INLINE crlfBuilder #-} crlfBuilder :: Builder@@ -40,43 +38,55 @@ -- Hex Encoding Infrastructure ------------------------------------------------------------------------------ -{-# INLINE shiftr_w32 #-}-shiftr_w32 :: Word32 -> Int -> Word32-shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)+-- | Pad the chunk size with leading zeros?+data Padding+ = NoPadding+ | PadTo !Int --- | @writeWord32Hex len w op@ writes the hex encoding of @w@ to @op@ and +{-# 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+{-# 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+ pure $ op0 `F.plusPtr` len where- go !w !op- | op < op0 = pure ()- | otherwise = do+ 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 `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)+ 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 = max 1 . iterationsUntilZero (`shiftr_w32` 4)+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 ------------------------------------------------------------------------------ @@ -100,86 +110,73 @@ 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 = 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)-+ | otherwise = -- 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+ outRemaining = ope `F.minusPtr` op+ maxChunkSizeLength = word32HexLength $ fromIntegral outRemaining - -- 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+ !brInner@(BufferRange opInner _) = BufferRange+ (op `F.plusPtr` (maxChunkSizeLength + crlfLength)) -- leave space for chunk header+ (ope `F.plusPtr` (-maxAfterBufferOverhead)) -- leave space at end of data - maxEncodingOverhead = maxBeforeBufferOverhead + maxAfterBufferOverhead+ doneH :: Ptr Word8 -> _x+ -> IO (BuildSignal a)+ doneH opInner' _ =+ wrapChunk opInner' $ \op' ->+ k $! BufferRange op' ope - minimalBufferSize = minimalChunkSize + maxEncodingOverhead+ fullH :: Ptr Word8 -> Int -> BuildStep _x+ -> IO (BuildSignal a)+ fullH opInner' minRequiredSize nextInnerStep =+ wrapChunk opInner' $ \op' ->+ pure $! B.bufferFull+ (minRequiredSize + maxEncodingOverhead)+ op'+ (go nextInnerStep) - -- remaining and required space computation- outRemaining = ope `F.minusPtr` op- maxChunkSizeLength = word32HexLength $ fromIntegral outRemaining+ 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) --- | The zero-length chunk @0\\r\\n\\r\\n@ signaling the termination of the data transfer.+ -- 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.cabal view
@@ -1,5 +1,5 @@ Name: bsb-http-chunked-Version: 0.0.0.3+Version: 0.0.0.4 Synopsis: Chunked HTTP transfer encoding for bytestring builders Description: This library contains functions for encoding [bytestring@@ -36,9 +36,8 @@ Library exposed-modules: Data.ByteString.Builder.HTTP.Chunked- build-depends: base >= 4.3 && < 4.13,- bytestring >= 0.9 && < 0.11,- bytestring-builder < 0.11+ 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@@ -51,14 +50,11 @@ , 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@@ -80,6 +76,4 @@ , gauge , semigroups ghc-options: -O2 -Wall -rtsopts- if impl(ghc < 7.10)- buildable: False type: exitcode-stdio-1.0