diff --git a/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs b/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs index b511206be0d..a346eb24d35 100644 --- a/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs +++ b/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