on master help sign in
changing the signature of recvRequest.
commit2f36d97387ce2ceb1403af26733fdfe965273297 authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 30 Oct 2013, 13:50 (13 years ago) parentdc1e6f4
2 files changed+8−6
warp/Network/Wai/Handler/Warp/Request.hs+5−3 warp/Network/Wai/Handler/Warp/Run.hs+3−3
warp/Network/Wai/Handler/Warp/Request.hs+5−3
@@ -40,7 +40,7 @@ maxTotalHeaderLength = 50 * 1024
4040----------------------------------------------------------------
4141
4242recvRequest :: Connection
43− -> Timeout.Handle
43+ -> InternalInfo
4444 -> SockAddr -- ^ Peer's address.
4545 -> Source IO ByteString -- ^ Where HTTP request comes from.
4646 -> IO (Request
@@ -50,7 +50,7 @@ recvRequest :: Connection
5050 -- 'IndexedHeader' of HTTP request for internal use, and
5151 -- leftover source (i.e. HTTP pipelining).
5252
53−recvRequest conn timeoutHandle addr src0 = do
53+recvRequest conn ii addr src0 = do
5454 (src, hdrlines) <- src0 $$+ headerLines
5555 (method, rpath, gets, httpversion, hdr) <- parseHeaderLines hdrlines
5656 let idxhdr = indexRequestHeader hdr
@@ -69,11 +69,13 @@ recvRequest conn timeoutHandle addr src0 = do
6969 , requestHeaders = hdr
7070 , isSecure = False
7171 , remoteHost = addr
72− , requestBody = timeoutBody timeoutHandle rbody
72+ , requestBody = timeoutBody th rbody
7373 , vault = mempty
7474 , requestBodyLength = bodyLength
7575 }
7676 return (req, idxhdr, getSource)
77+ where
78+ th = threadHandle ii
7779
7880----------------------------------------------------------------
7981
warp/Network/Wai/Handler/Warp/Run.hs+3−3
@@ -214,7 +214,7 @@ serveConnection :: Connection
214214 -> Settings
215215 -> Application
216216 -> IO ()
217−serveConnection conn ii remoteHost' settings app =
217+serveConnection conn ii addr settings app =
218218 recvSendLoop (connSource conn th) `onException` send500
219219 where
220220 th = threadHandle ii
@@ -222,12 +222,12 @@ serveConnection conn ii remoteHost' settings app =
222222 send500 = void $ mask $ \restore ->
223223 sendResponse conn ii restore dummyreq defaultIndexRequestHeader internalError
224224
225− dummyreq = defaultRequest { remoteHost = remoteHost' }
225+ dummyreq = defaultRequest { remoteHost = addr }
226226
227227 internalError = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"
228228
229229 recvSendLoop fromClient = do
230− (req, idxhdr, getSource) <- recvRequest conn th remoteHost' fromClient
230+ (req, idxhdr, getSource) <- recvRequest conn ii addr fromClient
231231 case settingsIntercept settings req of
232232 Nothing -> do
233233 -- Let the application run for as long as it wants