inbound-governor: use evaluate . assert

This avoids pure exceptions in io-sim (which can escape).
IntersectMBO · Oct 14, 2021 · 92ff6e4 · 92ff6e4
1 parent 9b59176
commit 92ff6e4
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 6 deletions.
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs
@@ -84,6 +84,7 @@ import qualified Ouroboros.Network.InboundGovernor.ControlChannel as ControlChan
 inboundGovernor :: forall (muxMode :: MuxMode) socket peerAddr versionNumber m a b.
                    ( MonadAsync    m
                    , MonadCatch    m
+                   , MonadEvaluate m
                    , MonadThrow    m
                    , MonadThrow    (STM m)
                    , MonadTime     m
@@ -325,12 +326,12 @@ inboundGovernor tracer serverControlChannel inboundIdleTimeout
           res <- promotedToWarmRemote connectionManager
                                       (remoteAddress connId)
           traceWith tracer (TrPromotedToWarmRemote connId res)
-          assert (resultInState res /= UnknownConnectionSt) $ do
-            let state' = updateRemoteState
-                           connId
-                           RemoteWarm
-                           state
-            inboundGovernorLoop state'
+          _ <- evaluate $ assert (resultInState res /= UnknownConnectionSt)
+          let state' = updateRemoteState
+                         connId
+                         RemoteWarm
+                         state
+          inboundGovernorLoop state'
 
         RemotePromotedToHot connId -> do
           traceWith tracer (TrPromotedToHotRemote connId)

diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Server2.hs b/ouroboros-network-framework/src/Ouroboros/Network/Server2.hs
@@ -107,6 +107,7 @@ data ServerArguments (muxMode  :: MuxMode) socket peerAddr versionNumber bytes m
 run :: forall muxMode socket peerAddr versionNumber m a b.
        ( MonadAsync    m
        , MonadCatch    m
+       , MonadEvaluate m
        , MonadThrow   (STM m)
        , MonadTime     m
        , MonadTimer    m