{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.ThreadNet.ShelleyAllegra (tests) where
import Cardano.Crypto.Hash (ShortHash)
import qualified Cardano.Ledger.Api.Transition as L
import qualified Cardano.Ledger.BaseTypes as SL
import qualified Cardano.Ledger.Shelley.Core as SL
import qualified Cardano.Protocol.TPraos.OCert as SL
import Cardano.Slotting.Slot (EpochSize (..), SlotNo (..))
import Control.Monad (replicateM)
import qualified Data.Map.Strict as Map
import Data.Maybe (maybeToList)
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.SOP.Strict (NP (..))
import Data.Word (Word64)
import Lens.Micro ((^.))
import Ouroboros.Consensus.BlockchainTime
import Ouroboros.Consensus.Cardano.Condense ()
import Ouroboros.Consensus.Cardano.Node (TriggerHardFork (..))
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
(isHardForkNodeToNodeEnabled)
import Ouroboros.Consensus.Ledger.SupportsMempool (extractTxs)
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.NodeId
import Ouroboros.Consensus.Protocol.TPraos (TPraos)
import Ouroboros.Consensus.Shelley.Eras
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import Ouroboros.Consensus.Shelley.Node
(ProtocolParamsShelleyBased (..), ShelleyGenesis (..))
import Test.Consensus.Shelley.MockCrypto (MockCrypto)
import Test.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck
import Test.ThreadNet.General
import qualified Test.ThreadNet.Infra.Shelley as Shelley
import Test.ThreadNet.Infra.ShelleyBasedHardFork
import Test.ThreadNet.Infra.TwoEras
import Test.ThreadNet.Network (NodeOutput (..),
TestNodeInitialization (..))
import Test.ThreadNet.TxGen
import Test.ThreadNet.TxGen.Allegra ()
import Test.ThreadNet.TxGen.Shelley
import Test.ThreadNet.Util.Expectations (NumBlocks (..))
import Test.ThreadNet.Util.NodeJoinPlan (trivialNodeJoinPlan)
import Test.ThreadNet.Util.NodeRestarts (noRestarts)
import Test.ThreadNet.Util.NodeToNodeVersion (genVersionFiltered)
import Test.ThreadNet.Util.Seed (runGen)
import qualified Test.Util.BoolProps as BoolProps
import Test.Util.HardFork.Future (EraSize (..), Future (..))
import Test.Util.Orphans.Arbitrary ()
import Test.Util.Slots (NumSlots (..))
import Test.Util.TestEnv
type Crypto = MockCrypto ShortHash
type ShelleyAllegraBlock =
ShelleyBasedHardForkBlock (TPraos Crypto) (ShelleyEra Crypto) (TPraos Crypto) (AllegraEra Crypto)
data TestSetup = TestSetup
{ TestSetup -> DecentralizationParam
setupD :: Shelley.DecentralizationParam
, TestSetup -> Bool
setupHardFork :: Bool
, TestSetup -> Nonce
setupInitialNonce :: SL.Nonce
, TestSetup -> SecurityParam
setupK :: SecurityParam
, TestSetup -> Partition
setupPartition :: Partition
, TestSetup -> SlotLength
setupSlotLength :: SlotLength
, TestSetup -> TestConfig
setupTestConfig :: TestConfig
, TestSetup
-> (NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock)
setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock)
}
deriving (Int -> TestSetup -> ShowS
[TestSetup] -> ShowS
TestSetup -> String
(Int -> TestSetup -> ShowS)
-> (TestSetup -> String)
-> ([TestSetup] -> ShowS)
-> Show TestSetup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestSetup -> ShowS
showsPrec :: Int -> TestSetup -> ShowS
$cshow :: TestSetup -> String
show :: TestSetup -> String
$cshowList :: [TestSetup] -> ShowS
showList :: [TestSetup] -> ShowS
Show)
instance Arbitrary TestSetup where
arbitrary :: Gen TestSetup
arbitrary = do
DecentralizationParam
setupD <- Gen DecentralizationParam
forall a. Arbitrary a => Gen a
arbitrary
Gen DecentralizationParam
-> (DecentralizationParam -> Bool) -> Gen DecentralizationParam
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` ((Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0) (Rational -> Bool)
-> (DecentralizationParam -> Rational)
-> DecentralizationParam
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecentralizationParam -> Rational
Shelley.decentralizationParamToRational)
SecurityParam
setupK <- Word64 -> SecurityParam
SecurityParam (Word64 -> SecurityParam) -> Gen Word64 -> Gen SecurityParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
8, Word64
10)
Nonce
setupInitialNonce <- Gen Nonce
genNonce
SlotLength
setupSlotLength <- Gen SlotLength
forall a. Arbitrary a => Gen a
arbitrary
let epochSize :: EpochSize
epochSize = Word64 -> EpochSize
EpochSize (Word64 -> EpochSize) -> Word64 -> EpochSize
forall a b. (a -> b) -> a -> b
$ SecurityParam -> Word64
shelleyEpochSize SecurityParam
setupK
TestConfig
setupTestConfig <- SecurityParam -> (EpochSize, EpochSize) -> Gen TestConfig
genTestConfig
SecurityParam
setupK
(EpochSize
epochSize, EpochSize
epochSize)
let TestConfig{NumCoreNodes
numCoreNodes :: NumCoreNodes
numCoreNodes :: TestConfig -> NumCoreNodes
numCoreNodes, NumSlots
numSlots :: NumSlots
numSlots :: TestConfig -> NumSlots
numSlots} = TestConfig
setupTestConfig
Bool
setupHardFork <- [(Int, Gen Bool)] -> Gen Bool
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
49, Bool -> Gen Bool
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True), (Int
1, Bool -> Gen Bool
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)]
Partition
setupPartition <- NumCoreNodes -> NumSlots -> SecurityParam -> Gen Partition
genPartition NumCoreNodes
numCoreNodes NumSlots
numSlots SecurityParam
setupK
(NodeToNodeVersion,
HardForkNodeToNodeVersion
'[ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto),
ShelleyBlock (TPraos Crypto) (AllegraEra Crypto)])
setupVersion <- (BlockNodeToNodeVersion ShelleyAllegraBlock -> Bool)
-> Proxy ShelleyAllegraBlock
-> Gen
(NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock)
forall blk.
SupportedNetworkProtocolVersion blk =>
(BlockNodeToNodeVersion blk -> Bool)
-> Proxy blk -> Gen (NodeToNodeVersion, BlockNodeToNodeVersion blk)
genVersionFiltered
BlockNodeToNodeVersion ShelleyAllegraBlock -> Bool
HardForkNodeToNodeVersion
'[ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto),
ShelleyBlock (TPraos Crypto) (AllegraEra Crypto)]
-> Bool
forall (xs :: [*]). HardForkNodeToNodeVersion xs -> Bool
isHardForkNodeToNodeEnabled
(forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ShelleyAllegraBlock)
TestSetup -> Gen TestSetup
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestSetup
{ DecentralizationParam
setupD :: DecentralizationParam
setupD :: DecentralizationParam
setupD
, Bool
setupHardFork :: Bool
setupHardFork :: Bool
setupHardFork
, Nonce
setupInitialNonce :: Nonce
setupInitialNonce :: Nonce
setupInitialNonce
, SecurityParam
setupK :: SecurityParam
setupK :: SecurityParam
setupK
, Partition
setupPartition :: Partition
setupPartition :: Partition
setupPartition
, SlotLength
setupSlotLength :: SlotLength
setupSlotLength :: SlotLength
setupSlotLength
, TestConfig
setupTestConfig :: TestConfig
setupTestConfig :: TestConfig
setupTestConfig
, (NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock)
(NodeToNodeVersion,
HardForkNodeToNodeVersion
'[ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto),
ShelleyBlock (TPraos Crypto) (AllegraEra Crypto)])
setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock)
setupVersion :: (NodeToNodeVersion,
HardForkNodeToNodeVersion
'[ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto),
ShelleyBlock (TPraos Crypto) (AllegraEra Crypto)])
setupVersion
}
tests :: TestTree
tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup String
"ShelleyAllegra ThreadNet" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
[ let name :: String
name = String
"simple convergence" in
(TestEnv -> TestTree) -> TestTree
askTestEnv ((TestEnv -> TestTree) -> TestTree)
-> (TestEnv -> TestTree) -> TestTree
forall a b. (a -> b) -> a -> b
$ TestTree -> TestEnv -> TestTree
adjustTestMode (TestTree -> TestEnv -> TestTree)
-> TestTree -> TestEnv -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> (TestSetup -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
name ((TestSetup -> Property) -> TestTree)
-> (TestSetup -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \TestSetup
setup ->
TestSetup -> Property
prop_simple_shelleyAllegra_convergence TestSetup
setup
]
where
adjustTestMode :: TestTree -> TestEnv -> TestTree
adjustTestMode :: TestTree -> TestEnv -> TestTree
adjustTestMode TestTree
tree = \case
TestEnv
Nightly -> TestTree
tree
TestEnv
_ -> (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10) TestTree
tree
prop_simple_shelleyAllegra_convergence :: TestSetup -> Property
prop_simple_shelleyAllegra_convergence :: TestSetup -> Property
prop_simple_shelleyAllegra_convergence TestSetup
{ DecentralizationParam
setupD :: TestSetup -> DecentralizationParam
setupD :: DecentralizationParam
setupD
, Bool
setupHardFork :: TestSetup -> Bool
setupHardFork :: Bool
setupHardFork
, Nonce
setupInitialNonce :: TestSetup -> Nonce
setupInitialNonce :: Nonce
setupInitialNonce
, SecurityParam
setupK :: TestSetup -> SecurityParam
setupK :: SecurityParam
setupK
, Partition
setupPartition :: TestSetup -> Partition
setupPartition :: Partition
setupPartition
, SlotLength
setupSlotLength :: TestSetup -> SlotLength
setupSlotLength :: SlotLength
setupSlotLength
, TestConfig
setupTestConfig :: TestSetup -> TestConfig
setupTestConfig :: TestConfig
setupTestConfig
, (NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock)
setupVersion :: TestSetup
-> (NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock)
setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock)
setupVersion
} =
PropGeneralArgs ShelleyAllegraBlock
-> TestOutput ShelleyAllegraBlock -> Property
forall blk.
(Condense blk, Condense (HeaderHash blk), Eq blk, RunNode blk) =>
PropGeneralArgs blk -> TestOutput blk -> Property
prop_general_semisync PropGeneralArgs ShelleyAllegraBlock
pga TestOutput ShelleyAllegraBlock
testOutput Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
TestOutput ShelleyAllegraBlock -> Property
forall blk. HasHeader blk => TestOutput blk -> Property
prop_inSync TestOutput ShelleyAllegraBlock
testOutput Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
ReachesEra2 -> Property
prop_ReachesEra2 ReachesEra2
reachesEra2 Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
Property
prop_noCPViolation Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
( String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"ReachesEra2 label" [ReachesEra2 -> String
label_ReachesEra2 ReachesEra2
reachesEra2] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"Observed forge during a non-overlay slot in the second era"
[ TestOutput ShelleyAllegraBlock -> Set SlotNo -> String
forall era (eras :: [*]).
TestOutput (HardForkBlock (era : eras)) -> Set SlotNo -> String
label_hadActiveNonOverlaySlots
TestOutput ShelleyAllegraBlock
testOutput
Set SlotNo
overlaySlots
] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
SecurityParam -> Partition -> Property -> Property
tabulatePartitionDuration SecurityParam
setupK Partition
setupPartition (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
SecurityParam -> NumBlocks -> String -> Property -> Property
tabulateFinalIntersectionDepth
SecurityParam
setupK
(Word64 -> NumBlocks
NumBlocks Word64
finalIntersectionDepth)
String
finalBlockEra (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
NumSlots -> Partition -> Bool -> Property -> Property
tabulatePartitionPosition
(Word64 -> NumSlots
NumSlots Word64
numFirstEraSlots)
Partition
setupPartition
(ReachesEra2 -> Bool
ledgerReachesEra2 ReachesEra2
reachesEra2) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
)
where
TestConfig
{ Seed
initSeed :: Seed
initSeed :: TestConfig -> Seed
initSeed
, NumCoreNodes
numCoreNodes :: TestConfig -> NumCoreNodes
numCoreNodes :: NumCoreNodes
numCoreNodes
, NumSlots
numSlots :: TestConfig -> NumSlots
numSlots :: NumSlots
numSlots
} = TestConfig
setupTestConfig
pga :: PropGeneralArgs ShelleyAllegraBlock
pga = PropGeneralArgs
{ pgaBlockProperty :: ShelleyAllegraBlock -> Property
pgaBlockProperty = Property -> ShelleyAllegraBlock -> Property
forall a b. a -> b -> a
const (Property -> ShelleyAllegraBlock -> Property)
-> Property -> ShelleyAllegraBlock -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
, pgaCountTxs :: ShelleyAllegraBlock -> Word64
pgaCountTxs = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64)
-> (ShelleyAllegraBlock -> Int) -> ShelleyAllegraBlock -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenTx ShelleyAllegraBlock] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([GenTx ShelleyAllegraBlock] -> Int)
-> (ShelleyAllegraBlock -> [GenTx ShelleyAllegraBlock])
-> ShelleyAllegraBlock
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyAllegraBlock -> [GenTx ShelleyAllegraBlock]
forall blk. HasTxs blk => blk -> [GenTx blk]
extractTxs
, pgaExpectedCannotForge :: SlotNo -> NodeId -> WrapCannotForge ShelleyAllegraBlock -> Bool
pgaExpectedCannotForge = SlotNo -> NodeId -> WrapCannotForge ShelleyAllegraBlock -> Bool
forall blk. SlotNo -> NodeId -> WrapCannotForge blk -> Bool
noExpectedCannotForges
, pgaFirstBlockNo :: BlockNo
pgaFirstBlockNo = BlockNo
0
, pgaFixedMaxForkLength :: Maybe NumBlocks
pgaFixedMaxForkLength = NumBlocks -> Maybe NumBlocks
forall a. a -> Maybe a
Just NumBlocks
maxForkLength
, pgaFixedSchedule :: Maybe LeaderSchedule
pgaFixedSchedule = Maybe LeaderSchedule
forall a. Maybe a
Nothing
, pgaSecurityParam :: SecurityParam
pgaSecurityParam = SecurityParam
setupK
, pgaTestConfig :: TestConfig
pgaTestConfig = TestConfig
setupTestConfig
, pgaTestConfigB :: TestConfigB ShelleyAllegraBlock
pgaTestConfigB = TestConfigB ShelleyAllegraBlock
testConfigB
}
txGenExtra :: ShelleyTxGenExtra (Blake2bPrefix 8)
txGenExtra = ShelleyTxGenExtra
{ stgeGenEnv :: GenEnv (ShelleyEra Crypto)
stgeGenEnv = WhetherToGeneratePPUs
-> [CoreNode Crypto] -> GenEnv (ShelleyEra Crypto)
forall h.
HashAlgorithm h =>
WhetherToGeneratePPUs
-> [CoreNode (MockCrypto h)] -> GenEnv (MockShelley h)
mkGenEnv WhetherToGeneratePPUs
DoNotGeneratePPUs [CoreNode Crypto]
coreNodes
, stgeStartAt :: SlotNo
stgeStartAt = Word64 -> SlotNo
SlotNo Word64
1
}
testConfigB :: TestConfigB ShelleyAllegraBlock
testConfigB = TestConfigB
{ forgeEbbEnv :: Maybe (ForgeEbbEnv ShelleyAllegraBlock)
forgeEbbEnv = Maybe (ForgeEbbEnv ShelleyAllegraBlock)
forall a. Maybe a
Nothing
, future :: Future
future =
if Bool
setupHardFork
then
SlotLength -> EpochSize -> EraSize -> Future -> Future
EraCons SlotLength
setupSlotLength EpochSize
epochSize EraSize
firstEraSize (Future -> Future) -> Future -> Future
forall a b. (a -> b) -> a -> b
$
SlotLength -> EpochSize -> Future
EraFinal SlotLength
setupSlotLength EpochSize
epochSize
else
SlotLength -> EpochSize -> Future
EraFinal SlotLength
setupSlotLength EpochSize
epochSize
, messageDelay :: CalcMessageDelay ShelleyAllegraBlock
messageDelay = Partition -> CalcMessageDelay ShelleyAllegraBlock
forall blk. Partition -> CalcMessageDelay blk
mkMessageDelay Partition
setupPartition
, nodeJoinPlan :: NodeJoinPlan
nodeJoinPlan = NumCoreNodes -> NodeJoinPlan
trivialNodeJoinPlan NumCoreNodes
numCoreNodes
, nodeRestarts :: NodeRestarts
nodeRestarts = NodeRestarts
noRestarts
, txGenExtra :: TxGenExtra ShelleyAllegraBlock
txGenExtra = TxGenExtra (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> WrapTxGenExtra
(ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
forall blk. TxGenExtra blk -> WrapTxGenExtra blk
WrapTxGenExtra ShelleyTxGenExtra (Blake2bPrefix 8)
TxGenExtra (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
txGenExtra WrapTxGenExtra (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> NP
WrapTxGenExtra '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto)]
-> NP
WrapTxGenExtra
'[ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto),
ShelleyBlock (TPraos Crypto) (AllegraEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* TxGenExtra (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> WrapTxGenExtra
(ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
forall blk. TxGenExtra blk -> WrapTxGenExtra blk
WrapTxGenExtra () WrapTxGenExtra (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> NP WrapTxGenExtra '[]
-> NP
WrapTxGenExtra '[ShelleyBlock (TPraos Crypto) (AllegraEra Crypto)]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP WrapTxGenExtra '[]
forall {k} (f :: k -> *). NP f '[]
Nil
, version :: (NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock)
version = (NodeToNodeVersion, BlockNodeToNodeVersion ShelleyAllegraBlock)
setupVersion
}
testOutput :: TestOutput ShelleyAllegraBlock
testOutput :: TestOutput ShelleyAllegraBlock
testOutput = TestConfig
-> TestConfigB ShelleyAllegraBlock
-> (forall (m :: * -> *).
IOLike m =>
TestConfigMB m ShelleyAllegraBlock)
-> TestOutput ShelleyAllegraBlock
forall blk.
(RunNode blk, TxGen blk, TracingConstraints blk, HasCallStack) =>
TestConfig
-> TestConfigB blk
-> (forall (m :: * -> *). IOLike m => TestConfigMB m blk)
-> TestOutput blk
runTestNetwork TestConfig
setupTestConfig TestConfigB ShelleyAllegraBlock
testConfigB TestConfigMB {
nodeInfo :: CoreNodeId -> TestNodeInitialization m ShelleyAllegraBlock
nodeInfo = \(CoreNodeId Word64
nid) ->
let protocolParamsShelleyBased :: ProtocolParamsShelleyBased Crypto
protocolParamsShelleyBased =
ProtocolParamsShelleyBased {
shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce = Nonce
setupInitialNonce
, shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials Crypto]
shelleyBasedLeaderCredentials =
[CoreNode Crypto -> ShelleyLeaderCredentials Crypto
forall c. PraosCrypto c => CoreNode c -> ShelleyLeaderCredentials c
Shelley.mkLeaderCredentials
([CoreNode Crypto]
coreNodes [CoreNode Crypto] -> Int -> CoreNode Crypto
forall a. HasCallStack => [a] -> Int -> a
!! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nid)]
}
hardForkTrigger :: TriggerHardFork
hardForkTrigger =
Word16 -> TriggerHardFork
TriggerHardForkAtVersion (Word16 -> TriggerHardFork) -> Word16 -> TriggerHardFork
forall a b. (a -> b) -> a -> b
$ Version -> Word16
forall i. Integral i => Version -> i
SL.getVersion Version
majorVersion2
(ProtocolInfo ShelleyAllegraBlock
protocolInfo, m [BlockForging m ShelleyAllegraBlock]
blockForging) =
ProtocolParamsShelleyBased (EraCrypto (ShelleyEra Crypto))
-> ProtVer
-> ProtVer
-> TransitionConfig (AllegraEra Crypto)
-> TriggerHardFork
-> (ProtocolInfo ShelleyAllegraBlock,
m [BlockForging m ShelleyAllegraBlock])
forall (m :: * -> *) proto1 era1 proto2 era2.
(IOLike m,
ShelleyBasedHardForkConstraints proto1 era1 proto2 era2) =>
ProtocolParamsShelleyBased (EraCrypto era1)
-> ProtVer
-> ProtVer
-> TransitionConfig era2
-> TriggerHardFork
-> (ProtocolInfo
(ShelleyBasedHardForkBlock proto1 era1 proto2 era2),
m [BlockForging
m (ShelleyBasedHardForkBlock proto1 era1 proto2 era2)])
protocolInfoShelleyBasedHardFork
ProtocolParamsShelleyBased (EraCrypto (ShelleyEra Crypto))
ProtocolParamsShelleyBased Crypto
protocolParamsShelleyBased
(Version -> Natural -> ProtVer
SL.ProtVer Version
majorVersion1 Natural
0)
(Version -> Natural -> ProtVer
SL.ProtVer Version
majorVersion2 Natural
0)
( TranslationContext (AllegraEra Crypto)
-> TransitionConfig (PreviousEra (AllegraEra Crypto))
-> TransitionConfig (AllegraEra Crypto)
forall era.
EraTransition era =>
TranslationContext era
-> TransitionConfig (PreviousEra era) -> TransitionConfig era
L.mkTransitionConfig TranslationContext (AllegraEra Crypto)
NoGenesis (AllegraEra Crypto)
forall era. NoGenesis era
L.NoGenesis
(TransitionConfig (PreviousEra (AllegraEra Crypto))
-> TransitionConfig (AllegraEra Crypto))
-> TransitionConfig (PreviousEra (AllegraEra Crypto))
-> TransitionConfig (AllegraEra Crypto)
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis Crypto -> TransitionConfig (ShelleyEra Crypto)
forall c. ShelleyGenesis c -> TransitionConfig (ShelleyEra c)
L.mkShelleyTransitionConfig ShelleyGenesis Crypto
genesisShelley
)
TriggerHardFork
hardForkTrigger
in
TestNodeInitialization {
tniCrucialTxs :: [GenTx ShelleyAllegraBlock]
tniCrucialTxs =
if Bool -> Bool
not Bool
setupHardFork then [] else
(GenTx (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> GenTx ShelleyAllegraBlock)
-> [GenTx (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))]
-> [GenTx ShelleyAllegraBlock]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenTx (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> GenTx ShelleyAllegraBlock
forall proto1 era1 proto2 era2.
GenTx (ShelleyBlock proto1 era1)
-> ShelleyBasedHardForkGenTx proto1 era1 proto2 era2
GenTxShelley1 ([GenTx (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))]
-> [GenTx ShelleyAllegraBlock])
-> [GenTx (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))]
-> [GenTx ShelleyAllegraBlock]
forall a b. (a -> b) -> a -> b
$
[CoreNode Crypto]
-> ProtVer
-> SlotNo
-> DecentralizationParam
-> [GenTx (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))]
forall c.
ShelleyBasedEra (ShelleyEra c) =>
[CoreNode c]
-> ProtVer
-> SlotNo
-> DecentralizationParam
-> [GenTx (ShelleyBlock (TPraos c) (ShelleyEra c))]
Shelley.mkSetDecentralizationParamTxs
[CoreNode Crypto]
coreNodes
(Version -> Natural -> ProtVer
SL.ProtVer Version
majorVersion2 Natural
0)
(Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ NumSlots -> Word64
unNumSlots NumSlots
numSlots)
DecentralizationParam
setupD
, tniProtocolInfo :: ProtocolInfo ShelleyAllegraBlock
tniProtocolInfo = ProtocolInfo ShelleyAllegraBlock
protocolInfo
, tniBlockForging :: m [BlockForging m ShelleyAllegraBlock]
tniBlockForging = m [BlockForging m ShelleyAllegraBlock]
blockForging
}
, mkRekeyM :: Maybe (m (RekeyM m ShelleyAllegraBlock))
mkRekeyM = Maybe (m (RekeyM m ShelleyAllegraBlock))
forall a. Maybe a
Nothing
}
maxForkLength :: NumBlocks
maxForkLength :: NumBlocks
maxForkLength = Word64 -> NumBlocks
NumBlocks (Word64 -> NumBlocks) -> Word64 -> NumBlocks
forall a b. (a -> b) -> a -> b
$ SecurityParam -> Word64
maxRollbacks SecurityParam
setupK
initialKESPeriod :: SL.KESPeriod
initialKESPeriod :: KESPeriod
initialKESPeriod = Word -> KESPeriod
SL.KESPeriod Word
0
coreNodes :: [Shelley.CoreNode Crypto]
coreNodes :: [CoreNode Crypto]
coreNodes = Seed -> Gen [CoreNode Crypto] -> [CoreNode Crypto]
forall a. Seed -> Gen a -> a
runGen Seed
initSeed (Gen [CoreNode Crypto] -> [CoreNode Crypto])
-> Gen [CoreNode Crypto] -> [CoreNode Crypto]
forall a b. (a -> b) -> a -> b
$
Int -> Gen (CoreNode Crypto) -> Gen [CoreNode Crypto]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) (Gen (CoreNode Crypto) -> Gen [CoreNode Crypto])
-> Gen (CoreNode Crypto) -> Gen [CoreNode Crypto]
forall a b. (a -> b) -> a -> b
$
KESPeriod -> Gen (CoreNode Crypto)
forall c. PraosCrypto c => KESPeriod -> Gen (CoreNode c)
Shelley.genCoreNode KESPeriod
initialKESPeriod
where
NumCoreNodes Word64
n = NumCoreNodes
numCoreNodes
maxLovelaceSupply :: Word64
maxLovelaceSupply :: Word64
maxLovelaceSupply =
Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CoreNode Crypto] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CoreNode Crypto]
coreNodes) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
Shelley.initialLovelacePerCoreNode
genesisShelley :: ShelleyGenesis Crypto
genesisShelley :: ShelleyGenesis Crypto
genesisShelley =
ProtVer
-> SecurityParam
-> Rational
-> DecentralizationParam
-> Word64
-> SlotLength
-> KesConfig
-> [CoreNode Crypto]
-> ShelleyGenesis Crypto
forall c.
PraosCrypto c =>
ProtVer
-> SecurityParam
-> Rational
-> DecentralizationParam
-> Word64
-> SlotLength
-> KesConfig
-> [CoreNode c]
-> ShelleyGenesis c
Shelley.mkGenesisConfig
(Version -> Natural -> ProtVer
SL.ProtVer Version
majorVersion1 Natural
0)
SecurityParam
setupK
Rational
activeSlotCoeff
DecentralizationParam
setupD
Word64
maxLovelaceSupply
SlotLength
setupSlotLength
(Proxy Crypto -> NumSlots -> KesConfig
forall (proxy :: * -> *) c.
Crypto c =>
proxy c -> NumSlots -> KesConfig
Shelley.mkKesConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Crypto) NumSlots
numSlots)
[CoreNode Crypto]
coreNodes
epochSize :: EpochSize
epochSize :: EpochSize
epochSize = ShelleyGenesis Crypto -> EpochSize
forall c. ShelleyGenesis c -> EpochSize
sgEpochLength ShelleyGenesis Crypto
genesisShelley
firstEraSize :: EraSize
firstEraSize :: EraSize
firstEraSize = Word64 -> EraSize
EraSize Word64
forall a. Num a => a
numFirstEraEpochs
reachesEra2 :: ReachesEra2
reachesEra2 :: ReachesEra2
reachesEra2 = ReachesEra2
{ rsEra1Slots :: Prereq
rsEra1Slots =
Bool -> Prereq
BoolProps.enabledIf (Bool -> Prereq) -> Bool -> Prereq
forall a b. (a -> b) -> a -> b
$ Word64
t Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
numFirstEraSlots
, rsPV :: Prereq
rsPV = Bool -> Prereq
BoolProps.enabledIf Bool
setupHardFork
, rsEra2Blocks :: Bool
rsEra2Blocks =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$
[ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ShelleyAllegraBlock -> Bool
forall era (eras :: [*]). HardForkBlock (era : eras) -> Bool
isFirstEraBlock ShelleyAllegraBlock
blk
| (NodeId
_nid, NodeOutput ShelleyAllegraBlock
no) <- Map NodeId (NodeOutput ShelleyAllegraBlock)
-> [(NodeId, NodeOutput ShelleyAllegraBlock)]
forall k a. Map k a -> [(k, a)]
Map.toList Map NodeId (NodeOutput ShelleyAllegraBlock)
testOutputNodes
, let NodeOutput{Map SlotNo ShelleyAllegraBlock
nodeOutputForges :: Map SlotNo ShelleyAllegraBlock
nodeOutputForges :: forall blk. NodeOutput blk -> Map SlotNo blk
nodeOutputForges} = NodeOutput ShelleyAllegraBlock
no
, (ShelleyAllegraBlock
blk, Map SlotNo ShelleyAllegraBlock
_m) <- Maybe (ShelleyAllegraBlock, Map SlotNo ShelleyAllegraBlock)
-> [(ShelleyAllegraBlock, Map SlotNo ShelleyAllegraBlock)]
forall a. Maybe a -> [a]
maybeToList (Maybe (ShelleyAllegraBlock, Map SlotNo ShelleyAllegraBlock)
-> [(ShelleyAllegraBlock, Map SlotNo ShelleyAllegraBlock)])
-> Maybe (ShelleyAllegraBlock, Map SlotNo ShelleyAllegraBlock)
-> [(ShelleyAllegraBlock, Map SlotNo ShelleyAllegraBlock)]
forall a b. (a -> b) -> a -> b
$ Map SlotNo ShelleyAllegraBlock
-> Maybe (ShelleyAllegraBlock, Map SlotNo ShelleyAllegraBlock)
forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map SlotNo ShelleyAllegraBlock
nodeOutputForges
]
, rsEra2Slots :: Requirement
rsEra2Slots =
Bool -> Requirement
BoolProps.requiredIf (Bool -> Requirement) -> Bool -> Requirement
forall a b. (a -> b) -> a -> b
$
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set SlotNo -> Bool
forall a. Set a -> Bool
Set.null Set SlotNo
overlaySlots
}
where
NumSlots Word64
t = NumSlots
numSlots
TestOutput{Map NodeId (NodeOutput ShelleyAllegraBlock)
testOutputNodes :: Map NodeId (NodeOutput ShelleyAllegraBlock)
testOutputNodes :: forall blk. TestOutput blk -> Map NodeId (NodeOutput blk)
testOutputNodes} = TestOutput ShelleyAllegraBlock
testOutput
overlaySlots :: Set SlotNo
overlaySlots :: Set SlotNo
overlaySlots =
NumSlots -> NumSlots -> UnitInterval -> EpochSize -> Set SlotNo
secondEraOverlaySlots
NumSlots
numSlots
(Word64 -> NumSlots
NumSlots Word64
numFirstEraSlots)
(ShelleyGenesis Crypto -> PParams (ShelleyEra Crypto)
forall c. ShelleyGenesis c -> PParams (ShelleyEra c)
sgProtocolParams ShelleyGenesis Crypto
genesisShelley PParams (ShelleyEra Crypto)
-> Getting UnitInterval (PParams (ShelleyEra Crypto)) UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval (PParams (ShelleyEra Crypto)) UnitInterval
forall era.
EraPParams era =>
SimpleGetter (PParams era) UnitInterval
SimpleGetter (PParams (ShelleyEra Crypto)) UnitInterval
SL.ppDG)
EpochSize
epochSize
numFirstEraSlots :: Word64
numFirstEraSlots :: Word64
numFirstEraSlots =
Word64
forall a. Num a => a
numFirstEraEpochs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* EpochSize -> Word64
unEpochSize EpochSize
epochSize
finalBlockEra :: String
finalBlockEra :: String
finalBlockEra =
if ReachesEra2 -> Bool
rsEra2Blocks ReachesEra2
reachesEra2
then String
"Allegra"
else String
"Shelley"
finalIntersectionDepth :: Word64
finalIntersectionDepth :: Word64
finalIntersectionDepth = Word64
depth
where
NumBlocks Word64
depth = PropGeneralArgs ShelleyAllegraBlock
-> TestOutput ShelleyAllegraBlock -> NumBlocks
forall blk.
HasHeader blk =>
PropGeneralArgs blk -> TestOutput blk -> NumBlocks
calcFinalIntersectionDepth PropGeneralArgs ShelleyAllegraBlock
pga TestOutput ShelleyAllegraBlock
testOutput
prop_noCPViolation :: Property
prop_noCPViolation :: Property
prop_noCPViolation =
String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
( String
"finalChains: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
Map NodeId (Chain ShelleyAllegraBlock) -> String
forall a. Show a => a -> String
show (NodeOutput ShelleyAllegraBlock -> Chain ShelleyAllegraBlock
forall blk. NodeOutput blk -> Chain blk
nodeOutputFinalChain (NodeOutput ShelleyAllegraBlock -> Chain ShelleyAllegraBlock)
-> Map NodeId (NodeOutput ShelleyAllegraBlock)
-> Map NodeId (Chain ShelleyAllegraBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestOutput ShelleyAllegraBlock
-> Map NodeId (NodeOutput ShelleyAllegraBlock)
forall blk. TestOutput blk -> Map NodeId (NodeOutput blk)
testOutputNodes TestOutput ShelleyAllegraBlock
testOutput)
) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"CP violation in final chains!" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ SecurityParam -> Word64
maxRollbacks SecurityParam
setupK Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
finalIntersectionDepth
majorVersion1 :: SL.Version
majorVersion1 :: Version
majorVersion1 = forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
SL.natVersion @1
majorVersion2 :: SL.Version
majorVersion2 :: Version
majorVersion2 = forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
SL.natVersion @2