connection-manager: don't blindly override state

When we fork outbound connection handler we need to update the state to `UnnegotiatedState`, but we should not do that blindly. It could happen that the connection broke and was put in `TerminatedState` (or `TerminatingState`) in the meantime by the connection handler thread. This bug was discovered by *IOSimPOR*.
IntersectMBO · Mar 14, 2022 · f21334b · f21334b
1 parent fdbdb26
commit f21334b
Showing 1 changed file with 24 additions and 22 deletions.
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs
@@ -24,7 +24,7 @@ module Ouroboros.Network.ConnectionManager.Core
   ) where
 
 import           Control.Exception (assert)
-import           Control.Monad (forM_, guard, when)
+import           Control.Monad (forM_, guard, when, (>=>))
 import           Control.Monad.Fix
 import           Control.Monad.Class.MonadAsync
 import           Control.Monad.Class.MonadFork (MonadFork, ThreadId, throwTo)
@@ -1663,32 +1663,34 @@ withConnectionManager ConnectionManagerArguments {
             (trans, mbAssertion) <- atomically $ do
               connState <- readTVar connVar
 
-              let assertion = case connState of
-                    ReservedOutboundState ->
-                      Nothing
-                    _                     ->
-                      Just (CM.TrUnexpectedlyFalseAssertion
-                              (RequestOutboundConnection
-                                (Just connId)
-                                (abstractState (Known connState))
-                              )
-                           )
               -- @
               --  Connected : ReservedOutboundState
               --            → UnnegotiatedState Outbound
               -- @
-                  connState' = UnnegotiatedState provenance connId connThread
-              writeTVar connVar connState'
-              return ( mkTransition connState connState'
-                     , assertion
-                     )
-
-            whenJust mbAssertion $ \tr -> do
-              traceWith tracer tr
-              _ <- evaluate (assert False)
-              pure ()
+              case connState of
+                ReservedOutboundState -> do
+                  let connState' = UnnegotiatedState provenance connId connThread
+                  writeTVar connVar connState'
+                  return ( Just $ mkTransition connState connState'
+                         , Nothing
+                         )
+                TerminatingState {} ->
+                  return (Nothing, Nothing)
+                TerminatedState {} ->
+                  return (Nothing, Nothing)
+                _ -> 
+                  return ( Nothing
+                         , Just (CM.TrUnexpectedlyFalseAssertion
+                                   (RequestOutboundConnection
+                                     (Just connId)
+                                     (abstractState (Known connState))
+                                   )
+                                )
+                         )
 
-            traceWith trTracer (TransitionTrace peerAddr trans)
+            traverse_ (traceWith trTracer . TransitionTrace peerAddr) trans
+            traverse_ (traceWith tracer >=> evaluate . assert True)
+                      mbAssertion
             traceCounters stateVar
 
             res <- atomically (readPromise reader)