{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
module Test.ThreadNet.Shelley (tests) where
import Cardano.Ledger.BaseTypes (nonZero)
import qualified Cardano.Ledger.BaseTypes as SL
( UnitInterval
, mkNonceFromNumber
, shelleyProtVer
, unboundRational
)
import Cardano.Ledger.Shelley (ShelleyEra)
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.Core as SL
import qualified Cardano.Ledger.Shelley.Translation as SL
( toFromByronTranslationContext
)
import qualified Cardano.Protocol.TPraos.OCert as SL
import Cardano.Slotting.EpochInfo (fixedEpochInfo)
import Control.Monad (replicateM)
import qualified Data.Map.Strict as Map
import Data.Word (Word64)
import Lens.Micro ((^.))
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.Ledger.Abstract
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.Ledger (ShelleyBlock)
import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import Ouroboros.Consensus.Shelley.Node
import Ouroboros.Consensus.Shelley.ShelleyHFC ()
import Test.Consensus.Shelley.MockCrypto (MockCrypto)
import Test.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck
import Test.ThreadNet.General
import Test.ThreadNet.Infra.Shelley
import Test.ThreadNet.Network
( TestNodeInitialization (..)
, nodeOutputFinalLedger
)
import Test.ThreadNet.TxGen.Shelley
import Test.ThreadNet.Util.NodeJoinPlan (trivialNodeJoinPlan)
import Test.ThreadNet.Util.NodeRestarts (noRestarts)
import Test.ThreadNet.Util.NodeToNodeVersion (genVersion)
import Test.ThreadNet.Util.Seed (runGen)
import Test.Util.HardFork.Future (singleEraFuture)
import Test.Util.Orphans.Arbitrary ()
import Test.Util.Slots (NumSlots (..))
import Test.Util.TestEnv
data TestSetup = TestSetup
{ TestSetup -> DecentralizationParam
setupD :: DecentralizationParam
, TestSetup -> DecentralizationParam
setupD2 :: DecentralizationParam
, TestSetup -> Nonce
setupInitialNonce :: SL.Nonce
, TestSetup -> SecurityParam
setupK :: SecurityParam
, TestSetup -> TestConfig
setupTestConfig :: TestConfig
, TestSetup
-> (NodeToNodeVersion,
BlockNodeToNodeVersion
(ShelleyBlock (TPraos MockCrypto) ShelleyEra))
setupVersion ::
( NodeToNodeVersion
, BlockNodeToNodeVersion (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
)
}
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
minK :: Word64
minK :: Word64
minK = Word64
5
maxK :: Word64
maxK :: Word64
maxK = Word64
10
activeSlotCoeff :: Rational
activeSlotCoeff :: Rational
activeSlotCoeff = Rational
0.5
instance Arbitrary TestSetup where
arbitrary :: Gen TestSetup
arbitrary = do
setupD <- Gen DecentralizationParam
forall a. Arbitrary a => Gen a
arbitrary
setupD2 <- arbitrary
setupInitialNonce <-
frequency
[ (1, pure SL.NeutralNonce)
, (9, SL.mkNonceFromNumber <$> arbitrary)
]
setupK <- SecurityParam <$> choose (minK, maxK) `suchThatMap` nonZero
setupTestConfig <- arbitrary
setupVersion <- genVersion (Proxy @(ShelleyBlock (TPraos MockCrypto) ShelleyEra))
pure
TestSetup
{ setupD
, setupD2
, setupInitialNonce
, setupK
, setupTestConfig
, setupVersion
}
newtype NightlyTestSetup = NightlyTestSetup TestSetup
deriving Int -> NightlyTestSetup -> ShowS
[NightlyTestSetup] -> ShowS
NightlyTestSetup -> String
(Int -> NightlyTestSetup -> ShowS)
-> (NightlyTestSetup -> String)
-> ([NightlyTestSetup] -> ShowS)
-> Show NightlyTestSetup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NightlyTestSetup -> ShowS
showsPrec :: Int -> NightlyTestSetup -> ShowS
$cshow :: NightlyTestSetup -> String
show :: NightlyTestSetup -> String
$cshowList :: [NightlyTestSetup] -> ShowS
showList :: [NightlyTestSetup] -> ShowS
Show
instance Arbitrary NightlyTestSetup where
shrink :: NightlyTestSetup -> [NightlyTestSetup]
shrink (NightlyTestSetup TestSetup
setup) = TestSetup -> NightlyTestSetup
NightlyTestSetup (TestSetup -> NightlyTestSetup)
-> [TestSetup] -> [NightlyTestSetup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestSetup -> [TestSetup]
forall a. Arbitrary a => a -> [a]
shrink TestSetup
setup
arbitrary :: Gen NightlyTestSetup
arbitrary = do
setup <- Gen TestSetup
forall a. Arbitrary a => Gen a
arbitrary
moreEpochs <- frequency [(3, pure False), (1, pure True)]
NightlyTestSetup
<$> if not moreEpochs
then pure setup
else do
let TestSetup
{ setupK
, setupTestConfig
} = setup
TestConfig
{ numSlots
} = setupTestConfig
NumSlots t = numSlots
factor <- choose (1, 2)
let t' = Word64
t Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
factor Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* EpochSize -> Word64
unEpochSize (SecurityParam -> Rational -> EpochSize
mkEpochSize SecurityParam
setupK Rational
activeSlotCoeff)
pure
setup
{ setupTestConfig =
setupTestConfig
{ numSlots = NumSlots t'
}
}
tests :: TestTree
tests :: TestTree
tests =
String -> [TestTree] -> TestTree
testGroup
String
"Shelley ThreadNet"
[ 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
$ \case
TestEnv
Nightly -> String -> (NightlyTestSetup -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
name ((NightlyTestSetup -> Property) -> TestTree)
-> (NightlyTestSetup -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(NightlyTestSetup TestSetup
setup) ->
TestSetup -> Property
prop_simple_real_tpraos_convergence TestSetup
setup
TestEnv
_ -> (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ String -> (TestSetup -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
name TestSetup -> Property
prop_simple_real_tpraos_convergence
]
prop_simple_real_tpraos_convergence :: TestSetup -> Property
prop_simple_real_tpraos_convergence :: TestSetup -> Property
prop_simple_real_tpraos_convergence
TestSetup
{ DecentralizationParam
setupD :: TestSetup -> DecentralizationParam
setupD :: DecentralizationParam
setupD
, DecentralizationParam
setupD2 :: TestSetup -> DecentralizationParam
setupD2 :: DecentralizationParam
setupD2
, Nonce
setupInitialNonce :: TestSetup -> Nonce
setupInitialNonce :: Nonce
setupInitialNonce
, SecurityParam
setupK :: TestSetup -> SecurityParam
setupK :: SecurityParam
setupK
, TestConfig
setupTestConfig :: TestSetup -> TestConfig
setupTestConfig :: TestConfig
setupTestConfig
, (NodeToNodeVersion,
BlockNodeToNodeVersion
(ShelleyBlock (TPraos MockCrypto) ShelleyEra))
setupVersion :: TestSetup
-> (NodeToNodeVersion,
BlockNodeToNodeVersion
(ShelleyBlock (TPraos MockCrypto) ShelleyEra))
setupVersion :: (NodeToNodeVersion,
BlockNodeToNodeVersion
(ShelleyBlock (TPraos MockCrypto) ShelleyEra))
setupVersion
} =
String -> String -> Property -> Property
countertabulate
String
"Epoch number of last slot"
( Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String) -> Word64 -> String
forall a b. (a -> b) -> a -> b
$
if Word64
0 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= NumSlots -> Word64
unNumSlots NumSlots
numSlots
then Word64
0
else
(NumSlots -> Word64
unNumSlots NumSlots
numSlots Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` EpochSize -> Word64
unEpochSize EpochSize
epochSize
)
(Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> String -> Property -> Property
countertabulate
String
"Updating d"
( if Bool -> Bool
not Bool
dShouldUpdate
then String
"No"
else
String
"Yes, " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ordering -> String
forall a. Show a => a -> String
show (DecentralizationParam -> DecentralizationParam -> Ordering
forall a. Ord a => a -> a -> Ordering
compare DecentralizationParam
setupD DecentralizationParam
setupD2)
)
(Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (SecurityParam -> String
forall a. Show a => a -> String
show SecurityParam
setupK)
(Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ PropGeneralArgs (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> TestOutput (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Property
forall blk.
(Condense blk, Condense (HeaderHash blk), Eq blk, RunNode blk) =>
PropGeneralArgs blk -> TestOutput blk -> Property
prop_general
PropGeneralArgs
{ pgaBlockProperty :: ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Property
pgaBlockProperty = Property -> ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Property
forall a b. a -> b -> a
const (Property
-> ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Property)
-> Property
-> ShelleyBlock (TPraos MockCrypto) ShelleyEra
-> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
, pgaCountTxs :: ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Word64
pgaCountTxs = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64)
-> (ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Int)
-> ShelleyBlock (TPraos MockCrypto) ShelleyEra
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)] -> Int)
-> (ShelleyBlock (TPraos MockCrypto) ShelleyEra
-> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)])
-> ShelleyBlock (TPraos MockCrypto) ShelleyEra
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBlock (TPraos MockCrypto) ShelleyEra
-> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
forall blk. HasTxs blk => blk -> [GenTx blk]
extractTxs
, pgaExpectedCannotForge :: SlotNo
-> NodeId
-> WrapCannotForge (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Bool
pgaExpectedCannotForge = SlotNo
-> NodeId
-> WrapCannotForge (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Bool
forall blk. SlotNo -> NodeId -> WrapCannotForge blk -> Bool
noExpectedCannotForges
, pgaFirstBlockNo :: BlockNo
pgaFirstBlockNo = BlockNo
0
, pgaFixedMaxForkLength :: Maybe NumBlocks
pgaFixedMaxForkLength = Maybe NumBlocks
forall a. Maybe a
Nothing
, pgaFixedSchedule :: Maybe LeaderSchedule
pgaFixedSchedule = Maybe LeaderSchedule
forall a. Maybe a
Nothing
, pgaSecurityParam :: SecurityParam
pgaSecurityParam = SecurityParam
setupK
, pgaTestConfig :: TestConfig
pgaTestConfig = TestConfig
setupTestConfig
, pgaTestConfigB :: TestConfigB (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
pgaTestConfigB = TestConfigB (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
testConfigB
}
TestOutput (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
testOutput
Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. Property
prop_checkFinalD
where
countertabulate :: String -> String -> Property -> Property
countertabulate :: String -> String -> Property -> Property
countertabulate String
lbl String
s =
String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
lbl [String
s] (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
lbl String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s)
TestConfig
{ Seed
initSeed :: Seed
initSeed :: TestConfig -> Seed
initSeed
, NumCoreNodes
numCoreNodes :: NumCoreNodes
numCoreNodes :: TestConfig -> NumCoreNodes
numCoreNodes
, NumSlots
numSlots :: TestConfig -> NumSlots
numSlots :: NumSlots
numSlots
} = TestConfig
setupTestConfig
testConfigB :: TestConfigB (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
testConfigB :: TestConfigB (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
testConfigB =
TestConfigB
{ forgeEbbEnv :: Maybe (ForgeEbbEnv (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
forgeEbbEnv = Maybe (ForgeEbbEnv (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
forall a. Maybe a
Nothing
, future :: Future
future = SlotLength -> EpochSize -> Future
singleEraFuture SlotLength
tpraosSlotLength EpochSize
epochSize
, messageDelay :: CalcMessageDelay (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
messageDelay = CalcMessageDelay (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
forall blk. CalcMessageDelay blk
noCalcMessageDelay
, nodeJoinPlan :: NodeJoinPlan
nodeJoinPlan = NumCoreNodes -> NodeJoinPlan
trivialNodeJoinPlan NumCoreNodes
numCoreNodes
, nodeRestarts :: NodeRestarts
nodeRestarts = NodeRestarts
noRestarts
, txGenExtra :: TxGenExtra (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
txGenExtra =
ShelleyTxGenExtra
{ stgeGenEnv :: GenEnv MockCrypto ShelleyEra
stgeGenEnv = WhetherToGeneratePPUs
-> [CoreNode MockCrypto] -> GenEnv MockCrypto ShelleyEra
mkGenEnv WhetherToGeneratePPUs
inclPPUs [CoreNode MockCrypto]
coreNodes
, stgeStartAt :: SlotNo
stgeStartAt =
Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ if Bool
includingDUpdateTx then Word64
1 else Word64
0
}
, version :: (NodeToNodeVersion,
BlockNodeToNodeVersion
(ShelleyBlock (TPraos MockCrypto) ShelleyEra))
version = (NodeToNodeVersion,
BlockNodeToNodeVersion
(ShelleyBlock (TPraos MockCrypto) ShelleyEra))
setupVersion
}
inclPPUs :: WhetherToGeneratePPUs
inclPPUs :: WhetherToGeneratePPUs
inclPPUs =
if Bool
includingDUpdateTx then WhetherToGeneratePPUs
DoNotGeneratePPUs else WhetherToGeneratePPUs
DoGeneratePPUs
sentinel :: SlotNo
sentinel :: SlotNo
sentinel = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ NumSlots -> Word64
unNumSlots NumSlots
numSlots
includingDUpdateTx :: Bool
includingDUpdateTx :: Bool
includingDUpdateTx = DecentralizationParam
setupD DecentralizationParam -> DecentralizationParam -> Bool
forall a. Eq a => a -> a -> Bool
/= DecentralizationParam
setupD2
dUpdatedAsOf :: SlotNo
dUpdatedAsOf :: SlotNo
dUpdatedAsOf = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ EpochSize -> Word64
unEpochSize EpochSize
epochSize
dShouldUpdate :: Bool
dShouldUpdate :: Bool
dShouldUpdate = Bool
includingDUpdateTx Bool -> Bool -> Bool
&& SlotNo
sentinel SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= SlotNo
dUpdatedAsOf
testOutput :: TestOutput (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
testOutput =
TestConfig
-> TestConfigB (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> (forall (m :: * -> *).
IOLike m =>
TestConfigMB m (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
-> TestOutput (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
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 (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
testConfigB
TestConfigMB
{ nodeInfo :: CoreNodeId
-> TestNodeInitialization
m (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
nodeInfo = \(CoreNodeId Word64
nid) ->
let (ProtocolInfo (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
protocolInfo, m [BlockForging m (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
blockForging) =
ShelleyGenesis
-> Nonce
-> ProtVer
-> CoreNode MockCrypto
-> (ProtocolInfo (ShelleyBlock (TPraos MockCrypto) ShelleyEra),
m [BlockForging m (ShelleyBlock (TPraos MockCrypto) ShelleyEra)])
forall (m :: * -> *) c.
(IOLike m, ShelleyCompatible (TPraos c) ShelleyEra) =>
ShelleyGenesis
-> Nonce
-> ProtVer
-> CoreNode c
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)])
mkProtocolShelley
ShelleyGenesis
genesisConfig
Nonce
setupInitialNonce
ProtVer
nextProtVer
([CoreNode MockCrypto]
coreNodes [CoreNode MockCrypto] -> Int -> CoreNode MockCrypto
forall a. HasCallStack => [a] -> Int -> a
!! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nid)
in TestNodeInitialization
{ tniProtocolInfo :: ProtocolInfo (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
tniProtocolInfo = ProtocolInfo (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
protocolInfo
, tniCrucialTxs :: [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
tniCrucialTxs =
if Bool -> Bool
not Bool
includingDUpdateTx
then []
else
[CoreNode MockCrypto]
-> ProtVer
-> SlotNo
-> DecentralizationParam
-> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
forall c.
ShelleyBasedEra ShelleyEra =>
[CoreNode c]
-> ProtVer
-> SlotNo
-> DecentralizationParam
-> [GenTx (ShelleyBlock (TPraos c) ShelleyEra)]
mkSetDecentralizationParamTxs
[CoreNode MockCrypto]
coreNodes
ProtVer
nextProtVer
SlotNo
sentinel
DecentralizationParam
setupD2
, tniBlockForging :: m [BlockForging m (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
tniBlockForging = m [BlockForging m (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
blockForging
}
, mkRekeyM :: Maybe (m (RekeyM m (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
mkRekeyM = Maybe (m (RekeyM m (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
forall a. Maybe a
Nothing
}
initialKESPeriod :: SL.KESPeriod
initialKESPeriod :: KESPeriod
initialKESPeriod = Word -> KESPeriod
SL.KESPeriod Word
0
coreNodes :: [CoreNode MockCrypto]
coreNodes :: [CoreNode MockCrypto]
coreNodes =
Seed -> Gen [CoreNode MockCrypto] -> [CoreNode MockCrypto]
forall a. Seed -> Gen a -> a
runGen Seed
initSeed (Gen [CoreNode MockCrypto] -> [CoreNode MockCrypto])
-> Gen [CoreNode MockCrypto] -> [CoreNode MockCrypto]
forall a b. (a -> b) -> a -> b
$
Int -> Gen (CoreNode MockCrypto) -> Gen [CoreNode MockCrypto]
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 MockCrypto) -> Gen [CoreNode MockCrypto])
-> Gen (CoreNode MockCrypto) -> Gen [CoreNode MockCrypto]
forall a b. (a -> b) -> a -> b
$
KESPeriod -> Gen (CoreNode MockCrypto)
forall c. Crypto c => KESPeriod -> Gen (CoreNode c)
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 MockCrypto] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CoreNode MockCrypto]
coreNodes) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
initialLovelacePerCoreNode
genesisConfig :: ShelleyGenesis
genesisConfig :: ShelleyGenesis
genesisConfig =
ProtVer
-> SecurityParam
-> Rational
-> DecentralizationParam
-> Word64
-> SlotLength
-> KesConfig
-> [CoreNode MockCrypto]
-> ShelleyGenesis
forall c.
PraosCrypto c =>
ProtVer
-> SecurityParam
-> Rational
-> DecentralizationParam
-> Word64
-> SlotLength
-> KesConfig
-> [CoreNode c]
-> ShelleyGenesis
mkGenesisConfig
ProtVer
genesisProtVer
SecurityParam
setupK
Rational
activeSlotCoeff
DecentralizationParam
setupD
Word64
maxLovelaceSupply
SlotLength
tpraosSlotLength
(Proxy MockCrypto -> NumSlots -> KesConfig
forall (proxy :: * -> *) c.
Crypto c =>
proxy c -> NumSlots -> KesConfig
mkKesConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @MockCrypto) NumSlots
numSlots)
[CoreNode MockCrypto]
coreNodes
epochSize :: EpochSize
epochSize :: EpochSize
epochSize = ShelleyGenesis -> EpochSize
sgEpochLength ShelleyGenesis
genesisConfig
genesisProtVer :: SL.ProtVer
genesisProtVer :: ProtVer
genesisProtVer = Version -> Natural -> ProtVer
SL.ProtVer Version
SL.shelleyProtVer Natural
0
nextProtVer :: SL.ProtVer
nextProtVer :: ProtVer
nextProtVer = ProtVer -> ProtVer
incrementMinorProtVer ProtVer
genesisProtVer
prop_checkFinalD :: Property
prop_checkFinalD :: Property
prop_checkFinalD =
[Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$
[ let ls :: NewEpochState ShelleyEra
ls =
Ticked
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK
-> NewEpochState ShelleyEra
forall proto era (mk :: MapKind).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> NewEpochState era
Shelley.tickedShelleyLedgerState (Ticked
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK
-> NewEpochState ShelleyEra)
-> Ticked
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK
-> NewEpochState ShelleyEra
forall a b. (a -> b) -> a -> b
$
ComputeLedgerEvents
-> LedgerCfg
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
-> SlotNo
-> LedgerState
(ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK
-> Ticked
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK
forall (l :: MapKind -> *).
IsLedger l =>
ComputeLedgerEvents
-> LedgerCfg l -> SlotNo -> l EmptyMK -> Ticked l DiffMK
applyChainTick ComputeLedgerEvents
OmitLedgerEvents LedgerCfg
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
ledgerConfig SlotNo
sentinel LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK
lsUnticked
msg :: String
msg =
String
"The ticked final ledger state of "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NodeId -> String
forall a. Show a => a -> String
show NodeId
nid
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" has an unexpected value for the d protocol parameter."
actual :: SL.UnitInterval
actual :: UnitInterval
actual = NewEpochState ShelleyEra -> PParams ShelleyEra
forall era. EraGov era => NewEpochState era -> PParams era
Shelley.getPParams NewEpochState ShelleyEra
ls PParams ShelleyEra
-> Getting UnitInterval (PParams ShelleyEra) UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval (PParams ShelleyEra) UnitInterval
forall era.
EraPParams era =>
SimpleGetter (PParams era) UnitInterval
SimpleGetter (PParams ShelleyEra) UnitInterval
SL.ppDG
expected :: DecentralizationParam
expected :: DecentralizationParam
expected = if Bool
dShouldUpdate then DecentralizationParam
setupD2 else DecentralizationParam
setupD
in String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"unticked " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK
-> String
forall a. Show a => a -> String
show LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK
lsUnticked)
(Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"ticked " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NewEpochState ShelleyEra -> String
forall a. Show a => a -> String
show NewEpochState ShelleyEra
ls)
(Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"(d,d2) = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (DecentralizationParam, DecentralizationParam) -> String
forall a. Show a => a -> String
show (DecentralizationParam
setupD, DecentralizationParam
setupD2))
(Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
( String
"(dUpdatedAsOf, dShouldUpdate) = "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (SlotNo, Bool) -> String
forall a. Show a => a -> String
show (SlotNo
dUpdatedAsOf, Bool
dShouldUpdate)
)
(Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
msg
(Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool
dWasFreeToVary
Bool -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.||. UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
SL.unboundRational UnitInterval
actual
Rational -> Rational -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== DecentralizationParam -> Rational
decentralizationParamToRational DecentralizationParam
expected
| (NodeId
nid, LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK
lsUnticked) <- [(NodeId,
LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)]
finalLedgers
]
where
dWasFreeToVary :: Bool
dWasFreeToVary :: Bool
dWasFreeToVary = case WhetherToGeneratePPUs
inclPPUs of
WhetherToGeneratePPUs
DoGeneratePPUs -> Bool
True
WhetherToGeneratePPUs
DoNotGeneratePPUs -> Bool
False
finalLedgers :: [(NodeId, LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)]
finalLedgers :: [(NodeId,
LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)]
finalLedgers =
Map
NodeId
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)
-> [(NodeId,
LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map
NodeId
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)
-> [(NodeId,
LedgerState
(ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)])
-> Map
NodeId
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)
-> [(NodeId,
LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)]
forall a b. (a -> b) -> a -> b
$ NodeOutput (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> LedgerState
(ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK
forall blk. NodeOutput blk -> LedgerState blk EmptyMK
nodeOutputFinalLedger (NodeOutput (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> LedgerState
(ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)
-> Map
NodeId (NodeOutput (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
-> Map
NodeId
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) EmptyMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestOutput (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Map
NodeId (NodeOutput (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
forall blk. TestOutput blk -> Map NodeId (NodeOutput blk)
testOutputNodes TestOutput (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
testOutput
ledgerConfig :: LedgerConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
ledgerConfig :: LedgerCfg
(LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
ledgerConfig =
ShelleyGenesis
-> TranslationContext ShelleyEra
-> EpochInfo (Except PastHorizonException)
-> ShelleyLedgerConfig ShelleyEra
forall era.
ShelleyGenesis
-> TranslationContext era
-> EpochInfo (Except PastHorizonException)
-> ShelleyLedgerConfig era
Shelley.mkShelleyLedgerConfig
ShelleyGenesis
genesisConfig
(ShelleyGenesis -> FromByronTranslationContext
SL.toFromByronTranslationContext ShelleyGenesis
genesisConfig)
(EpochSize -> SlotLength -> EpochInfo (Except PastHorizonException)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo EpochSize
epochSize SlotLength
tpraosSlotLength)