tx-submission-inbound: improved logging

ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs

@@ -33,7 +33,7 @@ import           Control.Monad.Class.MonadSTM.Strict (checkInvariant)
 import           Control.Monad.Class.MonadThrow
 import           Control.Tracer (Tracer, traceWith)
 
-import           Network.TypedProtocol.Pipelined (N, Nat (..))
+import           Network.TypedProtocol.Pipelined (N, Nat (..), natToInt)
 
 import           Ouroboros.Network.NodeToNode.Version (NodeToNodeVersion)
 import           Ouroboros.Network.Protocol.TxSubmission.Server
@@ -66,7 +66,9 @@ data TxSubmissionMempoolWriter txid tx idx m =
 -- TODO: extend tracing issue #2615
 data TraceTxSubmissionInbound txid tx
     -- | Server received 'MsgDone'
-    = ClientTerminated
+    = TxInboundTerminated
+    | TxInboundCanRequestMoreTxs Int
+    | TxInboundCannotRequestMoreTxs Int
   deriving Show
 
 data TxSubmissionProtocolError =
@@ -187,13 +189,16 @@ txSubmissionInbound tracer maxUnacked mpReader mpWriter _version =
                   Nat n
                -> StatefulM (ServerState txid tx) n txid tx m
     serverIdle n = StatefulM $ \st -> case n of
-        Zero -> if canRequestMoreTxs st
-          then
+        Zero -> do
+          if canRequestMoreTxs st
+          then do
             -- There are no replies in flight, but we do know some more txs we
             -- can ask for, so lets ask for them and more txids.
+            traceWith tracer (TxInboundCanRequestMoreTxs (natToInt n))
             pure $ continueWithState (serverReqTxs Zero) st
 
           else do
+            traceWith tracer (TxInboundCannotRequestMoreTxs (natToInt n))
             -- There's no replies in flight, and we have no more txs we can
             -- ask for so the only remaining thing to do is to ask for more
             -- txids. Since this is the only thing to do now, we make this a
@@ -208,7 +213,7 @@ txSubmissionInbound tracer maxUnacked mpReader mpWriter _version =
                 (numTxsToAcknowledge st)
                 numTxIdsToRequest
                 -- Our result if the client terminates the protocol
-                (traceWith tracer ClientTerminated)
+                (traceWith tracer TxInboundTerminated)
                 ( collectAndContinueWithState (handleReply Zero) st {
                     numTxsToAcknowledge    = 0,
                     requestedTxIdsInFlight = numTxIdsToRequest
@@ -217,7 +222,7 @@ txSubmissionInbound tracer maxUnacked mpReader mpWriter _version =
                 . NonEmpty.toList)
 
         Succ n' -> if canRequestMoreTxs st
-          then
+          then do
             -- We have replies in flight and we should eagerly collect them if
             -- available, but there are transactions to request too so we
             -- should not block waiting for replies.
@@ -230,11 +235,13 @@ txSubmissionInbound tracer maxUnacked mpReader mpWriter _version =
             -- have no txs to ask for, since (with no other guard) this will
             -- put us into a busy-polling loop.
             --
+            traceWith tracer (TxInboundCanRequestMoreTxs (natToInt n))
             pure $ CollectPipelined
               (Just (continueWithState (serverReqTxs (Succ n')) st))
               (collectAndContinueWithState (handleReply n') st)
 
-          else
+          else do
+            traceWith tracer (TxInboundCannotRequestMoreTxs (natToInt n))
             -- In this case there is nothing else to do so we block until we
             -- collect a reply.
             pure $ CollectPipelined