on master help sign in
Merge pull request #573 from bjin/http2-body-length

warp: fix HTTP2 requestBodyLength

commitfc01eefc1cf766305e47f93c1c8f18b303ee6dfc authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 3 Aug 2016, 09:54 (10 years ago) parente784f0f9959b2e
2 files changed+7−7
warp/Network/Wai/Handler/Warp/HTTP2/Receiver.hs+2−2 warp/Network/Wai/Handler/Warp/HTTP2/Request.hs+5−5
warp/Network/Wai/Handler/Warp/HTTP2/Receiver.hs+2−2
@@ -122,7 +122,7 @@ frameReceiver ctx mkreq recvN = loop 0 `E.catch` sendGoaway
122122 E.throwIO $ StreamError ProtocolError streamId
123123 writeIORef streamPrecedence $ toPrecedence pri
124124 writeIORef streamState HalfClosed
125− (!req, !ii) <- mkreq tbl (return "")
125+ (!req, !ii) <- mkreq tbl (Just 0, return "")
126126 atomically $ writeTQueue inputQ $ Input strm req reqvt ii
127127 Open (HasBody tbl@(_,reqvt) pri) -> do
128128 resetContinued
@@ -133,7 +133,7 @@ frameReceiver ctx mkreq recvN = loop 0 `E.catch` sendGoaway
133133 writeIORef streamState $ Open (Body q mcl bodyLength)
134134 readQ <- newReadBody q
135135 bodySource <- mkSource readQ
136− (!req, !ii) <- mkreq tbl (readSource bodySource)
136+ (!req, !ii) <- mkreq tbl (mcl, readSource bodySource)
137137 atomically $ writeTQueue inputQ $ Input strm req reqvt ii
138138 s@(Open Continued{}) -> do
139139 setContinued
warp/Network/Wai/Handler/Warp/HTTP2/Request.hs+5−5
@@ -30,17 +30,17 @@ import Network.Wai.Handler.Warp.Types
3030import Network.Wai.Internal (Request(..))
3131import System.IO.Unsafe (unsafePerformIO)
3232
33−type MkReq = (TokenHeaderList,ValueTable) -> IO ByteString -> IO (Request,InternalInfo)
33+type MkReq = (TokenHeaderList,ValueTable) -> (Maybe Int,IO ByteString) -> IO (Request,InternalInfo)
3434
3535mkRequest :: InternalInfo1 -> S.Settings -> SockAddr -> MkReq
36−mkRequest ii1 settings addr (reqths,reqvt) body = do
36+mkRequest ii1 settings addr (reqths,reqvt) (bodylen,body) = do
3737 ref <- newIORef Nothing
38− mkRequest' ii1 settings addr ref (reqths,reqvt) body
38+ mkRequest' ii1 settings addr ref (reqths,reqvt) (bodylen,body)
3939
4040mkRequest' :: InternalInfo1 -> S.Settings -> SockAddr
4141 -> IORef (Maybe HTTP2Data)
4242 -> MkReq
43−mkRequest' ii1 settings addr ref (reqths,reqvt) body = return (req,ii)
43+mkRequest' ii1 settings addr ref (reqths,reqvt) (bodylen,body) = return (req,ii)
4444 where
4545 !req = Request {
4646 requestMethod = colonMethod
@@ -54,7 +54,7 @@ mkRequest' ii1 settings addr ref (reqths,reqvt) body = return (req,ii)
5454 , remoteHost = addr
5555 , requestBody = body
5656 , vault = vaultValue
57− , requestBodyLength = ChunkedBody -- fixme
57+ , requestBodyLength = maybe ChunkedBody (KnownLength . fromIntegral) bodylen
5858 , requestHeaderHost = mHost <|> mAuth
5959 , requestHeaderRange = mRange
6060 , requestHeaderReferer = mReferer