@@ -324,15 +324,23 @@ data RemoteEndPoint = RemoteEndPoint
324324 , remoteId :: Int
325325 }
326326
327−data Origin = Local | Remote
327+data RequestedBy = RequestedByUs | RequestedByThem
328328 deriving (Eq, Show)
329329
330330data RemoteState =
331+ -- | Invalid remote endpoint (for example, invalid address)
331332 RemoteEndPointInvalid (TransportError ConnectErrorCode)
332− | RemoteEndPointInit (MVar ()) Origin
333+ -- | The remote endpoint is being initialized
334+ | RemoteEndPointInit (MVar ()) RequestedBy
335+ -- | "Normal" working endpoint
333336 | RemoteEndPointValid ValidRemoteEndPointState
337+ -- | The remote endpoint is being closed (garbage collected)
334338 | 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
336344
337345data ValidRemoteEndPointState = ValidRemoteEndPointState
338346 { _remoteOutgoing :: !Int
@@ -477,7 +485,7 @@ apiConnect ourEndPoint theirAddress _reliability hints =
477485 if localAddress ourEndPoint == theirAddress
478486 then connectToSelf ourEndPoint
479487 else try $ do
480− resetRemoteEndPoint ourEndPoint theirAddress
488+ resetIfBroken ourEndPoint theirAddress
481489 (theirEndPoint, connId) <-
482490 requestConnectionTo ourEndPoint theirAddress hints
483491 -- connAlive can be an IORef rather than an MVar because it is protected
@@ -530,7 +538,12 @@ apiSend (ourEndPoint, theirEndPoint) connId connAlive payload =
530538 if alive
531539 then relyViolation (ourEndPoint, theirEndPoint) "apiSend"
532540 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
534547 alive <- readIORef connAlive
535548 if alive
536549 then throwIO $ TransportError SendFailed (show err)
@@ -565,7 +578,7 @@ apiCloseEndPoint transport evs ourEndPoint = do
565578 tryCloseRemoteSocket theirEndPoint = do
566579 -- We make an attempt to close the connection nicely
567580 -- (by sending a CloseSocket first)
568− let closed = RemoteEndPointClosed .Just . userError $ "apiCloseEndPoint"
581+ let closed = RemoteEndPointFailed . userError $ "apiCloseEndPoint"
569582 modifyMVar_ (remoteState theirEndPoint) $ \st ->
570583 case st of
571584 RemoteEndPointInvalid _ ->
@@ -581,8 +594,10 @@ apiCloseEndPoint transport evs ourEndPoint = do
581594 putMVar resolved ()
582595 tryCloseSocket (remoteSocket conn)
583596 return closed
584− RemoteEndPointClosed err ->
585− return $ RemoteEndPointClosed err
597+ RemoteEndPointClosed ->
598+ return st
599+ RemoteEndPointFailed err ->
600+ return $ RemoteEndPointFailed err
586601
587602-- | Special case of 'apiConnect': connect an endpoint to itself
588603connectToSelf :: LocalEndPoint
@@ -659,10 +674,12 @@ internalSocketBetween transport ourAddress theirAddress = do
659674 return $ remoteSocket vst
660675 RemoteEndPointClosing _ vst ->
661676 return $ remoteSocket vst
662− RemoteEndPointClosed _ ->
677+ RemoteEndPointClosed ->
663678 throwIO $ userError "Remote endpoint closed"
664− RemoteEndPointInvalid _ ->
665− throwIO $ userError "Remote endpoint invalid"
679+ RemoteEndPointInvalid err ->
680+ throwIO err
681+ RemoteEndPointFailed err ->
682+ throwIO err
666683
667684--------------------------------------------------------------------------------
668685-- Lower level functionality --
@@ -676,8 +693,8 @@ internalSocketBetween transport ourAddress theirAddress = do
676693--
677694-- Throws a TransportError ConnectFailed exception if the local endpoint is
678695-- closed.
679−resetRemoteEndPoint :: LocalEndPoint -> EndPointAddress -> IO ()
680−resetRemoteEndPoint ourEndPoint theirAddress = do
696+resetIfBroken :: LocalEndPoint -> EndPointAddress -> IO ()
697+resetIfBroken ourEndPoint theirAddress = do
681698 mTheirEndPoint <- withMVar (localState ourEndPoint) $ \st -> case st of
682699 LocalEndPointValid vst ->
683700 return (vst ^. localConnectionTo theirAddress)
@@ -687,7 +704,7 @@ resetRemoteEndPoint ourEndPoint theirAddress = do
687704 withMVar (remoteState theirEndPoint) $ \st -> case st of
688705 RemoteEndPointInvalid _ ->
689706 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
690− RemoteEndPointClosed (Just _) ->
707+ RemoteEndPointFailed _ ->
691708 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
692709 _ ->
693710 return ()
@@ -739,7 +756,7 @@ requestConnectionTo ourEndPoint theirAddress hints = go
739756 where
740757 go = do
741758 (theirEndPoint, isNew) <- mapIOException connectFailed $
742− findRemoteEndPoint ourEndPoint theirAddress Local
759+ findRemoteEndPoint ourEndPoint theirAddress RequestedByUs
743760
744761 if isNew
745762 then do
@@ -779,7 +796,7 @@ setupRemoteEndPoint (ourEndPoint, theirEndPoint) hints = do
779796 tryCloseSocket sock
780797 return False
781798 Right (sock, ConnectionRequestCrossed) -> do
782− resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointClosed Nothing)
799+ resolveInit (ourEndPoint, theirEndPoint) RemoteEndPointClosed
783800 tryCloseSocket sock
784801 return False
785802 Left err -> do
@@ -825,12 +842,12 @@ resolveInit (ourEndPoint, theirEndPoint) newState =
825842 RemoteEndPointInit resolved _ -> do
826843 putMVar resolved ()
827844 case newState of
828− RemoteEndPointClosed Nothing ->
845+ RemoteEndPointClosed ->
829846 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
830847 _ ->
831848 return ()
832849 return newState
833− RemoteEndPointClosed (Just ex) ->
850+ RemoteEndPointFailed ex ->
834851 throwIO ex
835852 _ ->
836853 relyViolation (ourEndPoint, theirEndPoint) "resolveInit"
@@ -951,8 +968,10 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do
951968 relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (init)"
952969 , caseClosing = \_ _ ->
953970 relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closing)"
954− , caseClosed = \_ ->
955− throwIO $ userError "doRemoteRequest: Remote endpoint closed"
971+ , caseClosed =
972+ relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closed)"
973+ , caseFailed =
974+ throwIO
956975 }
957976 mReply <- takeMVar replyMVar
958977 case mReply of
@@ -1023,10 +1042,11 @@ forkEndPointThread ourEndPoint p =
10231042
10241043data RemoteStatePatternMatch a = RemoteStatePatternMatch
10251044 { caseInvalid :: TransportError ConnectErrorCode -> IO a
1026− , caseInit :: MVar () -> Origin -> IO a
1045+ , caseInit :: MVar () -> RequestedBy -> IO a
10271046 , caseValid :: ValidRemoteEndPointState -> IO a
10281047 , caseClosing :: MVar () -> ValidRemoteEndPointState -> IO a
1029− , caseClosed :: Maybe IOException -> IO a
1048+ , caseClosed :: IO a
1049+ , caseFailed :: IOException -> IO a
10301050 }
10311051
10321052remoteStateIdentity :: RemoteStatePatternMatch RemoteState
@@ -1036,7 +1056,8 @@ remoteStateIdentity =
10361056 , caseInit = (return .) . RemoteEndPointInit
10371057 , caseValid = return . RemoteEndPointValid
10381058 , caseClosing = (return .) . RemoteEndPointClosing
1039− , caseClosed = return . RemoteEndPointClosed
1059+ , caseClosed = return RemoteEndPointClosed
1060+ , caseFailed = return . RemoteEndPointFailed
10401061 }
10411062
10421063-- | Like modifyMVar, but if an I/O exception occurs don't restore the remote
@@ -1076,8 +1097,13 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
10761097 (putMVar theirState st)
10771098 putMVar theirState st'
10781099 return a
1079− RemoteEndPointClosed err -> do
1080− (st', a) <- onException (restore $ caseClosed match err)
1100+ RemoteEndPointClosed -> do
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)
10811107 (putMVar theirState st)
10821108 putMVar theirState st'
10831109 return a
@@ -1088,7 +1114,7 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
10881114 handleIOException :: IOException -> ValidRemoteEndPointState -> IO ()
10891115 handleIOException ex vst = do
10901116 tryCloseSocket (remoteSocket vst)
1091− putMVar theirState (RemoteEndPointClosed $ Just ex)
1117+ putMVar theirState (RemoteEndPointFailed ex)
10921118 let incoming = IntSet.elems $ vst ^. remoteIncoming
10931119 code = EventConnectionLost (remoteAddress theirEndPoint) incoming
10941120 err = TransportError code (show ex)
@@ -1105,7 +1131,8 @@ modifyRemoteState_ (ourEndPoint, theirEndPoint) match =
11051131 , caseInit = \resolved origin -> u $ caseInit match resolved origin
11061132 , caseValid = u . caseValid match
11071133 , caseClosing = \resolved vst -> u $ caseClosing match resolved vst
1108− , caseClosed = u . caseClosed match
1134+ , caseClosed = u $ caseClosed match
1135+ , caseFailed = u . caseFailed match
11091136 }
11101137 where
11111138 u :: IO a -> IO (a, ())
@@ -1130,9 +1157,12 @@ withRemoteState (ourEndPoint, theirEndPoint) match =
11301157 , caseClosing = \resolved vst -> do
11311158 a <- caseClosing match resolved vst
11321159 return (RemoteEndPointClosing resolved vst, a)
1133− , caseClosed = \err -> do
1134− a <- caseClosed match err
1135− return (RemoteEndPointClosed err, a)
1160+ , caseClosed = do
1161+ a <- caseClosed match
1162+ return (RemoteEndPointClosed, a)
1163+ , caseFailed = \err -> do
1164+ a <- caseFailed match err
1165+ return (RemoteEndPointFailed err, a)
11361166 }
11371167
11381168--------------------------------------------------------------------------------
@@ -1172,9 +1202,9 @@ handleConnectionRequest transport sock = handle handleException $ do
11721202 go :: LocalEndPoint -> EndPointAddress -> IO ()
11731203 go ourEndPoint theirAddress = do
11741204 mEndPoint <- handle ((>> return Nothing) . handleException) $ do
1175− resetRemoteEndPoint ourEndPoint theirAddress
1205+ resetIfBroken ourEndPoint theirAddress
11761206 (theirEndPoint, isNew) <-
1177− findRemoteEndPoint ourEndPoint theirAddress Remote
1207+ findRemoteEndPoint ourEndPoint theirAddress RequestedByThem
11781208
11791209 if not isNew
11801210 then do
@@ -1210,7 +1240,7 @@ handleConnectionRequest transport sock = handle handleException $ do
12101240findRemoteEndPoint
12111241 :: LocalEndPoint
12121242 -> EndPointAddress
1213− -> Origin
1243+ -> RequestedBy
12141244 -> IO (RemoteEndPoint, Bool)
12151245findRemoteEndPoint ourEndPoint theirAddress findOrigin = go
12161246 where
@@ -1244,12 +1274,12 @@ findRemoteEndPoint ourEndPoint theirAddress findOrigin = go
12441274 snapshot <- modifyMVar theirState $ \st -> case st of
12451275 RemoteEndPointValid vst ->
12461276 case findOrigin of
1247− Local -> do
1277+ RequestedByUs -> do
12481278 let st' = RemoteEndPointValid
12491279 . (remoteOutgoing ^: (+ 1))
12501280 $ vst
12511281 return (st', st')
1252− Remote ->
1282+ RequestedByThem ->
12531283 return (st, st)
12541284 _ ->
12551285 return (st, st)
@@ -1261,15 +1291,19 @@ findRemoteEndPoint ourEndPoint theirAddress findOrigin = go
12611291 throwIO err
12621292 RemoteEndPointInit resolved initOrigin ->
12631293 case (findOrigin, initOrigin) of
1264− (Local, Local) -> readMVar resolved >> go
1265− (Local, Remote) -> readMVar resolved >> go
1266− (Remote, Local) -> if ourAddress > theirAddress
1267− then
1268− -- Wait for the Crossed message
1269− readMVar resolved >> go
1270− else
1271− return (theirEndPoint, False)
1272− (Remote, Remote) -> throwIO $ userError "Already connected (B)"
1294+ (RequestedByUs, RequestedByUs) ->
1295+ readMVar resolved >> go
1296+ (RequestedByUs, RequestedByThem) ->
1297+ readMVar resolved >> go
1298+ (RequestedByThem, RequestedByUs) ->
1299+ if ourAddress > theirAddress
1300+ then
1301+ -- Wait for the Crossed message
1302+ readMVar resolved >> go
1303+ else
1304+ return (theirEndPoint, False)
1305+ (RequestedByThem, RequestedByThem) ->
1306+ throwIO $ userError "Already connected (B)"
12731307 RemoteEndPointValid _ ->
12741308 -- We assume that the request crossed if we find the endpoint in
12751309 -- Valid state. It is possible that this is really an invalid
@@ -1278,18 +1312,14 @@ findRemoteEndPoint ourEndPoint theirAddress findOrigin = go
12781312 return (theirEndPoint, False)
12791313 RemoteEndPointClosing resolved _ ->
12801314 readMVar resolved >> go
1281− RemoteEndPointClosed Nothing ->
1315+ RemoteEndPointClosed ->
12821316 go
1283− RemoteEndPointClosed (Just err) ->
1317+ RemoteEndPointFailed err ->
12841318 throwIO err
12851319
12861320 ourState = localState ourEndPoint
12871321 ourAddress = localAddress ourEndPoint
12881322
1289−
1290−
1291−
1292−
12931323-- | Handle requests from a remote endpoint.
12941324--
12951325-- Returns only if the remote party closes the socket or if an error occurs.
@@ -1307,9 +1337,9 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
13071337 return . Just $ remoteSocket ep
13081338 RemoteEndPointClosing _ ep ->
13091339 return . Just $ remoteSocket ep
1310− RemoteEndPointClosed _ ->
1311− -- The remote endpoint got closed before we got a chance to start
1312− -- dealing with incoming messages
1340+ RemoteEndPointClosed ->
1341+ return Nothing
1342+ RemoteEndPointFailed _ ->
13131343 return Nothing
13141344
13151345 forM_ mSock $ \sock ->
@@ -1377,9 +1407,9 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
13771407 -- to RemoteEndPointValid
13781408 putMVar resolved ()
13791409 return (remoteIncoming ^= IntSet.singleton newId $ vst)
1380− RemoteEndPointClosed (Just err) ->
1410+ RemoteEndPointFailed err ->
13811411 throwIO err
1382− RemoteEndPointClosed Nothing ->
1412+ RemoteEndPointClosed ->
13831413 relyViolation (ourEndPoint, theirEndPoint)
13841414 "createNewConnection (closed)"
13851415 sendOn vst ( encodeInt32 ControlResponse
@@ -1411,9 +1441,9 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
14111441 )
14121442 RemoteEndPointClosing _ _ ->
14131443 throwIO $ userError "Invalid control response"
1414− RemoteEndPointClosed (Just err) ->
1444+ RemoteEndPointFailed err ->
14151445 throwIO err
1416− RemoteEndPointClosed Nothing ->
1446+ RemoteEndPointClosed ->
14171447 relyViolation (ourEndPoint, theirEndPoint)
14181448 "readControlResponse (closed)"
14191449 case mmvar of
@@ -1444,9 +1474,9 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
14441474 -- far as we are concerned there are no incoming connections. This
14451475 -- means that a CloseConnection request at this point is invalid.
14461476 throwIO $ userError "Invalid CloseConnection request"
1447− RemoteEndPointClosed (Just err) ->
1477+ RemoteEndPointFailed err ->
14481478 throwIO err
1449− RemoteEndPointClosed Nothing ->
1479+ RemoteEndPointClosed ->
14501480 relyViolation (ourEndPoint, theirEndPoint) "closeConnection (closed)"
14511481 writeChan ourChannel (ConnectionClosed cid)
14521482 closeIfUnused (ourEndPoint, theirEndPoint)
@@ -1476,17 +1506,17 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
14761506 -- Attempt to reply (but don't insist)
14771507 tryIO $ sendOn vst' [encodeInt32 CloseSocket]
14781508 tryCloseSocket sock
1479− return (RemoteEndPointClosed Nothing, True)
1509+ return (RemoteEndPointClosed, True)
14801510 else
14811511 return (RemoteEndPointValid vst', False)
14821512 RemoteEndPointClosing resolved _ -> do
14831513 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
14841514 tryCloseSocket sock
14851515 putMVar resolved ()
1486− return (RemoteEndPointClosed Nothing, True)
1487− RemoteEndPointClosed (Just err) ->
1516+ return (RemoteEndPointClosed, True)
1517+ RemoteEndPointFailed err ->
14881518 throwIO err
1489− RemoteEndPointClosed Nothing ->
1519+ RemoteEndPointClosed ->
14901520 relyViolation (ourEndPoint, theirEndPoint)
14911521 "handleIncomingMessages:closeSocket (closed)"
14921522
@@ -1520,12 +1550,15 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
15201550 (IntSet.elems $ vst ^. remoteIncoming)
15211551 writeChan ourChannel . ErrorEvent $ TransportError code (show err)
15221552 forM_ (vst ^. pendingCtrlRequests) $ flip putMVar (Left err)
1523− return (RemoteEndPointClosed $ Just err)
1553+ return (RemoteEndPointFailed err)
15241554 RemoteEndPointClosing resolved _ -> do
15251555 putMVar resolved ()
1526− return (RemoteEndPointClosed $ Just err)
1527− RemoteEndPointClosed err' ->
1528− return (RemoteEndPointClosed err')
1556+ return (RemoteEndPointFailed err)
1557+ RemoteEndPointClosed ->
1558+ relyViolation (ourEndPoint, theirEndPoint)
1559+ "handleIncomingMessages:prematureExit"
1560+ RemoteEndPointFailed err' ->
1561+ return (RemoteEndPointFailed err')
15291562
15301563-- | Get the next connection ID
15311564--