@@ -66,6 +66,7 @@ module Streamly.Internal.Network.Socket
6666where
6767
6868import Control.Concurrent (threadWaitWrite, rtsSupportsBoundThreads)
69+import Control.Exception (onException)
6970import Control.Monad.Catch (MonadCatch, finally, MonadMask)
7071import Control.Monad.IO.Class (MonadIO(..))
7172import Control.Monad (when)
@@ -146,21 +147,26 @@ initListener :: Int -> SockSpec -> SockAddr -> IO Socket
146147initListener listenQLen SockSpec{..} addr =
147148 withSocketsDo $ do
148149 sock <- socket sockFamily sockType sockProto
149− mapM_ (\(opt, val) -> setSocketOption sock opt val) sockOpts
150− bind sock addr
151− Net.listen sock listenQLen
150+ use sock `onException` Net.close sock
152151 return sock
153152
153+ where
154+
155+ use sock = do
156+ mapM_ (\(opt, val) -> setSocketOption sock opt val) sockOpts
157+ bind sock addr
158+ Net.listen sock listenQLen
159+
154160{-# INLINE listenTuples #-}
155161listenTuples :: MonadIO m
156162 => Unfold m (Int, SockSpec, SockAddr) (Socket, SockAddr)
157163listenTuples = Unfold step inject
158164 where
159− inject (listenQLen, spec, addr) = liftIO $ initListener listenQLen spec addr
165+ inject (listenQLen, spec, addr) =
166+ liftIO $ initListener listenQLen spec addr
160167
161168 step listener = do
162− r <- liftIO $ Net.accept listener
163− -- XXX error handling
169+ r <- liftIO $ (Net.accept listener `onException` Net.close listener)
164170 return $ D.Yield r listener
165171
166172-- | Unfold a three tuple @(listenQLen, spec, addr)@ into a stream of connected
@@ -185,13 +191,11 @@ recvConnectionTuplesWith tcpListenQ spec addr = S.unfoldrM step Nothing
185191 where
186192 step Nothing = do
187193 listener <- liftIO $ initListener tcpListenQ spec addr
188− r <- liftIO $ Net.accept listener
189− -- XXX error handling
194+ r <- liftIO $ (Net.accept listener `onException` Net.close listener)
190195 return $ Just (r, Just listener)
191196
192197 step (Just listener) = do
193− r <- liftIO $ Net.accept listener
194− -- XXX error handling
198+ r <- liftIO $ (Net.accept listener `onException` Net.close listener)
195199 return $ Just (r, Just listener)
196200
197201-- | Start a TCP stream server that listens for connections on the supplied
@@ -202,7 +206,8 @@ recvConnectionTuplesWith tcpListenQ spec addr = S.unfoldrM step Nothing
202206-- /Internal/
203207{-# INLINE connections #-}
204208connections :: MonadAsync m => Int -> SockSpec -> SockAddr -> SerialT m Socket
205−connections tcpListenQ spec addr = fst <$> recvConnectionTuplesWith tcpListenQ spec addr
209+connections tcpListenQ spec addr =
210+ fst <$> recvConnectionTuplesWith tcpListenQ spec addr
206211
207212-------------------------------------------------------------------------------
208213-- Array IO (Input)