From d91d81ea4360efa37e956bc5eea1cbbef68beafa Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Fri, 25 Oct 2024 12:52:39 +0200 Subject: [PATCH] connection-manager: renamed methods --- ouroboros-network-framework/CHANGELOG.md | 3 + .../demo/connection-manager.hs | 6 +- .../Ouroboros/Network/ConnectionManager.hs | 8 +- .../Test/Ouroboros/Network/Server2/Sim.hs | 4 +- .../Network/ConnectionManager/Core.hs | 90 +++++++++---------- .../Network/ConnectionManager/Types.hs | 54 +++++------ .../src/Ouroboros/Network/InboundGovernor.hs | 4 +- .../ConnectionManager/Test/Experiments.hs | 12 +-- .../Network/ConnectionManager/Test/Utils.hs | 2 +- .../Network/PeerSelection/PeerStateActions.hs | 4 +- 10 files changed, 95 insertions(+), 92 deletions(-) diff --git a/ouroboros-network-framework/CHANGELOG.md b/ouroboros-network-framework/CHANGELOG.md index f651bd00de..bfe76a1af3 100644 --- a/ouroboros-network-framework/CHANGELOG.md +++ b/ouroboros-network-framework/CHANGELOG.md @@ -7,6 +7,9 @@ * Addapted to `network-mux` changes in https://github.com/IntersectMBO/ouroboros-network/pull/4999 * Addapted to `network-mux` changes in https://github.com/IntersectMBO/ouroboros-network/pull/4997 * Removed deprecated `Ouroboros.Network.Channel.{to,from}Channel` functions. +* Renamed `requestOutboundConnection` to `acquireOutboundConnection` and + `unregister{Inbound,Outbound}Connection` to `release{Inbound,Outbound}Connection`. + `AssertionLocation` constructors were renamed as well. ### Non-breaking changes diff --git a/ouroboros-network-framework/demo/connection-manager.hs b/ouroboros-network-framework/demo/connection-manager.hs index 5134355963..577dc37d7e 100644 --- a/ouroboros-network-framework/demo/connection-manager.hs +++ b/ouroboros-network-framework/demo/connection-manager.hs @@ -484,7 +484,7 @@ bidirectionalExperiment }) muxBundle res <- - unregisterOutboundConnection + releaseOutboundConnection connectionManager remoteAddr case res of UnsupportedState inState -> do @@ -541,9 +541,9 @@ bidirectionalExperiment Mux.InitiatorResponderMode UnversionedProtocol)) connect n cm | n <= 1 = - requestOutboundConnection cm remoteAddr + acquireOutboundConnection cm remoteAddr connect n cm = - requestOutboundConnection cm remoteAddr + acquireOutboundConnection cm remoteAddr `catch` \(_ :: IOException) -> threadDelay 1 >> connect (pred n) cm `catch` \(_ :: Mux.Error) -> threadDelay 1 diff --git a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs index ab90fcf2f9..d8e04f422c 100644 --- a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs +++ b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs @@ -810,7 +810,7 @@ prop_valid_transitions (Fixed rnd) (SkewedBool bindToLocalAddress) scheduleMap = -- another 5s is the longest delay for -- handshake negotiation. timeout (1 + 5 + testTimeWaitTimeout) - (requestOutboundConnection + (acquireOutboundConnection connectionManager addr)) `catches` [ Handler $ \(e :: IOException) -> return (Left (toException e)) @@ -849,11 +849,11 @@ prop_valid_transitions (Fixed rnd) (SkewedBool bindToLocalAddress) scheduleMap = -- 'unregisterOutboundConnection' to be -- successful. void $ - unregisterInboundConnection + releaseInboundConnection connectionManager addr res <- - unregisterOutboundConnection + releaseOutboundConnection connectionManager addr case res of UnsupportedState st -> @@ -929,7 +929,7 @@ prop_valid_transitions (Fixed rnd) (SkewedBool bindToLocalAddress) scheduleMap = Left _ -> -- TODO: should we run 'unregisterInboundConnection' depending on 'seActiveDelay' void $ - unregisterInboundConnection + releaseInboundConnection connectionManager addr go (thread : threads) acceptNext conns' (AcceptFailure err, _acceptNext) -> diff --git a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs index 2e4e315c07..306846f3cd 100644 --- a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs +++ b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs @@ -873,7 +873,7 @@ multinodeExperiment inboundTrTracer trTracer inboundTracer debugTracer cmTracer case fromException e of Just SomeAsyncException {} -> Nothing _ -> Just e) - $ requestOutboundConnection cm remoteAddr + $ acquireOutboundConnection cm remoteAddr case connHandle of Left _ -> go connMap @@ -888,7 +888,7 @@ multinodeExperiment inboundTrTracer trTracer inboundTracer debugTracer cmTracer m <- readTVar connVar check (Map.member (connId remoteAddr) m) writeTVar connVar (Map.delete (connId remoteAddr) m) - void (unregisterOutboundConnection cm remoteAddr) + void (releaseOutboundConnection cm remoteAddr) go (Map.delete remoteAddr connMap) RunMiniProtocols remoteAddr reqs -> do atomically $ do diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs index aed96e545e..90083bac36 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs @@ -501,7 +501,7 @@ defaultResetTimeout = 5 newtype PruneAction m = PruneAction { runPruneAction :: m () } --- | Instruction used internally in @unregisterOutboundConnectionImpl@, e.g. in +-- | Instruction used internally in @releaseOutboundConnectionImpl@, e.g. in -- the implementation of one of the two @DemotedToCold^{dataFlow}_{Local}@ -- transitions. -- @@ -690,11 +690,11 @@ with args@Arguments { getConnectionManager = WithInitiatorMode OutboundConnectionManager { - ocmRequestConnection = - requestOutboundConnectionImpl freshIdSupply stateVar + ocmAcquireConnection = + acquireOutboundConnectionImpl freshIdSupply stateVar outboundHandler, - ocmUnregisterConnection = - unregisterOutboundConnectionImpl stateVar stdGenVar + ocmReleaseConnection = + releaseOutboundConnectionImpl stateVar stdGenVar }, readState, waitForOutboundDemotion @@ -708,8 +708,8 @@ with args@Arguments { icmIncludeConnection = includeInboundConnectionImpl freshIdSupply stateVar inboundHandler, - icmUnregisterConnection = - unregisterInboundConnectionImpl stateVar, + icmReleaseConnection = + releaseInboundConnectionImpl stateVar, icmPromotedToWarmRemote = promotedToWarmRemoteImpl stateVar stdGenVar, icmDemotedToColdRemote = @@ -726,18 +726,18 @@ with args@Arguments { getConnectionManager = WithInitiatorResponderMode OutboundConnectionManager { - ocmRequestConnection = - requestOutboundConnectionImpl freshIdSupply stateVar + ocmAcquireConnection = + acquireOutboundConnectionImpl freshIdSupply stateVar outboundHandler, - ocmUnregisterConnection = - unregisterOutboundConnectionImpl stateVar stdGenVar + ocmReleaseConnection = + releaseOutboundConnectionImpl stateVar stdGenVar } InboundConnectionManager { icmIncludeConnection = includeInboundConnectionImpl freshIdSupply stateVar inboundHandler, - icmUnregisterConnection = - unregisterInboundConnectionImpl stateVar, + icmReleaseConnection = + releaseInboundConnectionImpl stateVar, icmPromotedToWarmRemote = promotedToWarmRemoteImpl stateVar stdGenVar, icmDemotedToColdRemote = @@ -863,7 +863,7 @@ with args@Arguments { cleanup :: m () cleanup = -- We must ensure that we update 'connVar', - -- `requestOutboundConnection` might be blocked on it awaiting for: + -- `acquireOutboundConnection` might be blocked on it awaiting for: -- - handshake negotiation; or -- - `Terminate: TerminatingState → TerminatedState` transition. -- That's why we use 'uninterruptibleMask'. Note that this cleanup @@ -959,7 +959,7 @@ with args@Arguments { in forceThreadDelay timeWaitTimeout `finally` do -- We must ensure that we update 'connVar', - -- `requestOutboundConnection` might be blocked on it awaiting for: + -- `acquireOutboundConnection` might be blocked on it awaiting for: -- - handshake negotiation; or -- - `Terminate: TerminatingState → TerminatedState` transition. traceWith tracer (TrConnectionTimeWaitDone connId) @@ -1125,7 +1125,7 @@ with args@Arguments { -- -- This is subtle part, which needs to handle a near simultaneous -- open. We cannot rely on 'ReservedOutboundState' state as - -- a lock. It may happen that the `requestOutboundConnection` + -- a lock. It may happen that the `acquireOutboundConnection` -- will put 'ReservedOutboundState', but before it will call `connect` -- the `accept` call will return. We overwrite the state and -- replace the connection state 'TVar' with a fresh one. Nothing @@ -1223,7 +1223,7 @@ with args@Arguments { -- -- Note: we don't set an explicit timeout here. The -- server will set a timeout and call - -- 'unregisterInboundConnection' when it expires. + -- 'releaseInboundConnection' when it expires. -- UnnegotiatedState {} -> do let connState' = InboundIdleState @@ -1278,7 +1278,7 @@ with args@Arguments { -- @ -- This is not needed! When we return from this call, the inbound -- protocol governor will monitor the connection. Once it becomes - -- idle, it will call 'unregisterInboundConnection' which will + -- idle, it will call 'releaseInboundConnection' which will -- perform the aforementioned @Commit@ transition. if connected @@ -1378,12 +1378,12 @@ with args@Arguments { -- We need 'mask' in order to guarantee that the traces are logged if an -- async exception lands between the successful STM action and the logging -- action. - unregisterInboundConnectionImpl + releaseInboundConnectionImpl :: StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m) -> peerAddr -> m (OperationResult DemotedToColdRemoteTr) - unregisterInboundConnectionImpl stateVar peerAddr = mask_ $ do - traceWith tracer (TrUnregisterConnection Inbound peerAddr) + releaseInboundConnectionImpl stateVar peerAddr = mask_ $ do + traceWith tracer (TrReleaseConnection Inbound peerAddr) (mbThread, mbTransition, result, mbAssertion) <- atomically $ do state <- readTMVar stateVar case Map.lookup peerAddr state of @@ -1400,7 +1400,7 @@ with args@Arguments { connState <- readTVar connVar let st = abstractState (Known connState) case connState of - -- In any of the following two states unregistering is not + -- In any of the following two states releasing is not -- supported. 'includeInboundConnection' is a synchronous -- operation which returns only once the connection is -- negotiated. @@ -1435,8 +1435,8 @@ with args@Arguments { , Nothing , OperationSuccess KeepTr , Just (TrUnexpectedlyFalseAssertion - (UnregisterInboundConnection (Just connId) - st) + (ReleaseInboundConnection (Just connId) + st) ) ) @@ -1454,8 +1454,8 @@ with args@Arguments { , Nothing , OperationSuccess CommitTr , Just (TrUnexpectedlyFalseAssertion - (UnregisterInboundConnection (Just connId) - st) + (ReleaseInboundConnection (Just connId) + st) ) ) @@ -1483,8 +1483,8 @@ with args@Arguments { , Just (mkTransition connState connState') , UnsupportedState st , Just (TrUnexpectedlyFalseAssertion - (UnregisterInboundConnection (Just connId) - st) + (ReleaseInboundConnection (Just connId) + st) ) ) @@ -1497,13 +1497,13 @@ with args@Arguments { , Just (mkTransition connState connState') , UnsupportedState st , Just (TrUnexpectedlyFalseAssertion - (UnregisterInboundConnection (Just connId) - st) + (ReleaseInboundConnection (Just connId) + st) ) ) - -- If 'unregisterOutboundConnection' is called just before - -- 'unregisterInboundConnection', the latter one might observe + -- If 'releaseOutboundConnection' is called just before + -- 'releaseInboundConnection', the latter one might observe -- 'TerminatingState'. TerminatingState _connId _connThread _handleError -> return ( Nothing @@ -1512,7 +1512,7 @@ with args@Arguments { , Nothing ) -- However, 'TerminatedState' should not be observable by - -- 'unregisterInboundConnection', unless 'timeWaitTimeout' is + -- 'releaseInboundConnection', unless 'timeWaitTimeout' is -- close to 'serverProtocolIdleTimeout'. TerminatedState _handleError -> return ( Nothing @@ -1535,14 +1535,14 @@ with args@Arguments { return result - requestOutboundConnectionImpl + acquireOutboundConnectionImpl :: HasCallStack => FreshIdSupply m -> StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m) -> ConnectionHandlerFn handlerTrace socket peerAddr handle handleError (version, versionData) m -> peerAddr -> m (Connected peerAddr handle handleError) - requestOutboundConnectionImpl freshIdSupply stateVar handler peerAddr = do + acquireOutboundConnectionImpl freshIdSupply stateVar handler peerAddr = do let provenance = Outbound traceWith tracer (TrIncludeConnection provenance peerAddr) (trace, mutableConnState@MutableConnState { connVar } @@ -1845,7 +1845,7 @@ with args@Arguments { _ -> return ( Nothing , Just (TrUnexpectedlyFalseAssertion - (RequestOutboundConnection + (AcquireOutboundConnection (Just connId) (abstractState (Known connState)) ) @@ -1975,7 +1975,7 @@ with args@Arguments { -- → OutboundState^\tau Duplex -- @ -- This transition can happen if there are concurrent - -- `includeInboundConnection` and `requestOutboundConnection` + -- `includeInboundConnection` and `acquireOutboundConnection` -- calls. let connState' = OutboundDupState connId connThread handle Ticking writeTVar connVar connState' @@ -2117,20 +2117,20 @@ with args@Arguments { return (Disconnected connId handleErrorM) - unregisterOutboundConnectionImpl + releaseOutboundConnectionImpl :: StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m) -> StrictTVar m StdGen -> peerAddr -> m (OperationResult AbstractState) - unregisterOutboundConnectionImpl stateVar stdGenVar peerAddr = do - traceWith tracer (TrUnregisterConnection Outbound peerAddr) + releaseOutboundConnectionImpl stateVar stdGenVar peerAddr = do + traceWith tracer (TrReleaseConnection Outbound peerAddr) (transition, mbAssertion) <- atomically $ do state <- readTMVar stateVar case Map.lookup peerAddr state of -- if the connection errored, it will remove itself from the state. - -- Calling 'unregisterOutboundConnection' is a no-op in this case. + -- Calling 'releaseOutboundConnection' is a no-op in this case. Nothing -> pure ( DemoteToColdLocalNoop Nothing UnknownConnectionSt , Nothing) @@ -2138,8 +2138,8 @@ with args@Arguments { connState <- readTVar connVar let st = abstractState (Known connState) case connState of - -- In any of the following three states unregistering is not - -- supported. 'requestOutboundConnection' is a synchronous + -- In any of the following three states releaseing is not + -- supported. 'acquireOutboundConnection' is a synchronous -- operation which returns only once the connection is -- negotiated. ReservedOutboundState -> @@ -2240,7 +2240,7 @@ with args@Arguments { if dataFlow == Duplex then Nothing else Just (TrUnexpectedlyFalseAssertion - (UnregisterOutboundConnection + (ReleaseOutboundConnection (Just connId) st) ) @@ -2697,7 +2697,7 @@ withCallStack k = k callStack -- data Trace peerAddr handlerTrace = TrIncludeConnection Provenance peerAddr - | TrUnregisterConnection Provenance peerAddr + | TrReleaseConnection Provenance peerAddr | TrConnect (Maybe peerAddr) -- ^ local address peerAddr -- ^ remote address | TrConnectError (Maybe peerAddr) -- ^ local address diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Types.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Types.hs index d2d1640528..cb981524c9 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Types.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Types.hs @@ -48,7 +48,7 @@ -- * 'InitiatorMode' - could be used on client side of node-to-client -- applications. -- --- The calls 'requestOutboundConnection' and 'includeInboundConnection' return +-- The calls 'acquireOutboundConnection' and 'includeInboundConnection' return -- once a connection has been negotiated. The returned 'handle' contains all -- the information that is needed to start and monitor mini-protocols through -- the mux interface. @@ -113,16 +113,16 @@ module Ouroboros.Network.ConnectionManager.Types , OperationResult (..) , resultInState , DemotedToColdRemoteTr (..) - , RequestOutboundConnection + , AcquireOutboundConnection , IncludeInboundConnection -- *** Outbound side - , requestOutboundConnection + , acquireOutboundConnection , promotedToWarmRemote , demotedToColdRemote - , unregisterOutboundConnection + , releaseOutboundConnection -- *** Inbound side , includeInboundConnection - , unregisterInboundConnection + , releaseInboundConnection , numberOfConnections -- ** Private API -- Includes all constructors required to create a 'ConnectionManager'. @@ -457,7 +457,7 @@ resultInState (OperationSuccess st) = st resultInState (TerminatedConnection st) = st --- | Return value of 'unregisterInboundConnection' to inform the caller about +-- | Return value of 'releaseInboundConnection' to inform the caller about -- the transition. -- data DemotedToColdRemoteTr = @@ -472,7 +472,7 @@ data DemotedToColdRemoteTr = deriving Show --- | Result of 'requestOutboundConnection' or 'includeInboundConnection'. +-- | Result of 'acquireOutboundConnection' or 'includeInboundConnection'. -- data Connected peerAddr handle handleError = -- | We are connected and mux is running. @@ -483,7 +483,7 @@ data Connected peerAddr handle handleError = -- -- /Implementation detail:/ we return @'Maybe' handleError@, rather than -- 'handleError'. In case of an existing inbound connection, the - -- implementation of 'requestOutboundConnection' is awaiting on handshake + -- implementation of 'acquireOutboundConnection' is awaiting on handshake -- through the connection state. The 'TerminatingState' or -- 'TerminatedState' are not only used for handshake errors, but also for -- normal termination, hence the @'Maybe'@. We could await on @@ -493,7 +493,7 @@ data Connected peerAddr handle handleError = | Disconnected !(ConnectionId peerAddr) !(Maybe handleError) -type RequestOutboundConnection peerAddr handle handleError m +type AcquireOutboundConnection peerAddr handle handleError m = peerAddr -> m (Connected peerAddr handle handleError) type IncludeInboundConnection socket peerAddr handle handleError m = Word32 @@ -508,8 +508,8 @@ type IncludeInboundConnection socket peerAddr handle handleError m data OutboundConnectionManager (muxMode :: Mux.Mode) socket peerAddr handle handleError m where OutboundConnectionManager :: HasInitiator muxMode ~ True - => { ocmRequestConnection :: RequestOutboundConnection peerAddr handle handleError m - , ocmUnregisterConnection :: peerAddr -> m (OperationResult AbstractState) + => { ocmAcquireConnection :: AcquireOutboundConnection peerAddr handle handleError m + , ocmReleaseConnection :: peerAddr -> m (OperationResult AbstractState) } -> OutboundConnectionManager muxMode socket peerAddr handle handleError m @@ -522,7 +522,7 @@ data InboundConnectionManager (muxMode :: Mux.Mode) socket peerAddr handle handl InboundConnectionManager :: HasResponder muxMode ~ True => { icmIncludeConnection :: IncludeInboundConnection socket peerAddr handle handleError m - , icmUnregisterConnection :: peerAddr -> m (OperationResult DemotedToColdRemoteTr) + , icmReleaseConnection :: peerAddr -> m (OperationResult DemotedToColdRemoteTr) , icmPromotedToWarmRemote :: peerAddr -> m (OperationResult AbstractState) , icmDemotedToColdRemote :: peerAddr -> m (OperationResult AbstractState) @@ -569,26 +569,26 @@ data ConnectionManager (muxMode :: Mux.Mode) socket peerAddr handle handleError -- * \(Reserve\) to \(Negotiated^{*}_{Outbound}\) transitions -- * \(PromotedToWarm^{Duplex}_{Local}\) transition -- * \(Awake^{Duplex}_{Local}\) transition -requestOutboundConnection +acquireOutboundConnection :: HasInitiator muxMode ~ True => ConnectionManager muxMode socket peerAddr handle handleError m - -> RequestOutboundConnection peerAddr handle handleError m -requestOutboundConnection = - ocmRequestConnection . withInitiatorMode . getConnectionManager + -> AcquireOutboundConnection peerAddr handle handleError m +acquireOutboundConnection = + ocmAcquireConnection . withInitiatorMode . getConnectionManager --- | Unregister outbound connection. +-- | Release outbound connection. -- -- This executes: -- -- * \(DemotedToCold^{*}_{Local}\) transitions -unregisterOutboundConnection +releaseOutboundConnection :: HasInitiator muxMode ~ True => ConnectionManager muxMode socket peerAddr handle handleError m -> peerAddr -> m (OperationResult AbstractState) -- ^ reports the from-state. -unregisterOutboundConnection = - ocmUnregisterConnection . withInitiatorMode . getConnectionManager +releaseOutboundConnection = + ocmReleaseConnection . withInitiatorMode . getConnectionManager -- | Notify the 'ConnectionManager' that a remote end promoted us to a -- /warm peer/. @@ -636,18 +636,18 @@ includeInboundConnection includeInboundConnection = icmIncludeConnection . withResponderMode . getConnectionManager --- | Unregister outbound connection. Returns if the operation was successful. +-- | Release outbound connection. Returns if the operation was successful. -- -- This executes: -- -- * \(Commit*{*}\) transition -- * \(TimeoutExpired\) transition -unregisterInboundConnection +releaseInboundConnection :: HasResponder muxMode ~ True => ConnectionManager muxMode socket peerAddr handle handleError m -> peerAddr -> m (OperationResult DemotedToColdRemoteTr) -unregisterInboundConnection = - icmUnregisterConnection . withResponderMode . getConnectionManager +releaseInboundConnection = + icmReleaseConnection . withResponderMode . getConnectionManager -- | Number of connections tracked by the server. -- @@ -837,9 +837,9 @@ connectionManagerErrorFromException x = do -- one can be sure where the assertion came from as well as the all relevant information. -- data AssertionLocation peerAddr - = UnregisterInboundConnection !(Maybe (ConnectionId peerAddr)) !AbstractState - | RequestOutboundConnection !(Maybe (ConnectionId peerAddr)) !AbstractState - | UnregisterOutboundConnection !(Maybe (ConnectionId peerAddr)) !AbstractState + = ReleaseInboundConnection !(Maybe (ConnectionId peerAddr)) !AbstractState + | AcquireOutboundConnection !(Maybe (ConnectionId peerAddr)) !AbstractState + | ReleaseOutboundConnection !(Maybe (ConnectionId peerAddr)) !AbstractState | PromotedToWarmRemote !(Maybe (ConnectionId peerAddr)) !AbstractState | DemotedToColdRemote !(Maybe (ConnectionId peerAddr)) !AbstractState deriving Show diff --git a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs index 4dcba9ebd0..7651c40ba4 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs @@ -469,8 +469,8 @@ with return (Just connId, state') CommitRemote connId -> do - res <- unregisterInboundConnection connectionManager - (remoteAddress connId) + res <- releaseInboundConnection connectionManager + (remoteAddress connId) traceWith tracer $ TrDemotedToColdRemote connId res case res of UnsupportedState {} -> do diff --git a/ouroboros-network-framework/testlib/Ouroboros/Network/ConnectionManager/Test/Experiments.hs b/ouroboros-network-framework/testlib/Ouroboros/Network/ConnectionManager/Test/Experiments.hs index 7e1a60a834..0116343488 100644 --- a/ouroboros-network-framework/testlib/Ouroboros/Network/ConnectionManager/Test/Experiments.hs +++ b/ouroboros-network-framework/testlib/Ouroboros/Network/ConnectionManager/Test/Experiments.hs @@ -734,8 +734,8 @@ unidirectionalExperiment stdGen timeouts snocket makeBearer confSock socket clie replicateM (numberOfRounds clientAndServerData) (bracket - (requestOutboundConnection connectionManager serverAddr) - (\_ -> unregisterOutboundConnection connectionManager serverAddr) + (acquireOutboundConnection connectionManager serverAddr) + (\_ -> releaseOutboundConnection connectionManager serverAddr) (\connHandle -> do case connHandle of Connected connId _ (Handle mux muxBundle controlBundle _ @@ -831,11 +831,11 @@ bidirectionalExperiment (numberOfRounds clientAndServerData0) (bracket (withLock useLock lock - (requestOutboundConnection + (acquireOutboundConnection connectionManager0 localAddr1)) (\_ -> - unregisterOutboundConnection + releaseOutboundConnection connectionManager0 localAddr1) (\connHandle -> @@ -853,11 +853,11 @@ bidirectionalExperiment (numberOfRounds clientAndServerData1) (bracket (withLock useLock lock - (requestOutboundConnection + (acquireOutboundConnection connectionManager1 localAddr0)) (\_ -> - unregisterOutboundConnection + releaseOutboundConnection connectionManager1 localAddr0) (\connHandle -> diff --git a/ouroboros-network-framework/testlib/Ouroboros/Network/ConnectionManager/Test/Utils.hs b/ouroboros-network-framework/testlib/Ouroboros/Network/ConnectionManager/Test/Utils.hs index 4c1a3de607..ec6e7fe489 100644 --- a/ouroboros-network-framework/testlib/Ouroboros/Network/ConnectionManager/Test/Utils.hs +++ b/ouroboros-network-framework/testlib/Ouroboros/Network/ConnectionManager/Test/Utils.hs @@ -300,7 +300,7 @@ connectionManagerTraceMap -> String connectionManagerTraceMap (TrIncludeConnection p _) = "TrIncludeConnection " ++ show p -connectionManagerTraceMap (TrUnregisterConnection p _) = +connectionManagerTraceMap (TrReleaseConnection p _) = "TrUnregisterConnection " ++ show p connectionManagerTraceMap (TrConnect _ _) = "TrConnect" diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs index c2f25554c6..1247f07b48 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs @@ -728,7 +728,7 @@ withPeerStateActions PeerStateActionsArguments { (newTVarIO PeerCold) (\peerStateVar -> atomically $ writeTVar peerStateVar PeerCold) $ \peerStateVar -> do - res <- requestOutboundConnection spsConnectionManager remotePeerAddr + res <- acquireOutboundConnection spsConnectionManager remotePeerAddr case res of Connected connectionId@ConnectionId { localAddress, remoteAddress } _dataFlow @@ -1041,7 +1041,7 @@ withPeerStateActions PeerStateActionsArguments { -- 'unregisterOutboundConnection' could only fail to demote the peer if -- connection manager would simultaneously promote it, but this is not -- possible. - _ <- unregisterOutboundConnection spsConnectionManager (remoteAddress pchConnectionId) + _ <- releaseOutboundConnection spsConnectionManager (remoteAddress pchConnectionId) wasWarm <- atomically (updateUnlessCoolingOrCold pchPeerStatus PeerCooling) when wasWarm $ traceWith spsTracer (PeerStatusChanged (WarmToCooling pchConnectionId))