Merge pull request #4684 from karknu/karknu/inbound_state_trans_m

Change state transitions for inbound cons
IntersectMBO · Oct 25, 2023 · 5fa0feb · 5fa0feb
2 parents 3b63ca5 + 2c7da5b
commit 5fa0feb
Show file tree

Hide file tree

Showing 2 changed files with 11 additions and 11 deletions.
diff --git 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
@@ -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 ()