Merge pull request #5872 from IntersectMBO/bench-8.11.0

[PERFORMANCE FIX] rollback two additional metrics
IntersectMBO · Jun 6, 2024 · ebc3ae3 · ebc3ae3
2 parents b4826bf + 9495329
commit ebc3ae3
Show file tree

Hide file tree

Showing 2 changed files with 66 additions and 47 deletions.
diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs
@@ -1151,21 +1151,16 @@ instance LogFormatting TraceStartLeadershipCheckPlus where
                 , "utxoSize" .= Number (fromIntegral tsUtxoSize)
                 , "delegMapSize" .= Number (fromIntegral tsDelegMapSize)
                 , "chainDensity" .= Number (fromRational (toRational tsChainDensity))
-                , "dRepCount"    .= Number (fromIntegral tsDRepCount)
-                , "dRepMapSize"  .= Number (fromIntegral tsDRepMapSize)
                 ]
   forHuman TraceStartLeadershipCheckPlus {..} =
       "Checking for leadership in slot " <> showT (unSlotNo tsSlotNo)
       <> " utxoSize "     <> showT tsUtxoSize
       <> " delegMapSize " <> showT tsDelegMapSize
       <> " chainDensity " <> showT tsChainDensity
-      <> " dRepCount "    <> showT tsDRepCount
-      <> " dRepMapSize "  <> showT tsDRepMapSize
   asMetrics TraceStartLeadershipCheckPlus {..} =
     [IntM "Forge.UtxoSize"     (fromIntegral tsUtxoSize),
-     IntM "Forge.DelegMapSize" (fromIntegral tsDelegMapSize),
-     IntM "Forge.DRepCount"    (fromIntegral tsDRepCount),
-     IntM "Forge.DRepMapSize"  (fromIntegral tsDRepMapSize)]
+     IntM "Forge.DelegMapSize" (fromIntegral tsDelegMapSize)]
+
 
 --------------------------------------------------------------------------------
 -- ForgeEvent Tracer

diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/StartLeadershipCheck.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/StartLeadershipCheck.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -13,23 +12,29 @@ module Cardano.Node.Tracing.Tracers.StartLeadershipCheck
   ) where
 
 
-import           Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import           Cardano.Logging
-import           Cardano.Node.Queries (LedgerQueries (..), NodeKernelData (..))
-import           Cardano.Slotting.Slot (fromWithOrigin)
+
+import           Control.Concurrent.STM (atomically)
+import           Data.IORef (readIORef)
+import           Data.Word (Word64)
+
+import qualified Ouroboros.Network.AnchoredFragment as AF
+import           Ouroboros.Network.Block (BlockNo (..), blockNo, unBlockNo)
+import           Ouroboros.Network.NodeToClient (LocalConnectionId)
+import           Ouroboros.Network.NodeToNode (RemoteAddress)
+
 import           Ouroboros.Consensus.Block (SlotNo (..))
 import           Ouroboros.Consensus.HardFork.Combinator
 import           Ouroboros.Consensus.Ledger.Abstract (IsLedger)
-import           Ouroboros.Consensus.Ledger.Extended (ledgerState)
+import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState, ledgerState)
 import           Ouroboros.Consensus.Node (NodeKernel (..))
 import           Ouroboros.Consensus.Node.Tracers
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
-import qualified Ouroboros.Network.AnchoredFragment as AF
-import           Ouroboros.Network.Block (BlockNo (..), blockNo, unBlockNo)
 
-import           Control.Concurrent.STM (atomically)
-import           Data.IORef (readIORef)
-import           Data.Word (Word64)
+import           Cardano.Node.Queries (LedgerQueries (..), NodeKernelData (..))
+import           Cardano.Slotting.Slot (fromWithOrigin)
+
+import           Cardano.Ledger.BaseTypes (StrictMaybe (..))
 
 
 type ForgeTracerType blk = Either (TraceForgeEvent blk)
@@ -40,8 +45,6 @@ data TraceStartLeadershipCheckPlus =
         tsSlotNo       :: SlotNo
       , tsUtxoSize     :: Int
       , tsDelegMapSize :: Int
-      , tsDRepCount    :: Int
-      , tsDRepMapSize  :: Int
       , tsChainDensity :: Double
     }
 
@@ -55,41 +58,47 @@ forgeTracerTransform ::
   => NodeKernelData blk
   -> Trace IO (ForgeTracerType blk)
   -> IO (Trace IO (ForgeTracerType blk))
-forgeTracerTransform (NodeKernelData ref) (Trace tr) =
-  let secondM f (x, y) = do -- avoiding new dep on extra pkg
-        y' <- f y
-        pure (x, y')
-  in contramapM (Trace tr) $ secondM
-      \case
-          Right (Left slc@(TraceStartLeadershipCheck tsSlotNo)) -> do
-            query <- readIORef ref >>= traverse
-                        \NodeKernel{getChainDB} -> do
-                               ledger <- fmap ledgerState . atomically $
-                                           ChainDB.getCurrentLedger getChainDB
-                               chain  <- atomically $ ChainDB.getCurrentChain getChainDB
-                               pure TraceStartLeadershipCheckPlus {
-                                   tsSlotNo
-                                 , tsUtxoSize     = ledgerUtxoSize       ledger
-                                 , tsDelegMapSize = ledgerDelegMapSize   ledger
-                                 , tsDRepCount    = ledgerDRepCount      ledger
-                                 , tsDRepMapSize  = ledgerDRepMapSize    ledger
-                                 , tsChainDensity = fragmentChainDensity chain }
-            pure . Right $ case query of
-              SNothing    -> Left slc
-              SJust tslcp -> Right tslcp
-          Right a ->
-              pure $ Right a
-          Left control ->
-              pure $ Left control
+forgeTracerTransform nodeKern (Trace tr) =
+    contramapM (Trace tr)
+      (\case
+          (lc, Right (Left slc@(TraceStartLeadershipCheck slotNo))) -> do
+            query <- mapNodeKernelDataIO
+                        (\nk ->
+                          (,,)
+                            <$> nkQueryLedger (ledgerUtxoSize . ledgerState) nk
+                            <*> nkQueryLedger (ledgerDelegMapSize . ledgerState) nk
+                            <*> nkQueryChain fragmentChainDensity nk)
+                        nodeKern
+            case query of
+              SNothing -> pure (lc, Right (Left slc))
+              SJust (utxoSize, delegMapSize, chainDensity) ->
+                    let msg = TraceStartLeadershipCheckPlus
+                                slotNo
+                                utxoSize
+                                delegMapSize
+                                (fromRational chainDensity)
+                    in pure (lc, Right (Right msg))
+          (lc, Right a) ->
+              pure (lc, Right a)
+          (lc, Left control) ->
+              pure (lc, Left control))
+
+nkQueryLedger ::
+     IsLedger (LedgerState blk)
+  => (ExtLedgerState blk -> a)
+  -> NodeKernel IO RemoteAddress LocalConnectionId blk
+  -> IO a
+nkQueryLedger f NodeKernel{getChainDB} =
+  f <$> atomically (ChainDB.getCurrentLedger getChainDB)
 
 fragmentChainDensity ::
 #if __GLASGOW_HASKELL__ >= 906
   (AF.HasHeader blk, AF.HasHeader (Header blk))
 #else
   AF.HasHeader (Header blk)
 #endif
-  => AF.AnchoredFragment (Header blk) -> Double
-fragmentChainDensity frag = fromRational $ calcDensity blockD slotD
+  => AF.AnchoredFragment (Header blk) -> Rational
+fragmentChainDensity frag = calcDensity blockD slotD
   where
     calcDensity :: Word64 -> Word64 -> Rational
     calcDensity bl sl
@@ -110,3 +119,18 @@ fragmentChainDensity frag = fromRational $ calcDensity blockD slotD
       -- don't let it contribute to the number of blocks
       Right 0 -> 1
       Right b -> b
+
+nkQueryChain ::
+     (AF.AnchoredFragment (Header blk) -> a)
+  -> NodeKernel IO RemoteAddress LocalConnectionId blk
+  -> IO a
+nkQueryChain f NodeKernel{getChainDB} =
+  f <$> atomically (ChainDB.getCurrentChain getChainDB)
+
+
+mapNodeKernelDataIO ::
+  (NodeKernel IO RemoteAddress LocalConnectionId blk -> IO a)
+  -> NodeKernelData blk
+  -> IO (StrictMaybe a)
+mapNodeKernelDataIO f (NodeKernelData ref) =
+  readIORef ref >>= traverse f