tx-submission: added counters

Author: coot

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

@@ -461,11 +461,12 @@ decisionLogicThread
        , Hashable peeraddr
        )
     => Tracer m (TraceTxLogic peeraddr txid tx)
+    -> Tracer m TxSubmissionCounters
     -> TxDecisionPolicy
     -> TxChannelsVar m peeraddr txid tx
     -> SharedTxStateVar m peeraddr txid tx
     -> m Void
-decisionLogicThread tracer policy txChannelsVar sharedStateVar = do
+decisionLogicThread tracer counterTracer policy txChannelsVar sharedStateVar = do
     labelThisThread "tx-decision"
     go
   where
@@ -493,6 +494,7 @@ decisionLogicThread tracer policy txChannelsVar sharedStateVar = do
         (Map.intersectionWith (,)
           txChannelMap
           decisions)
+      traceWith counterTracer (mkTxSubmissionCounters st)
       go
 
     -- Variant of modifyMVar_ that puts a default value if the MVar is empty.

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

@@ -26,13 +26,17 @@ module Ouroboros.Network.TxSubmission.Inbound.V2.Types
   , TxSubmissionMempoolWriter (..)
     -- ** Traces
   , TraceTxSubmissionInbound (..)
+  , TxSubmissionCounters (..)
+  , mkTxSubmissionCounters
     -- ** Protocol Error
   , TxSubmissionProtocolError (..)
   ) where
 
 import Control.Exception (Exception (..))
 import Control.Monad.Class.MonadTime.SI
 import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Monoid (Sum (..))
 import Data.Sequence.Strict (StrictSeq)
 import Data.Set (Set)
 import Data.Set qualified as Set
@@ -376,6 +380,43 @@ data TraceTxSubmissionInbound txid tx =
   deriving (Eq, Show)
 
 
+data TxSubmissionCounters =
+    TxSubmissionCounters {
+      numOfOutstandingTxIds         :: Int,
+      -- ^ txids which are not yet downloaded.  This is a diff of keys sets of
+      -- `referenceCounts` and a sum of `bufferedTxs` and
+      -- `inbubmissionToMempoolTxs` maps.
+      numOfBufferedTxs              :: Int,
+      -- ^ number of all buffered txs (downloaded or not available)
+      numOfInSubmissionToMempoolTxs :: Int,
+      -- ^ number of all tx's which were submitted to the mempool
+      numOfTxIdsInflight            :: Int
+      -- ^ number of all in-flight txid's.
+    }
+    deriving (Eq, Show)
+
+mkTxSubmissionCounters
+  :: Ord txid
+  => SharedTxState peeraddr txid tx
+  -> TxSubmissionCounters
+mkTxSubmissionCounters
+  SharedTxState {
+    inflightTxs,
+    bufferedTxs,
+    referenceCounts,
+    inSubmissionToMempoolTxs
+  }
+  =
+  TxSubmissionCounters {
+    numOfOutstandingTxIds         = Set.size $ Map.keysSet referenceCounts
+                                        Set.\\ Map.keysSet bufferedTxs
+                                        Set.\\ Map.keysSet inSubmissionToMempoolTxs,
+    numOfBufferedTxs              = Map.size bufferedTxs,
+    numOfInSubmissionToMempoolTxs = Map.size inSubmissionToMempoolTxs,
+    numOfTxIdsInflight            = getSum $ foldMap Sum inflightTxs
+  }
+
+
 data TxSubmissionProtocolError =
        ProtocolErrorTxNotRequested
      | ProtocolErrorTxIdsNotRequested

ouroboros-network/testlib/Test/Ouroboros/Network/Diffusion/Node.hs

@@ -128,6 +128,8 @@ import Test.Ouroboros.Network.PeerSelection.RootPeersDNS (DNSLookupDelay,
            DNSTimeout, DomainAccessPoint (..), MockDNSLookupResult,
            mockDNSActions)
 import Test.Ouroboros.Network.TxSubmission.Types (Tx)
+import Test.Ouroboros.Network.Utils
+
 
 
 data Interfaces extraAPI m = Interfaces
@@ -367,6 +369,7 @@ run blockGeneratorArgs limits ni na
 
                  withAsync (decisionLogicThread
                               tracerTxLogic
+                              sayTracer
                               (aTxDecisionPolicy na)
                               (nkTxChannelsVar nodeKernel)
                               (nkSharedTxStateVar nodeKernel)) $ \decLogicThread ->

ouroboros-network/testlib/Test/Ouroboros/Network/TxSubmission/AppV2.hs

@@ -190,7 +190,8 @@ runTxSubmission tracer tracerTxLogic state txDecisionPolicy = do
         -> m b
     run st txChannelsVar txMempoolSem sharedTxStateVar
         inboundMempool k =
-      withAsync (decisionLogicThread tracerTxLogic txDecisionPolicy txChannelsVar sharedTxStateVar) $ \a -> do
+      withAsync (decisionLogicThread tracerTxLogic sayTracer
+                                     txDecisionPolicy txChannelsVar sharedTxStateVar) $ \a -> do
             -- Construct txSubmission outbound client
         let clients = (\(addr, (mempool, ctrlMsgSTM, outDelay, _, outChannel, _)) -> do
                         let client = txSubmissionOutbound (Tracer $ say . show)