diff --git a/cardano-client/src/Cardano/Client/Subscription.hs b/cardano-client/src/Cardano/Client/Subscription.hs
index db681647a07..96e5d3402dc 100644
--- a/cardano-client/src/Cardano/Client/Subscription.hs
+++ b/cardano-client/src/Cardano/Client/Subscription.hs
@@ -71,7 +71,9 @@ data Decision =
     -- ^ reconnect
 
 data SubscriptionTracers a = SubscriptionTracers {
-      stMuxTracer          :: Tracer IO (Mx.WithBearer (ConnectionId LocalAddress) MuxTrace),
+      stMuxTracer          :: Tracer IO (Mx.WithBearer (ConnectionId LocalAddress) Mx.Trace),
+      stMuxChannelTracer   :: Tracer IO (Mx.WithBearer (ConnectionId LocalAddress) Mx.ChannelTrace),
+      stMuxBearerTracer    :: Tracer IO (Mx.WithBearer (ConnectionId LocalAddress) Mx.BearerTrace),
       -- ^ low level mux-network tracer, which logs mux sdu (send and received)
       -- and other low level multiplexing events.
       stHandshakeTracer    :: Tracer IO (Mx.WithBearer (ConnectionId LocalAddress)
@@ -110,6 +112,8 @@ subscribe
 subscribe snocket networkMagic supportedVersions
                   SubscriptionTracers {
                     stMuxTracer = muxTracer,
+                    stMuxChannelTracer = muxChannelTracer,
+                    stMuxBearerTracer = muxBearerTracer,
                     stHandshakeTracer = handshakeTracer,
                     stSubscriptionTracer = tracer
                   }
@@ -124,7 +128,12 @@ subscribe snocket networkMagic supportedVersions
         NtC.connectTo
           snocket
           NetworkConnectTracers {
-            nctMuxTracer       = muxTracer,
+            nctMuxTracers =
+              Mx.Tracers {
+                Mx.tracer        = muxTracer,
+                Mx.channelTracer = muxChannelTracer,
+                Mx.bearerTracer  = muxBearerTracer
+              },
             nctHandshakeTracer = handshakeTracer
           }
           (versionedProtocols networkMagic supportedVersions protocols)
diff --git a/cardano-ping/src/Cardano/Network/Ping.hs b/cardano-ping/src/Cardano/Network/Ping.hs
index 6228d2231f2..e472d210d12 100644
--- a/cardano-ping/src/Cardano/Network/Ping.hs
+++ b/cardano-ping/src/Cardano/Network/Ping.hs
@@ -681,9 +681,9 @@ pingClient stdout stderr PingOpts{..} versions peer = bracket
     let peerStr' = TL.pack peerStr
     unless pingOptsQuiet $ TL.hPutStrLn IO.stdout $ peerStr' <> " " <> (showNetworkRtt $ toSample t0_e t0_s)
 
-    bearer <- getBearer makeSocketBearer sduTimeout nullTracer sd Nothing
+    bearer <- getBearer makeSocketBearer sduTimeout sd Nothing
 
-    !t1_s <- write bearer timeoutfn $ wrap handshakeNum InitiatorDir (handshakeReq versions pingOptsHandshakeQuery)
+    !t1_s <- write bearer nullTracer timeoutfn $ wrap handshakeNum InitiatorDir (handshakeReq versions pingOptsHandshakeQuery)
     (msg, !t1_e) <- nextMsg bearer timeoutfn handshakeNum
     unless pingOptsQuiet $ TL.hPutStrLn IO.stdout $ peerStr' <> " " <> (showHandshakeRtt $ diffTime t1_e t1_s)
 
@@ -713,7 +713,7 @@ pingClient stdout stderr PingOpts{..} versions peer = bracket
                  then getTip bearer timeoutfn peerStr
                  else keepAlive bearer timeoutfn peerStr version (tdigest []) 0
               -- send terminating message
-              _ <- write bearer timeoutfn $ wrap keepaliveNum InitiatorDir (keepAliveDone version)
+              _ <- write bearer nullTracer timeoutfn $ wrap keepaliveNum InitiatorDir (keepAliveDone version)
               return ()
             -- protocol idle timeout
             MT.threadDelay idleTimeout
@@ -771,7 +771,7 @@ pingClient stdout stderr PingOpts{..} versions peer = bracket
 
     nextMsg ::  Mx.Bearer IO -> TimeoutFn IO -> MiniProtocolNum -> IO (LBS.ByteString, Time)
     nextMsg bearer timeoutfn ptclNum = do
-      (sdu, t_e) <- Network.Mux.Types.read bearer timeoutfn
+      (sdu, t_e) <- Network.Mux.Types.read bearer nullTracer timeoutfn
       if Mx.mhNum (Mx.msHeader sdu) == ptclNum
         then return (Mx.msBlob sdu, t_e)
         else nextMsg bearer timeoutfn ptclNum
@@ -786,7 +786,7 @@ pingClient stdout stderr PingOpts{..} versions peer = bracket
     keepAlive _ _ _ _ _ cookie | cookie == pingOptsCount = return ()
     keepAlive bearer timeoutfn peerStr version td !cookie = do
       let cookie16 = fromIntegral cookie
-      !t_s <- write bearer timeoutfn $ wrap keepaliveNum InitiatorDir (keepAliveReq version cookie16)
+      !t_s <- write bearer nullTracer timeoutfn $ wrap keepaliveNum InitiatorDir (keepAliveReq version cookie16)
       (!msg, !t_e) <- nextMsg bearer timeoutfn keepaliveNum
       let rtt = toSample t_e t_s
           td' = insert rtt td
@@ -810,7 +810,7 @@ pingClient stdout stderr PingOpts{..} versions peer = bracket
            -> String
            -> IO ()
     getTip bearer timeoutfn peerStr = do
-      !t_s <- write bearer timeoutfn $ wrap chainSyncNum InitiatorDir chainSyncFindIntersect
+      !t_s <- write bearer nullTracer timeoutfn $ wrap chainSyncNum InitiatorDir chainSyncFindIntersect
       (!msg, !t_e) <- nextMsg bearer timeoutfn chainSyncNum
       case CBOR.deserialiseFromBytes chainSyncIntersectNotFoundDec msg of
            Left err -> throwIO (PingClientFindIntersectDeserialiseFailure err peerStr)
diff --git a/docs/network-spec/connection-manager.tex b/docs/network-spec/connection-manager.tex
index ab5c8c25b3e..9b8c7b30161 100644
--- a/docs/network-spec/connection-manager.tex
+++ b/docs/network-spec/connection-manager.tex
@@ -2100,15 +2100,18 @@ \subsubsection{\RemoteIdle}
 connection is used (\warm{} or \hot{}) or not (\cold{}) by the outbound side.
 
 \subsubsection{\RemoteWarm}
-A connection enters \RemoteWarm{} state once any of the mini-protocols starts
-to operate.  Once all hot mini-protocols start, the state will transition to
-\RemoteHot{}.  Note that this is slightly different than the notion of a \warm{}
-peer, for which all \established{} and \warm{} mini-protocols are active, but
-\hot{} ones are idle.
+A connection dwells in \RemoteWarm{} if there are strictly only any warm or established
+responder protocols running. Note also that an established protocol is one that may run
+in both hot and warm states, but cannot be the only type running to maintain hot state
+once all proper hot protocols have terminated. In other words, the connection must be
+demoted in that case.
 
 \subsubsection{\RemoteHot}
-A connection enters \RemoteHot{} transition once all hot protocols started, if
-any of them terminates the connection will be put in \RemoteWarm{}.
+A connection enters \RemoteHot{} state once any hot responder protocol has started.
+In particular, if a hot responder is the first to start, the state cycles through \RemoteWarm{}
+first. Once all hot responders terminate, the connection will be put in \RemoteWarm{} regardless
+of whether there are any warm or established responders left. In the latter case, if there aren't any
+other protocols running, the connection will then follow up with further demotion to \RemoteIdle{}.
 
 \subsection{Transitions}
 
@@ -2166,11 +2169,10 @@ \subsubsection{\MuxTerminated}
 termination of the connection, as it can detect this by itself.
 
 \subsubsection{\PromotedToHotRemote}
-The inbound governor detects when all \hot{} mini-protocols started.   In such
+The inbound governor detects when any \hot{} mini-protocols have started.   In such
 case a \RemoteWarm{} connection is put in \RemoteHot{} state.
 
 \subsubsection{\DemotedToWarmRemote}
-Dually to \PromotedToHotRemote{} state transition, as soon as any of the \hot{}
-mini-protocols terminates, the connection will transition to \RemoteWarm{}
+Dually to \PromotedToHotRemote{} state transition, as soon as all of the \hot{}
+mini-protocols terminate, the connection will transition to \RemoteWarm{}
 state.
-
diff --git a/network-mux/CHANGELOG.md b/network-mux/CHANGELOG.md
index c7cf830553f..b8956f4ade3 100644
--- a/network-mux/CHANGELOG.md
+++ b/network-mux/CHANGELOG.md
@@ -6,6 +6,11 @@
 * Bearer writeMany function for vector IO
 * An optional read buffer for Bearer
 * Polling of the egress queue
+* run, miniProtocolJob, monitor now accept MuxTracerBundle record
+  instead of `Tracer m Trace` type.
+* Removed handshake trace events from mux trace.
+* `Trace` was split into three traces: `Trace` of mux events, `ChannelTrace`
+   & `BearerTrace`.  As a result `run` & `Bearer` API were modified.
 
 ### Non-breaking changes
 * Define msHeaderLength instead of using '8'
diff --git a/network-mux/bench/socket_read_write/Main.hs b/network-mux/bench/socket_read_write/Main.hs
index e933ef93526..c3247f025dc 100644
--- a/network-mux/bench/socket_read_write/Main.hs
+++ b/network-mux/bench/socket_read_write/Main.hs
@@ -52,9 +52,9 @@ readBenchmark sndSizeV sndSize addr = do
       atomically $ putTMVar sndSizeV sndSize
       Socket.connect sd addr
       withReadBufferIO (\buffer -> do
-        bearer <- getBearer makeSocketBearer sduTimeout activeTracer sd buffer
+        bearer <- getBearer makeSocketBearer sduTimeout sd buffer
 
-        let chan = bearerAsChannel bearer (MiniProtocolNum 42) InitiatorDir
+        let chan = bearerAsChannel activeTracer bearer (MiniProtocolNum 42) InitiatorDir
         doRead chan 0
        )
     )
@@ -79,9 +79,9 @@ readDemuxerQueueBenchmark sndSizeV sndSize addr = do
 
       Socket.connect sd addr
       withReadBufferIO (\buffer -> do
-        bearer <- getBearer makeSocketBearer sduTimeout activeTracer sd buffer
+        bearer <- getBearer makeSocketBearer sduTimeout sd buffer
         ms42 <- mkMiniProtocolState 42
-        withAsync (demuxer [ms42] bearer) $ \aid -> do
+        withAsync (demuxer [ms42] activeTracer bearer) $ \aid -> do
           doRead 0xa5 (totalPayloadLen sndSize) (miniProtocolIngressQueue ms42)
           cancel aid
        )
@@ -111,10 +111,10 @@ readDemuxerBenchmark sndSizeV sndSize addr = do
 
       Socket.connect sd addr
       withReadBufferIO (\buffer -> do
-        bearer <- getBearer makeSocketBearer sduTimeout activeTracer sd buffer
+        bearer <- getBearer makeSocketBearer sduTimeout sd buffer
         ms42 <- mkMiniProtocolState 42
         ms41 <- mkMiniProtocolState 41
-        withAsync (demuxer [ms41, ms42] bearer) $ \aid -> do
+        withAsync (demuxer [ms41, ms42] activeTracer bearer) $ \aid -> do
           withAsync (doRead 42 (totalPayloadLen sndSize) (miniProtocolIngressQueue ms42) 0) $ \aid42 -> do
             withAsync (doRead 41 (totalPayloadLen 10) (miniProtocolIngressQueue ms41) 0) $ \aid41 -> do
               _ <- waitBoth aid42 aid41
@@ -151,10 +151,10 @@ startServer :: StrictTMVar IO Int64 -> Socket -> IO ()
 startServer sndSizeV ad = forever $ do
     (sd, _) <- Socket.accept ad
     withReadBufferIO (\buffer -> do
-      bearer <- getBearer makeSocketBearer sduTimeout activeTracer sd buffer
+      bearer <- getBearer makeSocketBearer sduTimeout sd buffer
       sndSize <- atomically $ takeTMVar sndSizeV
 
-      let chan = bearerAsChannel bearer (MiniProtocolNum 42) ResponderDir
+      let chan = bearerAsChannel activeTracer bearer (MiniProtocolNum 42) ResponderDir
           payload = BL.replicate sndSize 0xa5
           maxData = totalPayloadLen sndSize
           numberOfSdus = fromIntegral $ maxData `div` sndSize
@@ -167,7 +167,7 @@ startServerMany :: StrictTMVar IO Int64 -> Socket -> IO ()
 startServerMany sndSizeV ad = forever $ do
     (sd, _) <- Socket.accept ad
     withReadBufferIO (\buffer -> do
-      bearer <- getBearer makeSocketBearer sduTimeout activeTracer sd buffer
+      bearer <- getBearer makeSocketBearer sduTimeout sd buffer
       sndSize <- atomically $ takeTMVar sndSizeV
 
       let maxData = totalPayloadLen sndSize
@@ -178,10 +178,10 @@ startServerMany sndSizeV ad = forever $ do
       withTimeoutSerial $ \timeoutFn -> do
         replicateM_ numberOfCalls $ do
           let sdus = replicate 10 $ wrap $ BL.replicate sndSize 0xa5
-          void $ writeMany bearer timeoutFn sdus
+          void $ writeMany bearer activeTracer timeoutFn sdus
         when (runtSdus > 0) $ do
           let sdus = replicate runtSdus $ wrap $ BL.replicate sndSize 0xa5
-          void $ writeMany bearer timeoutFn sdus
+          void $ writeMany bearer activeTracer timeoutFn sdus
      )
  where
   -- wrap a 'ByteString' as 'SDU'
@@ -205,7 +205,7 @@ startServerEgresss :: StrictTMVar IO Int64 -> Socket -> IO ()
 startServerEgresss sndSizeV ad = forever $ do
     (sd, _) <- Socket.accept ad
     withReadBufferIO (\buffer -> do
-      bearer <-getBearer makeSocketBearer sduTimeout activeTracer sd buffer
+      bearer <-getBearer makeSocketBearer sduTimeout sd buffer
       sndSize <- atomically $ takeTMVar sndSizeV
       eq <- atomically $ newTBQueue 100
       w42 <- newTVarIO BL.empty
@@ -216,7 +216,7 @@ startServerEgresss sndSizeV ad = forever $ do
           numberOfCalls = numberOfSdus `div` 10 :: Int
           runtSdus = numberOfSdus `mod` 10 :: Int
 
-      withAsync (muxer eq bearer) $ \aid -> do
+      withAsync (muxer eq activeTracer bearer) $ \aid -> do
 
         replicateM_ numberOfCalls $ do
           let payload42s = replicate 10 $ BL.replicate sndSize 42
diff --git a/network-mux/demo/mux-demo.hs b/network-mux/demo/mux-demo.hs
index aefde5e8432..8c17cb7bcaa 100644
--- a/network-mux/demo/mux-demo.hs
+++ b/network-mux/demo/mux-demo.hs
@@ -17,7 +17,7 @@ import Control.Concurrent (forkIO)
 import Control.Concurrent.STM (atomically)
 import Control.Exception (finally)
 import Control.Monad
-import Control.Tracer (Tracer (..), nullTracer, showTracing)
+import Control.Tracer (Tracer (..), showTracing)
 
 import System.Environment qualified as SysEnv
 import System.Exit
@@ -101,7 +101,7 @@ server =
     associateWithIOManager ioManager (Left hpipe)
     Win32.Async.connectNamedPipe hpipe
     void $ forkIO $ do
-      bearer <- getBearer Mx.makeNamedPipeBearer (-1) nullTracer hpipe Nothing
+      bearer <- getBearer Mx.makeNamedPipeBearer (-1) hpipe Nothing
       serverWorker bearer
         `finally` closeHandle hpipe
 #else
@@ -113,7 +113,7 @@ server = do
     forever $ do
       (sock', _addr) <- Socket.accept sock
       void $ forkIO $ do
-        bearer <- getBearer Mx.makeSocketBearer 1.0 nullTracer sock' Nothing
+        bearer <- getBearer Mx.makeSocketBearer 1.0 sock' Nothing
         serverWorker bearer
           `finally` Socket.close sock'
 #endif
@@ -133,7 +133,7 @@ serverWorker bearer = do
       putStrLn $ "Result: " ++ show result
       Mx.stop mux
 
-    Mx.run nullTracer mux bearer
+    Mx.run Mx.nullTracers mux bearer
   where
     ptcls :: [MiniProtocolInfo ResponderMode]
     ptcls = [ MiniProtocolInfo {
@@ -168,13 +168,13 @@ client n msg =
                         fILE_FLAG_OVERLAPPED
                         Nothing
     associateWithIOManager ioManager (Left hpipe)
-    bearer <- getBearer Mx.makeNamedPipeBearer (-1) nullTracer hpipe Nothing
+    bearer <- getBearer Mx.makeNamedPipeBearer (-1) hpipe Nothing
     clientWorker bearer n msg
 #else
 client n msg = do
     sock <- Socket.socket AF_UNIX Socket.Stream Socket.defaultProtocol
     Socket.connect sock (SockAddrUnix pipeName)
-    bearer <- getBearer Mx.makeSocketBearer 1.0 nullTracer sock Nothing
+    bearer <- getBearer Mx.makeSocketBearer 1.0 sock Nothing
     clientWorker bearer n msg
 #endif
 
@@ -193,7 +193,7 @@ clientWorker bearer n msg = do
       putStrLn $ "Result: " ++ show result
       Mx.stop mux
 
-    Mx.run nullTracer mux bearer
+    Mx.run Mx.nullTracers mux bearer
   where
     ptcls :: [MiniProtocolInfo Mx.InitiatorMode]
     ptcls = [ MiniProtocolInfo {
diff --git a/network-mux/src/Network/Mux.hs b/network-mux/src/Network/Mux.hs
index 26e7d6fd7ff..f21d27ba3b7 100644
--- a/network-mux/src/Network/Mux.hs
+++ b/network-mux/src/Network/Mux.hs
@@ -42,10 +42,18 @@ module Network.Mux
   , Error (..)
   , RuntimeError (..)
     -- * Tracing
-  , traceBearerState
-  , BearerState (..)
+  , Tracers' (..)
+  , Tracers
+  , nullTracers
+  , contramapTracers'
   , Trace (..)
+  , BearerTrace (..)
+  , ChannelTrace (..)
+  , State (..)
+  , traceBearerState
   , WithBearer (..)
+  , TracersWithBearer
+  , tracersWithBearer
   ) where
 
 import Data.ByteString.Builder (lazyByteString, toLazyByteString)
@@ -212,11 +220,13 @@ run :: forall m (mode :: Mode).
        , MonadTimer m
        , MonadMask m
        )
-    => Tracer m Trace
+    => Tracers m
     -> Mux mode m
     -> Bearer m
     -> m ()
-run tracer
+run tracers@TracersI { tracer_,
+                       bearerTracer_
+                     }
     Mux { muxMiniProtocols,
           muxControlCmdQueue,
           muxStatus
@@ -233,12 +243,15 @@ run tracer
       (\jobpool -> do
         JobPool.forkJob jobpool (muxerJob egressQueue)
         JobPool.forkJob jobpool demuxerJob
-        traceWith tracer (TraceState Mature)
+        -- for inbound and outbound duplex modes,
+        -- this call blocks the muxer until the CM
+        -- notifies the IG of the new connection.
+        traceWith tracer_ (TraceState Mature)
 
         -- Wait for someone to shut us down by calling muxStop or an error.
         -- Outstanding jobs are shut down Upon completion of withJobPool.
         withTimeoutSerial $ \timeout ->
-          monitor tracer
+          monitor tracers
                   timeout
                   jobpool
                   egressQueue
@@ -249,17 +262,22 @@ run tracer
     -- an exception.  Setting 'muxStatus' is necessary to resolve a possible
     -- deadlock of mini-protocol completion action.
     `catch` \(SomeAsyncException e) -> do
-      atomically $ writeTVar muxStatus (Failed $ toException e)
-      throwIO e
+       atomically $ writeTVar muxStatus (Failed $ toException e)
+       case (fromException $ toException e :: Maybe ColdBlooded) of
+         Just _      -> pure () -- ^ do not write to IG info queue to avoid getting stuck
+                           -- when pulling the rug
+         _otherAsync -> traceWith tracer_ (TraceState Dead)
+       throwIO e
   where
+
     muxerJob egressQueue =
-      JobPool.Job (muxer egressQueue bearer)
+      JobPool.Job (muxer egressQueue bearerTracer_ bearer)
                   (return . MuxerException)
                   MuxJob
                   (name ++ "-muxer")
 
     demuxerJob =
-      JobPool.Job (demuxer (Map.elems muxMiniProtocols) bearer)
+      JobPool.Job (demuxer (Map.elems muxMiniProtocols) bearerTracer_ bearer)
                   (return . DemuxerException)
                   MuxJob
                   (name ++ "-demuxer")
@@ -272,12 +290,16 @@ miniProtocolJob
      , MonadThread m
      , MonadThrow (STM m)
      )
-  => Tracer m Trace
+  => Tracers m
   -> EgressQueue m
   -> MiniProtocolState mode m
   -> MiniProtocolAction m
   -> JobPool.Job Group m JobResult
-miniProtocolJob tracer egressQueue
+miniProtocolJob TracersI {
+                  tracer_,
+                  channelTracer_
+                }
+                egressQueue
                 MiniProtocolState {
                   miniProtocolInfo =
                     MiniProtocolInfo {
@@ -300,11 +322,11 @@ miniProtocolJob tracer egressQueue
       labelThisThread (case miniProtocolNum of
                         MiniProtocolNum a -> "prtcl-" ++ show a)
       w <- newTVarIO BL.empty
-      let chan = muxChannel tracer egressQueue (Wanton w)
+      let chan = muxChannel channelTracer_ egressQueue (Wanton w)
                             miniProtocolNum miniProtocolDirEnum
                             miniProtocolIngressQueue
       (result, remainder) <- miniProtocolAction chan
-      traceWith tracer (TraceTerminating miniProtocolNum miniProtocolDirEnum)
+      traceWith tracer_ (TraceTerminating miniProtocolNum miniProtocolDirEnum)
       atomically $ do
         -- The Wanton w is the SDUs that are queued but not yet sent for this job.
         -- Job threads will be prevented from exiting until all their SDUs have been
@@ -317,7 +339,7 @@ miniProtocolJob tracer egressQueue
         case remainder of
           Just trailing ->
             modifyTVar miniProtocolIngressQueue (\(l, b) ->
-              (l + BL.length trailing, b <> (lazyByteString trailing)))
+              (l + BL.length trailing, b <> lazyByteString trailing))
           Nothing ->
             pure ()
 
@@ -383,6 +405,11 @@ data MonitorCtx m mode = MonitorCtx {
 --  1. It waits for mini-protocol threads to terminate.
 --  2. It starts responder protocol threads on demand when the first
 --     incoming message arrives.
+--  3. For outbound duplex and inbound bearers, it has a back
+--     channel to the inbound governor hidden in the tracer,
+--     informing it of mux start/stop and miniprotocol
+--     exits/terminations such that the IG can perform an
+--     efficient and proper accounting of peer transitions.
 --
 monitor :: forall mode m.
            ( MonadAsync m
@@ -390,14 +417,21 @@ monitor :: forall mode m.
            , Alternative (STM m)
            , MonadThrow (STM m)
            )
-        => Tracer m Trace
+        => Tracers m
         -> TimeoutFn m
         -> JobPool.JobPool Group m JobResult
         -> EgressQueue m
         -> StrictTQueue m (ControlCmd mode m)
         -> StrictTVar m Status
         -> m ()
-monitor tracer timeout jobpool egressQueue cmdQueue muxStatus =
+monitor tracers@TracersI {
+          tracer_       = tracer,
+          bearerTracer_ = bearerTracer
+        }
+        timeout jobpool egressQueue cmdQueue muxStatus =
+    -- the tracer may be hooked into the inbound governor
+    -- for inbound or outbound duplex connections, so care
+    -- should be excercised when ordering traces.
     go (MonitorCtx Map.empty Map.empty)
   where
     go :: MonitorCtx m mode -> m ()
@@ -430,12 +464,16 @@ monitor tracer timeout jobpool egressQueue cmdQueue muxStatus =
         -- Protocols that runs to completion are not automatically restarted.
         EventJobResult (MiniProtocolShutdown pnum pmode) -> do
           traceWith tracer (TraceCleanExit pnum pmode)
+          traceWith bearerTracer TraceEmitDeltaQ
           go monitorCtx
 
         EventJobResult (MiniProtocolException pnum pmode e) -> do
-          traceWith tracer (TraceState Dead)
-          traceWith tracer (TraceExceptionExit pnum pmode e)
+          -- this order of traces is significant for IG information
+          -- channel tracer which may be embedded with the tracer
           atomically $ writeTVar muxStatus $ Failed e
+          traceWith tracer (TraceExceptionExit pnum pmode e)
+          traceWith tracer (TraceState Dead)
+          traceWith bearerTracer TraceEmitDeltaQ
           throwIO e
 
         -- These two cover internal and protocol errors.  The muxer exception is
@@ -447,11 +485,10 @@ monitor tracer timeout jobpool egressQueue cmdQueue muxStatus =
         -- the source of the failure, e.g. specific mini-protocol. If we're
         -- propagating exceptions, we don't need to log them.
         EventJobResult (MuxerException e) -> do
-          traceWith tracer (TraceState Dead)
           atomically $ writeTVar muxStatus $ Failed e
+          traceWith tracer (TraceState Dead)
           throwIO e
         EventJobResult (DemuxerException e) -> do
-          traceWith tracer (TraceState Dead)
           r <- atomically $ do
             size <- JobPool.readGroupSize jobpool MiniProtocolJob
             case size of
@@ -460,6 +497,7 @@ monitor tracer timeout jobpool egressQueue cmdQueue muxStatus =
                 >> return True
               _ -> writeTVar muxStatus (Failed e)
                 >> return False
+          traceWith tracer (TraceState Dead)
           unless r (throwIO e)
 
         EventControlCmd (CmdStartProtocolThread
@@ -478,14 +516,14 @@ monitor tracer timeout jobpool egressQueue cmdQueue muxStatus =
             Nothing ->
               JobPool.forkJob jobpool $
                 miniProtocolJob
-                  tracer
+                  tracers
                   egressQueue
                   ptclState
                   ptclAction
             Just cap ->
               JobPool.forkJobOn cap jobpool $
                 miniProtocolJob
-                  tracer
+                  tracers
                   egressQueue
                   ptclState
                   ptclAction
@@ -585,14 +623,14 @@ monitor tracer timeout jobpool egressQueue cmdQueue muxStatus =
         Nothing ->
           JobPool.forkJob jobpool $
             miniProtocolJob
-              tracer
+              tracers
               egressQueue
               ptclState
               ptclAction
         Just cap ->
           JobPool.forkJobOn cap jobpool $
             miniProtocolJob
-              tracer
+              tracers
               egressQueue
               ptclState
               ptclAction
@@ -646,7 +684,7 @@ muxChannel
     :: forall m.
        ( MonadSTM m
        )
-    => Tracer m Trace
+    => Tracer m ChannelTrace
     -> EgressQueue m
     -> Wanton m
     -> MiniProtocolNum
@@ -654,7 +692,7 @@ muxChannel
     -> IngressQueue m
     -> ByteChannel m
 muxChannel tracer egressQueue want@(Wanton w) mc md q =
-    Channel { send, recv}
+    Channel { send, recv }
   where
     -- Limit for the message buffer between send and mux thread.
     perMiniProtocolBufferSize :: Int64
@@ -693,7 +731,7 @@ muxChannel tracer egressQueue want@(Wanton w) mc md q =
         traceWith tracer $ TraceChannelRecvEnd mc (fromIntegral $ BL.length blob)
         return $ Just blob
 
-traceBearerState :: Tracer m Trace -> BearerState -> m ()
+traceBearerState :: Tracer m Trace -> State -> m ()
 traceBearerState tracer state =
     traceWith tracer (TraceState state)
 
@@ -797,4 +835,3 @@ runMiniProtocol Mux { muxMiniProtocols, muxControlCmdQueue , muxStatus}
                    <|> return (Left $ toException (Shutdown Nothing st))
            Failed e -> readTMVar completionVar
                    <|> return (Left $ toException (Shutdown (Just e) st))
-
diff --git a/network-mux/src/Network/Mux/Bearer.hs b/network-mux/src/Network/Mux/Bearer.hs
index b2a85e2ed48..284c1254267 100644
--- a/network-mux/src/Network/Mux/Bearer.hs
+++ b/network-mux/src/Network/Mux/Bearer.hs
@@ -9,6 +9,7 @@
 module Network.Mux.Bearer
   ( Bearer (..)
   , MakeBearer (..)
+  , BearerTrace (..)
   , makeSocketBearer
   , makePipeChannelBearer
   , makeQueueChannelBearer
@@ -22,7 +23,6 @@ import           Control.Monad.Class.MonadSTM
 import           Control.Concurrent.Class.MonadSTM.Strict
 import           Control.Monad.Class.MonadThrow
 import           Control.Monad.Class.MonadTime.SI
-import           Control.Tracer (Tracer)
 
 import           Data.ByteString.Lazy qualified as BL
 import           Network.Socket (Socket)
@@ -45,8 +45,6 @@ newtype MakeBearer m fd = MakeBearer {
       :: DiffTime
       -- timeout for reading an SDU segment, if negative no
       -- timeout is applied.
-      -> Tracer m Trace
-      -- tracer
       -> fd
       -- file descriptor
       -> Maybe (ReadBuffer m)
@@ -55,14 +53,14 @@ newtype MakeBearer m fd = MakeBearer {
   }
 
 pureBearer :: Applicative m
-           => (DiffTime -> Tracer m Trace -> fd -> Maybe (ReadBuffer m) ->   Bearer m)
-           ->  DiffTime -> Tracer m Trace -> fd -> Maybe (ReadBuffer m) -> m (Bearer m)
-pureBearer f = \sduTimeout rb tr fd -> pure (f sduTimeout rb tr fd)
+           => (DiffTime -> fd -> Maybe (ReadBuffer m) ->    Bearer m)
+           ->  DiffTime -> fd -> Maybe (ReadBuffer m) -> m (Bearer m)
+pureBearer f = \sduTimeout rb fd -> pure (f sduTimeout rb fd)
 
 
 makeSocketBearer :: MakeBearer IO Socket
-makeSocketBearer = MakeBearer $ (\sduTimeout tr fd rb -> do
-    return $ socketAsBearer size batch rb sduTimeout tr fd)
+makeSocketBearer = MakeBearer $ \sduTimeout fd rb ->
+    return $ socketAsBearer size batch rb sduTimeout fd
   where
     size = SDUSize 12_288
     batch = 131_072
@@ -70,7 +68,7 @@ makeSocketBearer = MakeBearer $ (\sduTimeout tr fd rb -> do
 withReadBufferIO :: (Maybe (ReadBuffer IO) -> IO b)
                  -> IO b
 withReadBufferIO f = allocaBytesAligned size 8 $ \ptr -> do
-    v <- atomically $ newTVar BL.empty
+    v <- newTVarIO BL.empty
     f $ Just $ ReadBuffer v ptr size
   where
     -- Maximum amount of data read in one call.
@@ -80,7 +78,7 @@ withReadBufferIO f = allocaBytesAligned size 8 $ \ptr -> do
     size = 131_072
 
 makePipeChannelBearer :: MakeBearer IO PipeChannel
-makePipeChannelBearer = MakeBearer $ pureBearer (\_ tr fd _ -> pipeAsBearer size tr fd)
+makePipeChannelBearer = MakeBearer $ pureBearer (\_ fd _ -> pipeAsBearer size fd)
   where
     size = SDUSize 32_768
 
@@ -89,13 +87,13 @@ makeQueueChannelBearer :: ( MonadSTM   m
                           , MonadThrow m
                           )
                        => MakeBearer m (QueueChannel m)
-makeQueueChannelBearer = MakeBearer $ pureBearer (\_ tr q _-> queueChannelAsBearer size tr q)
+makeQueueChannelBearer = MakeBearer $ pureBearer (\_ q _ -> queueChannelAsBearer size q)
   where
     size = SDUSize 1_280
 
 #if defined(mingw32_HOST_OS)
 makeNamedPipeBearer :: MakeBearer IO HANDLE
-makeNamedPipeBearer = MakeBearer $ pureBearer (\_ tr fd _-> namedPipeAsBearer size tr fd)
+makeNamedPipeBearer = MakeBearer $ pureBearer (\_ fd _tr -> namedPipeAsBearer size fd)
   where
     size = SDUSize 24_576
 #endif
diff --git a/network-mux/src/Network/Mux/Bearer/AttenuatedChannel.hs b/network-mux/src/Network/Mux/Bearer/AttenuatedChannel.hs
index d1e756d88c6..801c05f5dad 100644
--- a/network-mux/src/Network/Mux/Bearer/AttenuatedChannel.hs
+++ b/network-mux/src/Network/Mux/Bearer/AttenuatedChannel.hs
@@ -268,10 +268,9 @@ attenuationChannelAsBearer :: forall m.
                               )
                            => SDUSize
                            -> DiffTime
-                           -> Tracer m Trace
                            -> AttenuatedChannel m
                            -> Bearer m
-attenuationChannelAsBearer sduSize sduTimeout muxTracer chan =
+attenuationChannelAsBearer sduSize sduTimeout chan =
     Bearer {
       read      = readMux,
       write     = writeMux,
@@ -281,13 +280,13 @@ attenuationChannelAsBearer sduSize sduTimeout muxTracer chan =
       name      = "attenuation-channel"
     }
   where
-    readMux :: TimeoutFn m -> m (SDU, Time)
-    readMux timeoutFn = do
-      traceWith muxTracer TraceRecvHeaderStart
+    readMux :: Tracer m BearerTrace -> TimeoutFn m -> m (SDU, Time)
+    readMux tracer timeoutFn = do
+      traceWith tracer TraceRecvHeaderStart
       mbuf <- timeoutFn sduTimeout $ acRead chan
       case mbuf of
         Nothing -> do
-          traceWith muxTracer TraceSDUReadTimeoutException
+          traceWith tracer TraceSDUReadTimeoutException
           throwIO SDUReadTimeout
 
         Just buf -> do
@@ -296,27 +295,27 @@ attenuationChannelAsBearer sduSize sduTimeout muxTracer chan =
             Left  e      -> throwIO e
             Right muxsdu -> do
               let header = msHeader muxsdu
-              traceWith muxTracer $ TraceRecvHeaderEnd header
+              traceWith tracer $ TraceRecvHeaderEnd header
               ts <- getMonotonicTime
-              traceWith muxTracer $ TraceRecvDeltaQObservation header ts
+              traceWith tracer $ TraceRecvDeltaQObservation header ts
               return (muxsdu {msBlob = payload}, ts)
 
-    writeMux :: TimeoutFn m -> SDU -> m Time
-    writeMux _ sdu = do
+    writeMux :: Tracer m BearerTrace -> TimeoutFn m -> SDU -> m Time
+    writeMux tracer _ sdu = do
       ts <- getMonotonicTime
       let ts32 = timestampMicrosecondsLow32Bits ts
           sdu' = setTimestamp sdu (RemoteClockModel ts32)
           buf  = encodeSDU sdu'
-      traceWith muxTracer $ TraceSendStart (msHeader sdu')
+      traceWith tracer $ TraceSendStart (msHeader sdu')
       acWrite chan buf
 
-      traceWith muxTracer TraceSendEnd
+      traceWith tracer TraceSendEnd
       return ts
 
-    writeMuxMany :: TimeoutFn m -> [SDU] -> m Time
-    writeMuxMany timeoutFn sdus = do
+    writeMuxMany :: Tracer m BearerTrace -> TimeoutFn m -> [SDU] -> m Time
+    writeMuxMany tracer timeoutFn sdus = do
       ts <- getMonotonicTime
-      mapM_ (writeMux timeoutFn) sdus
+      mapM_ (writeMux tracer timeoutFn) sdus
       return ts
 
 --
diff --git a/network-mux/src/Network/Mux/Bearer/Pipe.hs b/network-mux/src/Network/Mux/Bearer/Pipe.hs
index 174d0f302fb..71889218dcc 100644
--- a/network-mux/src/Network/Mux/Bearer/Pipe.hs
+++ b/network-mux/src/Network/Mux/Bearer/Pipe.hs
@@ -70,10 +70,9 @@ pipeChannelFromNamedPipe h = PipeChannel {
 
 pipeAsBearer
   :: Mx.SDUSize
-  -> Tracer IO Mx.Trace
   -> PipeChannel
   -> Bearer IO
-pipeAsBearer sduSize tracer channel =
+pipeAsBearer sduSize channel =
       Mx.Bearer {
           Mx.read      = readPipe,
           Mx.write     = writePipe,
@@ -83,8 +82,8 @@ pipeAsBearer sduSize tracer channel =
           Mx.batchSize = fromIntegral $ Mx.getSDUSize sduSize
         }
     where
-      readPipe :: Mx.TimeoutFn IO -> IO (Mx.SDU, Time)
-      readPipe _ = do
+      readPipe :: Tracer IO Mx.BearerTrace -> Mx.TimeoutFn IO -> IO (Mx.SDU, Time)
+      readPipe tracer _ = do
           traceWith tracer Mx.TraceRecvHeaderStart
           hbuf <- recvLen' (fromIntegral Mx.msHeaderLength) []
           case Mx.decodeSDU hbuf of
@@ -95,21 +94,21 @@ pipeAsBearer sduSize tracer channel =
                   ts <- getMonotonicTime
                   traceWith tracer (Mx.TraceRecvDeltaQObservation msHeader ts)
                   return (header {Mx.msBlob = blob}, ts)
+        where
+          recvLen' :: Int -> [BL.ByteString] -> IO BL.ByteString
+          recvLen' 0 bufs = return $ BL.concat $ reverse bufs
+          recvLen' l bufs = do
+              traceWith tracer $ Mx.TraceRecvStart l
+              buf <- readHandle channel l
+                        `catch` Mx.handleIOException "readHandle errored"
+              if BL.null buf
+                  then throwIO $ Mx.BearerClosed "Pipe closed when reading data"
+                  else do
+                      traceWith tracer $ Mx.TraceRecvEnd (fromIntegral $ BL.length buf)
+                      recvLen' (l - fromIntegral (BL.length buf)) (buf : bufs)
 
-      recvLen' :: Int -> [BL.ByteString] -> IO BL.ByteString
-      recvLen' 0 bufs = return $ BL.concat $ reverse bufs
-      recvLen' l bufs = do
-          traceWith tracer $ Mx.TraceRecvStart l
-          buf <- readHandle channel l
-                    `catch` Mx.handleIOException "readHandle errored"
-          if BL.null buf
-              then throwIO $ Mx.BearerClosed "Pipe closed when reading data"
-              else do
-                  traceWith tracer $ Mx.TraceRecvEnd (fromIntegral $ BL.length buf)
-                  recvLen' (l - fromIntegral (BL.length buf)) (buf : bufs)
-
-      writePipe :: Mx.TimeoutFn IO -> Mx.SDU -> IO Time
-      writePipe _ sdu = do
+      writePipe :: Tracer IO Mx.BearerTrace -> Mx.TimeoutFn IO -> Mx.SDU -> IO Time
+      writePipe tracer _ sdu = do
           ts <- getMonotonicTime
           let ts32 = Mx.timestampMicrosecondsLow32Bits ts
               sdu' = Mx.setTimestamp sdu (Mx.RemoteClockModel ts32)
@@ -120,9 +119,9 @@ pipeAsBearer sduSize tracer channel =
           traceWith tracer Mx.TraceSendEnd
           return ts
 
-      writePipeMany :: Mx.TimeoutFn IO -> [Mx.SDU] -> IO Time
-      writePipeMany timeoutFn sdus = do
+      writePipeMany :: Tracer IO Mx.BearerTrace -> Mx.TimeoutFn IO -> [Mx.SDU] -> IO Time
+      writePipeMany tracer timeoutFn sdus = do
         ts <- getMonotonicTime
-        mapM_ (writePipe timeoutFn) sdus
+        mapM_ (writePipe tracer timeoutFn) sdus
         return ts
 
diff --git a/network-mux/src/Network/Mux/Bearer/Queues.hs b/network-mux/src/Network/Mux/Bearer/Queues.hs
index 29c7769eef1..0e3253836ad 100644
--- a/network-mux/src/Network/Mux/Bearer/Queues.hs
+++ b/network-mux/src/Network/Mux/Bearer/Queues.hs
@@ -35,21 +35,20 @@ queueChannelAsBearer
      , MonadThrow m
      )
   => Mx.SDUSize
-  -> Tracer m Mx.Trace
   -> QueueChannel m
   -> Bearer m
-queueChannelAsBearer sduSize tracer QueueChannel { writeQueue, readQueue } = do
+queueChannelAsBearer sduSize QueueChannel { writeQueue, readQueue } = do
       Mx.Bearer {
         Mx.read      = readMux,
         Mx.write     = writeMux,
         Mx.writeMany = writeMuxMany,
         Mx.sduSize   = sduSize,
-        Mx.batchSize = 2 * (fromIntegral $ Mx.getSDUSize sduSize),
+        Mx.batchSize = 2 * fromIntegral (Mx.getSDUSize sduSize),
         Mx.name      = "queue-channel"
       }
     where
-      readMux :: Mx.TimeoutFn m -> m (Mx.SDU, Time)
-      readMux _ = do
+      readMux :: Tracer m Mx.BearerTrace -> Mx.TimeoutFn m -> m (Mx.SDU, Time)
+      readMux tracer _ = do
           traceWith tracer Mx.TraceRecvHeaderStart
           buf <- atomically $ readTBQueue readQueue
           let (hbuf, payload) = BL.splitAt 8 buf
@@ -61,8 +60,8 @@ queueChannelAsBearer sduSize tracer QueueChannel { writeQueue, readQueue } = do
                   traceWith tracer $ Mx.TraceRecvDeltaQObservation (Mx.msHeader header) ts
                   return (header {Mx.msBlob = payload}, ts)
 
-      writeMux :: Mx.TimeoutFn m -> Mx.SDU -> m Time
-      writeMux _ sdu = do
+      writeMux :: Tracer m Mx.BearerTrace -> Mx.TimeoutFn m -> Mx.SDU -> m Time
+      writeMux tracer _ sdu = do
           ts <- getMonotonicTime
           let ts32 = Mx.timestampMicrosecondsLow32Bits ts
               sdu' = Mx.setTimestamp sdu (Mx.RemoteClockModel ts32)
@@ -72,9 +71,9 @@ queueChannelAsBearer sduSize tracer QueueChannel { writeQueue, readQueue } = do
           traceWith tracer Mx.TraceSendEnd
           return ts
 
-      writeMuxMany :: Mx.TimeoutFn m -> [Mx.SDU] -> m Time
-      writeMuxMany timeoutFn sdus = do
+      writeMuxMany :: Tracer m Mx.BearerTrace -> Mx.TimeoutFn m -> [Mx.SDU] -> m Time
+      writeMuxMany tracer timeoutFn sdus = do
         ts <- getMonotonicTime
-        mapM_ (writeMux timeoutFn) sdus
+        mapM_ (writeMux tracer timeoutFn) sdus
         return ts
 
diff --git a/network-mux/src/Network/Mux/Bearer/Socket.hs b/network-mux/src/Network/Mux/Bearer/Socket.hs
index 2b96d37f697..2ffd5ac9b21 100644
--- a/network-mux/src/Network/Mux/Bearer/Socket.hs
+++ b/network-mux/src/Network/Mux/Bearer/Socket.hs
@@ -30,7 +30,7 @@ import Network.Mux.Codec qualified as Mx
 import Network.Mux.Time qualified as Mx
 import Network.Mux.Timeout qualified as Mx
 import Network.Mux.Trace qualified as Mx
-import Network.Mux.Types (Bearer)
+import Network.Mux.Types (Bearer, BearerTrace)
 import Network.Mux.Types qualified as Mx
 #if defined(linux_HOST_OS) && defined(MUX_TRACE_TCPINFO)
 import Network.Mux.TCPInfo (SocketOption (TCPInfoSocketOption))
@@ -52,10 +52,9 @@ socketAsBearer
   -> Int
   -> Maybe (Mx.ReadBuffer IO)
   -> DiffTime
-  -> Tracer IO Mx.Trace
   -> Socket.Socket
   -> Bearer IO
-socketAsBearer sduSize batchSize readBuffer_m sduTimeout tracer sd =
+socketAsBearer sduSize batchSize readBuffer_m sduTimeout sd =
       Mx.Bearer {
         Mx.read      = readSocket,
         Mx.write     = writeSocket,
@@ -65,8 +64,8 @@ socketAsBearer sduSize batchSize readBuffer_m sduTimeout tracer sd =
         Mx.name      = "socket-bearer"
       }
     where
-      readSocket :: Mx.TimeoutFn IO -> IO (Mx.SDU, Time)
-      readSocket timeout = do
+      readSocket :: Tracer IO BearerTrace -> Mx.TimeoutFn IO -> IO (Mx.SDU, Time)
+      readSocket tracer timeout = do
           traceWith tracer Mx.TraceRecvHeaderStart
 
           -- Wait for the first part of the header without any timeout
@@ -77,109 +76,109 @@ socketAsBearer sduSize batchSize readBuffer_m sduTimeout tracer sd =
           case r_m of
                 Nothing -> do
                     traceWith tracer Mx.TraceSDUReadTimeoutException
-                    throwIO $ Mx.SDUReadTimeout
+                    throwIO Mx.SDUReadTimeout
                 Just r -> return r
-
-      recvRem :: BL.ByteString -> IO (Mx.SDU, Time)
-      recvRem !h0 = do
-          hbuf <- recvLen' (Mx.msHeaderLength - BL.length h0) [h0]
-          case Mx.decodeSDU hbuf of
-               Left  e ->  throwIO e
-               Right header@Mx.SDU { Mx.msHeader } -> do
-                   traceWith tracer $ Mx.TraceRecvHeaderEnd msHeader
-                   !blob <- recvLen' (fromIntegral $ Mx.mhLength msHeader) []
-
-                   !ts <- getMonotonicTime
-                   let !header' = header {Mx.msBlob = blob}
-                   traceWith tracer (Mx.TraceRecvDeltaQObservation msHeader ts)
-                   return (header', ts)
-
-      recvLen' ::  Int64 -> [BL.ByteString] -> IO BL.ByteString
-      recvLen' 0 bufs = return $ BL.concat $ reverse bufs
-      recvLen' l bufs = do
-          buf <- recvAtMost False l
-          recvLen' (l - BL.length buf) (buf : bufs)
-
-      recvAtMost :: Bool -> Int64 -> IO BL.ByteString
-      recvAtMost waitingOnNxtHeader l = do
-          traceWith tracer $ Mx.TraceRecvStart $ fromIntegral l
-
-          case readBuffer_m of
-               Nothing -> -- No read buffer available; read directly from socket
-                   recvFromSocket waitingOnNxtHeader l
-               Just Mx.ReadBuffer{Mx.rbVar, Mx.rbSize} -> do
-                   availableData <- atomically $ do
-                       buf <- readTVar rbVar
-                       if BL.length buf >= l
+        where
+          recvRem :: BL.ByteString -> IO (Mx.SDU, Time)
+          recvRem !h0 = do
+              hbuf <- recvLen' (Mx.msHeaderLength - BL.length h0) [h0]
+              case Mx.decodeSDU hbuf of
+                   Left  e ->  throwIO e
+                   Right header@Mx.SDU { Mx.msHeader } -> do
+                       traceWith tracer $ Mx.TraceRecvHeaderEnd msHeader
+                       !blob <- recvLen' (fromIntegral $ Mx.mhLength msHeader) []
+
+                       !ts <- getMonotonicTime
+                       let !header' = header {Mx.msBlob = blob}
+                       traceWith tracer (Mx.TraceRecvDeltaQObservation msHeader ts)
+                       return (header', ts)
+
+          recvLen' ::  Int64 -> [BL.ByteString] -> IO BL.ByteString
+          recvLen' 0 bufs = return $ BL.concat $ reverse bufs
+          recvLen' l bufs = do
+              buf <- recvAtMost False l
+              recvLen' (l - BL.length buf) (buf : bufs)
+
+          recvAtMost :: Bool -> Int64 -> IO BL.ByteString
+          recvAtMost waitingOnNxtHeader l = do
+              traceWith tracer $ Mx.TraceRecvStart $ fromIntegral l
+
+              case readBuffer_m of
+                   Nothing -> -- No read buffer available; read directly from socket
+                       recvFromSocket waitingOnNxtHeader l
+                   Just Mx.ReadBuffer{Mx.rbVar, Mx.rbSize} -> do
+                       availableData <- atomically $ do
+                           buf <- readTVar rbVar
+                           if BL.length buf >= l
+                              then do
+                                let (toProcess, remaining) = BL.splitAt l buf
+                                writeTVar rbVar remaining
+                                return toProcess
+                              else do
+                                writeTVar rbVar BL.empty
+                                return buf
+
+                       if BL.null availableData
                           then do
-                            let (toProcess, remaining) = BL.splitAt l buf
-                            writeTVar rbVar remaining
-                            return toProcess
-                          else do
-                            writeTVar rbVar BL.empty
-                            return buf
-
-                   if BL.null availableData
-                      then do
 #if !defined(mingw32_HOST_OS)
-                        -- Not data in buffer; read more from socket
-                        when (not waitingOnNxtHeader) $
-                          -- Don't let the kernel wake us up until there is
-                          -- at least l bytes of data.
-                          Socket.setSocketOption sd Socket.RecvLowWater $ fromIntegral l
+                            -- Not data in buffer; read more from socket
+                            when (not waitingOnNxtHeader) $
+                              -- Don't let the kernel wake us up until there is
+                              -- at least l bytes of data.
+                              Socket.setSocketOption sd Socket.RecvLowWater $ fromIntegral l
 #endif
-                        newBuf <- recvFromSocket waitingOnNxtHeader $ fromIntegral rbSize
-                        atomically $ modifyTVar rbVar (`BL.append` newBuf)
+                            newBuf <- recvFromSocket waitingOnNxtHeader $ fromIntegral rbSize
+                            atomically $ modifyTVar rbVar (`BL.append` newBuf)
 #if !defined(mingw32_HOST_OS)
-                        when (not waitingOnNxtHeader) $
-                          Socket.setSocketOption sd Socket.RecvLowWater 1
+                            when (not waitingOnNxtHeader) $
+                              Socket.setSocketOption sd Socket.RecvLowWater 1
 #endif
-                        recvAtMost waitingOnNxtHeader l
-                      else do
-                        traceWith tracer $ Mx.TraceRecvEnd $ fromIntegral $ BL.length availableData
-                        return availableData
+                            recvAtMost waitingOnNxtHeader l
+                          else do
+                            traceWith tracer $ Mx.TraceRecvEnd $ fromIntegral $ BL.length availableData
+                            return availableData
 #if !defined(mingw32_HOST_OS)
-      -- Read at most `min rbSize maxLen` bytes from the socket
-      -- into rbBuf.
-      -- Creates and returns a Bytestring matching the exact size
-      -- of the number of bytes read.
-      recvBuf :: Mx.ReadBuffer IO -> Int64 -> IO BL.ByteString
-      recvBuf Mx.ReadBuffer{Mx.rbBuf, Mx.rbSize} maxLen = do
-        len <- Socket.recvBuf sd rbBuf (min rbSize $ fromIntegral maxLen)
-        traceWith tracer $ Mx.TraceRecvRaw len
-        if len > 0
-           then do
-             bs <- create len (\dest -> copyBytes dest rbBuf len)
-             return $ BL.fromStrict bs
-           else return $ BL.empty
+          -- Read at most `min rbSize maxLen` bytes from the socket
+          -- into rbBuf.
+          -- Creates and returns a Bytestring matching the exact size
+          -- of the number of bytes read.
+          recvBuf :: Mx.ReadBuffer IO -> Int64 -> IO BL.ByteString
+          recvBuf Mx.ReadBuffer{Mx.rbBuf, Mx.rbSize} maxLen = do
+            len <- Socket.recvBuf sd rbBuf (min rbSize $ fromIntegral maxLen)
+            traceWith tracer $ Mx.TraceRecvRaw len
+            if len > 0
+               then do
+                 bs <- create len (\dest -> copyBytes dest rbBuf len)
+                 return $ BL.fromStrict bs
+               else return $ BL.empty
 #endif
 
-      recvFromSocket :: Bool -> Int64 -> IO BL.ByteString
-      recvFromSocket waitingOnNxtHeader l = do
+          recvFromSocket :: Bool -> Int64 -> IO BL.ByteString
+          recvFromSocket waitingOnNxtHeader l = do
 #if defined(mingw32_HOST_OS)
-          buf <- Win32.Async.recv sd (fromIntegral l)
+              buf <- Win32.Async.recv sd (fromIntegral l)
 #else
-          buf <- (case readBuffer_m of
-                      Nothing         -> Socket.recv sd l
-                      Just readBuffer -> recvBuf readBuffer l
-                     )
+              buf <- (case readBuffer_m of
+                          Nothing         -> Socket.recv sd l
+                          Just readBuffer -> recvBuf readBuffer l
+                         )
 #endif
-                    `catch` Mx.handleIOException "recv errored"
-          if BL.null buf
-              then do
-                  when waitingOnNxtHeader $
-                      {- This may not be an error, but could be an orderly shutdown.
-                       - We wait 1 seconds to give the mux protocols time to perform
-                       - a clean up and exit.
-                       -}
-                      threadDelay 1
-                  throwIO $ Mx.BearerClosed (show sd ++
-                      " closed when reading data, waiting on next header " ++
-                      show waitingOnNxtHeader)
-              else return buf
-
-      writeSocket :: Mx.TimeoutFn IO -> Mx.SDU -> IO Time
-      writeSocket timeout sdu = do
+                        `catch` Mx.handleIOException "recv errored"
+              if BL.null buf
+                  then do
+                      when waitingOnNxtHeader $
+                          {- This may not be an error, but could be an orderly shutdown.
+                           - We wait 1 seconds to give the mux protocols time to perform
+                           - a clean up and exit.
+                           -}
+                          threadDelay 1
+                      throwIO $ Mx.BearerClosed (show sd ++
+                          " closed when reading data, waiting on next header " ++
+                          show waitingOnNxtHeader)
+                  else return buf
+
+      writeSocket :: Tracer IO BearerTrace -> Mx.TimeoutFn IO -> Mx.SDU -> IO Time
+      writeSocket tracer timeout sdu = do
           ts <- getMonotonicTime
           let ts32 = Mx.timestampMicrosecondsLow32Bits ts
               sdu' = Mx.setTimestamp sdu (Mx.RemoteClockModel ts32)
@@ -208,14 +207,14 @@ socketAsBearer sduSize batchSize readBuffer_m sduTimeout tracer sd =
 #endif
                    return ts
 
-      writeSocketMany :: Mx.TimeoutFn IO -> [Mx.SDU] -> IO Time
+      writeSocketMany :: Tracer IO BearerTrace -> Mx.TimeoutFn IO -> [Mx.SDU] -> IO Time
 #if defined(mingw32_HOST_OS)
-      writeSocketMany timeout sdus = do
+      writeSocketMany tracer timeout sdus = do
         ts <- getMonotonicTime
         mapM_ (writeSocket timeout) sdus
         return ts
 #else
-      writeSocketMany timeout sdus = do
+      writeSocketMany tracer timeout sdus = do
           ts <- getMonotonicTime
           let ts32 = Mx.timestampMicrosecondsLow32Bits ts
               buf  = map (Mx.encodeSDU .
diff --git a/network-mux/src/Network/Mux/DeltaQ/TraceTransformer.hs b/network-mux/src/Network/Mux/DeltaQ/TraceTransformer.hs
index dd7e6998d14..318402a174b 100644
--- a/network-mux/src/Network/Mux/DeltaQ/TraceTransformer.hs
+++ b/network-mux/src/Network/Mux/DeltaQ/TraceTransformer.hs
@@ -4,10 +4,13 @@
 module Network.Mux.DeltaQ.TraceTransformer
   ( initDeltaQTracer
   , initDeltaQTracer'
+  , initDeltaQTracers
   ) where
 
 import Control.Concurrent.Class.MonadSTM.Strict
 import Control.Tracer
+import Data.Functor.Contravariant ((>$<))
+import Data.Functor.Identity
 
 import Network.Mux.DeltaQ.TraceStats
 import Network.Mux.Trace
@@ -18,29 +21,27 @@ import Network.Mux.Types
 --   `MuxTraceRecvDeltaQSample` no more frequently than every 10
 --   seconds (when in use).
 initDeltaQTracer :: MonadSTM m
-                 => m (Tracer m Trace -> Tracer m Trace)
+                 => m (Tracer m BearerTrace -> Tracer m BearerTrace)
 initDeltaQTracer = newTVarIO initialStatsA >>= pure . dqTracer
 
 initDeltaQTracer' :: MonadSTM m
-                  => Tracer m Trace
-                  -> m (Tracer m Trace)
+                  => Tracer m BearerTrace
+                  -> m (Tracer m BearerTrace)
 initDeltaQTracer' tr = do
     v <- newTVarIO initialStatsA
     return $ dqTracer v tr
 
 dqTracer :: MonadSTM m
          => StrictTVar m StatsA
-         -> Tracer m Trace
-         -> Tracer m Trace
+         -> Tracer m BearerTrace
+         -> Tracer m BearerTrace
 dqTracer sTvar tr = Tracer go
   where
     go (TraceRecvDeltaQObservation SDUHeader { mhTimestamp, mhLength } t)
       = update mhTimestamp t (fromIntegral mhLength)
         >>= maybe (return ()) (traceWith tr . formatSample)
-    go te@(TraceCleanExit {})
-       = emitSample >> traceWith tr te
-    go te@(TraceExceptionExit {})
-       = emitSample >> traceWith tr te
+    go te@TraceEmitDeltaQ
+      = emitSample >> traceWith tr te
     go x
       = traceWith tr x
 
@@ -58,3 +59,11 @@ dqTracer sTvar tr = Tracer go
       = TraceRecvDeltaQSample duration sumPackets sumTotalSDU
                               estDeltaQS estDeltaQVMean estDeltaQVVar
                               estR sizeDist
+
+
+initDeltaQTracers :: MonadSTM m
+                  => Tracers m
+                  -> m (Tracers m)
+initDeltaQTracers tracers = do
+    bearerTracer' <- initDeltaQTracer' (Identity >$< bearerTracer tracers)
+    return $ tracers { bearerTracer = runIdentity >$< bearerTracer' }
diff --git a/network-mux/src/Network/Mux/Egress.hs b/network-mux/src/Network/Mux/Egress.hs
index 1f0f614b441..98adab7c8a0 100644
--- a/network-mux/src/Network/Mux/Egress.hs
+++ b/network-mux/src/Network/Mux/Egress.hs
@@ -22,6 +22,7 @@ import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadThrow
 import Control.Monad.Class.MonadTime.SI
 import Control.Monad.Class.MonadTimer.SI hiding (timeout)
+import Control.Tracer (Tracer)
 
 import Network.Mux.Timeout
 import Network.Mux.Types
@@ -142,19 +143,20 @@ muxer
        , MonadTimer m
        )
     => EgressQueue m
+    -> Tracer m BearerTrace
     -> Bearer m
     -> m void
-muxer egressQueue Bearer { writeMany, sduSize, batchSize } =
+muxer egressQueue tracer Bearer { writeMany, sduSize, batchSize } =
     withTimeoutSerial $ \timeout ->
     forever $ do
       start <- getMonotonicTime
       TLSRDemand mpc md d <- atomically $ readTBQueue egressQueue
       sdu <- processSingleWanton egressQueue sduSize mpc md d
       sdus <- buildBatch [sdu] (sduLength sdu)
-      void $ writeMany timeout sdus
+      void $ writeMany tracer timeout sdus
       end <- getMonotonicTime
       empty <- atomically $ isEmptyTBQueue egressQueue
-      when (empty) $ do
+      when empty $ do
         let delta = diffTime end start
         threadDelay (loopInterval - delta)
 
diff --git a/network-mux/src/Network/Mux/Ingress.hs b/network-mux/src/Network/Mux/Ingress.hs
index b24cf52164a..f7b7314e3f4 100644
--- a/network-mux/src/Network/Mux/Ingress.hs
+++ b/network-mux/src/Network/Mux/Ingress.hs
@@ -22,6 +22,7 @@ import Control.Monad
 import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadThrow
 import Control.Monad.Class.MonadTimer.SI hiding (timeout)
+import Control.Tracer (Tracer)
 
 import Network.Mux.Timeout
 import Network.Mux.Trace
@@ -99,13 +100,14 @@ data MiniProtocolDispatchInfo m =
 demuxer :: (MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
             MonadTimer m)
       => [MiniProtocolState mode m]
+      -> Tracer m BearerTrace
       -> Bearer m
       -> m void
-demuxer ptcls bearer =
+demuxer ptcls tracer bearer =
   let !dispatchTable = setupDispatchTable ptcls in
   withTimeoutSerial $ \timeout ->
   forever $ do
-    (sdu, _) <- Mx.read bearer timeout
+    (sdu, _) <- Mx.read bearer tracer timeout
     -- say $ printf "demuxing sdu on mid %s mode %s lenght %d " (show $ msId sdu) (show $ msDir sdu)
     --             (BL.length $ msBlob sdu)
     case lookupMiniProtocol dispatchTable (msNum sdu)
diff --git a/network-mux/src/Network/Mux/Trace.hs b/network-mux/src/Network/Mux/Trace.hs
index 7aefacef454..00a0d1e95ea 100644
--- a/network-mux/src/Network/Mux/Trace.hs
+++ b/network-mux/src/Network/Mux/Trace.hs
@@ -1,18 +1,34 @@
-{-# LANGUAGE CPP                       #-}
 {-# LANGUAGE DeriveFunctor             #-}
 {-# LANGUAGE DeriveGeneric             #-}
 {-# LANGUAGE DerivingVia               #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE LambdaCase                #-}
 {-# LANGUAGE NamedFieldPuns            #-}
+{-# LANGUAGE PatternSynonyms           #-}
+{-# LANGUAGE RankNTypes                #-}
+{-# LANGUAGE ViewPatterns              #-}
 
 module Network.Mux.Trace
-  ( Error (..)
+  ( -- * Exceptions
+    Error (..)
   , handleIOException
+    -- * Trace events
   , Trace (..)
-  , BearerState (..)
+  , ChannelTrace (..)
+  , BearerTrace (..)
+    -- * Tracers
+  , Tracers' (.., TracersI, tracer_, channelTracer_, bearerTracer_)
+  , contramapTracers'
+  , Tracers
+  , nullTracers
+  , tracersWith
+  , TracersWithBearer
+  , tracersWithBearer
+    -- * Tracing wrappers
   , WithBearer (..)
   , TraceLabelPeer (..)
+    -- * State
+  , State (..)
   ) where
 
 import Prelude hiding (read)
@@ -21,13 +37,13 @@ import Text.Printf
 
 import Control.Exception hiding (throwIO)
 import Control.Monad.Class.MonadThrow
-import Control.Monad.Class.MonadTime.SI
+import Control.Tracer (Tracer, nullTracer)
 import Data.Bifunctor (Bifunctor (..))
-import Data.Word
+import Data.Functor.Contravariant (contramap, (>$<))
+import Data.Functor.Identity
 import GHC.Generics (Generic (..))
 import Quiet (Quiet (..))
 
-import Network.Mux.TCPInfo
 import Network.Mux.Types
 
 
@@ -111,39 +127,35 @@ data WithBearer peerid a = WithBearer {
 --TODO: probably remove this type
 
 
-data BearerState = Mature
-                 -- ^ `Bearer` has successfully completed the handshake.
-                 | Dead
-                 -- ^ `Bearer` is dead and the underlying bearer has been
-                 -- closed.
-                 deriving (Eq, Show)
+-- | Mid-level channel events traced independently by each mini protocol job.
+--
+data ChannelTrace =
+      TraceChannelRecvStart MiniProtocolNum
+    | TraceChannelRecvEnd MiniProtocolNum Int
+    | TraceChannelSendStart MiniProtocolNum Int
+    | TraceChannelSendEnd MiniProtocolNum
+
+instance Show ChannelTrace where
+    show (TraceChannelRecvStart mid) = printf "Channel Receive Start on %s" (show mid)
+    show (TraceChannelRecvEnd mid len) = printf "Channel Receive End on (%s) %d" (show mid)
+        len
+    show (TraceChannelSendStart mid len) = printf "Channel Send Start on (%s) %d" (show mid)
+        len
+    show (TraceChannelSendEnd mid) = printf "Channel Send End on %s" (show mid)
+
+
+data State = Mature
+             -- ^ `Mux started ingress, and egress threads
+           | Dead
+             -- ^ Mux is being shutdown.
+           deriving (Eq, Show)
 
--- | Enumeration of Mux events that can be traced.
+-- | High-level mux events.
 --
 data Trace =
-      TraceRecvHeaderStart
-    | TraceRecvHeaderEnd SDUHeader
-    | TraceRecvDeltaQObservation SDUHeader Time
-    | TraceRecvDeltaQSample Double Int Int Double Double Double Double String
-    | TraceRecvRaw Int
-    | TraceRecvStart Int
-    | TraceRecvEnd Int
-    | TraceSendStart SDUHeader
-    | TraceSendEnd
-    | TraceState BearerState
+      TraceState State
     | TraceCleanExit MiniProtocolNum MiniProtocolDir
     | TraceExceptionExit MiniProtocolNum MiniProtocolDir SomeException
-    | TraceChannelRecvStart MiniProtocolNum
-    | TraceChannelRecvEnd MiniProtocolNum Int
-    | TraceChannelSendStart MiniProtocolNum Int
-    | TraceChannelSendEnd MiniProtocolNum
-    | TraceHandshakeStart
-    | TraceHandshakeClientEnd DiffTime
-    | TraceHandshakeServerEnd
-    | forall e. Exception e => TraceHandshakeClientError e DiffTime
-    | forall e. Exception e => TraceHandshakeServerError e
-    | TraceSDUReadTimeoutException
-    | TraceSDUWriteTimeoutException
     | TraceStartEagerly MiniProtocolNum MiniProtocolDir
     | TraceStartOnDemand MiniProtocolNum MiniProtocolDir
     | TraceStartOnDemandAny MiniProtocolNum MiniProtocolDir
@@ -151,40 +163,11 @@ data Trace =
     | TraceTerminating MiniProtocolNum MiniProtocolDir
     | TraceStopping
     | TraceStopped
-    | TraceTCPInfo StructTCPInfo Word16
 
 instance Show Trace where
-    show TraceRecvHeaderStart = printf "Bearer Receive Header Start"
-    show (TraceRecvHeaderEnd SDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = printf "Bearer Receive Header End: ts: 0x%08x (%s) %s len %d"
-        (unRemoteClockModel mhTimestamp) (show mhNum) (show mhDir) mhLength
-    show (TraceRecvDeltaQObservation SDUHeader { mhTimestamp, mhLength } ts) = printf "Bearer DeltaQ observation: remote ts %d local ts %s length %d"
-        (unRemoteClockModel mhTimestamp) (show ts) mhLength
-    show (TraceRecvDeltaQSample d sp so dqs dqvm dqvs estR sdud) = printf "Bearer DeltaQ Sample: duration %.3e packets %d sumBytes %d DeltaQ_S %.3e DeltaQ_VMean %.3e DeltaQ_VVar %.3e DeltaQ_estR %.3e sizeDist %s"
-         d sp so dqs dqvm dqvs estR sdud
-    show (TraceRecvRaw len) = printf "Bearer Receive Raw: length %d" len
-    show (TraceRecvStart len) = printf "Bearer Receive Start: length %d" len
-    show (TraceRecvEnd len) = printf "Bearer Receive End: length %d" len
-    show (TraceSendStart SDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = printf "Bearer Send Start: ts: 0x%08x (%s) %s length %d"
-        (unRemoteClockModel mhTimestamp) (show mhNum) (show mhDir) mhLength
-    show TraceSendEnd = printf "Bearer Send End"
     show (TraceState new) = printf "State: %s" (show new)
     show (TraceCleanExit mid dir) = printf "Miniprotocol (%s) %s terminated cleanly" (show mid) (show dir)
     show (TraceExceptionExit mid dir e) = printf "Miniprotocol %s %s terminated with exception %s" (show mid) (show dir) (show e)
-    show (TraceChannelRecvStart mid) = printf "Channel Receive Start on %s" (show mid)
-    show (TraceChannelRecvEnd mid len) = printf "Channel Receive End on (%s) %d" (show mid)
-        len
-    show (TraceChannelSendStart mid len) = printf "Channel Send Start on (%s) %d" (show mid)
-        len
-    show (TraceChannelSendEnd mid) = printf "Channel Send End on %s" (show mid)
-    show TraceHandshakeStart = "Handshake start"
-    show (TraceHandshakeClientEnd duration) = printf "Handshake Client end, duration %s" (show duration)
-    show TraceHandshakeServerEnd = "Handshake Server end"
-    show (TraceHandshakeClientError e duration) =
-         -- Client Error can include an error string from the peer which could be very large.
-        printf "Handshake Client Error %s duration %s" (take 256 $ show e) (show duration)
-    show (TraceHandshakeServerError e) = printf "Handshake Server Error %s" (show e)
-    show TraceSDUReadTimeoutException = "Timed out reading SDU"
-    show TraceSDUWriteTimeoutException = "Timed out writing SDU"
     show (TraceStartEagerly mid dir) = printf "Eagerly started (%s) in %s" (show mid) (show dir)
     show (TraceStartOnDemand mid dir) = printf "Preparing to start (%s) in %s" (show mid) (show dir)
     show (TraceStartOnDemandAny mid dir) = printf "Preparing to start on any (%s) in %s" (show mid) (show dir)
@@ -192,19 +175,79 @@ instance Show Trace where
     show (TraceTerminating mid dir) = printf "Terminating (%s) in %s" (show mid) (show dir)
     show TraceStopping = "Mux stopping"
     show TraceStopped  = "Mux stoppped"
-#ifdef linux_HOST_OS
-    show (TraceTCPInfo StructTCPInfo
-            { tcpi_snd_mss, tcpi_rcv_mss, tcpi_lost, tcpi_retrans
-            , tcpi_rtt, tcpi_rttvar, tcpi_snd_cwnd }
-            len)
-                                     =
-      printf "TCPInfo rtt %d rttvar %d cwnd %d smss %d rmss %d lost %d retrans %d len %d"
-        (fromIntegral tcpi_rtt :: Word) (fromIntegral tcpi_rttvar :: Word)
-        (fromIntegral tcpi_snd_cwnd :: Word) (fromIntegral tcpi_snd_mss :: Word)
-        (fromIntegral tcpi_rcv_mss :: Word) (fromIntegral tcpi_lost :: Word)
-        (fromIntegral tcpi_retrans :: Word)
-        len
-#else
-    show (TraceTCPInfo _ len) = printf "TCPInfo len %d" len
-#endif
 
+
+-- | Bundle of tracers used directly by mux.
+--
+data Tracers' m f = Tracers {
+    tracer        :: Tracer m (f Trace),
+    -- ^ high-level tracer of mux state events
+
+    channelTracer :: Tracer m (f ChannelTrace),
+    -- ^ channel tracer
+
+    bearerTracer  :: Tracer m (f BearerTrace)
+    -- ^ high-frequency tracer
+  }
+
+type Tracers m = Tracers' m Identity
+
+
+-- | Trace all events through one polymorphic tracer.
+--
+tracersWith :: (forall x. Tracer m x) -> Tracers' m f
+tracersWith tr = Tracers {
+    tracer        = tr,
+    channelTracer = tr,
+    bearerTracer  = tr
+  }
+
+
+nullTracers :: Applicative m => Tracers' m f
+nullTracers = tracersWith nullTracer
+
+
+-- | A convenient bidirectional pattern synonym which (un)wraps the `Identity`
+-- functor in the `Tracer` type.
+--
+pattern TracersI :: forall m.
+                    Tracer m Trace
+                 -> Tracer m ChannelTrace
+                 -> Tracer m BearerTrace
+                 -> Tracers m
+pattern TracersI { tracer_, channelTracer_, bearerTracer_ } <-
+    Tracers { tracer        = contramap Identity -> tracer_,
+              channelTracer = contramap Identity -> channelTracer_,
+              bearerTracer  = contramap Identity -> bearerTracer_
+            }
+  where
+    TracersI tracer_ channelTracer_ bearerTracer_ =
+      Tracers {
+         tracer        = runIdentity >$< tracer_,
+         channelTracer = runIdentity >$< channelTracer_,
+         bearerTracer  = runIdentity >$< bearerTracer_
+       }
+
+{-# COMPLETE TracersI #-}
+
+-- | Contravariant natural transformation of `Tracers' m`.
+--
+contramapTracers' :: (forall x. f' x -> f x)
+                  -> Tracers' m f -> Tracers' m f'
+contramapTracers'
+  f
+  Tracers { tracer,
+            channelTracer,
+            bearerTracer
+          }
+  =
+  Tracers { tracer        = f >$< tracer,
+            channelTracer = f >$< channelTracer,
+            bearerTracer  = f >$< bearerTracer
+          }
+
+
+type TracersWithBearer connId m = Tracers' m (WithBearer connId)
+
+tracersWithBearer :: peerId -> TracersWithBearer peerId m -> Tracers m
+tracersWithBearer peerId = contramapTracers' (WithBearer peerId . runIdentity)
diff --git a/network-mux/src/Network/Mux/Types.hs b/network-mux/src/Network/Mux/Types.hs
index 9cf2e862a26..f6024ee13e0 100644
--- a/network-mux/src/Network/Mux/Types.hs
+++ b/network-mux/src/Network/Mux/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingVia                #-}
@@ -12,7 +13,8 @@
 -- | Types used by the multiplexer.
 --
 module Network.Mux.Types
-  ( MiniProtocolInfo (..)
+  ( ColdBlooded (..)
+  , MiniProtocolInfo (..)
   , MiniProtocolNum (..)
   , MiniProtocolDirection (..)
   , MiniProtocolLimits (..)
@@ -41,11 +43,13 @@ module Network.Mux.Types
   , remoteClockPrecision
   , RuntimeError (..)
   , ReadBuffer (..)
+  , BearerTrace (..)
   ) where
 
 import Prelude hiding (read)
 
-import Control.Exception (Exception, SomeException)
+import Control.Exception
+import Control.Tracer (Tracer)
 import Data.ByteString.Builder (Builder)
 import Data.ByteString.Lazy qualified as BL
 import Data.Functor (void)
@@ -54,6 +58,7 @@ import Data.Ix (Ix (..))
 import Data.Word
 import Foreign.Ptr (Ptr)
 import Quiet
+import Text.Printf
 
 import GHC.Generics (Generic)
 
@@ -61,6 +66,7 @@ import Control.Concurrent.Class.MonadSTM.Strict (StrictTVar)
 import Control.Monad.Class.MonadTime.SI
 
 import Network.Mux.Channel (ByteChannel, Channel (..))
+import Network.Mux.TCPInfo
 import Network.Mux.Timeout (TimeoutFn)
 
 
@@ -171,6 +177,15 @@ data Status
     | Stopped
     deriving Show
 
+-- | A type belonging to Async exception hierarchy
+-- used when killing the server
+--
+data ColdBlooded = ColdBlooded deriving Show
+
+instance Exception ColdBlooded where
+  toException   = asyncExceptionToException
+  fromException = asyncExceptionFromException
+
 --
 -- Mux internal types
 --
@@ -244,11 +259,11 @@ msHeaderLength = 8
 --
 data Bearer m = Bearer {
     -- | Timestamp and send SDU.
-      write     :: TimeoutFn m -> SDU -> m Time
+      write     :: Tracer m BearerTrace -> TimeoutFn m -> SDU -> m Time
     -- | Timestamp and send many SDUs.
-    , writeMany :: TimeoutFn m -> [SDU] -> m Time
+    , writeMany :: Tracer m BearerTrace -> TimeoutFn m -> [SDU] -> m Time
     -- | Read a SDU
-    , read      :: TimeoutFn m -> m (SDU, Time)
+    , read      :: Tracer m BearerTrace -> TimeoutFn m -> m (SDU, Time)
     -- | Return a suitable SDU payload size.
     , sduSize   :: SDUSize
     -- | Return a suitable batch size
@@ -268,14 +283,15 @@ newtype SDUSize = SDUSize { getSDUSize :: Word16 }
 --
 bearerAsChannel
   :: forall m. Functor m
-  => Bearer m
+  => Tracer m BearerTrace
+  -> Bearer m
   -> MiniProtocolNum
   -> MiniProtocolDir
   -> ByteChannel m
-bearerAsChannel bearer ptclNum ptclDir =
+bearerAsChannel tracer bearer ptclNum ptclDir =
       Channel {
-        send = \blob -> void $ write bearer noTimeout (wrap blob),
-        recv = Just . msBlob . fst <$> read bearer noTimeout
+        send = \blob -> void $ write bearer tracer noTimeout (wrap blob),
+        recv = Just . msBlob . fst <$> read bearer tracer noTimeout
       }
     where
       -- wrap a 'ByteString' as 'SDU'
@@ -318,3 +334,55 @@ data ReadBuffer m = ReadBuffer {
   -- | Size of `rbBuf`.
   , rbSize :: Int
   }
+
+
+-- | Low-level bearer trace tags (these are not traced by the tracer which is
+-- passed to Mux).
+--
+data BearerTrace =
+      TraceRecvHeaderStart
+    | TraceRecvHeaderEnd SDUHeader
+    | TraceRecvDeltaQObservation SDUHeader Time
+    | TraceRecvDeltaQSample Double Int Int Double Double Double Double String
+    | TraceEmitDeltaQ
+    | TraceRecvRaw Int
+    | TraceRecvStart Int
+    | TraceRecvEnd Int
+    | TraceSendStart SDUHeader
+    | TraceSendEnd
+    | TraceSDUReadTimeoutException
+    | TraceSDUWriteTimeoutException
+    | TraceTCPInfo StructTCPInfo Word16
+
+instance Show BearerTrace where
+    show TraceRecvHeaderStart = printf "Bearer Receive Header Start"
+    show (TraceRecvHeaderEnd SDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = printf "Bearer Receive Header End: ts: 0x%08x (%s) %s len %d"
+        (unRemoteClockModel mhTimestamp) (show mhNum) (show mhDir) mhLength
+    show (TraceRecvDeltaQObservation SDUHeader { mhTimestamp, mhLength } ts) = printf "Bearer DeltaQ observation: remote ts %d local ts %s length %d"
+        (unRemoteClockModel mhTimestamp) (show ts) mhLength
+    show (TraceRecvDeltaQSample d sp so dqs dqvm dqvs estR sdud) = printf "Bearer DeltaQ Sample: duration %.3e packets %d sumBytes %d DeltaQ_S %.3e DeltaQ_VMean %.3e DeltaQ_VVar %.3e DeltaQ_estR %.3e sizeDist %s"
+         d sp so dqs dqvm dqvs estR sdud
+    show TraceEmitDeltaQ = "emit DeltaQ"
+    show (TraceRecvRaw len) = printf "Bearer Receive Raw: length %d" len
+    show (TraceRecvStart len) = printf "Bearer Receive Start: length %d" len
+    show (TraceRecvEnd len) = printf "Bearer Receive End: length %d" len
+    show (TraceSendStart SDUHeader { mhTimestamp, mhNum, mhDir, mhLength }) = printf "Bearer Send Start: ts: 0x%08x (%s) %s length %d"
+        (unRemoteClockModel mhTimestamp) (show mhNum) (show mhDir) mhLength
+    show TraceSendEnd = printf "Bearer Send End"
+    show TraceSDUReadTimeoutException = "Timed out reading SDU"
+    show TraceSDUWriteTimeoutException = "Timed out writing SDU"
+#ifdef linux_HOST_OS
+    show (TraceTCPInfo StructTCPInfo
+            { tcpi_snd_mss, tcpi_rcv_mss, tcpi_lost, tcpi_retrans
+            , tcpi_rtt, tcpi_rttvar, tcpi_snd_cwnd }
+            len)
+                                     =
+      printf "TCPInfo rtt %d rttvar %d cwnd %d smss %d rmss %d lost %d retrans %d len %d"
+        (fromIntegral tcpi_rtt :: Word) (fromIntegral tcpi_rttvar :: Word)
+        (fromIntegral tcpi_snd_cwnd :: Word) (fromIntegral tcpi_snd_mss :: Word)
+        (fromIntegral tcpi_rcv_mss :: Word) (fromIntegral tcpi_lost :: Word)
+        (fromIntegral tcpi_retrans :: Word)
+        len
+#else
+    show (TraceTCPInfo _ len) = printf "TCPInfo len %d" len
+#endif
diff --git a/network-mux/test/Test/Mux.hs b/network-mux/test/Test/Mux.hs
index cc0ab27ff9b..72287726ea7 100644
--- a/network-mux/test/Test/Mux.hs
+++ b/network-mux/test/Test/Mux.hs
@@ -7,7 +7,6 @@
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TupleSections              #-}
-{-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeFamilies               #-}
 
 {-# OPTIONS_GHC -Wno-orphans            #-}
@@ -153,7 +152,7 @@ genByteString size = do
       where
         !(w64, g') = SM.nextWord64 g
 
-prop_arbitrary_genByteString :: (NonNegative (Small Int)) -> Property
+prop_arbitrary_genByteString :: NonNegative (Small Int) -> Property
 prop_arbitrary_genByteString (NonNegative (Small size)) = ioProperty $ do
   bs <- generate $ genByteString size
   return $ fromIntegral size == BL.length bs
@@ -289,7 +288,7 @@ instance Arbitrary ArbitrarySDU where
             return $ ArbitraryInvalidSDU (InvalidSDU (Mx.RemoteClockModel ts) mid len (fromIntegral realLen) p)
                                          (Mx.SDUDecodeError "")
 
-instance Arbitrary Mx.BearerState where
+instance Arbitrary Mx.State where
      arbitrary = elements [Mx.Mature, Mx.Dead]
 
 newtype DummyCapability = DummyCapability {
@@ -350,15 +349,15 @@ prop_mux_snd_recv (DummyRun messages) = ioProperty $ do
 
         clientBearer = queueChannelAsBearer
                          sduLen
-                         clientTracer
                          QueueChannel { writeQueue = client_w, readQueue = client_r }
         serverBearer = queueChannelAsBearer
                          sduLen
-                         serverTracer
                          QueueChannel { writeQueue = server_w, readQueue = server_r }
 
-        clientTracer = contramap (Mx.WithBearer "client") activeTracer
-        serverTracer = contramap (Mx.WithBearer "server") activeTracer
+        clientTracer' = contramap (Mx.WithBearer "client") activeTracer
+        serverTracer' = contramap (Mx.WithBearer "server") activeTracer
+        clientTracer = Mx.TracersI clientTracer' clientTracer' clientTracer'
+        serverTracer = Mx.TracersI serverTracer' serverTracer' serverTracer'
 
         clientApp = MiniProtocolInfo {
                        miniProtocolNum = Mx.MiniProtocolNum 2,
@@ -418,17 +417,17 @@ prop_mux_snd_recv_bi (DummyRun messages) (DummyCapability clientCap) (DummyCapab
     let server_w = client_r
         server_r = client_w
 
-        clientTracer = contramap (Mx.WithBearer "client") activeTracer
-        serverTracer = contramap (Mx.WithBearer "server") activeTracer
+        clientTracer' = contramap (Mx.WithBearer "client") activeTracer
+        serverTracer' = contramap (Mx.WithBearer "server") activeTracer
+        clientTracer  = Mx.TracersI clientTracer' clientTracer' clientTracer'
+        serverTracer  = Mx.TracersI serverTracer' serverTracer' serverTracer'
 
     clientBearer <- getBearer makeQueueChannelBearer
                       (-1)
-                      clientTracer
                       QueueChannel { writeQueue = client_w, readQueue = client_r }
                       Nothing
     serverBearer <- getBearer makeQueueChannelBearer
                       (-1)
-                      serverTracer
                       QueueChannel { writeQueue = server_w, readQueue = server_r }
                       Nothing
 
@@ -524,23 +523,23 @@ prop_mux_snd_recv_compat :: DummyTrace
 prop_mux_snd_recv_compat messages = ioProperty $ do
     client_w <- atomically $ newTBQueue 10
     client_r <- atomically $ newTBQueue 10
-    endMpsVar <- atomically $ newTVar 2
+    endMpsVar <- newTVarIO 2
 
     let server_w = client_r
         server_r = client_w
 
-        clientTracer = contramap (Mx.WithBearer "client") activeTracer
-        serverTracer = contramap (Mx.WithBearer "server") activeTracer
+        clientTracer' = contramap (Mx.WithBearer "client") activeTracer
+        serverTracer' = contramap (Mx.WithBearer "server") activeTracer
+        clientTracer  = Mx.TracersI clientTracer' clientTracer' clientTracer'
+        serverTracer  = Mx.TracersI serverTracer' serverTracer' serverTracer'
 
 
     clientBearer <- getBearer makeQueueChannelBearer
                       (-1)
-                      clientTracer
                       QueueChannel { writeQueue = client_w, readQueue = client_r }
                      Nothing
     serverBearer <- getBearer makeQueueChannelBearer
                      (-1)
-                     serverTracer
                      QueueChannel { writeQueue = server_w, readQueue = server_r }
                      Nothing
     (verify, client_mp, server_mp) <- setupMiniReqRspCompat
@@ -743,8 +742,10 @@ runMuxApplication :: DummyCapability
                   -> Mx.Bearer IO
                   -> IO Bool
 runMuxApplication (DummyCapability rspCap) initApps initBearer respApps respBearer = do
-    let clientTracer = contramap (Mx.WithBearer "client") activeTracer
-        serverTracer = contramap (Mx.WithBearer "server") activeTracer
+    let clientTracer' = contramap (Mx.WithBearer "client") activeTracer
+        serverTracer' = contramap (Mx.WithBearer "server") activeTracer
+        clientTracer  = Mx.TracersI clientTracer' clientTracer' clientTracer'
+        serverTracer  = Mx.TracersI serverTracer' serverTracer' serverTracer'
         protNum = [1..]
         respApps' = zip protNum respApps
         initApps' = zip protNum initApps
@@ -811,17 +812,12 @@ runWithQueues cap initApps respApps = do
     let server_w = client_r
         server_r = client_w
 
-        clientTracer = contramap (Mx.WithBearer "client") activeTracer
-        serverTracer = contramap (Mx.WithBearer "server") activeTracer
-
     clientBearer <- getBearer makeQueueChannelBearer
                       (-1)
-                      clientTracer
                       QueueChannel { writeQueue = client_w, readQueue = client_r }
                       Nothing
     serverBearer <- getBearer makeQueueChannelBearer
                       (-1)
-                      serverTracer
                       QueueChannel { writeQueue = server_w, readQueue = server_r }
                       Nothing
     runMuxApplication cap initApps clientBearer respApps serverBearer
@@ -877,14 +873,10 @@ runWithPipe cap initApps respApps =
         let clientChannel = Mx.pipeChannelFromHandles rCli wSrv
             serverChannel = Mx.pipeChannelFromHandles rSrv wCli
 
-        clientBearer <- getBearer makePipeChannelBearer (-1) clientTracer clientChannel Nothing
-        serverBearer <- getBearer makePipeChannelBearer (-1) serverTracer serverChannel Nothing
+        clientBearer <- getBearer makePipeChannelBearer (-1) clientChannel Nothing
+        serverBearer <- getBearer makePipeChannelBearer (-1) serverChannel Nothing
         runMuxApplication cap initApps clientBearer respApps serverBearer
-
 #endif
-  where
-    clientTracer = contramap (Mx.WithBearer "client") activeTracer
-    serverTracer = contramap (Mx.WithBearer "server") activeTracer
 
 runWithSocket :: DummyCapability
               -> Maybe (Mx.ReadBuffer IO)
@@ -912,16 +904,14 @@ runWithSocket cap clientBuf_m serverBuf_m initApps respApps = withIOManager (\io
         Socket.close sd
       )
       (\(cd, sd) -> do
-        clientB <- mkBearer clientBuf_m cd clientTracer
-        serverB <- mkBearer serverBuf_m sd serverTracer
+        clientB <- mkBearer clientBuf_m cd
+        serverB <- mkBearer serverBuf_m sd
 
         runMuxApplication cap initApps clientB respApps serverB
       )
    )
   where
-    mkBearer buf_m sock tr = getBearer makeSocketBearer (-1) tr sock buf_m
-    clientTracer = contramap (Mx.WithBearer "client") activeTracer
-    serverTracer = contramap (Mx.WithBearer "server") activeTracer
+    mkBearer buf_m sock = getBearer makeSocketBearer (-1) sock buf_m
 
 -- | Verify that it is possible to run two miniprotocols over the same bearer.
 -- Makes sure that messages are delivered to the correct miniprotocol in order.
@@ -1005,7 +995,7 @@ prop_mux_starvation (Uneven response0 response1) =
 
     client_w <- atomically $ newTBQueue 10
     client_r <- atomically $ newTBQueue 10
-    activeMpsVar <- atomically $ newTVar 0
+    activeMpsVar <- newTVarIO 0
     traceHeaderVar <- newTVarIO []
     let headerTracer =
           Tracer $ \e -> case e of
@@ -1016,18 +1006,18 @@ prop_mux_starvation (Uneven response0 response1) =
     let server_w = client_r
         server_r = client_w
 
-        clientTracer = contramap (Mx.WithBearer "client") activeTracer
-        serverTracer = contramap (Mx.WithBearer "server") activeTracer
+        clientTracer' = contramap (Mx.WithBearer "client") activeTracer
+        serverTracer' = contramap (Mx.WithBearer "server") activeTracer
+        clientTracer  = Mx.TracersI clientTracer' clientTracer' (clientTracer' <> headerTracer)
+        serverTracer  = Mx.TracersI serverTracer' serverTracer' serverTracer'
 
 
     clientBearer <- getBearer makeQueueChannelBearer
                       (-1)
-                      clientTracer
                       QueueChannel { writeQueue = client_w, readQueue = client_r }
                       Nothing
     serverBearer <- getBearer makeQueueChannelBearer
                       (-1)
-                      serverTracer
                       QueueChannel { writeQueue = server_w, readQueue = server_r }
                       Nothing
     (client_short, server_short) <-
@@ -1072,7 +1062,7 @@ prop_mux_starvation (Uneven response0 response1) =
                    Mx.StartOnDemand server_long
 
     clientMux <- Mx.new [clientApp2, clientApp3]
-    clientMux_aid <- async $ Mx.run (clientTracer <> headerTracer) clientMux clientBearer
+    clientMux_aid <- async $ Mx.run clientTracer clientMux clientBearer
     clientRes2 <- Mx.runMiniProtocol clientMux (miniProtocolNum clientApp2) (miniProtocolDir clientApp2)
                    Mx.StartEagerly client_short
     clientRes3 <- Mx.runMiniProtocol clientMux (miniProtocolNum clientApp3) (miniProtocolDir clientApp3)
@@ -1261,11 +1251,11 @@ prop_demux_sdu a = do
         server_w <- atomically $ newTBQueue 10
         server_r <- atomically $ newTBQueue 10
 
-        let serverTracer = contramap (Mx.WithBearer "server") activeTracer
+        let serverTracer' = contramap (Mx.WithBearer "server") activeTracer
+            serverTracer  = Mx.TracersI serverTracer' serverTracer' serverTracer'
 
         serverBearer <- getBearer makeQueueChannelBearer
                           (-1)
-                          serverTracer
                           QueueChannel { writeQueue = server_w,
                                          readQueue  = server_r
                                        }
@@ -1480,7 +1470,7 @@ triggerApp :: forall m.
             -> DummyApp
             -> m ()
 triggerApp bearer app = do
-    let chan = Mx.bearerAsChannel bearer (daNum app) Mx.InitiatorDir
+    let chan = Mx.bearerAsChannel nullTracer bearer (daNum app) Mx.InitiatorDir
     traceWith verboseTracer $ "app waiting " ++ (show $ daNum app)
     threadDelay (daStartAfter app)
     traceWith verboseTracer $ "app starting " ++ (show $ daNum app)
@@ -1507,13 +1497,11 @@ prop_mux_start_mX apps runTime = do
     bearer <-
       getBearer makeQueueChannelBearer
         (-1)
-        nullTracer
         QueueChannel { writeQueue = mux_w, readQueue = mux_r }
         Nothing
     peerBearer <-
       getBearer makeQueueChannelBearer
         (-1)
-        nullTracer
         QueueChannel { writeQueue = mux_r, readQueue = mux_w }
         Nothing
     prop_mux_start_m bearer (triggerApp peerBearer) checkRes apps runTime anyStartAfter
@@ -1570,13 +1558,12 @@ prop_mux_restart_m (DummyRestartingInitiatorApps apps) = do
     mux_r <- atomically $ newTBQueue 10
     bearer <- getBearer Mx.makeQueueChannelBearer
                 (-1)
-                nullTracer
                 QueueChannel { writeQueue = mux_w, readQueue = mux_r }
                 Nothing
     let minis = map (appToInfo Mx.InitiatorDirectionOnly . fst) apps
 
     mux <- Mx.new minis
-    mux_aid <- async $ Mx.run nullTracer mux bearer
+    mux_aid <- async $ Mx.run Mx.nullTracers mux bearer
     getRes <- sequence [ Mx.runMiniProtocol
                            mux
                           (daNum $ fst app)
@@ -1612,20 +1599,18 @@ prop_mux_restart_m (DummyRestartingResponderApps rapps) = do
     bearer <-
       getBearer makeQueueChannelBearer
         (-1)
-        nullTracer
         QueueChannel { writeQueue = mux_w, readQueue = mux_r }
         Nothing
     peerBearer <-
       getBearer makeQueueChannelBearer
         (-1)
-        nullTracer
         QueueChannel { writeQueue = mux_r, readQueue = mux_w }
         Nothing
     let apps = map fst rapps
         minis = map (appToInfo Mx.ResponderDirectionOnly) apps
 
     mux <- Mx.new minis
-    mux_aid <- async $ Mx.run nullTracer mux bearer
+    mux_aid <- async $ Mx.run Mx.nullTracers mux bearer
     getRes <- sequence [ Mx.runMiniProtocol
                            mux
                           (daNum $ fst app)
@@ -1663,13 +1648,11 @@ prop_mux_restart_m (DummyRestartingInitiatorResponderApps rapps) = do
     bearer <-
       getBearer makeQueueChannelBearer
         (-1)
-        nullTracer
         QueueChannel { writeQueue = mux_w, readQueue = mux_r }
         Nothing
     peerBearer <-
       getBearer makeQueueChannelBearer
         (-1)
-        nullTracer
         QueueChannel { writeQueue = mux_r, readQueue = mux_w }
         Nothing
     let apps = map fst rapps
@@ -1677,7 +1660,7 @@ prop_mux_restart_m (DummyRestartingInitiatorResponderApps rapps) = do
         respMinis = map (appToInfo Mx.ResponderDirection) apps
 
     mux <- Mx.new $ initMinis ++ respMinis
-    mux_aid <- async $ Mx.run nullTracer mux bearer
+    mux_aid <- async $ Mx.run Mx.nullTracers mux bearer
     getInitRes <- sequence [ Mx.runMiniProtocol
                                mux
                                (daNum $ fst app)
@@ -1762,7 +1745,7 @@ prop_mux_start_m bearer _ checkRes (DummyInitiatorApps apps) runTime _ = do
         minRunTime = minimum $ runTime : (map daRunTime $ filter (\app -> daAction app == DummyAppFail) apps)
 
     mux <- Mx.new minis
-    mux_aid <- async $ Mx.run nullTracer mux bearer
+    mux_aid <- async $ Mx.run Mx.nullTracers mux bearer
     killer <- async $ (threadDelay runTime) >> Mx.stop mux
     getRes <- sequence [ Mx.runMiniProtocol
                            mux
@@ -1786,7 +1769,7 @@ prop_mux_start_m bearer trigger checkRes (DummyResponderApps apps) runTime anySt
                                               ) $ filter (\app -> daAction app == DummyAppFail) apps)
 
     mux <- Mx.new minis
-    mux_aid <- async $ Mx.run verboseTracer mux bearer
+    mux_aid <- async $ Mx.run muxVerboseTracer mux bearer
     getRes <- sequence [ Mx.runMiniProtocol
                            mux
                           (daNum app)
@@ -1816,7 +1799,7 @@ prop_mux_start_m bearer _trigger _checkRes (DummyResponderAppsKillMux apps) runT
     let minis = map (appToInfo Mx.ResponderDirectionOnly) apps
 
     mux <- Mx.new minis
-    mux_aid <- async $ Mx.run verboseTracer mux bearer
+    mux_aid <- async $ Mx.run muxVerboseTracer mux bearer
     getRes <- sequence [ Mx.runMiniProtocol
                            mux
                           (daNum app)
@@ -1839,7 +1822,7 @@ prop_mux_start_m bearer trigger checkRes (DummyInitiatorResponderApps apps) runT
         minRunTime = minimum $ runTime : (map (\a -> daRunTime a) $ filter (\app -> daAction app == DummyAppFail) apps)
 
     mux <- Mx.new $ initMinis ++ respMinis
-    mux_aid <- async $ Mx.run verboseTracer mux bearer
+    mux_aid <- async $ Mx.run muxVerboseTracer mux bearer
     getInitRes <- sequence [ Mx.runMiniProtocol
                                mux
                                (daNum app)
@@ -1917,6 +1900,14 @@ verboseTracer :: forall a m.
                => Tracer m a
 verboseTracer = threadAndTimeTracer $ showTracing $ Tracer say
 
+muxVerboseTracer :: forall m.
+                       ( MonadAsync m
+                       , MonadMonotonicTime m
+                       , MonadSay m
+                       )
+                 => Mx.Tracers m
+muxVerboseTracer = Mx.TracersI verboseTracer verboseTracer verboseTracer
+
 threadAndTimeTracer :: forall a m.
                        ( MonadAsync m
                        , MonadMonotonicTime m
@@ -1998,6 +1989,10 @@ close_experiment
       _iotest
 #endif
       fault tracer muxTracer clientCtx serverCtx reqs0 fn acc0 = do
+    let clientMuxTracer' = (Client,) `contramap` muxTracer
+        serverMuxTracer' = (Server,) `contramap` muxTracer
+        clientMuxTracer  = Mx.TracersI clientMuxTracer' nullTracer nullTracer
+        serverMuxTracer  = Mx.TracersI serverMuxTracer' nullTracer nullTracer
     withAsync
       -- run client thread
       (bracket (Mx.new [ MiniProtocolInfo {
@@ -2009,7 +2004,7 @@ close_experiment
                        ])
                 Mx.stop $ \mux ->
         withNetworkCtx clientCtx $ \clientBearer ->
-          withAsync (Mx.run ((Client,) `contramap` muxTracer) mux clientBearer) $ \_muxAsync ->
+          withAsync (Mx.run clientMuxTracer mux clientBearer) $ \_muxAsync ->
                 Mx.runMiniProtocol
                   mux miniProtocolNum
                   Mx.InitiatorDirectionOnly Mx.StartEagerly
@@ -2028,7 +2023,7 @@ close_experiment
                             ])
                     Mx.stop $ \mux ->
           withNetworkCtx serverCtx $ \serverBearer  ->
-            withAsync (Mx.run ((Server,) `contramap` muxTracer) mux serverBearer) $ \_muxAsync -> do
+            withAsync (Mx.run serverMuxTracer mux serverBearer) $ \_muxAsync -> do
                   Mx.runMiniProtocol
                     mux miniProtocolNum
                     Mx.ResponderDirectionOnly Mx.StartOnDemand
@@ -2227,7 +2222,7 @@ prop_mux_close_io fault reqs fn acc = ioProperty $ withIOManager $ \iocp -> do
                 return sock,
               ncClose  = Socket.close,
               ncMuxBearer = \sd k -> withReadBufferIO (\buffer -> do
-                              bearer <- getBearer makeSocketBearer 10 nullTracer sd buffer
+                              bearer <- getBearer makeSocketBearer 10 sd buffer
                               k bearer
                             )
 
@@ -2244,7 +2239,7 @@ prop_mux_close_io fault reqs fn acc = ioProperty $ withIOManager $ \iocp -> do
                 return sock,
               ncClose  = Socket.close,
               ncMuxBearer = \sd k -> withReadBufferIO (\buffer -> do
-                              bearer <- getBearer makeSocketBearer 10 nullTracer sd buffer
+                              bearer <- getBearer makeSocketBearer 10 sd buffer
                               k bearer
                             )
 
@@ -2298,16 +2293,14 @@ prop_mux_close_sim fault (Positive sduSize_) reqs fn acc =
               ncClose  = acClose,
               ncMuxBearer = \fd k ->
                                k $ attenuationChannelAsBearer
-                                     sduSize sduTimeout
-                                     nullTracer fd
+                                     sduSize sduTimeout fd
             }
           serverCtx = NetworkCtx {
               ncSocket = return chann',
               ncClose  = acClose,
               ncMuxBearer = \fd k ->
                                k $ attenuationChannelAsBearer
-                                     sduSize sduTimeout
-                                     nullTracer fd
+                                     sduSize sduTimeout fd
             }
       close_experiment
         False
diff --git a/ouroboros-network-framework/CHANGELOG.md b/ouroboros-network-framework/CHANGELOG.md
index e424fe15baa..4df0b57cddb 100644
--- a/ouroboros-network-framework/CHANGELOG.md
+++ b/ouroboros-network-framework/CHANGELOG.md
@@ -6,6 +6,16 @@
 
 ### Breaking changes
 
+* IG performance related improvements changing to interfaces of
+  * IG `with` and `Arguments`
+  * CM `with` and `Arguments`
+  * Server `with` and `Arguments`
+  * Deleted `InboundGovernor.Event` module and moved to InboundGovernor:
+    * `NewConnectionInfo`, `Event`, `EventSignal`, `Terminated`, `firstPeerCommitRemote`
+  * signature of `makeConnectionHandler`
+  * moved `InboundGovernorInfoChannel` to IG from InformationChannel
+    and changed its type to contain `Event`'s.
+
 ## 0.17.0.0 -- 2025-02-25
 
 ### Breaking changes
diff --git a/ouroboros-network-framework/demo/connection-manager.hs b/ouroboros-network-framework/demo/connection-manager.hs
index 12727ffa25a..79914d9d2f4 100644
--- a/ouroboros-network-framework/demo/connection-manager.hs
+++ b/ouroboros-network-framework/demo/connection-manager.hs
@@ -1,16 +1,17 @@
-{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE KindSignatures      #-}
-{-# LANGUAGE NamedFieldPuns      #-}
-{-# LANGUAGE NumericUnderscores  #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections       #-}
-{-# LANGUAGE TypeApplications    #-}
-{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE CPP                      #-}
+{-# LANGUAGE ConstraintKinds          #-}
+{-# LANGUAGE DataKinds                #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE FlexibleContexts         #-}
+{-# LANGUAGE GADTs                    #-}
+{-# LANGUAGE KindSignatures           #-}
+{-# LANGUAGE NamedFieldPuns           #-}
+{-# LANGUAGE NumericUnderscores       #-}
+{-# LANGUAGE RankNTypes               #-}
+{-# LANGUAGE ScopedTypeVariables      #-}
+{-# LANGUAGE TupleSections            #-}
+{-# LANGUAGE TypeApplications         #-}
+{-# LANGUAGE TypeOperators            #-}
 
 -- just to use 'debugTracer'
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
@@ -40,6 +41,7 @@ import Data.Functor (($>))
 import Data.Hashable (Hashable)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Typeable (Typeable)
+import Data.Void
 
 import Network.Mux qualified as Mux
 import Network.Mux.Bearer qualified as Mux
@@ -57,6 +59,8 @@ import Network.TypedProtocol.ReqResp.Examples
 import Network.TypedProtocol.ReqResp.Server
 import Network.TypedProtocol.ReqResp.Type (ReqResp)
 
+import Network.Mux qualified as Mx
+
 import Ouroboros.Network.ConnectionHandler
 import Ouroboros.Network.ConnectionManager.Core qualified as CM
 import Ouroboros.Network.ConnectionManager.InformationChannel
@@ -64,6 +68,7 @@ import Ouroboros.Network.ConnectionManager.InformationChannel
 import Ouroboros.Network.ConnectionManager.State qualified as CM
 import Ouroboros.Network.ConnectionManager.Types
 import Ouroboros.Network.Context
+import Ouroboros.Network.InboundGovernor qualified as InboundGovernor
 import Ouroboros.Network.IOManager
 import Ouroboros.Network.Mux
 import Ouroboros.Network.MuxMode
@@ -205,6 +210,7 @@ withBidirectionalConnectionManager
           Mux.InitiatorResponderMode socket peerAddr UnversionedProtocolData
           UnversionedProtocol ByteString m () ()
        -> peerAddr
+       -> Async m Void
        -> m a)
     -> m a
 withBidirectionalConnectionManager snocket makeBearer socket
@@ -227,42 +233,18 @@ withBidirectionalConnectionManager snocket makeBearer socket
     hotRequestsVar         <- LazySTM.newTVarIO hotInitiatorRequests
     warmRequestsVar        <- LazySTM.newTVarIO warmInitiatorRequests
     establishedRequestsVar <- LazySTM.newTVarIO establishedInitiatorRequests
-    let muxTracer = ("mux",) `contramap` nullTracer -- mux tracer
-
-    CM.with
-      CM.Arguments {
-          -- ConnectionManagerTrace
-          CM.tracer       = ("cm",) `contramap` debugTracer,
-          CM.trTracer     = ("cm-state",) `contramap` debugTracer,
-          -- MuxTracer
-          CM.muxTracer    = muxTracer,
-          CM.ipv4Address  = localAddress,
-          CM.ipv6Address  = Nothing,
-          CM.addressType  = \_ -> Just IPv4Address,
-          CM.snocket      = snocket,
-          CM.makeBearer   = makeBearer,
-          CM.withBuffer   = \f -> f Nothing,
-          CM.configureSocket = \_ _ -> return (),
-          CM.timeWaitTimeout = timeWaitTimeout,
-          CM.outboundIdleTimeout = protocolIdleTimeout,
-          CM.connectionDataFlow = \_ -> Duplex,
-          CM.prunePolicy = simplePrunePolicy,
-          CM.stdGen      = stdGen,
-          CM.connectionsLimits = AcceptedConnectionsLimit {
-              acceptedConnectionsHardLimit = maxBound,
-              acceptedConnectionsSoftLimit = maxBound,
-              acceptedConnectionsDelay     = 0
-            },
-          CM.updateVersionData = \a _ -> a,
-          CM.connStateIdSupply
+    let muxTracers = Mx.Tracers {
+          Mx.tracer        = ("mux",) `contramap` nullTracer,
+          Mx.channelTracer = ("mux",) `contramap` nullTracer,
+          Mx.bearerTracer  = ("mux",) `contramap` nullTracer
         }
-        (makeConnectionHandler
-          muxTracer
-          SingInitiatorResponderMode
+        mkConnectionHandler singMuxMode = makeConnectionHandler
+          muxTracers
           noBindForkPolicy
           HandshakeArguments {
               -- TraceSendRecv
               haHandshakeTracer = ("handshake",) `contramap` debugTracer,
+              haBearerTracer = ("hanshake",) `contramap` nullTracer,
               haHandshakeCodec = unversionedHandshakeCodec,
               haVersionDataCodec = unversionedProtocolDataCodec,
               haAcceptVersion = acceptableVersion,
@@ -274,26 +256,59 @@ withBidirectionalConnectionManager snocket makeBearer socket
                                 warmRequestsVar
                                 establishedRequestsVar))
           (mainThreadId,   debugMuxErrorRethrowPolicy
-                        <> debugIOErrorRethrowPolicy))
-          (\_ -> HandshakeFailure)
-          (InResponderMode inbgovInfoChannel)
-      $ \connectionManager -> do
-            serverAddr <- Snocket.getLocalAddr snocket socket
-            Server.with
-              Server.Arguments {
-                  Server.sockets = socket :| [],
-                  Server.snocket = snocket,
-                  Server.tracer = ("server",) `contramap` debugTracer, -- ServerTrace
-                  Server.trTracer = nullTracer,
-                  Server.inboundGovernorTracer = ("inbound-governor",) `contramap` debugTracer,
-                  Server.debugInboundGovernor = nullTracer,
-                  Server.connectionLimits = AcceptedConnectionsLimit maxBound maxBound 0,
-                  Server.connectionManager = connectionManager,
-                  Server.connectionDataFlow = \_ -> Duplex,
-                  Server.inboundIdleTimeout = Just protocolIdleTimeout,
-                  Server.inboundInfoChannel = inbgovInfoChannel
+                        <> debugIOErrorRethrowPolicy)
+          singMuxMode
+
+        withConnectionManager connectionHandler k' =
+            CM.with
+              CM.Arguments {
+                  -- ConnectionManagerTrace
+                  tracer       = ("cm",) `contramap` debugTracer,
+                  trTracer     = ("cm-state",) `contramap` debugTracer,
+                  ipv4Address  = localAddress,
+                  ipv6Address  = Nothing,
+                  addressType  = \_ -> Just IPv4Address,
+                  snocket      = snocket,
+                  makeBearer   = makeBearer,
+                  CM.withBuffer   = \f -> f Nothing,
+                  configureSocket = \_ _ -> return (),
+                  timeWaitTimeout = timeWaitTimeout,
+                  outboundIdleTimeout = protocolIdleTimeout,
+                  connectionDataFlow = \_ -> Duplex,
+                  prunePolicy = simplePrunePolicy,
+                  stdGen      = stdGen,
+                  connectionsLimits = AcceptedConnectionsLimit {
+                      acceptedConnectionsHardLimit = maxBound,
+                      acceptedConnectionsSoftLimit = maxBound,
+                      acceptedConnectionsDelay     = 0
+                    },
+                  updateVersionData = \a _ -> a,
+                  connStateIdSupply,
+                  classifyHandleError = (\_ -> HandshakeFailure)
                 }
-              (\_ _ -> k connectionManager serverAddr)
+              (InResponderMode inbgovInfoChannel)
+              connectionHandler
+              k'
+
+    serverAddr <- Snocket.getLocalAddr snocket socket
+    Server.with
+      Server.Arguments {
+          sockets = socket :| [],
+          snocket = snocket,
+          tracer = ("server",) `contramap` debugTracer, -- ServerTrace
+          connectionLimits = AcceptedConnectionsLimit maxBound maxBound 0,
+          inboundGovernorArgs =
+              InboundGovernor.Arguments {
+                  transitionTracer = nullTracer,
+                  tracer = ("inbound-governor",) `contramap` debugTracer,
+                  debugTracer = nullTracer,
+                  connectionDataFlow = \_ -> Duplex,
+                  infoChannel = inbgovInfoChannel,
+                  idleTimeout = Just protocolIdleTimeout,
+                  withConnectionManager,
+                  mkConnectionHandler = mkConnectionHandler SingInitiatorResponderMode (\_ -> Duplex) }
+        }
+      (\inbGovAsync _ connManager-> k connManager serverAddr inbGovAsync)
   where
     serverApplication :: LazySTM.TVar m [[Int]]
                       -> LazySTM.TVar m [[Int]]
@@ -478,7 +493,7 @@ bidirectionalExperiment
         snocket makeBearer socket0 connStateIdSupply
         protocolIdleTimeout timeWaitTimeout
         (Just localAddr) stdGen clientAndServerData $
-        \connectionManager _serverAddr -> forever' $ do
+        \connectionManager _serverAddr _inbGovAsync -> forever' $ do
           -- runInitiatorProtocols returns a list of results per each protocol
           -- in each bucket (warm \/ hot \/ established); but we run only one
           -- mini-protocol. We can use `concat` to flatten the results.
diff --git a/ouroboros-network-framework/demo/ping-pong.hs b/ouroboros-network-framework/demo/ping-pong.hs
index 4ea1834cbac..47639af2ba4 100644
--- a/ouroboros-network-framework/demo/ping-pong.hs
+++ b/ouroboros-network-framework/demo/ping-pong.hs
@@ -164,12 +164,13 @@ serverPingPong =
       mempty
       defaultLocalSocketAddr
       HandshakeArguments {
-        haHandshakeTracer  = nullTracer,
-        haHandshakeCodec   = unversionedHandshakeCodec,
-        haVersionDataCodec = unversionedProtocolDataCodec,
-        haAcceptVersion    = acceptableVersion,
-        haQueryVersion     = queryVersion,
-        haTimeLimits       = noTimeLimitsHandshake
+        haHandshakeTracer       = nullTracer,
+        haBearerTracer = nullTracer,
+        haHandshakeCodec        = unversionedHandshakeCodec,
+        haVersionDataCodec      = unversionedProtocolDataCodec,
+        haAcceptVersion         = acceptableVersion,
+        haQueryVersion          = queryVersion,
+        haTimeLimits            = noTimeLimitsHandshake
       }
       (unversionedProtocol (SomeResponderApplication app))
       $ \_ serverAsync -> wait serverAsync -- block until server finishes
@@ -259,6 +260,7 @@ serverPingPong2 =
       defaultLocalSocketAddr
       HandshakeArguments {
         haHandshakeTracer  = nullTracer,
+        haBearerTracer     = nullTracer,
         haHandshakeCodec   = unversionedHandshakeCodec,
         haVersionDataCodec = unversionedProtocolDataCodec,
         haAcceptVersion    = acceptableVersion,
diff --git a/ouroboros-network-framework/io-tests/Test/Ouroboros/Network/Socket.hs b/ouroboros-network-framework/io-tests/Test/Ouroboros/Network/Socket.hs
index d6eb888c236..7ce1985099e 100644
--- a/ouroboros-network-framework/io-tests/Test/Ouroboros/Network/Socket.hs
+++ b/ouroboros-network-framework/io-tests/Test/Ouroboros/Network/Socket.hs
@@ -59,6 +59,7 @@ import Ouroboros.Network.Server.Simple qualified as Server.Simple
 import Network.Mux qualified as Mx
 import Network.Mux.Bearer qualified as Mx
 import Network.Mux.Timeout qualified as Mx
+import Network.Mux.Trace qualified as Mx
 import Network.Mux.Types qualified as Mx
 
 import Ouroboros.Network.Protocol.Handshake
@@ -246,6 +247,7 @@ prop_socket_send_recv initiatorAddr responderAddr configureSock f xs =
         responderAddr
         HandshakeArguments {
           haHandshakeTracer  = nullTracer,
+          haBearerTracer     = nullTracer,
           haHandshakeCodec   = unversionedHandshakeCodec,
           haVersionDataCodec = unversionedProtocolDataCodec,
           haAcceptVersion    = acceptableVersion,
@@ -262,7 +264,7 @@ prop_socket_send_recv initiatorAddr responderAddr configureSock f xs =
               ctaHandshakeCodec      = unversionedHandshakeCodec,
               ctaHandshakeTimeLimits = noTimeLimitsHandshake,
               ctaVersionDataCodec    = unversionedProtocolDataCodec,
-              ctaConnectTracers      = NetworkConnectTracers activeMuxTracer nullTracer,
+              ctaConnectTracers      = NetworkConnectTracers (Mx.tracersWith activeMuxTracer) nullTracer,
               ctaHandshakeCallbacks  = HandshakeCallbacks acceptableVersion queryVersion
             }
             (`configureSock` Nothing)
@@ -343,7 +345,7 @@ prop_socket_recv_error f rerr =
                             localAddress = Socket.addrAddress muxAddress,
                             remoteAddress
                           }
-                    bearer <- Mx.getBearer Mx.makeSocketBearer timeout nullTracer sd' Nothing
+                    bearer <- Mx.getBearer Mx.makeSocketBearer timeout sd' Nothing
                     _ <- async $ do
                       threadDelay 0.1
                       atomically $ putTMVar lock ()
@@ -367,7 +369,7 @@ prop_socket_recv_error f rerr =
                               [(Mx.ResponderDirectionOnly, void . runMiniProtocolCb initiator respCtx)]
                       ]
 
-                    withAsync (Mx.run nullTracer mux bearer) $ \aid -> do
+                    withAsync (Mx.run Mx.nullTracers mux bearer) $ \aid -> do
                       _ <- atomically $ runFirstToFinish $ foldMap FirstToFinish resOps
                       Mx.stop mux
                       wait aid
@@ -443,11 +445,11 @@ prop_socket_send_error rerr =
                     let sduTimeout = if rerr == SendSDUTimeout then 0.10
                                                                else (-1) -- No timeout
                         blob = BL.pack $ replicate 0xffff 0xa5
-                    bearer <- Mx.getBearer Mx.makeSocketBearer sduTimeout nullTracer sd' Nothing
+                    bearer <- Mx.getBearer Mx.makeSocketBearer sduTimeout sd' Nothing
                     Mx.withTimeoutSerial $ \timeout ->
                       -- send maximum mux sdus until we've filled the window.
                       replicateM 100 $ do
-                        ((), Nothing) <$ Mx.write bearer timeout (wrap blob Mx.ResponderDir (MiniProtocolNum 0))
+                        ((), Nothing) <$ Mx.write bearer nullTracer timeout (wrap blob Mx.ResponderDir (MiniProtocolNum 0))
           )
           $ \muxAsync -> do
 
diff --git a/ouroboros-network-framework/ouroboros-network-framework.cabal b/ouroboros-network-framework/ouroboros-network-framework.cabal
index dd22166b33f..a928834b6e3 100644
--- a/ouroboros-network-framework/ouroboros-network-framework.cabal
+++ b/ouroboros-network-framework/ouroboros-network-framework.cabal
@@ -41,7 +41,6 @@ library
     Ouroboros.Network.Driver.Stateful
     Ouroboros.Network.IOManager
     Ouroboros.Network.InboundGovernor
-    Ouroboros.Network.InboundGovernor.Event
     Ouroboros.Network.InboundGovernor.State
     Ouroboros.Network.Mux
     Ouroboros.Network.MuxMode
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 37100de8cf7..f49e7200b89 100644
--- a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs
+++ b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveFunctor              #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingVia                #-}
+{-# LANGUAGE DisambiguateRecordFields   #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GADTs                      #-}
@@ -32,7 +33,7 @@ import Control.Monad.Class.MonadThrow
 import Control.Monad.Class.MonadTime.SI
 import Control.Monad.Class.MonadTimer.SI
 import Control.Monad.IOSim
-import Control.Tracer (Tracer (..), contramap, nullTracer)
+import Control.Tracer (Tracer (..), contramap)
 
 import GHC.Generics
 import GHC.IO.Exception
@@ -345,11 +346,11 @@ newtype FD m = FD { fdState :: StrictTVar m FDState }
 
 makeFDBearer :: MonadDelay m
              => MakeBearer m (FD m)
-makeFDBearer = MakeBearer $ \_ _ _ _ ->
+makeFDBearer = MakeBearer $ \_ _ _ ->
       return Mx.Bearer {
-          Mx.write     = \_ _ -> getMonotonicTime,
-          Mx.writeMany = \_ _ -> getMonotonicTime,
-          Mx.read      = \_ -> forever (threadDelay 3600),
+          Mx.write     = \_ _ _ -> getMonotonicTime,
+          Mx.writeMany = \_ _ _ -> getMonotonicTime,
+          Mx.read      = \_ _ -> forever (threadDelay 3600),
           Mx.sduSize   = Mx.SDUSize 1500,
           Mx.batchSize = 1500,
           Mx.name      = "FD"
@@ -761,32 +762,30 @@ prop_valid_transitions (Fixed rnd) (SkewedBool bindToLocalAddress) scheduleMap =
         let connectionHandler = mkConnectionHandler snocket
         result <- CM.with
           CM.Arguments {
-              CM.tracer,
-              CM.trTracer,
-              CM.muxTracer = nullTracer,
-              CM.ipv4Address = myAddress,
-              CM.ipv6Address = Nothing,
-              CM.addressType = \_ -> Just IPv4Address,
-              CM.snocket = snocket,
-              CM.makeBearer = makeFDBearer,
-              CM.withBuffer = \f -> f Nothing,
-              CM.configureSocket = \_ _ -> return (),
-              CM.connectionDataFlow = id,
-              CM.prunePolicy = simplePrunePolicy,
-              CM.stdGen = Random.mkStdGen rnd,
-              CM.connectionsLimits = AcceptedConnectionsLimit {
-                  acceptedConnectionsHardLimit = maxBound,
-                  acceptedConnectionsSoftLimit = maxBound,
-                  acceptedConnectionsDelay     = 0
-                },
-              CM.timeWaitTimeout = testTimeWaitTimeout,
-              CM.outboundIdleTimeout = testOutboundIdleTimeout,
-              CM.updateVersionData = \a _ -> a,
-              CM.connStateIdSupply
-            }
-            connectionHandler
-            (\_ -> HandshakeFailure)
-            (InResponderMode inbgovInfoChannel)
+            tracer,
+            trTracer,
+            ipv4Address = myAddress,
+            ipv6Address = Nothing,
+            addressType = \_ -> Just IPv4Address,
+            snocket = snocket,
+            makeBearer = makeFDBearer,
+            withBuffer = \f -> f Nothing,
+            configureSocket = \_ _ -> return (),
+            connectionDataFlow = id,
+            prunePolicy = simplePrunePolicy,
+            stdGen = Random.mkStdGen rnd,
+            connectionsLimits = AcceptedConnectionsLimit {
+                acceptedConnectionsHardLimit = maxBound,
+                acceptedConnectionsSoftLimit = maxBound,
+                acceptedConnectionsDelay     = 0
+              },
+            timeWaitTimeout = testTimeWaitTimeout,
+            outboundIdleTimeout = testOutboundIdleTimeout,
+            updateVersionData = \a _ -> a,
+            connStateIdSupply,
+            classifyHandleError = \_ -> HandshakeFailure }
+          (InResponderMode inbgovInfoChannel)
+          connectionHandler
           $ \(connectionManager
                 :: ConnectionManager Mx.InitiatorResponderMode (FD (IOSim s))
                                      Addr (Handle m) Void (IOSim s)) -> do
diff --git a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server/Sim.hs b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server/Sim.hs
index 401b218bab0..f3b7f922841 100644
--- a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server/Sim.hs
+++ b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server/Sim.hs
@@ -106,7 +106,7 @@ import Test.Ouroboros.Network.InboundGovernor.Utils
            validRemoteTransitionMap, verifyRemoteTransition,
            verifyRemoteTransitionOrder)
 import Test.Ouroboros.Network.Orphans ()
-import Test.Ouroboros.Network.Utils (WithName (..), WithTime (..),
+import Test.Ouroboros.Network.Utils (WithName (..), WithTime (..), debugTracerG,
            genDelayWithPrecision, nightlyTest, sayTracer, tracerWithTime)
 import Test.Simulation.Network.Snocket hiding (tests)
 
@@ -226,7 +226,7 @@ data ConnectionEvent req peerAddr
     -- ^ Close an outbound connection.
   | ShutdownClientServer DiffTime peerAddr
     -- ^ Shuts down a client/server (simulates power loss)
-  deriving (Show, Functor)
+  deriving (Eq, Show, Functor)
 
 -- | A sequence of connection events that make up a test scenario for `prop_multinode_Sim`.
 data MultiNodeScript req peerAddr = MultiNodeScript
@@ -458,7 +458,7 @@ maxAcceptedConnectionsLimit = AcceptedConnectionsLimit maxBound maxBound 0
 --
 --   transitions.
 --
-instance Arbitrary req =>
+instance (Eq req, Arbitrary req) =>
          Arbitrary (MultiNodePruningScript req) where
   arbitrary = do
     Positive len <- scale ((* 2) . (`div` 3)) arbitrary
@@ -532,17 +532,20 @@ instance Arbitrary req =>
   -- we could miss which change actually introduces the failure, and be lift
   -- with a larger counter example.
   shrink (MultiNodePruningScript
-            (AcceptedConnectionsLimit hardLimit softLimit delay)
+            acl@(AcceptedConnectionsLimit hardLimit softLimit delay)
             events
             attenuationMap) =
-    MultiNodePruningScript
-        <$> (AcceptedConnectionsLimit
+    let a = AcceptedConnectionsLimit
               <$> shrink hardLimit
               <*> shrink softLimit
-              <*> pure delay)
-        <*> (makeValid
-            <$> shrinkList shrinkEvent events)
-        <*> shrink attenuationMap
+              <*> pure delay in
+      [MultiNodePruningScript a' events attenuationMap
+      | a' <- a] <>
+      [MultiNodePruningScript acl events' attenuationMap
+      | events' <- makeValid <$> shrinkList shrinkEvent events
+      , events' /= events] <>
+      [MultiNodePruningScript acl events attenuationMap'
+      | attenuationMap' <- shrink attenuationMap]
     where
       makeValid = go (ScriptState [] [] [] [] [])
         where
@@ -635,6 +638,7 @@ multinodeExperiment
                           (CM.Trace
                             peerAddr
                             (ConnectionHandlerTrace UnversionedProtocol DataFlowProtocolData)))
+    -> Mux.Tracers' m (WithNameAndBearer (Name peerAddr) peerAddr)
     -> StdGen
     -> Snocket m socket peerAddr
     -> Mux.MakeBearer m socket
@@ -647,7 +651,7 @@ multinodeExperiment
     -> MultiNodeScript req peerAddr
     -> m ()
 multinodeExperiment inboundTrTracer trTracer inboundTracer debugTracer cmTracer
-                    stdGen0 snocket makeBearer addrFamily serverAddr accInit
+                    muxTracers stdGen0 snocket makeBearer addrFamily serverAddr accInit
                     dataFlow0 acceptedConnLimit
                     (MultiNodeScript script _) =
   withJobPool $ \jobpool -> do
@@ -746,7 +750,7 @@ multinodeExperiment inboundTrTracer trTracer inboundTracer debugTracer cmTracer
         forkJob jobpool
           $ Job
               ( withInitiatorOnlyConnectionManager
-                    name simTimeouts nullTracer nullTracer stdGen
+                    name simTimeouts nullTracer cmTracer stdGen
                     snocket makeBearer connStateIdSupply
                     (Just localAddr) (mkNextRequests connVar)
                     timeLimitsHandshake acceptedConnLimit
@@ -783,7 +787,7 @@ multinodeExperiment inboundTrTracer trTracer inboundTracer debugTracer cmTracer
                   Job ( withBidirectionalConnectionManager
                           name simTimeouts
                           inboundTrTracer trTracer cmTracer
-                          inboundTracer debugTracer
+                          inboundTracer muxTracers debugTracer
                           stdGen
                           snocket makeBearer connStateIdSupply
                           (\_ -> pure ()) fd (Just localAddr) serverAcc
@@ -1122,6 +1126,8 @@ prop_connection_manager_no_invalid_traces (Fixed rnd) serverAcc (ArbDataFlow dat
                      , ppScript (MultiNodeScript events attenuationMap)
                      , "========== ConnectionManager Events =========="
                      , Trace.ppTrace show show connectionManagerEvents
+                     , "====== Say Events ======"
+                     , intercalate "\n" $ selectTraceEventsSay' trace
                      ])
     . bifoldMap
        ( \ case
@@ -1424,6 +1430,7 @@ prop_connection_manager_counters (Fixed rnd) serverAcc (ArbDataFlow dataFlow)
                                     (   sayTracer
                                      <> Tracer traceM
                                      <> networkStateTracer getState)
+                                    (Mux.Tracers debugTracerG debugTracerG debugTracerG)
                                     (mkStdGen rnd)
                                     snocket
                                     makeFDBearer
@@ -1479,7 +1486,8 @@ prop_timeouts_enforced (Fixed rnd) serverAcc (ArbDataFlow dataFlow)
                              (tracerWithTime (Tracer traceM) <> dynamicTracer)
                              dynamicTracer
                              nullTracer
-                             dynamicTracer
+                             (Mux.Tracers dynamicTracer dynamicTracer dynamicTracer)
+                             debugTracerG
 
 -- | Property wrapping `multinodeExperiment`.
 --
@@ -1893,30 +1901,34 @@ prop_connection_manager_pruning (Fixed rnd) serverAcc
              -> Maybe (Either (WithName (Name SimAddr) (AbstractTransitionTrace SimAddr))
                               (WithName (Name SimAddr) (CM.Trace SimAddr
                                                           (ConnectionHandlerTrace UnversionedProtocol DataFlowProtocolData))))
-          fn _ (EventLog dyn) = Left  <$> fromDynamic dyn
-                            <|> Right <$> fromDynamic dyn
+          fn _ (EventLog dyn) = fromDynamic dyn
           fn _ _              = Nothing
 
   in  tabulate "ConnectionEvents" (map showConnectionEvents events)
-    -- . counterexample (ppScript (MultiNodeScript events attenuationMap))
+    . counterexample (ppScript (MultiNodeScript events attenuationMap))
+    . counterexample (concat
+        [ "\n\n====== Say Events ======\n"
+        , intercalate "\n" $ selectTraceEventsSay' trace
+        , "\n"
+        ])
     . mkPropertyPruning
     . bifoldMap
        ( \ case
            MainReturn {} -> mempty
-           v             -> mempty { tpProperty = counterexample (show v) False }
+           v             -> mempty { tpProperty = counterexample ("\ncounterexample: " <> show v) False }
        )
        ( \ case
            Left trs ->
              TestProperty {
                tpProperty =
                    (counterexample $!
-                     (  "\nconnection:\n"
+                     (  "\ncounterexample\nconnection:\n"
                      ++ intercalate "\n" (map ppTransition trs))
                      )
                  . foldMap ( \ tr
                             -> All
                              . (counterexample $!
-                                 (  "\nUnexpected transition: "
+                                 (  "\ncounterexample\nUnexpected transition: "
                                  ++ show tr)
                                  )
                              . verifyAbstractTransition
@@ -1932,8 +1944,11 @@ prop_connection_manager_pruning (Fixed rnd) serverAcc
                tpActivityTypes       = [classifyActivityType       trs],
                tpTransitions         = trs
             }
-           Right b ->
-              mempty { tpNumberOfPrunings = classifyPruning b }
+           Right b
+             | CM.TrUnexpectedlyFalseAssertion assertionLoc <- b ->
+                 mempty { tpProperty = counterexample ("\ncounterexample: " <> show assertionLoc) False }
+             | otherwise ->
+                 mempty { tpNumberOfPrunings = classifyPruning b }
        )
     . fmap (first (map ttTransition))
     . groupConnsEither id abstractStateIsFinalTransition
@@ -2191,7 +2206,7 @@ prop_server_accept_error (Fixed rnd) (AbsIOError ioerr) =
                withBidirectionalConnectionManager "node-0" simTimeouts
                                                   nullTracer nullTracer
                                                   nullTracer nullTracer
-                                                  nullTracer
+                                                  Mux.nullTracers nullTracer
                                                   (mkStdGen rnd)
                                                   snock
                                                   makeFDBearer
@@ -2255,6 +2270,7 @@ multiNodeSimTracer :: ( Alternative (STM m), Monad m, MonadFix m
                       (WithName (Name SimAddr) (IG.Trace SimAddr))
                    -> Tracer m
                       (WithName (Name SimAddr) (IG.Debug SimAddr DataFlowProtocolData))
+                   -> Mux.Tracers' m (WithNameAndBearer (Name SimAddr) SimAddr)
                    -> Tracer m
                       (WithName
                        (Name SimAddr)
@@ -2266,7 +2282,7 @@ multiNodeSimTracer :: ( Alternative (STM m), Monad m, MonadFix m
 multiNodeSimTracer stdGen serverAcc dataFlow defaultBearerInfo
                    acceptedConnLimit events attenuationMap
                    remoteTrTracer abstractTrTracer
-                   inboundGovTracer debugTracer connMgrTracer = do
+                   inboundGovTracer debugTracer muxTracers connMgrTracer = do
 
       let attenuationMap' = (fmap toBearerInfo <$>)
                           . Map.mapKeys ( normaliseId
@@ -2284,6 +2300,7 @@ multiNodeSimTracer stdGen serverAcc dataFlow defaultBearerInfo
                                      inboundGovTracer
                                      debugTracer
                                      connMgrTracer
+                                     muxTracers
                                      stdGen
                                      snocket
                                      makeFDBearer
@@ -2318,7 +2335,7 @@ multiNodeSim stdGen serverAcc dataFlow defaultBearerInfo
                    acceptedConnLimit events attenuationMap = do
   multiNodeSimTracer stdGen serverAcc dataFlow defaultBearerInfo acceptedConnLimit
                      events attenuationMap dynamicTracer dynamicTracer dynamicTracer
-                     (Tracer traceM) dynamicTracer
+                     (Tracer traceM) (Mux.Tracers dynamicTracer dynamicTracer dynamicTracer) dynamicTracer --debugTracerG
 
 
 -- | Connection terminated while negotiating it.
diff --git a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Socket.hs b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Socket.hs
index 2472c829b9b..c19124fcd9e 100644
--- a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Socket.hs
+++ b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Socket.hs
@@ -61,6 +61,7 @@ import Ouroboros.Network.Server.Simple qualified as Server.Simple
 import Network.Mux qualified as Mx
 import Network.Mux.Bearer qualified as Mx
 import Network.Mux.Timeout
+import Network.Mux.Trace qualified as Mx
 import Network.Mux.Types (MiniProtocolDir (..), RemoteClockModel (..))
 import Network.Mux.Types qualified as Mx
 
@@ -253,6 +254,7 @@ prop_socket_send_recv initiatorAddr responderAddr configureSock f xs =
           responderAddr
           HandshakeArguments {
             haHandshakeTracer  = nullTracer,
+            haBearerTracer     = nullTracer,
             haHandshakeCodec   = unversionedHandshakeCodec,
             haVersionDataCodec = unversionedProtocolDataCodec,
             haAcceptVersion    = acceptableVersion,
@@ -268,7 +270,7 @@ prop_socket_send_recv initiatorAddr responderAddr configureSock f xs =
                 ctaHandshakeCodec      = unversionedHandshakeCodec,
                 ctaHandshakeTimeLimits = noTimeLimitsHandshake,
                 ctaVersionDataCodec    = unversionedProtocolDataCodec,
-                ctaConnectTracers      = NetworkConnectTracers activeMuxTracer nullTracer,
+                ctaConnectTracers      = NetworkConnectTracers (Mx.tracersWith activeMuxTracer) nullTracer,
                 ctaHandshakeCallbacks  = HandshakeCallbacks acceptableVersion queryVersion
               }
               (`configureSock` Nothing)
@@ -348,7 +350,7 @@ prop_socket_recv_error f rerr =
                             localAddress = Socket.addrAddress muxAddress,
                             remoteAddress
                           }
-                    bearer <- Mx.getBearer Mx.makeSocketBearer timeout nullTracer sd' Nothing
+                    bearer <- Mx.getBearer Mx.makeSocketBearer timeout sd' Nothing
                     _ <- async $ do
                       threadDelay 0.1
                       atomically $ putTMVar lock ()
@@ -372,7 +374,7 @@ prop_socket_recv_error f rerr =
                               [(Mx.ResponderDirectionOnly, void . runMiniProtocolCb initiator respCtx)]
                       ]
 
-                    withAsync (Mx.run nullTracer mux bearer) $ \aid -> do
+                    withAsync (Mx.run Mx.nullTracers mux bearer) $ \aid -> do
                       _ <- atomically $ runFirstToFinish $ foldMap FirstToFinish resOps
                       Mx.stop mux
                       wait aid
@@ -448,11 +450,11 @@ prop_socket_send_error rerr =
                     let sduTimeout = if rerr == SendSDUTimeout then 0.10
                                                                else (-1) -- No timeout
                         blob = BL.pack $ replicate 0xffff 0xa5
-                    bearer <- Mx.getBearer Mx.makeSocketBearer sduTimeout nullTracer sd' Nothing
+                    bearer <- Mx.getBearer Mx.makeSocketBearer sduTimeout sd' Nothing
                     withTimeoutSerial $ \timeout ->
                       -- send maximum mux sdus until we've filled the window.
                       replicateM 100 $ do
-                        ((), Nothing) <$ Mx.write bearer timeout (wrap blob ResponderDir (MiniProtocolNum 0))
+                        ((), Nothing) <$ Mx.write bearer nullTracer timeout (wrap blob ResponderDir (MiniProtocolNum 0))
           )
           $ \muxAsync -> do
 
@@ -526,7 +528,7 @@ prop_socket_client_connect_error _ xs =
           ctaHandshakeCodec      = unversionedHandshakeCodec,
           ctaHandshakeTimeLimits = noTimeLimitsHandshake,
           ctaVersionDataCodec    = unversionedProtocolDataCodec,
-          ctaConnectTracers      = NetworkConnectTracers activeMuxTracer nullTracer,
+          ctaConnectTracers      = NetworkConnectTracers (Mx.tracersWith activeMuxTracer) nullTracer,
           ctaHandshakeCallbacks  = HandshakeCallbacks acceptableVersion queryVersion
         }
         (flip configureSocket Nothing)
diff --git a/ouroboros-network-framework/sim-tests/Test/Simulation/Network/Snocket.hs b/ouroboros-network-framework/sim-tests/Test/Simulation/Network/Snocket.hs
index 0e5795366b1..a34b934fa4c 100644
--- a/ouroboros-network-framework/sim-tests/Test/Simulation/Network/Snocket.hs
+++ b/ouroboros-network-framework/sim-tests/Test/Simulation/Network/Snocket.hs
@@ -246,7 +246,7 @@ clientServerSimulation payloads =
           (accepted, accept1) <- runAccept accept0
           case accepted of
             Accepted fd' remoteAddr -> do
-              bearer <- getBearer makeFDBearer 10 nullTracer fd' Nothing
+              bearer <- getBearer makeFDBearer 10 fd' Nothing
               thread <- async $ handleConnection bearer remoteAddr
                                 `finally`
                                close snocket fd'
@@ -287,9 +287,12 @@ clientServerSimulation payloads =
                                                serverPeer)
               withAsync
                 (do labelThisThread "server-mux"
-                    Mx.run (("server", connId,)
+                    let serverTracer :: forall x. Show x => Tracer m x
+                        serverTracer =
+                          (("server", connId,)
                              `contramap`
                              traceTime (Tracer (say . show)))
+                    Mx.run (Mx.Tracers serverTracer serverTracer serverTracer)
                            mux bearer)
                 $ \_muxThread -> do
                   res <- atomically resSTM
@@ -327,14 +330,17 @@ clientServerSimulation payloads =
                               (\channel -> runPeer tr codecReqResp
                                                    channel
                                                    clientPeer)
-                  bearer <- Mx.getBearer makeFDBearer 10 nullTracer fd Nothing
+                  bearer <- Mx.getBearer makeFDBearer 10 fd Nothing
 
                   -- kill mux as soon as the client returns
                   withAsync
                     (do labelThisThread "client-mux"
-                        Mx.run (("client", connId,)
+                        let clientTracer :: forall x. Show x => Tracer m x
+                            clientTracer =
+                              (("client", connId,)
                                  `contramap`
                                  traceTime (Tracer (say . show)))
+                        Mx.run (Mx.Tracers clientTracer clientTracer clientTracer)
                                mux bearer)
                     $ \_ -> do
                       res <- atomically resSTM
@@ -595,8 +601,8 @@ prop_self_connect (Payload payload) =
                   $ \fd -> do
                     bind snocket fd addr
                     connect snocket fd addr
-                    bearer <- getBearer makeFDBearer 10 nullTracer fd Nothing
-                    let channel = bearerAsChannel bearer (MiniProtocolNum 0) InitiatorDir
+                    bearer <- getBearer makeFDBearer 10 fd Nothing
+                    let channel = bearerAsChannel nullTracer bearer (MiniProtocolNum 0) InitiatorDir
                     send channel payload
                     payload' <- recv channel
                     threadDelay 1
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionHandler.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionHandler.hs
index 93c07319336..9134e6287e4 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionHandler.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionHandler.hs
@@ -1,12 +1,14 @@
 {-# LANGUAGE BangPatterns              #-}
+{-# LANGUAGE BlockArguments            #-}
 {-# LANGUAGE DataKinds                 #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts          #-}
 {-# LANGUAGE GADTs                     #-}
-{-# LANGUAGE KindSignatures            #-}
+{-# LANGUAGE LambdaCase                #-}
 {-# LANGUAGE NamedFieldPuns            #-}
 {-# LANGUAGE RankNTypes                #-}
 {-# LANGUAGE ScopedTypeVariables       #-}
+{-# LANGUAGE TypeFamilyDependencies    #-}
 {-# LANGUAGE TypeOperators             #-}
 
 -- | Implementation of 'ConnectionHandler'
@@ -31,6 +33,7 @@ module Ouroboros.Network.ConnectionHandler
   , HandleWithMinimalCtx
   , HandleError (..)
   , classifyHandleError
+  , MkMuxConnectionHandler
   , MuxConnectionHandler
   , makeConnectionHandler
   , MuxConnectionManager
@@ -47,7 +50,7 @@ import Control.Monad.Class.MonadFork
 import Control.Monad.Class.MonadThrow hiding (handle)
 import Control.Monad.Class.MonadTime.SI
 import Control.Monad.Class.MonadTimer.SI
-import Control.Tracer (Tracer, contramap, traceWith)
+import Control.Tracer (Tracer, traceWith)
 
 import Data.ByteString.Lazy (ByteString)
 import Data.Map (Map)
@@ -56,12 +59,14 @@ import Data.Typeable (Typeable)
 
 import Network.Mux (Mux)
 import Network.Mux qualified as Mx
+import Network.Mux.Trace
 
 import Ouroboros.Network.ConnectionId (ConnectionId (..))
 import Ouroboros.Network.ConnectionManager.Types
 import Ouroboros.Network.Context (ExpandedInitiatorContext,
            MinimalInitiatorContext, ResponderContext)
 import Ouroboros.Network.ControlMessage (ControlMessage (..))
+import Ouroboros.Network.InboundGovernor.State
 import Ouroboros.Network.Mux
 import Ouroboros.Network.MuxMode
 import Ouroboros.Network.Protocol.Handshake
@@ -115,6 +120,29 @@ data Handle (muxMode :: Mx.Mode) initiatorCtx responderCtx versionData bytes m a
         hVersionData    :: !versionData
       }
 
+type family MkMuxConnectionHandler (muxMode :: Mx.Mode) socket initiatorCtx responderCtx
+                                   peerAddr versionNumber versionData bytes m a b =
+  result | result -> socket where
+  MkMuxConnectionHandler Mx.InitiatorMode socket initiatorCtx responderCtx peerAddr
+                                          versionNumber versionData bytes m a b =
+    MuxConnectionHandler Mx.InitiatorMode socket initiatorCtx responderCtx peerAddr
+                                          versionNumber versionData bytes m a b
+
+  MkMuxConnectionHandler Mx.ResponderMode socket initiatorCtx responderCtx peerAddr
+                                          versionNumber versionData bytes m a b =
+       (   StrictTVar m (Maybe ResponderCounters)
+        -> Tracer m (WithBearer (ConnectionId peerAddr) Trace))
+    -> MuxConnectionHandler Mx.ResponderMode socket initiatorCtx responderCtx peerAddr
+                                             versionNumber versionData bytes m a b
+
+  MkMuxConnectionHandler Mx.InitiatorResponderMode socket initiatorCtx responderCtx peerAddr
+                                                   versionNumber versionData bytes m a b =
+       (versionData -> DataFlow)
+    -> (   StrictTVar m (Maybe ResponderCounters)
+        -> Tracer m (WithBearer (ConnectionId peerAddr) Trace))
+    -> MuxConnectionHandler Mx.InitiatorResponderMode socket initiatorCtx responderCtx
+                                                      peerAddr versionNumber versionData
+                                                      bytes m a b
 
 -- | 'Handle' used by `node-to-node` P2P connections.
 --
@@ -207,6 +235,10 @@ type ConnectionManagerWithExpandedCtx muxMode socket peerAddr versionData versio
 -- different `ConnectionManager`s: one for `node-to-client` and another for
 -- `node-to-node` connections.  But this is ok, as these resources are
 -- independent.
+-- When a server is running, the inbound governor creates a tracer which is passed here,
+-- and the connection handler appends it to the muxer tracer for
+-- inbound and (negotiated) outbound duplex connections. This tracer
+-- efficiently informs the IG loop of miniprotocol activity.
 --
 makeConnectionHandler
     :: forall initiatorCtx responderCtx peerAddr muxMode socket versionNumber versionData m a b.
@@ -222,34 +254,30 @@ makeConnectionHandler
        , Show     peerAddr
        , Typeable peerAddr
        )
-    => Tracer m (Mx.WithBearer (ConnectionId peerAddr) Mx.Trace)
-    -> SingMuxMode muxMode
+    => Mx.TracersWithBearer (ConnectionId peerAddr) m
     -> ForkPolicy peerAddr
-    -- ^ describe whether this is outbound or inbound connection, and bring
-    -- evidence that we can use mux with it.
     -> HandshakeArguments (ConnectionId peerAddr) versionNumber versionData m
     -> Versions versionNumber versionData
                 (OuroborosBundle muxMode initiatorCtx responderCtx ByteString m a b)
     -> (ThreadId m, RethrowPolicy)
     -- ^ 'ThreadId' and rethrow policy.  Rethrow policy might throw an async
     -- exception to that thread, when trying to terminate the process.
-    -> MuxConnectionHandler muxMode socket initiatorCtx responderCtx peerAddr versionNumber versionData ByteString m a b
-makeConnectionHandler muxTracer singMuxMode
-                      forkPolicy
+    -> SingMuxMode muxMode
+    -- ^ describe whether this is outbound or inbound connection, and bring
+    -- evidence that we can use mux with it.
+    -> MkMuxConnectionHandler muxMode socket initiatorCtx responderCtx peerAddr versionNumber versionData ByteString m a b
+makeConnectionHandler muxTracers forkPolicy
                       handshakeArguments
                       versionedApplication
                       (mainThreadId, rethrowPolicy) =
-    ConnectionHandler {
-        connectionHandler =
-          case singMuxMode of
-            SingInitiatorMode ->
-              WithInitiatorMode outboundConnectionHandler
-            SingResponderMode ->
-              WithResponderMode inboundConnectionHandler
-            SingInitiatorResponderMode ->
-              WithInitiatorResponderMode outboundConnectionHandler
-                                         inboundConnectionHandler
-      }
+  \case
+    SingInitiatorMode -> ConnectionHandler . WithInitiatorMode
+                       $ outboundConnectionHandler NotInResponderMode
+    SingResponderMode -> ConnectionHandler . WithResponderMode . inboundConnectionHandler
+    SingInitiatorResponderMode -> \connectionDataFlow inboundGovChannelTracer ->
+      ConnectionHandler $ WithInitiatorResponderMode
+        (outboundConnectionHandler $ InResponderMode (inboundGovChannelTracer, connectionDataFlow))
+        (inboundConnectionHandler inboundGovChannelTracer)
   where
     -- install classify exception handler
     classifyExceptions :: forall x.
@@ -276,7 +304,10 @@ makeConnectionHandler muxTracer singMuxMode
 
     outboundConnectionHandler
       :: HasInitiator muxMode ~ True
-      => ConnectionHandlerFn (ConnectionHandlerTrace versionNumber versionData)
+      => InResponderMode muxMode (   StrictTVar m (Maybe ResponderCounters)
+                                  -> Tracer m (WithBearer (ConnectionId peerAddr) Trace)
+                                 , versionData -> DataFlow)
+      -> ConnectionHandlerFn (ConnectionHandlerTrace versionNumber versionData)
                              socket
                              peerAddr
                              (Handle muxMode initiatorCtx responderCtx versionData ByteString m a b)
@@ -284,7 +315,8 @@ makeConnectionHandler muxTracer singMuxMode
                              versionNumber
                              versionData
                              m
-    outboundConnectionHandler versionDataFn
+    outboundConnectionHandler inResponderMode
+                              versionDataFn
                               socket
                               PromiseWriter { writePromise }
                               tracer
@@ -335,11 +367,31 @@ makeConnectionHandler muxTracer singMuxMode
                           hVersionData    = agreedOptions
                         }
                   atomically $ writePromise (Right $ HandshakeConnectionResult handle (versionNumber, agreedOptions))
-                  withBuffer (\buffer -> do
-                      bearer <- mkMuxBearer sduTimeout socket buffer
-                      Mx.run (Mx.WithBearer connectionId `contramap` muxTracer)
-                             mux bearer
-                    )
+                  withBuffer \buffer -> do
+                    bearer <- mkMuxBearer sduTimeout socket buffer
+                    muxTracers' <- case inResponderMode of
+                      InResponderMode (inboundGovChannelTracer, connectionDataFlow)
+                        | Duplex <- connectionDataFlow agreedOptions -> do
+                            -- In this case, following the Mx.run call below, the muxer begins racing with
+                            -- the CM to write to the information channel queue. The tracer of mux activity,
+                            -- while the CM of new connection notification. The latter *should* come first.
+                            -- The IG tracer will block the muxer on a TVar when it reaches mature state
+                            -- until the CM informs the former of new peer connection to ensure
+                            -- proper sequencing of events.
+                            countersVar <- newTVarIO $ Just $ ResponderCounters 0 0
+                            pure $ Mx.tracersWithBearer connectionId muxTracers {
+                                  Mx.tracer = Mx.tracer muxTracers <> inboundGovChannelTracer countersVar
+                                }
+                      _notResponder ->
+                            -- If this is InitiatorOnly, or a server where unidirectional flow was negotiated
+                            -- the IG will never be informed of this remote for obvious reasons. There is no
+                            -- need to pass the responder IG tracer here, and we must not in the latter case
+                            -- as the muxer will deadlock itself before it launches any miniprotocols from the
+                            -- command queue. It will be stuck when reaches mature state, forever waiting for
+                            -- the incoming peer handle.
+                            pure $ Mx.tracersWithBearer connectionId muxTracers
+
+                    Mx.run muxTracers' mux bearer
 
               Right (HandshakeQueryResult vMap) -> do
                 atomically $ writePromise (Right HandshakeConnectionQuery)
@@ -348,7 +400,9 @@ makeConnectionHandler muxTracer singMuxMode
 
     inboundConnectionHandler
       :: HasResponder muxMode ~ True
-      => ConnectionHandlerFn (ConnectionHandlerTrace versionNumber versionData)
+      => (   StrictTVar m (Maybe ResponderCounters)
+          -> Tracer m (WithBearer (ConnectionId peerAddr) Trace))
+      -> ConnectionHandlerFn (ConnectionHandlerTrace versionNumber versionData)
                              socket
                              peerAddr
                              (Handle muxMode initiatorCtx responderCtx versionData ByteString m a b)
@@ -356,7 +410,8 @@ makeConnectionHandler muxTracer singMuxMode
                              versionNumber
                              versionData
                              m
-    inboundConnectionHandler updateVersionDataFn
+    inboundConnectionHandler inboundGovChannelTracer
+                             updateVersionDataFn
                              socket
                              PromiseWriter { writePromise }
                              tracer
@@ -410,7 +465,10 @@ makeConnectionHandler muxTracer singMuxMode
                   atomically $ writePromise (Right $ HandshakeConnectionResult handle (versionNumber, agreedOptions))
                   withBuffer (\buffer -> do
                       bearer <- mkMuxBearer sduTimeout socket buffer
-                      Mx.run (Mx.WithBearer connectionId `contramap` muxTracer)
+                      countersVar <- newTVarIO . Just $ ResponderCounters 0 0
+                      Mx.run (Mx.tracersWithBearer connectionId muxTracers {
+                               Mx.tracer = Mx.tracer muxTracers <> inboundGovChannelTracer countersVar
+                             })
                              mux bearer
                     )
               Right (HandshakeQueryResult vMap) -> do
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs
index a3ff65acb34..8489b612887 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs
@@ -1,14 +1,16 @@
-{-# LANGUAGE BangPatterns         #-}
-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE FlexibleContexts     #-}
-{-# LANGUAGE GADTs                #-}
-{-# LANGUAGE KindSignatures       #-}
-{-# LANGUAGE NamedFieldPuns       #-}
-{-# LANGUAGE RankNTypes           #-}
-{-# LANGUAGE ScopedTypeVariables  #-}
-{-# LANGUAGE TupleSections        #-}
-{-# LANGUAGE UndecidableInstances #-}
-
+{-# LANGUAGE BangPatterns             #-}
+{-# LANGUAGE DataKinds                #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE FlexibleContexts         #-}
+{-# LANGUAGE GADTs                    #-}
+{-# LANGUAGE KindSignatures           #-}
+{-# LANGUAGE NamedFieldPuns           #-}
+{-# LANGUAGE RankNTypes               #-}
+{-# LANGUAGE ScopedTypeVariables      #-}
+{-# LANGUAGE TupleSections            #-}
+{-# LANGUAGE UndecidableInstances     #-}
+
+--{-# OPTIONS_GHC -fno-ignore-asserts #-}
 -- | The implementation of connection manager.
 --
 -- The module should be imported qualified.
@@ -53,7 +55,6 @@ import Data.Tuple (swap)
 import Data.Wedge
 import Data.Word (Word32)
 
-import Network.Mux.Trace qualified as Mx
 import Network.Mux.Types qualified as Mx
 
 import Ouroboros.Network.ConnectionId
@@ -64,7 +65,7 @@ import Ouroboros.Network.ConnectionManager.State (ConnStateIdSupply,
            ConnectionManagerState, ConnectionState (..), MutableConnState (..))
 import Ouroboros.Network.ConnectionManager.State qualified as State
 import Ouroboros.Network.ConnectionManager.Types
-import Ouroboros.Network.InboundGovernor.Event (NewConnectionInfo (..))
+import Ouroboros.Network.InboundGovernor (Event (..), NewConnectionInfo (..))
 import Ouroboros.Network.MuxMode
 import Ouroboros.Network.NodeToNode.Version (DiffusionMode (..))
 import Ouroboros.Network.Server.RateLimiting (AcceptedConnectionsLimit (..))
@@ -73,7 +74,7 @@ import Ouroboros.Network.Snocket
 
 -- | Arguments for a 'ConnectionManager' which are independent of 'MuxMode'.
 --
-data Arguments handlerTrace socket peerAddr handle handleError versionNumber versionData m =
+data Arguments handlerTrace socket peerAddr handle handleError versionNumber versionData m a b =
     Arguments {
         -- | Connection manager tracer.
         --
@@ -86,10 +87,6 @@ data Arguments handlerTrace socket peerAddr handle handleError versionNumber ver
         trTracer            :: Tracer m (TransitionTrace State.ConnStateId
                                             (ConnectionState peerAddr handle handleError versionNumber m)),
 
-        -- | Mux trace.
-        --
-        muxTracer           :: Tracer m (Mx.WithBearer (ConnectionId peerAddr) Mx.Trace),
-
         -- | @IPv4@ address of the connection manager.  If given, outbound
         -- connections to an @IPv4@ address will bound to it.  To use
         -- bidirectional @TCP@ connections, it must be the same as the server
@@ -156,7 +153,9 @@ data Arguments handlerTrace socket peerAddr handle handleError versionNumber ver
 
         -- | Supply for `ConnStateId`-s.
         --
-        connStateIdSupply   :: ConnStateIdSupply m
+        connStateIdSupply   :: ConnStateIdSupply m,
+
+        classifyHandleError :: handleError -> HandleErrorType
       }
 
 
@@ -358,7 +357,7 @@ data DemoteToColdLocal peerAddr handlerTrace handle handleError version m
 -- is responsible for the resource.
 --
 with
-    :: forall (muxMode :: Mx.Mode) peerAddr socket handlerTrace handle handleError version versionData m a.
+    :: forall (muxMode :: Mx.Mode) peerAddr socket initiatorCtx handlerTrace handle handleError version versionData m a b x.
        ( Alternative (STM m)
        , MonadLabelledSTM   m
        , MonadTraceSTM      m
@@ -376,23 +375,20 @@ with
        , Show     peerAddr
        , Typeable peerAddr
        )
-    => Arguments handlerTrace socket peerAddr handle handleError version versionData m
-    -> ConnectionHandler  muxMode handlerTrace socket peerAddr handle handleError version versionData m
-    -- ^ Callback which runs in a thread dedicated for a given connection.
-    -> (handleError -> HandleErrorType)
-    -- ^ classify 'handleError's
-    -> InResponderMode muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
+    => Arguments handlerTrace socket peerAddr handle handleError version versionData m a b
+    -> InResponderMode muxMode (InformationChannel (Event muxMode handle initiatorCtx peerAddr versionData m a b) m)
     -- ^ On outbound duplex connections we need to notify the server about
     -- a new connection.
-    -> (ConnectionManager muxMode socket peerAddr handle handleError m -> m a)
+    -> ConnectionHandler muxMode handlerTrace socket peerAddr handle handleError version versionData m
+    -- ^ ConnectionHandler which negotiates a connection and hosts the mux
+    -> (ConnectionManager muxMode socket peerAddr handle handleError m -> m x)
     -- ^ Continuation which receives the 'ConnectionManager'.  It must not leak
     -- outside of scope of this callback.  Once it returns all resources
     -- will be closed.
-    -> m a
+    -> m x
 with args@Arguments {
          tracer,
          trTracer,
-         muxTracer,
          ipv4Address,
          ipv6Address,
          addressType,
@@ -406,13 +402,13 @@ with args@Arguments {
          prunePolicy,
          connectionsLimits,
          updateVersionData,
-         connStateIdSupply
+         connStateIdSupply,
+         classifyHandleError
        }
-     ConnectionHandler {
-         connectionHandler
-       }
-     classifyHandleError
      inboundGovernorInfoChannel
+     ConnectionHandler {
+       connectionHandler
+     }
      k = do
     ((stateVar, stdGenVar)
        ::  ( StrictTMVar m (ConnectionManagerState peerAddr handle handleError
@@ -426,7 +422,7 @@ with args@Arguments {
             st' <- case mbst of
               Nothing -> pure Nothing
               Just st -> Just <$> traverse (inspectTVar (Proxy :: Proxy m) . toLazyTVar . connVar) st
-            return (TraceString (show st'))
+            return (TraceString ("cm-state: " <> show st'))
 
           stdGenVar <- newTVar (stdGen args)
           return (v, stdGenVar)
@@ -576,7 +572,7 @@ with args@Arguments {
             -- time and making us go above timeout schedules.
             traverse
               (\thread -> do
-                throwTo (asyncThreadId thread) AsyncCancelled
+                throwTo (asyncThreadId thread) Mx.ColdBlooded
                 pure thread
               )
               (getConnThread connState)
@@ -624,10 +620,7 @@ with args@Arguments {
             (handler updateVersionDataFn socket writer
                      (TrConnectionHandler connId `contramap` tracer)
                      connId
-                     (\bearerTimeout ->
-                       getBearer makeBearer
-                         bearerTimeout
-                         (Mx.WithBearer connId `contramap` muxTracer))
+                     (\bearerTimeout -> getBearer makeBearer bearerTimeout)
                      withBuffer)
             unmask
           `finally` cleanup
@@ -1054,8 +1047,8 @@ with args@Arguments {
                     case inboundGovernorInfoChannel of
                       InResponderMode infoChannel ->
                         atomically $ InfoChannel.writeMessage
-                                       infoChannel
-                                       (NewConnectionInfo provenance connId dataFlow handle)
+                                       infoChannel $
+                                       NewConnection (NewConnectionInfo provenance connId dataFlow handle)
                       _ -> return ()
                     return $ Connected connId dataFlow handle
 
@@ -1073,7 +1066,7 @@ with args@Arguments {
            m (ConnectionManagerState peerAddr handle handleError version m)
       -> MutableConnState peerAddr handle handleError version m
       -> Maybe handleError
-      -> m (Connected peerAddr handle1 handleError)
+      -> m (Connected peerAddr handle handleError)
     terminateInboundWithErrorOrQuery connId connStateId connVar connThread stateVar mutableConnState handleErrorM = do
         transitions <- atomically $ do
           connState <- readTVar connVar
@@ -1654,21 +1647,17 @@ with args@Arguments {
                           --    → OutboundDupState^\tau Outbound
                           -- @
                           let connState' = OutboundDupState connId connThread handle Ticking
-                              notifyInboundGov =
-                                case provenance' of
-                                  Inbound  -> False
-                                  -- This is a connection to oneself; We don't
-                                  -- need to notify the inbound governor, as
-                                  -- it's already done by
-                                  -- `includeInboundConnectionImpl`
-                                  Outbound -> True
                           writeTVar connVar connState'
-                          case inboundGovernorInfoChannel of
-                            InResponderMode infoChannel | notifyInboundGov ->
-                              InfoChannel.writeMessage
-                                infoChannel
-                                (NewConnectionInfo provenance' connId dataFlow handle)
-                            _ -> return ()
+                          case provenance' of
+                            Outbound | InResponderMode infoChannel <- inboundGovernorInfoChannel ->
+                              InfoChannel.writeMessage infoChannel .
+                                NewConnection $ NewConnectionInfo provenance' connId dataFlow handle
+                            -- This is a connection to oneself; We don't
+                            -- need to notify the inbound governor, as
+                            -- it's already done by
+                            -- `includeInboundConnectionImpl`
+                            _otherwise -> return ()
+
                           return (Just $ mkTransition connState connState')
 
                     -- @
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/InformationChannel.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/InformationChannel.hs
index a133382ec4c..4050875036d 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/InformationChannel.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/InformationChannel.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE RankNTypes     #-}
 module Ouroboros.Network.ConnectionManager.InformationChannel
   ( InformationChannel (..)
-  , InboundGovernorInfoChannel
   , newInformationChannel
   ) where
 
@@ -11,10 +10,6 @@ import Control.Concurrent.Class.MonadSTM.Strict
 
 import Data.Functor (($>))
 import GHC.Natural (Natural)
-import Network.Mux qualified as Mux
-import Ouroboros.Network.ConnectionHandler (Handle)
-import Ouroboros.Network.Context (ResponderContext)
-import Ouroboros.Network.InboundGovernor.Event (NewConnectionInfo)
 
 -- | Information channel.
 --
@@ -24,20 +19,16 @@ data InformationChannel a m =
     --
     readMessage  :: STM m a,
 
+    -- | Efficiently flush all values from the channel
+    -- for batch processing
+    --
+    readMessages :: STM m [a],
+
     -- | Write a value to the channel.
     --
     writeMessage :: a -> STM m ()
   }
 
--- | A channel which instantiates to 'NewConnectionInfo' and
--- 'Handle'.
---
--- * /Producer:/ connection manger for duplex outbound connections.
--- * /Consumer:/ inbound governor.
---
-type InboundGovernorInfoChannel (muxMode :: Mux.Mode) initiatorCtx peerAddr versionData bytes m a b =
-    InformationChannel (NewConnectionInfo peerAddr (Handle muxMode initiatorCtx (ResponderContext peerAddr) versionData bytes m a b)) m
-
 
 -- | Create a new 'InformationChannel' backed by a `TBQueue`.
 --
@@ -50,6 +41,7 @@ newInformationChannel = do
         >>= \q -> labelTBQueue q "server-cc" $> q
     pure $ InformationChannel {
         readMessage  = readTBQueue channel,
+        readMessages = flushTBQueue channel,
         writeMessage = writeTBQueue channel
       }
 
@@ -57,4 +49,4 @@ newInformationChannel = do
 -- | The 'InformationChannel's 'TBQueue' depth.
 --
 cc_QUEUE_BOUND :: Natural
-cc_QUEUE_BOUND = 10
+cc_QUEUE_BOUND = 100
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs
index 39a4c5932ce..6d9b446a3e8 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs
@@ -1,13 +1,15 @@
-{-# LANGUAGE BangPatterns        #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE KindSignatures      #-}
-{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE NamedFieldPuns      #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE BlockArguments        #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE NamedFieldPuns        #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeOperators         #-}
 
 -- 'runResponder' is using a redundant constraint.
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
@@ -25,6 +27,8 @@ module Ouroboros.Network.InboundGovernor
     -- * Trace
   , Trace (..)
   , Debug (..)
+  , Event (..)
+  , NewConnectionInfo (..)
   , RemoteSt (..)
   , RemoteTransition
   , RemoteTransitionTrace
@@ -32,6 +36,7 @@ module Ouroboros.Network.InboundGovernor
     -- * Re-exports
   , Transition' (..)
   , TransitionTrace' (..)
+  , ResponderCounters (..)
     -- * API's exported for testing purposes
   , maturedPeers
   ) where
@@ -40,13 +45,13 @@ import Control.Applicative (Alternative)
 import Control.Concurrent.Class.MonadSTM qualified as LazySTM
 import Control.Concurrent.Class.MonadSTM.Strict
 import Control.Exception (SomeAsyncException (..))
-import Control.Monad (foldM)
+import Control.Monad (foldM, forM_, forever)
 import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadFork
 import Control.Monad.Class.MonadThrow
 import Control.Monad.Class.MonadTime.SI
 import Control.Monad.Class.MonadTimer.SI
-import Control.Tracer (Tracer, traceWith)
+import Control.Tracer (Tracer (..), traceWith)
 
 import Data.Bifunctor (first)
 import Data.ByteString.Lazy (ByteString)
@@ -61,19 +66,18 @@ import Data.Set qualified as Set
 import Data.Void (Void)
 
 import Network.Mux qualified as Mux
+import Network.Mux.Types qualified as Mux
 
 import Ouroboros.Network.ConnectionHandler
 import Ouroboros.Network.ConnectionManager.InformationChannel
-           (InboundGovernorInfoChannel)
+           (InformationChannel)
 import Ouroboros.Network.ConnectionManager.InformationChannel qualified as InfoChannel
 import Ouroboros.Network.ConnectionManager.Types
 import Ouroboros.Network.Context
-import Ouroboros.Network.InboundGovernor.Event
 import Ouroboros.Network.InboundGovernor.State
 import Ouroboros.Network.Mux
 import Ouroboros.Network.Server.RateLimiting
 
-
 -- | Period of time after which a peer transitions from a fresh to a mature one,
 -- see `matureDuplexPeers` and `freshDuplexPeers`.
 --
@@ -88,7 +92,9 @@ inactionTimeout :: DiffTime
 inactionTimeout = 31.415927
 
 
-data Arguments muxMode socket initiatorCtx peerAddr versionNumber versionData m a b = Arguments {
+data Arguments muxMode handlerTrace socket peerAddr initiatorCtx responderCtx
+               handle handleError versionNumber versionData bytes m a b x =
+  Arguments {
       transitionTracer   :: Tracer m (RemoteTransitionTrace peerAddr),
       -- ^ transition tracer
       tracer             :: Tracer m (Trace peerAddr),
@@ -97,17 +103,26 @@ data Arguments muxMode socket initiatorCtx peerAddr versionNumber versionData m
       -- ^ debug inbound governor tracer
       connectionDataFlow :: versionData -> DataFlow,
       -- ^ connection data flow
-      infoChannel        :: InboundGovernorInfoChannel muxMode initiatorCtx peerAddr versionData ByteString m a b,
+      infoChannel        :: InboundGovernorInfoChannel muxMode peerAddr initiatorCtx versionData ByteString m a b,
       -- ^ 'InformationChannel' which passes 'NewConnectionInfo' for outbound
       -- connections from connection manager to the inbound governor.
       idleTimeout        :: Maybe DiffTime,
       -- ^ protocol idle timeout.  The remote site must restart a mini-protocol
       -- within given timeframe (Nothing indicates no timeout).
-      connectionManager  :: MuxConnectionManager muxMode socket initiatorCtx
-                                                    (ResponderContext peerAddr) peerAddr
-                                                    versionData versionNumber
-                                                    ByteString m a b
-      -- ^ connection manager
+      withConnectionManager
+        :: ConnectionHandler muxMode handlerTrace socket peerAddr handle handleError versionNumber versionData m
+        -> (ConnectionManager muxMode socket peerAddr handle handleError m -> m x)
+        -> m x,
+      -- ^ connection manager continuation
+      mkConnectionHandler
+        :: (   StrictTVar m (Maybe ResponderCounters)
+            -> Tracer m (Mux.WithBearer (ConnectionId peerAddr) Mux.Trace))
+        -> ConnectionHandler muxMode handlerTrace socket peerAddr handle handleError versionNumber versionData m
+      -- ^ Connection handler builder, which injects a special tracer
+      -- created here and routed into the muxer via the connection manager.
+      -- The purpose is to inform the IG loop
+      -- of miniprotocol responder activity such that proper and efficient
+      -- peer cold/warm/hot transitions can be tracked.
     }
 
 
@@ -126,7 +141,8 @@ data Arguments muxMode socket initiatorCtx peerAddr versionNumber versionData m
 -- The first one is used in data diffusion for /Node-To-Node protocol/, while the
 -- other is useful for running a server for the /Node-To-Client protocol/.
 --
-with :: forall (muxMode :: Mux.Mode) socket initiatorCtx peerAddr versionData versionNumber m a b x.
+with :: forall (muxMode :: Mux.Mode) socket peerAddr initiatorCtx responderCtx
+               handle handlerTrace handleError versionData versionNumber bytes m a b x.
         ( Alternative (STM m)
         , MonadAsync       m
         , MonadCatch       m
@@ -139,32 +155,181 @@ with :: forall (muxMode :: Mux.Mode) socket initiatorCtx peerAddr versionData ve
         , MonadMask        m
         , Ord peerAddr
         , HasResponder muxMode ~ True
+        , MonadTraceSTM m
+        , MonadFork m
+        , MonadDelay m
+        , Show peerAddr
         )
-     => Arguments muxMode socket initiatorCtx peerAddr versionNumber versionData m a b
-     -> (Async m Void -> m (PublicState peerAddr versionData) -> m x)
+     => Arguments muxMode handlerTrace socket peerAddr initiatorCtx responderCtx
+                  handle handleError versionNumber versionData bytes m a b x
+     -> (   Async m Void
+         -> m (PublicState peerAddr versionData)
+         -> ConnectionManager muxMode socket peerAddr handle handleError m
+         -> m x)
      -> m x
 with
     Arguments {
-      transitionTracer   = trTracer,
-      tracer             = tracer,
-      debugTracer        = debugTracer,
-      connectionDataFlow = connectionDataFlow,
-      infoChannel        = infoChannel,
-      idleTimeout        = idleTimeout,
-      connectionManager  = connectionManager
+      transitionTracer = trTracer,
+      tracer,
+      debugTracer,
+      connectionDataFlow,
+      idleTimeout,
+      infoChannel,
+      withConnectionManager,
+      mkConnectionHandler
     }
     k
     = do
     labelThisThread "inbound-governor"
-    var <- newTVarIO (mkPublicState emptyState)
-    withAsync ((do
-               labelThisThread "inbound-governor-loop"
-               inboundGovernorLoop var emptyState)
-                `catch`
-               handleError var) $
+    stateVar <- newTVarIO emptyState
+    let connectionHandler = mkConnectionHandler $ responderIgTracer stateVar
+    withConnectionManager connectionHandler \connectionManager ->
+      withAsync
+        (  labelThisThread "inbound-governor-loop" >>
+           forever (inboundGovernorStep connectionManager stateVar >> yield)
+         `catch`
+           handleError stateVar)
       \thread ->
-        k thread (readTVarIO var)
+        k thread (mkPublicState <$> readTVarIO stateVar) connectionManager
   where
+    -- the responder IG info channel tracer is embedded with the mux tracer unconditionally
+    -- by the conn handler on the inbound side and conditionally for 'InitiatorResponderMode'
+    -- on the outbound side only when the latter has negotiated a 'Duplex' data flow - otherwise
+    -- for unidirectional mode the IG is never provided with the peer handle since the inbound
+    -- is inactive.
+    responderIgTracer :: StrictTVar m (State muxMode initiatorCtx peerAddr versionData m a b)
+                      -> StrictTVar m (Maybe ResponderCounters)
+                      -> Tracer m (Mux.WithBearer (ConnectionId peerAddr) Mux.Trace)
+    responderIgTracer stateVar countersVar = Tracer $ \(Mux.WithBearer peer trace) ->
+      -- hello from muxer main thread
+      case trace of
+        Mux.TraceState Mux.Mature -> atomically do
+          -- For inbound and outbound duplex connections, following a successful
+          -- handshake, the muxer begins racing with the connection
+          -- manager on informing the IG of the new connection
+          -- and responder miniprotocols' activity. In principle,
+          -- the problematic case is when the IG tracer registers responder
+          -- miniprotocol launch command before the CM informs the IG of the
+          -- new connection. However unlikely, this will lead to
+          -- incoherent transitions between the two components.
+          -- The muxer blocks itself here to yield right-of-way
+          -- to the CM.
+          check . Map.member peer . connections =<< readTVar stateVar
+
+        _ | Just mid <- startWithID trace -> atomically do
+              connections <- connections <$> readTVar stateVar
+              mCounters   <- readTVar countersVar
+              case (Map.lookup peer connections,
+                    mCounters) of
+                (Just (ConnectionState { csRemoteState, csMiniProtocolMap }),
+                 Just rc@ResponderCounters { numTraceHotResponders,
+                                             numTraceWarmResponders }) -> do
+                  let miniProtocolTemp = getProtocolTemp mid csMiniProtocolMap
+                      commit = do
+                        case (miniProtocolTemp,
+                              numTraceWarmResponders,
+                              numTraceHotResponders) of
+                          (Hot, 0, 0) -> do
+                                InfoChannel.writeMessage infoChannel $ AwakeRemote peer
+                                InfoChannel.writeMessage infoChannel $ RemotePromotedToHot peer
+                          (Hot, _, 0) ->
+                                InfoChannel.writeMessage infoChannel $ RemotePromotedToHot peer
+                          (Hot, _, _) -> pure ()
+                          (_orNot, 0, 0) -> do
+                            InfoChannel.writeMessage infoChannel $ AwakeRemote peer
+                          _otherwise -> pure ()
+                        case miniProtocolTemp of
+                          Hot    -> writeTVar countersVar $ Just rc { numTraceHotResponders = succ numTraceHotResponders }
+                          _orNot -> writeTVar countersVar $ Just rc { numTraceWarmResponders = succ numTraceWarmResponders }
+
+                  case csRemoteState of
+                    -- we retry on expired because we let the IG
+                    -- loop handle this peer. If the connection is released,
+                    -- and CM reports CommitTr, this peer will disappear
+                    -- from the connections so on retry we will hit the
+                    -- _otherwise clause instead and promotion will fail,
+                    -- as it should. Otherwise, if KeepTr is returned,
+                    -- we can handle 'AwakeRemote' from this peer.
+                    RemoteIdle timeoutSTM -> do
+                      expired <- timeoutSTM
+                      if expired then retry else commit
+                    _gogo -> commit
+
+                _otherwise -> writeTVar countersVar Nothing
+
+        _ | Just mid <- terminateWithID trace -> atomically do
+              connections <- connections <$> readTVar stateVar
+              mCounters   <- readTVar countersVar
+              case (Map.lookup peer connections,
+                    mCounters) of
+                (Just (ConnectionState { csMux,
+                                         csVersionData,
+                                         csMiniProtocolMap,
+                                         csCompletionMap }),
+                 Just rc@ResponderCounters { numTraceHotResponders,
+                                             numTraceWarmResponders }) -> do
+                  InfoChannel.writeMessage infoChannel $
+                    MiniProtocolTerminated $ Terminated {
+                      tConnId = peer,
+                      tMux = csMux,
+                      tMiniProtocolData = csMiniProtocolMap Map.! mid,
+                      tDataFlow = connectionDataFlow csVersionData,
+                      tResult = csCompletionMap Map.! mid }
+                  case trace of
+                    Mux.TraceCleanExit {} -> do
+                      let miniProtocolTemp = getProtocolTemp mid csMiniProtocolMap
+                      case ( miniProtocolTemp
+                           , numTraceWarmResponders
+                           , numTraceHotResponders) of
+                        (Hot, 0, 1) -> do
+                          InfoChannel.writeMessage infoChannel $ RemoteDemotedToWarm peer
+                          InfoChannel.writeMessage infoChannel $ WaitIdleRemote peer
+                        (Hot, _, 1) ->
+                              InfoChannel.writeMessage infoChannel $ RemoteDemotedToWarm peer
+                        (Hot, _, _) -> pure ()
+                        (_orNot, 1, 0) ->
+                          InfoChannel.writeMessage infoChannel $ WaitIdleRemote peer
+                        _otherwise -> pure ()
+
+                      case miniProtocolTemp of
+                          Hot    -> writeTVar countersVar $ Just rc { numTraceHotResponders = pred numTraceHotResponders }
+                          _orNot -> writeTVar countersVar $ Just rc { numTraceWarmResponders = pred numTraceWarmResponders }
+
+                    _otherwise -> writeTVar countersVar Nothing
+
+                _otherwise -> writeTVar countersVar Nothing
+
+
+        _ | True <- muxStopped trace -> atomically do
+              State { connections } <- readTVar stateVar
+              case Map.lookup peer connections of
+                Just ConnectionState {csMux} ->
+                  InfoChannel.writeMessage infoChannel $
+                    MuxFinished peer (Mux.stopped csMux)
+                _otherwise -> pure ()
+              writeTVar countersVar Nothing
+
+        _otherwise -> return ()
+      where
+        muxStopped = \case
+          Mux.TraceStopped -> True
+          Mux.TraceState Mux.Dead -> True
+          _otherwise -> False
+
+        getProtocolTemp mid csMiniProtocolMap  =
+          let miniData = csMiniProtocolMap Map.! mid
+           in mpdMiniProtocolTemp miniData
+
+        terminateWithID = \case
+          Mux.TraceCleanExit mid Mux.ResponderDir -> Just mid
+          Mux.TraceExceptionExit mid Mux.ResponderDir _e -> Just mid
+          _otherwise -> Nothing
+
+        startWithID = \case
+          Mux.TraceStartEagerly mid Mux.ResponderDir -> Just mid  -- ^ is any responder started eagerly???
+          Mux.TraceStartedOnDemand mid Mux.ResponderDir -> Just mid
+          _otherwise -> Nothing
+
     emptyState :: State muxMode initiatorCtx peerAddr versionData m a b
     emptyState = State {
         connections       = Map.empty,
@@ -178,11 +343,11 @@ with
     -- NOTE: `inboundGovernorLoop` doesn't throw synchronous exceptions, this is
     -- just need to handle asynchronous exceptions.
     handleError
-      :: StrictTVar m (PublicState peerAddr versionData)
+      :: StrictTVar m (State muxMode initiatorCtx peerAddr versionData m a b)
       -> SomeException
       -> m Void
     handleError var e = do
-      PublicState { remoteStateMap } <- readTVarIO var
+      PublicState { remoteStateMap } <- mkPublicState <$> readTVarIO var
       _ <- Map.traverseWithKey
              (\connId remoteSt ->
                traceWith trTracer $
@@ -193,378 +358,360 @@ with
              remoteStateMap
       throwIO e
 
-    -- The inbound protocol governor recursive loop.  The 'connections' is
-    -- updated as we recurse.
-    --
-    inboundGovernorLoop
-      :: StrictTVar m (PublicState peerAddr versionData)
-      -> State muxMode initiatorCtx peerAddr versionData m a b
-      -> m Void
-    inboundGovernorLoop var !state = do
+    -- The inbound protocol governor single step, which may
+    -- process multipe events from the information channel
+    inboundGovernorStep
+      :: ConnectionManager muxMode socket peerAddr handle handleError m
+      -> StrictTVar m (State muxMode initiatorCtx peerAddr versionData m a b)
+      -> m ()
+    inboundGovernorStep connectionManager stateVar = do
       time <- getMonotonicTime
       inactivityVar <- registerDelay inactionTimeout
+      events <- atomically do
+        state <- readTVar stateVar
+        runFirstToFinish $
+            -- we deliberately read the info channel queue after
+            -- the relevant item in each firsttofinish to limit
+            -- contention
+            FirstToFinish do
+              -- mark connections as mature
+              case maturedPeers time (freshDuplexPeers state) of
+                (as, _)     | Map.null as
+                            -> retry
+                (as, fresh) ->
+                  (MaturedDuplexPeers as fresh :) <$> InfoChannel.readMessages infoChannel
+         <> FirstToFinish do
+              firstCommit <- runFirstToFinish $
+                Map.foldMapWithKey firstPeerCommitRemote (connections state)
+              -- it is important we read the channel here, and join it after
+              -- the firstCommit. Registering protocol starts are synchronized
+              -- with handling an expired peer in an atomic action in the tracer.
+              (firstCommit :) <$> InfoChannel.readMessages infoChannel
+         <> FirstToFinish do
+              muxEvents <- InfoChannel.readMessages infoChannel
+              check (not . null $ muxEvents) >> pure muxEvents
+         <> FirstToFinish do
+              -- spin the inbound governor loop; it will re-run with new
+              -- time, which allows to make some peers mature.
+              LazySTM.readTVar inactivityVar >>= check >> pure [InactivityTimeout]
+
+      forM_ events \event -> do
+        state <- readTVarIO stateVar
+        decision <- case event of
+          NewConnection
+            -- new connection has been announced by either accept loop or
+            -- by connection manager (in which case the connection is in
+            -- 'DuplexState').
+            (NewConnectionInfo
+              provenance
+              connId
+              dataFlow
+              Handle {
+                hMux         = csMux,
+                hMuxBundle   = muxBundle,
+                hVersionData = csVersionData
+              }) -> do
+
+                traceWith tracer (TrNewConnection provenance connId)
+                let responderContext = ResponderContext { rcConnectionId = connId }
+
+                connections <- Map.alterF
+                  (\case
+                    -- connection
+                    Nothing -> do
+                      let csMPMHot =
+                            [ ( miniProtocolNum mpH
+                              , MiniProtocolData mpH responderContext Hot
+                              )
+                            | mpH <- projectBundle SingHot muxBundle
+                            ]
+                          csMPMWarm =
+                            [ ( miniProtocolNum mpW
+                              , MiniProtocolData mpW responderContext Warm
+                              )
+                            | mpW <- projectBundle SingWarm muxBundle
+                            ]
+                          csMPMEstablished =
+                            [ ( miniProtocolNum mpE
+                              , MiniProtocolData mpE responderContext Established
+                              )
+                            | mpE <- projectBundle SingEstablished muxBundle
+                            ]
+                          csMiniProtocolMap =
+                              Map.fromList
+                              (csMPMHot ++ csMPMWarm ++ csMPMEstablished)
+
+                      mCompletionMap
+                        <-
+                        foldM
+                          (\acc mpd@MiniProtocolData { mpdMiniProtocol } ->
+                            runResponder csMux mpd >>= \case
+                              -- synchronous exceptions when starting
+                              -- a mini-protocol are non-recoverable; we
+                              -- close the connection and allow the server
+                              -- to continue.
+                              Left err -> do
+                                traceWith tracer (TrResponderStartFailure connId (miniProtocolNum mpdMiniProtocol) err)
+                                Mux.stop csMux
+                                return Nothing
+
+                              Right completion ->  do
+                                let acc' = Map.insert (miniProtocolNum mpdMiniProtocol)
+                                                      completion
+                                       <$> acc
+                                -- force under lazy 'Maybe'
+                                case acc' of
+                                  Just !_ -> return acc'
+                                  Nothing -> return acc'
+                          )
+                          (Just Map.empty)
+                          csMiniProtocolMap
+
+                      case mCompletionMap of
+                        -- there was an error when starting one of the
+                        -- responders, we let the server continue without this
+                        -- connection.
+                        Nothing -> return Nothing
+
+                        Just csCompletionMap -> do
+                          mv <- traverse registerDelay idleTimeout
+                          let -- initial state is 'RemoteIdle', if the remote end will not
+                              -- start any responders this will unregister the inbound side.
+                              csRemoteState :: RemoteState m
+                              csRemoteState = RemoteIdle (case mv of
+                                                            Nothing -> pure False
+                                                            Just v  -> LazySTM.readTVar v)
+
+                              connState = ConnectionState {
+                                  csMux,
+                                  csVersionData,
+                                  csMiniProtocolMap,
+                                  csCompletionMap,
+                                  csRemoteState
+                                }
+
+                          return (Just connState)
+
+                    -- inbound governor might be notified about a connection
+                    -- which is already tracked.  In such case we preserve its
+                    -- state.
+                    --
+                    -- In particular we preserve an ongoing timeout on
+                    -- 'RemoteIdle' state.
+                    Just connState -> return (Just connState)
+
+                  )
+                  connId
+                  (connections state)
+
+                -- update state and continue the recursive loop
+                let state' = state {
+                        connections,
+                        freshDuplexPeers =
+                          case dataFlow of
+                            Unidirectional -> freshDuplexPeers state
+                            Duplex         -> OrdPSQ.insert (remoteAddress connId) time csVersionData
+                                                            (freshDuplexPeers state)
+                      }
+                return $ StateWithPeerTransition state' connId
+
+          MuxFinished connId result -> do
+
+            merr <- atomically result
+            case merr of
+              Nothing  -> traceWith tracer (TrMuxCleanExit connId)
+              Just err -> traceWith tracer (TrMuxErrored connId err)
+
+            -- the connection manager does should realise this on itself.
+            -- we bypass the assertion check since MuxFinished could have been
+            -- placed on the queue before we managed to remove the connection from
+            -- the private state, but this is benign.
+            let state' = unregisterConnection True connId state
+            return $ StateWithPeerTransition state' connId -- ^ even though it might not be true, but it's benign
+
+          MiniProtocolTerminated
+            Terminated {
+                tConnId,
+                tMux,
+                tMiniProtocolData = mpd@MiniProtocolData { mpdMiniProtocol = miniProtocol },
+                tResult
+              } -> do
+            tResult' <- atomically tResult
+            let num = miniProtocolNum miniProtocol
+            case tResult' of
+              Left e -> do
+                -- a mini-protocol errored.  In this case mux will shutdown, and
+                -- the connection manager will tear down the socket. Before bailing out,
+                -- the IG tracer will emit BearState Dead which will unregister the connection
+                -- in some following iteration via MuxFinished, but for this peer it should
+                -- be the very next message.
+                traceWith tracer $
+                  TrResponderErrored tConnId num e
+                return TraceOnly
+
+              Right _ ->
+                runResponder tMux mpd >>= \case
+                  Right completionAction -> do
+                    traceWith tracer (TrResponderRestarted tConnId num)
+                    let state' = updateMiniProtocol tConnId num completionAction state
+                    return $ OnlyStateChange state'
+
+                  Left err -> do
+                    -- there is no way to recover from synchronous exceptions; we
+                    -- stop mux which allows to close resources held by
+                    -- connection manager.
+                    traceWith tracer (TrResponderStartFailure tConnId num err)
+                    Mux.stop tMux
+                    return TraceOnly
+
+          WaitIdleRemote connId -> do
+            -- @
+            --    DemotedToCold^{dataFlow}_{Remote} : InboundState Duplex
+            --                                      → InboundIdleState Duplex
+            -- @
+            -- NOTE: `demotedToColdRemote` doesn't throw, hence exception handling
+            -- is not needed.
+            res <- demotedToColdRemote connectionManager connId
+            traceWith tracer (TrWaitIdleRemote connId res)
+            case res of
+              OperationSuccess {}  -> do
+                mv <- traverse registerDelay idleTimeout
+                let timeoutSTM :: STM m Bool
+                    !timeoutSTM = case mv of
+                      Nothing -> pure False
+                      Just v  -> LazySTM.readTVar v
+
+                    state' = updateRemoteState connId (RemoteIdle timeoutSTM) state
+
+                return $ StateWithPeerTransition state' connId
+              -- if the connection handler failed by this time, it will have
+              -- written BearerState Dead to the IG tracer and we will handle this
+              -- in MuxFinished case on the next iteration, where it will unregister
+              -- the connection
+              _otherwise -> return TraceOnly
 
-      event
-        <- atomically $ runFirstToFinish $
-               FirstToFinish  (
-                 -- mark connections as mature
-                 case maturedPeers time (freshDuplexPeers state) of
-                   (as, _)     | Map.null as
-                               -> retry
-                   (as, fresh) -> pure $ MaturedDuplexPeers as fresh
-               )
-            <> Map.foldMapWithKey
-                 (    firstMuxToFinish
-                   <> firstPeerDemotedToCold
-                   <> firstPeerCommitRemote
-                   <> firstMiniProtocolToFinish connectionDataFlow
-                   <> firstPeerPromotedToWarm
-                   <> firstPeerPromotedToHot
-                   <> firstPeerDemotedToWarm
-
-                   :: EventSignal muxMode initiatorCtx peerAddr versionData m a b
-                 )
-                 (connections state)
-            <> FirstToFinish (
-                 NewConnection <$> InfoChannel.readMessage infoChannel
-               )
-            <> FirstToFinish (
-                  -- spin the inbound governor loop; it will re-run with new
-                  -- time, which allows to make some peers mature.
-                  LazySTM.readTVar inactivityVar >>= check >> pure InactivityTimeout
-               )
-      (mbConnId, state') <- case event of
-        NewConnection
-          -- new connection has been announced by either accept loop or
-          -- by connection manager (in which case the connection is in
-          -- 'DuplexState').
-          (NewConnectionInfo
-            provenance
-            connId
-            dataFlow
-            Handle {
-              hMux         = csMux,
-              hMuxBundle   = muxBundle,
-              hVersionData = csVersionData
-            }) -> do
-
-              traceWith tracer (TrNewConnection provenance connId)
-              let responderContext = ResponderContext { rcConnectionId = connId }
-
-              connections <- Map.alterF
-                (\case
-                  -- connection
-                  Nothing -> do
-                    let csMPMHot =
-                          [ ( miniProtocolNum mpH
-                            , MiniProtocolData mpH responderContext Hot
-                            )
-                          | mpH <- projectBundle SingHot muxBundle
-                          ]
-                        csMPMWarm =
-                          [ ( miniProtocolNum mpW
-                            , MiniProtocolData mpW responderContext Warm
-                            )
-                          | mpW <- projectBundle SingWarm muxBundle
-                          ]
-                        csMPMEstablished =
-                          [ ( miniProtocolNum mpE
-                            , MiniProtocolData mpE responderContext Established
-                            )
-                          | mpE <- projectBundle SingEstablished muxBundle
-                          ]
-                        csMiniProtocolMap =
-                            Map.fromList
-                            (csMPMHot ++ csMPMWarm ++ csMPMEstablished)
-
-                    mCompletionMap
-                      <-
-                      foldM
-                        (\acc mpd@MiniProtocolData { mpdMiniProtocol } ->
-                          runResponder csMux mpd >>= \case
-                            -- synchronous exceptions when starting
-                            -- a mini-protocol are non-recoverable; we
-                            -- close the connection and allow the server
-                            -- to continue.
-                            Left err -> do
-                              traceWith tracer (TrResponderStartFailure connId (miniProtocolNum mpdMiniProtocol) err)
-                              Mux.stop csMux
-                              return Nothing
-
-                            Right completion ->  do
-                              let acc' = Map.insert (miniProtocolNum mpdMiniProtocol)
-                                                    completion
-                                     <$> acc
-                              -- force under lazy 'Maybe'
-                              case acc' of
-                                Just !_ -> return acc'
-                                Nothing -> return acc'
-                        )
-                        (Just Map.empty)
-                        csMiniProtocolMap
-
-                    case mCompletionMap of
-                      -- there was an error when starting one of the
-                      -- responders, we let the server continue without this
-                      -- connection.
-                      Nothing -> return Nothing
-
-                      Just csCompletionMap -> do
-                        mv <- traverse registerDelay idleTimeout
-                        let -- initial state is 'RemoteIdle', if the remote end will not
-                            -- start any responders this will unregister the inbound side.
-                            csRemoteState :: RemoteState m
-                            csRemoteState = RemoteIdle (case mv of
-                                                          Nothing -> retry
-                                                          Just v  -> LazySTM.readTVar v >>= check)
-
-                            connState = ConnectionState {
-                                csMux,
-                                csVersionData,
-                                csMiniProtocolMap,
-                                csCompletionMap,
-                                csRemoteState
-                              }
-
-                        return (Just connState)
-
-                  -- inbound governor might be notified about a connection
-                  -- which is already tracked.  In such case we preserve its
-                  -- state.
-                  --
-                  -- In particular we preserve an ongoing timeout on
-                  -- 'RemoteIdle' state.
-                  Just connState -> return (Just connState)
-
-                )
-                connId
-                (connections state)
-
-              time' <- getMonotonicTime
-              -- update state and continue the recursive loop
-              let state' = state {
-                      connections,
-                      freshDuplexPeers =
-                        case dataFlow of
-                          Unidirectional -> freshDuplexPeers state
-                          Duplex         -> OrdPSQ.insert (remoteAddress connId) time' csVersionData
-                                                          (freshDuplexPeers state)
-                    }
-              return (Just connId, state')
-
-        MuxFinished connId merr -> do
-
-          case merr of
-            Nothing  -> traceWith tracer (TrMuxCleanExit connId)
-            Just err -> traceWith tracer (TrMuxErrored connId err)
-
-          -- the connection manager does should realise this on itself.
-          let state' = unregisterConnection connId state
-          return (Just connId, state')
-
-        MiniProtocolTerminated
-          Terminated {
-              tConnId,
-              tMux,
-              tMiniProtocolData = mpd@MiniProtocolData { mpdMiniProtocol = miniProtocol },
-              tResult
-            } ->
-          let num = miniProtocolNum miniProtocol in
-          case tResult of
-            Left e -> do
-              -- a mini-protocol errored.  In this case mux will shutdown, and
-              -- the connection manager will tear down the socket.  We can just
-              -- forget the connection from 'State'.
-              traceWith tracer $
-                TrResponderErrored tConnId num e
-
-              let state' = unregisterConnection tConnId state
-              return (Just tConnId, state')
-
-            Right _ ->
-              runResponder tMux mpd >>= \case
-                Right completionAction -> do
-                  traceWith tracer (TrResponderRestarted tConnId num)
-                  let state' = updateMiniProtocol tConnId num completionAction state
-                  return (Nothing, state')
-
-                Left err -> do
-                  -- there is no way to recover from synchronous exceptions; we
-                  -- stop mux which allows to close resources held by
-                  -- connection manager.
-                  traceWith tracer (TrResponderStartFailure tConnId num err)
-                  Mux.stop tMux
-
-                  let state' = unregisterConnection tConnId state
-
-                  return (Just tConnId, state')
-
-
-        WaitIdleRemote connId -> do
           -- @
-          --    DemotedToCold^{dataFlow}_{Remote} : InboundState Duplex
-          --                                      → InboundIdleState Duplex
+          --    PromotedToWarm^{Duplex}_{Remote}
+          -- @
+          -- or
+          -- @
+          --    Awake^{dataFlow}_{Remote}
           -- @
-          -- NOTE: `demotedToColdRemote` doesn't throw, hence exception handling
-          -- is not needed.
-          res <- demotedToColdRemote connectionManager connId
-          traceWith tracer (TrWaitIdleRemote connId res)
-          case res of
-            TerminatedConnection {} -> do
-              let state' = unregisterConnection connId state
-              return (Just connId, state')
-            OperationSuccess {}  -> do
-              mv <- traverse registerDelay idleTimeout
-              let timeoutSTM :: STM m ()
-                  !timeoutSTM = case mv of
-                    Nothing -> retry
-                    Just v  -> LazySTM.readTVar v >>= check
-
-              let state' = updateRemoteState connId (RemoteIdle timeoutSTM) state
-
-              return (Just connId, state')
-            -- It could happen that the connection got deleted by connection
-            -- manager due to some async exception so we need to unregister it
-            -- from the inbound governor state.
-            UnsupportedState UnknownConnectionSt -> do
-              let state' = unregisterConnection connId state
-              return (Just connId, state')
-            UnsupportedState {} -> do
-              return (Just connId, state)
-
-        -- @
-        --    PromotedToWarm^{Duplex}_{Remote}
-        -- @
-        -- or
-        -- @
-        --    Awake^{dataFlow}_{Remote}
-        -- @
-        --
-        -- Note: the 'AwakeRemote' is detected as soon as mux detects any
-        -- traffic.  This means that we'll observe this transition also if the
-        -- first message that arrives is terminating a mini-protocol.
-        AwakeRemote connId -> do
-          -- notify the connection manager about the transition
           --
-          -- NOTE: `promotedToWarmRemote` doesn't throw, hence exception handling
-          -- is not needed.
-          res <- promotedToWarmRemote connectionManager connId
-          traceWith tracer (TrPromotedToWarmRemote connId res)
-
-          case resultInState res of
-            UnknownConnectionSt -> do
-              let state' = unregisterConnection connId state
-              return (Just connId, state')
-            _ -> do
-              let state' = updateRemoteState
-                             connId
-                             RemoteWarm
-                             state
-              return (Just connId, state')
-
-        RemotePromotedToHot connId -> do
-          traceWith tracer (TrPromotedToHotRemote connId)
-          let state' = updateRemoteState connId RemoteHot state
-
-          return (Just connId, state')
-
-        RemoteDemotedToWarm connId -> do
-          traceWith tracer (TrDemotedToWarmRemote connId)
-          let state' = updateRemoteState connId RemoteWarm state
-
-          return (Just connId, state')
-
-        CommitRemote connId -> do
-          -- NOTE: `releaseInboundConnection` doesn't throw, hence exception
-          -- handling is not needed.
-          res <- releaseInboundConnection connectionManager connId
-          traceWith tracer $ TrDemotedToColdRemote connId res
-          case res of
-            UnsupportedState {} -> do
-              -- 'inState' can be either:
-              -- @'UnknownConnection'@,
-              -- @'InReservedOutboundState'@,
-              -- @'InUnnegotiatedState',
-              -- @'InOutboundState' 'Unidirectional'@,
-              -- @'InTerminatingState'@,
-              -- @'InTermiantedState'@.
-              let state' = unregisterConnection connId state
-              return (Just connId, state')
-
-            TerminatedConnection {} -> do
-              -- 'inState' can be either:
-              -- @'InTerminatingState'@,
-              -- @'InTermiantedState'@.
-              let state' = unregisterConnection connId state
-              return (Just connId, state')
-
-            OperationSuccess transition ->
-              case transition of
-                -- the following two cases are when the connection was not used
-                -- by p2p-governor, the connection will be closed.
-                CommitTr -> do
+          -- Note: the 'AwakeRemote' is detected as soon as mux detects any
+          -- traffic.  This means that we'll observe this transition also if the
+          -- first message that arrives is terminating a mini-protocol.
+          AwakeRemote connId -> do
+            -- notify the connection manager about the transition
+            --
+            -- NOTE: `promotedToWarmRemote` doesn't throw, hence exception handling
+            -- is not needed.
+            res <- promotedToWarmRemote connectionManager connId
+            traceWith tracer (TrPromotedToWarmRemote connId res)
+
+            let state' = updateRemoteState
+                           connId
+                           RemoteWarm
+                           state
+            return $ StateWithPeerTransition state' connId
+
+          RemotePromotedToHot connId -> do
+            traceWith tracer (TrPromotedToHotRemote connId)
+            let state' = updateRemoteState connId RemoteHot state
+            return $ StateWithPeerTransition state' connId
+
+          RemoteDemotedToWarm connId -> do
+            traceWith tracer (TrDemotedToWarmRemote connId)
+            let state' = updateRemoteState connId RemoteWarm state
+            return $ StateWithPeerTransition state' connId
+
+          CommitRemote connId -> do
+            -- NOTE: `releaseInboundConnection` doesn't throw, hence exception
+            -- handling is not needed.
+            res <- releaseInboundConnection connectionManager connId
+            traceWith tracer $ TrDemotedToColdRemote connId res
+            case res of
+              OperationSuccess transition ->
+                case transition of
+                  -- the following two cases are when the connection was not used
+                  -- by p2p-governor, the connection will be closed.
+                  CommitTr -> do
+                    -- @
+                    --    Commit^{dataFlow}_{Remote} : InboundIdleState dataFlow
+                    --                               → TerminatingState
+                    -- @
+                    let state' = unregisterConnection False connId state
+                    return $ StateWithPeerTransition state' connId
+
+                  -- the connection is still used by p2p-governor, carry on but put
+                  -- it in 'RemoteCold' state.  This will ensure we keep ready to
+                  -- serve the peer.
+                  -- @
+                  --    DemotedToCold^{Duplex}_{Remote} : DuplexState
+                  --                                    → OutboundState Duplex
+                  -- @
+                  -- or
                   -- @
-                  --    Commit^{dataFlow}_{Remote} : InboundIdleState dataFlow
-                  --                               → TerminatingState
+                  --    Awake^{Duplex}^{Local} : InboundIdleState Duplex
+                  --                           → OutboundState Duplex
                   -- @
-                  let state' = unregisterConnection connId state
-                  return (Just connId, state')
-
-                -- the connection is still used by p2p-governor, carry on but put
-                -- it in 'RemoteCold' state.  This will ensure we keep ready to
-                -- serve the peer.
-                -- @
-                --    DemotedToCold^{Duplex}_{Remote} : DuplexState
-                --                                    → OutboundState Duplex
-                -- @
-                -- or
-                -- @
-                --    Awake^{Duplex}^{Local} : InboundIdleState Duplex
-                --                           → OutboundState Duplex
-                -- @
-                --
-                -- note: the latter transition is level triggered rather than
-                -- edge triggered. The server state is updated once protocol
-                -- idleness expires rather than as soon as the connection
-                -- manager was requested outbound connection.
-                KeepTr -> do
-                  let state' = updateRemoteState connId RemoteCold state
-
-                  return (Just connId, state')
-
-        MaturedDuplexPeers newMatureDuplexPeers freshDuplexPeers -> do
-          traceWith tracer $ TrMaturedConnections (Map.keysSet newMatureDuplexPeers)
-                                                  (Set.fromList $ OrdPSQ.keys freshDuplexPeers)
-          pure (Nothing, state { matureDuplexPeers = newMatureDuplexPeers
-                                                  <> matureDuplexPeers state,
-                                 freshDuplexPeers })
-
-        InactivityTimeout -> do
-          traceWith tracer $ TrInactive ((\(a,b,_) -> (a,b)) <$> OrdPSQ.toList (freshDuplexPeers state))
-          pure (Nothing, state)
-
-      mask_ $ do
-        atomically $ writeTVar var (mkPublicState state')
-        traceWith debugTracer (Debug state')
-        case mbConnId of
-          Just cid -> traceWith trTracer (mkRemoteTransitionTrace cid state state')
-          Nothing  -> pure ()
-
-      mapTraceWithCache TrInboundGovernorCounters
-                        tracer
-                        (countersCache state')
-                        (counters state')
-      traceWith tracer $ TrRemoteState $
-            mkRemoteSt . csRemoteState
-        <$> connections state'
-
-      -- Update Inbound Governor Counters cache values
-      let newCounters       = counters state'
-          Cache oldCounters = countersCache state'
-          state'' | newCounters /= oldCounters = state' { countersCache = Cache newCounters }
-                  | otherwise                 = state'
-
-      inboundGovernorLoop var state''
+                  --
+                  -- note: the latter transition is level triggered rather than
+                  -- edge triggered. The server state is updated once protocol
+                  -- idleness expires rather than as soon as the connection
+                  -- manager was requested outbound connection.
+                  KeepTr -> do
+                    let state' = updateRemoteState connId RemoteCold state
+                    return $ StateWithPeerTransition state' connId
+
+              _otherwise -> return TraceOnly
+
+          MaturedDuplexPeers newMatureDuplexPeers freshDuplexPeers -> do
+            traceWith tracer $ TrMaturedConnections (Map.keysSet newMatureDuplexPeers)
+                                                    (Set.fromList $ OrdPSQ.keys freshDuplexPeers)
+            return $ OnlyStateChange state { matureDuplexPeers = newMatureDuplexPeers
+                                                               <> matureDuplexPeers state,
+                                             freshDuplexPeers }
+
+          InactivityTimeout -> do
+            traceWith tracer $ TrInactive ((\(a,b,_) -> (a,b)) <$> OrdPSQ.toList (freshDuplexPeers state))
+            return TraceOnly
+
+        mask_ $ do
+          case decision of
+            OnlyStateChange state' -> do
+              atomically $ writeTVar stateVar state'
+              traceWith debugTracer (Debug state')
+            StateWithPeerTransition state' p -> do
+              atomically $ writeTVar stateVar state'
+              traceWith debugTracer (Debug state')
+              traceWith trTracer (mkRemoteTransitionTrace p state state')
+            _otherwise -> pure ()
+
+        case decision of
+          _ | Just state' <- withState -> do
+                mapTraceWithCache TrInboundGovernorCounters
+                                  tracer
+                                  (countersCache state')
+                                  (counters state')
+                traceWith tracer $ TrRemoteState $
+                      mkRemoteSt . csRemoteState
+                  <$> connections state'
+
+                -- Update Inbound Governor Counters cache values
+                let newCounters       = counters state'
+                    Cache oldCounters = countersCache state'
+                    state'' | newCounters /= oldCounters = state' { countersCache = Cache newCounters }
+                            | otherwise                 = state'
+
+                atomically $ writeTVar stateVar state''
+            where
+              withState = case decision of
+                OnlyStateChange s            -> Just s
+                StateWithPeerTransition s _p -> Just s
+                _otherwise                   -> Nothing
+
+          _otherwise -> return ()
 
 
 -- | Run a responder mini-protocol.
@@ -646,6 +793,129 @@ mkRemoteTransitionTrace connId fromState toState =
                  }
 
 
+-- | A channel which instantiates to 'NewConnectionInfo' and
+-- 'Handle'.
+--
+-- * /Producer:/ connection manger for duplex outbound connections.
+-- * /Consumer:/ inbound governor.
+--
+type InboundGovernorInfoChannel (muxMode :: Mux.Mode) peerAddr initiatorCtx versionData bytes m a b =
+    InformationChannel (Event (muxMode :: Mux.Mode) (Handle muxMode initiatorCtx (ResponderContext peerAddr) versionData bytes m a b) initiatorCtx peerAddr versionData m a b) m
+
+
+-- | Announcement message for a new connection.
+--
+data NewConnectionInfo peerAddr handle
+
+    -- | Announce a new connection.  /Inbound protocol governor/ will start
+    -- responder protocols using 'StartOnDemand' strategy and monitor remote
+    -- transitions: @PromotedToWarm^{Duplex}_{Remote}@ and
+    -- @DemotedToCold^{dataFlow}_{Remote}@.
+    = NewConnectionInfo
+      !Provenance
+      !(ConnectionId peerAddr)
+      !DataFlow
+      !handle
+
+instance Show peerAddr
+      => Show (NewConnectionInfo peerAddr handle) where
+      show (NewConnectionInfo provenance connId dataFlow _) =
+        concat [ "NewConnectionInfo "
+               , show provenance
+               , " "
+               , show connId
+               , " "
+               , show dataFlow
+               ]
+
+
+-- | Edge triggered events to which the /inbound protocol governor/ reacts.
+--
+data Event (muxMode :: Mux.Mode) handle initiatorCtx peerAddr versionData m a b
+    -- | A request to start mini-protocol bundle, either from the server or from
+    -- connection manager after a duplex connection was negotiated.
+    --
+    = NewConnection !(NewConnectionInfo peerAddr handle)
+
+    -- | A multiplexer exited.
+    --
+    | MuxFinished            !(ConnectionId peerAddr) (STM m (Maybe SomeException))
+
+    -- | A mini-protocol terminated either cleanly or abruptly.
+    --
+    | MiniProtocolTerminated !(Terminated muxMode initiatorCtx peerAddr m a b)
+
+    -- | Transition from 'RemoteEstablished' to 'RemoteIdle'.
+    --
+    | WaitIdleRemote         !(ConnectionId peerAddr)
+
+    -- | A remote @warm → hot@ transition.  It is scheduled as soon as all hot
+    -- mini-protocols are running.
+    --
+    | RemotePromotedToHot    !(ConnectionId peerAddr)
+
+    -- | A @hot → warm@ transition.  It is scheduled as soon as any hot
+    -- mini-protocol terminates.
+    --
+    | RemoteDemotedToWarm    !(ConnectionId peerAddr)
+
+    -- | Transition from 'RemoteIdle' to 'RemoteCold'.
+    --
+    | CommitRemote           !(ConnectionId peerAddr)
+
+    -- | Transition from 'RemoteIdle' or 'RemoteCold' to 'RemoteEstablished'.
+    --
+    | AwakeRemote            !(ConnectionId peerAddr)
+
+    -- | Update `igsMatureDuplexPeers` and `igsFreshDuplexPeers`.
+    --
+    | MaturedDuplexPeers   !(Map peerAddr versionData)         -- ^ newly matured duplex peers
+                           !(OrdPSQ peerAddr Time versionData) -- ^ queue of fresh duplex peers
+
+    | InactivityTimeout
+
+
+-- STM transactions which detect 'Event's (signals)
+--
+
+
+-- | A signal which returns an 'Event'.  Signals are combined together and
+-- passed used to fold the current state map.
+--
+type EventSignal (muxMode :: Mux.Mode) handle initiatorCtx peerAddr versionData m a b =
+        ConnectionId peerAddr
+     -> ConnectionState muxMode initiatorCtx peerAddr versionData m a b
+     -> FirstToFinish (STM m) (Event muxMode handle initiatorCtx peerAddr versionData m a b)
+
+
+-- | When a mini-protocol terminates we take 'Terminated' out of 'ConnectionState
+-- and pass it to the main loop.  This is just enough to decide if we need to
+-- restart a mini-protocol and to do the restart.
+--
+data Terminated muxMode initiatorCtx peerAddr m a b = Terminated {
+    tConnId           :: !(ConnectionId peerAddr),
+    tMux              :: !(Mux.Mux muxMode m),
+    tMiniProtocolData :: !(MiniProtocolData muxMode initiatorCtx peerAddr m a b),
+    tDataFlow         :: !DataFlow,
+    tResult           :: STM m (Either SomeException b) -- !(Either SomeException b)
+  }
+
+
+-- | First peer for which the 'RemoteIdle' timeout expires.
+--
+firstPeerCommitRemote :: (Alternative (STM m), MonadSTM m)
+                      => EventSignal muxMode handle initiatorCtx peerAddr versionData m a b
+firstPeerCommitRemote
+    connId ConnectionState { csRemoteState }
+    = case csRemoteState of
+        -- the connection is already in 'RemoteCold' state
+        RemoteCold            -> mempty
+        RemoteEstablished     -> mempty
+        RemoteIdle timeoutSTM -> FirstToFinish do
+          expired <- timeoutSTM
+          if expired then pure $ CommitRemote connId else retry
+
+
 data IGAssertionLocation peerAddr
   = InboundGovernorLoop !(Maybe (ConnectionId peerAddr)) !AbstractState
   deriving Show
@@ -678,3 +948,7 @@ data Trace peerAddr
 
 data Debug peerAddr versionData = forall muxMode initiatorCtx m a b.
     Debug (State muxMode initiatorCtx peerAddr versionData m a b)
+
+data LoopDecision state peer = TraceOnly
+                             | OnlyStateChange !state
+                             | StateWithPeerTransition !state peer
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/Event.hs b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/Event.hs
deleted file mode 100644
index 271325ed152..00000000000
--- a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/Event.hs
+++ /dev/null
@@ -1,401 +0,0 @@
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE KindSignatures      #-}
-{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE NamedFieldPuns      #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections       #-}
-
--- Internals of inbound protocol governor.  This module provide 'Event' type,
--- which enumerates external events and stm action which block until these
--- events fire.
---
-module Ouroboros.Network.InboundGovernor.Event
-  ( Event (..)
-  , EventSignal
-  , firstMuxToFinish
-  , Terminated (..)
-  , firstMiniProtocolToFinish
-  , firstPeerPromotedToWarm
-  , firstPeerPromotedToHot
-  , firstPeerDemotedToWarm
-  , firstPeerDemotedToCold
-  , firstPeerCommitRemote
-  , NewConnectionInfo (..)
-  ) where
-
-import Control.Applicative (Alternative)
-import Control.Concurrent.Class.MonadSTM.Strict
-import Control.Monad.Class.MonadThrow hiding (handle)
-import Control.Monad.Class.MonadTime.SI
-
-import Data.ByteString.Lazy (ByteString)
-import Data.Functor (($>))
-import Data.Map.Strict (Map)
-import Data.Map.Strict qualified as Map
-import Data.Monoid.Synchronisation
-import Data.OrdPSQ (OrdPSQ)
-import Data.Set qualified as Set
-
-import Network.Mux qualified as Mux
-import Network.Mux.Types (MiniProtocolDir (..), MiniProtocolStatus (..))
-
-import Ouroboros.Network.ConnectionHandler
-import Ouroboros.Network.ConnectionManager.Types
-import Ouroboros.Network.Context
-import Ouroboros.Network.InboundGovernor.State
-import Ouroboros.Network.Mux
-
-
--- | Announcement message for a new connection.
---
-data NewConnectionInfo peerAddr handle
-
-    -- | Announce a new connection.  /Inbound protocol governor/ will start
-    -- responder protocols using 'StartOnDemand' strategy and monitor remote
-    -- transitions: @PromotedToWarm^{Duplex}_{Remote}@ and
-    -- @DemotedToCold^{dataFlow}_{Remote}@.
-    = NewConnectionInfo
-      !Provenance
-      !(ConnectionId peerAddr)
-      !DataFlow
-      !handle
-
-instance Show peerAddr
-      => Show (NewConnectionInfo peerAddr handle) where
-      show (NewConnectionInfo provenance connId dataFlow _) =
-        concat [ "NewConnectionInfo "
-               , show provenance
-               , " "
-               , show connId
-               , " "
-               , show dataFlow
-               ]
-
--- | Edge triggered events to which the /inbound protocol governor/ reacts.
---
-data Event (muxMode :: Mux.Mode) initiatorCtx peerAddr versionData m a b
-    -- | A request to start mini-protocol bundle, either from the server or from
-    -- connection manager after a duplex connection was negotiated.
-    --
-    = NewConnection !(NewConnectionInfo peerAddr
-                        (Handle muxMode initiatorCtx (ResponderContext peerAddr) versionData ByteString m a b))
-
-    -- | A multiplexer exited.
-    --
-    | MuxFinished            !(ConnectionId peerAddr) !(Maybe SomeException)
-
-    -- | A mini-protocol terminated either cleanly or abruptly.
-    --
-    | MiniProtocolTerminated !(Terminated muxMode initiatorCtx peerAddr m a b)
-
-    -- | Transition from 'RemoteEstablished' to 'RemoteIdle'.
-    --
-    | WaitIdleRemote         !(ConnectionId peerAddr)
-
-    -- | A remote @warm → hot@ transition.  It is scheduled as soon as all hot
-    -- mini-protocols are running.
-    --
-    | RemotePromotedToHot    !(ConnectionId peerAddr)
-
-    -- | A @hot → warm@ transition.  It is scheduled as soon as any hot
-    -- mini-protocol terminates.
-    --
-    | RemoteDemotedToWarm    !(ConnectionId peerAddr)
-
-    -- | Transition from 'RemoteIdle' to 'RemoteCold'.
-    --
-    | CommitRemote           !(ConnectionId peerAddr)
-
-    -- | Transition from 'RemoteIdle' or 'RemoteCold' to 'RemoteEstablished'.
-    --
-    | AwakeRemote            !(ConnectionId peerAddr)
-
-    -- | Update `igsMatureDuplexPeers` and `igsFreshDuplexPeers`.
-    --
-    | MaturedDuplexPeers   !(Map peerAddr versionData)         -- ^ newly matured duplex peers
-                           !(OrdPSQ peerAddr Time versionData) -- ^ queue of fresh duplex peers
-
-    | InactivityTimeout
-
-
---
--- STM transactions which detect 'Event's (signals)
---
-
-
--- | A signal which returns an 'Event'.  Signals are combined together and
--- passed used to fold the current state map.
---
-type EventSignal (muxMode :: Mux.Mode) initiatorCtx peerAddr versionData m a b =
-        ConnectionId peerAddr
-     -> ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-     -> FirstToFinish (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
-
--- | A mux stopped.  If mux exited cleanly no error is attached.
---
-firstMuxToFinish :: MonadSTM m
-                 => EventSignal muxMode initiatorCtx peerAddr versionData m a b
-firstMuxToFinish connId ConnectionState { csMux } =
-    FirstToFinish $ MuxFinished connId <$> Mux.stopped csMux
-
-
--- | When a mini-protocol terminates we take 'Terminated' out of 'ConnectionState
--- and pass it to the main loop.  This is just enough to decide if we need to
--- restart a mini-protocol and to do the restart.
---
-data Terminated muxMode initiatorCtx peerAddr m a b = Terminated {
-    tConnId           :: !(ConnectionId peerAddr),
-    tMux              :: !(Mux.Mux muxMode m),
-    tMiniProtocolData :: !(MiniProtocolData muxMode initiatorCtx peerAddr m a b),
-    tDataFlow         :: !DataFlow,
-    tResult           :: !(Either SomeException b)
-  }
-
-
--- | Detect when one of the mini-protocols terminated.
---
--- /triggers:/ 'MiniProtocolTerminated'.
---
-firstMiniProtocolToFinish :: Alternative (STM m)
-                          => (versionData -> DataFlow)
-                          -> EventSignal muxMode initiatorCtx peerAddr versionData m a b
-firstMiniProtocolToFinish
-    connDataFlow
-    connId
-    ConnectionState { csMux,
-                      csVersionData,
-                      csMiniProtocolMap,
-                      csCompletionMap
-                    }
-    = Map.foldMapWithKey
-        (\miniProtocolNum completionAction ->
-              (\tResult -> MiniProtocolTerminated $ Terminated {
-                    tConnId           = connId,
-                    tMux              = csMux,
-                    tMiniProtocolData = csMiniProtocolMap Map.! miniProtocolNum,
-                    tDataFlow         = connDataFlow csVersionData,
-                    tResult
-                  }
-              )
-          <$> FirstToFinish completionAction
-        )
-        csCompletionMap
-
-
--- | Detect when one of the peers was promoted to warm, e.g.
--- @PromotedToWarm^{Duplex}_{Remote}@ or
--- @PromotedToWarm^{Unidirectional}_{Remote}@.
---
--- /triggers:/ 'PromotedToWarm'
---
--- Note: The specification only describes @PromotedToWarm^{Duplex}_{Remote}@
--- transition, but here we don't make a distinction on @Duplex@ and
--- @Unidirectional@ connections.
---
-firstPeerPromotedToWarm :: forall muxMode initiatorCtx peerAddr versionData m a b.
-                           ( Alternative (STM m)
-                           , MonadSTM m
-                           )
-                        => EventSignal muxMode initiatorCtx peerAddr versionData m a b
-firstPeerPromotedToWarm
-    connId
-    ConnectionState { csMux, csRemoteState }
-    = case csRemoteState of
-        -- the connection is already in 'RemoteEstablished' state.
-        RemoteEstablished -> mempty
-
-        -- If the connection is in 'RemoteCold' state we do first to finish
-        -- synchronisation to detect incoming traffic on any of the responder
-        -- mini-protocols.
-        --
-        -- This works for both duplex and unidirectional connections (e.g. p2p
-        -- \/ non-p2p nodes), for which protocols are started eagerly, unlike
-        -- for p2p nodes for which we start all mini-protocols on demand.
-        -- Using 'miniProtocolStatusVar' is ok for unidirectional connection,
-        -- as we never restart the protocols for them.  They transition to
-        -- 'RemoteWarm' as soon the connection is accepted.  This is because
-        -- for eagerly started mini-protocols mux puts them in 'StatusRunning'
-        -- as soon as mini-protocols are set in place by 'runMiniProtocol'.
-        RemoteCold ->
-          Map.foldMapWithKey
-            fn
-            (Mux.miniProtocolStateMap csMux)
-
-        -- We skip it here; this case is done in 'firstPeerDemotedToCold'.
-        RemoteIdle {} ->
-          Map.foldMapWithKey
-            fn
-            (Mux.miniProtocolStateMap csMux)
-  where
-    fn :: (MiniProtocolNum, MiniProtocolDir)
-       -> STM m MiniProtocolStatus
-       -> FirstToFinish (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
-    fn = \(_miniProtocolNum, miniProtocolDir) miniProtocolStatus ->
-      case miniProtocolDir of
-        InitiatorDir -> mempty
-
-        ResponderDir ->
-          FirstToFinish $
-            miniProtocolStatus >>= \case
-              StatusIdle             -> retry
-              StatusStartOnDemand    -> retry
-              StatusStartOnDemandAny -> retry
-              StatusRunning          -> return $ AwakeRemote connId
-
-
--- | 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)
-                          , MonadSTM m
-                          )
-                       => EventSignal muxMode initiatorCtx peerAddr versionData m a b
-firstPeerPromotedToHot
-   connId connState@ConnectionState { csRemoteState }
-   = case csRemoteState of
-       RemoteHot     -> mempty
-       RemoteWarm    ->
-           fmap (const $ RemotePromotedToHot connId)
-         $ foldMap fn
-             (hotMiniProtocolStateMap connState)
-       RemoteCold    ->
-           fmap (const $ RemotePromotedToHot connId)
-         $ foldMap fn
-             (hotMiniProtocolStateMap connState)
-       RemoteIdle {} -> mempty
-  where
-    -- only hot mini-protocols;
-    hotMiniProtocolStateMap :: ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-                            -> Map (MiniProtocolNum, MiniProtocolDir)
-                                   (STM m MiniProtocolStatus)
-    hotMiniProtocolStateMap ConnectionState { csMux, csMiniProtocolMap } =
-       Mux.miniProtocolStateMap csMux
-       `Map.restrictKeys`
-       ( Set.map (,ResponderDir)
-       . Map.keysSet
-       . Map.filter
-           (\MiniProtocolData { mpdMiniProtocolTemp } ->
-              case mpdMiniProtocolTemp of
-                Hot -> True
-                _   -> False
-           )
-       $ csMiniProtocolMap
-       )
-
-    fn :: STM m MiniProtocolStatus
-       -> FirstToFinish (STM m) ()
-    fn miniProtocolStatus =
-      FirstToFinish $
-        miniProtocolStatus >>= \case
-          StatusIdle             -> retry
-          StatusStartOnDemand    -> retry
-          StatusStartOnDemandAny -> retry
-          StatusRunning          -> return ()
-
-
--- | Detect when all hot mini-protocols terminates, which triggers the
--- `RemoteHot → RemoteWarm` transition.
---
-firstPeerDemotedToWarm :: forall muxMode initiatorCtx peerAddr versionData m a b.
-                          ( Alternative (STM m)
-                          , MonadSTM m
-                          )
-                       => EventSignal muxMode initiatorCtx peerAddr versionData m a b
-firstPeerDemotedToWarm
-    connId connState@ConnectionState { csRemoteState }
-    = case csRemoteState of
-        RemoteHot ->
-           lastToFirstM $
-              RemoteDemotedToWarm connId <$ foldMap fn (hotMiniProtocolStateMap connState)
-
-        _  -> mempty
-  where
-    -- only hot mini-protocols;
-    hotMiniProtocolStateMap :: ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-                            -> Map (MiniProtocolNum, MiniProtocolDir)
-                                   (STM m MiniProtocolStatus)
-    hotMiniProtocolStateMap ConnectionState { csMux, csMiniProtocolMap } =
-       Mux.miniProtocolStateMap csMux
-       `Map.restrictKeys`
-       ( Set.map (,ResponderDir)
-       . Map.keysSet
-       . Map.filter
-           (\MiniProtocolData { mpdMiniProtocolTemp } ->
-                case mpdMiniProtocolTemp of
-                  Hot -> True
-                  _   -> False
-           )
-       $ csMiniProtocolMap
-       )
-
-    fn :: STM m MiniProtocolStatus
-       -> LastToFinishM (STM m) ()
-    fn miniProtocolStatus =
-      LastToFinishM $
-        miniProtocolStatus >>= \case
-          StatusIdle             -> return ()
-          StatusStartOnDemand    -> return ()
-          StatusStartOnDemandAny -> return ()
-          StatusRunning          -> retry
-
-
--- | Await for first peer demoted to cold, i.e. detect the
--- @DemotedToCold^{Duplex}_{Remote}@.
---
--- /triggers:/ 'DemotedToColdRemote'
---
-firstPeerDemotedToCold :: ( Alternative (STM m)
-                          , MonadSTM m
-                          )
-                       => EventSignal muxMode initiatorCtx peerAddr versionData m a b
-firstPeerDemotedToCold
-    connId
-    ConnectionState {
-      csMux,
-      csRemoteState
-    }
-    = case csRemoteState of
-        -- the connection is already in 'RemoteCold' state
-        RemoteCold -> mempty
-
-        -- Responders are started using 'StartOnDemand' strategy. We detect
-        -- when all of the responders are in 'StatusIdle' or
-        -- 'StatusStartOnDemand' and subsequently put the connection in
-        -- 'RemoteIdle' state.
-        --
-        -- In compat mode, when established mini-protocols terminate they will
-        -- not be restarted.
-        RemoteEstablished ->
-              fmap (const $ WaitIdleRemote connId)
-            . lastToFirstM
-            $ Map.foldMapWithKey
-                (\(_, miniProtocolDir) miniProtocolStatus ->
-                  case miniProtocolDir of
-                    InitiatorDir -> mempty
-
-                    ResponderDir ->
-                      LastToFinishM $ do
-                        miniProtocolStatus >>= \case
-                          StatusIdle             -> return ()
-                          StatusStartOnDemand    -> return ()
-                          StatusStartOnDemandAny -> return ()
-                          StatusRunning          -> retry
-                )
-                (Mux.miniProtocolStateMap csMux)
-
-        RemoteIdle {} -> mempty
-
-
--- | First peer for which the 'RemoteIdle' timeout expires.
---
-firstPeerCommitRemote :: Alternative (STM m)
-                      => EventSignal muxMode initiatorCtx peerAddr versionData m a b
-firstPeerCommitRemote
-    connId ConnectionState { csRemoteState }
-    = case csRemoteState of
-        -- the connection is already in 'RemoteCold' state
-        RemoteCold            -> mempty
-        RemoteEstablished     -> mempty
-        RemoteIdle timeoutSTM -> FirstToFinish (timeoutSTM $> CommitRemote connId)
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/State.hs b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/State.hs
index 445ff4f812f..70f833a610f 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/State.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor/State.hs
@@ -15,6 +15,7 @@ module Ouroboros.Network.InboundGovernor.State
   , mkPublicState
   , State (..)
   , ConnectionState (..)
+  , ResponderCounters (..)
   , Counters (..)
   , counters
   , unregisterConnection
@@ -186,9 +187,16 @@ data ConnectionState muxMode initiatorCtx peerAddr versionData m a b = Connectio
       -- | State of the connection.
       --
       csRemoteState     :: !(RemoteState m)
-
     }
 
+-- | The IG maintains a state of the number of hot and warm
+-- miniprotocol responders to track transitions and notify
+-- the connection manager for interesting events.
+--
+data ResponderCounters = ResponderCounters {
+  numTraceHotResponders  :: !Int,
+  numTraceWarmResponders :: !Int
+  }
 
 --
 -- State management functions
@@ -198,12 +206,13 @@ data ConnectionState muxMode initiatorCtx peerAddr versionData m a b = Connectio
 -- | Remove connection from 'State'.
 --
 unregisterConnection :: Ord peerAddr
-                     => ConnectionId peerAddr
+                     => Bool
+                     -> ConnectionId peerAddr
                      -> State muxMode initiatorCtx peerAddr versionData m a b
                      -> State muxMode initiatorCtx peerAddr versionData m a b
-unregisterConnection connId state =
+unregisterConnection bypass connId state =
     state { connections =
-              assert (connId `Map.member` connections state) $
+              assert (connId `Map.member` connections state || bypass) $
               Map.delete connId (connections state),
 
             matureDuplexPeers =
@@ -263,7 +272,7 @@ data RemoteState m
     --
     -- 'RemoteIdle' is the initial state of an accepted a connection.
     --
-    | RemoteIdle !(STM m ())
+    | RemoteIdle !(STM m Bool)
 
     -- | The 'RemoteCold' state for 'Duplex' connections allows us to have
     -- responders started using the on-demand strategy.  This assures that once
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Mux.hs b/ouroboros-network-framework/src/Ouroboros/Network/Mux.hs
index ceec14bddf9..861889c9f0f 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/Mux.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/Mux.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE NamedFieldPuns        #-}
-{-# LANGUAGE PatternSynonyms       #-}
 {-# LANGUAGE PolyKinds             #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake.hs b/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake.hs
index c9e25dbda46..3f517cea224 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake.hs
@@ -85,8 +85,13 @@ tryHandshake doHandshake = do
 data HandshakeArguments connectionId vNumber vData m = HandshakeArguments {
       -- | 'Handshake' tracer
       --
-      haHandshakeTracer :: Tracer m (Mx.WithBearer connectionId
-                                     (TraceSendRecv (Handshake vNumber CBOR.Term))),
+      haHandshakeTracer
+        :: Tracer m (Mx.WithBearer connectionId
+                                   (TraceSendRecv (Handshake vNumber CBOR.Term))),
+
+      haBearerTracer
+        :: Tracer m (Mx.WithBearer connectionId Mx.BearerTrace),
+
       -- | Codec for protocol messages.
       --
       haHandshakeCodec
@@ -132,6 +137,7 @@ runHandshakeClient bearer
                    connectionId
                    HandshakeArguments {
                      haHandshakeTracer,
+                     haBearerTracer,
                      haHandshakeCodec,
                      haVersionDataCodec,
                      haAcceptVersion,
@@ -145,7 +151,8 @@ runHandshakeClient bearer
           haHandshakeCodec
           byteLimitsHandshake
           haTimeLimits
-          (Mx.bearerAsChannel bearer handshakeProtocolNum Mx.InitiatorDir)
+          (Mx.bearerAsChannel (Mx.WithBearer connectionId `contramap` haBearerTracer)
+                              bearer handshakeProtocolNum Mx.InitiatorDir)
           (handshakeClientPeer haVersionDataCodec haAcceptVersion versions))
 
 
@@ -169,6 +176,7 @@ runHandshakeServer bearer
                    connectionId
                    HandshakeArguments {
                      haHandshakeTracer,
+                     haBearerTracer,
                      haHandshakeCodec,
                      haVersionDataCodec,
                      haAcceptVersion,
@@ -183,7 +191,8 @@ runHandshakeServer bearer
           haHandshakeCodec
           byteLimitsHandshake
           haTimeLimits
-          (Mx.bearerAsChannel bearer handshakeProtocolNum Mx.ResponderDir)
+          (Mx.bearerAsChannel (Mx.WithBearer connectionId `contramap` haBearerTracer)
+                              bearer handshakeProtocolNum Mx.ResponderDir)
           (handshakeServerPeer haVersionDataCodec haAcceptVersion haQueryVersion versions))
 
 -- | A 20s delay after query result was send back, before we close the
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Server.hs b/ouroboros-network-framework/src/Ouroboros/Network/Server.hs
index dd4e4a66308..cec4c8334f9 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/Server.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/Server.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments      #-}
 {-# LANGUAGE CPP                 #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE FlexibleContexts    #-}
@@ -35,9 +36,10 @@ import Control.Monad.Class.MonadFork
 import Control.Monad.Class.MonadThrow hiding (handle)
 import Control.Monad.Class.MonadTime.SI
 import Control.Monad.Class.MonadTimer.SI
+import Control.Monad.Fix (MonadFix)
+
 import Control.Tracer (Tracer, contramap, traceWith)
 
-import Data.ByteString.Lazy (ByteString)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Void (Void, absurd)
@@ -46,13 +48,8 @@ import GHC.IO.Exception
 import Foreign.C.Error
 #endif
 
-import Network.Mux qualified as Mx
-import Ouroboros.Network.ConnectionHandler
 import Ouroboros.Network.ConnectionId (ConnectionId (..))
-import Ouroboros.Network.ConnectionManager.InformationChannel
-           (InboundGovernorInfoChannel)
 import Ouroboros.Network.ConnectionManager.Types
-import Ouroboros.Network.Context (ResponderContext)
 import Ouroboros.Network.InboundGovernor qualified as InboundGovernor
 import Ouroboros.Network.Mux
 import Ouroboros.Network.Server.RateLimiting
@@ -66,31 +63,13 @@ import Ouroboros.Network.Snocket
 
 -- | Server static configuration.
 --
-data Arguments (muxMode  :: Mx.Mode) socket initiatorCtx peerAddr versionData versionNumber bytes m a b =
+data Arguments muxMode socket peerAddr initiatorCtx responderCtx handle handlerTrace handleError versionNumber versionData bytes m a b x =
     Arguments {
       sockets               :: NonEmpty socket,
       snocket               :: Snocket m socket peerAddr,
       tracer                :: Tracer m (Trace peerAddr),
-      trTracer              :: Tracer m (InboundGovernor.RemoteTransitionTrace peerAddr),
-      inboundGovernorTracer :: Tracer m (InboundGovernor.Trace peerAddr),
-      debugInboundGovernor  :: Tracer m (InboundGovernor.Debug peerAddr versionData),
       connectionLimits      :: AcceptedConnectionsLimit,
-      connectionManager     :: MuxConnectionManager muxMode socket initiatorCtx (ResponderContext peerAddr)
-                                                          peerAddr versionData versionNumber bytes m a b,
-
-      -- | Time for which all protocols need to be idle to trigger
-      -- 'DemotedToCold' transition.
-      --
-      inboundIdleTimeout    :: Maybe DiffTime,
-
-      connectionDataFlow    :: versionData -> DataFlow,
-
-      -- | Server control var is passed as an argument; this allows to use the
-      -- server to run and manage responders which needs to be started on
-      -- inbound connections.
-      --
-      inboundInfoChannel    :: InboundGovernorInfoChannel muxMode initiatorCtx peerAddr versionData
-                                                                bytes m a b
+      inboundGovernorArgs   :: InboundGovernor.Arguments muxMode handlerTrace socket peerAddr initiatorCtx responderCtx handle handleError versionNumber versionData bytes m a b x
     }
 
 -- | Server pauses accepting connections after an 'CONNABORTED' error.
@@ -113,7 +92,7 @@ server_CONNABORTED_DELAY = 0.5
 -- The first one is used in data diffusion for /Node-To-Node protocol/, while the
 -- other is useful for running a server for the /Node-To-Client protocol/.
 --
-with :: forall muxMode socket initiatorCtx peerAddr versionData versionNumber m a b x.
+with :: forall muxMode socket peerAddr initiatorCtx responderCtx handle handlerTrace handleError versionNumber versionData bytes m a b x.
        ( Alternative (STM m)
        , MonadAsync    m
        , MonadDelay    m
@@ -127,10 +106,18 @@ with :: forall muxMode socket initiatorCtx peerAddr versionData versionNumber m
        , HasResponder muxMode ~ True
        , Ord      peerAddr
        , Show     peerAddr
+       , MonadTraceSTM m
+       , MonadFork m
+       , MonadFix m
        )
-    => Arguments muxMode socket initiatorCtx peerAddr versionData versionNumber ByteString m a b
+    => Arguments muxMode socket peerAddr initiatorCtx responderCtx handle handlerTrace
+                 handleError versionNumber versionData bytes m a b x
     -- ^ record which holds all server arguments
-    -> (Async m Void -> m (InboundGovernor.PublicState peerAddr versionData) -> m x)
+    -> (   Async m Void
+        -> m (InboundGovernor.PublicState peerAddr versionData)
+        -> ConnectionManager
+              muxMode socket peerAddr handle handleError m
+        -> m x)
     -- ^ a callback which receives a handle to inbound governor thread and can
     -- read `PublicState`.
     --
@@ -140,57 +127,45 @@ with :: forall muxMode socket initiatorCtx peerAddr versionData versionNumber m
 with Arguments {
       sockets = socks,
       snocket,
-      trTracer,
-      tracer = tracer,
-      inboundGovernorTracer = inboundGovernorTracer,
-      debugInboundGovernor,
+      tracer,
       connectionLimits =
         limits@AcceptedConnectionsLimit { acceptedConnectionsHardLimit = hardLimit },
-      inboundIdleTimeout,
-      connectionManager,
-      connectionDataFlow,
-      inboundInfoChannel
+      inboundGovernorArgs
     }
-    k = do
+    k
+    = do
       let sockets = NonEmpty.toList socks
       localAddresses <- traverse (getLocalAddr snocket) sockets
-      traceWith tracer (TrServerStarted localAddresses)
-      InboundGovernor.with
-        InboundGovernor.Arguments {
-          InboundGovernor.transitionTracer   = trTracer,
-          InboundGovernor.tracer             = inboundGovernorTracer,
-          InboundGovernor.debugTracer        = debugInboundGovernor,
-          InboundGovernor.connectionDataFlow = connectionDataFlow,
-          InboundGovernor.infoChannel        = inboundInfoChannel,
-          InboundGovernor.idleTimeout        = inboundIdleTimeout,
-          InboundGovernor.connectionManager  = connectionManager
-        } $ \inboundGovernorThread readPublicInboundState ->
-        withAsync (do
-                      labelThisThread "Server2 (ouroboros-network-framework)"
-                      k inboundGovernorThread readPublicInboundState) $ \actionThread -> do
-          let acceptLoops :: [m Void]
-              acceptLoops =
-                          [ (do
-                                labelThisThread ("accept " ++ show localAddress)
-                                accept snocket socket >>= acceptLoop localAddress)
-                              `finally` close snocket socket
-                          | (localAddress, socket) <- localAddresses `zip` sockets
-                          ]
-          -- race all `acceptLoops` with `actionThread` and
-          -- `inboundGovernorThread`
-          let waiter = fn <$> (do
-                                  labelThisThread "racing-action-inbound-governor"
-                                  actionThread `waitEither` inboundGovernorThread)
+      InboundGovernor.with inboundGovernorArgs
+        \inboundGovernorThread readPublicInboundState connectionManager ->
+          withAsync do
+            labelThisThread "Server2 (ouroboros-network-framework)"
+            k inboundGovernorThread readPublicInboundState connectionManager
+          \actionThread -> do
+            traceWith tracer (TrServerStarted localAddresses)
+            let acceptLoops :: [m Void]
+                acceptLoops =
+                            [ (do
+                                  labelThisThread ("accept " ++ show localAddress)
+                                  accept snocket socket >>= acceptLoop localAddress connectionManager)
+                                `finally` close snocket socket
+                            | (localAddress, socket) <- localAddresses `zip` sockets
+                            ]
+            -- race all `acceptLoops` with `actionThread` and
+            -- `inboundGovernorThread`
+            let waiter = fn <$> (do
+                                    labelThisThread "racing-action-inbound-governor"
+                                    actionThread `waitEither` inboundGovernorThread)
 
-          (fn <$> waiter `race` (labelThisThread "racing-accept-loops" >> raceAll acceptLoops))
-            `finally`
-              traceWith tracer TrServerStopped
-            `catch`
-              \(e :: SomeException) -> do
-                case fromException e of
-                  Just (_ :: AsyncCancelled) -> pure ()
-                  Nothing                    -> traceWith tracer (TrServerError e)
-                throwIO e
+            (fn <$> waiter `race` (labelThisThread "racing-accept-loops" >> raceAll acceptLoops))
+              `finally`
+                traceWith tracer TrServerStopped
+              `catch`
+                \(e :: SomeException) -> do
+                  case fromException e of
+                    Just (_ :: AsyncCancelled) -> pure ()
+                    Nothing                    -> traceWith tracer (TrServerError e)
+                  throwIO e
   where
     fn :: Either x Void -> x
     fn (Left x)  = x
@@ -204,9 +179,10 @@ with Arguments {
         go as (x:xs) = withAsync x (\a -> go (a:as) xs)
 
     acceptLoop :: peerAddr
+               -> ConnectionManager muxMode socket peerAddr handle handleError m
                -> Accept m socket peerAddr
                -> m Void
-    acceptLoop localAddress acceptOne0 = mask $ \unmask -> do
+    acceptLoop localAddress connectionManager acceptOne0 = mask $ \unmask -> do
         labelThisThread ("accept-loop-" ++ show localAddress)
         go unmask acceptOne0
         `catch` \ e -> traceWith tracer (TrServerError e)
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Server/Simple.hs b/ouroboros-network-framework/src/Ouroboros/Network/Server/Simple.hs
index bbdbadd3ee1..3aa7b242421 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/Server/Simple.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/Server/Simple.hs
@@ -18,7 +18,6 @@ import Control.Monad.Class.MonadFork (MonadFork)
 import Control.Monad.Class.MonadSTM
 import Control.Monad.Class.MonadThrow
 import Control.Monad.Class.MonadTimer.SI (MonadDelay, MonadTimer)
-import Control.Tracer (nullTracer)
 import Data.ByteString.Lazy qualified as BL
 import Data.Functor (void)
 import Data.Typeable (Typeable)
@@ -75,8 +74,7 @@ with sn makeBearer configureSock addr handshakeArgs versions k =
         let connThread = do
               -- connection responder thread
               let connId = ConnectionId addr remoteAddr
-              bearer <- Mx.getBearer makeBearer
-                        (-1) nullTracer sock' Nothing
+              bearer <- Mx.getBearer makeBearer (-1) sock' Nothing
               configureSock sock' addr
               r <- runHandshakeServer bearer connId handshakeArgs versions
               case r of
@@ -85,7 +83,7 @@ with sn makeBearer configureSock addr handshakeArgs versions k =
                 Right HandshakeQueryResult {}   -> error "handshake query is not supported"
                 Right (HandshakeNegotiationResult (SomeResponderApplication app) vNumber vData) -> do
                   mux <- Mx.new (toMiniProtocolInfos (runForkPolicy noBindForkPolicy (remoteAddress connId)) app)
-                  withAsync (Mx.run nullTracer mux bearer) $ \aid -> do
+                  withAsync (Mx.run Mx.nullTracers mux bearer) $ \aid -> do
                     void $ simpleMuxCallback connId vNumber vData app mux aid
 
             errorHandler = \e -> throwIO e
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Snocket.hs b/ouroboros-network-framework/src/Ouroboros/Network/Snocket.hs
index 076fba7671f..235c1a8d46c 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/Snocket.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/Snocket.hs
@@ -412,11 +412,11 @@ makeLocalRawBearer = MakeRawBearer (return . localSocketToRawBearer)
 
 makeLocalBearer :: MakeBearer IO LocalSocket
 #if defined(mingw32_HOST_OS)
-makeLocalBearer = MakeBearer $ \sduTimeout tracer LocalSocket { getLocalHandle = fd } rb ->
-  getBearer makeNamedPipeBearer sduTimeout tracer fd rb
+makeLocalBearer = MakeBearer $ \sduTimeout LocalSocket { getLocalHandle = fd } rb ->
+  getBearer makeNamedPipeBearer sduTimeout fd rb
 #else
-makeLocalBearer = MakeBearer $ \sduTimeout tracer (LocalSocket fd) rb ->
-  getBearer makeSocketBearer sduTimeout tracer fd rb
+makeLocalBearer = MakeBearer $ \sduTimeout (LocalSocket fd) rb ->
+  getBearer makeSocketBearer sduTimeout fd rb
 #endif
 
 -- | System dependent LocalSnocket
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Socket.hs b/ouroboros-network-framework/src/Ouroboros/Network/Socket.hs
index f9dcc241474..c5e5d3f26a4 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/Socket.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/Socket.hs
@@ -101,7 +101,7 @@ import Ouroboros.Network.Snocket qualified as Snocket
 -- 'Ouroboros.Network.NodeToClient.connectTo).
 --
 data NetworkConnectTracers addr vNumber = NetworkConnectTracers {
-      nctMuxTracer         :: Tracer IO (Mx.WithBearer (ConnectionId addr)  Mx.Trace),
+      nctMuxTracers        :: Mx.TracersWithBearer (ConnectionId addr) IO,
       -- ^ low level mux-network tracer, which logs mux sdu (send and received)
       -- and other low level multiplexing events.
       nctHandshakeTracer   :: Tracer IO (Mx.WithBearer (ConnectionId addr)
@@ -112,7 +112,7 @@ data NetworkConnectTracers addr vNumber = NetworkConnectTracers {
 
 nullNetworkConnectTracers :: NetworkConnectTracers addr vNumber
 nullNetworkConnectTracers = NetworkConnectTracers {
-      nctMuxTracer       = nullTracer,
+      nctMuxTracers      = Mx.nullTracers,
       nctHandshakeTracer = nullTracer
     }
 
@@ -120,7 +120,9 @@ nullNetworkConnectTracers = NetworkConnectTracers {
 debuggingNetworkConnectTracers :: (Show addr, Show vNumber)
                                => NetworkConnectTracers addr vNumber
 debuggingNetworkConnectTracers = NetworkConnectTracers {
-      nctMuxTracer       = showTracing stdoutTracer,
+      nctMuxTracers      = Mx.Tracers (showTracing stdoutTracer)
+                                      (showTracing stdoutTracer)
+                                      (showTracing stdoutTracer),
       nctHandshakeTracer = showTracing stdoutTracer
     }
 
@@ -368,7 +370,7 @@ connectToNodeWithMux'
       ctaVersionDataCodec    = versionDataCodec,
       ctaConnectTracers      =
         NetworkConnectTracers {
-          nctMuxTracer,
+          nctMuxTracers,
           nctHandshakeTracer
         },
       ctaHandshakeCallbacks  = handshakeCallbacks
@@ -376,45 +378,40 @@ connectToNodeWithMux'
   versions sd k = do
     connectionId <- (\localAddress remoteAddress -> ConnectionId { localAddress, remoteAddress })
                 <$> Snocket.getLocalAddr sn sd <*> Snocket.getRemoteAddr sn sd
-    muxTracer <- initDeltaQTracer' $ Mx.WithBearer connectionId `contramap` nctMuxTracer
-    ts_start <- getMonotonicTime
+    muxTracers <- initDeltaQTracers $ Mx.tracersWithBearer connectionId nctMuxTracers
 
-    handshakeBearer <- Mx.getBearer makeBearer sduHandshakeTimeout muxTracer sd Nothing
+    handshakeBearer <- Mx.getBearer makeBearer sduHandshakeTimeout sd Nothing
     app_e <-
       runHandshakeClient
         handshakeBearer
         connectionId
         -- TODO: push 'HandshakeArguments' up the call stack.
         HandshakeArguments {
-          haHandshakeTracer  = nctHandshakeTracer,
-          haHandshakeCodec   = handshakeCodec,
-          haVersionDataCodec = versionDataCodec,
-          haAcceptVersion    = acceptCb handshakeCallbacks,
-          haQueryVersion     = queryCb handshakeCallbacks,
-          haTimeLimits       = handshakeTimeLimits
+          haHandshakeTracer   = nctHandshakeTracer,
+          haBearerTracer      = Mx.bearerTracer nctMuxTracers,
+          haHandshakeCodec    = handshakeCodec,
+          haVersionDataCodec  = versionDataCodec,
+          haAcceptVersion     = acceptCb handshakeCallbacks,
+          haQueryVersion      = queryCb handshakeCallbacks,
+          haTimeLimits        = handshakeTimeLimits
         }
         versions
-    ts_end <- getMonotonicTime
     case app_e of
        Left (HandshakeProtocolLimit err) -> do
-         traceWith muxTracer $ Mx.TraceHandshakeClientError err (diffTime ts_end ts_start)
          throwIO err
 
        Left (HandshakeProtocolError err) -> do
-         traceWith muxTracer $ Mx.TraceHandshakeClientError err (diffTime ts_end ts_start)
          throwIO err
 
        Right (HandshakeNegotiationResult app versionNumber agreedOptions) -> do
-         traceWith muxTracer $ Mx.TraceHandshakeClientEnd (diffTime ts_end ts_start)
          Mx.withReadBufferIO (\buffer -> do
-             bearer <- Mx.getBearer makeBearer sduTimeout muxTracer sd buffer
+             bearer <- Mx.getBearer makeBearer sduTimeout sd buffer
              mux <- Mx.new (toMiniProtocolInfos (runForkPolicy noBindForkPolicy remoteAddress) app)
-             withAsync (Mx.run muxTracer mux bearer) $ \aid ->
+             withAsync (Mx.run muxTracers mux bearer) $ \aid ->
                k connectionId versionNumber agreedOptions app mux aid
            )
 
        Right (HandshakeQueryResult _vMap) -> do
-         traceWith muxTracer $ Mx.TraceHandshakeClientEnd (diffTime ts_end ts_start)
          throwIO (QueryNotSupported @vNumber)
 
 
@@ -502,4 +499,3 @@ data SomeResponderApplication addr bytes m b where
           Mx.HasResponder muxMode ~ True
        => (OuroborosApplicationWithMinimalCtx muxMode addr bytes m a b)
        -> SomeResponderApplication addr bytes m b
-
diff --git a/ouroboros-network-framework/src/Simulation/Network/Snocket.hs b/ouroboros-network-framework/src/Simulation/Network/Snocket.hs
index 116ae8c1946..af231836878 100644
--- a/ouroboros-network-framework/src/Simulation/Network/Snocket.hs
+++ b/ouroboros-network-framework/src/Simulation/Network/Snocket.hs
@@ -678,8 +678,8 @@ makeFDBearer :: forall addr m.
                 , Show addr
                 )
              => MakeBearer m (FD m (TestAddress addr))
-makeFDBearer = MakeBearer $ \sduTimeout muxTracer FD { fdVar } _ -> do
-        fd_ <- atomically (readTVar fdVar)
+makeFDBearer = MakeBearer $ \sduTimeout FD { fdVar } _ -> do
+        fd_ <- readTVarIO fdVar
         case fd_ of
           FDUninitialised {} ->
             throwIO (invalidError fd_)
@@ -689,7 +689,7 @@ makeFDBearer = MakeBearer $ \sduTimeout muxTracer FD { fdVar } _ -> do
             throwIO (invalidError fd_)
           FDConnected _ conn -> do
             return $ attenuationChannelAsBearer (connSDUSize conn)
-                                                sduTimeout muxTracer
+                                                sduTimeout
                                                 (connChannelLocal conn)
           FDClosed {} ->
             throwIO (invalidError fd_)
diff --git a/ouroboros-network-framework/testlib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs b/ouroboros-network-framework/testlib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs
index c1fc4a26977..d76102a9919 100644
--- a/ouroboros-network-framework/testlib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs
+++ b/ouroboros-network-framework/testlib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs
@@ -1,16 +1,18 @@
-{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE NamedFieldPuns      #-}
-{-# LANGUAGE PolyKinds           #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections       #-}
-{-# LANGUAGE TypeApplications    #-}
-{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE BlockArguments           #-}
+{-# LANGUAGE CPP                      #-}
+{-# LANGUAGE ConstraintKinds          #-}
+{-# LANGUAGE DataKinds                #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE FlexibleContexts         #-}
+{-# LANGUAGE GADTs                    #-}
+{-# LANGUAGE LambdaCase               #-}
+{-# LANGUAGE NamedFieldPuns           #-}
+{-# LANGUAGE PolyKinds                #-}
+{-# LANGUAGE RankNTypes               #-}
+{-# LANGUAGE ScopedTypeVariables      #-}
+{-# LANGUAGE TupleSections            #-}
+{-# LANGUAGE TypeApplications         #-}
+{-# LANGUAGE TypeOperators            #-}
 
 -- for 'debugTracer'
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
@@ -30,6 +32,7 @@ module Test.Ouroboros.Network.ConnectionManager.Experiments
   , withBidirectionalConnectionManager
   , runInitiatorProtocols
   , oneshotNextRequests
+  , WithNameAndBearer
   ) where
 
 import Control.Applicative (Alternative)
@@ -50,6 +53,7 @@ import Codec.Serialise.Class (Serialise)
 import Data.ByteString.Lazy (ByteString)
 import Data.ByteString.Lazy qualified as LBS
 import Data.Functor (($>), (<&>))
+import Data.Functor.Compose
 import Data.Hashable
 import Data.List (mapAccumL)
 import Data.List.NonEmpty (NonEmpty (..))
@@ -276,55 +280,63 @@ withInitiatorOnlyConnectionManager
     -> m a
 withInitiatorOnlyConnectionManager name timeouts trTracer tracer stdGen snocket makeBearer connStateIdSupply
                                    localAddr nextRequests handshakeTimeLimits acceptedConnLimit k = do
-    mainThreadId <- myThreadId
-    let muxTracer = (name,) `contramap` nullTracer -- mux tracer
-    CM.with
-      CM.Arguments {
-          -- ConnectionManagerTrace
-          CM.tracer    = WithName name
-                        `contramap` tracer,
-          CM.trTracer  = (WithName name . fmap CM.abstractState)
-                        `contramap` trTracer,
-         -- MuxTracer
-          CM.muxTracer = muxTracer,
-          CM.ipv4Address = localAddr,
-          CM.ipv6Address = Nothing,
-          CM.addressType = \_ -> Just IPv4Address,
-          CM.snocket = snocket,
-          CM.makeBearer = makeBearer,
-          CM.withBuffer = \f -> f Nothing,
-          CM.configureSocket = \_ _ -> return (),
-          CM.connectionDataFlow = \(DataFlowProtocolData df _) -> df,
-          CM.prunePolicy = simplePrunePolicy,
-          CM.stdGen,
-          CM.connectionsLimits = acceptedConnLimit,
-          CM.timeWaitTimeout = tTimeWaitTimeout timeouts,
-          CM.outboundIdleTimeout = tOutboundIdleTimeout timeouts,
-          CM.updateVersionData = \a _ -> a,
-          CM.connStateIdSupply
-        }
-      (makeConnectionHandler
-        muxTracer
-        SingInitiatorMode
-        noBindForkPolicy
-        HandshakeArguments {
-            -- TraceSendRecv
-            haHandshakeTracer = (name,) `contramap` nullTracer,
-            haHandshakeCodec = unversionedHandshakeCodec,
-            haVersionDataCodec = cborTermVersionDataCodec dataFlowProtocolDataCodec,
-            haAcceptVersion = acceptableVersion,
-            haQueryVersion = queryVersion,
-            haTimeLimits = handshakeTimeLimits
-          }
-        (dataFlowProtocol Unidirectional clientApplication)
-        (mainThreadId, debugMuxErrorRethrowPolicy
-                    <> debugMuxRuntimeErrorRethrowPolicy
-                    <> debugIOErrorRethrowPolicy
-                    <> assertRethrowPolicy))
-      (\_ -> HandshakeFailure)
-      NotInResponderMode
-      (\cm ->
-        k cm `catch` \(e :: SomeException) -> throwIO e)
+  mainThreadId <- myThreadId
+  let muxTracers :: Mx.TracersWithBearer (ConnectionId peerAddr) m
+      muxTracers = Mx.Tracers {
+        Mx.tracer        = WithName name `contramap` nullTracer,
+        Mx.channelTracer = WithName name `contramap` nullTracer,
+        Mx.bearerTracer  = WithName name `contramap` nullTracer
+      }
+      mkConnectionHandler =
+        makeConnectionHandler
+          muxTracers
+          noBindForkPolicy
+          HandshakeArguments {
+              -- TraceSendRecv
+              haHandshakeTracer = WithName name `contramap` nullTracer,
+              haBearerTracer = WithName name `contramap` nullTracer,
+              haHandshakeCodec = unversionedHandshakeCodec,
+              haVersionDataCodec = cborTermVersionDataCodec dataFlowProtocolDataCodec,
+              haAcceptVersion = acceptableVersion,
+              haQueryVersion = queryVersion,
+              haTimeLimits = handshakeTimeLimits
+            }
+          (dataFlowProtocol Unidirectional clientApplication)
+          (mainThreadId,   debugMuxErrorRethrowPolicy
+                        <> debugMuxRuntimeErrorRethrowPolicy
+                        <> debugIOErrorRethrowPolicy
+                        <> assertRethrowPolicy)
+          SingInitiatorMode
+
+
+  CM.with CM.Arguments {
+    -- ConnectionManagerTrace
+    tracer    = WithName name
+                  `contramap` tracer,
+    trTracer  = (WithName name . fmap CM.abstractState)
+                  `contramap` trTracer,
+    -- This is actually the low level bearer tracer
+    ipv4Address  = localAddr,
+    ipv6Address  = Nothing,
+    addressType  = \_ -> Just IPv4Address,
+    snocket,
+    makeBearer,
+    withBuffer = \f -> f Nothing,
+    configureSocket = \_ _ -> return (),
+    connectionDataFlow = \(DataFlowProtocolData df _) -> df,
+    timeWaitTimeout = tTimeWaitTimeout timeouts,
+    outboundIdleTimeout = tOutboundIdleTimeout timeouts,
+    prunePolicy = simplePrunePolicy,
+    stdGen,
+    connectionsLimits = acceptedConnLimit,
+    updateVersionData = \a _ -> a,
+    connStateIdSupply,
+    classifyHandleError = \_ -> HandshakeFailure
+    }
+    NotInResponderMode
+    mkConnectionHandler
+    \cm ->
+      k cm `catch` \(e :: SomeException) -> throwIO e
   where
     clientApplication :: TemperatureBundle
                            [MiniProtocol Mx.InitiatorMode
@@ -396,6 +408,7 @@ assertRethrowPolicy =
     mkRethrowPolicy $
       \_ (_ :: AssertionFailed) -> ShutdownNode
 
+type WithNameAndBearer name addr = Compose (WithName name) (Mx.WithBearer (ConnectionId addr))
 
 -- | Runs an example server which runs a single 'ReqResp' protocol for any hot
 -- \/ warm \/ established peers and also gives access to bidirectional
@@ -432,6 +445,7 @@ withBidirectionalConnectionManager
                             peerAddr
                             (ConnectionHandlerTrace UnversionedProtocol DataFlowProtocolData)))
     -> Tracer m (WithName name (InboundGovernor.Trace peerAddr))
+    -> Mx.Tracers' m (WithNameAndBearer name peerAddr)
     -> Tracer m (WithName name (InboundGovernor.Debug peerAddr DataFlowProtocolData))
     -> StdGen
     -> Snocket m socket peerAddr
@@ -459,7 +473,7 @@ withBidirectionalConnectionManager
     -> m a
 withBidirectionalConnectionManager name timeouts
                                    inboundTrTracer trTracer
-                                   tracer inboundTracer debugTracer
+                                   tracer inboundTracer muxTracer debugTracer
                                    stdGen
                                    snocket makeBearer connStateIdSupply
                                    confSock socket
@@ -469,82 +483,87 @@ withBidirectionalConnectionManager name timeouts
                                    acceptedConnLimit k = do
     mainThreadId <- myThreadId
     inbgovInfoChannel <- newInformationChannel
-    let muxTracer = WithName name `contramap` nullTracer -- mux tracer
-
-    CM.with
-      CM.Arguments {
-          -- ConnectionManagerTrace
-          CM.tracer    = WithName name
-                        `contramap` tracer,
-          CM.trTracer  = (WithName name . fmap CM.abstractState)
-                        `contramap` trTracer,
-          -- MuxTracer
-          CM.muxTracer    = muxTracer,
-          CM.ipv4Address  = localAddress,
-          CM.ipv6Address  = Nothing,
-          CM.addressType  = \_ -> Just IPv4Address,
-          CM.snocket      = snocket,
-          CM.makeBearer   = makeBearer,
-          CM.withBuffer = \f -> f Nothing,
-          CM.configureSocket = \sock _ -> confSock sock,
-          CM.timeWaitTimeout = tTimeWaitTimeout timeouts,
-          CM.outboundIdleTimeout = tOutboundIdleTimeout timeouts,
-          CM.connectionDataFlow = \(DataFlowProtocolData df _) -> df,
-          CM.prunePolicy = simplePrunePolicy,
-          CM.stdGen,
-          CM.connectionsLimits = acceptedConnLimit,
-          CM.updateVersionData = \versionData diffusionMode ->
+    let mkConnectionHandler singMuxMode =
+          makeConnectionHandler
+            ((Compose . WithName name) `Mx.contramapTracers'` muxTracer)
+            noBindForkPolicy
+            HandshakeArguments {
+                -- TraceSendRecv
+                haHandshakeTracer = WithName name `contramap` nullTracer,
+                haBearerTracer = WithName `contramap` nullTracer,
+                haHandshakeCodec = unversionedHandshakeCodec,
+                haVersionDataCodec = cborTermVersionDataCodec dataFlowProtocolDataCodec,
+                haAcceptVersion = acceptableVersion,
+                haQueryVersion = queryVersion,
+                haTimeLimits = handshakeTimeLimits
+              }
+            (dataFlowProtocol Duplex serverApplication)
+            (mainThreadId,   debugMuxErrorRethrowPolicy
+                          <> debugMuxRuntimeErrorRethrowPolicy
+                          <> debugIOErrorRethrowPolicy
+                          <> assertRethrowPolicy)
+            singMuxMode
+
+        withConnectionManager connectionHandler k' =
+          CM.with CM.Arguments {
+            -- ConnectionManagerTrace
+            tracer    = WithName name
+                          `contramap` tracer,
+            trTracer  = (WithName name . fmap CM.abstractState)
+                          `contramap` trTracer,
+            -- low level bearer tracer
+            ipv4Address  = localAddress,
+            ipv6Address  = Nothing,
+            addressType  = \_ -> Just IPv4Address,
+            snocket,
+            makeBearer,
+            withBuffer = \f -> f Nothing,
+            configureSocket = \sock _ -> confSock sock,
+            connectionDataFlow = \(DataFlowProtocolData df _) -> df,
+            timeWaitTimeout = tTimeWaitTimeout timeouts,
+            outboundIdleTimeout = tOutboundIdleTimeout timeouts,
+            -- CM.connectionDataFlow = \(DataFlowProtocolData df _) -> df,
+            prunePolicy = simplePrunePolicy,
+            stdGen,
+            connectionsLimits = acceptedConnLimit,
+            updateVersionData = \versionData diffusionMode ->
                                   versionData { getProtocolDataFlow =
                                                   case diffusionMode of
                                                     InitiatorOnlyDiffusionMode         -> Unidirectional
                                                     InitiatorAndResponderDiffusionMode -> Duplex
                                               },
-          CM.connStateIdSupply
-        }
-        (makeConnectionHandler
-          muxTracer
-          SingInitiatorResponderMode
-          noBindForkPolicy
-          HandshakeArguments {
-              -- TraceSendRecv
-              haHandshakeTracer = WithName name `contramap` nullTracer,
-              haHandshakeCodec = unversionedHandshakeCodec,
-              haVersionDataCodec = cborTermVersionDataCodec dataFlowProtocolDataCodec,
-              haAcceptVersion = acceptableVersion,
-              haQueryVersion = queryVersion,
-              haTimeLimits = handshakeTimeLimits
+            connStateIdSupply,
+            classifyHandleError = (\_ -> HandshakeFailure)
             }
-          (dataFlowProtocol Duplex serverApplication)
-          (mainThreadId,   debugMuxErrorRethrowPolicy
-                        <> debugMuxRuntimeErrorRethrowPolicy
-                        <> debugIOErrorRethrowPolicy
-                        <> assertRethrowPolicy))
-        (\_ -> HandshakeFailure)
-        (InResponderMode inbgovInfoChannel)
-      $ \connectionManager ->
-          do
-            serverAddr <- Snocket.getLocalAddr snocket socket
-            Server.with
-              Server.Arguments {
-                  Server.sockets = socket :| [],
-                  Server.snocket = snocket,
-                  Server.trTracer =
-                    WithName name `contramap` inboundTrTracer,
-                  Server.tracer =
-                    WithName name `contramap` nullTracer, -- ServerTrace
-                  Server.debugInboundGovernor =
-                    WithName name `contramap` debugTracer,
-                  Server.inboundGovernorTracer =
-                    WithName name `contramap` inboundTracer, -- InboundGovernorTrace
-                  Server.connectionLimits = acceptedConnLimit,
-                  Server.connectionManager = connectionManager,
-                  Server.connectionDataFlow = \(DataFlowProtocolData df _) -> df,
-                  Server.inboundIdleTimeout = Just (tProtocolIdleTimeout timeouts),
-                  Server.inboundInfoChannel = inbgovInfoChannel
-                }
-              (\inboundGovernorAsync _ -> k connectionManager serverAddr inboundGovernorAsync)
-          `catch` \(e :: SomeException) -> do
-            throwIO e
+            (InResponderMode inbgovInfoChannel)
+            connectionHandler
+            k'
+
+    serverAddr <- Snocket.getLocalAddr snocket socket
+    handle (\(e :: SomeException) -> throwIO e) $
+      Server.with
+        Server.Arguments {
+          sockets = socket :| [],
+          snocket = snocket,
+          tracer =
+            WithName name `contramap` nullTracer, -- ServerTrace
+          connectionLimits = acceptedConnLimit,
+          inboundGovernorArgs =
+            InboundGovernor.Arguments {
+              transitionTracer =
+               WithName name `contramap` inboundTrTracer,
+              tracer =
+                WithName name `contramap` inboundTracer, -- InboundGovernorTrace
+              debugTracer =
+                WithName name `contramap` debugTracer,
+              connectionDataFlow = \(DataFlowProtocolData df _) -> df,
+              infoChannel = inbgovInfoChannel,
+              idleTimeout = Just (tProtocolIdleTimeout timeouts),
+              withConnectionManager,
+              mkConnectionHandler = mkConnectionHandler SingInitiatorResponderMode (\(DataFlowProtocolData df _) -> df)
+              }
+          }
+          (\inboundGovernorAsync _ connectionManager -> k connectionManager serverAddr inboundGovernorAsync)
   where
     serverApplication :: TemperatureBundle
                           [MiniProtocol Mx.InitiatorResponderMode
@@ -743,7 +762,7 @@ unidirectionalExperiment stdGen timeouts snocket makeBearer confSock socket clie
       $ \connectionManager ->
         withBidirectionalConnectionManager "server" timeouts
                                            nullTracer nullTracer nullTracer
-                                           nullTracer nullTracer
+                                           nullTracer Mx.nullTracers nullTracer
                                            stdGen''
                                            snocket makeBearer connStateIdSupply
                                            confSock socket Nothing
@@ -827,7 +846,7 @@ bidirectionalExperiment
       nextRequests0 <- oneshotNextRequests clientAndServerData0
       nextRequests1 <- oneshotNextRequests clientAndServerData1
       withBidirectionalConnectionManager "node-0" timeouts
-                                         nullTracer nullTracer nullTracer nullTracer
+                                         nullTracer nullTracer nullTracer nullTracer Mx.nullTracers
                                          nullTracer stdGen' snocket makeBearer
                                          connStateIdSupply confSock
                                          socket0 (Just localAddr0)
@@ -837,7 +856,7 @@ bidirectionalExperiment
                                          maxAcceptedConnectionsLimit
         (\connectionManager0 _serverAddr0 _serverAsync0 -> do
           withBidirectionalConnectionManager "node-1" timeouts
-                                             nullTracer nullTracer nullTracer nullTracer
+                                             nullTracer nullTracer nullTracer nullTracer Mx.nullTracers
                                              nullTracer stdGen'' snocket makeBearer
                                              connStateIdSupply confSock
                                              socket1 (Just localAddr1)
@@ -931,19 +950,6 @@ bidirectionalExperiment
 -- Utils
 --
 
-
--- | Redefine this tracer to get valuable tracing information from various
--- components:
---
--- * connection-manager
--- * inbound governor
--- * server
---
--- debugTracer :: (MonadSay m, MonadTime m, Show a) => Tracer m a
--- debugTracer = Tracer (\msg -> (,msg) <$> getCurrentTime >>= say . show)
-           -- <> Tracer Debug.traceShowM
-
-
 withLock :: ( MonadSTM   m
             , MonadThrow m
             )
diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs
index 8b3ad61dba9..f1adcf6b9c5 100644
--- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs
+++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs
@@ -1326,18 +1326,14 @@ prop_channel_simultaneous_open_sim codec versionDataCodec
               (Snocket.connect sn fdConn' addr)
             bearer  <- Mx.getBearer makeFDBearer
                         1
-                        nullTracer
-                        -- (("client",) `contramap` Tracer Debug.traceShowM)
                         fdConn
                         Nothing
             bearer' <- Mx.getBearer makeFDBearer
                         1
-                        nullTracer
-                        -- (("server",) `contramap` Tracer Debug.traceShowM)
                         fdConn'
                         Nothing
-            let chann  = bearerAsChannel bearer  (MiniProtocolNum 0) InitiatorDir
-                chann' = bearerAsChannel bearer' (MiniProtocolNum 0) InitiatorDir
+            let chann  = bearerAsChannel nullTracer bearer  (MiniProtocolNum 0) InitiatorDir
+                chann' = bearerAsChannel nullTracer bearer' (MiniProtocolNum 0) InitiatorDir
             res <- prop_channel_simultaneous_open
               (pure (chann, chann'))
               codec
diff --git a/ouroboros-network-testing/src/Test/Ouroboros/Network/Utils.hs b/ouroboros-network-testing/src/Test/Ouroboros/Network/Utils.hs
index 119b3def13e..2919ee0b6f0 100644
--- a/ouroboros-network-testing/src/Test/Ouroboros/Network/Utils.hs
+++ b/ouroboros-network-testing/src/Test/Ouroboros/Network/Utils.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TupleSections              #-}
 
 module Test.Ouroboros.Network.Utils
   ( -- * Arbitrary Delays
@@ -30,6 +31,7 @@ module Test.Ouroboros.Network.Utils
   , splitWithNameTrace
     -- * Tracers
   , debugTracer
+  , debugTracerG
   , sayTracer
     -- * Tasty Utils
   , nightlyTest
@@ -38,6 +40,8 @@ module Test.Ouroboros.Network.Utils
   , renderRanges
   ) where
 
+import GHC.Real
+
 import Control.Monad.Class.MonadSay
 import Control.Monad.Class.MonadTime.SI
 import Control.Tracer (Contravariant (contramap), Tracer (..), contramapM)
@@ -48,7 +52,6 @@ import Data.List.Trace (Trace)
 import Data.List.Trace qualified as Trace
 import Data.Map qualified as Map
 import Data.Maybe (fromJust, isJust)
-import Data.Ratio
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Text.Pretty.Simple (pPrint)
@@ -61,7 +64,7 @@ import Test.Tasty.ExpectedFailure (ignoreTest)
 
 newtype Delay = Delay { getDelay :: DiffTime }
   deriving Show
-  deriving newtype (Eq, Ord, Num)
+  deriving newtype (Eq, Ord, Num, Fractional, Real)
 
 
 genDelayWithPrecision :: Integer -> Gen DiffTime
@@ -76,18 +79,20 @@ genDelayWithPrecision precision =
 --
 instance Arbitrary Delay where
     arbitrary = Delay <$> genDelayWithPrecision 10
-    shrink (Delay delay) | delay >= 0.1 = [ Delay (delay - 0.1) ]
-                         | otherwise    = []
+    shrink delay | delay > 0.1 =
+      takeWhile (>= 0.1) . map fromRational . shrink . toRational $ delay
+    shrink _delay = []
 
 
 newtype SmallDelay = SmallDelay { getSmallDelay :: DiffTime }
   deriving Show
-  deriving newtype (Eq, Ord, Num)
+  deriving newtype (Eq, Ord, Num, Fractional, Real)
 
 instance Arbitrary SmallDelay where
     arbitrary = resize 5 $ SmallDelay . getDelay <$> suchThat arbitrary (\(Delay d ) -> d < 5)
-    shrink (SmallDelay delay) | delay >= 0.1 = [ SmallDelay (delay - 0.1) ]
-                              | otherwise    = []
+    shrink delay | delay > 0.1 =
+      takeWhile (>= 0.1) . map fromRational . shrink . toRational $ delay
+    shrink _delay = []
 
 -- | Pick a subset of a set, using a 50:50 chance for each set element.
 --
@@ -167,13 +172,19 @@ data WithName name event = WithName {
     wnName  :: name,
     wnEvent :: event
   }
-  deriving (Show, Functor)
+  deriving (Functor)
+
+instance (Show name, Show event) => Show (WithName name event) where
+  show (WithName name ev) = "#" <> show name <> " %" <> show ev
 
 data WithTime event = WithTime {
     wtTime  :: Time,
     wtEvent :: event
   }
-  deriving (Show, Functor)
+  deriving (Functor)
+
+instance Show event => Show (WithTime event) where
+  show (WithTime t ev) = "@" <> show t <> " " <> show ev
 
 tracerWithName :: name -> Tracer m (WithName name a) -> Tracer m a
 tracerWithName name = contramap (WithName name)
@@ -227,6 +238,16 @@ debugTracer = Tracer traceShowM
 sayTracer :: ( Show a, MonadSay m) => Tracer m a
 sayTracer = Tracer (say . show)
 
+-- | Redefine this tracer to get valuable tracing information from various
+-- components:
+--
+-- * connection-manager
+-- * inbound governor
+-- * server
+--
+debugTracerG :: (MonadSay m, MonadTime m, Show a) => Tracer m a
+debugTracerG = Tracer (\msg -> (,msg) <$> getCurrentTime >>= say . show)
+           -- <> Tracer Debug.traceShowM
 
 --
 -- Nightly tests
diff --git a/ouroboros-network/demo/chain-sync.hs b/ouroboros-network/demo/chain-sync.hs
index dfe73191fab..8ad74bdeae7 100644
--- a/ouroboros-network/demo/chain-sync.hs
+++ b/ouroboros-network/demo/chain-sync.hs
@@ -281,6 +281,7 @@ serverChainSync sockAddr slotLength seed = withIOManager $ \iocp -> do
       (localAddressFromPath sockAddr)
       HandshakeArguments {
         haHandshakeTracer  = nullTracer,
+        haBearerTracer     = nullTracer,
         haHandshakeCodec   = unversionedHandshakeCodec,
         haVersionDataCodec = unversionedProtocolDataCodec,
         haAcceptVersion    = acceptableVersion,
@@ -555,6 +556,7 @@ serverBlockFetch sockAddr slotLength seed = withIOManager $ \iocp -> do
       (localAddressFromPath sockAddr)
       HandshakeArguments {
         haHandshakeTracer  = nullTracer,
+        haBearerTracer     = nullTracer,
         haHandshakeCodec   = unversionedHandshakeCodec,
         haVersionDataCodec = unversionedProtocolDataCodec,
         haAcceptVersion    = acceptableVersion,
diff --git a/ouroboros-network/io-tests/Test/Ouroboros/Network/Pipe.hs b/ouroboros-network/io-tests/Test/Ouroboros/Network/Pipe.hs
index f69a4fc09ae..c25d2bd2323 100644
--- a/ouroboros-network/io-tests/Test/Ouroboros/Network/Pipe.hs
+++ b/ouroboros-network/io-tests/Test/Ouroboros/Network/Pipe.hs
@@ -194,8 +194,8 @@ demo chain0 updates = do
                                      , ChainSync.chainSyncServerPeer server
                                      )
 
-        clientBearer <- Mx.getBearer Mx.makePipeChannelBearer (-1) activeTracer chan1 Nothing
-        serverBearer <- Mx.getBearer Mx.makePipeChannelBearer (-1) activeTracer chan2 Nothing
+        clientBearer <- Mx.getBearer Mx.makePipeChannelBearer (-1) chan1 Nothing
+        serverBearer <- Mx.getBearer Mx.makePipeChannelBearer (-1) chan2 Nothing
 
         _ <- async $ do
               clientMux <- Mx.new (toMiniProtocolInfos (\_ _ -> Nothing) consumerApp)
@@ -217,7 +217,7 @@ demo chain0 updates = do
                       InitiatorProtocolOnly initiator ->
                         [(Mx.InitiatorDirectionOnly, void . runMiniProtocolCb initiator initCtx)]
                 ]
-              withAsync (Mx.run nullTracer clientMux clientBearer) $ \aid -> do
+              withAsync (Mx.run (Mx.Tracers activeTracer activeTracer activeTracer) clientMux clientBearer) $ \aid -> do
                 _ <- atomically $ runFirstToFinish $ foldMap FirstToFinish resOps
                 Mx.stop clientMux
                 wait aid
@@ -242,7 +242,7 @@ demo chain0 updates = do
                       ResponderProtocolOnly responder ->
                         [(Mx.ResponderDirectionOnly, void . runMiniProtocolCb responder respCtx)]
                 ]
-              withAsync (Mx.run nullTracer serverMux serverBearer) $ \aid -> do
+              withAsync (Mx.run (Mx.Tracers activeTracer activeTracer activeTracer) serverMux serverBearer) $ \aid -> do
                 _ <- atomically $ runFirstToFinish $ foldMap FirstToFinish resOps
                 Mx.stop serverMux
                 wait aid
diff --git a/ouroboros-network/io-tests/Test/Ouroboros/Network/Socket.hs b/ouroboros-network/io-tests/Test/Ouroboros/Network/Socket.hs
index 82d91784bc9..ce57c65d06e 100644
--- a/ouroboros-network/io-tests/Test/Ouroboros/Network/Socket.hs
+++ b/ouroboros-network/io-tests/Test/Ouroboros/Network/Socket.hs
@@ -165,6 +165,7 @@ demo chain0 updates = withIOManager $ \iocp -> do
       producerAddress
       HandshakeArguments {
         haHandshakeTracer  = nullTracer,
+        haBearerTracer     = nullTracer,
         haHandshakeCodec   = nodeToNodeHandshakeCodec,
         haVersionDataCodec = cborTermVersionDataCodec nodeToNodeCodecCBORTerm,
         haAcceptVersion    = acceptableVersion,
diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion.hs
index 0308d81d14e..51c6aeb649c 100644
--- a/ouroboros-network/src/Ouroboros/Network/Diffusion.hs
+++ b/ouroboros-network/src/Ouroboros/Network/Diffusion.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments           #-}
 {-# LANGUAGE CPP                      #-}
 {-# LANGUAGE DataKinds                #-}
 {-# LANGUAGE DisambiguateRecordFields #-}
@@ -53,6 +54,7 @@ import System.Random (StdGen, newStdGen, split)
 import Network.DNS (Resolver)
 import Network.Mux qualified as Mx
 import Network.Mux.Bearer (withReadBufferIO)
+import Network.Mux.Types
 import Network.Socket (Socket)
 import Network.Socket qualified as Socket
 
@@ -185,7 +187,11 @@ runM Interfaces
        }
      Tracers
        { dtMuxTracer
+       , dtChannelTracer
+       , dtBearerTracer
        , dtLocalMuxTracer
+       , dtLocalChannelTracer
+       , dtLocalBearerTracer
        , dtDiffusionTracer = tracer
        , dtTracePeerSelectionTracer
        , dtTraceChurnCounters
@@ -326,12 +332,15 @@ runM Interfaces
 
         let localConnectionLimits = AcceptedConnectionsLimit maxBound maxBound 0
 
-            localConnectionHandler :: NodeToClientConnectionHandler
+            mkLocalConnectionHandler :: NodeToClientMkConnectionHandler
                                         ntcFd ntcAddr ntcVersion ntcVersionData m
-            localConnectionHandler =
+            mkLocalConnectionHandler responderMuxChannelTracer =
               makeConnectionHandler
-                dtLocalMuxTracer
-                SingResponderMode
+                Mx.Tracers {
+                  Mx.tracer        = dtLocalMuxTracer,
+                  Mx.channelTracer = dtLocalChannelTracer,
+                  Mx.bearerTracer  = dtLocalBearerTracer
+                }
                 daLocalMuxForkPolicy
                 diNtcHandshakeArguments
                 ( ( \ (OuroborosApplication apps)
@@ -341,59 +350,52 @@ runM Interfaces
                         (WithEstablished [])
                   ) <$> daLocalResponderApplication )
                 (mainThreadId, rethrowPolicy <> daLocalRethrowPolicy)
-
-            localConnectionManagerArguments
-              :: NodeToClientConnectionManagerArguments
-                   ntcFd ntcAddr ntcVersion ntcVersionData m
-            localConnectionManagerArguments =
-              CM.Arguments {
-                  CM.tracer              = dtLocalConnectionManagerTracer,
-                  CM.trTracer            = nullTracer, -- TODO: issue #3320
-                  CM.muxTracer           = dtLocalMuxTracer,
-                  CM.ipv4Address         = Nothing,
-                  CM.ipv6Address         = Nothing,
-                  CM.addressType         = const Nothing,
-                  CM.snocket             = diNtcSnocket,
-                  CM.makeBearer          = diNtcBearer,
-                  CM.withBuffer          = diWithBuffer,
-                  CM.configureSocket     = \_ _ -> return (),
-                  CM.timeWaitTimeout     = local_TIME_WAIT_TIMEOUT,
-                  CM.outboundIdleTimeout = local_PROTOCOL_IDLE_TIMEOUT,
-                  CM.connectionDataFlow  = ntcDataFlow,
-                  CM.prunePolicy         = Diffusion.Policies.prunePolicy,
-                  CM.stdGen              = cmLocalStdGen,
-                  CM.connectionsLimits   = localConnectionLimits,
-                  CM.updateVersionData   = \a _ -> a,
-                  CM.connStateIdSupply   = diConnStateIdSupply
+                SingResponderMode
+                responderMuxChannelTracer
+
+            localWithConnectionManager responderInfoChannel connectionHandler k =
+              CM.with CM.Arguments {
+                  tracer              = dtLocalConnectionManagerTracer,
+                  trTracer            = nullTracer, -- TODO: issue #3320
+                  ipv4Address         = Nothing,
+                  ipv6Address         = Nothing,
+                  addressType         = const Nothing,
+                  snocket             = diNtcSnocket,
+                  makeBearer          = diNtcBearer,
+                  withBuffer          = diWithBuffer,
+                  configureSocket     = \_ _ -> return (),
+                  timeWaitTimeout     = local_TIME_WAIT_TIMEOUT,
+                  outboundIdleTimeout = local_PROTOCOL_IDLE_TIMEOUT,
+                  connectionDataFlow  = ntcDataFlow,
+                  prunePolicy         = Diffusion.Policies.prunePolicy,
+                  stdGen              = cmLocalStdGen,
+                  connectionsLimits   = localConnectionLimits,
+                  updateVersionData   = \a _ -> a,
+                  connStateIdSupply   = diConnStateIdSupply,
+                  classifyHandleError
               }
-
-        CM.with
-          localConnectionManagerArguments
-          localConnectionHandler
-          classifyHandleError
-          (InResponderMode localInbInfoChannel)
-          $ \localConnectionManager-> do
-            --
-            -- run node-to-client server
-            --
-            traceWith tracer . RunLocalServer
-              =<< Snocket.getLocalAddr diNtcSnocket localSocket
-
-            Server.with
-              Server.Arguments {
-                  Server.sockets               = localSocket :| [],
-                  Server.snocket               = diNtcSnocket,
-                  Server.tracer                = dtLocalServerTracer,
-                  Server.trTracer              = nullTracer, -- TODO: issue #3320
-                  Server.debugInboundGovernor  = nullTracer,
-                  Server.inboundGovernorTracer = dtLocalInboundGovernorTracer,
-                  Server.inboundIdleTimeout    = Nothing,
-                  Server.connectionLimits      = localConnectionLimits,
-                  Server.connectionManager     = localConnectionManager,
-                  Server.connectionDataFlow    = ntcDataFlow,
-                  Server.inboundInfoChannel    = localInbInfoChannel
-                }
-              (\inboundGovernorThread _ -> Async.wait inboundGovernorThread)
+              (InResponderMode responderInfoChannel)
+              connectionHandler
+              k
+
+        traceWith tracer . RunLocalServer =<< Snocket.getLocalAddr diNtcSnocket localSocket
+        Server.with
+          Server.Arguments {
+              sockets               = localSocket :| [],
+              snocket               = diNtcSnocket,
+              tracer                = dtLocalServerTracer,
+              connectionLimits      = localConnectionLimits,
+              inboundGovernorArgs   =
+                IG.Arguments {
+                  tracer                = dtLocalInboundGovernorTracer,
+                  transitionTracer      = nullTracer,
+                  debugTracer           = nullTracer,
+                  connectionDataFlow    = ntcDataFlow,
+                  idleTimeout           = Nothing,
+                  withConnectionManager = localWithConnectionManager localInbInfoChannel,
+                  mkConnectionHandler   = mkLocalConnectionHandler,
+                  infoChannel           = localInbInfoChannel } }
+          (\inboundGovernorThread _ _ -> Async.wait inboundGovernorThread)
 
 
     -- | mkRemoteThread - create remote connection manager
@@ -465,34 +467,34 @@ runM Interfaces
       --
 
       let connectionManagerArguments'
-            :: forall handle handleError.
+            :: forall muxMode handle b.
                PrunePolicy ntnAddr
             -> StdGen
             -> CM.Arguments
                  (ConnectionHandlerTrace ntnVersion ntnVersionData)
-                 ntnFd ntnAddr handle handleError ntnVersion ntnVersionData m
+                 ntnFd ntnAddr handle (HandleError muxMode ntnVersion) ntnVersion ntnVersionData m a b
           connectionManagerArguments' prunePolicy stdGen =
             CM.Arguments {
-                CM.tracer              = dtConnectionManagerTracer,
-                CM.trTracer            =
+                tracer              = dtConnectionManagerTracer,
+                trTracer            =
                   fmap CM.abstractState
                   `contramap` dtConnectionManagerTransitionTracer,
-                CM.muxTracer           = dtMuxTracer,
-                CM.ipv4Address,
-                CM.ipv6Address,
-                CM.addressType         = diNtnAddressType,
-                CM.snocket             = diNtnSnocket,
-                CM.makeBearer          = diNtnBearer,
-                CM.withBuffer          = diWithBuffer,
-                CM.configureSocket     = diNtnConfigureSocket,
-                CM.connectionDataFlow  = diNtnDataFlow,
-                CM.prunePolicy         = prunePolicy,
-                CM.stdGen,
-                CM.connectionsLimits   = daAcceptedConnectionsLimit,
-                CM.timeWaitTimeout     = daTimeWaitTimeout,
-                CM.outboundIdleTimeout = daProtocolIdleTimeout,
-                CM.updateVersionData   = diUpdateVersionData,
-                CM.connStateIdSupply   = diConnStateIdSupply
+                ipv4Address,
+                ipv6Address,
+                addressType         = diNtnAddressType,
+                snocket             = diNtnSnocket,
+                makeBearer          = diNtnBearer,
+                withBuffer          = diWithBuffer,
+                configureSocket     = diNtnConfigureSocket,
+                connectionDataFlow  = diNtnDataFlow,
+                prunePolicy         = prunePolicy,
+                stdGen,
+                connectionsLimits   = daAcceptedConnectionsLimit,
+                timeWaitTimeout     = daTimeWaitTimeout,
+                outboundIdleTimeout = daProtocolIdleTimeout,
+                updateVersionData   = diUpdateVersionData,
+                connStateIdSupply   = diConnStateIdSupply,
+                classifyHandleError
             }
 
       let peerSelectionPolicy =
@@ -500,48 +502,29 @@ runM Interfaces
               policyRngVar daPeerMetrics (epErrorDelay exitPolicy)
 
       let makeConnectionHandler'
-            :: forall muxMode socket initiatorCtx responderCtx b c.
-               SingMuxMode muxMode
-            -> Versions ntnVersion ntnVersionData
+            :: forall muxMode initiatorCtx responderCtx b c.
+               Versions ntnVersion ntnVersionData
                  (OuroborosBundle muxMode initiatorCtx responderCtx ByteString m b c)
-            -> MuxConnectionHandler
-                 muxMode socket initiatorCtx responderCtx ntnAddr
+            -> SingMuxMode muxMode
+            -> MkMuxConnectionHandler
+                 muxMode ntnFd initiatorCtx responderCtx ntnAddr
                  ntnVersion ntnVersionData ByteString m b c
-          makeConnectionHandler' muxMode versions =
+          makeConnectionHandler' versions singMuxMode =
             makeConnectionHandler
-              dtMuxTracer
-              muxMode
+              Mx.Tracers {
+                Mx.tracer        = dtMuxTracer,
+                Mx.channelTracer = dtChannelTracer,
+                Mx.bearerTracer  = dtBearerTracer
+              }
               daMuxForkPolicy
               diNtnHandshakeArguments
               versions
               (mainThreadId, rethrowPolicy <> daRethrowPolicy)
+              singMuxMode
 
           -- | Capture the two variations (InitiatorMode,InitiatorResponderMode) of
           --   withConnectionManager:
 
-          withConnectionManagerInitiatorOnlyMode =
-            CM.with
-              (connectionManagerArguments' simplePrunePolicy cmStdGen1)
-                 -- Server is not running, it will not be able to
-                 -- advise which connections to prune.  It's also not
-                 -- expected that the governor targets will be larger
-                 -- than limits imposed by 'cmConnectionsLimits'.
-              (makeConnectionHandler'
-                SingInitiatorMode
-                daApplicationInitiatorMode)
-              classifyHandleError
-              NotInResponderMode
-
-          withConnectionManagerInitiatorAndResponderMode
-            inbndInfoChannel =
-              CM.with
-                (connectionManagerArguments' Diffusion.Policies.prunePolicy cmStdGen2)
-                (makeConnectionHandler'
-                   SingInitiatorResponderMode
-                   daApplicationInitiatorResponderMode)
-                classifyHandleError
-                (InResponderMode inbndInfoChannel)
-
       --
       -- peer state actions
       --
@@ -721,23 +704,6 @@ runM Interfaces
               )
               f
 
-          -- run node-to-node server
-          withServer sockets connectionManager inboundInfoChannel =
-            Server.with
-              Server.Arguments {
-                  Server.sockets               = sockets,
-                  Server.snocket               = diNtnSnocket,
-                  Server.tracer                = dtServerTracer,
-                  Server.trTracer              = dtInboundGovernorTransitionTracer,
-                  Server.debugInboundGovernor  = nullTracer,
-                  Server.inboundGovernorTracer = dtInboundGovernorTracer,
-                  Server.connectionLimits      = daAcceptedConnectionsLimit,
-                  Server.connectionManager     = connectionManager,
-                  Server.connectionDataFlow    = diNtnDataFlow,
-                  Server.inboundIdleTimeout    = Just daProtocolIdleTimeout,
-                  Server.inboundInfoChannel    = inboundInfoChannel
-                }
-
       --
       -- Part (b): capturing the major control-flow of runM:
       --
@@ -745,14 +711,29 @@ runM Interfaces
 
         -- InitiatorOnly mode, run peer selection only:
         InitiatorOnlyDiffusionMode ->
-          withConnectionManagerInitiatorOnlyMode $ \connectionManager-> do
-          debugStateVar <- newTVarIO $ Governor.emptyPeerSelectionState fuzzRng daEmptyExtraState mempty
-          diInstallSigUSR1Handler connectionManager debugStateVar daPeerMetrics
-          withPeerStateActions' connectionManager $ \peerStateActions->
-            withPeerSelectionActions'
-              (return Map.empty)
-              peerStateActions $
-              \(ledgerPeersThread, localRootPeersProvider) peerSelectionActions->
+          let withConnectionManagerInitiatorOnlyMode k =
+                CM.with
+                  (connectionManagerArguments' simplePrunePolicy cmStdGen1)
+                     -- Server is not running, it will not be able to
+                     -- advise which connections to prune.  It's also not
+                     -- expected that the governor targets will be larger
+                     -- than limits imposed by 'cmConnectionsLimits'.
+                  NotInResponderMode
+                  mkConnectionHandler
+                  k
+
+              mkConnectionHandler =
+                makeConnectionHandler' daApplicationInitiatorMode
+                                       SingInitiatorMode in
+
+          withConnectionManagerInitiatorOnlyMode $ \connectionManager -> do
+            debugStateVar <- newTVarIO $ Governor.emptyPeerSelectionState fuzzRng daEmptyExtraState mempty
+            diInstallSigUSR1Handler connectionManager debugStateVar daPeerMetrics
+            withPeerStateActions' connectionManager $ \peerStateActions ->
+              withPeerSelectionActions'
+                (return Map.empty)
+                peerStateActions
+                \(ledgerPeersThread, localRootPeersProvider) peerSelectionActions ->
                 Async.withAsync
                   (peerSelectionGovernor'
                     dtDebugPeerSelectionInitiatorTracer
@@ -766,45 +747,77 @@ runM Interfaces
 
         -- InitiatorAndResponder mode, run peer selection and the server:
         InitiatorAndResponderDiffusionMode -> do
-          inboundInfoChannel  <- newInformationChannel
-          withConnectionManagerInitiatorAndResponderMode
-            inboundInfoChannel $ \connectionManager ->
-              --
-              -- node-to-node sockets
-              --
-              withSockets' $ \sockets addresses -> do
-                --
-                -- node-to-node server
-                --
-                withServer sockets connectionManager inboundInfoChannel $
-                  \inboundGovernorThread readInboundState -> do
-                    debugStateVar <- newTVarIO $ Governor.emptyPeerSelectionState fuzzRng daEmptyExtraState mempty
-                    diInstallSigUSR1Handler connectionManager debugStateVar daPeerMetrics
-                    withPeerStateActions' connectionManager $
-                      \peerStateActions ->
-                        withPeerSelectionActions'
-                          (mkInboundPeersMap <$> readInboundState)
-                          peerStateActions $
-                            \(ledgerPeersThread, localRootPeersProvider) peerSelectionActions ->
-                              Async.withAsync
-                                (do
-                                  labelThisThread "Peer selection governor"
-                                  peerSelectionGovernor' dtDebugPeerSelectionInitiatorResponderTracer debugStateVar peerSelectionActions) $
-                                    \governorThread -> do
-                                      -- begin, unique to InitiatorAndResponder mode:
-                                      traceWith tracer (RunServer addresses)
-                                      -- end, unique to ...
-                                      Async.withAsync (do
-                                                          labelThisThread "Peer churn governor"
-                                                          peerChurnGovernor') $
-                                        \churnGovernorThread ->
-                                          -- wait for any thread to fail:
-                                          snd <$> Async.waitAny [ ledgerPeersThread
-                                                                , localRootPeersProvider
-                                                                , governorThread
-                                                                , churnGovernorThread
-                                                                , inboundGovernorThread
-                                                                ]
+          inboundInfoChannel <- newInformationChannel
+          let mkConnectionHandler =
+                makeConnectionHandler' daApplicationInitiatorResponderMode
+
+              -- bootstrap node-to-node server continuation
+              withServer sockets =
+                Server.with
+                  Server.Arguments {
+                    sockets               = sockets,
+                    snocket               = diNtnSnocket,
+                    tracer                = dtServerTracer,
+                    connectionLimits      = daAcceptedConnectionsLimit,
+                    inboundGovernorArgs   =
+                      IG.Arguments {
+                        tracer = dtInboundGovernorTracer,
+                        transitionTracer      = dtInboundGovernorTransitionTracer,
+                        debugTracer           = nullTracer,
+                        connectionDataFlow    = diNtnDataFlow,
+                        idleTimeout           = Just daProtocolIdleTimeout,
+                        withConnectionManager =
+                          withConnectionManagerInitiatorAndResponderMode inboundInfoChannel,
+                        mkConnectionHandler   = mkConnectionHandler
+                                                  SingInitiatorResponderMode diNtnDataFlow,
+                        infoChannel           = inboundInfoChannel } }
+
+              -- bootstrap connection manager continuation
+              withConnectionManagerInitiatorAndResponderMode
+                responderInfoChannel connectionHandler k =
+                  CM.with
+                      (connectionManagerArguments' Diffusion.Policies.prunePolicy
+                                                   cmStdGen2)
+                      (InResponderMode responderInfoChannel)
+                      connectionHandler
+                      k
+          --
+          -- node-to-node sockets
+          --
+          withSockets' \sockets addresses -> do
+            --
+            -- node-to-node server
+            --
+            -- begin, unique to InitiatorAndResponder mode:
+            traceWith tracer (RunServer addresses)
+            -- end, unique to ...
+            withServer sockets
+              \inboundGovernorThread readInboundState connectionManager -> do
+                debugStateVar <- newTVarIO $ Governor.emptyPeerSelectionState fuzzRng daEmptyExtraState mempty
+                diInstallSigUSR1Handler connectionManager debugStateVar daPeerMetrics
+                withPeerStateActions' connectionManager
+                  \peerStateActions ->
+                    withPeerSelectionActions'
+                      (mkInboundPeersMap <$> readInboundState)
+                      peerStateActions
+                      \(ledgerPeersThread, localRootPeersProvider) peerSelectionActions ->
+                        Async.withAsync
+                          do
+                            labelThisThread "Peer selection governor"
+                            peerSelectionGovernor' dtDebugPeerSelectionInitiatorResponderTracer debugStateVar peerSelectionActions
+                          \governorThread -> do
+                            Async.withAsync
+                              do
+                                labelThisThread "Peer churn governor"
+                                peerChurnGovernor'
+                              \churnGovernorThread ->
+                                -- wait for any thread to fail:
+                                snd <$> Async.waitAny [ ledgerPeersThread
+                                                      , localRootPeersProvider
+                                                      , governorThread
+                                                      , churnGovernorThread
+                                                      , inboundGovernorThread
+                                                      ]
 
 -- | Main entry point for data diffusion service.  It allows to:
 --
@@ -878,6 +891,7 @@ run sigUSR1Signal tracers args apps = do
         diNtnHandshakeArguments =
           HandshakeArguments {
               haHandshakeTracer = dtHandshakeTracer tracers,
+              haBearerTracer    = dtBearerTracer tracers,
               haHandshakeCodec  = NodeToNode.nodeToNodeHandshakeCodec,
               haVersionDataCodec =
                 cborTermVersionDataCodec
@@ -889,6 +903,7 @@ run sigUSR1Signal tracers args apps = do
         diNtcHandshakeArguments =
           HandshakeArguments {
               haHandshakeTracer  = dtLocalHandshakeTracer tracers,
+              haBearerTracer     = dtLocalBearerTracer tracers,
               haHandshakeCodec   = NodeToClient.nodeToClientHandshakeCodec,
               haVersionDataCodec =
                 cborTermVersionDataCodec
diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/Types.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/Types.hs
index a24afa08f7b..0fc6b1f03bb 100644
--- a/ouroboros-network/src/Ouroboros/Network/Diffusion/Types.hs
+++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/Types.hs
@@ -20,8 +20,7 @@ module Ouroboros.Network.Diffusion.Types
     -- * NodeToClient type aliases
   , NodeToClientHandle
   , NodeToClientHandleError
-  , NodeToClientConnectionHandler
-  , NodeToClientConnectionManagerArguments
+  , NodeToClientMkConnectionHandler
     -- * NodeToNode type aliases
   , NodeToNodeHandle
   , NodeToNodeConnectionManager
@@ -46,6 +45,7 @@ import Data.Void (Void)
 import System.Random (StdGen)
 
 import Network.Mux qualified as Mx
+import Network.Mux.Trace qualified as Mux
 import Network.Mux.Types (ReadBuffer)
 import Network.Socket qualified as Socket
 
@@ -126,6 +126,17 @@ data Tracers ntnAddr ntnVersion ntnVersionData
       dtMuxTracer
         :: Tracer m (Mx.WithBearer (ConnectionId ntnAddr) Mx.Trace)
 
+      -- | Mux's channel tracer
+      --
+    , dtChannelTracer
+        :: Tracer m (Mx.WithBearer (ConnectionId ntnAddr) Mx.ChannelTrace)
+
+      -- | Bearer tracer
+      --
+    , dtBearerTracer
+        :: Tracer m (Mx.WithBearer (ConnectionId ntnAddr) Mx.BearerTrace)
+
+
       -- | Handshake protocol tracer
     , dtHandshakeTracer
         :: Tracer m (NodeToNode.HandshakeTr ntnAddr ntnVersion)
@@ -135,9 +146,20 @@ data Tracers ntnAddr ntnVersion ntnVersionData
       --
 
       -- | Mux tracer for local clients
+      --
     , dtLocalMuxTracer
         :: Tracer m (Mx.WithBearer (ConnectionId ntcAddr) Mx.Trace)
 
+      -- | Mux's channel tracer for local clients
+      --
+    , dtLocalChannelTracer
+        :: Tracer m (Mx.WithBearer (ConnectionId ntcAddr) Mx.ChannelTrace)
+
+      -- | Bearer tracer for local clients
+      --
+    , dtLocalBearerTracer
+        :: Tracer m (Mx.WithBearer (ConnectionId ntcAddr) Mx.BearerTrace)
+
       -- | Handshake protocol tracer for local clients
     , dtLocalHandshakeTracer
         :: Tracer m (NodeToClient.HandshakeTr ntcAddr ntcVersion)
@@ -225,8 +247,12 @@ nullTracers :: Applicative m
                        extraFlags extraPeers extraCounters m
 nullTracers = Tracers {
     dtMuxTracer                                  = nullTracer
+  , dtChannelTracer                              = nullTracer
+  , dtBearerTracer                               = nullTracer
   , dtHandshakeTracer                            = nullTracer
   , dtLocalMuxTracer                             = nullTracer
+  , dtLocalChannelTracer                         = nullTracer
+  , dtLocalBearerTracer                          = nullTracer
   , dtLocalHandshakeTracer                       = nullTracer
   , dtDiffusionTracer                            = nullTracer
   , dtTraceLocalRootPeersTracer                  = nullTracer
@@ -503,31 +529,20 @@ type NodeToClientHandle ntcAddr versionData m =
 type NodeToClientHandleError ntcVersion =
     HandleError Mx.ResponderMode ntcVersion
 
-type NodeToClientConnectionHandler
+type NodeToClientMkConnectionHandler
       ntcFd ntcAddr ntcVersion ntcVersionData m =
-    ConnectionHandler
-      Mx.ResponderMode
-      (ConnectionHandlerTrace ntcVersion ntcVersionData)
-      ntcFd
-      ntcAddr
-      (NodeToClientHandle ntcAddr ntcVersionData m)
-      (NodeToClientHandleError ntcVersion)
-      ntcVersion
-      ntcVersionData
-      m
-
-type NodeToClientConnectionManagerArguments
-      ntcFd ntcAddr ntcVersion ntcVersionData m =
-    CM.Arguments
-      (ConnectionHandlerTrace ntcVersion ntcVersionData)
-      ntcFd
-      ntcAddr
-      (NodeToClientHandle ntcAddr ntcVersionData m)
-      (NodeToClientHandleError ntcVersion)
-      ntcVersion
-      ntcVersionData
-      m
-
+       (   StrictTVar m (Maybe IG.ResponderCounters)
+        -> Tracer m (Mux.WithBearer (ConnectionId ntcAddr) Mux.Trace))
+    -> ConnectionHandler
+         Mx.ResponderMode
+         (ConnectionHandlerTrace ntcVersion ntcVersionData)
+         ntcFd
+         ntcAddr
+         (NodeToClientHandle ntcAddr ntcVersionData m)
+         (NodeToClientHandleError ntcVersion)
+         ntcVersion
+         ntcVersionData
+         m
 
 --
 -- Node-To-Node type aliases
diff --git a/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Node.hs b/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Node.hs
index 8f574a5daa6..ff740297e5e 100644
--- a/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Node.hs
+++ b/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Node.hs
@@ -279,6 +279,7 @@ run blockGeneratorArgs limits ni na
               , Diff.diNtnHandshakeArguments =
                   HandshakeArguments
                     { haHandshakeTracer  = nullTracer
+                    , haBearerTracer     = nullTracer
                     , haHandshakeCodec   = unversionedHandshakeCodec
                     , haVersionDataCodec = ntnUnversionedDataCodec
                     , haAcceptVersion    = iAcceptVersion ni
@@ -297,6 +298,7 @@ run blockGeneratorArgs limits ni na
               , Diff.diNtcHandshakeArguments =
                   HandshakeArguments
                     { haHandshakeTracer  = nullTracer
+                    , haBearerTracer     = nullTracer
                     , haHandshakeCodec   = unversionedHandshakeCodec
                     , haVersionDataCodec = unversionedProtocolDataCodec
                     , haAcceptVersion    = \_ v -> Accept v
diff --git a/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Testnet/Cardano.hs b/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Testnet/Cardano.hs
index cd792dc749c..752f25bfb08 100644
--- a/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Testnet/Cardano.hs
+++ b/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Testnet/Cardano.hs
@@ -28,6 +28,7 @@ import Data.Bifunctor (first)
 import Data.Dynamic (fromDynamic)
 import Data.Foldable (fold)
 import Data.IP qualified as IP
+import Data.List (intercalate)
 import Data.List qualified as List
 import Data.List.Trace qualified as Trace
 import Data.Map (Map)
@@ -304,7 +305,9 @@ testWithIOSim f traceNumber bi ds =
                                 iosimTracer
       trace = runSimTrace sim
    in labelDiffusionScript ds
-    $ counterexample (Trace.ppTrace show (ppSimEvent 0 0 0) $ Trace.take traceNumber trace)
+    $ counterexample (intercalate "\n" $
+        selectTraceEventsSay' $ Trace.take traceNumber trace)
+    --counterexample (Trace.ppTrace show (ppSimEvent 0 0 0) $ Trace.take traceNumber trace)
     $ f trace traceNumber
 
 
@@ -912,6 +915,7 @@ prop_only_bootstrap_peers_in_fallback_state ioSimTrace traceNumber =
             . Signal.selectEvents
                 (\case TrJoiningNetwork -> Just Joined
                        TrKillingNode    -> Just Killed
+                       TrErrored _      -> Just Killed
                        _                -> Nothing
                 )
             . selectDiffusionSimulationTrace
diff --git a/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Testnet/Cardano/Simulation.hs b/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Testnet/Cardano/Simulation.hs
index d3c484346f0..b899e28b3da 100644
--- a/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Testnet/Cardano/Simulation.hs
+++ b/ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Testnet/Cardano/Simulation.hs
@@ -70,6 +70,7 @@ import Network.DNS qualified as DNS
 import System.Random (StdGen, mkStdGen)
 import System.Random qualified as Random
 
+import Network.Mux qualified as Mux
 import Network.TypedProtocol.Core
 import Network.TypedProtocol.PingPong.Type qualified as PingPong
 
@@ -101,6 +102,7 @@ import Ouroboros.Network.Block (BlockNo)
 import Ouroboros.Network.BlockFetch (FetchMode (..), PraosFetchMode (..),
            TraceFetchClientState, TraceLabelPeer (..))
 import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace)
+import Ouroboros.Network.ConnectionId
 import Ouroboros.Network.ConnectionManager.Core qualified as CM
 import Ouroboros.Network.ConnectionManager.State qualified as CM
 import Ouroboros.Network.ConnectionManager.Types (AbstractTransitionTrace)
@@ -255,6 +257,7 @@ data Command = JoinNetwork DiffTime
                             , WarmValency
                             , Map RelayAccessPoint (LocalRootConfig PeerTrustable)
                             )]
+             | Skip DiffTime
   deriving Eq
 
 instance Show Command where
@@ -266,6 +269,9 @@ instance Show Command where
                                                 . showsPrec d delay
                                                 . showString " "
                                                 . showsPrec d localRoots
+    showsPrec d (Skip delay)                    = showString "Skip"
+                                                . showsPrec d delay
+                                                . showString " "
 
 genCommands :: [( HotValency
                 , WarmValency
@@ -295,17 +301,20 @@ genCommands localRoots = sized $ \size -> do
 
 fixupCommands :: [Command] -> [Command]
 fixupCommands [] = []
-fixupCommands (jn@(JoinNetwork _):t) = jn : go jn t
+fixupCommands (jn@(JoinNetwork _):t) = jn : go jn 0 t
   where
-    go :: Command -> [Command] -> [Command]
-    go _ [] = []
-    go prev (cmd:cmds) =
+    go :: Command -> DiffTime -> [Command] -> [Command]
+    go _ _ [] = []
+    go prev accDelay (cmd:cmds) =
       case (prev, cmd) of
-        (JoinNetwork _   , JoinNetwork _   ) -> go prev cmds
-        (Kill _          , Kill _          ) -> go prev cmds
-        (Kill _          , Reconfigure _ _ ) -> go prev cmds
-        (Reconfigure _ _ , JoinNetwork _   ) -> go prev cmds
-        _                                    -> cmd : go cmd cmds
+        (JoinNetwork _   , JoinNetwork _   ) -> go prev accDelay cmds
+        (Kill _          , Kill _          ) -> go prev accDelay cmds
+        (Kill _          , Reconfigure _ _ ) -> go prev accDelay cmds
+        (Reconfigure _ _ , JoinNetwork _   ) -> go prev accDelay cmds
+        (_               , Skip d          ) -> go prev (d + accDelay) cmds
+        (_               , JoinNetwork d   ) -> JoinNetwork (d + accDelay) : go cmd 0 cmds
+        (_               , Kill d          ) -> Kill (d + accDelay) : go cmd 0 cmds
+        (_               , Reconfigure d c ) -> Reconfigure (d + accDelay) c : go cmd 0 cmds
 fixupCommands (_:t) = fixupCommands t
 
 -- | Simulation arguments.
@@ -376,9 +385,12 @@ genNodeArgs relays minConnected localRootPeers self = flip suchThat hasUpstream
 
   -- Generating an InitiatorResponderMode node is 3 times more likely since we
   -- want our tests to cover more this case.
-  diffusionMode <- frequency [ (1, pure InitiatorOnlyDiffusionMode)
-                             , (3, pure InitiatorAndResponderDiffusionMode)
-                             ]
+  -- diffusionMode <- frequency [ (1, pure InitiatorOnlyDiffusionMode)
+  --                            , (3, pure InitiatorAndResponderDiffusionMode)
+  --                            ]
+  -- TODO: 'cm & ig enforce timeouts' fails in 'InitiatorOnlyDiffusionMode'
+  -- so we pin it to this
+  let diffusionMode = InitiatorAndResponderDiffusionMode
 
   -- These values approximately correspond to false positive
   -- thresholds for streaks of empty slots with 99% probability,
@@ -775,44 +787,48 @@ instance Arbitrary DiffusionScript where
               <$> frequency [ (1, arbitrary >>= genNonHotDiffusionScript)
                             , (1, arbitrary >>= genHotDiffusionScript)]
   -- TODO: shrink dns map
-  -- TODO: we should write more careful shrinking than recursively shrinking
-  -- `DiffusionScript`!
-  shrink (DiffusionScript sargs dnsScript cmds0) = shrinkCmds cmds0 ++ shrinkDns
+  shrink (DiffusionScript sargs dnsScript0 players0) =
+    [DiffusionScript sargs dnsScript0 players
+    | players <- shrinkPlayers players0
+    ] <>
+    [DiffusionScript sargs dnsScript players0
+    | dnsScript <-
+        mapMaybe
+          -- make sure `fixupDomainMapScript` didn't return something that's
+          -- equal to the original `script`
+          ((\dnsScript' -> if dnsScript0 == dnsScript' then Nothing else Just dnsScript')
+           .  fixupDomainMapScript (getLast dnsScript0))
+          $ shrinkScriptWith (liftShrink2 shrinkMap_ shrink) dnsScript0
+    ]
     where
-      shrinkDns =
-        [DiffusionScript sargs script cmds0
-        | script <-
-            mapMaybe
-              -- make sure `fixupDomainMapScript` didn't return something that's
-              -- equal to the original `script`
-              ((\dnsScript' -> if dnsScript == dnsScript' then Nothing else Just dnsScript')
-               .  fixupDomainMapScript (getLast dnsScript))
-              $ shrinkScriptWith (shrinkTuple shrinkMap_ shrink) dnsScript
-        ]
-
       getLast (Script ne) = fst $ NonEmpty.last ne
 
       shrinkMap_ :: Ord a => Map a b -> [Map a b]
       shrinkMap_ = map Map.fromList . shrinkList (const []) . Map.toList
 
-      shrinkTuple :: (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
-      shrinkTuple f g (a, b) = [(a', b) | a' <- f a]
-                            ++ [(a, b') | b' <- g b]
+      -- the easiest failure to analyze is the one with the least number of nodes participating.
+      -- Currently we use up to three nodes, but in case we increase the number in the future
+      -- this will be even more useful.
+      shrinkPlayers =
+        filter ((> 1) . length) . shrinkList shrinkPlayer
 
-      shrinkCmds [] = []
-      shrinkCmds ((nargs, cmds):rest) =
-        let shrunkCmdss = fixupCommands <$> shrinkList shrinkCommand cmds
-            rest' = shrinkCmds rest
-        in [DiffusionScript sargs dnsScript ((nargs, shrunkCmds):rest)
-           | shrunkCmds <- shrunkCmdss] ++ rest'
+      shrinkPlayer (nargs, cmds) =
+        map (nargs,) . filter (/= cmds) $ fixupCommands <$> shrinkList shrinkCommand cmds
         where
           shrinkDelay = map fromRational . shrink . toRational
 
+          -- A failing network with the least nodes active at a particular time is the simplest to analyze,
+          -- if for no other reason other than for having the least amount of traces for us to read.
+          -- A dead node is its simplest configuration as that can't contribute to its failure,
+          -- So we shrink to that first to see at least if a failure occurs somewhere else still.
+          -- Otherwise we know that this node has to be running for sure while the exchange is happening.
           shrinkCommand :: Command -> [Command]
           shrinkCommand (JoinNetwork d)     = JoinNetwork <$> shrinkDelay d
-          shrinkCommand (Kill d)            = Kill        <$> shrinkDelay d
-          shrinkCommand (Reconfigure d lrp) = Reconfigure <$> shrinkDelay d
-                                                          <*> pure lrp
+          shrinkCommand (Kill d)            = Kill <$> shrinkDelay d
+          shrinkCommand (Reconfigure d lrp) =   Skip d
+                                              : (Reconfigure <$> shrinkDelay d
+                                                             <*> pure lrp)
+          shrinkCommand (Skip _d)           = []
 
 
 -- | Multinode Hot Diffusion Simulator Script
@@ -883,6 +899,7 @@ data DiffusionSimulationTrace
   | TrUpdatingDNS
   | TrRunning
   | TrErrored SomeException
+  | TrSay String
   deriving (Show)
 
 -- Warning: be careful with writing properties that rely
@@ -912,6 +929,7 @@ data DiffusionTestTrace =
     | DiffusionFetchTrace (TraceFetchClientState BlockHeader)
     | DiffusionDebugTrace String
     | DiffusionDNSTrace DNSTrace
+    | DiffusionMuxTrace (Mux.WithBearer (ConnectionId NtNAddr) Mux.Trace)
     deriving (Show)
 
 
@@ -922,7 +940,7 @@ iosimTracer :: forall s a.
               , Typeable a
               )
             => Tracer (IOSim s) (WithTime (WithName NtNAddr a))
-iosimTracer = Tracer traceM <> sayTracer
+iosimTracer = Tracer traceM -- <> sayTracer
 
 -- | Run an arbitrary topology
 diffusionSimulation
@@ -961,8 +979,10 @@ diffusionSimulation
       $ \ntcSnocket _ -> do
         dnsMapVar <- fromLazyTVar <$> playTimedScript nullTracer dnsMapScript
         withAsyncAll
-          (map ((\(args, commands) -> runCommand Nothing ntnSnocket ntcSnocket dnsMapVar simArgs args connStateIdSupply commands))
-               nodeArgs)
+          (zipWith
+            (\(args, commands) i -> runCommand ntnSnocket ntcSnocket dnsMapVar simArgs args connStateIdSupply i Nothing commands)
+            nodeArgs
+            [1..])
           $ \nodes -> do
             (_, x) <- waitAny nodes
             return x
@@ -973,14 +993,7 @@ diffusionSimulation
 
     -- | Runs a single node according to a list of commands.
     runCommand
-      :: Maybe ( Async m Void
-               , StrictTVar m [( HotValency
-                               , WarmValency
-                               , Map RelayAccessPoint (LocalRootConfig PeerTrustable)
-                               )])
-         -- ^ If the node is running and corresponding local root configuration
-         -- TVar.
-      -> Snocket m (FD m NtNAddr) NtNAddr
+      :: Snocket m (FD m NtNAddr) NtNAddr
         -- ^ Node to node Snocket
       -> Snocket m (FD m NtCAddr) NtCAddr
         -- ^ Node to client Snocket
@@ -989,45 +1002,60 @@ diffusionSimulation
       -> SimArgs -- ^ Simulation arguments needed in order to run a simulation
       -> NodeArgs -- ^ Simulation arguments needed in order to run a single node
       -> CM.ConnStateIdSupply m
+      -> Int
+      -> Maybe ( Async m Void
+               , StrictTVar m [( HotValency
+                               , WarmValency
+                               , Map RelayAccessPoint (LocalRootConfig PeerTrustable)
+                               )])
+         -- ^ If the node is running and corresponding local root configuration
+         -- TVar.
       -> [Command] -- ^ List of commands/actions to perform for a single node
       -> m Void
-    runCommand Nothing ntnSnocket ntcSnocket dnsMapVar sArgs nArgs connStateIdSupply [] = do
-      threadDelay 3600
-      traceWith (diffSimTracer (naAddr nArgs)) TrRunning
-      runCommand Nothing ntnSnocket ntcSnocket dnsMapVar sArgs nArgs connStateIdSupply []
-    runCommand (Just (_, _)) ntnSnocket ntcSnocket dMapVarMap sArgs nArgs connStateIdSupply [] = do
-      -- We shouldn't block this thread waiting
-      -- on the async since this will lead to a deadlock
-      -- as thread returns 'Void'.
-      threadDelay 3600
-      traceWith (diffSimTracer (naAddr nArgs)) TrRunning
-      runCommand Nothing ntnSnocket ntcSnocket dMapVarMap sArgs nArgs connStateIdSupply []
-    runCommand Nothing ntnSnocket ntcSnocket dnsMapVar sArgs nArgs connStateIdSupply
-               (JoinNetwork delay :cs) = do
-      threadDelay delay
-      traceWith (diffSimTracer (naAddr nArgs)) TrJoiningNetwork
-      lrpVar <- newTVarIO $ naLocalRootPeers nArgs
-      withAsync (runNode sArgs nArgs ntnSnocket ntcSnocket connStateIdSupply lrpVar dnsMapVar) $ \nodeAsync ->
-        runCommand (Just (nodeAsync, lrpVar)) ntnSnocket ntcSnocket dnsMapVar sArgs nArgs connStateIdSupply cs
-    runCommand _ _ _ _ _ _ _ (JoinNetwork _:_) =
-      error "runCommand: Impossible happened"
-    runCommand (Just (async_, _)) ntnSnocket ntcSnocket dMapVarMap sArgs nArgs connStateIdSupply
-               (Kill delay:cs) = do
-      threadDelay delay
-      traceWith (diffSimTracer (naAddr nArgs)) TrKillingNode
-      cancel async_
-      runCommand Nothing ntnSnocket ntcSnocket dMapVarMap sArgs nArgs connStateIdSupply cs
-    runCommand _ _ _ _ _ _ _ (Kill _:_) = do
-      error "runCommand: Impossible happened"
-    runCommand Nothing _ _ _ _ _ _ (Reconfigure _ _:_) =
-      error "runCommand: Impossible happened"
-    runCommand (Just (async_, lrpVar)) ntnSnocket ntcSnocket dMapVarMap sArgs nArgs connStateIdSupply
-               (Reconfigure delay newLrp:cs) = do
-      threadDelay delay
-      traceWith (diffSimTracer (naAddr nArgs)) TrReconfiguringNode
-      _ <- atomically $ writeTVar lrpVar newLrp
-      runCommand (Just (async_, lrpVar)) ntnSnocket ntcSnocket dMapVarMap sArgs nArgs connStateIdSupply
-                 cs
+    runCommand ntnSocket ntcSocket dnsMapVar sArgs nArgs@NodeArgs { naAddr }
+               connStateIdSupply i hostAndLRP cmds = do
+      traceWith (diffSimTracer naAddr) . TrSay $ "node-" <> show i
+      runCommand' hostAndLRP cmds
+      where
+        runCommand' Nothing [] = do
+          threadDelay 3600
+          traceWith (diffSimTracer naAddr) TrRunning
+          runCommand' Nothing []
+        runCommand' (Just (_, _)) [] = do
+          -- We shouldn't block this thread waiting
+          -- on the async since this will lead to a deadlock
+          -- as thread returns 'Void'.
+          threadDelay 3600
+          traceWith (diffSimTracer naAddr) TrRunning
+          runCommand' Nothing []
+        runCommand' Nothing
+                   (JoinNetwork delay :cs) = do
+          threadDelay delay
+          traceWith (diffSimTracer naAddr) TrJoiningNetwork
+          lrpVar <- newTVarIO $ naLocalRootPeers nArgs
+          withAsync (runNode sArgs nArgs ntnSocket ntcSocket connStateIdSupply lrpVar dnsMapVar i) $ \nodeAsync ->
+            runCommand' (Just (nodeAsync, lrpVar)) cs
+        runCommand' _ (JoinNetwork _:_) =
+          error "runCommand: Impossible happened"
+        runCommand' (Just (async_, _))
+                    (Kill delay:cs) = do
+          threadDelay delay
+          traceWith (diffSimTracer naAddr) TrKillingNode
+          cancel async_
+          runCommand' Nothing cs
+        runCommand' _ (Kill _:_) = do
+          error "runCommand: Impossible happened"
+        runCommand' Nothing (Reconfigure _ _:_) =
+          error "runCommand: Impossible happened"
+        runCommand' (Just (async_, lrpVar))
+                    (Reconfigure delay newLrp:cs) = do
+          threadDelay delay
+          traceWith (diffSimTracer naAddr) TrReconfiguringNode
+          _ <- atomically $ writeTVar lrpVar newLrp
+          runCommand' (Just (async_, lrpVar))
+                     cs
+        runCommand' _ (Skip _ : _) =
+          error "runCommand: Impossible happened"
 
     runNode :: SimArgs
             -> NodeArgs
@@ -1039,6 +1067,7 @@ diffusionSimulation
                              , Map RelayAccessPoint (LocalRootConfig PeerTrustable)
                              )]
             -> StrictTVar m MockDNSMap
+            -> Int
             -> m Void
     runNode SimArgs
             { saSlot                  = bgaSlotDuration
@@ -1058,12 +1087,13 @@ diffusionSimulation
             , naChainSyncExitOnBlockNo = chainSyncExitOnBlockNo
             , naChainSyncEarlyExit     = chainSyncEarlyExit
             , naPeerSharing            = peerSharing
+            , naDiffusionMode          = diffusionMode
             }
             ntnSnocket
             ntcSnocket
             connStateIdSupply
             lrpVar
-            dMapVar = do
+            dMapVar i = do
       chainSyncExitVar <- newTVarIO chainSyncExitOnBlockNo
       ledgerPeersVar <- initScript' ledgerPeers
       onlyOutboundConnectionsStateVar <- newTVarIO UntrustedState
@@ -1074,7 +1104,6 @@ diffusionSimulation
           (bgaRng, rng) = Random.split $ mkStdGen seed
           acceptedConnectionsLimit =
             AcceptedConnectionsLimit maxBound maxBound 0
-          diffusionMode = InitiatorAndResponderDiffusionMode
           readLocalRootPeers  = readTVar lrpVar
           readPublicRootPeers = return publicRoots
           readUseLedgerPeers  = return (UseLedgerPeers (After 0))
@@ -1218,7 +1247,7 @@ diffusionSimulation
               , Node.aExtraChurnArgs = cardanoChurnArgs
               }
 
-          tracers = mkTracers addr
+          tracers = mkTracers addr i
 
           requestPublicRootPeers' =
             requestPublicRootPeers (Diff.dtTracePublicRootPeersTracer tracers)
@@ -1286,60 +1315,70 @@ diffusionSimulation
     diffSimTracer ntnAddr = contramap DiffusionDiffusionSimulationTrace
                           . tracerWithName ntnAddr
                           . tracerWithTime
-                          $ nodeTracer
+                          $ nodeTracer <> sayTracer
 
     mkTracers
       :: NtNAddr
+      -> Int
       -> Diff.Tracers NtNAddr NtNVersion NtNVersionData
                       NtCAddr NtCVersion NtCVersionData
                       SomeException Cardano.ExtraState
                       Cardano.ExtraState PeerTrustable
                       (Cardano.ExtraPeers NtNAddr)
                       (Cardano.ExtraPeerSelectionSetsWithSizes NtNAddr) m
-    mkTracers ntnAddr =
+    mkTracers ntnAddr i =
+      let sayTracer' = Tracer \msg -> say $ "(node-" <> show i <> ")" <> show msg
+          -- toggle and uncomment interesting sayTracer' below
+          nodeTracer' = if True then nodeTracer <> sayTracer' else nodeTracer in
+
       Diff.nullTracers {
+          -- Diff.dtMuxTracer = contramap
+          --                      DiffusionMuxTrace
+          --                  . tracerWithName ntnAddr
+          --                  . tracerWithTime
+          --                  $ nodeTracer' -- <> sayTracer',
           Diff.dtTraceLocalRootPeersTracer       = contramap
                                                     DiffusionLocalRootPeerTrace
                                                  . tracerWithName ntnAddr
                                                  . tracerWithTime
-                                                 $ nodeTracer
+                                                 $ nodeTracer' -- <> sayTracer'
         , Diff.dtTracePublicRootPeersTracer      = contramap
                                                     DiffusionPublicRootPeerTrace
                                                  . tracerWithName ntnAddr
                                                  . tracerWithTime
-                                                 $ nodeTracer
+                                                 $ nodeTracer' -- <> sayTracer'
         , Diff.dtTraceLedgerPeersTracer          = contramap
                                                   DiffusionLedgerPeersTrace
                                                  . tracerWithName ntnAddr
                                                  . tracerWithTime
-                                                 $ nodeTracer
+                                                 $ nodeTracer' -- <> sayTracer'
         , Diff.dtTracePeerSelectionTracer          = contramap
                                                     DiffusionPeerSelectionTrace
                                                  . tracerWithName ntnAddr
                                                  . tracerWithTime
-                                                 $ nodeTracer
+                                                 $ nodeTracer' -- <> sayTracer'
         , Diff.dtDebugPeerSelectionInitiatorTracer = contramap
                                                     DiffusionDebugPeerSelectionTrace
                                                  . tracerWithName ntnAddr
                                                  . tracerWithTime
-                                                 $ nodeTracer
+                                                 $ nodeTracer' -- <> sayTracer'
         , Diff.dtDebugPeerSelectionInitiatorResponderTracer
             = contramap DiffusionDebugPeerSelectionTrace
             . tracerWithName ntnAddr
             . tracerWithTime
-            $ nodeTracer
+            $ nodeTracer' -- <> sayTracer'
         , Diff.dtTracePeerSelectionCounters        = nullTracer
         , Diff.dtTraceChurnCounters                = nullTracer
         , Diff.dtPeerSelectionActionsTracer        = contramap
                                                     DiffusionPeerSelectionActionsTrace
                                                  . tracerWithName ntnAddr
                                                  . tracerWithTime
-                                                 $ nodeTracer
+                                                 $ nodeTracer' -- <> sayTracer'
         , Diff.dtConnectionManagerTracer           = contramap
                                                     DiffusionConnectionManagerTrace
                                                  . tracerWithName ntnAddr
                                                  . tracerWithTime
-                                                 $ nodeTracer
+                                                 $ nodeTracer' -- <> sayTracer'
         , Diff.dtConnectionManagerTransitionTracer = contramap
                                                      DiffusionConnectionManagerTransitionTrace
                                                  . tracerWithName ntnAddr
@@ -1347,29 +1386,29 @@ diffusionSimulation
           -- note: we have two ways getting transition trace:
           -- * through `traceTVar` installed in `newMutableConnState`
           -- * the `dtConnectionManagerTransitionTracer`
-                                                     $ nodeTracer
+                                                     $ nodeTracer' -- <> sayTracer'
         , Diff.dtServerTracer                      = contramap
                                                      DiffusionServerTrace
                                                  . tracerWithName ntnAddr
                                                  . tracerWithTime
-                                                 $ nodeTracer
+                                                 $ nodeTracer' -- <> sayTracer'
         , Diff.dtInboundGovernorTracer             = contramap
                                                      DiffusionInboundGovernorTrace
                                                  . tracerWithName ntnAddr
                                                  . tracerWithTime
-                                                 $ nodeTracer
+                                                 $ nodeTracer' -- <> sayTracer'
         , Diff.dtInboundGovernorTransitionTracer   = contramap
                                                      DiffusionInboundGovernorTransitionTrace
                                                  . tracerWithName ntnAddr
                                                  . tracerWithTime
-                                                 $ nodeTracer
+                                                 $ nodeTracer' -- <> sayTracer'
         , Diff.dtLocalConnectionManagerTracer      = nullTracer
         , Diff.dtLocalServerTracer                 = nullTracer
         , Diff.dtLocalInboundGovernorTracer        = nullTracer
         , Diff.dtDnsTracer                         = contramap DiffusionDNSTrace
                                                      . tracerWithName ntnAddr
                                                      . tracerWithTime
-                                                     $ nodeTracer
+                                                     $ nodeTracer' -- <> sayTracer'
       }
 
 
diff --git a/ouroboros-network/testlib/Test/Ouroboros/Network/Mux.hs b/ouroboros-network/testlib/Test/Ouroboros/Network/Mux.hs
index 002b11bf003..9b13a2c41ee 100644
--- a/ouroboros-network/testlib/Test/Ouroboros/Network/Mux.hs
+++ b/ouroboros-network/testlib/Test/Ouroboros/Network/Mux.hs
@@ -153,14 +153,12 @@ demo chain0 updates delay = do
 
     clientBearer <- Mx.getBearer Mx.makeQueueChannelBearer
                       (-1)
-                      activeTracer
                       Mx.QueueChannel { Mx.writeQueue = client_w,
                                         Mx.readQueue = client_r
                                       }
                        Nothing
     serverBearer <- Mx.getBearer Mx.makeQueueChannelBearer
                        (-1)
-                       activeTracer
                        Mx.QueueChannel { Mx.writeQueue = server_w,
                                          Mx.readQueue = server_r
                                        }
@@ -186,7 +184,7 @@ demo chain0 updates delay = do
               InitiatorProtocolOnly initiator ->
                 [(Mx.InitiatorDirectionOnly, void . runMiniProtocolCb initiator initCtx)]
         ]
-      withAsync (Mx.run nullTracer clientMux clientBearer) $ \aid -> do
+      withAsync (Mx.run (Mx.Tracers activeTracer activeTracer activeTracer) clientMux clientBearer) $ \aid -> do
         _ <- atomically $ runFirstToFinish $ foldMap FirstToFinish resOps
         Mx.stop clientMux
         wait aid
@@ -211,7 +209,7 @@ demo chain0 updates delay = do
               ResponderProtocolOnly responder ->
                 [(Mx.ResponderDirectionOnly, void . runMiniProtocolCb responder respCtx)]
         ]
-      withAsync (Mx.run nullTracer serverMux serverBearer) $ \aid -> do
+      withAsync (Mx.run (Mx.Tracers activeTracer activeTracer activeTracer) serverMux serverBearer) $ \aid -> do
         _ <- atomically $ runFirstToFinish $ foldMap FirstToFinish resOps
         Mx.stop serverMux
         wait aid