WIP with debug tracing

IntersectMBO · Jul 31, 2024 · 83bb788 · 83bb788
1 parent 21adba3
commit 83bb788
Show file tree

Hide file tree

Showing 3 changed files with 78 additions and 39 deletions.
diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/TxSubmission/Common.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/TxSubmission/Common.hs
@@ -303,6 +303,9 @@ verboseTracer :: forall a m.
                => Tracer m a
 verboseTracer = threadAndTimeTracer $ showTracing $ Tracer say
 
+debugTracer :: forall a s. Show a => Tracer (IOSim s) a
+debugTracer = threadAndTimeTracer $ showTracing $ Tracer (traceM . show)
+
 threadAndTimeTracer :: forall a m.
                        ( MonadAsync m
                        , MonadDelay m

diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/TxSubmission/TxSubmissionV2.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/TxSubmission/TxSubmissionV2.hs
@@ -51,7 +51,7 @@ import Ouroboros.Network.TxSubmission.Inbound.Policy
 import Ouroboros.Network.TxSubmission.Outbound
 import Ouroboros.Network.Util.ShowProxy
 
-import Ouroboros.Network.Testing.Utils
+import Ouroboros.Network.Testing.Utils hiding (debugTracer)
 
 import Test.QuickCheck
 import Test.Tasty (TestTree, testGroup)
@@ -73,6 +73,7 @@ import Test.Ouroboros.Network.TxSubmission.Common hiding (tests)
 tests :: TestTree
 tests = testGroup "Ouroboros.Network.TxSubmission.TxSubmissionV2"
   [ testProperty "txSubmission" prop_txSubmission
+  , testProperty "x" prop_x
   ]
 
 data TxSubmissionV2State =
@@ -320,7 +321,9 @@ prop_txSubmission (TxSubmissionV2State state txDecisionPolicy) =
             threadDelay (simDelayTime + 100)
             atomically (traverse_ (`writeTVar` Terminate) controlMessageVars)
 
-      txSubmissionSimulation verboseTracer verboseTracer state'' txDecisionPolicy
+      let tracer = verboseTracer <> debugTracer
+          tracer' = verboseTracer <> debugTracer
+      txSubmissionSimulation tracer tracer' state'' txDecisionPolicy
 
 checkMempools :: (Eq a, Show a) => [a] -> [a] -> Property
 checkMempools [] [] = property True
@@ -332,6 +335,10 @@ checkMempools inp@(i : is) outp@(o : os) =
            else counterexample (show inp ++ " " ++ show outp)
               $ checkMempools is outp
 
+prop_x :: Property
+prop_x = prop_txSubmission
+  TxSubmissionV2State {peerMap = Map.fromList [(4,([Tx {getTxId = 0, getTxSize = SizeInBytes 34236, getTxValid = True},Tx {getTxId = 1, getTxSize = SizeInBytes 3153, getTxValid = True},Tx {getTxId = 4, getTxSize = SizeInBytes 65033, getTxValid = True},Tx {getTxId = 2, getTxSize = SizeInBytes 42190, getTxValid = True},Tx {getTxId = -3, getTxSize = SizeInBytes 44515, getTxValid = False},Tx {getTxId = -6, getTxSize = SizeInBytes 45992, getTxValid = True},Tx {getTxId = 3, getTxSize = SizeInBytes 2243, getTxValid = True},Tx {getTxId = -4, getTxSize = SizeInBytes 8535, getTxValid = False}],Just (Positive {getPositive = SmallDelay {getSmallDelay = 1.166666666666}}),Just (Positive {getPositive = SmallDelay {getSmallDelay = 1.888888888888}})))], decisionPolicy = TxDecisionPolicy {maxNumTxIdsToRequest = NumTxIdsToReq 2, maxUnacknowledgedTxIds = NumTxIdsToReq 2, txsSizeInflightPerPeer = SizeInBytes 1, maxTxsSizeInflight = SizeInBytes 1, txInflightMultiplicity = 1}}
+
 -- | Split a list into sub list of at most `n` elements.
 --
 divvy :: Int -> [a] -> [[a]]

diff --git a/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound/Decision.hs b/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound/Decision.hs
@@ -8,6 +8,7 @@
 
 module Ouroboros.Network.TxSubmission.Inbound.Decision
   ( TxDecision (..)
+  , emptyTxDecision
     -- * Internal API exposed for testing
   , makeDecisions
   , filterActivePeers
@@ -91,6 +92,14 @@ instance Ord txid => Semigroup (TxDecision txid tx) where
                    txdTxsToMempool       = txdTxsToMempool ++ txdTxsToMempool'
                  }
 
+emptyTxDecision :: TxDecision txid tx
+emptyTxDecision = TxDecision {
+    txdTxIdsToAcknowledge = 0,
+    txdTxIdsToRequest     = 0,
+    txdPipelineTxIds      = False,
+    txdTxsToRequest       = Set.empty,
+    txdTxsToMempool       = []
+  }
 
 data SharedDecisionContext peeraddr txid tx = SharedDecisionContext {
     -- TODO: check how to access it.
@@ -172,7 +181,7 @@ data St peeraddr txid tx =
         -- ^ size of all `tx`s in-flight.
 
         stInflight     :: !(Map txid Int),
-        -- ^ `txid`s in-flight.
+      -- ^ `txid`s in-flight.
 
         stAcknowledged :: !(Map txid Int)
         -- ^ acknowledged `txid` with multiplicities.  It is used to update
@@ -257,19 +266,27 @@ pickTxsToDownload policy@TxDecisionPolicy { txsSizeInflightPerPeer,
 
                  stAcknowledged' = Map.unionWith (+) stAcknowledged txIdsToAck
              in
-             ( st { stAcknowledged = stAcknowledged' }
-             , ( (peeraddr, peerTxState')
-               , TxDecision { txdTxIdsToAcknowledge = numTxIdsToAck,
-                              txdTxIdsToRequest     = numTxIdsToReq,
-                              txdPipelineTxIds      = not
-                                                    . StrictSeq.null
-                                                    . unacknowledgedTxIds
-                                                    $ peerTxState',
-                              txdTxsToRequest       = Set.empty,
-                              txdTxsToMempool       = txsToMempool
-                            }
-               )
-             )
+             if requestedTxIdsInflight peerTxState > 0
+               then
+                 ( st { stAcknowledged = stAcknowledged' }
+                 , ( (peeraddr, peerTxState')
+                     , TxDecision { txdTxIdsToAcknowledge = numTxIdsToAck,
+                                    txdTxIdsToRequest     = numTxIdsToReq,
+                                    txdPipelineTxIds      = not
+                                                          . StrictSeq.null
+                                                          . unacknowledgedTxIds
+                                                          $ peerTxState',
+                                    txdTxsToRequest       = Set.empty,
+                                    txdTxsToMempool       = txsToMempool
+                                  }
+                     )
+                 )
+               else
+                 ( st
+                 , ( (peeraddr, peerTxState)
+                   , emptyTxDecision
+                   )
+                 )
         else
           let requestedTxsInflightSize' :: SizeInBytes
               txsToRequest :: Set txid
@@ -336,23 +353,32 @@ pickTxsToDownload policy@TxDecisionPolicy { txsSizeInflightPerPeer,
 
               stInflight' :: Map txid Int
               stInflight' = Map.unionWith (+) stInflightDelta stInflight
-
-
-          in ( St { stInflight     = stInflight',
-                    stInflightSize = sizeInflightOther + requestedTxsInflightSize',
-                    stAcknowledged = stAcknowledged' }
-             , ( (peeraddr, peerTxState'')
-               , TxDecision { txdTxIdsToAcknowledge = numTxIdsToAck,
-                              txdPipelineTxIds      = not
-                                                    . StrictSeq.null
-                                                    . unacknowledgedTxIds
-                                                    $ peerTxState'',
-                              txdTxIdsToRequest     = numTxIdsToReq,
-                              txdTxsToRequest       = txsToRequest,
-                              txdTxsToMempool       = txsToMempool
-                            }
-               )
-             )
+          in
+            if requestedTxIdsInflight peerTxState > 0
+              then
+                ( St { stInflight     = stInflight',
+                       stInflightSize = sizeInflightOther + requestedTxsInflightSize',
+                       stAcknowledged = stAcknowledged' }
+                , ( (peeraddr, peerTxState'')
+                  , TxDecision { txdTxIdsToAcknowledge = numTxIdsToAck,
+                                 txdPipelineTxIds      = not
+                                                       . StrictSeq.null
+                                                       . unacknowledgedTxIds
+                                                       $ peerTxState'',
+                                 txdTxIdsToRequest     = numTxIdsToReq,
+                                 txdTxsToRequest       = txsToRequest,
+                                 txdTxsToMempool       = txsToMempool
+                               }
+                  )
+                )
+              else
+                ( st { stInflight     = stInflight',
+                       stInflightSize = sizeInflightOther + requestedTxsInflightSize'
+                     }
+                , ( (peeraddr, peerTxState')
+                  , emptyTxDecision { txdTxsToRequest = txsToRequest }
+                  )
+                )
 
     gn :: ( St peeraddr txid tx
           , [((peeraddr, PeerTxState txid tx), TxDecision txid tx)]
@@ -362,8 +388,8 @@ pickTxsToDownload policy@TxDecisionPolicy { txsSizeInflightPerPeer,
           )
     gn
       ( St { stInflight,
-            stInflightSize,
-            stAcknowledged }
+             stInflightSize,
+             stAcknowledged }
       , as
       )
       =
@@ -435,8 +461,9 @@ filterActivePeers
     fn :: PeerTxState txid tx -> Bool
     fn ps@PeerTxState { unacknowledgedTxIds,
                         requestedTxIdsInflight } =
-           hasTxIdsToAcknowledge st ps
-        || requestedTxIdsInflight + numOfUnacked < maxUnacknowledgedTxIds
+        --    hasTxIdsToAcknowledge st ps ||
+           requestedTxIdsInflight == 0 -- document why it's not <= maxTxIdsInFlightPerPeer
+        && requestedTxIdsInflight + numOfUnacked < maxUnacknowledgedTxIds
       where
         numOfUnacked   = fromIntegral (StrictSeq.length unacknowledgedTxIds)
 
@@ -447,8 +474,10 @@ filterActivePeers
                         requestedTxsInflightSize,
                         availableTxIds,
                         unknownTxs } =
-           hasTxIdsToAcknowledge st ps
-        || requestedTxIdsInflight + numOfUnacked < maxUnacknowledgedTxIds
+        -- hasTxIdsToAcknowledge st ps ||
+           (    requestedTxIdsInflight == 0
+             && requestedTxIdsInflight + numOfUnacked < maxUnacknowledgedTxIds
+           )
         || (underSizeLimit && not (Map.null downloadable))
       where
         numOfUnacked   = fromIntegral (StrictSeq.length unacknowledgedTxIds)