warp 3.2.2 → 3.2.3
raw patch · 6 files changed
+73/−79 lines, 6 filesdep ~http2
Dependency ranges changed: http2
Files
- ChangeLog.md +6/−0
- Network/Wai/Handler/Warp/HTTP2/HPACK.hs +20/−28
- Network/Wai/Handler/Warp/HTTP2/Sender.hs +14/−27
- Network/Wai/Handler/Warp/HTTP2/Types.hs +5/−5
- Network/Wai/Handler/Warp/Header.hs +25/−16
- warp.cabal +3/−3
ChangeLog.md view
@@ -1,3 +1,9 @@+## 3.2.3++* Using http2 v1.5.x which much improves the performance of HTTP/2.+* To get rid of the bottleneck of ByteString's (==), a new logic to+ compare header names is introduced.+ ## 3.2.2 * Throwing errno for pread [#499](https://github.com/yesodweb/wai/issues/499).
Network/Wai/Handler/Warp/HTTP2/HPACK.hs view
@@ -1,16 +1,13 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NamedFieldPuns, RecordWildCards #-} module Network.Wai.Handler.Warp.HTTP2.HPACK where import Control.Arrow (first) import qualified Control.Exception as E-import qualified Data.ByteString as B-import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Char8 as B8 import Data.CaseInsensitive (foldedCase)-import Data.IORef (readIORef, writeIORef)-import Network.HPACK+import Network.HPACK hiding (Buffer) import qualified Network.HTTP.Types as H import Network.HTTP2 import Network.Wai.Handler.Warp.HTTP2.Types@@ -22,39 +19,34 @@ -- $setup -- >>> :set -XOverloadedStrings +strategy :: EncodeStrategy+strategy = EncodeStrategy { compressionAlgo = Linear, useHuffman = False }+ -- Set-Cookie: contains only one cookie value. -- So, we don't need to split it.-hpackEncodeHeader :: Context -> InternalInfo -> S.Settings+hpackEncodeHeader :: Context -> Buffer -> BufSize+ -> InternalInfo -> S.Settings -> H.Status -> H.ResponseHeaders- -> IO Builder-hpackEncodeHeader ctx ii settings s h = do- hdr1 <- addServerAndDate h- let hdr2 = (":status", status) : map (first foldedCase) hdr1- hpackEncodeRawHeaders ctx hdr2+ -> IO (HeaderList, Int)+hpackEncodeHeader Context{..} buf siz ii settings s hdr0 = do+ hdr1 <- addServerAndDate hdr0+ let hs = (":status", status) : map (first foldedCase) hdr1+ encodeHeaderBuffer buf siz strategy True encodeDynamicTable hs where status = B8.pack $ show $ H.statusCode s dc = dateCacher ii- rspidxhdr = indexResponseHeader h+ rspidxhdr = indexResponseHeader hdr0 defServer = S.settingsServerName settings addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr -hpackEncodeCIHeaders :: Context -> [H.Header] -> IO Builder-hpackEncodeCIHeaders ctx = hpackEncodeRawHeaders ctx . map (first foldedCase)--hpackEncodeRawHeaders :: Context -> [(B.ByteString, B.ByteString)] -> IO Builder-hpackEncodeRawHeaders Context{encodeDynamicTable} hdr = do- ehdrtbl <- readIORef encodeDynamicTable- (ehdrtbl', builder) <- encodeHeaderBuilder defaultEncodeStrategy ehdrtbl hdr- writeIORef encodeDynamicTable ehdrtbl'- return builder+hpackEncodeHeaderLoop :: Context -> Buffer -> BufSize -> HeaderList+ -> IO (HeaderList, Int)+hpackEncodeHeaderLoop Context{..} buf siz hs =+ encodeHeaderBuffer buf siz strategy False encodeDynamicTable hs ---------------------------------------------------------------- hpackDecodeHeader :: HeaderBlockFragment -> Context -> IO HeaderList-hpackDecodeHeader hdrblk Context{decodeDynamicTable} = do- hdrtbl <- readIORef decodeDynamicTable- (hdrtbl', hdr) <- decodeHeader hdrtbl hdrblk `E.onException` cleanup- writeIORef decodeDynamicTable hdrtbl'- return hdr- where- cleanup = E.throwIO $ ConnectionError CompressionError "cannot decompress the header"+hpackDecodeHeader hdrblk Context{..} =+ decodeHeader decodeDynamicTable hdrblk `E.catch` \(E.SomeException _) ->+ E.throwIO $ ConnectionError CompressionError "cannot decompress the header"
Network/Wai/Handler/Warp/HTTP2/Sender.hs view
@@ -105,9 +105,7 @@ connSendAll frame case lookup SettingsHeaderTableSize alist of Nothing -> return ()- Just siz -> do- dyntbl <- readIORef encodeDynamicTable- setLimitForEncoding siz dyntbl+ Just siz -> setLimitForEncoding siz encodeDynamicTable return True output (ONext strm curr mtbq) off0 lim = do@@ -195,43 +193,32 @@ headerContinue sid rspn endOfStream off = do let !s = rspnStatus rspn !h = rspnHeaders rspn- builder <- hpackEncodeHeader ctx ii settings s h let !offkv = off + frameHeaderLength let !bufkv = connWriteBuffer `plusPtr` offkv !limkv = connBufferSize - offkv- (kvlen, signal) <- B.runBuilder builder bufkv limkv- let flag0 = case signal of- B.Done -> setEndHeader defaultFlags- _ -> defaultFlags+ (hs,kvlen) <- hpackEncodeHeader ctx bufkv limkv ii settings s h+ let flag0 = case hs of+ [] -> setEndHeader defaultFlags+ _ -> defaultFlags flag = if endOfStream then setEndStream flag0 else flag0 let buf = connWriteBuffer `plusPtr` off fillFrameHeader FrameHeaders kvlen sid flag buf- continue sid kvlen signal+ continue sid kvlen hs bufHeaderPayload = connWriteBuffer `plusPtr` frameHeaderLength headerPayloadLim = connBufferSize - frameHeaderLength - continue _ kvlen B.Done = return kvlen- continue sid kvlen (B.More _ writer) = do+ continue _ kvlen [] = return kvlen+ continue sid kvlen hs = do flushN $ kvlen + frameHeaderLength -- Now off is 0- (kvlen', signal') <- writer bufHeaderPayload headerPayloadLim- let flag = case signal' of- B.Done -> setEndHeader defaultFlags- _ -> defaultFlags+ (hs', kvlen') <- hpackEncodeHeaderLoop ctx bufHeaderPayload headerPayloadLim hs+ when (hs == hs') $ E.throwIO $ ConnectionError CompressionError "cannot compress the header"+ let flag = case hs' of+ [] -> setEndHeader defaultFlags+ _ -> defaultFlags fillFrameHeader FrameContinuation kvlen' sid flag connWriteBuffer- continue sid kvlen' signal'- continue sid kvlen (B.Chunk bs writer) = do- flushN $ kvlen + frameHeaderLength- -- Now off is 0- let (bs1,bs2) = BS.splitAt headerPayloadLim bs- kvlen' = BS.length bs1- void $ copy bufHeaderPayload bs1- fillFrameHeader FrameContinuation kvlen' sid defaultFlags connWriteBuffer- if bs2 == "" then- continue sid kvlen' (B.More 0 writer)- else- continue sid kvlen' (B.Chunk bs2 writer)+ continue sid kvlen' hs' -- Re-enqueue the stream in the output queue. maybeEnqueueNext :: Stream -> Maybe (TBQueue Sequence) -> Maybe DynaNext -> IO ()
Network/Wai/Handler/Warp/HTTP2/Types.hs view
@@ -24,7 +24,7 @@ import Network.HTTP2 import Network.HTTP2.Priority-import Network.HPACK+import Network.HPACK hiding (Buffer) ---------------------------------------------------------------- @@ -109,8 +109,8 @@ , inputQ :: !(TQueue Input) , outputQ :: !(PriorityTree Output) , controlQ :: !(TQueue Control)- , encodeDynamicTable :: !(IORef DynamicTable)- , decodeDynamicTable :: !(IORef DynamicTable)+ , encodeDynamicTable :: !DynamicTable+ , decodeDynamicTable :: !DynamicTable , connectionWindow :: !(TVar WindowSize) } @@ -127,8 +127,8 @@ <*> newTQueueIO <*> newPriorityTree <*> newTQueueIO- <*> (newDynamicTableForEncoding defaultDynamicTableSize >>= newIORef)- <*> (newDynamicTableForDecoding defaultDynamicTableSize >>= newIORef)+ <*> newDynamicTableForEncoding defaultDynamicTableSize+ <*> newDynamicTableForDecoding defaultDynamicTableSize 4096 <*> newTVarIO defaultInitialWindowSize clearContext :: Context -> IO ()
Network/Wai/Handler/Warp/Header.hs view
@@ -4,6 +4,8 @@ import Data.Array import Data.Array.ST+import qualified Data.ByteString as BS+import Data.CaseInsensitive (foldedCase) import Network.HTTP.Types import Network.Wai.Handler.Warp.Types @@ -38,18 +40,22 @@ requestMaxIndex = fromEnum (maxBound :: RequestHeaderIndex) requestKeyIndex :: HeaderName -> Int-requestKeyIndex "content-length" = fromEnum ReqContentLength-requestKeyIndex "transfer-encoding" = fromEnum ReqTransferEncoding-requestKeyIndex "expect" = fromEnum ReqExpect-requestKeyIndex "connection" = fromEnum ReqConnection-requestKeyIndex "range" = fromEnum ReqRange-requestKeyIndex "host" = fromEnum ReqHost-requestKeyIndex "if-modified-since" = fromEnum ReqIfModifiedSince-requestKeyIndex "if-unmodified-since" = fromEnum ReqIfUnmodifiedSince-requestKeyIndex "if-range" = fromEnum ReqIfRange-requestKeyIndex "referer" = fromEnum ReqReferer-requestKeyIndex "user-agent" = fromEnum ReqUserAgent-requestKeyIndex _ = -1+requestKeyIndex hn = case BS.length bs of+ 4 -> if bs == "host" then fromEnum ReqHost else -1+ 5 -> if bs == "range" then fromEnum ReqRange else -1+ 6 -> if bs == "expect" then fromEnum ReqExpect else -1+ 7 -> if bs == "referer" then fromEnum ReqReferer else -1+ 8 -> if bs == "if-range" then fromEnum ReqIfRange else -1+ 10 -> if bs == "user-agent" then fromEnum ReqUserAgent else+ if bs == "connection" then fromEnum ReqConnection else -1+ 14 -> if bs == "content-length" then fromEnum ReqContentLength else -1+ 17 -> if bs == "transfer-encoding" then fromEnum ReqTransferEncoding else+ if bs == "if-modified-since" then fromEnum ReqIfModifiedSince+ else -1+ 19 -> if bs == "if-unmodified-since" then fromEnum ReqIfUnmodifiedSince else -1+ _ -> -1+ where+ bs = foldedCase hn defaultIndexRequestHeader :: IndexedHeader defaultIndexRequestHeader = array (0,requestMaxIndex) [(i,Nothing)|i<-[0..requestMaxIndex]]@@ -69,10 +75,13 @@ responseMaxIndex = fromEnum (maxBound :: ResponseHeaderIndex) responseKeyIndex :: HeaderName -> Int-responseKeyIndex "content-length" = fromEnum ResContentLength-responseKeyIndex "server" = fromEnum ResServer-responseKeyIndex "date" = fromEnum ResDate-responseKeyIndex _ = -1+responseKeyIndex hn = case BS.length bs of+ 4 -> if bs == "date" then fromEnum ResDate else -1+ 6 -> if bs == "server" then fromEnum ResServer else -1+ 14 -> if bs == "content-length" then fromEnum ResContentLength else -1+ _ -> -1+ where+ bs = foldedCase hn ----------------------------------------------------------------
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 3.2.2+Version: 3.2.3 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE@@ -43,7 +43,7 @@ , ghc-prim , http-types >= 0.8.5 , iproute >= 1.3.1- , http2 >= 1.4 && < 1.5+ , http2 >= 1.5 && < 1.6 , simple-sendfile >= 0.2.7 && < 0.3 , unix-compat >= 0.2 , wai >= 3.2 && < 3.3@@ -163,7 +163,7 @@ , directory , process , containers- , http2 >= 1.4 && < 1.5+ , http2 >= 1.5 && < 1.6 , word8 , hashable , http-date