Trace TraceTxSubmissionOutboundSendMsgReplyTxs events after txs are sent

Author: intricate

ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Direct.hs

@@ -53,7 +53,8 @@ directPipelined (TxSubmissionServerPipelined mserver)
     directSender q (SendMsgRequestTxsPipelined txids serverNext)
                    ClientStIdle{recvMsgRequestTxs} = do
       server' <- serverNext
-      SendMsgReplyTxs txs client' <- recvMsgRequestTxs txids
+      SendMsgReplyTxs txs onTxsSent client' <- recvMsgRequestTxs txids
+      _ <- onTxsSent txs
       directSender (enqueue (CollectTxs txids txs) q) server' client'
 
     directSender q (CollectPipelined (Just server') _) client =

ouroboros-network/protocol-tests/Ouroboros/Network/Protocol/TxSubmission/Examples.hs

@@ -141,7 +141,7 @@ txSubmissionClient tracer txId txSize maxUnacked =
           traceWith tracer (EventRecvMsgRequestTxs unackedSeq unackedMap
                                                    remainingTxs txids)
           case [ txid | txid <- txids, txid `Map.notMember` unackedMap ] of
-            [] -> pure (SendMsgReplyTxs txs client')
+            [] -> pure (SendMsgReplyTxs txs (const $ pure ()) client')
               where
                 txs         = map (unackedMap Map.!) txids
                 client'     = client unackedSeq unackedMap' remainingTxs

ouroboros-network/src/Ouroboros/Network/Protocol/TxSubmission/Client.hs

@@ -80,6 +80,7 @@ data ClientStTxIds blocking txid tx m a where
 
 data ClientStTxs txid tx m a where
   SendMsgReplyTxs   :: [tx]
+                    -> ([tx] -> m ())
                     -> ClientStIdle txid tx m a
                     -> ClientStTxs  txid tx m a
 
@@ -110,8 +111,7 @@ txSubmissionClientPeer (TxSubmissionClient client) =
                              (Done TokDone result)
 
         MsgRequestTxs txids -> Effect $ do
-          SendMsgReplyTxs txs k <- recvMsgRequestTxs txids
+          SendMsgReplyTxs txs onTxsSent k <- recvMsgRequestTxs txids
           return $ Yield (ClientAgency TokTxs)
                          (MsgReplyTxs txs)
-                         (go k)
-
+                         (Effect $ onTxsSent txs >> return (go k))

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

@@ -189,7 +189,7 @@ txSubmissionOutbound tracer maxUnacked TxSubmissionMempoolReader{..} =
               !unackedMap' = foldl' (flip Map.delete) unackedMap txids
               client'      = client unackedSeq unackedMap' lastIdx
 
-          -- Trace the transactions to be sent in the response.
-          traceWith tracer (TraceTxSubmissionOutboundSendMsgReplyTxs txs)
+              -- Trace the transactions to be sent in the response.
+              traceTxsSent = traceWith tracer . TraceTxSubmissionOutboundSendMsgReplyTxs
 
-          return $ SendMsgReplyTxs txs client'
+          return $ SendMsgReplyTxs txs traceTxsSent client'