@@ -59,7 +59,7 @@ module Network.Wai.Handler.Warp
5959#endif
6060 ) where
6161
62−import Prelude hiding (catch, lines)
62+import Prelude hiding (lines)
6363import Network.Wai
6464
6565import Data.ByteString (ByteString)
@@ -71,7 +71,8 @@ import Network (sClose, Socket)
7171import Network.Socket (accept, SockAddr)
7272import qualified Network.Socket.ByteString as Sock
7373import Control.Exception
74− ( bracket, finally, Exception, SomeException, catch
74+ ( mask, allowInterrupt, handle, onException, bracket
75+ , Exception, SomeException
7576 , fromException, AsyncException (ThreadKilled)
7677 , try
7778 )
@@ -104,7 +105,7 @@ import qualified Timeout as T
104105import Timeout (Manager, registerKillThread, pause, resume)
105106import Data.Word (Word8)
106107import Data.List (foldl')
107−import Control.Monad (forever, when)
108+import Control.Monad (forever, when, void)
108109import qualified Network.HTTP.Types as H
109110import qualified Data.CaseInsensitive as CI
110111import System.IO (hPrint, stderr)
@@ -206,13 +207,14 @@ runSettingsConnection set getConn app = do
206207 port = settingsPort set
207208 tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return
208209 $ settingsManager set
209− forever $ do
210+ mask $ \restore -> forever $ do
211+ allowInterrupt
210212 (conn, addr) <- getConn
211− _ <- forkIO $ do
213+ void $ forkIO $ do
212214 th <- T.registerKillThread tm
213− serveConnection set th onE port app conn addr
214− T.cancel th
215− return ()
215+ handle onE $ (do restore $ serveConnection set th port app conn addr
216+ connClose conn >> T.cancel th
217+ ) `onException` (T.cancel th >> connClose conn)
216218
217219-- | Contains a @Source@ and a byte count that is still to be read in.
218220newtype IsolatedBSSource = IsolatedBSSource (I.IORef (Int, C.Source (ResourceT IO) ByteString))
@@ -275,14 +277,9 @@ ibsDone (IsolatedBSSource ref) = fmap snd $ I.readIORef ref
275277
276278serveConnection :: Settings
277279 -> T.Handle
278− -> (SomeException -> IO ())
279− -> Port -> Application -> Connection -> SockAddr -> IO ()
280−serveConnection settings th onException port app conn remoteHost' =
281− catch
282− (finally
283− (runResourceT serveConnection')
284− (connClose conn))
285− onException
280+ -> Port -> Application -> Connection -> SockAddr-> IO ()
281+serveConnection settings th port app conn remoteHost' =
282+ runResourceT serveConnection'
286283 where
287284 serveConnection' :: ResourceT IO ()
288285 serveConnection' = do