[CAD-402] Adding changes to the trace events we need and removing time from them

ouroboros-consensus/src/Ouroboros/Consensus/Mempool/API.hs

@@ -305,25 +305,19 @@ data TraceEventMempool blk
       -- ^ New, valid transaction were added to the Mempool.
       !MempoolSize
       -- ^ The current size of the Mempool.
-      !Time
-      -- ^ The time at which the transactions were added.
   | TraceMempoolRejectedTxs
       ![(GenTx blk, ApplyTxErr blk)]
       -- ^ New, invalid transaction were rejected and thus not added to the
       -- Mempool.
       !MempoolSize
       -- ^ The current size of the Mempool.
-      !Time
-      -- ^ The time at which the transactions were rejected.
   | TraceMempoolRemoveTxs
       ![GenTx blk]
       -- ^ Previously valid transactions that are no longer valid because of
       -- changes in the ledger state. These transactions have been removed
       -- from the Mempool.
       !MempoolSize
       -- ^ The current size of the Mempool.
-      !Time
-      -- ^ The time at which the transactions were removed.
   | TraceMempoolManuallyRemovedTxs
       ![GenTxId blk]
       -- ^ Transactions that have been manually removed from the Mempool.

ouroboros-consensus/src/Ouroboros/Consensus/Mempool/Impl.hs

@@ -285,13 +285,9 @@ implAddTxs mpEnv accum txs = assert (all txInvariant txs) $ do
 
     let ValidationResult { vrNewValid = accepted } = vr
 
-    -- We record the time at which the transactions were added to the mempool
-    -- so we can use it in our performance measurements.
-    time <- getMonotonicTime
-
-    traceBatch TraceMempoolRemoveTxs   mempoolSize (map fst removed) time
-    traceBatch TraceMempoolAddTxs      mempoolSize accepted          time
-    traceBatch TraceMempoolRejectedTxs mempoolSize rejected          time
+    traceBatch TraceMempoolRemoveTxs   mempoolSize (map fst removed)
+    traceBatch TraceMempoolAddTxs      mempoolSize accepted
+    traceBatch TraceMempoolRejectedTxs mempoolSize rejected
 
     case unvalidated of
       -- All of the provided transactions have been validated.
@@ -307,9 +303,9 @@ implAddTxs mpEnv accum txs = assert (all txInvariant txs) $ do
       , mpEnvCapacity = MempoolCapacityBytes mempoolCap
       } = mpEnv
 
-    traceBatch mkEv size batch time
+    traceBatch mkEv size batch
       | null batch = return ()
-      | otherwise  = traceWith mpEnvTracer (mkEv batch size time)
+      | otherwise  = traceWith mpEnvTracer (mkEv batch size)
 
     mkRes acc accepted rejected =
          [(tx, Just err) | (tx, err) <- rejected]
@@ -453,8 +449,7 @@ implWithSyncState mpEnv@MempoolEnv{mpEnvTracer, mpEnvStateVar} blockSlot f = do
       res         <- f snapshot
       return (map fst vrInvalid, mempoolSize, res)
     unless (null removed) $ do
-      time <- getMonotonicTime
-      traceWith mpEnvTracer $ TraceMempoolRemoveTxs removed mempoolSize time
+      traceWith mpEnvTracer $ TraceMempoolRemoveTxs removed mempoolSize
     return res
 
 implGetSnapshot :: IOLike m

ouroboros-consensus/src/Ouroboros/Consensus/Node/Tracers.hs

@@ -9,7 +9,6 @@ module Ouroboros.Consensus.Node.Tracers
   , TraceForgeEvent (..)
   ) where
 
-import           Control.Monad.Class.MonadTime (Time)
 import           Control.Tracer (Tracer, nullTracer, showTracing)
 
 import           Ouroboros.Network.Block (Point, SlotNo)
@@ -119,8 +118,8 @@ data TraceForgeEvent blk tx
   | TraceCouldNotForge SlotNo AnachronyFailure
 
   -- | We adopted the block we produced, we also trace the transactions
-  -- and the time the block with the transactions was adopted.
-  | TraceAdoptedBlock SlotNo blk [tx] Time
+  -- that were adopted.
+  | TraceAdoptedBlock SlotNo blk [tx]
 
   -- | We did not adopt the block we produced, but the block was valid. We
   -- must have adopted a block that another leader of the same slot produced

ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs

@@ -368,11 +368,7 @@ forkBlockProduction maxBlockBodySize IS{..} BlockProduction{..} =
           -- Check whether we adopted our block
           curTip <- atomically $ ChainDB.getTipPoint chainDB
           if curTip == blockPoint newBlock then do
-            -- We measure the time directly.
-            -- We could also measure it when collecting the trace events, but this
-            -- is much more precise.
-            time <- getMonotonicTime
-            trace $ TraceAdoptedBlock currentSlot newBlock txs time
+            trace $ TraceAdoptedBlock currentSlot newBlock txs
           else do
             isInvalid <- atomically $
               ($ blockHash newBlock) . forgetFingerprint <$>
@@ -392,6 +388,7 @@ forkBlockProduction maxBlockBodySize IS{..} BlockProduction{..} =
                 -- process.
                 removeTxs mempool (map txId txs)
   where
+    trace :: TraceForgeEvent blk (GenTx blk) -> m ()
     trace = traceWith (forgeTracer tracers)
 
     -- Return the point and block number of the most recent block in the

ouroboros-consensus/test-consensus/Test/Consensus/Mempool.hs

@@ -12,14 +12,12 @@ import           Control.Exception (assert)
 import           Control.Monad (foldM, forM, forM_, unless, void)
 import           Control.Monad.Except (Except, runExcept)
 import           Control.Monad.State (State, evalState, get, modify)
-import           Control.Monad.Class.MonadTime (Time (..))
 import           Data.List (find, foldl', isSuffixOf, nub, sort)
 import           Data.Map (Map)
 import qualified Data.Map as Map
 import           Data.Maybe (isJust, isNothing)
 import           Data.Set (Set)
 import qualified Data.Set as Set
-import           Data.Time.Clock (secondsToDiffTime)
 import           Data.Word (Word32)
 
 import           Test.QuickCheck
@@ -315,9 +313,9 @@ prop_Mempool_Capacity mcts = withTestMempool mctsTestSetup $
     sortTxsInTrace :: TraceEventMempool TestBlock
                    -> TraceEventMempool TestBlock
     sortTxsInTrace ev = case ev of
-      TraceMempoolAddTxs      txs mpSz time -> TraceMempoolAddTxs      (sort txs) mpSz time
-      TraceMempoolRemoveTxs   txs mpSz time -> TraceMempoolRemoveTxs   (sort txs) mpSz time
-      TraceMempoolRejectedTxs txs mpSz time -> TraceMempoolRejectedTxs (sort txs) mpSz time
+      TraceMempoolAddTxs      txs mpSz -> TraceMempoolAddTxs      (sort txs) mpSz
+      TraceMempoolRemoveTxs   txs mpSz -> TraceMempoolRemoveTxs   (sort txs) mpSz
+      TraceMempoolRejectedTxs txs mpSz -> TraceMempoolRejectedTxs (sort txs) mpSz
       TraceMempoolManuallyRemovedTxs txIds txs mpSz ->
         TraceMempoolManuallyRemovedTxs (sort txIds) (sort txs) mpSz
 
@@ -333,13 +331,13 @@ prop_Mempool_TraceValidTxs setup =
       return $ counterexample (ppTxs (txs setup)) $
         let addedTxs = maybe
               []
-              (\(TraceMempoolAddTxs txs _ _) -> txs)
+              (\(TraceMempoolAddTxs txs _) -> txs)
               (find isAddTxsEvent evs)
         in sort (validTxs setup)  === sort addedTxs
   where
     isAddTxsEvent :: TraceEventMempool blk -> Bool
-    isAddTxsEvent (TraceMempoolAddTxs _ _ _) = True
-    isAddTxsEvent _                          = False
+    isAddTxsEvent (TraceMempoolAddTxs _ _) = True
+    isAddTxsEvent _                        = False
 
 -- | Test that all invalid rejected transactions returned from 'addTxs' are
 -- appropriately represented in the trace of events.
@@ -353,13 +351,13 @@ prop_Mempool_TraceRejectedTxs setup =
       return $ counterexample (ppTxs (txs setup)) $
         let rejectedTxs = maybe
               []
-              (\(TraceMempoolRejectedTxs txsAndErrs _ _) -> map fst txsAndErrs)
+              (\(TraceMempoolRejectedTxs txsAndErrs _) -> map fst txsAndErrs)
               (find isRejectedTxsEvent evs)
         in sort (invalidTxs setup) === sort rejectedTxs
   where
     isRejectedTxsEvent :: TraceEventMempool blk -> Bool
-    isRejectedTxsEvent (TraceMempoolRejectedTxs _ _ _) = True
-    isRejectedTxsEvent _                               = False
+    isRejectedTxsEvent (TraceMempoolRejectedTxs _ _) = True
+    isRejectedTxsEvent _                             = False
 
 -- | Test that all transactions in the 'Mempool' that have become invalid
 -- because of an update to the ledger are appropriately represented in the
@@ -383,13 +381,13 @@ prop_Mempool_TraceRemovedTxs setup =
       return $ map (const (Right ())) errs === errs .&&.
         let removedTxs = maybe
               []
-              (\(TraceMempoolRemoveTxs txs _ _) -> txs)
+              (\(TraceMempoolRemoveTxs txs _) -> txs)
               (find isRemoveTxsEvent evs)
         in sort txsInMempool === sort removedTxs
   where
     isRemoveTxsEvent :: TraceEventMempool blk -> Bool
-    isRemoveTxsEvent (TraceMempoolRemoveTxs _ _ _) = True
-    isRemoveTxsEvent _                             = False
+    isRemoveTxsEvent (TraceMempoolRemoveTxs _ _) = True
+    isRemoveTxsEvent _                           = False
 
 {-------------------------------------------------------------------------------
   TestSetup: how to set up a TestMempool
@@ -823,13 +821,10 @@ mempoolCapTestExpectedTrace mcts =
         (chunk, txs') = splitTxsUntilCap txs mctsCapacity
 
     chunkExpectedTrace chunk =
-      [ TraceMempoolAddTxs    chunk (txsToMempoolSize chunk) nullTime
-      , TraceMempoolRemoveTxs chunk mempty                   nullTime
+      [ TraceMempoolAddTxs    chunk (txsToMempoolSize chunk)
+      , TraceMempoolRemoveTxs chunk mempty
       ]
 
-    nullTime :: Time
-    nullTime = Time $ secondsToDiffTime 0
-
 {-------------------------------------------------------------------------------
   MempoolCapTestEnv: environment for tests related to mempool capacity
 -------------------------------------------------------------------------------}
@@ -1089,7 +1084,7 @@ executeAction testMempool action = case action of
     AddTx tx -> do
       void $ addTxs [TestGenTx tx]
       expectTraceEvent $ \case
-        TraceMempoolAddTxs [TestGenTx tx'] _ _
+        TraceMempoolAddTxs [TestGenTx tx'] _
           | tx == tx'
           -> property True
         _ -> counterexample ("Transaction not added: " <> condense tx) False
@@ -1099,7 +1094,7 @@ executeAction testMempool action = case action of
       -- Synchronise the Mempool with the updated chain
       withSyncState TxsForUnknownBlock $ \_snapshot -> return ()
       expectTraceEvent $ \case
-        TraceMempoolRemoveTxs [TestGenTx tx'] _ _
+        TraceMempoolRemoveTxs [TestGenTx tx'] _
           | tx == tx'
           -> property True
         _ -> counterexample ("Transaction not removed: " <> condense tx) False