Skip to content

Commit d64e8a5

Browse files
NadiaYvettemgmeier
authored andcommitted
start-leadership: trace drep count and map size
Update TraceStartLeadershipCheckPlus with fields to track the DRep count and DRep map size. Update LedgerQueries with methods to extract the information to fill TraceStartLeadershipCheckPlus with. Update forgeTracerTransform to go about filling in all of the fields of TraceStartLeadershipCheckPlus with all the results from the accessors. DRep counts and map sizes get logged in the regularly-scheduled periodic traces in the final result.
1 parent df7e8d8 commit d64e8a5

File tree

3 files changed

+81
-56
lines changed

3 files changed

+81
-56
lines changed

cardano-node/src/Cardano/Node/Queries.hs

Lines changed: 40 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -231,10 +231,14 @@ instance All GetKESInfo xs => GetKESInfo (HardForkBlock xs) where
231231
class LedgerQueries blk where
232232
ledgerUtxoSize :: LedgerState blk -> Int
233233
ledgerDelegMapSize :: LedgerState blk -> Int
234+
ledgerDRepCount :: LedgerState blk -> Int
235+
ledgerDRepMapSize :: LedgerState blk -> Int
234236

235237
instance LedgerQueries Byron.ByronBlock where
236238
ledgerUtxoSize = Map.size . Byron.unUTxO . Byron.cvsUtxo . Byron.byronLedgerState
237239
ledgerDelegMapSize _ = 0
240+
ledgerDRepCount _ = 0
241+
ledgerDRepMapSize _ = 0
238242

239243
instance LedgerQueries (Shelley.ShelleyBlock protocol era) where
240244
ledgerUtxoSize =
@@ -253,11 +257,30 @@ instance LedgerQueries (Shelley.ShelleyBlock protocol era) where
253257
. Shelley.esLState
254258
. Shelley.nesEs
255259
. Shelley.shelleyLedgerState
260+
ledgerDRepCount =
261+
Map.size
262+
. Shelley.vsDReps
263+
. Shelley.certVState
264+
. Shelley.lsCertState
265+
. Shelley.esLState
266+
. Shelley.nesEs
267+
. Shelley.shelleyLedgerState
268+
ledgerDRepMapSize =
269+
UM.size
270+
. UM.DRepUView
271+
. Shelley.dsUnified
272+
. Shelley.certDState
273+
. Shelley.lsCertState
274+
. Shelley.esLState
275+
. Shelley.nesEs
276+
. Shelley.shelleyLedgerState
256277

257278
instance (LedgerQueries x, NoHardForks x)
258279
=> LedgerQueries (HardForkBlock '[x]) where
259-
ledgerUtxoSize = ledgerUtxoSize . project
280+
ledgerUtxoSize = ledgerUtxoSize . project
260281
ledgerDelegMapSize = ledgerDelegMapSize . project
282+
ledgerDRepCount = ledgerDRepCount . project
283+
ledgerDRepMapSize = ledgerDRepMapSize . project
261284

262285
instance LedgerQueries (Cardano.CardanoBlock c) where
263286
ledgerUtxoSize = \case
@@ -276,6 +299,22 @@ instance LedgerQueries (Cardano.CardanoBlock c) where
276299
Cardano.LedgerStateAlonzo ledgerAlonzo -> ledgerDelegMapSize ledgerAlonzo
277300
Cardano.LedgerStateBabbage ledgerBabbage -> ledgerDelegMapSize ledgerBabbage
278301
Cardano.LedgerStateConway ledgerConway -> ledgerDelegMapSize ledgerConway
302+
ledgerDRepCount = \case
303+
Cardano.LedgerStateByron ledgerByron -> ledgerDRepCount ledgerByron
304+
Cardano.LedgerStateShelley ledgerShelley -> ledgerDRepCount ledgerShelley
305+
Cardano.LedgerStateAllegra ledgerAllegra -> ledgerDRepCount ledgerAllegra
306+
Cardano.LedgerStateMary ledgerMary -> ledgerDRepCount ledgerMary
307+
Cardano.LedgerStateAlonzo ledgerAlonzo -> ledgerDRepCount ledgerAlonzo
308+
Cardano.LedgerStateBabbage ledgerBabbage -> ledgerDRepCount ledgerBabbage
309+
Cardano.LedgerStateConway ledgerConway -> ledgerDRepCount ledgerConway
310+
ledgerDRepMapSize = \case
311+
Cardano.LedgerStateByron ledgerByron -> ledgerDRepMapSize ledgerByron
312+
Cardano.LedgerStateShelley ledgerShelley -> ledgerDRepMapSize ledgerShelley
313+
Cardano.LedgerStateAllegra ledgerAllegra -> ledgerDRepMapSize ledgerAllegra
314+
Cardano.LedgerStateMary ledgerMary -> ledgerDRepMapSize ledgerMary
315+
Cardano.LedgerStateAlonzo ledgerAlonzo -> ledgerDRepMapSize ledgerAlonzo
316+
Cardano.LedgerStateBabbage ledgerBabbage -> ledgerDRepMapSize ledgerBabbage
317+
Cardano.LedgerStateConway ledgerConway -> ledgerDRepMapSize ledgerConway
279318

280319
--
281320
-- * Node kernel

cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1151,15 +1151,21 @@ instance LogFormatting TraceStartLeadershipCheckPlus where
11511151
, "utxoSize" .= Number (fromIntegral tsUtxoSize)
11521152
, "delegMapSize" .= Number (fromIntegral tsDelegMapSize)
11531153
, "chainDensity" .= Number (fromRational (toRational tsChainDensity))
1154+
, "dRepCount" .= Number (fromIntegral tsDRepCount)
1155+
, "dRepMapSize" .= Number (fromIntegral tsDRepMapSize)
11541156
]
11551157
forHuman TraceStartLeadershipCheckPlus {..} =
11561158
"Checking for leadership in slot " <> showT (unSlotNo tsSlotNo)
1157-
<> " utxoSize " <> showT tsUtxoSize
1159+
<> " utxoSize " <> showT tsUtxoSize
11581160
<> " delegMapSize " <> showT tsDelegMapSize
11591161
<> " chainDensity " <> showT tsChainDensity
1162+
<> " dRepCount " <> showT tsDRepCount
1163+
<> " dRepMapSize " <> showT tsDRepMapSize
11601164
asMetrics TraceStartLeadershipCheckPlus {..} =
1161-
[IntM "Forge.UtxoSize" (fromIntegral tsUtxoSize),
1162-
IntM "Forge.DelegMapSize" (fromIntegral tsDelegMapSize)]
1165+
[IntM "Forge.UtxoSize" (fromIntegral tsUtxoSize),
1166+
IntM "Forge.DelegMapSize" (fromIntegral tsDelegMapSize),
1167+
IntM "Forge.DRepCount" (fromIntegral tsDRepCount),
1168+
IntM "Forge.DRepMapSize" (fromIntegral tsDRepMapSize)]
11631169

11641170
--------------------------------------------------------------------------------
11651171
-- ForgeEvent Tracer
Lines changed: 32 additions & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE BlockArguments #-}
12
{-# LANGUAGE CPP #-}
23
{-# LANGUAGE DataKinds #-}
34
{-# LANGUAGE FlexibleContexts #-}
@@ -20,13 +21,11 @@ import Data.Word (Word64)
2021

2122
import qualified Ouroboros.Network.AnchoredFragment as AF
2223
import Ouroboros.Network.Block (BlockNo (..), blockNo, unBlockNo)
23-
import Ouroboros.Network.NodeToClient (LocalConnectionId)
24-
import Ouroboros.Network.NodeToNode (RemoteAddress)
2524

2625
import Ouroboros.Consensus.Block (SlotNo (..))
2726
import Ouroboros.Consensus.HardFork.Combinator
2827
import Ouroboros.Consensus.Ledger.Abstract (IsLedger)
29-
import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState, ledgerState)
28+
import Ouroboros.Consensus.Ledger.Extended (ledgerState)
3029
import Ouroboros.Consensus.Node (NodeKernel (..))
3130
import Ouroboros.Consensus.Node.Tracers
3231
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
@@ -45,6 +44,8 @@ data TraceStartLeadershipCheckPlus =
4544
tsSlotNo :: SlotNo
4645
, tsUtxoSize :: Int
4746
, tsDelegMapSize :: Int
47+
, tsDRepCount :: Int
48+
, tsDRepMapSize :: Int
4849
, tsChainDensity :: Double
4950
}
5051

@@ -58,47 +59,41 @@ forgeTracerTransform ::
5859
=> NodeKernelData blk
5960
-> Trace IO (ForgeTracerType blk)
6061
-> IO (Trace IO (ForgeTracerType blk))
61-
forgeTracerTransform nodeKern (Trace tr) =
62-
contramapM (Trace tr)
63-
(\case
64-
(lc, Right (Left slc@(TraceStartLeadershipCheck slotNo))) -> do
65-
query <- mapNodeKernelDataIO
66-
(\nk ->
67-
(,,)
68-
<$> nkQueryLedger (ledgerUtxoSize . ledgerState) nk
69-
<*> nkQueryLedger (ledgerDelegMapSize . ledgerState) nk
70-
<*> nkQueryChain fragmentChainDensity nk)
71-
nodeKern
72-
case query of
73-
SNothing -> pure (lc, Right (Left slc))
74-
SJust (utxoSize, delegMapSize, chainDensity) ->
75-
let msg = TraceStartLeadershipCheckPlus
76-
slotNo
77-
utxoSize
78-
delegMapSize
79-
(fromRational chainDensity)
80-
in pure (lc, Right (Right msg))
81-
(lc, Right a) ->
82-
pure (lc, Right a)
83-
(lc, Left control) ->
84-
pure (lc, Left control))
85-
86-
nkQueryLedger ::
87-
IsLedger (LedgerState blk)
88-
=> (ExtLedgerState blk -> a)
89-
-> NodeKernel IO RemoteAddress LocalConnectionId blk
90-
-> IO a
91-
nkQueryLedger f NodeKernel{getChainDB} =
92-
f <$> atomically (ChainDB.getCurrentLedger getChainDB)
62+
forgeTracerTransform (NodeKernelData ref) (Trace tr) =
63+
let secondM f (x, y) = do -- avoiding new dep on extra pkg
64+
y' <- f y
65+
pure (x, y')
66+
in contramapM (Trace tr) $ secondM
67+
\case
68+
Right (Left slc@(TraceStartLeadershipCheck tsSlotNo)) -> do
69+
query <- readIORef ref >>= traverse
70+
\NodeKernel{getChainDB} -> do
71+
ledger <- fmap ledgerState . atomically $
72+
ChainDB.getCurrentLedger getChainDB
73+
chain <- atomically $ ChainDB.getCurrentChain getChainDB
74+
pure TraceStartLeadershipCheckPlus {
75+
tsSlotNo
76+
, tsUtxoSize = ledgerUtxoSize ledger
77+
, tsDelegMapSize = ledgerDelegMapSize ledger
78+
, tsDRepCount = ledgerDRepCount ledger
79+
, tsDRepMapSize = ledgerDRepMapSize ledger
80+
, tsChainDensity = fragmentChainDensity chain }
81+
pure . Right $ case query of
82+
SNothing -> Left slc
83+
SJust tslcp -> Right tslcp
84+
Right a ->
85+
pure $ Right a
86+
Left control ->
87+
pure $ Left control
9388

9489
fragmentChainDensity ::
9590
#if __GLASGOW_HASKELL__ >= 906
9691
(AF.HasHeader blk, AF.HasHeader (Header blk))
9792
#else
9893
AF.HasHeader (Header blk)
9994
#endif
100-
=> AF.AnchoredFragment (Header blk) -> Rational
101-
fragmentChainDensity frag = calcDensity blockD slotD
95+
=> AF.AnchoredFragment (Header blk) -> Double
96+
fragmentChainDensity frag = fromRational $ calcDensity blockD slotD
10297
where
10398
calcDensity :: Word64 -> Word64 -> Rational
10499
calcDensity bl sl
@@ -119,18 +114,3 @@ fragmentChainDensity frag = calcDensity blockD slotD
119114
-- don't let it contribute to the number of blocks
120115
Right 0 -> 1
121116
Right b -> b
122-
123-
nkQueryChain ::
124-
(AF.AnchoredFragment (Header blk) -> a)
125-
-> NodeKernel IO RemoteAddress LocalConnectionId blk
126-
-> IO a
127-
nkQueryChain f NodeKernel{getChainDB} =
128-
f <$> atomically (ChainDB.getCurrentChain getChainDB)
129-
130-
131-
mapNodeKernelDataIO ::
132-
(NodeKernel IO RemoteAddress LocalConnectionId blk -> IO a)
133-
-> NodeKernelData blk
134-
-> IO (StrictMaybe a)
135-
mapNodeKernelDataIO f (NodeKernelData ref) =
136-
readIORef ref >>= traverse f

0 commit comments

Comments
 (0)