git.iko.soy/distributed-process
on master help sign in
Better names
0b7ae5fEdsko de Vries
network-transport/src/Network/Transport/TCP.hs+100−67
compare with master
unifiedsplit
@@ -324,15 +324,23 @@ data RemoteEndPoint = RemoteEndPoint
324 , remoteId :: Int
324 , remoteId :: Int
325 }
325 }
326
326
327−data Origin = Local | Remote
327+data RequestedBy = RequestedByUs | RequestedByThem
328 deriving (Eq, Show)
328 deriving (Eq, Show)
329
329
330data RemoteState =
330data RemoteState =
331+ -- | Invalid remote endpoint (for example, invalid address)
331 RemoteEndPointInvalid (TransportError ConnectErrorCode)
332 RemoteEndPointInvalid (TransportError ConnectErrorCode)
333+ -- | The remote endpoint is being initialized
332− | RemoteEndPointInit (MVar ()) Origin
334+ | RemoteEndPointInit (MVar ()) RequestedBy
335+ -- | "Normal" working endpoint
333 | RemoteEndPointValid ValidRemoteEndPointState
336 | RemoteEndPointValid ValidRemoteEndPointState
337+ -- | The remote endpoint is being closed (garbage collected)
334 | RemoteEndPointClosing (MVar ()) ValidRemoteEndPointState
338 | RemoteEndPointClosing (MVar ()) ValidRemoteEndPointState
335− | RemoteEndPointClosed (Maybe IOException)
339+ -- | The remote endpoint has been closed (garbage collected)
340+ | RemoteEndPointClosed
341+ -- | The remote endpoint has failed, or has been forcefully shutdown
342+ -- using a closeTransport or closeEndPoint API call
343+ | RemoteEndPointFailed IOException
336
344
337data ValidRemoteEndPointState = ValidRemoteEndPointState
345data ValidRemoteEndPointState = ValidRemoteEndPointState
338 { _remoteOutgoing :: !Int
346 { _remoteOutgoing :: !Int
@@ -477,7 +485,7 @@ apiConnect ourEndPoint theirAddress _reliability hints =
477 if localAddress ourEndPoint == theirAddress
485 if localAddress ourEndPoint == theirAddress
478 then connectToSelf ourEndPoint
486 then connectToSelf ourEndPoint
479 else try $ do
487 else try $ do
480− resetRemoteEndPoint ourEndPoint theirAddress
488+ resetIfBroken ourEndPoint theirAddress
481 (theirEndPoint, connId) <-
489 (theirEndPoint, connId) <-
482 requestConnectionTo ourEndPoint theirAddress hints
490 requestConnectionTo ourEndPoint theirAddress hints
483 -- connAlive can be an IORef rather than an MVar because it is protected
491 -- connAlive can be an IORef rather than an MVar because it is protected
@@ -530,7 +538,12 @@ apiSend (ourEndPoint, theirEndPoint) connId connAlive payload =
530 if alive
538 if alive
531 then relyViolation (ourEndPoint, theirEndPoint) "apiSend"
539 then relyViolation (ourEndPoint, theirEndPoint) "apiSend"
532 else throwIO $ TransportError SendClosed "Connection closed"
540 else throwIO $ TransportError SendClosed "Connection closed"
533− , caseClosed = \err -> do
541+ , caseClosed = do
542+ alive <- readIORef connAlive
543+ if alive
544+ then relyViolation (ourEndPoint, theirEndPoint) "apiSend"
545+ else throwIO $ TransportError SendClosed "Connection closed"
546+ , caseFailed = \err -> do
534 alive <- readIORef connAlive
547 alive <- readIORef connAlive
535 if alive
548 if alive
536 then throwIO $ TransportError SendFailed (show err)
549 then throwIO $ TransportError SendFailed (show err)
@@ -565,7 +578,7 @@ apiCloseEndPoint transport evs ourEndPoint = do
565 tryCloseRemoteSocket theirEndPoint = do
578 tryCloseRemoteSocket theirEndPoint = do
566 -- We make an attempt to close the connection nicely
579 -- We make an attempt to close the connection nicely
567 -- (by sending a CloseSocket first)
580 -- (by sending a CloseSocket first)
568− let closed = RemoteEndPointClosed .Just . userError $ "apiCloseEndPoint"
581+ let closed = RemoteEndPointFailed . userError $ "apiCloseEndPoint"
569 modifyMVar_ (remoteState theirEndPoint) $ \st ->
582 modifyMVar_ (remoteState theirEndPoint) $ \st ->
570 case st of
583 case st of
571 RemoteEndPointInvalid _ ->
584 RemoteEndPointInvalid _ ->
@@ -581,8 +594,10 @@ apiCloseEndPoint transport evs ourEndPoint = do
581 putMVar resolved ()
594 putMVar resolved ()
582 tryCloseSocket (remoteSocket conn)
595 tryCloseSocket (remoteSocket conn)
583 return closed
596 return closed
584− RemoteEndPointClosed err ->
597+ RemoteEndPointClosed ->
585− return $ RemoteEndPointClosed err
598+ return st
599+ RemoteEndPointFailed err ->
600+ return $ RemoteEndPointFailed err
586
601
587-- | Special case of 'apiConnect': connect an endpoint to itself
602-- | Special case of 'apiConnect': connect an endpoint to itself
588connectToSelf :: LocalEndPoint
603connectToSelf :: LocalEndPoint
@@ -659,10 +674,12 @@ internalSocketBetween transport ourAddress theirAddress = do
659 return $ remoteSocket vst
674 return $ remoteSocket vst
660 RemoteEndPointClosing _ vst ->
675 RemoteEndPointClosing _ vst ->
661 return $ remoteSocket vst
676 return $ remoteSocket vst
662− RemoteEndPointClosed _ ->
677+ RemoteEndPointClosed ->
663 throwIO $ userError "Remote endpoint closed"
678 throwIO $ userError "Remote endpoint closed"
664− RemoteEndPointInvalid _ ->
679+ RemoteEndPointInvalid err ->
665− throwIO $ userError "Remote endpoint invalid"
680+ throwIO err
681+ RemoteEndPointFailed err ->
682+ throwIO err
666
683
667--------------------------------------------------------------------------------
684--------------------------------------------------------------------------------
668-- Lower level functionality --
685-- Lower level functionality --
@@ -676,8 +693,8 @@ internalSocketBetween transport ourAddress theirAddress = do
676--
693--
677-- Throws a TransportError ConnectFailed exception if the local endpoint is
694-- Throws a TransportError ConnectFailed exception if the local endpoint is
678-- closed.
695-- closed.
679−resetRemoteEndPoint :: LocalEndPoint -> EndPointAddress -> IO ()
696+resetIfBroken :: LocalEndPoint -> EndPointAddress -> IO ()
680−resetRemoteEndPoint ourEndPoint theirAddress = do
697+resetIfBroken ourEndPoint theirAddress = do
681 mTheirEndPoint <- withMVar (localState ourEndPoint) $ \st -> case st of
698 mTheirEndPoint <- withMVar (localState ourEndPoint) $ \st -> case st of
682 LocalEndPointValid vst ->
699 LocalEndPointValid vst ->
683 return (vst ^. localConnectionTo theirAddress)
700 return (vst ^. localConnectionTo theirAddress)
@@ -687,7 +704,7 @@ resetRemoteEndPoint ourEndPoint theirAddress = do
687 withMVar (remoteState theirEndPoint) $ \st -> case st of
704 withMVar (remoteState theirEndPoint) $ \st -> case st of
688 RemoteEndPointInvalid _ ->
705 RemoteEndPointInvalid _ ->
689 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
706 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
690− RemoteEndPointClosed (Just _) ->
707+ RemoteEndPointFailed _ ->
691 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
708 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
692 _ ->
709 _ ->
693 return ()
710 return ()
@@ -739,7 +756,7 @@ requestConnectionTo ourEndPoint theirAddress hints = go
739 where
756 where
740 go = do
757 go = do
741 (theirEndPoint, isNew) <- mapIOException connectFailed $
758 (theirEndPoint, isNew) <- mapIOException connectFailed $
742− findRemoteEndPoint ourEndPoint theirAddress Local
759+ findRemoteEndPoint ourEndPoint theirAddress RequestedByUs
743
760
744 if isNew
761 if isNew
745 then do
762 then do
@@ -779,7 +796,7 @@ setupRemoteEndPoint (ourEndPoint, theirEndPoint) hints = do
779 tryCloseSocket sock
796 tryCloseSocket sock
780 return False
797 return False
781 Right (sock, ConnectionRequestCrossed) -> do
798 Right (sock, ConnectionRequestCrossed) -> do
782− resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointClosed Nothing)
799+ resolveInit (ourEndPoint, theirEndPoint) RemoteEndPointClosed
783 tryCloseSocket sock
800 tryCloseSocket sock
784 return False
801 return False
785 Left err -> do
802 Left err -> do
@@ -825,12 +842,12 @@ resolveInit (ourEndPoint, theirEndPoint) newState =
825 RemoteEndPointInit resolved _ -> do
842 RemoteEndPointInit resolved _ -> do
826 putMVar resolved ()
843 putMVar resolved ()
827 case newState of
844 case newState of
828− RemoteEndPointClosed Nothing ->
845+ RemoteEndPointClosed ->
829 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
846 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
830 _ ->
847 _ ->
831 return ()
848 return ()
832 return newState
849 return newState
833− RemoteEndPointClosed (Just ex) ->
850+ RemoteEndPointFailed ex ->
834 throwIO ex
851 throwIO ex
835 _ ->
852 _ ->
836 relyViolation (ourEndPoint, theirEndPoint) "resolveInit"
853 relyViolation (ourEndPoint, theirEndPoint) "resolveInit"
@@ -951,8 +968,10 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do
951 relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (init)"
968 relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (init)"
952 , caseClosing = \_ _ ->
969 , caseClosing = \_ _ ->
953 relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closing)"
970 relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closing)"
954− , caseClosed = \_ ->
971+ , caseClosed =
955− throwIO $ userError "doRemoteRequest: Remote endpoint closed"
972+ relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closed)"
973+ , caseFailed =
974+ throwIO
956 }
975 }
957 mReply <- takeMVar replyMVar
976 mReply <- takeMVar replyMVar
958 case mReply of
977 case mReply of
@@ -1023,10 +1042,11 @@ forkEndPointThread ourEndPoint p =
1023
1042
1024data RemoteStatePatternMatch a = RemoteStatePatternMatch
1043data RemoteStatePatternMatch a = RemoteStatePatternMatch
1025 { caseInvalid :: TransportError ConnectErrorCode -> IO a
1044 { caseInvalid :: TransportError ConnectErrorCode -> IO a
1026− , caseInit :: MVar () -> Origin -> IO a
1045+ , caseInit :: MVar () -> RequestedBy -> IO a
1027 , caseValid :: ValidRemoteEndPointState -> IO a
1046 , caseValid :: ValidRemoteEndPointState -> IO a
1028 , caseClosing :: MVar () -> ValidRemoteEndPointState -> IO a
1047 , caseClosing :: MVar () -> ValidRemoteEndPointState -> IO a
1048+ , caseClosed :: IO a
1029− , caseClosed :: Maybe IOException -> IO a
1049+ , caseFailed :: IOException -> IO a
1030 }
1050 }
1031
1051
1032remoteStateIdentity :: RemoteStatePatternMatch RemoteState
1052remoteStateIdentity :: RemoteStatePatternMatch RemoteState
@@ -1036,7 +1056,8 @@ remoteStateIdentity =
1036 , caseInit = (return .) . RemoteEndPointInit
1056 , caseInit = (return .) . RemoteEndPointInit
1037 , caseValid = return . RemoteEndPointValid
1057 , caseValid = return . RemoteEndPointValid
1038 , caseClosing = (return .) . RemoteEndPointClosing
1058 , caseClosing = (return .) . RemoteEndPointClosing
1039− , caseClosed = return . RemoteEndPointClosed
1059+ , caseClosed = return RemoteEndPointClosed
1060+ , caseFailed = return . RemoteEndPointFailed
1040 }
1061 }
1041
1062
1042-- | Like modifyMVar, but if an I/O exception occurs don't restore the remote
1063-- | Like modifyMVar, but if an I/O exception occurs don't restore the remote
@@ -1076,8 +1097,13 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
1076 (putMVar theirState st)
1097 (putMVar theirState st)
1077 putMVar theirState st'
1098 putMVar theirState st'
1078 return a
1099 return a
1079− RemoteEndPointClosed err -> do
1100+ RemoteEndPointClosed -> do
1080− (st', a) <- onException (restore $ caseClosed match err)
1101+ (st', a) <- onException (restore $ caseClosed match)
1102+ (putMVar theirState st)
1103+ putMVar theirState st'
1104+ return a
1105+ RemoteEndPointFailed err -> do
1106+ (st', a) <- onException (restore $ caseFailed match err)
1081 (putMVar theirState st)
1107 (putMVar theirState st)
1082 putMVar theirState st'
1108 putMVar theirState st'
1083 return a
1109 return a
@@ -1088,7 +1114,7 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
1088 handleIOException :: IOException -> ValidRemoteEndPointState -> IO ()
1114 handleIOException :: IOException -> ValidRemoteEndPointState -> IO ()
1089 handleIOException ex vst = do
1115 handleIOException ex vst = do
1090 tryCloseSocket (remoteSocket vst)
1116 tryCloseSocket (remoteSocket vst)
1091− putMVar theirState (RemoteEndPointClosed $ Just ex)
1117+ putMVar theirState (RemoteEndPointFailed ex)
1092 let incoming = IntSet.elems $ vst ^. remoteIncoming
1118 let incoming = IntSet.elems $ vst ^. remoteIncoming
1093 code = EventConnectionLost (remoteAddress theirEndPoint) incoming
1119 code = EventConnectionLost (remoteAddress theirEndPoint) incoming
1094 err = TransportError code (show ex)
1120 err = TransportError code (show ex)
@@ -1105,7 +1131,8 @@ modifyRemoteState_ (ourEndPoint, theirEndPoint) match =
1105 , caseInit = \resolved origin -> u $ caseInit match resolved origin
1131 , caseInit = \resolved origin -> u $ caseInit match resolved origin
1106 , caseValid = u . caseValid match
1132 , caseValid = u . caseValid match
1107 , caseClosing = \resolved vst -> u $ caseClosing match resolved vst
1133 , caseClosing = \resolved vst -> u $ caseClosing match resolved vst
1108− , caseClosed = u . caseClosed match
1134+ , caseClosed = u $ caseClosed match
1135+ , caseFailed = u . caseFailed match
1109 }
1136 }
1110 where
1137 where
1111 u :: IO a -> IO (a, ())
1138 u :: IO a -> IO (a, ())
@@ -1130,9 +1157,12 @@ withRemoteState (ourEndPoint, theirEndPoint) match =
1130 , caseClosing = \resolved vst -> do
1157 , caseClosing = \resolved vst -> do
1131 a <- caseClosing match resolved vst
1158 a <- caseClosing match resolved vst
1132 return (RemoteEndPointClosing resolved vst, a)
1159 return (RemoteEndPointClosing resolved vst, a)
1133− , caseClosed = \err -> do
1160+ , caseClosed = do
1161+ a <- caseClosed match
1162+ return (RemoteEndPointClosed, a)
1163+ , caseFailed = \err -> do
1134− a <- caseClosed match err
1164+ a <- caseFailed match err
1135− return (RemoteEndPointClosed err, a)
1165+ return (RemoteEndPointFailed err, a)
1136 }
1166 }
1137
1167
1138--------------------------------------------------------------------------------
1168--------------------------------------------------------------------------------
@@ -1172,9 +1202,9 @@ handleConnectionRequest transport sock = handle handleException $ do
1172 go :: LocalEndPoint -> EndPointAddress -> IO ()
1202 go :: LocalEndPoint -> EndPointAddress -> IO ()
1173 go ourEndPoint theirAddress = do
1203 go ourEndPoint theirAddress = do
1174 mEndPoint <- handle ((>> return Nothing) . handleException) $ do
1204 mEndPoint <- handle ((>> return Nothing) . handleException) $ do
1175− resetRemoteEndPoint ourEndPoint theirAddress
1205+ resetIfBroken ourEndPoint theirAddress
1176 (theirEndPoint, isNew) <-
1206 (theirEndPoint, isNew) <-
1177− findRemoteEndPoint ourEndPoint theirAddress Remote
1207+ findRemoteEndPoint ourEndPoint theirAddress RequestedByThem
1178
1208
1179 if not isNew
1209 if not isNew
1180 then do
1210 then do
@@ -1210,7 +1240,7 @@ handleConnectionRequest transport sock = handle handleException $ do
1210findRemoteEndPoint
1240findRemoteEndPoint
1211 :: LocalEndPoint
1241 :: LocalEndPoint
1212 -> EndPointAddress
1242 -> EndPointAddress
1213− -> Origin
1243+ -> RequestedBy
1214 -> IO (RemoteEndPoint, Bool)
1244 -> IO (RemoteEndPoint, Bool)
1215findRemoteEndPoint ourEndPoint theirAddress findOrigin = go
1245findRemoteEndPoint ourEndPoint theirAddress findOrigin = go
1216 where
1246 where
@@ -1244,12 +1274,12 @@ findRemoteEndPoint ourEndPoint theirAddress findOrigin = go
1244 snapshot <- modifyMVar theirState $ \st -> case st of
1274 snapshot <- modifyMVar theirState $ \st -> case st of
1245 RemoteEndPointValid vst ->
1275 RemoteEndPointValid vst ->
1246 case findOrigin of
1276 case findOrigin of
1247− Local -> do
1277+ RequestedByUs -> do
1248 let st' = RemoteEndPointValid
1278 let st' = RemoteEndPointValid
1249 . (remoteOutgoing ^: (+ 1))
1279 . (remoteOutgoing ^: (+ 1))
1250 $ vst
1280 $ vst
1251 return (st', st')
1281 return (st', st')
1252− Remote ->
1282+ RequestedByThem ->
1253 return (st, st)
1283 return (st, st)
1254 _ ->
1284 _ ->
1255 return (st, st)
1285 return (st, st)
@@ -1261,15 +1291,19 @@ findRemoteEndPoint ourEndPoint theirAddress findOrigin = go
1261 throwIO err
1291 throwIO err
1262 RemoteEndPointInit resolved initOrigin ->
1292 RemoteEndPointInit resolved initOrigin ->
1263 case (findOrigin, initOrigin) of
1293 case (findOrigin, initOrigin) of
1294+ (RequestedByUs, RequestedByUs) ->
1264− (Local, Local) -> readMVar resolved >> go
1295+ readMVar resolved >> go
1296+ (RequestedByUs, RequestedByThem) ->
1265− (Local, Remote) -> readMVar resolved >> go
1297+ readMVar resolved >> go
1298+ (RequestedByThem, RequestedByUs) ->
1266− (Remote, Local) -> if ourAddress > theirAddress
1299+ if ourAddress > theirAddress
1267− then
1300+ then
1268− -- Wait for the Crossed message
1301+ -- Wait for the Crossed message
1269− readMVar resolved >> go
1302+ readMVar resolved >> go
1270− else
1303+ else
1271− return (theirEndPoint, False)
1304+ return (theirEndPoint, False)
1305+ (RequestedByThem, RequestedByThem) ->
1272− (Remote, Remote) -> throwIO $ userError "Already connected (B)"
1306+ throwIO $ userError "Already connected (B)"
1273 RemoteEndPointValid _ ->
1307 RemoteEndPointValid _ ->
1274 -- We assume that the request crossed if we find the endpoint in
1308 -- We assume that the request crossed if we find the endpoint in
1275 -- Valid state. It is possible that this is really an invalid
1309 -- Valid state. It is possible that this is really an invalid
@@ -1278,18 +1312,14 @@ findRemoteEndPoint ourEndPoint theirAddress findOrigin = go
1278 return (theirEndPoint, False)
1312 return (theirEndPoint, False)
1279 RemoteEndPointClosing resolved _ ->
1313 RemoteEndPointClosing resolved _ ->
1280 readMVar resolved >> go
1314 readMVar resolved >> go
1281− RemoteEndPointClosed Nothing ->
1315+ RemoteEndPointClosed ->
1282 go
1316 go
1283− RemoteEndPointClosed (Just err) ->
1317+ RemoteEndPointFailed err ->
1284 throwIO err
1318 throwIO err
1285
1319
1286 ourState = localState ourEndPoint
1320 ourState = localState ourEndPoint
1287 ourAddress = localAddress ourEndPoint
1321 ourAddress = localAddress ourEndPoint
1288
1322
1289−
1290−
1291−
1292−
1293-- | Handle requests from a remote endpoint.
1323-- | Handle requests from a remote endpoint.
1294--
1324--
1295-- Returns only if the remote party closes the socket or if an error occurs.
1325-- Returns only if the remote party closes the socket or if an error occurs.
@@ -1307,9 +1337,9 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1307 return . Just $ remoteSocket ep
1337 return . Just $ remoteSocket ep
1308 RemoteEndPointClosing _ ep ->
1338 RemoteEndPointClosing _ ep ->
1309 return . Just $ remoteSocket ep
1339 return . Just $ remoteSocket ep
1310− RemoteEndPointClosed _ ->
1340+ RemoteEndPointClosed ->
1311− -- The remote endpoint got closed before we got a chance to start
1341+ return Nothing
1312− -- dealing with incoming messages
1342+ RemoteEndPointFailed _ ->
1313 return Nothing
1343 return Nothing
1314
1344
1315 forM_ mSock $ \sock ->
1345 forM_ mSock $ \sock ->
@@ -1377,9 +1407,9 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1377 -- to RemoteEndPointValid
1407 -- to RemoteEndPointValid
1378 putMVar resolved ()
1408 putMVar resolved ()
1379 return (remoteIncoming ^= IntSet.singleton newId $ vst)
1409 return (remoteIncoming ^= IntSet.singleton newId $ vst)
1380− RemoteEndPointClosed (Just err) ->
1410+ RemoteEndPointFailed err ->
1381 throwIO err
1411 throwIO err
1382− RemoteEndPointClosed Nothing ->
1412+ RemoteEndPointClosed ->
1383 relyViolation (ourEndPoint, theirEndPoint)
1413 relyViolation (ourEndPoint, theirEndPoint)
1384 "createNewConnection (closed)"
1414 "createNewConnection (closed)"
1385 sendOn vst ( encodeInt32 ControlResponse
1415 sendOn vst ( encodeInt32 ControlResponse
@@ -1411,9 +1441,9 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1411 )
1441 )
1412 RemoteEndPointClosing _ _ ->
1442 RemoteEndPointClosing _ _ ->
1413 throwIO $ userError "Invalid control response"
1443 throwIO $ userError "Invalid control response"
1414− RemoteEndPointClosed (Just err) ->
1444+ RemoteEndPointFailed err ->
1415 throwIO err
1445 throwIO err
1416− RemoteEndPointClosed Nothing ->
1446+ RemoteEndPointClosed ->
1417 relyViolation (ourEndPoint, theirEndPoint)
1447 relyViolation (ourEndPoint, theirEndPoint)
1418 "readControlResponse (closed)"
1448 "readControlResponse (closed)"
1419 case mmvar of
1449 case mmvar of
@@ -1444,9 +1474,9 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1444 -- far as we are concerned there are no incoming connections. This
1474 -- far as we are concerned there are no incoming connections. This
1445 -- means that a CloseConnection request at this point is invalid.
1475 -- means that a CloseConnection request at this point is invalid.
1446 throwIO $ userError "Invalid CloseConnection request"
1476 throwIO $ userError "Invalid CloseConnection request"
1447− RemoteEndPointClosed (Just err) ->
1477+ RemoteEndPointFailed err ->
1448 throwIO err
1478 throwIO err
1449− RemoteEndPointClosed Nothing ->
1479+ RemoteEndPointClosed ->
1450 relyViolation (ourEndPoint, theirEndPoint) "closeConnection (closed)"
1480 relyViolation (ourEndPoint, theirEndPoint) "closeConnection (closed)"
1451 writeChan ourChannel (ConnectionClosed cid)
1481 writeChan ourChannel (ConnectionClosed cid)
1452 closeIfUnused (ourEndPoint, theirEndPoint)
1482 closeIfUnused (ourEndPoint, theirEndPoint)
@@ -1476,17 +1506,17 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1476 -- Attempt to reply (but don't insist)
1506 -- Attempt to reply (but don't insist)
1477 tryIO $ sendOn vst' [encodeInt32 CloseSocket]
1507 tryIO $ sendOn vst' [encodeInt32 CloseSocket]
1478 tryCloseSocket sock
1508 tryCloseSocket sock
1479− return (RemoteEndPointClosed Nothing, True)
1509+ return (RemoteEndPointClosed, True)
1480 else
1510 else
1481 return (RemoteEndPointValid vst', False)
1511 return (RemoteEndPointValid vst', False)
1482 RemoteEndPointClosing resolved _ -> do
1512 RemoteEndPointClosing resolved _ -> do
1483 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
1513 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
1484 tryCloseSocket sock
1514 tryCloseSocket sock
1485 putMVar resolved ()
1515 putMVar resolved ()
1486− return (RemoteEndPointClosed Nothing, True)
1516+ return (RemoteEndPointClosed, True)
1487− RemoteEndPointClosed (Just err) ->
1517+ RemoteEndPointFailed err ->
1488 throwIO err
1518 throwIO err
1489− RemoteEndPointClosed Nothing ->
1519+ RemoteEndPointClosed ->
1490 relyViolation (ourEndPoint, theirEndPoint)
1520 relyViolation (ourEndPoint, theirEndPoint)
1491 "handleIncomingMessages:closeSocket (closed)"
1521 "handleIncomingMessages:closeSocket (closed)"
1492
1522
@@ -1520,12 +1550,15 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1520 (IntSet.elems $ vst ^. remoteIncoming)
1550 (IntSet.elems $ vst ^. remoteIncoming)
1521 writeChan ourChannel . ErrorEvent $ TransportError code (show err)
1551 writeChan ourChannel . ErrorEvent $ TransportError code (show err)
1522 forM_ (vst ^. pendingCtrlRequests) $ flip putMVar (Left err)
1552 forM_ (vst ^. pendingCtrlRequests) $ flip putMVar (Left err)
1523− return (RemoteEndPointClosed $ Just err)
1553+ return (RemoteEndPointFailed err)
1524 RemoteEndPointClosing resolved _ -> do
1554 RemoteEndPointClosing resolved _ -> do
1525 putMVar resolved ()
1555 putMVar resolved ()
1556+ return (RemoteEndPointFailed err)
1526− return (RemoteEndPointClosed $ Just err)
1557+ RemoteEndPointClosed ->
1527− RemoteEndPointClosed err' ->
1558+ relyViolation (ourEndPoint, theirEndPoint)
1528− return (RemoteEndPointClosed err')
1559+ "handleIncomingMessages:prematureExit"
1560+ RemoteEndPointFailed err' ->
1561+ return (RemoteEndPointFailed err')
1529
1562
1530-- | Get the next connection ID
1563-- | Get the next connection ID
1531--
1564--