Skip to content

Commit 108bfcb

Browse files
jasagredojasagredo
committed
Provide KESAgentClientTrace to BlockForging
1 parent af05488 commit 108bfcb

File tree

16 files changed

+71
-41
lines changed

16 files changed

+71
-41
lines changed

‎ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -149,6 +149,7 @@ library
149149
cardano-strict-containers,
150150
cborg ^>=0.2.2,
151151
containers >=0.5 && <0.8,
152+
contra-tracer,
152153
crypton,
153154
deepseq,
154155
formatting >=6.3 && <7.3,
@@ -325,6 +326,7 @@ library unstable-shelley-testlib
325326
cardano-slotting,
326327
cardano-strict-containers,
327328
containers,
329+
contra-tracer,
328330
generic-random,
329331
kes-agent,
330332
microlens,
@@ -367,6 +369,7 @@ test-suite shelley-test
367369
cborg,
368370
constraints,
369371
containers,
372+
contra-tracer,
370373
filepath,
371374
measures,
372375
microlens,
@@ -418,6 +421,7 @@ library unstable-cardano-testlib
418421
cardano-strict-containers,
419422
cborg,
420423
containers,
424+
contra-tracer,
421425
mempack,
422426
microlens,
423427
mtl,

‎ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -63,6 +63,7 @@ import qualified Codec.CBOR.Decoding as CBOR
6363
import Codec.CBOR.Encoding (Encoding)
6464
import qualified Codec.CBOR.Encoding as CBOR
6565
import Control.Exception (assert)
66+
import qualified Control.Tracer as Tracer
6667
import qualified Data.ByteString.Short as Short
6768
import Data.Functor.These (These1 (..))
6869
import qualified Data.Map.Strict as Map
@@ -492,7 +493,7 @@ protocolInfoCardano ::
492493
)
493494
=> CardanoProtocolParams c
494495
-> ( ProtocolInfo (CardanoBlock c)
495-
, m [BlockForging m (CardanoBlock c)]
496+
, Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (CardanoBlock c)]
496497
)
497498
protocolInfoCardano paramsCardano
498499
| SL.Mainnet <- SL.sgNetworkId genesisShelley
@@ -855,9 +856,9 @@ protocolInfoCardano paramsCardano
855856
-- credentials. If there are multiple Shelley credentials, we merge the
856857
-- Byron credentials with the first Shelley one but still have separate
857858
-- threads for the remaining Shelley ones.
858-
mkBlockForgings :: m [BlockForging m (CardanoBlock c)]
859-
mkBlockForgings = do
860-
shelleyBased <- traverse blockForgingShelleyBased credssShelleyBased
859+
mkBlockForgings :: Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (CardanoBlock c)]
860+
mkBlockForgings tr = do
861+
shelleyBased <- traverse (blockForgingShelleyBased tr) credssShelleyBased
861862
let blockForgings :: [NonEmptyOptNP (BlockForging m) (CardanoEras c)]
862863
blockForgings = case (mBlockForgingByron, shelleyBased) of
863864
(Nothing, shelleys) -> shelleys
@@ -879,9 +880,10 @@ protocolInfoCardano paramsCardano
879880
return $ byronBlockForging creds `OptNP.at` IZ
880881

881882
blockForgingShelleyBased ::
882-
ShelleyLeaderCredentials c
883+
Tracer.Tracer m KESAgentClientTrace
884+
-> ShelleyLeaderCredentials c
883885
-> m (NonEmptyOptNP (BlockForging m) (CardanoEras c))
884-
blockForgingShelleyBased credentials = do
886+
blockForgingShelleyBased tr credentials = do
885887
let canBeLeader = shelleyLeaderCredentialsCanBeLeader credentials
886888

887889
let slotToPeriod :: SlotNo -> Absolute.KESPeriod
@@ -893,6 +895,7 @@ protocolInfoCardano paramsCardano
893895

894896
hotKey <- instantiatePraosCredentials
895897
maxKESEvo
898+
tr
896899
(praosCanBeLeaderCredentialsSource canBeLeader)
897900

898901
let tpraos :: forall era.

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ import qualified Cardano.Protocol.TPraos.OCert as SL
4747
import Cardano.Slotting.EpochInfo
4848
import Cardano.Slotting.Time (mkSlotLength)
4949
import Control.Monad.Except (Except)
50+
import qualified Control.Tracer as Tracer
5051
import Data.Bifunctor (first)
5152
import qualified Data.SerDoc.Class as SerDoc
5253
import qualified Data.Text as T
@@ -179,7 +180,7 @@ protocolInfoShelley ::
179180
-> ProtocolParamsShelleyBased c
180181
-> SL.ProtVer
181182
-> ( ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra)
182-
, m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)]
183+
, Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)]
183184
)
184185
protocolInfoShelley shelleyGenesis
185186
protocolParamsShelleyBased
@@ -200,7 +201,7 @@ protocolInfoTPraosShelleyBased ::
200201
-> SL.ProtVer
201202
-- ^ see 'shelleyProtVer', mutatis mutandi
202203
-> ( ProtocolInfo (ShelleyBlock (TPraos c) era)
203-
, m [BlockForging m (ShelleyBlock (TPraos c) era)]
204+
, Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (ShelleyBlock (TPraos c) era)]
204205
)
205206
protocolInfoTPraosShelleyBased ProtocolParamsShelleyBased {
206207
shelleyBasedInitialNonce = initialNonce
@@ -213,16 +214,19 @@ protocolInfoTPraosShelleyBased ProtocolParamsShelleyBased {
213214
pInfoConfig = topLevelConfig
214215
, pInfoInitLedger = initExtLedgerState
215216
}
216-
, traverse mkBlockForging credentialss
217+
, \tr -> traverse (mkBlockForging tr) credentialss
217218
)
218219
where
219-
mkBlockForging :: ShelleyLeaderCredentials c -> m (BlockForging m (ShelleyBlock (TPraos c) era))
220-
mkBlockForging credentials = do
220+
mkBlockForging :: Tracer.Tracer m KESAgentClientTrace
221+
-> ShelleyLeaderCredentials c
222+
-> m (BlockForging m (ShelleyBlock (TPraos c) era))
223+
mkBlockForging tr credentials = do
221224
let canBeLeader = shelleyLeaderCredentialsCanBeLeader credentials
222225

223226
hotKey :: HotKey c m <-
224227
instantiatePraosCredentials
225228
(tpraosMaxKESEvo tpraosParams)
229+
tr
226230
(praosCanBeLeaderCredentialsSource canBeLeader)
227231

228232
return $ shelleyBlockForging tpraosParams hotKey credentials

‎ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/ProtocolInfo.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ import qualified Cardano.Ledger.BaseTypes as SL
2727
import Cardano.Protocol.Crypto (StandardCrypto)
2828
import qualified Cardano.Protocol.TPraos.OCert as SL
2929
import qualified Cardano.Slotting.Time as Time
30+
import qualified Control.Tracer as Tracer
3031
import Data.Proxy (Proxy (..))
3132
import Data.SOP.Strict
3233
import Data.Word (Word64)
@@ -47,7 +48,7 @@ import Ouroboros.Consensus.NodeId (CoreNodeId (..))
4748
import Ouroboros.Consensus.Protocol.PBFT (PBftParams,
4849
PBftSignatureThreshold (..))
4950
import Ouroboros.Consensus.Protocol.Praos.AgentClient
50-
(KESAgentContext)
51+
(KESAgentClientTrace, KESAgentContext)
5152
import Ouroboros.Consensus.Shelley.Node
5253
(ProtocolParamsShelleyBased (..), ShelleyGenesis,
5354
ShelleyLeaderCredentials)
@@ -235,7 +236,7 @@ mkTestProtocolInfo ::
235236
-- that __might__ appear in the 'CardanoHardForkTriggers' parameter.
236237
-> CardanoHardForkTriggers
237238
-- ^ Specification of the era to which the initial state should hard-fork to.
238-
-> (ProtocolInfo (CardanoBlock c), m [BlockForging m (CardanoBlock c)])
239+
-> (ProtocolInfo (CardanoBlock c), Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (CardanoBlock c)])
239240
mkTestProtocolInfo
240241
(coreNodeId, coreNode)
241242
shelleyGenesis

‎ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ import qualified Cardano.Ledger.UMap as SL
4747
import Codec.CBOR.Decoding
4848
import Codec.CBOR.Encoding
4949
import Control.Monad.Except (runExcept)
50+
import qualified Control.Tracer as Tracer
5051
import Data.Coerce
5152
import qualified Data.Map.Strict as Map
5253
import Data.MemPack
@@ -62,7 +63,7 @@ import Data.Void (Void)
6263
import Lens.Micro ((^.))
6364
import NoThunks.Class (NoThunks)
6465
import Ouroboros.Consensus.Block.Abstract (BlockProtocol)
65-
import Ouroboros.Consensus.Block.Forging (BlockForging)
66+
import Ouroboros.Consensus.Block.Forging (BlockForging, KESTracer)
6667
import Ouroboros.Consensus.Cardano.CanHardFork
6768
(crossEraForecastAcrossShelley,
6869
translateChainDepStateAcrossShelley)
@@ -81,7 +82,7 @@ import Ouroboros.Consensus.Ledger.Tables.Utils
8182
import Ouroboros.Consensus.Node
8283
import Ouroboros.Consensus.Node.NetworkProtocolVersion
8384
import Ouroboros.Consensus.Protocol.Praos.AgentClient
84-
(KESAgentContext)
85+
(KESAgentClientTrace, KESAgentContext)
8586
import Ouroboros.Consensus.Protocol.TPraos
8687
import Ouroboros.Consensus.Shelley.Eras
8788
import Ouroboros.Consensus.Shelley.Ledger
@@ -363,6 +364,8 @@ instance ShelleyBasedHardForkConstraints proto1 era1 proto2 era2
363364
Protocol info
364365
-------------------------------------------------------------------------------}
365366

367+
type instance KESTracer (ShelleyBlock proto era) = KESAgentClientTrace
368+
366369
protocolInfoShelleyBasedHardFork ::
367370
forall m proto1 era1 proto2 era2.
368371
( KESAgentContext (ProtoCrypto proto2) m
@@ -374,7 +377,7 @@ protocolInfoShelleyBasedHardFork ::
374377
-> L.TransitionConfig era2
375378
-> TriggerHardFork
376379
-> ( ProtocolInfo (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)
377-
, m [BlockForging m (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)]
380+
, Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)]
378381
)
379382
protocolInfoShelleyBasedHardFork protocolParamsShelleyBased
380383
protVer1
@@ -406,7 +409,7 @@ protocolInfoShelleyBasedHardFork protocolParamsShelleyBased
406409
genesis = transCfg2 ^. L.tcShelleyGenesisL
407410

408411
protocolInfo1 :: ProtocolInfo (ShelleyBlock proto1 era1)
409-
blockForging1 :: m [BlockForging m (ShelleyBlock proto1 era1)]
412+
blockForging1 :: Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (ShelleyBlock proto1 era1)]
410413
(protocolInfo1, blockForging1) =
411414
protocolInfoTPraosShelleyBased
412415
protocolParamsShelleyBased
@@ -427,7 +430,7 @@ protocolInfoShelleyBasedHardFork protocolParamsShelleyBased
427430
-- Era 2
428431

429432
protocolInfo2 :: ProtocolInfo (ShelleyBlock proto2 era2)
430-
blockForging2 :: m [BlockForging m (ShelleyBlock proto2 era2)]
433+
blockForging2 :: Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (ShelleyBlock proto2 era2)]
431434
(protocolInfo2, blockForging2) =
432435
protocolInfoTPraosShelleyBased
433436
ProtocolParamsShelleyBased {

‎ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/Protocol/Types.hs

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
{-# LANGUAGE FlexibleInstances #-}
55
{-# LANGUAGE GADTs #-}
66
{-# LANGUAGE MultiParamTypeClasses #-}
7+
{-# LANGUAGE ScopedTypeVariables #-}
78
{-# LANGUAGE StandaloneDeriving #-}
89
{-# LANGUAGE TypeFamilies #-}
910
{-# LANGUAGE UndecidableInstances #-}
@@ -19,6 +20,7 @@ module Cardano.Api.Protocol.Types (
1920
) where
2021

2122
import Cardano.Chain.Slotting (EpochSlots)
23+
import qualified Control.Tracer as Tracer
2224
import Data.Bifunctor (bimap)
2325
import Ouroboros.Consensus.Block.Forging (BlockForging)
2426
import Ouroboros.Consensus.Byron.ByronHFC (ByronBlockHFC)
@@ -41,11 +43,10 @@ import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
4143
import Ouroboros.Consensus.Shelley.ShelleyHFC (ShelleyBlockHFC)
4244
import Ouroboros.Consensus.Util.IOLike
4345

44-
4546
class (RunNode blk, IOLike m) => Protocol m blk where
4647
data ProtocolInfoArgs m blk
4748
protocolInfo :: ProtocolInfoArgs m blk -> ( ProtocolInfo blk
48-
, m [BlockForging m blk]
49+
, Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m blk]
4950
)
5051

5152
-- | Node client support for each consensus protocol.
@@ -62,7 +63,7 @@ class RunNode blk => ProtocolClient blk where
6263
instance IOLike m => Protocol m ByronBlockHFC where
6364
data ProtocolInfoArgs m ByronBlockHFC = ProtocolInfoArgsByron ProtocolParamsByron
6465
protocolInfo (ProtocolInfoArgsByron params) = ( inject $ protocolInfoByron params
65-
, pure . map inject $ blockForgingByron params
66+
, \_ -> pure . map inject $ blockForgingByron params
6667
)
6768

6869
instance ( CardanoHardForkConstraints StandardCrypto
@@ -101,7 +102,9 @@ instance ( IOLike m
101102
(ProtocolParamsShelleyBased StandardCrypto)
102103
ProtVer
103104
protocolInfo (ProtocolInfoArgsShelley genesis shelleyBasedProtocolParams' protVer) =
104-
bimap inject (fmap $ map inject) $ protocolInfoShelley genesis shelleyBasedProtocolParams' protVer
105+
bimap inject injectBlockForging $ protocolInfoShelley genesis shelleyBasedProtocolParams' protVer
106+
where
107+
injectBlockForging bf tr = fmap (map inject) $ bf tr
105108

106109
instance Consensus.LedgerSupportsProtocol
107110
(Consensus.ShelleyBlock

‎ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Run.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -141,7 +141,7 @@ synthesize genTxs DBSynthesizerConfig{confOptions, confShelleyGenesis, confDbDir
141141
flavargs $
142142
ChainDB.defaultArgs
143143

144-
(_, forgers) <- allocate registry (const $ mkForgers) (mapM_ BlockForging.finalize)
144+
(_, forgers) <- allocate registry (const $ mkForgers nullTracer) (mapM_ BlockForging.finalize)
145145
let fCount = length forgers
146146
putStrLn $ "--> forger count: " ++ show fCount
147147
if fCount > 0

‎ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -61,6 +61,7 @@ import Cardano.Protocol.TPraos.OCert
6161
import qualified Cardano.Protocol.TPraos.OCert as SL (KESPeriod, OCert (OCert),
6262
OCertSignable (..))
6363
import Control.Monad.Except (throwError)
64+
import qualified Control.Tracer as Tracer
6465
import qualified Data.ByteString as BS
6566
import Data.Coerce (coerce)
6667
import Data.ListMap (ListMap (ListMap))
@@ -80,7 +81,7 @@ import Ouroboros.Consensus.BlockchainTime
8081
import Ouroboros.Consensus.Config.SecurityParam
8182
import Ouroboros.Consensus.Node.ProtocolInfo
8283
import Ouroboros.Consensus.Protocol.Praos.AgentClient
83-
(KESAgentContext)
84+
(KESAgentClientTrace, KESAgentContext)
8485
import Ouroboros.Consensus.Protocol.Praos.Common
8586
(PraosCanBeLeader (PraosCanBeLeader),
8687
PraosCredentialsSource (..), praosCanBeLeaderColdVerKey,
@@ -418,7 +419,7 @@ mkProtocolShelley ::
418419
-> ProtVer
419420
-> CoreNode c
420421
-> ( ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra)
421-
, m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)]
422+
, Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)]
422423
)
423424
mkProtocolShelley genesis initialNonce protVer coreNode =
424425
protocolInfoShelley

‎ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ import qualified Cardano.Ledger.Shelley.Core as SL
2121
import qualified Cardano.Protocol.TPraos.OCert as SL
2222
import Cardano.Slotting.Slot (EpochSize (..), SlotNo (..))
2323
import Control.Monad (replicateM)
24+
import Control.Tracer (nullTracer)
2425
import qualified Data.Map.Strict as Map
2526
import Data.Maybe (maybeToList)
2627
import Data.Proxy (Proxy (..))
@@ -252,7 +253,7 @@ prop_simple_allegraMary_convergence TestSetup
252253
(SlotNo $ unNumSlots numSlots) -- never expire
253254
setupD -- unchanged
254255
, tniProtocolInfo = protocolInfo
255-
, tniBlockForging = blockForging
256+
, tniBlockForging = blockForging nullTracer
256257
}
257258
, mkRekeyM = Nothing
258259
}

‎ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ import qualified Cardano.Protocol.TPraos.OCert as SL
2626
import Cardano.Slotting.Slot (EpochSize (..), SlotNo (..))
2727
import Control.Exception (assert)
2828
import Control.Monad (replicateM)
29+
import qualified Control.Tracer as Tracer
2930
import qualified Data.Map.Strict as Map
3031
import Data.Maybe (maybeToList)
3132
import Data.Proxy (Proxy (..))
@@ -55,7 +56,7 @@ import Ouroboros.Consensus.Node.ProtocolInfo
5556
import Ouroboros.Consensus.NodeId
5657
import Ouroboros.Consensus.Protocol.PBFT
5758
import Ouroboros.Consensus.Protocol.Praos.AgentClient
58-
(KESAgentContext)
59+
(KESAgentClientTrace, KESAgentContext)
5960
import Ouroboros.Consensus.Shelley.HFEras ()
6061
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
6162
import Ouroboros.Consensus.Shelley.Node
@@ -458,7 +459,7 @@ mkProtocolCardanoAndHardForkTxs
458459
TestNodeInitialization
459460
{ tniCrucialTxs = crucialTxs
460461
, tniProtocolInfo = protocolInfo
461-
, tniBlockForging = blockForging
462+
, tniBlockForging = blockForging Tracer.nullTracer
462463
}
463464
where
464465
crucialTxs :: [GenTx (CardanoBlock c)]
@@ -477,7 +478,7 @@ mkProtocolCardanoAndHardForkTxs
477478
propPV
478479

479480
protocolInfo :: ProtocolInfo (CardanoBlock c)
480-
blockForging :: m [BlockForging m (CardanoBlock c)]
481+
blockForging :: Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (CardanoBlock c)]
481482
(setByronProtVer -> protocolInfo, blockForging) =
482483
mkTestProtocolInfo
483484
(coreNodeId, coreNodeShelley)

‎ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ import qualified Cardano.Ledger.Shelley.Core as SL
2222
import qualified Cardano.Protocol.TPraos.OCert as SL
2323
import Cardano.Slotting.Slot (EpochSize (..), SlotNo (..))
2424
import Control.Monad (replicateM)
25+
import Control.Tracer (nullTracer)
2526
import qualified Data.Map.Strict as Map
2627
import Data.Maybe (maybeToList)
2728
import Data.Proxy (Proxy (..))
@@ -259,7 +260,7 @@ prop_simple_allegraAlonzo_convergence TestSetup
259260
(SlotNo $ unNumSlots numSlots) -- never expire
260261
setupD -- unchanged
261262
, tniProtocolInfo = protocolInfo
262-
, tniBlockForging = blockForging
263+
, tniBlockForging = blockForging nullTracer
263264
}
264265
, mkRekeyM = Nothing
265266
}

‎ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ import qualified Cardano.Ledger.Shelley.Core as SL
2121
import qualified Cardano.Protocol.TPraos.OCert as SL
2222
import Cardano.Slotting.Slot (EpochSize (..), SlotNo (..))
2323
import Control.Monad (replicateM)
24+
import Control.Tracer (nullTracer)
2425
import qualified Data.Map.Strict as Map
2526
import Data.Maybe (maybeToList)
2627
import Data.Proxy (Proxy (..))
@@ -263,7 +264,7 @@ prop_simple_shelleyAllegra_convergence TestSetup
263264
(SlotNo $ unNumSlots numSlots) -- never expire
264265
setupD -- unchanged
265266
, tniProtocolInfo = protocolInfo
266-
, tniBlockForging = blockForging
267+
, tniBlockForging = blockForging nullTracer
267268
}
268269
, mkRekeyM = Nothing
269270
}

0 commit comments

Comments
 (0)