git.iko.soy/distributed-process
on master help sign in
Optional EndPointAddress in EventConnectionLost
5ffbd26Edsko de Vries
distributed-process/src/Control/Distributed/Process.hs+1−1
compare with master
unifiedsplit
@@ -586,7 +586,7 @@ handleIncomingMessages node = go [] Map.empty Set.empty
586 go (List.delete cid uninitConns)
586 go (List.delete cid uninitConns)
587 (Map.delete cid procConns)
587 (Map.delete cid procConns)
588 (Set.delete cid ctrlConns)
588 (Set.delete cid ctrlConns)
589− NT.ErrorEvent (NT.TransportError (NT.EventConnectionLost theirAddr _) _) -> do
589+ NT.ErrorEvent (NT.TransportError (NT.EventConnectionLost (Just theirAddr) _) _) -> do
590 -- TODO: we could cache this information
590 -- TODO: we could cache this information
591 pids <- withMVar state $ \st ->
591 pids <- withMVar state $ \st ->
592 return $ filter ((== theirAddr) . nodeAddress . processNodeId)
592 return $ filter ((== theirAddr) . nodeAddress . processNodeId)
network-transport/src/Network/Transport.hs+4−2
@@ -218,6 +218,8 @@ data EventErrorCode =
218 EventEndPointFailed
218 EventEndPointFailed
219 -- | Transport-wide fatal error
219 -- | Transport-wide fatal error
220 | EventTransportFailed
220 | EventTransportFailed
221+ -- | Some incoming connections were closed abruptly.
222+ -- If an endpoint address is specified, then all connections to and
221− -- | Connection to a remote endpoint was lost
223+ -- from that endpoint are now lost
222− | EventConnectionLost EndPointAddress [ConnectionId]
224+ | EventConnectionLost (Maybe EndPointAddress) [ConnectionId]
223 deriving (Show, Typeable, Eq)
225 deriving (Show, Typeable, Eq)
network-transport/src/Network/Transport/TCP.hs+2−2
@@ -732,7 +732,7 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
732 tryCloseSocket (remoteSocket vst)
732 tryCloseSocket (remoteSocket vst)
733 putMVar theirState (RemoteEndPointFailed ex)
733 putMVar theirState (RemoteEndPointFailed ex)
734 let incoming = IntSet.elems $ vst ^. remoteIncoming
734 let incoming = IntSet.elems $ vst ^. remoteIncoming
735− code = EventConnectionLost (remoteAddress theirEndPoint) incoming
735+ code = EventConnectionLost (Just $ remoteAddress theirEndPoint) incoming
736 err = TransportError code (show ex)
736 err = TransportError code (show ex)
737 writeChan (localChannel ourEndPoint) $ ErrorEvent err
737 writeChan (localChannel ourEndPoint) $ ErrorEvent err
738
738
@@ -1072,7 +1072,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1072 "handleIncomingMessages:prematureExit"
1072 "handleIncomingMessages:prematureExit"
1073 RemoteEndPointValid vst -> do
1073 RemoteEndPointValid vst -> do
1074 let code = EventConnectionLost
1074 let code = EventConnectionLost
1075− (remoteAddress theirEndPoint)
1075+ (Just $ remoteAddress theirEndPoint)
1076 (IntSet.elems $ vst ^. remoteIncoming)
1076 (IntSet.elems $ vst ^. remoteIncoming)
1077 writeChan ourChannel . ErrorEvent $ TransportError code (show err)
1077 writeChan ourChannel . ErrorEvent $ TransportError code (show err)
1078 forM_ (vst ^. pendingCtrlRequests) $ flip putMVar (Left err)
1078 forM_ (vst ^. pendingCtrlRequests) $ flip putMVar (Left err)
network-transport/tests/TestTCP.hs+3−3
@@ -93,7 +93,7 @@ testEarlyDisconnect nextPort = do
93 ConnectionOpened cid _ addr <- receive endpoint
93 ConnectionOpened cid _ addr <- receive endpoint
94 True <- return $ addr == theirAddr
94 True <- return $ addr == theirAddr
95
95
96− ErrorEvent (TransportError (EventConnectionLost addr' [cid']) _) <- receive endpoint
96+ ErrorEvent (TransportError (EventConnectionLost (Just addr') [cid']) _) <- receive endpoint
97 True <- return $ addr' == theirAddr && cid' == cid
97 True <- return $ addr' == theirAddr && cid' == cid
98
98
99 return ()
99 return ()
@@ -116,7 +116,7 @@ testEarlyDisconnect nextPort = do
116 Received cid' ["pong"] <- receive endpoint
116 Received cid' ["pong"] <- receive endpoint
117 True <- return $ cid == cid'
117 True <- return $ cid == cid'
118
118
119− ErrorEvent (TransportError (EventConnectionLost addr' [cid'']) _) <- receive endpoint
119+ ErrorEvent (TransportError (EventConnectionLost (Just addr') [cid'']) _) <- receive endpoint
120 True <- return $ addr' == theirAddr && cid'' == cid
120 True <- return $ addr' == theirAddr && cid'' == cid
121
121
122 return ()
122 return ()
@@ -227,7 +227,7 @@ testEarlyCloseSocket nextPort = do
227 ConnectionClosed cid'' <- receive endpoint
227 ConnectionClosed cid'' <- receive endpoint
228 True <- return $ cid'' == cid
228 True <- return $ cid'' == cid
229
229
230− ErrorEvent (TransportError (EventConnectionLost addr' []) _) <- receive endpoint
230+ ErrorEvent (TransportError (EventConnectionLost (Just addr') []) _) <- receive endpoint
231 True <- return $ addr' == theirAddr
231 True <- return $ addr' == theirAddr
232
232
233 return ()
233 return ()
network-transport/tests/TestTransport.hs+2−2
@@ -598,7 +598,7 @@ testCloseEndPoint transport _ = do
598 send conn ["pong"]
598 send conn ["pong"]
599
599
600 ConnectionClosed cid'' <- receive endpoint ; True <- return $ cid == cid''
600 ConnectionClosed cid'' <- receive endpoint ; True <- return $ cid == cid''
601− ErrorEvent (TransportError (EventConnectionLost addr' []) _) <- receive endpoint ; True <- return $ addr' == theirAddr
601+ ErrorEvent (TransportError (EventConnectionLost (Just addr') []) _) <- receive endpoint ; True <- return $ addr' == theirAddr
602
602
603 Left (TransportError SendFailed _) <- send conn ["pong2"]
603 Left (TransportError SendFailed _) <- send conn ["pong2"]
604
604
@@ -686,7 +686,7 @@ testCloseTransport newTransport = do
686 evs <- replicateM 3 $ receive endpoint
686 evs <- replicateM 3 $ receive endpoint
687 let expected = [ ConnectionClosed cid1
687 let expected = [ ConnectionClosed cid1
688 , ConnectionClosed cid2
688 , ConnectionClosed cid2
689− , ErrorEvent (TransportError (EventConnectionLost theirAddr2 []) "")
689+ , ErrorEvent (TransportError (EventConnectionLost (Just theirAddr2) []) "")
690 ]
690 ]
691 True <- return $ any (== expected) (permutations evs)
691 True <- return $ any (== expected) (permutations evs)
692
692