fixup! Refactor Connection Handler

Author: crocodile-dentist

ouroboros-network-framework/src/Ouroboros/Network/ConnectionHandler.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns              #-}
+{-# LANGUAGE BlockArguments            #-}
 {-# LANGUAGE DataKinds                 #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts          #-}
@@ -362,28 +363,31 @@ makeConnectionHandler muxTracer forkPolicy
                           hVersionData    = agreedOptions
                         }
                   atomically $ writePromise (Right $ HandshakeConnectionResult handle (versionNumber, agreedOptions))
-                  withBuffer (\buffer -> do
-                      bearer <- mkMuxBearer sduTimeout socket buffer
-                      case inResponderMode of
-                        InResponderMode (inboundGovChannelTracer, connectionDataFlow)
-                          | Duplex <- connectionDataFlow agreedOptions ->
-                              -- Following this call, the muxer is racing with the CM,
-                              -- was was informed of a new remote via the promise.
-                              -- The IG tracer pauses the muxer main thread when it reaches mature state
-                              -- until the CM informs the former of new peer connection to ensure
-                              -- proper sequencing of events.
-                              Mx.run (Mx.WithBearer connectionId `contramap` (muxTracer <> inboundGovChannelTracer))
-                                     mux bearer
-                        _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. We should not pass
-                              -- the IG tracer to mux, and 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.
-                          Mx.run (Mx.WithBearer connectionId `contramap` muxTracer)
-                                 mux bearer
-                    )
+                  withBuffer \buffer -> do
+                    bearer <- mkMuxBearer sduTimeout socket buffer
+                    let muxTracer' = contramap (Mx.WithBearer connectionId)
+                          case inResponderMode of
+                            InResponderMode (inboundGovChannelTracer, connectionDataFlow)
+                              | Duplex <- connectionDataFlow agreedOptions ->
+                                  -- 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.
+                                  muxTracer <> inboundGovChannelTracer
+                            _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.
+                                  muxTracer
+                    Mx.run Mx.MuxTracerBundle {
+                             muxTracer     = muxTracer',
+                             channelTracer = Mx.WithBearer connectionId `contramap` muxTracer }
+                           mux bearer
 
               Right (HandshakeQueryResult vMap) -> do
                 atomically $ writePromise (Right HandshakeConnectionQuery)