consensus: add the DoneAddingBlock tracer event

This addresses issue #3382 -- at least initially. The timestamp in this event
is the nub of that issue, under normal circumstances.

ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs

@@ -247,7 +247,7 @@ addBlockSync
   => ChainDbEnv m blk
   -> BlockToAdd m blk
   -> m ()
-addBlockSync cdb@CDB {..} BlockToAdd { blockToAdd = b, .. } = do
+addBlockSync cdb@CDB {..} blkToAdd = do
     (isMember, invalid, curChain) <- atomically $ (,,)
       <$> VolatileDB.getIsMember          cdbVolatileDB
       <*> (forgetFingerprint <$> readTVar cdbInvalid)
@@ -294,8 +294,17 @@ addBlockSync cdb@CDB {..} BlockToAdd { blockToAdd = b, .. } = do
         void $ chainSelectionForFutureBlocks cdb blockCache
         chainSelectionForBlock cdb blockCache hdr
 
+    trace $ DoneAddingBlock (blockRealPoint b) whenItWasEnqueued newTip
+
     deliverProcessed newTip
   where
+    BlockToAdd {
+        blockToAdd            = b
+      , varBlockWrittenToDisk
+      , varBlockProcessed
+      , whenItWasEnqueued
+      } = blkToAdd
+
     trace :: TraceAddBlockEvent blk -> m ()
     trace = traceWith (contramap TraceAddBlockEvent cdbTracer)
 

ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs

@@ -435,6 +435,7 @@ data BlockToAdd m blk = BlockToAdd
     -- ^ Used for the 'blockWrittenToDisk' field of 'AddBlockPromise'.
   , varBlockProcessed     :: !(StrictTMVar m (Point blk))
     -- ^ Used for the 'blockProcessed' field of 'AddBlockPromise'.
+  , whenItWasEnqueued     :: !Time
   }
 
 -- | Create a new 'BlocksToAdd' with the given size.
@@ -452,10 +453,12 @@ addBlockToAdd
 addBlockToAdd tracer (BlocksToAdd queue) blk = do
     varBlockWrittenToDisk <- newEmptyTMVarIO
     varBlockProcessed     <- newEmptyTMVarIO
+    whenItWasEnqueued     <- getMonotonicTime
     let !toAdd = BlockToAdd
           { blockToAdd = blk
           , varBlockWrittenToDisk
           , varBlockProcessed
+          , whenItWasEnqueued
           }
     queueSize <- atomically $ do
       writeTBQueue  queue toAdd
@@ -614,6 +617,24 @@ data TraceAddBlockEvent blk =
     -- This is done for all blocks from the future each time a new block is
     -- added.
   | ChainSelectionForFutureBlock (RealPoint blk)
+
+    -- | The ChainDB has finished processing an instruction to add this block.
+    -- The time argument is when the instruction was added to the
+    -- 'cdbBlocksToAdd' queue. The second point argument is the possibly-new
+    -- ChainDB tip that resulted from this block having been added.
+    --
+    -- If the block was relevant, valid, new, and so on, then this instruction
+    -- incurred a corresponding chain selection that finished immediately prior
+    -- to this event firing. If the block is from the future (see
+    -- 'BlockInTheFuture'), then that particular chain selection invocation was
+    -- partially truncated and this block will be reconsidered again by some
+    -- later chain selection. This event will /not/ fire again for such deferred
+    -- chain selections (see 'ChainSelectionForFutureBlock', which notably does
+    -- not have the 'Time' field) -- this event only fires once per add-block
+    -- instruction. There may be zero (eg invalid block), one (eg usual case),
+    -- or many (eg future block) chain selections per instruction.
+  | DoneAddingBlock (RealPoint blk) Time (Point blk)
+
   deriving (Generic)
 
 deriving instance