git.iko.soy/typeable/wai
on master help sign in
changing the signature of recvRequest.
2f36d97Kazu Yamamoto
warp/Network/Wai/Handler/Warp/Request.hs+5−3
compare with master
unifiedsplit
@@ -40,7 +40,7 @@ maxTotalHeaderLength = 50 * 1024
40----------------------------------------------------------------
40----------------------------------------------------------------
41
41
42recvRequest :: Connection
42recvRequest :: Connection
43− -> Timeout.Handle
43+ -> InternalInfo
44 -> SockAddr -- ^ Peer's address.
44 -> SockAddr -- ^ Peer's address.
45 -> Source IO ByteString -- ^ Where HTTP request comes from.
45 -> Source IO ByteString -- ^ Where HTTP request comes from.
46 -> IO (Request
46 -> IO (Request
@@ -50,7 +50,7 @@ recvRequest :: Connection
50 -- 'IndexedHeader' of HTTP request for internal use, and
50 -- 'IndexedHeader' of HTTP request for internal use, and
51 -- leftover source (i.e. HTTP pipelining).
51 -- leftover source (i.e. HTTP pipelining).
52
52
53−recvRequest conn timeoutHandle addr src0 = do
53+recvRequest conn ii addr src0 = do
54 (src, hdrlines) <- src0 $$+ headerLines
54 (src, hdrlines) <- src0 $$+ headerLines
55 (method, rpath, gets, httpversion, hdr) <- parseHeaderLines hdrlines
55 (method, rpath, gets, httpversion, hdr) <- parseHeaderLines hdrlines
56 let idxhdr = indexRequestHeader hdr
56 let idxhdr = indexRequestHeader hdr
@@ -69,11 +69,13 @@ recvRequest conn timeoutHandle addr src0 = do
69 , requestHeaders = hdr
69 , requestHeaders = hdr
70 , isSecure = False
70 , isSecure = False
71 , remoteHost = addr
71 , remoteHost = addr
72− , requestBody = timeoutBody timeoutHandle rbody
72+ , requestBody = timeoutBody th rbody
73 , vault = mempty
73 , vault = mempty
74 , requestBodyLength = bodyLength
74 , requestBodyLength = bodyLength
75 }
75 }
76 return (req, idxhdr, getSource)
76 return (req, idxhdr, getSource)
77+ where
78+ th = threadHandle ii
77
79
78----------------------------------------------------------------
80----------------------------------------------------------------
79
81
warp/Network/Wai/Handler/Warp/Run.hs+3−3
@@ -214,7 +214,7 @@ serveConnection :: Connection
214 -> Settings
214 -> Settings
215 -> Application
215 -> Application
216 -> IO ()
216 -> IO ()
217−serveConnection conn ii remoteHost' settings app =
217+serveConnection conn ii addr settings app =
218 recvSendLoop (connSource conn th) `onException` send500
218 recvSendLoop (connSource conn th) `onException` send500
219 where
219 where
220 th = threadHandle ii
220 th = threadHandle ii
@@ -222,12 +222,12 @@ serveConnection conn ii remoteHost' settings app =
222 send500 = void $ mask $ \restore ->
222 send500 = void $ mask $ \restore ->
223 sendResponse conn ii restore dummyreq defaultIndexRequestHeader internalError
223 sendResponse conn ii restore dummyreq defaultIndexRequestHeader internalError
224
224
225− dummyreq = defaultRequest { remoteHost = remoteHost' }
225+ dummyreq = defaultRequest { remoteHost = addr }
226
226
227 internalError = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"
227 internalError = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"
228
228
229 recvSendLoop fromClient = do
229 recvSendLoop fromClient = do
230− (req, idxhdr, getSource) <- recvRequest conn th remoteHost' fromClient
230+ (req, idxhdr, getSource) <- recvRequest conn ii addr fromClient
231 case settingsIntercept settings req of
231 case settingsIntercept settings req of
232 Nothing -> do
232 Nothing -> do
233 -- Let the application run for as long as it wants
233 -- Let the application run for as long as it wants