@@ -473,7 +473,7 @@ apiConnect :: LocalEndPoint -- ^ Local end point
473473 -> Reliability -- ^ Reliability (ignored)
474474 -> ConnectHints -- ^ Hints (ignored for now)
475475 -> IO (Either (TransportError ConnectErrorCode) Connection)
476−apiConnect ourEndPoint theirAddress _reliability hints = do
476+apiConnect ourEndPoint theirAddress _reliability hints =
477477 if localAddress ourEndPoint == theirAddress
478478 then connectToSelf ourEndPoint
479479 else try $ do
@@ -562,24 +562,25 @@ apiCloseEndPoint transport evs ourEndPoint = do
562562 where
563563 -- Close the remote socket and return the set of all incoming connections
564564 tryCloseRemoteSocket :: RemoteEndPoint -> IO ()
565− tryCloseRemoteSocket theirEndPoint =
565+ tryCloseRemoteSocket theirEndPoint = do
566566 -- We make an attempt to close the connection nicely
567567 -- (by sending a CloseSocket first)
568+ let closed = RemoteEndPointClosed .Just . userError $ "apiCloseEndPoint"
568569 modifyMVar_ (remoteState theirEndPoint) $ \st ->
569570 case st of
570571 RemoteEndPointInvalid _ ->
571572 return st
572573 RemoteEndPointInit resolved _ -> do
573574 putMVar resolved ()
574− return $ RemoteEndPointClosed (Just . userError $ "apiCloseEndPoint")
575+ return closed
575576 RemoteEndPointValid conn -> do
576577 tryIO $ sendOn conn [encodeInt32 CloseSocket]
577578 tryCloseSocket (remoteSocket conn)
578− return $ RemoteEndPointClosed (Just . userError $ "apiCloseEndPoint")
579+ return closed
579580 RemoteEndPointClosing resolved conn -> do
580581 putMVar resolved ()
581582 tryCloseSocket (remoteSocket conn)
582− return $ RemoteEndPointClosed (Just . userError $ "apiCloseEndPoint")
583+ return closed
583584 RemoteEndPointClosed err ->
584585 return $ RemoteEndPointClosed err
585586
@@ -760,33 +761,32 @@ requestConnectionTo ourEndPoint theirAddress hints = go
760761setupRemoteEndPoint :: EndPointPair -> ConnectHints -> IO ()
761762setupRemoteEndPoint (ourEndPoint, theirEndPoint) hints = do
762763 didAccept <- bracketOnError (socketToEndPoint ourAddress theirAddress hints)
763− onError $ \result ->
764− case result of
765− Right (sock, ConnectionRequestAccepted) -> do
766− let vst = ValidRemoteEndPointState
767− { remoteSocket = sock
768− , _remoteOutgoing = 0
769− , _remoteIncoming = IntSet.empty
770− , sendOn = sendMany sock
771− , _pendingCtrlRequests = IntMap.empty
772− , _nextCtrlRequestId = 0
773− }
774− resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointValid vst)
775− return True
776− Right (sock, ConnectionRequestInvalid) -> do
777− let err = invalidAddress "setupRemoteEndPoint: Invalid endpoint"
778− resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointInvalid err)
779− tryCloseSocket sock
780− return False
781− Right (sock, ConnectionRequestCrossed) -> do
782− -- We leave the endpoint in Init state, handleConnectionRequest will
783− -- take care of it
784− resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointClosed Nothing)
785− tryCloseSocket sock
786− return False
787− Left err -> do
788− resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointInvalid err)
789− return False
764+ onError $ \result -> case result of
765+ Right (sock, ConnectionRequestAccepted) -> do
766+ let vst = ValidRemoteEndPointState
767+ { remoteSocket = sock
768+ , _remoteOutgoing = 0
769+ , _remoteIncoming = IntSet.empty
770+ , sendOn = sendMany sock
771+ , _pendingCtrlRequests = IntMap.empty
772+ , _nextCtrlRequestId = 0
773+ }
774+ resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointValid vst)
775+ return True
776+ Right (sock, ConnectionRequestInvalid) -> do
777+ let err = invalidAddress "setupRemoteEndPoint: Invalid endpoint"
778+ resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointInvalid err)
779+ tryCloseSocket sock
780+ return False
781+ Right (sock, ConnectionRequestCrossed) -> do
782+ -- We leave the endpoint in Init state, handleConnectionRequest will
783+ -- take care of it
784+ resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointClosed Nothing)
785+ tryCloseSocket sock
786+ return False
787+ Left err -> do
788+ resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointInvalid err)
789+ return False
790790
791791 -- If we get to this point without an exception, then
792792 --
@@ -794,7 +794,7 @@ setupRemoteEndPoint (ourEndPoint, theirEndPoint) hints = do
794794 -- if didAccept is True, the socket has been stored as part of the remote
795795 -- state so we no longer need to worry about closing it when an
796796 -- asynchronous exception occurs
797− when didAccept $ handleIncomingMessages (ourEndPoint, theirEndPoint)
797+ when didAccept $ handleIncomingMessages (ourEndPoint, theirEndPoint)
798798 where
799799 -- If an asynchronous exception occurs while we set up the remote endpoint
800800 -- we need to make sure to close the socket. It is also useful to
@@ -857,7 +857,7 @@ socketToEndPoint (EndPointAddress ourAddress) theirAddress hints = try $ do
857857 timeoutMaybe (connectTimeout hints) timeoutError $
858858 N.connect sock (N.addrAddress addr)
859859 response <- mapIOException failed $ do
860− sendMany sock (encodeInt32 theirEndPointId : prependLength [ourAddress])
860+ sendMany sock (encodeInt32 theirEndPointId : prependLength [ourAddress])
861861 recvInt32 sock
862862 case tryToEnum response of
863863 Nothing -> throwIO (failed . userError $ "Unexpected response")
@@ -947,10 +947,14 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do
947947 $ vst
948948 )
949949 -- Error cases
950− , caseInvalid = throwIO
951− , caseInit = \_ _ -> relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (init)"
952− , caseClosing = \_ _ -> relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closing)"
953− , caseClosed = \_ -> throwIO $ userError "doRemoteRequest: Remote endpoint closed"
950+ , caseInvalid =
951+ throwIO
952+ , caseInit = \_ _ ->
953+ relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (init)"
954+ , caseClosing = \_ _ ->
955+ relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closing)"
956+ , caseClosed = \_ ->
957+ throwIO $ userError "doRemoteRequest: Remote endpoint closed"
954958 }
955959 mReply <- takeMVar replyMVar
956960 case mReply of
@@ -1014,7 +1018,7 @@ forkEndPointThread ourEndPoint p =
10141018 ourState = localState ourEndPoint
10151019
10161020--------------------------------------------------------------------------------
1017−-- As soon as a remote connection fails, we want to put notify our endpoint --
1021+-- As soon as a remote connection fails, we want to put notify our endpoint --
10181022-- and put it into a closed state. Since this may happen in many places, we --
10191023-- provide some abstractions. --
10201024--------------------------------------------------------------------------------
@@ -1296,9 +1300,11 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
12961300 mSock <- withMVar theirState $ \st ->
12971301 case st of
12981302 RemoteEndPointInvalid _ ->
1299− relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages (invalid)"
1303+ relyViolation (ourEndPoint, theirEndPoint)
1304+ "handleIncomingMessages (invalid)"
13001305 RemoteEndPointInit _ _ ->
1301− relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages (init)"
1306+ relyViolation (ourEndPoint, theirEndPoint)
1307+ "handleIncomingMessages (init)"
13021308 RemoteEndPointValid ep ->
13031309 return . Just $ remoteSocket ep
13041310 RemoteEndPointClosing _ ep ->
@@ -1505,9 +1511,11 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
15051511 modifyMVar_ theirState $ \st ->
15061512 case st of
15071513 RemoteEndPointInvalid _ ->
1508− relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:prematureExit"
1514+ relyViolation (ourEndPoint, theirEndPoint)
1515+ "handleIncomingMessages:prematureExit"
15091516 RemoteEndPointInit _ _ ->
1510− relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:prematureExit"
1517+ relyViolation (ourEndPoint, theirEndPoint)
1518+ "handleIncomingMessages:prematureExit"
15111519 RemoteEndPointValid vst -> do
15121520 let code = EventConnectionLost
15131521 (remoteAddress theirEndPoint)