diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/Data/ByteString/Builder/HTTP/Chunked.hs b/Data/ByteString/Builder/HTTP/Chunked.hs --- a/Data/ByteString/Builder/HTTP/Chunked.hs +++ b/Data/ByteString/Builder/HTTP/Chunked.hs @@ -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" diff --git a/bsb-http-chunked.cabal b/bsb-http-chunked.cabal --- a/bsb-http-chunked.cabal +++ b/bsb-http-chunked.cabal @@ -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