@@ -31,6 +31,7 @@ import Network.Wai.Handler.Warp.SendFile
3131import Network.Wai.Handler.Warp.Settings
3232import qualified Network.Wai.Handler.Warp.Timeout as T
3333import Network.Wai.Handler.Warp.Types
34+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
3435
3536#if WINDOWS
3637import qualified Control.Concurrent.MVar as MV
@@ -215,19 +216,22 @@ serveConnection :: Connection
215216 -> Settings
216217 -> Application
217218 -> IO ()
218−serveConnection conn ii addr settings app =
219− recvSendLoop (connSource conn th) `onException` send500
219+serveConnection conn ii addr settings app = do
220+ istatus <- newIORef False
221+ recvSendLoop istatus (connSource conn th istatus) `onException` send500 istatus
220222 where
221223 th = threadHandle ii
222224
223− send500 = void $ mask $ \restore ->
224− sendResponse conn ii restore dummyreq defaultIndexRequestHeader internalError
225+ send500 istatus = do
226+ status <- readIORef istatus
227+ when status $ void $ mask $ \restore ->
228+ sendResponse conn ii restore dummyreq defaultIndexRequestHeader internalError
225229
226230 dummyreq = defaultRequest { remoteHost = addr }
227231
228232 internalError = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"
229233
230− recvSendLoop fromClient = do
234+ recvSendLoop istatus fromClient = do
231235 (req, idxhdr, getSource) <- recvRequest settings conn ii addr fromClient
232236 case settingsIntercept settings req of
233237 Nothing -> do
@@ -240,6 +244,7 @@ serveConnection conn ii addr settings app =
240244 keepAlive <- mask $ \restore -> do
241245 res <- restore $ app req
242246 T.resume th
247+ writeIORef istatus False
243248 sendResponse conn ii restore req idxhdr res
244249
245250 -- We just send a Response and it takes a time to
@@ -255,19 +260,21 @@ serveConnection conn ii addr settings app =
255260 requestBody req $$ CL.sinkNull
256261 ResumableSource fromClient' _ <- getSource
257262
258− when keepAlive $ recvSendLoop fromClient'
263+ when keepAlive $ recvSendLoop istatus fromClient'
259264 Just intercept -> do
260265 T.pause th
261266 ResumableSource fromClient' _ <- getSource
262267 intercept fromClient' conn
263268
264−connSource :: Connection -> T.Handle -> Source IO ByteString
265−connSource Connection { connRecv = recv } th = src
269+connSource :: Connection -> T.Handle -> IORef Bool -> Source IO ByteString
270+connSource Connection { connRecv = recv } th istatus = src
266271 where
267272 src = do
268273 bs <- liftIO recv
269274 unless (S.null bs) $ do
270− when (S.length bs >= 2048) $ liftIO $ T.tickle th
275+ liftIO $ do
276+ writeIORef istatus True
277+ when (S.length bs >= 2048) $ T.tickle th
271278 yield bs
272279 src
273280