@@ -267,7 +267,29 @@ fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->
267267 -- Allocate a new IORef indicating whether the connection has been
268268 -- closed, to avoid double-freeing a connection
269269 withClosedRef $ \ref ->
270−
270+ let cleanUp (conn, _) = closeConn ref conn `finally` connFree conn
271+ serve (conn, transport) =
272+ -- We need to register a timeout handler for this thread, and
273+ -- cancel that handler as soon as we exit. We additionally close
274+ -- the connection immediately in case the child thread catches the
275+ -- async exception or performs some long-running cleanup action.
276+ bracket (T.registerKillThread (timeoutManager0 ii0) (closeConn ref conn))
277+ T.cancel $ \th ->
278+ let ii1 = toInternalInfo1 ii0 th
279+ -- We now have fully registered a connection close handler
280+ -- in the case of all exceptions, so it is safe to one
281+ -- again allow async exceptions.
282+ in unmask .
283+ -- Call the user-supplied on exception code if any
284+ -- exceptions are thrown.
285+ handle (settingsOnException set Nothing) .
286+
287+ -- Call the user-supplied code for connection open and close events
288+ bracket (onOpen addr) (onClose addr) $ \goingon ->
289+
290+ -- Actually serve this connection.
291+ -- bracket with closeConn above ensures the connection is closed.
292+ when goingon $ serveConnection conn ii1 addr transport set app
271293 -- Run the connection maker to get a new connection, and ensure
272294 -- that the connection is closed. If the mkConn call throws an
273295 -- exception, we will leak the connection. If the mkConn call is
@@ -278,30 +300,7 @@ fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->
278300 -- We grab the connection before registering timeouts since the
279301 -- timeouts will be useless during connection creation, due to the
280302 -- fact that async exceptions are still masked.
281− bracket mkConn (\(conn, _) -> closeConn ref conn `finally` connFree conn)
282− $ \(conn, transport) ->
283−
284− -- We need to register a timeout handler for this thread, and
285− -- cancel that handler as soon as we exit. We additionally close
286− -- the connection immediately in case the child thread catches the
287− -- async exception or performs some long-running cleanup action.
288− bracket (T.registerKillThread (timeoutManager0 ii0) (closeConn ref conn)) T.cancel $ \th ->
289−
290− let ii1 = toInternalInfo1 ii0 th
291− -- We now have fully registered a connection close handler
292− -- in the case of all exceptions, so it is safe to one
293− -- again allow async exceptions.
294− in unmask .
295− -- Call the user-supplied on exception code if any
296− -- exceptions are thrown.
297− handle (settingsOnException set Nothing) .
298−
299− -- Call the user-supplied code for connection open and close events
300− bracket (onOpen addr) (onClose addr) $ \goingon ->
301−
302− -- Actually serve this connection.
303− -- bracket with closeConn above ensures the connection is closed.
304− when goingon $ serveConnection conn ii1 addr transport set app
303+ in bracket mkConn cleanUp serve `catch` settingsOnException set Nothing
305304 where
306305 withClosedRef inner = newIORef False >>= inner
307306