@@ -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)
@@ -238,25 +237,25 @@ forkProcess node proc = modifyMVar (localState node) $ \st -> do
240handleIncomingMessages :: LocalNode -> IO ()
239handleIncomingMessages :: LocalNode -> IO ()
241−handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
240+handleIncomingMessages node = go Set.empty Map.empty Map.empty Set.empty
243− go :: [NT.ConnectionId] -- ^ Connections whose purpose we don't yet know
242+ go :: Set NT.ConnectionId -- ^ Connections whose purpose we don't yet know
244 -> Map NT.ConnectionId LocalProcess -- ^ Connections to local processes
243 -> Map NT.ConnectionId LocalProcess -- ^ Connections to local processes
245 -> Map NT.ConnectionId TypedChannel -- ^ Connections to typed channels
244 -> Map NT.ConnectionId TypedChannel -- ^ Connections to typed channels
246 -> Set NT.ConnectionId -- ^ Connections to our controller
245 -> Set NT.ConnectionId -- ^ Connections to our controller
247 -> IO ()
246 -> IO ()
248− go uninitConns procs chans ctrls = do
247+ go !uninitConns !procs !chans !ctrls = do
249 event <- NT.receive endpoint
248 event <- NT.receive endpoint
250 case event of
249 case event of
251 NT.ConnectionOpened cid _rel _theirAddr ->
250 NT.ConnectionOpened cid _rel _theirAddr ->
252 -- TODO: Check if _rel is ReliableOrdered, and if not, treat as
251 -- TODO: Check if _rel is ReliableOrdered, and if not, treat as
253 -- (**) below.
252 -- (**) below.
254− go (cid : uninitConns) procs chans ctrls
253+ go (Set.insert cid uninitConns) procs chans ctrls
255 NT.Received cid payload ->
254 NT.Received cid payload ->
256 case ( Map.lookup cid procs
255 case ( Map.lookup cid procs
257 , Map.lookup cid chans
256 , Map.lookup cid chans
258 , cid `Set.member` ctrls
257 , cid `Set.member` ctrls
259− , cid `elem` uninitConns
258+ , cid `Set.member` uninitConns
261 (Just proc, _, _, _) -> do
260 (Just proc, _, _, _) -> do
262 let msg = payloadToMessage payload
261 let msg = payloadToMessage payload
@@ -276,7 +275,7 @@ handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
276 mProc <- withMVar state $ return . (^. localProcessWithId lpid)
275 mProc <- withMVar state $ return . (^. localProcessWithId lpid)
277 case mProc of
276 case mProc of
278 Just proc ->
277 Just proc ->
279− go (List.delete cid uninitConns)
278+ go (Set.delete cid uninitConns)
280 (Map.insert cid proc procs)
279 (Map.insert cid proc procs)
@@ -288,7 +287,7 @@ handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
288 -- remote node as having died, and we should close
287 -- remote node as having died, and we should close
289 -- incoming connections (this requires a Transport layer
288 -- incoming connections (this requires a Transport layer
290 -- extension). (**)
289 -- extension). (**)
291− go (List.delete cid uninitConns) procs chans ctrls
290+ go (Set.delete cid uninitConns) procs chans ctrls
292 SendPortIdentifier chId -> do
291 SendPortIdentifier chId -> do
293 let lcid = sendPortLocalId chId
292 let lcid = sendPortLocalId chId
294 lpid = processLocalId (sendPortProcessId chId)
293 lpid = processLocalId (sendPortProcessId chId)
@@ -298,20 +297,20 @@ handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
298 mChannel <- withMVar (processState proc) $ return . (^. typedChannelWithId lcid)
297 mChannel <- withMVar (processState proc) $ return . (^. typedChannelWithId lcid)
299 case mChannel of
298 case mChannel of
300 Just channel ->
299 Just channel ->
301− go (List.delete cid uninitConns)
300+ go (Set.delete cid uninitConns)
303 (Map.insert cid channel chans)
302 (Map.insert cid channel chans)
305 Nothing ->
304 Nothing ->
306 -- Unknown typed channel
305 -- Unknown typed channel
307 -- TODO (**) above
306 -- TODO (**) above
308− go (List.delete cid uninitConns) procs chans ctrls
307+ go (Set.delete cid uninitConns) procs chans ctrls
309 Nothing ->
308 Nothing ->
310 -- Unknown process
309 -- Unknown process
311 -- TODO (**) above
310 -- TODO (**) above
312− go (List.delete cid uninitConns) procs chans ctrls
311+ go (Set.delete cid uninitConns) procs chans ctrls
313 NodeIdentifier _ ->
312 NodeIdentifier _ ->
314− go (List.delete cid uninitConns)
313+ go (Set.delete cid uninitConns)
317 (Set.insert cid ctrls)
316 (Set.insert cid ctrls)
@@ -320,7 +319,7 @@ handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
320 -- TODO (**) above
319 -- TODO (**) above
321 go uninitConns procs chans ctrls
320 go uninitConns procs chans ctrls
322 NT.ConnectionClosed cid ->
321 NT.ConnectionClosed cid ->
323− go (List.delete cid uninitConns)
322+ go (Set.delete cid uninitConns)
324 (Map.delete cid procs)
323 (Map.delete cid procs)
325 (Map.delete cid chans)
324 (Map.delete cid chans)
326 (Set.delete cid ctrls)
325 (Set.delete cid ctrls)
@@ -331,10 +330,11 @@ handleIncomingMessages node = go [] Map.empty Map.empty Set.empty
331 { ctrlMsgSender = nid
330 { ctrlMsgSender = nid
332 , ctrlMsgSignal = Died nid DiedDisconnect
331 , ctrlMsgSignal = Died nid DiedDisconnect
333+ let notRemoved k = k `notElem` cids
334− go (uninitConns List.\\ cids)
334+ go (Set.filter notRemoved uninitConns)
335− (Map.filterWithKey (\k _ -> k `notElem` cids) procs)
335+ (Map.filterWithKey (const . notRemoved) procs)
336− (Map.filterWithKey (\k _ -> k `notElem` cids) chans)
336+ (Map.filterWithKey (const . notRemoved) chans)
337− (ctrls Set.\\ Set.fromList cids)
337+ (Set.filter notRemoved ctrls)
338 NT.ErrorEvent (NT.TransportError (NT.EventConnectionLost Nothing _) _) ->
338 NT.ErrorEvent (NT.TransportError (NT.EventConnectionLost Nothing _) _) ->
339 -- TODO: We should treat an asymetrical connection loss (incoming
339 -- TODO: We should treat an asymetrical connection loss (incoming
340 -- connection broken, but outgoing connection still potentially ok)
340 -- connection broken, but outgoing connection still potentially ok)