@@ -4,6 +4,7 @@
4module Network.Wai.Handler.Warp.Run where
4module Network.Wai.Handler.Warp.Run where
6import Control.Concurrent (threadDelay, forkIOWithUnmask)
6import Control.Concurrent (threadDelay, forkIOWithUnmask)
7+import qualified Control.Concurrent as Conc (yield)
7import Control.Exception
8import Control.Exception
8import qualified Control.Exception.Lifted as Lifted
9import qualified Control.Exception.Lifted as Lifted
9import Control.Monad (forever, when, unless, void)
10import Control.Monad (forever, when, unless, void)
@@ -256,6 +257,15 @@ serveConnection timeoutHandle settings cleaner app conn remoteHost' =
256 liftIO $ T.resume th
257 liftIO $ T.resume th
257 sendResponse settings cleaner env' conn res
258 sendResponse settings cleaner env' conn res
260+ -- | We just send a Response and it takes a time to
261+ -- receive a Request again. If we immediately call recv,
262+ -- it is likely to fail and the IO manager works.
263+ -- It is very costy. So, we yield to another Haskell
264+ -- thread hoping that the next Request will arraive
265+ -- when this Haskell thread will be re-scheduled.
266+ -- This improves performance at least when
267+ -- the number of cores is small.
259 -- flush the rest of the request body
269 -- flush the rest of the request body
260 requestBody env $$ CL.sinkNull
270 requestBody env $$ CL.sinkNull
261 ResumableSource fromClient' _ <- liftIO getSource
271 ResumableSource fromClient' _ <- liftIO getSource