@@ -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 )
@@ -100,7 +101,7 @@ import qualified Timeout as T
100101import Timeout (Manager, registerKillThread, pause, resume)
101102import Data.Word (Word8)
102103import Data.List (foldl')
103−import Control.Monad (forever, when)
104+import Control.Monad (forever, when, void)
104105import qualified Network.HTTP.Types as H
105106import qualified Data.CaseInsensitive as CI
106107import System.IO (hPrint, stderr)
@@ -202,13 +203,14 @@ runSettingsConnection set getConn app = do
202203 port = settingsPort set
203204 tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return
204205 $ settingsManager set
205− forever $ do
206+ mask $ \restore -> forever $ do
207+ allowInterrupt
206208 (conn, addr) <- getConn
207− _ <- forkIO $ do
209+ void $ forkIO $ do
208210 th <- T.registerKillThread tm
209− serveConnection set th onE port app conn addr
210− T.cancel th
211− return ()
211+ handle onE $ (do restore $ serveConnection set th port app conn addr
212+ connClose conn >> T.cancel th
213+ ) `onException` (T.cancel th >> connClose conn)
212214
213215-- | Contains a @Source@ and a byte count that is still to be read in.
214216newtype IsolatedBSSource = IsolatedBSSource (I.IORef (Int, C.Source (ResourceT IO) ByteString))
@@ -271,14 +273,9 @@ ibsDone (IsolatedBSSource ref) = fmap snd $ I.readIORef ref
271273
272274serveConnection :: Settings
273275 -> T.Handle
274− -> (SomeException -> IO ())
275− -> Port -> Application -> Connection -> SockAddr -> IO ()
276−serveConnection settings th onException port app conn remoteHost' =
277− catch
278− (finally
279− (runResourceT serveConnection')
280− (connClose conn))
281− onException
276+ -> Port -> Application -> Connection -> SockAddr-> IO ()
277+serveConnection settings th port app conn remoteHost' =
278+ runResourceT serveConnection'
282279 where
283280 serveConnection' :: ResourceT IO ()
284281 serveConnection' = do