@@ -259,10 +259,10 @@ data ValidLocalEndPointState = ValidLocalEndPointState
259259-- | /----------------\
260260-- | | |
261261-- | v |
262−-- \---> Valid ----+---> Closing
263−-- | |
264−-- | v
265−-- \---> Closed
262+-- +---> Valid ----+---> Closing
263+-- | | |
264+-- | | v
265+-- \---------------+---> Closed
266266--
267267-- Init: There are two places where we create new remote endpoints: in
268268-- requestConnectionTo (in response to an API 'connect' call) and in
@@ -565,16 +565,15 @@ apiCloseEndPoint transport evs ourEndPoint = do
565565 case st of
566566 RemoteEndPointInvalid _ ->
567567 return st
568− RemoteEndPointInit _ ->
569− return st
568+ RemoteEndPointInit resolved -> do
569+ putMVar resolved ()
570+ return RemoteEndPointClosed
570571 RemoteEndPointValid conn -> do
571− -- Try to send a CloseSocket request
572572 tryIO $ sendOn conn [encodeInt32 CloseSocket]
573− -- .. but even if it fails, close the socket anyway
574573 tryCloseSocket (remoteSocket conn)
575574 return RemoteEndPointClosed
576− RemoteEndPointClosing _ conn -> do
577− -- TODO: should we signal on resolved here?
575+ RemoteEndPointClosing resolved conn -> do
576+ putMVar resolved ()
578577 tryCloseSocket (remoteSocket conn)
579578 return RemoteEndPointClosed
580579 RemoteEndPointClosed ->
@@ -583,42 +582,44 @@ apiCloseEndPoint transport evs ourEndPoint = do
583582-- | Special case of 'apiConnect': connect an endpoint to itself
584583connectToSelf :: LocalEndPoint
585584 -> IO (Either (TransportError ConnectErrorCode) Connection)
586−connectToSelf ourEndPoint = do
587− -- Here connAlive must an MVar because it is not protected by another lock
588− connAlive <- newMVar True
589− mConnId <- tryIO (getNextConnectionId ourEndPoint)
590− case mConnId of
591− Left err ->
592− return . Left $ TransportError ConnectNotFound (show err)
593− Right connId -> do
594− writeChan ourChan $
595− ConnectionOpened connId ReliableOrdered (localAddress ourEndPoint)
596− return . Right $ Connection
597− { send = selfSend connAlive connId
598− , close = selfClose connAlive connId
599− }
585+connectToSelf ourEndPoint = try . mapIOException connectFailed $ do
586+ connAlive <- newIORef True -- Protected by the local endpoint lock
587+ connId <- getNextConnectionId ourEndPoint
588+ writeChan ourChan $
589+ ConnectionOpened connId ReliableOrdered (localAddress ourEndPoint)
590+ return Connection
591+ { send = selfSend connAlive connId
592+ , close = selfClose connAlive connId
593+ }
600594 where
601− ourChan :: Chan Event
602− ourChan = localChannel ourEndPoint
603−
604− selfSend :: MVar Bool
595+ selfSend :: IORef Bool
605596 -> ConnectionId
606597 -> [ByteString]
607598 -> IO (Either (TransportError SendErrorCode) ())
608599 selfSend connAlive connId msg =
609− modifyMVar connAlive $ \alive ->
610− if alive
611− then do
612− writeChan ourChan (Received connId msg)
613− return (alive, Right ())
614− else
615− return (alive, Left (TransportError SendFailed "Connection closed"))
600+ try . withMVar ourState $ \st -> case st of
601+ LocalEndPointValid _ -> do
602+ alive <- readIORef connAlive
603+ if alive
604+ then writeChan ourChan (Received connId msg)
605+ else throwIO $ TransportError SendClosed "Connection closed"
606+ LocalEndPointClosed ->
607+ throwIO $ TransportError SendFailed "Endpoint closed"
616608
617− selfClose :: MVar Bool -> ConnectionId -> IO ()
609+ selfClose :: IORef Bool -> ConnectionId -> IO ()
618610 selfClose connAlive connId =
619− modifyMVar_ connAlive $ \alive -> do
620− when alive $ writeChan ourChan (ConnectionClosed connId)
621− return False
611+ withMVar ourState $ \st -> case st of
612+ LocalEndPointValid _ -> do
613+ alive <- readIORef connAlive
614+ when alive $ do
615+ writeChan ourChan (ConnectionClosed connId)
616+ writeIORef connAlive False
617+ LocalEndPointClosed ->
618+ return ()
619+
620+ ourChan = localChannel ourEndPoint
621+ ourState = localState ourEndPoint
622+ connectFailed = TransportError ConnectFailed . show
622623
623624--------------------------------------------------------------------------------
624625-- Functions from TransportInternals --