Your pseudo code doesn't look right although I couldn't completely understand it. You need something like this: {-# LANGUAGE ScopedTypeVariables #-} import Network.Socket import Control.Concurrent import Control.Exception acceptLoop :: Socket -> IO () acceptLoop sock = mask_ loop where loop = do -- only safe point in the loop for exceptions allowInterrupt (connected_sock, _) <- accept sock -- use forkIOWithUnmask: we want the thread to be interruptable no matter -- what the inherited masking state is _thr_id <- forkIOWithUnmask (handle_conn connected_sock) loop handle_conn connected_sock unmask = -- register cleanup action, run the handler in interruptable state to be -- able to kill the thread. catch (unmask (handler connected_sock)) (\(_exc :: SomeException) -> close connected_sock) handler connected_sock = -- fill here return () Ömer 2017-10-25 8:52 GMT+03:00 Sumit Raja <sumitraja@gmail.com>:
Hi Ömer
You need to mask async exceptions between `accept()` and cleanup action registration, because an exception in between these operations will cause the socket to leak.
You can take a look at warp's accept loop:
https://github.com/yesodweb/wai/blob/master/warp/Network/Wai/Handler/Warp/Ru...
Trying to map steps for the code you've pointed me to in bad pseudo code:
finally (mask >> acceptLoop serverSocket) (close serverSocket)
acceptLoop = unmask sock <- accept serverSock mask forkIO $ do mask finally (unmask >> process sock) (close sock) acceptLoop
Is this correct?
Thanks Sumit