@@ -25,6 +25,7 @@ import qualified Data.Map as Map
2525 , toList
2626 , partitionWithKey
2727 , filterWithKey
28+ , elems
2829 )
2930import Data.Set (Set)
3031import qualified Data.Set as Set (empty, insert, delete, member, filter)
@@ -65,6 +66,7 @@ import qualified Network.Transport as NT
6566 , closeEndPoint
6667 , ConnectionId
6768 , Connection
69+ , close
6870 )
6971import Data.Accessor (Accessor, accessor, (^.), (^=), (^:))
7072import qualified Data.Accessor.Container as DAC (mapDefault, mapMaybe)
@@ -214,9 +216,13 @@ forkProcess node proc = modifyMVar (localState node) $ \st -> do
214216 (runLocalProcess lproc proc >> return DiedNormal)
215217 (return . DiedException . (show :: SomeException -> String))
216218 -- [Unified: Table 4, rules termination and exiting]
217− modifyMVar_ (localState node) $
218− return . (localProcessWithId lpid ^= Nothing)
219− . (localConnections ^: removeConnectionsFrom (ProcessIdentifier pid))
219+ modifyMVar_ (localState node) $ \st -> do
220+ let pid' = ProcessIdentifier pid
221+ let (affected, unaffected) = Map.partitionWithKey (\(fr, _to) !_v -> impliesDeathOf pid' fr) (st ^. localConnections)
222+ mapM_ NT.close (Map.elems affected)
223+ return $ (localProcessWithId lpid ^= Nothing)
224+ . (localConnections ^= unaffected)
225+ $ st
220226 writeChan (localCtrlChan node) NCMsg
221227 { ctrlMsgSender = ProcessIdentifier pid
222228 , ctrlMsgSignal = Died (ProcessIdentifier pid) reason
@@ -239,13 +245,6 @@ forkProcess node proc = modifyMVar (localState node) $ \st -> do
239245 , pid
240246 )
241247
242−-- | Remove connections from 'ident' (typically because 'ident' has terminated)
243−removeConnectionsFrom :: Identifier
244− -> Map (Identifier, Identifier) NT.Connection
245− -> Map (Identifier, Identifier) NT.Connection
246−removeConnectionsFrom ident =
247− Map.filterWithKey $ \(fr, _to) _conn -> fr /= ident
248−
249248handleIncomingMessages :: LocalNode -> IO ()
250249handleIncomingMessages node = go Set.empty Map.empty Map.empty Set.empty
251250 where