Skip to content

Commit ded7304

Browse files
mgmeiermgmeier
committed
trace dreps: do not
1 parent 549d015 commit ded7304

File tree

2 files changed

+66
-47
lines changed

2 files changed

+66
-47
lines changed

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

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1151,21 +1151,16 @@ 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)
11561154
]
11571155
forHuman TraceStartLeadershipCheckPlus {..} =
11581156
"Checking for leadership in slot " <> showT (unSlotNo tsSlotNo)
11591157
<> " utxoSize " <> showT tsUtxoSize
11601158
<> " delegMapSize " <> showT tsDelegMapSize
11611159
<> " chainDensity " <> showT tsChainDensity
1162-
<> " dRepCount " <> showT tsDRepCount
1163-
<> " dRepMapSize " <> showT tsDRepMapSize
11641160
asMetrics TraceStartLeadershipCheckPlus {..} =
11651161
[IntM "Forge.UtxoSize" (fromIntegral tsUtxoSize),
1166-
IntM "Forge.DelegMapSize" (fromIntegral tsDelegMapSize),
1167-
IntM "Forge.DRepCount" (fromIntegral tsDRepCount),
1168-
IntM "Forge.DRepMapSize" (fromIntegral tsDRepMapSize)]
1162+
IntM "Forge.DelegMapSize" (fromIntegral tsDelegMapSize)]
1163+
11691164

11701165
--------------------------------------------------------------------------------
11711166
-- ForgeEvent Tracer

‎cardano-node/src/Cardano/Node/Tracing/Tracers/StartLeadershipCheck.hs‎

Lines changed: 64 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE BlockArguments #-}
21
{-# LANGUAGE CPP #-}
32
{-# LANGUAGE DataKinds #-}
43
{-# LANGUAGE FlexibleContexts #-}
@@ -13,23 +12,29 @@ module Cardano.Node.Tracing.Tracers.StartLeadershipCheck
1312
) where
1413

1514

16-
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
1715
import Cardano.Logging
18-
import Cardano.Node.Queries (LedgerQueries (..), NodeKernelData (..))
19-
import Cardano.Slotting.Slot (fromWithOrigin)
16+
17+
import Control.Concurrent.STM (atomically)
18+
import Data.IORef (readIORef)
19+
import Data.Word (Word64)
20+
21+
import qualified Ouroboros.Network.AnchoredFragment as AF
22+
import Ouroboros.Network.Block (BlockNo (..), blockNo, unBlockNo)
23+
import Ouroboros.Network.NodeToClient (LocalConnectionId)
24+
import Ouroboros.Network.NodeToNode (RemoteAddress)
25+
2026
import Ouroboros.Consensus.Block (SlotNo (..))
2127
import Ouroboros.Consensus.HardFork.Combinator
2228
import Ouroboros.Consensus.Ledger.Abstract (IsLedger)
23-
import Ouroboros.Consensus.Ledger.Extended (ledgerState)
29+
import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState, ledgerState)
2430
import Ouroboros.Consensus.Node (NodeKernel (..))
2531
import Ouroboros.Consensus.Node.Tracers
2632
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
27-
import qualified Ouroboros.Network.AnchoredFragment as AF
28-
import Ouroboros.Network.Block (BlockNo (..), blockNo, unBlockNo)
2933

30-
import Control.Concurrent.STM (atomically)
31-
import Data.IORef (readIORef)
32-
import Data.Word (Word64)
34+
import Cardano.Node.Queries (LedgerQueries (..), NodeKernelData (..))
35+
import Cardano.Slotting.Slot (fromWithOrigin)
36+
37+
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
3338

3439

3540
type ForgeTracerType blk = Either (TraceForgeEvent blk)
@@ -40,8 +45,6 @@ data TraceStartLeadershipCheckPlus =
4045
tsSlotNo :: SlotNo
4146
, tsUtxoSize :: Int
4247
, tsDelegMapSize :: Int
43-
, tsDRepCount :: Int
44-
, tsDRepMapSize :: Int
4548
, tsChainDensity :: Double
4649
}
4750

@@ -55,41 +58,47 @@ forgeTracerTransform ::
5558
=> NodeKernelData blk
5659
-> Trace IO (ForgeTracerType blk)
5760
-> IO (Trace IO (ForgeTracerType blk))
58-
forgeTracerTransform (NodeKernelData ref) (Trace tr) =
59-
let secondM f (x, y) = do -- avoiding new dep on extra pkg
60-
y' <- f y
61-
pure (x, y')
62-
in contramapM (Trace tr) $ secondM
63-
\case
64-
Right (Left slc@(TraceStartLeadershipCheck tsSlotNo)) -> do
65-
query <- readIORef ref >>= traverse
66-
\NodeKernel{getChainDB} -> do
67-
ledger <- fmap ledgerState . atomically $
68-
ChainDB.getCurrentLedger getChainDB
69-
chain <- atomically $ ChainDB.getCurrentChain getChainDB
70-
pure TraceStartLeadershipCheckPlus {
71-
tsSlotNo
72-
, tsUtxoSize = ledgerUtxoSize ledger
73-
, tsDelegMapSize = ledgerDelegMapSize ledger
74-
, tsDRepCount = ledgerDRepCount ledger
75-
, tsDRepMapSize = ledgerDRepMapSize ledger
76-
, tsChainDensity = fragmentChainDensity chain }
77-
pure . Right $ case query of
78-
SNothing -> Left slc
79-
SJust tslcp -> Right tslcp
80-
Right a ->
81-
pure $ Right a
82-
Left control ->
83-
pure $ Left control
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)
8493

8594
fragmentChainDensity ::
8695
#if __GLASGOW_HASKELL__ >= 906
8796
(AF.HasHeader blk, AF.HasHeader (Header blk))
8897
#else
8998
AF.HasHeader (Header blk)
9099
#endif
91-
=> AF.AnchoredFragment (Header blk) -> Double
92-
fragmentChainDensity frag = fromRational $ calcDensity blockD slotD
100+
=> AF.AnchoredFragment (Header blk) -> Rational
101+
fragmentChainDensity frag = calcDensity blockD slotD
93102
where
94103
calcDensity :: Word64 -> Word64 -> Rational
95104
calcDensity bl sl
@@ -110,3 +119,18 @@ fragmentChainDensity frag = fromRational $ calcDensity blockD slotD
110119
-- don't let it contribute to the number of blocks
111120
Right 0 -> 1
112121
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)