@@ -26,9 +26,8 @@ import qualified Data.Map as Map
26 , partitionWithKey
26 , partitionWithKey
27 , filterWithKey
27 , filterWithKey
29−import qualified Data.List as List (delete, (\\))
30import Data.Set (Set)
29import Data.Set (Set)
31−import qualified Data.Set as Set (empty, insert, delete, member, (\\), fromList)
30+import qualified Data.Set as Set (empty, insert, delete, member, filter)
32import Data.Foldable (forM_)
31import Data.Foldable (forM_)
33import Data.Maybe (isJust)
32import Data.Maybe (isJust)
34import Data.Typeable (Typeable)
33import Data.Typeable (Typeable)
@@ -248,25 +247,25 @@ removeConnectionsFrom ident =
248 Map.filterWithKey $ \(fr, _to) _conn -> fr /= ident
247 Map.filterWithKey $ \(fr, _to) _conn -> fr /= ident
250handleIncomingMessages :: LocalNode -> IO ()
249handleIncomingMessages :: LocalNode -> IO ()
251−handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
250+handleIncomingMessages node = go Set.empty Map.empty Map.empty Set.empty
253− go :: [NT.ConnectionId] -- ^ Connections whose purpose we don't yet know
252+ go :: Set NT.ConnectionId -- ^ Connections whose purpose we don't yet know
254 -> Map NT.ConnectionId LocalProcess -- ^ Connections to local processes
253 -> Map NT.ConnectionId LocalProcess -- ^ Connections to local processes
255 -> Map NT.ConnectionId TypedChannel -- ^ Connections to typed channels
254 -> Map NT.ConnectionId TypedChannel -- ^ Connections to typed channels
256 -> Set NT.ConnectionId -- ^ Connections to our controller
255 -> Set NT.ConnectionId -- ^ Connections to our controller
257 -> IO ()
256 -> IO ()
258− go uninitConns procs chans ctrls = do
257+ go !uninitConns !procs !chans !ctrls = do
259 event <- NT.receive endpoint
258 event <- NT.receive endpoint
260 case event of
259 case event of
261 NT.ConnectionOpened cid _rel _theirAddr ->
260 NT.ConnectionOpened cid _rel _theirAddr ->
262 -- TODO: Check if _rel is ReliableOrdered, and if not, treat as
261 -- TODO: Check if _rel is ReliableOrdered, and if not, treat as
263 -- (**) below.
262 -- (**) below.
264− go (cid : uninitConns) procs chans ctrls
263+ go (Set.insert cid uninitConns) procs chans ctrls
265 NT.Received cid payload ->
264 NT.Received cid payload ->
266 case ( Map.lookup cid procs
265 case ( Map.lookup cid procs
267 , Map.lookup cid chans
266 , Map.lookup cid chans
268 , cid `Set.member` ctrls
267 , cid `Set.member` ctrls
269− , cid `elem` uninitConns
268+ , cid `Set.member` uninitConns
271 (Just proc, _, _, _) -> do
270 (Just proc, _, _, _) -> do
272 let msg = payloadToMessage payload
271 let msg = payloadToMessage payload
@@ -286,7 +285,7 @@ handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
286 mProc <- withMVar state $ return . (^. localProcessWithId lpid)
285 mProc <- withMVar state $ return . (^. localProcessWithId lpid)
287 case mProc of
286 case mProc of
288 Just proc ->
287 Just proc ->
289− go (List.delete cid uninitConns)
288+ go (Set.delete cid uninitConns)
290 (Map.insert cid proc procs)
289 (Map.insert cid proc procs)
@@ -298,7 +297,7 @@ handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
298 -- remote node as having died, and we should close
297 -- remote node as having died, and we should close
299 -- incoming connections (this requires a Transport layer
298 -- incoming connections (this requires a Transport layer
300 -- extension). (**)
299 -- extension). (**)
301− go (List.delete cid uninitConns) procs chans ctrls
300+ go (Set.delete cid uninitConns) procs chans ctrls
302 SendPortIdentifier chId -> do
301 SendPortIdentifier chId -> do
303 let lcid = sendPortLocalId chId
302 let lcid = sendPortLocalId chId
304 lpid = processLocalId (sendPortProcessId chId)
303 lpid = processLocalId (sendPortProcessId chId)
@@ -308,20 +307,20 @@ handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
308 mChannel <- withMVar (processState proc) $ return . (^. typedChannelWithId lcid)
307 mChannel <- withMVar (processState proc) $ return . (^. typedChannelWithId lcid)
309 case mChannel of
308 case mChannel of
310 Just channel ->
309 Just channel ->
311− go (List.delete cid uninitConns)
310+ go (Set.delete cid uninitConns)
313 (Map.insert cid channel chans)
312 (Map.insert cid channel chans)
315 Nothing ->
314 Nothing ->
316 -- Unknown typed channel
315 -- Unknown typed channel
317 -- TODO (**) above
316 -- TODO (**) above
318− go (List.delete cid uninitConns) procs chans ctrls
317+ go (Set.delete cid uninitConns) procs chans ctrls
319 Nothing ->
318 Nothing ->
320 -- Unknown process
319 -- Unknown process
321 -- TODO (**) above
320 -- TODO (**) above
322− go (List.delete cid uninitConns) procs chans ctrls
321+ go (Set.delete cid uninitConns) procs chans ctrls
323 NodeIdentifier _ ->
322 NodeIdentifier _ ->
324− go (List.delete cid uninitConns)
323+ go (Set.delete cid uninitConns)
327 (Set.insert cid ctrls)
326 (Set.insert cid ctrls)
@@ -330,7 +329,7 @@ handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
330 -- TODO (**) above
329 -- TODO (**) above
331 go uninitConns procs chans ctrls
330 go uninitConns procs chans ctrls
332 NT.ConnectionClosed cid ->
331 NT.ConnectionClosed cid ->
333− go (List.delete cid uninitConns)
332+ go (Set.delete cid uninitConns)
334 (Map.delete cid procs)
333 (Map.delete cid procs)
335 (Map.delete cid chans)
334 (Map.delete cid chans)
336 (Set.delete cid ctrls)
335 (Set.delete cid ctrls)
@@ -341,10 +340,11 @@ handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
341 { ctrlMsgSender = nid
340 { ctrlMsgSender = nid
342 , ctrlMsgSignal = Died nid DiedDisconnect
341 , ctrlMsgSignal = Died nid DiedDisconnect
343+ let notRemoved k = k `notElem` cids
344− go (uninitConns List.\\ cids)
344+ go (Set.filter notRemoved uninitConns)
345− (Map.filterWithKey (\k _ -> k `notElem` cids) procs)
345+ (Map.filterWithKey (const . notRemoved) procs)
346− (Map.filterWithKey (\k _ -> k `notElem` cids) chans)
346+ (Map.filterWithKey (const . notRemoved) chans)
347− (ctrls Set.\\ Set.fromList cids)
347+ (Set.filter notRemoved ctrls)
348 NT.ErrorEvent (NT.TransportError (NT.EventConnectionLost Nothing _) _) ->
348 NT.ErrorEvent (NT.TransportError (NT.EventConnectionLost Nothing _) _) ->
349 -- TODO: We should treat an asymetrical connection loss (incoming
349 -- TODO: We should treat an asymetrical connection loss (incoming
350 -- connection broken, but outgoing connection still potentially ok)
350 -- connection broken, but outgoing connection still potentially ok)