Skip to content

Commit 76434e0

Browse files
geo2ageo2a
committed
ThreadNet: refactor TestSetup in era-crossing tests
- move `TestSetup` to an existing shared module - abstract `TestSetup` over the protocol - abstract `protocolInfoShelleyBasedHardFork` - minimise syntactic differences
1 parent b33bfb4 commit 76434e0

File tree

6 files changed

+202
-300
lines changed

6 files changed

+202
-300
lines changed

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

Lines changed: 35 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,6 @@
88
{-# LANGUAGE InstanceSigs #-}
99
{-# LANGUAGE LambdaCase #-}
1010
{-# LANGUAGE MultiParamTypeClasses #-}
11-
{-# LANGUAGE NamedFieldPuns #-}
1211
{-# LANGUAGE PatternSynonyms #-}
1312
{-# LANGUAGE RankNTypes #-}
1413
{-# LANGUAGE ScopedTypeVariables #-}
@@ -193,7 +192,6 @@ type ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 =
193192
, -- At the moment, fix the protocols together
194193
ProtoCrypto proto1 ~ ProtoCrypto proto2
195194
, PraosCrypto (ProtoCrypto proto1)
196-
, proto1 ~ TPraos (ProtoCrypto proto1)
197195
, proto1 ~ proto2
198196
, MemPack (TxOut (LedgerState (ShelleyBlock proto1 era1)))
199197
, MemPack (TxOut (LedgerState (ShelleyBlock proto2 era2)))
@@ -237,19 +235,19 @@ instance
237235

238236
hardForkEraTranslation =
239237
EraTranslation
240-
{ translateLedgerState = PCons translateLedgerState PNil
241-
, translateLedgerTables = PCons translateLedgerTables PNil
238+
{ translateLedgerState = PCons translateLedgerStateInstance PNil
239+
, translateLedgerTables = PCons translateLedgerTablesInstance PNil
242240
, translateChainDepState = PCons translateChainDepStateAcrossShelley PNil
243241
, crossEraForecast = PCons crossEraForecastAcrossShelley PNil
244242
}
245243
where
246-
translateLedgerState ::
244+
translateLedgerStateInstance ::
247245
InPairs.RequiringBoth
248246
WrapLedgerConfig
249247
TranslateLedgerState
250248
(ShelleyBlock proto1 era1)
251249
(ShelleyBlock proto2 era2)
252-
translateLedgerState =
250+
translateLedgerStateInstance =
253251
InPairs.RequireBoth $
254252
\_cfg1 cfg2 ->
255253
HFC.TranslateLedgerState
@@ -263,11 +261,11 @@ instance
263261
. Flip
264262
}
265263

266-
translateLedgerTables ::
264+
translateLedgerTablesInstance ::
267265
TranslateLedgerTables
268266
(ShelleyBlock proto1 era1)
269267
(ShelleyBlock proto2 era2)
270-
translateLedgerTables =
268+
translateLedgerTablesInstance =
271269
HFC.TranslateLedgerTables
272270
{ translateTxInWith = coerce
273271
, translateTxOutWith = SL.upgradeTxOut
@@ -390,7 +388,23 @@ protocolInfoShelleyBasedHardFork ::
390388
( KESAgentContext (ProtoCrypto proto2) m
391389
, ShelleyBasedHardForkConstraints proto1 era1 proto2 era2
392390
) =>
391+
( ProtocolParamsShelleyBased (ProtoCrypto proto1) ->
392+
L.TransitionConfig era1 ->
393+
SL.ProtVer ->
394+
( ProtocolInfo (ShelleyBlock proto1 era1)
395+
, Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m (ShelleyBlock proto1 era1)]
396+
)
397+
) ->
398+
( ProtocolParamsShelleyBased (ProtoCrypto proto2) ->
399+
L.TransitionConfig era2 ->
400+
SL.ProtVer ->
401+
( ProtocolInfo (ShelleyBlock proto2 era2)
402+
, Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m (ShelleyBlock proto2 era2)]
403+
)
404+
) ->
393405
ProtocolParamsShelleyBased (ProtoCrypto proto1) ->
406+
(ConsensusConfig proto1 -> PartialConsensusConfig proto1) ->
407+
(ConsensusConfig proto2 -> PartialConsensusConfig proto2) ->
394408
SL.ProtVer ->
395409
SL.ProtVer ->
396410
L.TransitionConfig era2 ->
@@ -400,7 +414,11 @@ protocolInfoShelleyBasedHardFork ::
400414
m [MkBlockForging m (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)]
401415
)
402416
protocolInfoShelleyBasedHardFork
417+
protocolInfoProtoShelleyBased1 -- TODO(geo2a): come up with a better name for this argument
418+
protocolInfoProtoShelleyBased2
403419
protocolParamsShelleyBased
420+
toPartialConsensusConfig1
421+
toPartialConsensusConfig2
404422
protVer1
405423
protVer2
406424
transCfg2
@@ -410,20 +428,15 @@ protocolInfoShelleyBasedHardFork
410428
protocolInfo1
411429
blockForging1
412430
eraParams1
413-
tpraosParams
431+
toPartialConsensusConfig1
414432
toPartialLedgerConfig1
415433
-- Era 2
416434
protocolInfo2
417435
blockForging2
418436
eraParams2
419-
tpraosParams
437+
toPartialConsensusConfig2
420438
toPartialLedgerConfig2
421439
where
422-
ProtocolParamsShelleyBased
423-
{ shelleyBasedInitialNonce
424-
, shelleyBasedLeaderCredentials
425-
} = protocolParamsShelleyBased
426-
427440
-- Era 1
428441

429442
genesis :: SL.ShelleyGenesis
@@ -433,7 +446,7 @@ protocolInfoShelleyBasedHardFork
433446
blockForging1 ::
434447
Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m (ShelleyBlock proto1 era1)]
435448
(protocolInfo1, blockForging1) =
436-
protocolInfoTPraosShelleyBased
449+
protocolInfoProtoShelleyBased1
437450
protocolParamsShelleyBased
438451
(transCfg2 ^. L.tcPreviousEraConfigL)
439452
protVer1
@@ -444,9 +457,9 @@ protocolInfoShelleyBasedHardFork
444457
toPartialLedgerConfig1 ::
445458
LedgerConfig (ShelleyBlock proto1 era1) ->
446459
PartialLedgerConfig (ShelleyBlock proto1 era1)
447-
toPartialLedgerConfig1 cfg =
460+
toPartialLedgerConfig1 cfg1 =
448461
ShelleyPartialLedgerConfig
449-
{ shelleyLedgerConfig = cfg
462+
{ shelleyLedgerConfig = cfg1
450463
, shelleyTriggerHardFork = hardForkTrigger
451464
}
452465

@@ -456,11 +469,8 @@ protocolInfoShelleyBasedHardFork
456469
blockForging2 ::
457470
Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m (ShelleyBlock proto2 era2)]
458471
(protocolInfo2, blockForging2) =
459-
protocolInfoTPraosShelleyBased
460-
ProtocolParamsShelleyBased
461-
{ shelleyBasedInitialNonce
462-
, shelleyBasedLeaderCredentials
463-
}
472+
protocolInfoProtoShelleyBased2
473+
protocolParamsShelleyBased
464474
transCfg2
465475
protVer2
466476

@@ -470,9 +480,9 @@ protocolInfoShelleyBasedHardFork
470480
toPartialLedgerConfig2 ::
471481
LedgerConfig (ShelleyBlock proto2 era2) ->
472482
PartialLedgerConfig (ShelleyBlock proto2 era2)
473-
toPartialLedgerConfig2 cfg =
483+
toPartialLedgerConfig2 cfg2 =
474484
ShelleyPartialLedgerConfig
475-
{ shelleyLedgerConfig = cfg
485+
{ shelleyLedgerConfig = cfg2
476486
, shelleyTriggerHardFork = TriggerHardForkNotDuringThisExecution
477487
}
478488

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

Lines changed: 119 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,33 @@
11
{-# LANGUAGE DataKinds #-}
22
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE GADTs #-}
45
{-# LANGUAGE LambdaCase #-}
56
{-# LANGUAGE MultiWayIf #-}
67
{-# LANGUAGE NamedFieldPuns #-}
8+
{-# LANGUAGE ScopedTypeVariables #-}
9+
{-# LANGUAGE StandaloneDeriving #-}
10+
{-# LANGUAGE TypeApplications #-}
711
{-# LANGUAGE TypeOperators #-}
12+
{-# LANGUAGE UndecidableInstances #-}
813

914
-- | Definitions used in ThreadNet tests that involve two eras.
1015
module Test.ThreadNet.Infra.TwoEras
11-
( -- * Generators
12-
Partition (..)
16+
( -- * Common infrastructure used in the ThreadNet tests that perform an era crossing
17+
18+
-- ** A hard-fork block for two eras
19+
DualBlock
20+
21+
-- ** The varying data of the tests crossing between Shelley-based eras
22+
, TestSetup (..)
23+
24+
-- ** Generators
25+
, Partition (..)
1326
, genNonce
1427
, genPartition
1528
, genTestConfig
1629

17-
-- * Era inspection
30+
-- ** Era inspection
1831
, ReachesEra2 (..)
1932
, activeSlotCoeff
2033
, isFirstEraBlock
@@ -25,7 +38,7 @@ module Test.ThreadNet.Infra.TwoEras
2538
, secondEraOverlaySlots
2639
, shelleyEpochSize
2740

28-
-- * Properties
41+
-- ** Properties
2942
, label_ReachesEra2
3043
, label_hadActiveNonOverlaySlots
3144
, prop_ReachesEra2
@@ -37,42 +50,138 @@ module Test.ThreadNet.Infra.TwoEras
3750
import qualified Cardano.Chain.Common as CC.Common
3851
import Cardano.Chain.ProtocolConstants (kEpochSlots)
3952
import Cardano.Chain.Slotting (unEpochSlots)
40-
import Cardano.Ledger.BaseTypes (unNonZero)
53+
import Cardano.Ledger.BaseTypes (nonZero, unNonZero)
4154
import qualified Cardano.Ledger.BaseTypes as SL
4255
import qualified Cardano.Protocol.TPraos.Rules.Overlay as SL
4356
import Cardano.Slotting.EpochInfo
44-
import Cardano.Slotting.Slot
45-
( EpochNo (..)
46-
, EpochSize (..)
47-
, SlotNo (..)
48-
)
57+
import Cardano.Slotting.Slot (EpochNo (..), EpochSize (..), SlotNo (..))
4958
import Control.Exception (assert)
5059
import Data.Functor ((<&>))
5160
import qualified Data.Map.Strict as Map
5261
import Data.Maybe (isJust)
62+
import Data.Proxy (Proxy (..))
5363
import Data.SOP.Strict (NS (..))
5464
import Data.Set (Set)
5565
import qualified Data.Set as Set
5666
import Data.Word (Word64)
5767
import GHC.Generics (Generic)
68+
import Ouroboros.Consensus.BlockchainTime
69+
import Ouroboros.Consensus.Cardano.Condense ()
5870
import Ouroboros.Consensus.Config.SecurityParam
5971
import Ouroboros.Consensus.HardFork.Combinator
6072
( HardForkBlock (..)
6173
, OneEraBlock (..)
6274
)
75+
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
76+
( isHardForkNodeToNodeEnabled
77+
)
6378
import qualified Ouroboros.Consensus.HardFork.History.Util as Util
79+
import Ouroboros.Consensus.Node.NetworkProtocolVersion
6480
import Ouroboros.Consensus.Node.ProtocolInfo
6581
import Ouroboros.Consensus.NodeId
82+
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
83+
import Test.Consensus.Shelley.MockCrypto (MockCrypto)
6684
import Test.QuickCheck
6785
import Test.ThreadNet.General
6886
import qualified Test.ThreadNet.Infra.Shelley as Shelley
87+
import Test.ThreadNet.Infra.ShelleyBasedHardFork
6988
import Test.ThreadNet.Network (CalcMessageDelay (..), NodeOutput (..))
89+
import Test.ThreadNet.TxGen.Allegra ()
7090
import Test.ThreadNet.Util.Expectations (NumBlocks (..))
91+
import Test.ThreadNet.Util.NodeToNodeVersion (genVersionFiltered)
7192
import qualified Test.ThreadNet.Util.NodeTopology as Topo
7293
import qualified Test.Util.BoolProps as BoolProps
7394
import Test.Util.Orphans.Arbitrary ()
7495
import Test.Util.Slots (NumSlots (..))
7596

97+
{-------------------------------------------------------------------------------
98+
Block Type
99+
-------------------------------------------------------------------------------}
100+
101+
-- | A hard-fork block for two Shelley-based eras
102+
type DualBlock proto era1 era2 =
103+
ShelleyBasedHardForkBlock (proto MockCrypto) era1 (proto MockCrypto) era2
104+
105+
{-------------------------------------------------------------------------------
106+
Test Setup
107+
-------------------------------------------------------------------------------}
108+
109+
-- | The varying data of the tests crossing between Shelley-based eras
110+
--
111+
-- Note: The Shelley nodes in this test all join, propose an update, and endorse
112+
-- it literally as soon as possible. Therefore, if the test reaches the end of
113+
-- the first epoch, the proposal will be adopted.
114+
data TestSetup proto era1 era2 = TestSetup
115+
{ setupD :: Shelley.DecentralizationParam
116+
, setupHardFork :: Bool
117+
-- ^ whether the proposal should trigger a hard fork or not
118+
, setupInitialNonce :: SL.Nonce
119+
-- ^ the initial Shelley 'SL.ticknStateEpochNonce'
120+
--
121+
-- We vary it to ensure we explore different leader schedules.
122+
, setupK :: SecurityParam
123+
, setupPartition :: Partition
124+
, setupSlotLength :: SlotLength
125+
, setupTestConfig :: TestConfig
126+
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion (DualBlock proto era1 era2))
127+
}
128+
129+
deriving instance Show (TestSetup proto era1 era2)
130+
131+
instance
132+
SupportedNetworkProtocolVersion (DualBlock proto era1 era2) =>
133+
Arbitrary (TestSetup proto era1 era2)
134+
where
135+
arbitrary = do
136+
setupD <-
137+
arbitrary
138+
-- The decentralization parameter cannot be 0 in the first
139+
-- Shelley epoch, since stake pools can only be created and
140+
-- delegated to via Shelley transactions.
141+
`suchThat` ((/= 0) . Shelley.decentralizationParamToRational)
142+
setupK <- SecurityParam <$> choose (8, 10) `suchThatMap` nonZero
143+
-- If k < 8, common prefix violations become too likely in
144+
-- Praos mode for thin overlay schedules (ie low d), even for
145+
-- f=0.2.
146+
147+
setupInitialNonce <- genNonce
148+
149+
setupSlotLength <- arbitrary
150+
151+
let epochSize = EpochSize $ shelleyEpochSize setupK
152+
setupTestConfig <-
153+
genTestConfig
154+
setupK
155+
(epochSize, epochSize)
156+
let TestConfig{numCoreNodes, numSlots} = setupTestConfig
157+
158+
setupHardFork <- frequency [(49, pure True), (1, pure False)]
159+
160+
-- TODO How reliable is the Byron-based partition duration logic when
161+
-- reused for Shelley?
162+
setupPartition <- genPartition numCoreNodes numSlots setupK
163+
164+
setupVersion <-
165+
genVersionFiltered
166+
isHardForkNodeToNodeEnabled
167+
(Proxy @(DualBlock proto era1 era2))
168+
169+
pure
170+
TestSetup
171+
{ setupD
172+
, setupHardFork
173+
, setupInitialNonce
174+
, setupK
175+
, setupPartition
176+
, setupSlotLength
177+
, setupTestConfig
178+
, setupVersion
179+
}
180+
181+
{-------------------------------------------------------------------------------
182+
Network Partitions
183+
-------------------------------------------------------------------------------}
184+
76185
-- | When and for how long the nodes are partitioned
77186
--
78187
-- The nodes are divided via message delays into two sub-networks by the parity

0 commit comments

Comments
 (0)