git.iko.soy/typeable/wai
on master help sign in
warp: fix HTTP2 requestBodyLength
9959b2eBin Jin
warp/Network/Wai/Handler/Warp/HTTP2/Receiver.hs+2−2
compare with master
unifiedsplit
@@ -122,7 +122,7 @@ frameReceiver ctx mkreq recvN = loop 0 `E.catch` sendGoaway
122 E.throwIO $ StreamError ProtocolError streamId
122 E.throwIO $ StreamError ProtocolError streamId
123 writeIORef streamPrecedence $ toPrecedence pri
123 writeIORef streamPrecedence $ toPrecedence pri
124 writeIORef streamState HalfClosed
124 writeIORef streamState HalfClosed
125− (!req, !ii) <- mkreq tbl (return "")
125+ (!req, !ii) <- mkreq tbl (Just 0, return "")
126 atomically $ writeTQueue inputQ $ Input strm req reqvt ii
126 atomically $ writeTQueue inputQ $ Input strm req reqvt ii
127 Open (HasBody tbl@(_,reqvt) pri) -> do
127 Open (HasBody tbl@(_,reqvt) pri) -> do
128 resetContinued
128 resetContinued
@@ -133,7 +133,7 @@ frameReceiver ctx mkreq recvN = loop 0 `E.catch` sendGoaway
133 writeIORef streamState $ Open (Body q mcl bodyLength)
133 writeIORef streamState $ Open (Body q mcl bodyLength)
134 readQ <- newReadBody q
134 readQ <- newReadBody q
135 bodySource <- mkSource readQ
135 bodySource <- mkSource readQ
136− (!req, !ii) <- mkreq tbl (readSource bodySource)
136+ (!req, !ii) <- mkreq tbl (mcl, readSource bodySource)
137 atomically $ writeTQueue inputQ $ Input strm req reqvt ii
137 atomically $ writeTQueue inputQ $ Input strm req reqvt ii
138 s@(Open Continued{}) -> do
138 s@(Open Continued{}) -> do
139 setContinued
139 setContinued
warp/Network/Wai/Handler/Warp/HTTP2/Request.hs+5−5
@@ -30,17 +30,17 @@ import Network.Wai.Handler.Warp.Types
30import Network.Wai.Internal (Request(..))
30import Network.Wai.Internal (Request(..))
31import System.IO.Unsafe (unsafePerformIO)
31import System.IO.Unsafe (unsafePerformIO)
32
32
33−type MkReq = (TokenHeaderList,ValueTable) -> IO ByteString -> IO (Request,InternalInfo)
33+type MkReq = (TokenHeaderList,ValueTable) -> (Maybe Int,IO ByteString) -> IO (Request,InternalInfo)
34
34
35mkRequest :: InternalInfo1 -> S.Settings -> SockAddr -> MkReq
35mkRequest :: InternalInfo1 -> S.Settings -> SockAddr -> MkReq
36−mkRequest ii1 settings addr (reqths,reqvt) body = do
36+mkRequest ii1 settings addr (reqths,reqvt) (bodylen,body) = do
37 ref <- newIORef Nothing
37 ref <- newIORef Nothing
38− mkRequest' ii1 settings addr ref (reqths,reqvt) body
38+ mkRequest' ii1 settings addr ref (reqths,reqvt) (bodylen,body)
39
39
40mkRequest' :: InternalInfo1 -> S.Settings -> SockAddr
40mkRequest' :: InternalInfo1 -> S.Settings -> SockAddr
41 -> IORef (Maybe HTTP2Data)
41 -> IORef (Maybe HTTP2Data)
42 -> MkReq
42 -> 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)
44 where
44 where
45 !req = Request {
45 !req = Request {
46 requestMethod = colonMethod
46 requestMethod = colonMethod
@@ -54,7 +54,7 @@ mkRequest' ii1 settings addr ref (reqths,reqvt) body = return (req,ii)
54 , remoteHost = addr
54 , remoteHost = addr
55 , requestBody = body
55 , requestBody = body
56 , vault = vaultValue
56 , vault = vaultValue
57− , requestBodyLength = ChunkedBody -- fixme
57+ , requestBodyLength = maybe ChunkedBody (KnownLength . fromIntegral) bodylen
58 , requestHeaderHost = mHost <|> mAuth
58 , requestHeaderHost = mHost <|> mAuth
59 , requestHeaderRange = mRange
59 , requestHeaderRange = mRange
60 , requestHeaderReferer = mReferer
60 , requestHeaderReferer = mReferer