diff --git a/ouroboros-network-framework/CHANGELOG.md b/ouroboros-network-framework/CHANGELOG.md index 133a82990f3..c8c9219dd89 100644 --- a/ouroboros-network-framework/CHANGELOG.md +++ b/ouroboros-network-framework/CHANGELOG.md @@ -8,6 +8,7 @@ ### Non-breaking changes +* An inbound peer is considered hot if any hot protocol is running. * Split `test` component into `io-tests` and `sim-tests`. * `demo-ping-pong`: improved tracer. * Fixed a bug in `connection-manager` which could result in leaking diff --git a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/Event.hs b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/Event.hs index d2de3fbe60d..93c0f46ea72 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/Event.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/Event.hs @@ -233,8 +233,8 @@ firstPeerPromotedToWarm StatusRunning -> return $ AwakeRemote connId --- | Detect when a first warm peer is promoted to hot (all hot mini-protocols --- run running). +-- | Detect when a first warm peer is promoted to hot (any hot mini-protocols +-- is running). -- firstPeerPromotedToHot :: forall muxMode initiatorCtx peerAddr versionData m a b. ( Alternative (STM m) @@ -246,13 +246,11 @@ firstPeerPromotedToHot = case csRemoteState of RemoteHot -> mempty RemoteWarm -> - lastToFirstM - . fmap (const $ RemotePromotedToHot connId) + fmap (const $ RemotePromotedToHot connId) $ foldMap fn (hotMiniProtocolStateMap connState) RemoteCold -> - lastToFirstM - . fmap (const $ RemotePromotedToHot connId) + fmap (const $ RemotePromotedToHot connId) $ foldMap fn (hotMiniProtocolStateMap connState) RemoteIdle {} -> mempty @@ -276,16 +274,16 @@ firstPeerPromotedToHot ) fn :: STM m MiniProtocolStatus - -> LastToFinishM (STM m) () + -> FirstToFinish (STM m) () fn miniProtocolStatus = - LastToFinishM $ + FirstToFinish $ miniProtocolStatus >>= \case StatusIdle -> retry StatusStartOnDemand -> retry StatusRunning -> return () --- | Detect when a first hot mini-protocols terminates, which triggers the +-- | Detect when all hot mini-protocols terminates, which triggers the -- `RemoteHot → RemoteWarm` transition. -- firstPeerDemotedToWarm :: forall muxMode initiatorCtx peerAddr versionData m a b. @@ -297,6 +295,7 @@ firstPeerDemotedToWarm connId connState@ConnectionState { csRemoteState } = case csRemoteState of RemoteHot -> + lastToFirstM $ RemoteDemotedToWarm connId <$ foldMap fn (hotMiniProtocolStateMap connState) _ -> mempty @@ -320,9 +319,9 @@ firstPeerDemotedToWarm ) fn :: STM m MiniProtocolStatus - -> FirstToFinish (STM m) () + -> LastToFinishM (STM m) () fn miniProtocolStatus = - FirstToFinish $ + LastToFinishM $ miniProtocolStatus >>= \case StatusIdle -> return () StatusStartOnDemand -> return ()