Skip to content

Commit

Permalink
Merge pull request #5800 from IntersectMBO/nadia.chambers/start-leade…
Browse files Browse the repository at this point in the history 
…rship-001

start-leadership: trace drep count and map size
  • Loading branch information
@mgmeier
mgmeier committed Apr 29, 2024
2 parents e155f27 + 19944c9 commit 0a26384
Show file tree
Hide file tree
Showing 3 changed files with 89 additions and 68 deletions.
41 changes: 40 additions & 1 deletion cardano-node/src/Cardano/Node/Queries.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -231,10 +231,14 @@ instance All GetKESInfo xs => GetKESInfo (HardForkBlock xs) where
class LedgerQueries blk where
ledgerUtxoSize :: LedgerState blk -> Int
ledgerDelegMapSize :: LedgerState blk -> Int
ledgerDRepCount :: LedgerState blk -> Int
ledgerDRepMapSize :: LedgerState blk -> Int

instance LedgerQueries Byron.ByronBlock where
ledgerUtxoSize = Map.size . Byron.unUTxO . Byron.cvsUtxo . Byron.byronLedgerState
ledgerDelegMapSize _ = 0
ledgerDRepCount _ = 0
ledgerDRepMapSize _ = 0

instance LedgerQueries (Shelley.ShelleyBlock protocol era) where
ledgerUtxoSize =
Expand All @@ -253,11 +257,30 @@ instance LedgerQueries (Shelley.ShelleyBlock protocol era) where
. Shelley.esLState
. Shelley.nesEs
. Shelley.shelleyLedgerState
ledgerDRepCount =
Map.size
. Shelley.vsDReps
. Shelley.certVState
. Shelley.lsCertState
. Shelley.esLState
. Shelley.nesEs
. Shelley.shelleyLedgerState
ledgerDRepMapSize =
UM.size
. UM.DRepUView
. Shelley.dsUnified
. Shelley.certDState
. Shelley.lsCertState
. Shelley.esLState
. Shelley.nesEs
. Shelley.shelleyLedgerState

instance (LedgerQueries x, NoHardForks x)
=> LedgerQueries (HardForkBlock '[x]) where
ledgerUtxoSize = ledgerUtxoSize . project
ledgerUtxoSize = ledgerUtxoSize . project
ledgerDelegMapSize = ledgerDelegMapSize . project
ledgerDRepCount = ledgerDRepCount . project
ledgerDRepMapSize = ledgerDRepMapSize . project

instance LedgerQueries (Cardano.CardanoBlock c) where
ledgerUtxoSize = \case
Expand All @@ -276,6 +299,22 @@ instance LedgerQueries (Cardano.CardanoBlock c) where
Cardano.LedgerStateAlonzo ledgerAlonzo -> ledgerDelegMapSize ledgerAlonzo
Cardano.LedgerStateBabbage ledgerBabbage -> ledgerDelegMapSize ledgerBabbage
Cardano.LedgerStateConway ledgerConway -> ledgerDelegMapSize ledgerConway
ledgerDRepCount = \case
Cardano.LedgerStateByron ledgerByron -> ledgerDRepCount ledgerByron
Cardano.LedgerStateShelley ledgerShelley -> ledgerDRepCount ledgerShelley
Cardano.LedgerStateAllegra ledgerAllegra -> ledgerDRepCount ledgerAllegra
Cardano.LedgerStateMary ledgerMary -> ledgerDRepCount ledgerMary
Cardano.LedgerStateAlonzo ledgerAlonzo -> ledgerDRepCount ledgerAlonzo
Cardano.LedgerStateBabbage ledgerBabbage -> ledgerDRepCount ledgerBabbage
Cardano.LedgerStateConway ledgerConway -> ledgerDRepCount ledgerConway
ledgerDRepMapSize = \case
Cardano.LedgerStateByron ledgerByron -> ledgerDRepMapSize ledgerByron
Cardano.LedgerStateShelley ledgerShelley -> ledgerDRepMapSize ledgerShelley
Cardano.LedgerStateAllegra ledgerAllegra -> ledgerDRepMapSize ledgerAllegra
Cardano.LedgerStateMary ledgerMary -> ledgerDRepMapSize ledgerMary
Cardano.LedgerStateAlonzo ledgerAlonzo -> ledgerDRepMapSize ledgerAlonzo
Cardano.LedgerStateBabbage ledgerBabbage -> ledgerDRepMapSize ledgerBabbage
Cardano.LedgerStateConway ledgerConway -> ledgerDRepMapSize ledgerConway

--
-- * Node kernel
Expand Down
12 changes: 9 additions & 3 deletions cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1151,15 +1151,21 @@ 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
<> " 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.UtxoSize" (fromIntegral tsUtxoSize),
IntM "Forge.DelegMapSize" (fromIntegral tsDelegMapSize),
IntM "Forge.DRepCount" (fromIntegral tsDRepCount),
IntM "Forge.DRepMapSize" (fromIntegral tsDRepMapSize)]

--------------------------------------------------------------------------------
-- ForgeEvent Tracer
Expand Down
104 changes: 40 additions & 64 deletions cardano-node/src/Cardano/Node/Tracing/Tracers/StartLeadershipCheck.hs
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
Expand All @@ -12,29 +13,23 @@ module Cardano.Node.Tracing.Tracers.StartLeadershipCheck
) where


import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Logging

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 Cardano.Node.Queries (LedgerQueries (..), NodeKernelData (..))
import Cardano.Slotting.Slot (fromWithOrigin)
import Ouroboros.Consensus.Block (SlotNo (..))
import Ouroboros.Consensus.HardFork.Combinator
import Ouroboros.Consensus.Ledger.Abstract (IsLedger)
import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState, ledgerState)
import Ouroboros.Consensus.Ledger.Extended (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 Cardano.Node.Queries (LedgerQueries (..), NodeKernelData (..))
import Cardano.Slotting.Slot (fromWithOrigin)

import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Control.Concurrent.STM (atomically)
import Data.IORef (readIORef)
import Data.Word (Word64)


type ForgeTracerType blk = Either (TraceForgeEvent blk)
Expand All @@ -45,6 +40,8 @@ data TraceStartLeadershipCheckPlus =
tsSlotNo :: SlotNo
, tsUtxoSize :: Int
, tsDelegMapSize :: Int
, tsDRepCount :: Int
, tsDRepMapSize :: Int
, tsChainDensity :: Double
}

Expand All @@ -58,47 +55,41 @@ forgeTracerTransform ::
=> NodeKernelData blk
-> Trace IO (ForgeTracerType blk)
-> IO (Trace IO (ForgeTracerType blk))
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)
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

fragmentChainDensity ::
#if __GLASGOW_HASKELL__ >= 906
(AF.HasHeader blk, AF.HasHeader (Header blk))
#else
AF.HasHeader (Header blk)
#endif
=> AF.AnchoredFragment (Header blk) -> Rational
fragmentChainDensity frag = calcDensity blockD slotD
=> AF.AnchoredFragment (Header blk) -> Double
fragmentChainDensity frag = fromRational $ calcDensity blockD slotD
where
calcDensity :: Word64 -> Word64 -> Rational
calcDensity bl sl
Expand All @@ -119,18 +110,3 @@ fragmentChainDensity frag = 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

0 comments on commit 0a26384

Please sign in to comment.