{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.ThreadNet.Byron (
tests
, TestSetup (..)
, byronPBftParams
, expectedCannotForge
, genTestSetup
, noEBBs
) where
import qualified Cardano.Chain.Block as Block
import qualified Cardano.Chain.Common as Common
import qualified Cardano.Chain.Delegation as Delegation
import qualified Cardano.Chain.Genesis as Genesis
import Cardano.Chain.ProtocolConstants (kEpochSlots)
import Cardano.Chain.Slotting (EpochNumber (..), unEpochSlots)
import qualified Cardano.Crypto as Crypto
import qualified Cardano.Crypto.DSIGN as Crypto
import Cardano.Crypto.Seed (mkSeedFromBytes)
import Cardano.Ledger.Binary (byronProtVer, reAnnotate)
import qualified Cardano.Ledger.Binary.Plain as Plain
import Control.Monad (join)
import qualified Data.ByteString as BS
import Data.Coerce (coerce)
import Data.Functor ((<&>))
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import qualified Data.Set as Set
import Data.Word (Word64)
import Numeric.Search.Range (searchFromTo)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime
import qualified Ouroboros.Consensus.Byron.Crypto.DSIGN as Crypto
import Ouroboros.Consensus.Byron.Ledger (ByronBlock,
ByronNodeToNodeVersion (..))
import qualified Ouroboros.Consensus.Byron.Ledger as Byron
import Ouroboros.Consensus.Byron.Ledger.Conversions
import Ouroboros.Consensus.Byron.Node
import Ouroboros.Consensus.Byron.Protocol
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.NodeId
import Ouroboros.Consensus.Protocol.PBFT
import qualified Ouroboros.Consensus.Protocol.PBFT.Crypto as Crypto
import Ouroboros.Consensus.TypeFamilyWrappers
import Ouroboros.Consensus.Util.Condense (condense)
import Ouroboros.Network.Mock.Chain (Chain)
import qualified Ouroboros.Network.Mock.Chain as Chain
import Test.Cardano.Slotting.Numeric ()
import Test.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck
import Test.ThreadNet.General
import Test.ThreadNet.Infra.Byron
import Test.ThreadNet.Network (NodeOutput (..),
TestNodeInitialization (..))
import qualified Test.ThreadNet.Ref.PBFT as Ref
import Test.ThreadNet.Rekeying
import Test.ThreadNet.TxGen.Byron ()
import Test.ThreadNet.Util
import Test.ThreadNet.Util.NodeJoinPlan
import Test.ThreadNet.Util.NodeRestarts
import Test.ThreadNet.Util.NodeToNodeVersion
import Test.ThreadNet.Util.NodeTopology
import Test.ThreadNet.Util.Seed
import Test.Util.HardFork.Future (singleEraFuture)
import Test.Util.Orphans.Arbitrary ()
import Test.Util.Slots (NumSlots (..))
import qualified Test.Util.Stream as Stream
import Test.Util.TestEnv (adjustQuickCheckTests)
data TestSetup = TestSetup
{ TestSetup -> ProduceEBBs
setupEBBs :: ProduceEBBs
, TestSetup -> SecurityParam
setupK :: SecurityParam
, TestSetup -> TestConfig
setupTestConfig :: TestConfig
, TestSetup -> NodeJoinPlan
setupNodeJoinPlan :: NodeJoinPlan
, TestSetup -> NodeRestarts
setupNodeRestarts :: NodeRestarts
, TestSetup -> SlotLength
setupSlotLength :: SlotLength
, TestSetup -> (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
}
deriving (Int -> TestSetup -> ShowS
[TestSetup] -> ShowS
TestSetup -> [Char]
(Int -> TestSetup -> ShowS)
-> (TestSetup -> [Char])
-> ([TestSetup] -> ShowS)
-> Show TestSetup
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestSetup -> ShowS
showsPrec :: Int -> TestSetup -> ShowS
$cshow :: TestSetup -> [Char]
show :: TestSetup -> [Char]
$cshowList :: [TestSetup] -> ShowS
showList :: [TestSetup] -> ShowS
Show)
instance Arbitrary TestSetup where
arbitrary :: Gen TestSetup
arbitrary = do
SecurityParam
k <- 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
1, Word64
10)
Gen (Gen TestSetup) -> Gen TestSetup
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Gen (Gen TestSetup) -> Gen TestSetup)
-> Gen (Gen TestSetup) -> Gen TestSetup
forall a b. (a -> b) -> a -> b
$ SecurityParam
-> NumCoreNodes -> NumSlots -> SlotLength -> Gen TestSetup
genTestSetup SecurityParam
k (NumCoreNodes -> NumSlots -> SlotLength -> Gen TestSetup)
-> Gen NumCoreNodes
-> Gen (NumSlots -> SlotLength -> Gen TestSetup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NumCoreNodes
forall a. Arbitrary a => Gen a
arbitrary Gen (NumSlots -> SlotLength -> Gen TestSetup)
-> Gen NumSlots -> Gen (SlotLength -> Gen TestSetup)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NumSlots
forall a. Arbitrary a => Gen a
arbitrary Gen (SlotLength -> Gen TestSetup)
-> Gen SlotLength -> Gen (Gen TestSetup)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SlotLength
forall a. Arbitrary a => Gen a
arbitrary
genTestSetup :: SecurityParam -> NumCoreNodes -> NumSlots -> SlotLength -> Gen TestSetup
genTestSetup :: SecurityParam
-> NumCoreNodes -> NumSlots -> SlotLength -> Gen TestSetup
genTestSetup SecurityParam
k NumCoreNodes
numCoreNodes NumSlots
numSlots SlotLength
setupSlotLength = do
ProduceEBBs
setupEBBs <- Gen ProduceEBBs
forall a. Arbitrary a => Gen a
arbitrary
Seed
initSeed <- Gen Seed
forall a. Arbitrary a => Gen a
arbitrary
NodeTopology
nodeTopology <- HasCallStack => NumCoreNodes -> Gen NodeTopology
NumCoreNodes -> Gen NodeTopology
genNodeTopology NumCoreNodes
numCoreNodes
let testConfig :: TestConfig
testConfig = TestConfig
{ Seed
initSeed :: Seed
initSeed :: Seed
initSeed
, NodeTopology
nodeTopology :: NodeTopology
nodeTopology :: NodeTopology
nodeTopology
, NumCoreNodes
numCoreNodes :: NumCoreNodes
numCoreNodes :: NumCoreNodes
numCoreNodes
, NumSlots
numSlots :: NumSlots
numSlots :: NumSlots
numSlots
}
let params :: PBftParams
params = SecurityParam -> NumCoreNodes -> PBftParams
byronPBftParams SecurityParam
k NumCoreNodes
numCoreNodes
NodeJoinPlan
nodeJoinPlan <- PBftParams -> NumSlots -> Gen NodeJoinPlan
genByronNodeJoinPlan PBftParams
params NumSlots
numSlots
NodeRestarts
nodeRestarts <- NodeJoinPlan -> NumSlots -> Gen NodeRestarts
genNodeRestarts NodeJoinPlan
nodeJoinPlan NumSlots
numSlots Gen NodeRestarts
-> (NodeRestarts -> Gen NodeRestarts) -> Gen NodeRestarts
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
PBftParams
-> NodeJoinPlan
-> NodeTopology
-> NumSlots
-> NodeRestarts
-> Gen NodeRestarts
genNodeRekeys PBftParams
params NodeJoinPlan
nodeJoinPlan NodeTopology
nodeTopology NumSlots
numSlots
(NodeToNodeVersion, ByronNodeToNodeVersion)
setupVersion <- Proxy ByronBlock
-> Gen (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Gen (NodeToNodeVersion, BlockNodeToNodeVersion blk)
genVersion (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ByronBlock)
TestSetup -> Gen TestSetup
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestSetup -> Gen TestSetup) -> TestSetup -> Gen TestSetup
forall a b. (a -> b) -> a -> b
$ ProduceEBBs
-> SecurityParam
-> TestConfig
-> NodeJoinPlan
-> NodeRestarts
-> SlotLength
-> (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
-> TestSetup
TestSetup
ProduceEBBs
setupEBBs
SecurityParam
k
TestConfig
testConfig
NodeJoinPlan
nodeJoinPlan
NodeRestarts
nodeRestarts
SlotLength
setupSlotLength
(NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
(NodeToNodeVersion, ByronNodeToNodeVersion)
setupVersion
tests :: TestTree
tests :: TestTree
tests = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Byron" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
[ [Char]
-> (TestSetup -> NumSlots -> NumCoreNodes -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"trivial join plan is considered deterministic"
((TestSetup -> NumSlots -> NumCoreNodes -> Property) -> TestTree)
-> (TestSetup -> NumSlots -> NumCoreNodes -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \TestSetup{setupK :: TestSetup -> SecurityParam
setupK = SecurityParam
k, setupTestConfig :: TestSetup -> TestConfig
setupTestConfig = TestConfig{NumCoreNodes
numCoreNodes :: TestConfig -> NumCoreNodes
numCoreNodes :: NumCoreNodes
numCoreNodes}} ->
PBftParams -> NumSlots -> NumCoreNodes -> Property
prop_deterministicPlan (PBftParams -> NumSlots -> NumCoreNodes -> Property)
-> PBftParams -> NumSlots -> NumCoreNodes -> Property
forall a b. (a -> b) -> a -> b
$ SecurityParam -> NumCoreNodes -> PBftParams
byronPBftParams SecurityParam
k NumCoreNodes
numCoreNodes
, (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
[Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"addressed by InvalidRollForward exception (PR #773)" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
3 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
10
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
24
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (Map CoreNodeId SlotNo -> NodeJoinPlan)
-> Map CoreNodeId SlotNo -> NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,Word64 -> SlotNo
SlotNo Word64
0), (Word64 -> CoreNodeId
CoreNodeId Word64
1,Word64 -> SlotNo
SlotNo Word64
20), (Word64 -> CoreNodeId
CoreNodeId Word64
2,Word64 -> SlotNo
SlotNo Word64
22)]
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"rewind to EBB supported as of Issue #1312, #1" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
2 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
10
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
2
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan ([(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,Word64 -> SlotNo
SlotNo Word64
0),(Word64 -> CoreNodeId
CoreNodeId Word64
1,Word64 -> SlotNo
SlotNo Word64
1)])
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"rewind to EBB supported as of Issue #1312, #2" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
2 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
10
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
4
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan ([(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0}),(Word64 -> CoreNodeId
CoreNodeId Word64
1,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
3})])
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"one testOutputTipBlockNos update per node per slot" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
2 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
5
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
7
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan ([(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0}),(Word64 -> CoreNodeId
CoreNodeId Word64
1,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0})])
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
NodeRestarts ([(SlotNo, Map CoreNodeId NodeRestart)]
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(SlotNo {unSlotNo :: Word64
unSlotNo = Word64
5},[(CoreNodeId, NodeRestart)] -> Map CoreNodeId NodeRestart
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
1,NodeRestart
NodeRestart)])])
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"BlockFetch live lock due to an EBB at the ImmutableDB tip, Issue #1435" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
4 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
5
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
58
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (Map CoreNodeId SlotNo -> NodeJoinPlan)
-> Map CoreNodeId SlotNo -> NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,Word64 -> SlotNo
SlotNo Word64
3),(Word64 -> CoreNodeId
CoreNodeId Word64
1,Word64 -> SlotNo
SlotNo Word64
3),(Word64 -> CoreNodeId
CoreNodeId Word64
2,Word64 -> SlotNo
SlotNo Word64
5),(Word64 -> CoreNodeId
CoreNodeId Word64
3,Word64 -> SlotNo
SlotNo Word64
57)]
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"ImmutableDB is leaking file handles, #1543" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let ncn5 :: NumCoreNodes
ncn5 = Word64 -> NumCoreNodes
NumCoreNodes Word64
5 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
2
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn5
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
54
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn5
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (Map CoreNodeId SlotNo -> NodeJoinPlan)
-> Map CoreNodeId SlotNo -> NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Word64 -> CoreNodeId
CoreNodeId Word64
0, SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0})
, (Word64 -> CoreNodeId
CoreNodeId Word64
1, SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0})
, (Word64 -> CoreNodeId
CoreNodeId Word64
2, SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0})
, (Word64 -> CoreNodeId
CoreNodeId Word64
3, SlotNo {unSlotNo :: Word64
unSlotNo = Word64
53})
, (Word64 -> CoreNodeId
CoreNodeId Word64
4, SlotNo {unSlotNo :: Word64
unSlotNo = Word64
53})
]
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
NodeRestarts (Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts)
-> Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
forall a b. (a -> b) -> a -> b
$ [(SlotNo, Map CoreNodeId NodeRestart)]
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (SlotNo {unSlotNo :: Word64
unSlotNo = Word64
50},[(CoreNodeId, NodeRestart)] -> Map CoreNodeId NodeRestart
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,NodeRestart
NodeRestart)])
, (SlotNo {unSlotNo :: Word64
unSlotNo = Word64
53},[(CoreNodeId, NodeRestart)] -> Map CoreNodeId NodeRestart
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
3,NodeRestart
NodeRestart)])
]
, setupSlotLength :: SlotLength
setupSlotLength = Integer -> SlotLength
slotLengthFromSec Integer
20
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
,
(Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
[Char] -> (Seed -> Word64 -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"re-delegation via NodeRekey" ((Seed -> Word64 -> Property) -> TestTree)
-> (Seed -> Word64 -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \Seed
seed Word64
w ->
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
5
k :: Num a => a
k :: forall a. Num a => a
k = a
5
window :: Num a => a
window :: forall a. Num a => a
window = a
20
slotsPerEpoch :: Num a => a
slotsPerEpoch :: forall a. Num a => a
slotsPerEpoch = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ EpochSlots -> Word64
unEpochSlots (EpochSlots -> Word64) -> EpochSlots -> Word64
forall a b. (a -> b) -> a -> b
$
BlockCount -> EpochSlots
kEpochSlots (BlockCount -> EpochSlots) -> BlockCount -> EpochSlots
forall a b. (a -> b) -> a -> b
$ Word64 -> BlockCount
forall a b. Coercible a b => a -> b
coerce (Word64
forall a. Num a => a
k :: Word64)
slotsPerRekey :: Num a => a
slotsPerRekey :: forall a. Num a => a
slotsPerRekey = a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Num a => a
k
in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
forall a. Num a => a
k
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots (Word64 -> NumSlots) -> Word64 -> NumSlots
forall a b. (a -> b) -> a -> b
$ Word64
forall a. Num a => a
window Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
forall a. Num a => a
slotsPerEpoch Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
forall a. Num a => a
slotsPerRekey Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
forall a. Num a => a
window
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Seed
seed
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = NumCoreNodes -> NodeJoinPlan
trivialNodeJoinPlan NumCoreNodes
ncn
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
NodeRestarts (Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts)
-> Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
forall a b. (a -> b) -> a -> b
$ SlotNo
-> Map CoreNodeId NodeRestart
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall k a. k -> a -> Map k a
Map.singleton (Word64 -> SlotNo
SlotNo (Word64
forall a. Num a => a
slotsPerEpoch Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
mod Word64
w Word64
forall a. Num a => a
window)) (CoreNodeId -> NodeRestart -> Map CoreNodeId NodeRestart
forall k a. k -> a -> Map k a
Map.singleton (Word64 -> CoreNodeId
CoreNodeId Word64
0) NodeRestart
NodeRekey)
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"exercise a corner case of mkCurrentBlockContext" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
let k :: SecurityParam
k = Word64 -> SecurityParam
SecurityParam Word64
1
ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
2
in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = SecurityParam
k
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
2
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = NumCoreNodes -> NodeJoinPlan
trivialNodeJoinPlan NumCoreNodes
ncn
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
NodeRestarts (Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts)
-> Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
forall a b. (a -> b) -> a -> b
$ SlotNo
-> Map CoreNodeId NodeRestart
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall k a. k -> a -> Map k a
Map.singleton (Word64 -> SlotNo
SlotNo Word64
1) (CoreNodeId -> NodeRestart -> Map CoreNodeId NodeRestart
forall k a. k -> a -> Map k a
Map.singleton (Word64 -> CoreNodeId
CoreNodeId Word64
1) NodeRestart
NodeRestart)
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"correct EpochNumber in delegation certificate 1" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let ncn4 :: NumCoreNodes
ncn4 = Word64 -> NumCoreNodes
NumCoreNodes Word64
4 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
3
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn4
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
72
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn4
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = NumCoreNodes -> NodeJoinPlan
trivialNodeJoinPlan NumCoreNodes
ncn4
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
NodeRestarts ([(SlotNo, Map CoreNodeId NodeRestart)]
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> SlotNo
SlotNo Word64
59,[(CoreNodeId, NodeRestart)] -> Map CoreNodeId NodeRestart
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
3,NodeRestart
NodeRekey)])])
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"correct EpochNumber in delegation certificate 2" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
let ncn3 :: NumCoreNodes
ncn3 = Word64 -> NumCoreNodes
NumCoreNodes Word64
3 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
2
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn3
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
84
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn3
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan ([(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
1}),(Word64 -> CoreNodeId
CoreNodeId Word64
1,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
1}),(Word64 -> CoreNodeId
CoreNodeId Word64
2,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
58})])
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
NodeRestarts ([(SlotNo, Map CoreNodeId NodeRestart)]
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(SlotNo {unSlotNo :: Word64
unSlotNo = Word64
58},[(CoreNodeId, NodeRestart)] -> Map CoreNodeId NodeRestart
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
2,NodeRestart
NodeRekey)])])
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"repeatedly add the the dlg cert tx" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
4
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = Word64 -> NumCoreNodes
NumCoreNodes Word64
3
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
96
, nodeTopology :: NodeTopology
nodeTopology =
Map CoreNodeId (Set CoreNodeId) -> NodeTopology
NodeTopology (Map CoreNodeId (Set CoreNodeId) -> NodeTopology)
-> Map CoreNodeId (Set CoreNodeId) -> NodeTopology
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, Set CoreNodeId)] -> Map CoreNodeId (Set CoreNodeId)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,[CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList []),(Word64 -> CoreNodeId
CoreNodeId Word64
1,[CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [Word64 -> CoreNodeId
CoreNodeId Word64
0]),(Word64 -> CoreNodeId
CoreNodeId Word64
2,[CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [Word64 -> CoreNodeId
CoreNodeId Word64
0])]
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (Map CoreNodeId SlotNo -> NodeJoinPlan)
-> Map CoreNodeId SlotNo -> NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,Word64 -> SlotNo
SlotNo Word64
0),(Word64 -> CoreNodeId
CoreNodeId Word64
1,Word64 -> SlotNo
SlotNo Word64
0),(Word64 -> CoreNodeId
CoreNodeId Word64
2,Word64 -> SlotNo
SlotNo Word64
83)]
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
NodeRestarts (Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts)
-> Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
forall a b. (a -> b) -> a -> b
$ [(SlotNo, Map CoreNodeId NodeRestart)]
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> SlotNo
SlotNo Word64
83,[(CoreNodeId, NodeRestart)] -> Map CoreNodeId NodeRestart
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
2,NodeRestart
NodeRekey)])]
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"topology prevents timely dlg cert tx propagation" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
let ncn5 :: NumCoreNodes
ncn5 = Word64 -> NumCoreNodes
NumCoreNodes Word64
5 in
Property -> Property
forall prop. Testable prop => prop -> Property
expectFailure (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
2
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn5
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
50
, nodeTopology :: NodeTopology
nodeTopology =
Map CoreNodeId (Set CoreNodeId) -> NodeTopology
NodeTopology ([(CoreNodeId, Set CoreNodeId)] -> Map CoreNodeId (Set CoreNodeId)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,[CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList []),(Word64 -> CoreNodeId
CoreNodeId Word64
1,[CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [Word64 -> CoreNodeId
CoreNodeId Word64
0]),(Word64 -> CoreNodeId
CoreNodeId Word64
2,[CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [Word64 -> CoreNodeId
CoreNodeId Word64
0, Word64 -> CoreNodeId
CoreNodeId Word64
1]),(Word64 -> CoreNodeId
CoreNodeId Word64
3,[CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [Word64 -> CoreNodeId
CoreNodeId Word64
0,Word64 -> CoreNodeId
CoreNodeId Word64
1,Word64 -> CoreNodeId
CoreNodeId Word64
2]),(Word64 -> CoreNodeId
CoreNodeId Word64
4,[CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [Word64 -> CoreNodeId
CoreNodeId Word64
0,Word64 -> CoreNodeId
CoreNodeId Word64
1,Word64 -> CoreNodeId
CoreNodeId Word64
2])])
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan ([(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0}),(Word64 -> CoreNodeId
CoreNodeId Word64
1,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0}),(Word64 -> CoreNodeId
CoreNodeId Word64
2,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0}),(Word64 -> CoreNodeId
CoreNodeId Word64
3,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
37}),(Word64 -> CoreNodeId
CoreNodeId Word64
4,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
37})])
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
NodeRestarts ([(SlotNo, Map CoreNodeId NodeRestart)]
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(SlotNo {unSlotNo :: Word64
unSlotNo = Word64
37},[(CoreNodeId, NodeRestart)] -> Map CoreNodeId NodeRestart
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
4,NodeRestart
NodeRekey)])])
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"mkDelegationEnvironment uses currentSlot not latestSlot" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
3 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
2
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
41
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = NumCoreNodes -> NodeJoinPlan
trivialNodeJoinPlan NumCoreNodes
ncn
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
NodeRestarts (Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts)
-> Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
forall a b. (a -> b) -> a -> b
$ SlotNo
-> Map CoreNodeId NodeRestart
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall k a. k -> a -> Map k a
Map.singleton (Word64 -> SlotNo
SlotNo Word64
30) (Map CoreNodeId NodeRestart
-> Map SlotNo (Map CoreNodeId NodeRestart))
-> Map CoreNodeId NodeRestart
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall a b. (a -> b) -> a -> b
$ CoreNodeId -> NodeRestart -> Map CoreNodeId NodeRestart
forall k a. k -> a -> Map k a
Map.singleton (Word64 -> CoreNodeId
CoreNodeId Word64
2) NodeRestart
NodeRekey
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"delayed message corner case" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
2 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
7
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
10
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan ([(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0}),(Word64 -> CoreNodeId
CoreNodeId Word64
1,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
1})])
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"mkUpdateLabels anticipates instant confirmation" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
3 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
9
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
1
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = NumCoreNodes -> NodeJoinPlan
trivialNodeJoinPlan NumCoreNodes
ncn
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"have nodes add transactions as promptly as possible, as expected by proposal tracking" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
4 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
8
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
2
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = NumCoreNodes -> NodeJoinPlan
trivialNodeJoinPlan NumCoreNodes
ncn
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"track proposals even when c0 is not the first to lead" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
4 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
5
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
5
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (Map CoreNodeId SlotNo -> NodeJoinPlan)
-> Map CoreNodeId SlotNo -> NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Word64 -> CoreNodeId
CoreNodeId Word64
0, Word64 -> SlotNo
SlotNo Word64
2) , (Word64 -> CoreNodeId
CoreNodeId Word64
1, Word64 -> SlotNo
SlotNo Word64
3) , (Word64 -> CoreNodeId
CoreNodeId Word64
2, Word64 -> SlotNo
SlotNo Word64
4) , (Word64 -> CoreNodeId
CoreNodeId Word64
3, Word64 -> SlotNo
SlotNo Word64
4) ]
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"cardano-ledger-byron checks for proposal confirmation before it checks for expiry" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
5 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
10
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
12
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (Map CoreNodeId SlotNo -> NodeJoinPlan)
-> Map CoreNodeId SlotNo -> NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Word64 -> CoreNodeId
CoreNodeId Word64
0, Word64 -> SlotNo
SlotNo Word64
0) , (Word64 -> CoreNodeId
CoreNodeId Word64
1, Word64 -> SlotNo
SlotNo Word64
0) , (Word64 -> CoreNodeId
CoreNodeId Word64
2, Word64 -> SlotNo
SlotNo Word64
10) , (Word64 -> CoreNodeId
CoreNodeId Word64
3, Word64 -> SlotNo
SlotNo Word64
10) , (Word64 -> CoreNodeId
CoreNodeId Word64
4, Word64 -> SlotNo
SlotNo Word64
10) ]
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"repropose an expired proposal" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
5 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
10
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
17
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (Map CoreNodeId SlotNo -> NodeJoinPlan)
-> Map CoreNodeId SlotNo -> NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[(Word64 -> CoreNodeId
CoreNodeId Word64
0, Word64 -> SlotNo
SlotNo Word64
0)
,(Word64 -> CoreNodeId
CoreNodeId Word64
1, Word64 -> SlotNo
SlotNo Word64
10)
,(Word64 -> CoreNodeId
CoreNodeId Word64
2, Word64 -> SlotNo
SlotNo Word64
11)
,(Word64 -> CoreNodeId
CoreNodeId Word64
3, Word64 -> SlotNo
SlotNo Word64
11)
,(Word64 -> CoreNodeId
CoreNodeId Word64
4, Word64 -> SlotNo
SlotNo Word64
16)
]
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"only expect EBBs if the reference simulator does" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
let ncn :: NumCoreNodes
ncn = Word64 -> NumCoreNodes
NumCoreNodes Word64
3 in
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
2
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = NumCoreNodes
ncn
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
21
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology NumCoreNodes
ncn
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (Map CoreNodeId SlotNo -> NodeJoinPlan)
-> Map CoreNodeId SlotNo -> NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Word64 -> CoreNodeId
CoreNodeId Word64
0,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0})
, (Word64 -> CoreNodeId
CoreNodeId Word64
1,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0})
, (Word64 -> CoreNodeId
CoreNodeId Word64
2,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
20})
]
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"only check updates for mesh topologies" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
10
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = Word64 -> NumCoreNodes
NumCoreNodes Word64
5
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
13
, nodeTopology :: NodeTopology
nodeTopology = Map CoreNodeId (Set CoreNodeId) -> NodeTopology
NodeTopology (Map CoreNodeId (Set CoreNodeId) -> NodeTopology)
-> Map CoreNodeId (Set CoreNodeId) -> NodeTopology
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, Set CoreNodeId)] -> Map CoreNodeId (Set CoreNodeId)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Word64 -> CoreNodeId
CoreNodeId Word64
0, [CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [])
, (Word64 -> CoreNodeId
CoreNodeId Word64
1, [CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [Word64 -> CoreNodeId
CoreNodeId Word64
0])
, (Word64 -> CoreNodeId
CoreNodeId Word64
2, [CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [Word64 -> CoreNodeId
CoreNodeId Word64
1])
, (Word64 -> CoreNodeId
CoreNodeId Word64
3, [CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [Word64 -> CoreNodeId
CoreNodeId Word64
0, Word64 -> CoreNodeId
CoreNodeId Word64
1, Word64 -> CoreNodeId
CoreNodeId Word64
2])
, (Word64 -> CoreNodeId
CoreNodeId Word64
4, [CoreNodeId] -> Set CoreNodeId
forall a. Ord a => [a] -> Set a
Set.fromList [Word64 -> CoreNodeId
CoreNodeId Word64
0, Word64 -> CoreNodeId
CoreNodeId Word64
1, Word64 -> CoreNodeId
CoreNodeId Word64
2, Word64 -> CoreNodeId
CoreNodeId Word64
3])
]
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (Map CoreNodeId SlotNo -> NodeJoinPlan)
-> Map CoreNodeId SlotNo -> NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ [(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (Word64 -> CoreNodeId
CoreNodeId Word64
0, Word64 -> SlotNo
SlotNo Word64
0)
, (Word64 -> CoreNodeId
CoreNodeId Word64
1, Word64 -> SlotNo
SlotNo Word64
11)
, (Word64 -> CoreNodeId
CoreNodeId Word64
2, Word64 -> SlotNo
SlotNo Word64
11)
, (Word64 -> CoreNodeId
CoreNodeId Word64
3, Word64 -> SlotNo
SlotNo Word64
11)
, (Word64 -> CoreNodeId
CoreNodeId Word64
4, Word64 -> SlotNo
SlotNo Word64
11)
]
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = SlotLength
defaultSlotLength
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"HeaderProtocolError prevents JIT EBB emission" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
8
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = Word64 -> NumCoreNodes
NumCoreNodes Word64
3
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
81
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology (Word64 -> NumCoreNodes
NumCoreNodes Word64
3)
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan ([(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
2}),(Word64 -> CoreNodeId
CoreNodeId Word64
1,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
6}),(Word64 -> CoreNodeId
CoreNodeId Word64
2,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
9})])
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = Integer -> SlotLength
slotLengthFromSec Integer
20
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"WallClock must handle PastHorizon by exactly slotLength delay" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
ProduceEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
2
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = Word64 -> NumCoreNodes
NumCoreNodes Word64
2
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
39
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology (Word64 -> NumCoreNodes
NumCoreNodes Word64
2)
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan ([(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0}),(Word64 -> CoreNodeId
CoreNodeId Word64
1,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
33})])
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = Integer -> SlotLength
slotLengthFromSec Integer
20
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"systemTimeCurrent must not answer once clock is exhausted" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: ProduceEBBs
setupEBBs = ProduceEBBs
NoEBBs
, setupK :: SecurityParam
setupK = Word64 -> SecurityParam
SecurityParam Word64
2
, setupTestConfig :: TestConfig
setupTestConfig = TestConfig
{ numCoreNodes :: NumCoreNodes
numCoreNodes = Word64 -> NumCoreNodes
NumCoreNodes Word64
3
, numSlots :: NumSlots
numSlots = Word64 -> NumSlots
NumSlots Word64
21
, nodeTopology :: NodeTopology
nodeTopology = NumCoreNodes -> NodeTopology
meshNodeTopology (Word64 -> NumCoreNodes
NumCoreNodes Word64
3)
, initSeed :: Seed
initSeed = Int -> Seed
Seed Int
0
}
, setupNodeJoinPlan :: NodeJoinPlan
setupNodeJoinPlan = Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan ([(CoreNodeId, SlotNo)] -> Map CoreNodeId SlotNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word64 -> CoreNodeId
CoreNodeId Word64
0,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0}),(Word64 -> CoreNodeId
CoreNodeId Word64
1,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
0}),(Word64 -> CoreNodeId
CoreNodeId Word64
2,SlotNo {unSlotNo :: Word64
unSlotNo = Word64
20})])
, setupNodeRestarts :: NodeRestarts
setupNodeRestarts = NodeRestarts
noRestarts
, setupSlotLength :: SlotLength
setupSlotLength = Integer -> SlotLength
slotLengthFromSec Integer
20
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion
NodeToNodeV_7, BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1)
}
, [Char] -> (TestSetup -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"simple convergence" ((TestSetup -> Property) -> TestTree)
-> (TestSetup -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \TestSetup
setup ->
TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
setup
]
where
defaultSlotLength :: SlotLength
defaultSlotLength :: SlotLength
defaultSlotLength = Integer -> SlotLength
slotLengthFromSec Integer
1
prop_deterministicPlan :: PBftParams -> NumSlots -> NumCoreNodes -> Property
prop_deterministicPlan :: PBftParams -> NumSlots -> NumCoreNodes -> Property
prop_deterministicPlan PBftParams
params NumSlots
numSlots NumCoreNodes
numCoreNodes =
Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ case HasCallStack => PBftParams -> NodeJoinPlan -> NumSlots -> Result
PBftParams -> NodeJoinPlan -> NumSlots -> Result
Ref.simulate PBftParams
params NodeJoinPlan
njp NumSlots
numSlots of
Ref.Forked{} -> Bool
False
Ref.Outcomes{} -> Bool
True
Result
Ref.Nondeterministic -> Bool
False
where
njp :: NodeJoinPlan
njp = NumCoreNodes -> NodeJoinPlan
trivialNodeJoinPlan NumCoreNodes
numCoreNodes
expectedCannotForge ::
SecurityParam
-> NumCoreNodes
-> NodeRestarts
-> SlotNo
-> NodeId
-> WrapCannotForge ByronBlock
-> Bool
expectedCannotForge :: SecurityParam
-> NumCoreNodes
-> NodeRestarts
-> SlotNo
-> NodeId
-> WrapCannotForge ByronBlock
-> Bool
expectedCannotForge
SecurityParam
k NumCoreNodes
numCoreNodes (NodeRestarts Map SlotNo (Map CoreNodeId NodeRestart)
nrs)
SlotNo
s (CoreId (CoreNodeId Word64
i)) (WrapCannotForge CannotForge ByronBlock
cl)
= case CannotForge ByronBlock
cl of
PBftCannotForgeThresholdExceeded{} ->
Bool
True
PBftCannotForgeInvalidDelegation {} ->
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([()] -> Bool) -> [()] -> Bool
forall a b. (a -> b) -> a -> b
$
[ ()
| (SlotNo
restartSlot, Map CoreNodeId NodeRestart
nrs') <- Map SlotNo (Map CoreNodeId NodeRestart)
-> [(SlotNo, Map CoreNodeId NodeRestart)]
forall k a. Map k a -> [(k, a)]
Map.toList Map SlotNo (Map CoreNodeId NodeRestart)
nrs
, SlotNo
restartSlot SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
s
Bool -> Bool -> Bool
&& SlotNo
s SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SecurityParam -> NumCoreNodes -> SlotNo -> SlotNo
latestPossibleDlgMaturation SecurityParam
k NumCoreNodes
numCoreNodes SlotNo
restartSlot
, (CoreNodeId Word64
i', NodeRestart
NodeRekey) <- Map CoreNodeId NodeRestart -> [(CoreNodeId, NodeRestart)]
forall k a. Map k a -> [(k, a)]
Map.toList Map CoreNodeId NodeRestart
nrs'
, Word64
i' Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
i
]
expectedCannotForge SecurityParam
_ NumCoreNodes
_ NodeRestarts
_ SlotNo
_ NodeId
_ WrapCannotForge ByronBlock
_ = Bool
False
latestPossibleDlgMaturation ::
SecurityParam -> NumCoreNodes -> SlotNo -> SlotNo
latestPossibleDlgMaturation :: SecurityParam -> NumCoreNodes -> SlotNo -> SlotNo
latestPossibleDlgMaturation
(SecurityParam Word64
k) (NumCoreNodes Word64
n) (SlotNo Word64
rekeySlot) =
Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Word64
rekeySlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
k
prop_simple_real_pbft_convergence :: TestSetup -> Property
prop_simple_real_pbft_convergence :: TestSetup -> Property
prop_simple_real_pbft_convergence TestSetup
{ setupEBBs :: TestSetup -> ProduceEBBs
setupEBBs = ProduceEBBs
produceEBBs
, setupK :: TestSetup -> SecurityParam
setupK = SecurityParam
k
, setupTestConfig :: TestSetup -> TestConfig
setupTestConfig = TestConfig
testConfig
, setupNodeJoinPlan :: TestSetup -> NodeJoinPlan
setupNodeJoinPlan = NodeJoinPlan
nodeJoinPlan
, setupNodeRestarts :: TestSetup -> NodeRestarts
setupNodeRestarts = NodeRestarts
nodeRestarts
, setupSlotLength :: TestSetup -> SlotLength
setupSlotLength = SlotLength
slotLength
, setupVersion :: TestSetup -> (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
setupVersion = (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
version
} =
[Char] -> [[Char]] -> Property -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"produce EBBs" [ProduceEBBs -> [Char]
forall a. Show a => a -> [Char]
show ProduceEBBs
produceEBBs] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
[Char] -> [[Char]] -> Property -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"Ref.PBFT result" [Result -> [Char]
Ref.resultConstrName Result
refResult] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
[Char] -> [[Char]] -> Property -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"proposed protocol version was adopted" [Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
aPvuRequired] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
[Char] -> [[Char]] -> Property -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"proposed software version was adopted" [Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
aSvuRequired] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
[Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char]
"params: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> PBftParams -> [Char]
forall a. Show a => a -> [Char]
show PBftParams
params) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
[Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char]
"Ref.PBFT result: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Result -> [Char]
forall a. Show a => a -> [Char]
show Result
refResult) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
[Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample
([Char]
"delegation certificates: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(NodeId, [(SlotNumber, [ACertificate ByteString])])] -> [Char]
forall a. Show a => a -> [Char]
show [
(,) NodeId
nid ([(SlotNumber, [ACertificate ByteString])]
-> (NodeId, [(SlotNumber, [ACertificate ByteString])]))
-> [(SlotNumber, [ACertificate ByteString])]
-> (NodeId, [(SlotNumber, [ACertificate ByteString])])
forall a b. (a -> b) -> a -> b
$
(Maybe (SlotNumber, [ACertificate ByteString])
-> Maybe (SlotNumber, [ACertificate ByteString]))
-> [Maybe (SlotNumber, [ACertificate ByteString])]
-> [(SlotNumber, [ACertificate ByteString])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe (SlotNumber, [ACertificate ByteString])
-> ((SlotNumber, [ACertificate ByteString])
-> Maybe (SlotNumber, [ACertificate ByteString]))
-> Maybe (SlotNumber, [ACertificate ByteString])
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x :: (SlotNumber, [ACertificate ByteString])
x@(SlotNumber
_, [ACertificate ByteString]
dlgs) -> if [ACertificate ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ACertificate ByteString]
dlgs then Maybe (SlotNumber, [ACertificate ByteString])
forall a. Maybe a
Nothing else (SlotNumber, [ACertificate ByteString])
-> Maybe (SlotNumber, [ACertificate ByteString])
forall a. a -> Maybe a
Just (SlotNumber, [ACertificate ByteString])
x) ([Maybe (SlotNumber, [ACertificate ByteString])]
-> [(SlotNumber, [ACertificate ByteString])])
-> [Maybe (SlotNumber, [ACertificate ByteString])]
-> [(SlotNumber, [ACertificate ByteString])]
forall a b. (a -> b) -> a -> b
$
[ case ByronBlock -> ABlockOrBoundary ByteString
Byron.byronBlockRaw ByronBlock
blk of
Block.ABOBBlock ABlock ByteString
b -> (SlotNumber, [ACertificate ByteString])
-> Maybe (SlotNumber, [ACertificate ByteString])
forall a. a -> Maybe a
Just (ABlock ByteString -> SlotNumber
forall a. ABlock a -> SlotNumber
Block.blockSlot ABlock ByteString
b, APayload ByteString -> [ACertificate ByteString]
forall a. APayload a -> [ACertificate a]
Delegation.getPayload (APayload ByteString -> [ACertificate ByteString])
-> APayload ByteString -> [ACertificate ByteString]
forall a b. (a -> b) -> a -> b
$ ABlock ByteString -> APayload ByteString
forall a. ABlock a -> APayload a
Block.blockDlgPayload ABlock ByteString
b)
Block.ABOBBoundary ABoundaryBlock ByteString
_ -> Maybe (SlotNumber, [ACertificate ByteString])
forall a. Maybe a
Nothing
| ByronBlock
blk <- Chain ByronBlock -> [ByronBlock]
forall block. Chain block -> [block]
Chain.chainToList Chain ByronBlock
ch
]
| (NodeId
nid, Chain ByronBlock
ch) <- [(NodeId, Chain ByronBlock)]
finalChains
]) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
PropGeneralArgs ByronBlock -> TestOutput ByronBlock -> Property
forall blk.
(Condense blk, Condense (HeaderHash blk), Eq blk, RunNode blk) =>
PropGeneralArgs blk -> TestOutput blk -> Property
prop_general PropGeneralArgs
{ pgaBlockProperty :: ByronBlock -> Property
pgaBlockProperty = Property -> ByronBlock -> Property
forall a b. a -> b -> a
const (Property -> ByronBlock -> Property)
-> Property -> ByronBlock -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
, pgaCountTxs :: ByronBlock -> Word64
pgaCountTxs = ByronBlock -> Word64
Byron.countByronGenTxs
, pgaExpectedCannotForge :: SlotNo -> NodeId -> WrapCannotForge ByronBlock -> Bool
pgaExpectedCannotForge = SecurityParam
-> NumCoreNodes
-> NodeRestarts
-> SlotNo
-> NodeId
-> WrapCannotForge ByronBlock
-> Bool
expectedCannotForge SecurityParam
k NumCoreNodes
numCoreNodes NodeRestarts
nodeRestarts
, pgaFirstBlockNo :: BlockNo
pgaFirstBlockNo = BlockNo
1
, pgaFixedMaxForkLength :: Maybe NumBlocks
pgaFixedMaxForkLength =
NumBlocks -> Maybe NumBlocks
forall a. a -> Maybe a
Just (NumBlocks -> Maybe NumBlocks) -> NumBlocks -> Maybe NumBlocks
forall a b. (a -> b) -> a -> b
$ Word64 -> NumBlocks
NumBlocks (Word64 -> NumBlocks) -> Word64 -> NumBlocks
forall a b. (a -> b) -> a -> b
$ case Result
refResult of
Ref.Forked{} -> Word64
1
Result
_ -> Word64
0
, pgaFixedSchedule :: Maybe LeaderSchedule
pgaFixedSchedule =
LeaderSchedule -> Maybe LeaderSchedule
forall a. a -> Maybe a
Just (LeaderSchedule -> Maybe LeaderSchedule)
-> LeaderSchedule -> Maybe LeaderSchedule
forall a b. (a -> b) -> a -> b
$ NumCoreNodes -> NumSlots -> LeaderSchedule
roundRobinLeaderSchedule NumCoreNodes
numCoreNodes NumSlots
numSlots
, pgaSecurityParam :: SecurityParam
pgaSecurityParam = SecurityParam
k
, pgaTestConfig :: TestConfig
pgaTestConfig = TestConfig
testConfig
, pgaTestConfigB :: TestConfigB ByronBlock
pgaTestConfigB = TestConfigB ByronBlock
testConfigB
}
TestOutput ByronBlock
testOutput Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
Property
prop_pvu Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
Property
prop_svu Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
Bool -> Bool
not (((NodeId, Chain ByronBlock) -> Bool)
-> [(NodeId, Chain ByronBlock)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Chain ByronBlock -> Bool
forall block. Chain block -> Bool
Chain.null (Chain ByronBlock -> Bool)
-> ((NodeId, Chain ByronBlock) -> Chain ByronBlock)
-> (NodeId, Chain ByronBlock)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeId, Chain ByronBlock) -> Chain ByronBlock
forall a b. (a, b) -> b
snd) [(NodeId, Chain ByronBlock)]
finalChains) Bool -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
case Result
refResult of
Ref.Outcomes [Outcome]
outcomes ->
[Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin (((NodeId, Chain ByronBlock) -> Property)
-> [(NodeId, Chain ByronBlock)] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
map (SecurityParam
-> ProduceEBBs
-> [Outcome]
-> (NodeId, Chain ByronBlock)
-> Property
hasAllEBBs SecurityParam
k ProduceEBBs
produceEBBs [Outcome]
outcomes) [(NodeId, Chain ByronBlock)]
finalChains)
Result
_ -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
where
TestConfig
{ NodeTopology
nodeTopology :: TestConfig -> NodeTopology
nodeTopology :: NodeTopology
nodeTopology
, NumCoreNodes
numCoreNodes :: TestConfig -> NumCoreNodes
numCoreNodes :: NumCoreNodes
numCoreNodes
, NumSlots
numSlots :: TestConfig -> NumSlots
numSlots :: NumSlots
numSlots
, Seed
initSeed :: TestConfig -> Seed
initSeed :: Seed
initSeed
} = TestConfig
testConfig
testConfigB :: TestConfigB ByronBlock
testConfigB = TestConfigB
{ forgeEbbEnv :: Maybe (ForgeEbbEnv ByronBlock)
forgeEbbEnv = case ProduceEBBs
produceEBBs of
ProduceEBBs
NoEBBs -> Maybe (ForgeEbbEnv ByronBlock)
forall a. Maybe a
Nothing
ProduceEBBs
ProduceEBBs -> ForgeEbbEnv ByronBlock -> Maybe (ForgeEbbEnv ByronBlock)
forall a. a -> Maybe a
Just ForgeEbbEnv ByronBlock
byronForgeEbbEnv
, future :: Future
future = SlotLength -> EpochSize -> Future
singleEraFuture SlotLength
slotLength EpochSize
epochSize
, messageDelay :: CalcMessageDelay ByronBlock
messageDelay = CalcMessageDelay ByronBlock
forall blk. CalcMessageDelay blk
noCalcMessageDelay
, NodeJoinPlan
nodeJoinPlan :: NodeJoinPlan
nodeJoinPlan :: NodeJoinPlan
nodeJoinPlan
, NodeRestarts
nodeRestarts :: NodeRestarts
nodeRestarts :: NodeRestarts
nodeRestarts
, txGenExtra :: TxGenExtra ByronBlock
txGenExtra = ()
, version :: (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
version = (NodeToNodeVersion, BlockNodeToNodeVersion ByronBlock)
version
}
testOutput :: TestOutput ByronBlock
testOutput =
TestConfig
-> TestConfigB ByronBlock
-> (forall (m :: * -> *). IOLike m => TestConfigMB m ByronBlock)
-> TestOutput ByronBlock
forall blk.
(RunNode blk, TxGen blk, TracingConstraints blk, HasCallStack) =>
TestConfig
-> TestConfigB blk
-> (forall (m :: * -> *). IOLike m => TestConfigMB m blk)
-> TestOutput blk
runTestNetwork TestConfig
testConfig TestConfigB ByronBlock
testConfigB TestConfigMB
{ nodeInfo :: CoreNodeId -> TestNodeInitialization m ByronBlock
nodeInfo = \CoreNodeId
nid ->
PBftParams
-> CoreNodeId
-> Config
-> GeneratedSecrets
-> ProtocolVersion
-> TestNodeInitialization m ByronBlock
forall (m :: * -> *).
(Monad m, HasCallStack) =>
PBftParams
-> CoreNodeId
-> Config
-> GeneratedSecrets
-> ProtocolVersion
-> TestNodeInitialization m ByronBlock
mkProtocolByronAndHardForkTxs
PBftParams
params CoreNodeId
nid Config
genesisConfig GeneratedSecrets
genesisSecrets
ProtocolVersion
theProposedProtocolVersion
, mkRekeyM :: Maybe (m (RekeyM m ByronBlock))
mkRekeyM = m (RekeyM m ByronBlock) -> Maybe (m (RekeyM m ByronBlock))
forall a. a -> Maybe a
Just (m (RekeyM m ByronBlock) -> Maybe (m (RekeyM m ByronBlock)))
-> m (RekeyM m ByronBlock) -> Maybe (m (RekeyM m ByronBlock))
forall a b. (a -> b) -> a -> b
$ Rekeying m ByronBlock -> m (RekeyM m ByronBlock)
forall (m :: * -> *) blk.
IOLike m =>
Rekeying m blk -> m (RekeyM m blk)
fromRekeyingToRekeyM Rekeying
{ rekeyOracle :: CoreNodeId -> SlotNo -> Maybe SlotNo
rekeyOracle = \CoreNodeId
cid SlotNo
s ->
let nominalSlots :: Set SlotNo
nominalSlots = case Result
refResult of
Ref.Forked{} -> Set SlotNo
forall a. Set a
Set.empty
Ref.Outcomes [Outcome]
outcomes ->
[SlotNo] -> Set SlotNo
forall a. Ord a => [a] -> Set a
Set.fromList ([SlotNo] -> Set SlotNo) -> [SlotNo] -> Set SlotNo
forall a b. (a -> b) -> a -> b
$
[ SlotNo
s'
| (Outcome
Ref.Nominal, SlotNo
s') <- [Outcome] -> [SlotNo] -> [(Outcome, SlotNo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Outcome]
outcomes [SlotNo
0..]
, CoreNodeId
cid CoreNodeId -> CoreNodeId -> Bool
forall a. Eq a => a -> a -> Bool
/= PBftParams -> SlotNo -> CoreNodeId
Ref.mkLeaderOf PBftParams
params SlotNo
s'
]
Ref.Nondeterministic{} -> Set SlotNo
forall a. Set a
Set.empty
in SlotNo -> Set SlotNo -> Maybe SlotNo
forall a. Ord a => a -> Set a -> Maybe a
Set.lookupGT SlotNo
s Set SlotNo
nominalSlots
, rekeyUpd :: CoreNodeId
-> ProtocolInfo ByronBlock
-> m [BlockForging m ByronBlock]
-> EpochNo
-> SignKeyDSIGN ByronDSIGN
-> m (Maybe (TestNodeInitialization m ByronBlock))
rekeyUpd = Config
-> GeneratedSecrets
-> CoreNodeId
-> ProtocolInfo ByronBlock
-> m [BlockForging m ByronBlock]
-> EpochNo
-> SignKeyDSIGN ByronDSIGN
-> m (Maybe (TestNodeInitialization m ByronBlock))
forall (m :: * -> *).
Monad m =>
Config
-> GeneratedSecrets
-> CoreNodeId
-> ProtocolInfo ByronBlock
-> m [BlockForging m ByronBlock]
-> EpochNo
-> SignKeyDSIGN ByronDSIGN
-> m (Maybe (TestNodeInitialization m ByronBlock))
mkRekeyUpd Config
genesisConfig GeneratedSecrets
genesisSecrets
, rekeyFreshSKs :: Stream (SignKeyDSIGN ByronDSIGN)
rekeyFreshSKs =
let prj :: SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftVerKeyHash PBftByronCrypto
prj = VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftVerKeyHash PBftByronCrypto
forall c.
PBftCrypto c =>
VerKeyDSIGN (PBftDSIGN c) -> PBftVerKeyHash c
Crypto.hashVerKey (VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftVerKeyHash PBftByronCrypto)
-> (SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> VerKeyDSIGN (PBftDSIGN PBftByronCrypto))
-> SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftVerKeyHash PBftByronCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
Crypto.deriveVerKeyDSIGN
acc0 :: Set KeyHash
acc0 =
[KeyHash] -> Set KeyHash
forall a. Ord a => [a] -> Set a
Set.fromList ([KeyHash] -> Set KeyHash) -> [KeyHash] -> Set KeyHash
forall a b. (a -> b) -> a -> b
$
(Certificate -> KeyHash) -> [Certificate] -> [KeyHash]
forall a b. (a -> b) -> [a] -> [b]
map (VerificationKey -> KeyHash
Common.hashKey (VerificationKey -> KeyHash)
-> (Certificate -> VerificationKey) -> Certificate -> KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
Delegation.delegateVK) ([Certificate] -> [KeyHash]) -> [Certificate] -> [KeyHash]
forall a b. (a -> b) -> a -> b
$
Map KeyHash Certificate -> [Certificate]
forall k a. Map k a -> [a]
Map.elems (Map KeyHash Certificate -> [Certificate])
-> Map KeyHash Certificate -> [Certificate]
forall a b. (a -> b) -> a -> b
$
GenesisDelegation -> Map KeyHash Certificate
Genesis.unGenesisDelegation (GenesisDelegation -> Map KeyHash Certificate)
-> GenesisDelegation -> Map KeyHash Certificate
forall a b. (a -> b) -> a -> b
$
GenesisData -> GenesisDelegation
Genesis.gdHeavyDelegation (GenesisData -> GenesisDelegation)
-> GenesisData -> GenesisDelegation
forall a b. (a -> b) -> a -> b
$
Config -> GenesisData
Genesis.configGenesisData Config
genesisConfig
genKeyDSIGNRandom :: Gen (SignKeyDSIGN ByronDSIGN)
genKeyDSIGNRandom = do
Seed -> SignKeyDSIGN ByronDSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
Crypto.genKeyDSIGN (Seed -> SignKeyDSIGN ByronDSIGN)
-> ([Word8] -> Seed) -> [Word8] -> SignKeyDSIGN ByronDSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Seed
mkSeedFromBytes (ByteString -> Seed) -> ([Word8] -> ByteString) -> [Word8] -> Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack
([Word8] -> SignKeyDSIGN ByronDSIGN)
-> Gen [Word8] -> Gen (SignKeyDSIGN ByronDSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
in
(SignKeyDSIGN ByronDSIGN -> KeyHash)
-> Set KeyHash
-> Stream (SignKeyDSIGN ByronDSIGN)
-> Stream (SignKeyDSIGN ByronDSIGN)
forall b a. Ord b => (a -> b) -> Set b -> Stream a -> Stream a
Stream.nubOrdBy SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftVerKeyHash PBftByronCrypto
SignKeyDSIGN ByronDSIGN -> KeyHash
prj Set KeyHash
acc0 (Stream (SignKeyDSIGN ByronDSIGN)
-> Stream (SignKeyDSIGN ByronDSIGN))
-> Stream (SignKeyDSIGN ByronDSIGN)
-> Stream (SignKeyDSIGN ByronDSIGN)
forall a b. (a -> b) -> a -> b
$
Seed
-> Gen (Stream (SignKeyDSIGN ByronDSIGN))
-> Stream (SignKeyDSIGN ByronDSIGN)
forall a. Seed -> Gen a -> a
runGen Seed
initSeed (Gen (Stream (SignKeyDSIGN ByronDSIGN))
-> Stream (SignKeyDSIGN ByronDSIGN))
-> Gen (Stream (SignKeyDSIGN ByronDSIGN))
-> Stream (SignKeyDSIGN ByronDSIGN)
forall a b. (a -> b) -> a -> b
$
Stream (Gen (SignKeyDSIGN ByronDSIGN))
-> Gen (Stream (SignKeyDSIGN ByronDSIGN))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Stream (m a) -> m (Stream a)
sequence (Stream (Gen (SignKeyDSIGN ByronDSIGN))
-> Gen (Stream (SignKeyDSIGN ByronDSIGN)))
-> Stream (Gen (SignKeyDSIGN ByronDSIGN))
-> Gen (Stream (SignKeyDSIGN ByronDSIGN))
forall a b. (a -> b) -> a -> b
$ let ms :: Stream (Gen (SignKeyDSIGN ByronDSIGN))
ms = Gen (SignKeyDSIGN ByronDSIGN)
genKeyDSIGNRandom Gen (SignKeyDSIGN ByronDSIGN)
-> Stream (Gen (SignKeyDSIGN ByronDSIGN))
-> Stream (Gen (SignKeyDSIGN ByronDSIGN))
forall a. a -> Stream a -> Stream a
Stream.:< Stream (Gen (SignKeyDSIGN ByronDSIGN))
ms in Stream (Gen (SignKeyDSIGN ByronDSIGN))
ms
}
}
epochSize :: EpochSize
epochSize :: EpochSize
epochSize = EpochSlots -> EpochSize
fromByronEpochSlots (EpochSlots -> EpochSize) -> EpochSlots -> EpochSize
forall a b. (a -> b) -> a -> b
$ BlockCount -> EpochSlots
kEpochSlots (SecurityParam -> BlockCount
toByronBlockCount SecurityParam
k)
refResult :: Ref.Result
refResult :: Result
refResult = HasCallStack => PBftParams -> NodeJoinPlan -> NumSlots -> Result
PBftParams -> NodeJoinPlan -> NumSlots -> Result
Ref.simulate PBftParams
params NodeJoinPlan
nodeJoinPlan NumSlots
numSlots
finalChains :: [(NodeId, Chain ByronBlock)]
finalChains :: [(NodeId, Chain ByronBlock)]
finalChains = Map NodeId (Chain ByronBlock) -> [(NodeId, Chain ByronBlock)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map NodeId (Chain ByronBlock) -> [(NodeId, Chain ByronBlock)])
-> Map NodeId (Chain ByronBlock) -> [(NodeId, Chain ByronBlock)]
forall a b. (a -> b) -> a -> b
$ NodeOutput ByronBlock -> Chain ByronBlock
forall blk. NodeOutput blk -> Chain blk
nodeOutputFinalChain (NodeOutput ByronBlock -> Chain ByronBlock)
-> Map NodeId (NodeOutput ByronBlock)
-> Map NodeId (Chain ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestOutput ByronBlock -> Map NodeId (NodeOutput ByronBlock)
forall blk. TestOutput blk -> Map NodeId (NodeOutput blk)
testOutputNodes TestOutput ByronBlock
testOutput
finalLedgers :: [(NodeId, Byron.LedgerState ByronBlock)]
finalLedgers :: [(NodeId, LedgerState ByronBlock)]
finalLedgers = Map NodeId (LedgerState ByronBlock)
-> [(NodeId, LedgerState ByronBlock)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map NodeId (LedgerState ByronBlock)
-> [(NodeId, LedgerState ByronBlock)])
-> Map NodeId (LedgerState ByronBlock)
-> [(NodeId, LedgerState ByronBlock)]
forall a b. (a -> b) -> a -> b
$ NodeOutput ByronBlock -> LedgerState ByronBlock
forall blk. NodeOutput blk -> LedgerState blk
nodeOutputFinalLedger (NodeOutput ByronBlock -> LedgerState ByronBlock)
-> Map NodeId (NodeOutput ByronBlock)
-> Map NodeId (LedgerState ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestOutput ByronBlock -> Map NodeId (NodeOutput ByronBlock)
forall blk. TestOutput blk -> Map NodeId (NodeOutput blk)
testOutputNodes TestOutput ByronBlock
testOutput
pvuLabels :: [(NodeId, ProtocolVersionUpdateLabel)]
pvuLabels :: [(NodeId, ProtocolVersionUpdateLabel)]
pvuLabels = ((NodeId, (ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))
-> (NodeId, ProtocolVersionUpdateLabel))
-> [(NodeId,
(ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))]
-> [(NodeId, ProtocolVersionUpdateLabel)]
forall a b. (a -> b) -> [a] -> [b]
map (((ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel)
-> ProtocolVersionUpdateLabel)
-> (NodeId,
(ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))
-> (NodeId, ProtocolVersionUpdateLabel)
forall a b. (a -> b) -> (NodeId, a) -> (NodeId, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel)
-> ProtocolVersionUpdateLabel
forall a b. (a, b) -> a
fst) [(NodeId,
(ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))]
updLabels
svuLabels :: [(NodeId, SoftwareVersionUpdateLabel)]
svuLabels :: [(NodeId, SoftwareVersionUpdateLabel)]
svuLabels = ((NodeId, (ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))
-> (NodeId, SoftwareVersionUpdateLabel))
-> [(NodeId,
(ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))]
-> [(NodeId, SoftwareVersionUpdateLabel)]
forall a b. (a -> b) -> [a] -> [b]
map (((ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel)
-> SoftwareVersionUpdateLabel)
-> (NodeId,
(ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))
-> (NodeId, SoftwareVersionUpdateLabel)
forall a b. (a -> b) -> (NodeId, a) -> (NodeId, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel)
-> SoftwareVersionUpdateLabel
forall a b. (a, b) -> b
snd) [(NodeId,
(ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))]
updLabels
updLabels
:: [(NodeId, (ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))]
updLabels :: [(NodeId,
(ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))]
updLabels =
[ (,) NodeId
cid ((ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel)
-> (NodeId,
(ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel)))
-> (ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel)
-> (NodeId,
(ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel))
forall a b. (a -> b) -> a -> b
$
PBftParams
-> NumSlots
-> Config
-> NodeJoinPlan
-> NodeTopology
-> Result
-> LedgerState ByronBlock
-> (ProtocolVersionUpdateLabel, SoftwareVersionUpdateLabel)
mkUpdateLabels
PBftParams
params
NumSlots
numSlots
Config
genesisConfig
NodeJoinPlan
nodeJoinPlan
NodeTopology
nodeTopology
Result
refResult
LedgerState ByronBlock
ldgr
| (NodeId
cid, LedgerState ByronBlock
ldgr) <- [(NodeId, LedgerState ByronBlock)]
finalLedgers
]
aPvuRequired :: Bool
aPvuRequired :: Bool
aPvuRequired =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool
pvuRequired
| (NodeId
_, ProtocolVersionUpdateLabel{Maybe Bool
pvuRequired :: Maybe Bool
pvuRequired :: ProtocolVersionUpdateLabel -> Maybe Bool
pvuRequired}) <- [(NodeId, ProtocolVersionUpdateLabel)]
pvuLabels
]
aSvuRequired :: Bool
aSvuRequired :: Bool
aSvuRequired =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool
svuRequired
| (NodeId
_, SoftwareVersionUpdateLabel{Maybe Bool
svuRequired :: Maybe Bool
svuRequired :: SoftwareVersionUpdateLabel -> Maybe Bool
svuRequired}) <- [(NodeId, SoftwareVersionUpdateLabel)]
svuLabels
]
prop_pvu :: Property
prop_pvu :: Property
prop_pvu =
[Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([(NodeId, ProtocolVersionUpdateLabel)] -> [Char]
forall a. Show a => a -> [Char]
show [(NodeId, ProtocolVersionUpdateLabel)]
pvuLabels) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
[Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
[ [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ((NodeId, ProtocolVersionUpdateLabel) -> [Char]
forall a. Show a => a -> [Char]
show (NodeId
cid, ProtocolVersionUpdateLabel
pvuLabel)) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let ProtocolVersionUpdateLabel
{ Bool
pvuObserved :: Bool
pvuObserved :: ProtocolVersionUpdateLabel -> Bool
pvuObserved
, Maybe Bool
pvuRequired :: ProtocolVersionUpdateLabel -> Maybe Bool
pvuRequired :: Maybe Bool
pvuRequired
} = ProtocolVersionUpdateLabel
pvuLabel
in
Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ case Maybe Bool
pvuRequired of
Just Bool
b -> Bool
b Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
pvuObserved
Maybe Bool
Nothing -> Bool
True
| (NodeId
cid, ProtocolVersionUpdateLabel
pvuLabel) <- [(NodeId, ProtocolVersionUpdateLabel)]
pvuLabels
]
prop_svu :: Property
prop_svu :: Property
prop_svu =
[Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([(NodeId, SoftwareVersionUpdateLabel)] -> [Char]
forall a. Show a => a -> [Char]
show [(NodeId, SoftwareVersionUpdateLabel)]
svuLabels) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
[Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
[ [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ((NodeId, SoftwareVersionUpdateLabel) -> [Char]
forall a. Show a => a -> [Char]
show (NodeId
cid, SoftwareVersionUpdateLabel
svuLabel)) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
let SoftwareVersionUpdateLabel
{ Bool
svuObserved :: Bool
svuObserved :: SoftwareVersionUpdateLabel -> Bool
svuObserved
, Maybe Bool
svuRequired :: SoftwareVersionUpdateLabel -> Maybe Bool
svuRequired :: Maybe Bool
svuRequired
} = SoftwareVersionUpdateLabel
svuLabel
in
Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ case Maybe Bool
svuRequired of
Just Bool
b -> Bool
b Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
svuObserved
Maybe Bool
Nothing -> Bool
True
| (NodeId
cid, SoftwareVersionUpdateLabel
svuLabel) <- [(NodeId, SoftwareVersionUpdateLabel)]
svuLabels
]
params :: PBftParams
params :: PBftParams
params = SecurityParam -> NumCoreNodes -> PBftParams
byronPBftParams SecurityParam
k NumCoreNodes
numCoreNodes
genesisConfig :: Genesis.Config
genesisSecrets :: Genesis.GeneratedSecrets
(Config
genesisConfig, GeneratedSecrets
genesisSecrets) = SlotLength -> PBftParams -> (Config, GeneratedSecrets)
generateGenesisConfig SlotLength
slotLength PBftParams
params
byronForgeEbbEnv :: ForgeEbbEnv ByronBlock
byronForgeEbbEnv :: ForgeEbbEnv ByronBlock
byronForgeEbbEnv = ForgeEbbEnv
{ forgeEBB :: TopLevelConfig ByronBlock
-> SlotNo -> BlockNo -> ChainHash ByronBlock -> ByronBlock
forgeEBB = BlockConfig ByronBlock
-> SlotNo -> BlockNo -> ChainHash ByronBlock -> ByronBlock
Byron.forgeEBB (BlockConfig ByronBlock
-> SlotNo -> BlockNo -> ChainHash ByronBlock -> ByronBlock)
-> (TopLevelConfig ByronBlock -> BlockConfig ByronBlock)
-> TopLevelConfig ByronBlock
-> SlotNo
-> BlockNo
-> ChainHash ByronBlock
-> ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig ByronBlock -> BlockConfig ByronBlock
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock
}
data ProduceEBBs
= NoEBBs
| ProduceEBBs
deriving (ProduceEBBs -> ProduceEBBs -> Bool
(ProduceEBBs -> ProduceEBBs -> Bool)
-> (ProduceEBBs -> ProduceEBBs -> Bool) -> Eq ProduceEBBs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProduceEBBs -> ProduceEBBs -> Bool
== :: ProduceEBBs -> ProduceEBBs -> Bool
$c/= :: ProduceEBBs -> ProduceEBBs -> Bool
/= :: ProduceEBBs -> ProduceEBBs -> Bool
Eq, Int -> ProduceEBBs -> ShowS
[ProduceEBBs] -> ShowS
ProduceEBBs -> [Char]
(Int -> ProduceEBBs -> ShowS)
-> (ProduceEBBs -> [Char])
-> ([ProduceEBBs] -> ShowS)
-> Show ProduceEBBs
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProduceEBBs -> ShowS
showsPrec :: Int -> ProduceEBBs -> ShowS
$cshow :: ProduceEBBs -> [Char]
show :: ProduceEBBs -> [Char]
$cshowList :: [ProduceEBBs] -> ShowS
showList :: [ProduceEBBs] -> ShowS
Show)
noEBBs :: ProduceEBBs
noEBBs :: ProduceEBBs
noEBBs = ProduceEBBs
NoEBBs
instance Arbitrary ProduceEBBs where
arbitrary :: Gen ProduceEBBs
arbitrary = [ProduceEBBs] -> Gen ProduceEBBs
forall a. [a] -> Gen a
elements [ProduceEBBs
NoEBBs, ProduceEBBs
ProduceEBBs]
shrink :: ProduceEBBs -> [ProduceEBBs]
shrink ProduceEBBs
NoEBBs = []
shrink ProduceEBBs
ProduceEBBs = [ProduceEBBs
NoEBBs]
hasAllEBBs :: SecurityParam
-> ProduceEBBs
-> [Ref.Outcome]
-> (NodeId, Chain ByronBlock)
-> Property
hasAllEBBs :: SecurityParam
-> ProduceEBBs
-> [Outcome]
-> (NodeId, Chain ByronBlock)
-> Property
hasAllEBBs SecurityParam
k ProduceEBBs
produceEBBs [Outcome]
outcomes (NodeId
nid, Chain ByronBlock
c) =
[Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char]
"Missing or unexpected EBBs in " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (NodeId, Chain ByronBlock) -> [Char]
forall a. Condense a => a -> [Char]
condense (NodeId
nid, Chain ByronBlock
c)) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
[EpochNo]
actual [EpochNo] -> [EpochNo] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [EpochNo]
expected
where
expected :: [EpochNo]
expected :: [EpochNo]
expected = case ProduceEBBs
produceEBBs of
ProduceEBBs
NoEBBs -> [EpochNo
0]
ProduceEBBs
ProduceEBBs -> case [SlotNo] -> [SlotNo]
forall a. [a] -> [a]
reverse [ SlotNo
s :: SlotNo | (Outcome
Ref.Nominal, SlotNo
s) <- [Outcome] -> [SlotNo] -> [(Outcome, SlotNo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Outcome]
outcomes [SlotNo
0..] ] of
[] -> [EpochNo
0]
SlotNo
s:[SlotNo]
_ -> [Word64] -> [EpochNo]
forall a b. Coercible a b => a -> b
coerce [Word64
0 .. Word64
hi]
where
hi :: Word64
hi :: Word64
hi = SlotNo -> Word64
unSlotNo SlotNo
s Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
denom
denom :: Word64
denom = EpochSlots -> Word64
unEpochSlots (EpochSlots -> Word64) -> EpochSlots -> Word64
forall a b. (a -> b) -> a -> b
$ BlockCount -> EpochSlots
kEpochSlots (BlockCount -> EpochSlots) -> BlockCount -> EpochSlots
forall a b. (a -> b) -> a -> b
$ SecurityParam -> BlockCount
forall a b. Coercible a b => a -> b
coerce SecurityParam
k
actual :: [EpochNo]
actual = (ByronBlock -> Maybe EpochNo) -> [ByronBlock] -> [EpochNo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ByronBlock -> Maybe EpochNo
forall blk. GetHeader blk => blk -> Maybe EpochNo
blockIsEBB ([ByronBlock] -> [EpochNo]) -> [ByronBlock] -> [EpochNo]
forall a b. (a -> b) -> a -> b
$ Chain ByronBlock -> [ByronBlock]
forall block. Chain block -> [block]
Chain.toOldestFirst Chain ByronBlock
c
genSlot :: SlotNo -> SlotNo -> Gen SlotNo
genSlot :: SlotNo -> SlotNo -> Gen SlotNo
genSlot SlotNo
lo SlotNo
hi = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
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 (SlotNo -> Word64
unSlotNo SlotNo
lo, SlotNo -> Word64
unSlotNo SlotNo
hi)
genByronNodeJoinPlan :: PBftParams -> NumSlots -> Gen NodeJoinPlan
genByronNodeJoinPlan :: PBftParams -> NumSlots -> Gen NodeJoinPlan
genByronNodeJoinPlan PBftParams
params numSlots :: NumSlots
numSlots@(NumSlots Word64
t)
| Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
0 Bool -> Bool -> Bool
|| Word64
t Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
1 = [Char] -> Gen NodeJoinPlan
forall a. HasCallStack => [Char] -> a
error ([Char] -> Gen NodeJoinPlan) -> [Char] -> Gen NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot generate Byron NodeJoinPlan: "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (PBftParams, NumSlots) -> [Char]
forall a. Show a => a -> [Char]
show (PBftParams
params, NumSlots
numSlots)
| Bool
otherwise =
NodeJoinPlan -> State -> Gen NodeJoinPlan
go (Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan Map CoreNodeId SlotNo
forall k a. Map k a
Map.empty) State
Ref.emptyState
Gen NodeJoinPlan -> (NodeJoinPlan -> Bool) -> Gen NodeJoinPlan
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (\NodeJoinPlan
njp -> PBftParams -> Result -> Bool
Ref.definitelyEnoughBlocks PBftParams
params (Result -> Bool) -> Result -> Bool
forall a b. (a -> b) -> a -> b
$
HasCallStack => PBftParams -> NodeJoinPlan -> NumSlots -> Result
PBftParams -> NodeJoinPlan -> NumSlots -> Result
Ref.simulate PBftParams
params NodeJoinPlan
njp NumSlots
numSlots)
where
PBftParams{NumCoreNodes
pbftNumNodes :: NumCoreNodes
pbftNumNodes :: PBftParams -> NumCoreNodes
pbftNumNodes} = PBftParams
params
NumCoreNodes Word64
n = NumCoreNodes
pbftNumNodes
sentinel :: SlotNo
sentinel = Word64 -> SlotNo
SlotNo Word64
t
lastSlot :: SlotNo
lastSlot = SlotNo -> SlotNo
forall a. Enum a => a -> a
pred SlotNo
sentinel
go ::
NodeJoinPlan
-> Ref.State
-> Gen NodeJoinPlan
go :: NodeJoinPlan -> State -> Gen NodeJoinPlan
go nodeJoinPlan :: NodeJoinPlan
nodeJoinPlan@(NodeJoinPlan Map CoreNodeId SlotNo
m) State
st
| Word64
i Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
n = NodeJoinPlan -> Gen NodeJoinPlan
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeJoinPlan -> Gen NodeJoinPlan)
-> NodeJoinPlan -> Gen NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan Map CoreNodeId SlotNo
m
| Bool
otherwise = do
let check :: SlotNo -> Bool
check SlotNo
s' =
PBftParams -> SlotNo -> NodeJoinPlan -> State -> Bool
Ref.viable PBftParams
params SlotNo
sentinel
(Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (CoreNodeId
-> SlotNo -> Map CoreNodeId SlotNo -> Map CoreNodeId SlotNo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CoreNodeId
nid SlotNo
s' Map CoreNodeId SlotNo
m))
State
st
lo :: SlotNo
lo = State -> SlotNo
Ref.nextSlot State
st
inn :: SlotNo -> Word64
inn = (Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-) (Word64 -> Word64) -> (SlotNo -> Word64) -> SlotNo -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Word64
unSlotNo
out :: Word64 -> SlotNo
out = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> (Word64 -> Word64) -> Word64 -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-)
SlotNo
s' <- case Word64 -> SlotNo
out (Word64 -> SlotNo) -> Maybe Word64 -> Maybe SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> Bool) -> Word64 -> Word64 -> Maybe Word64
forall a. Integral a => (a -> Bool) -> a -> a -> Maybe a
searchFromTo (SlotNo -> Bool
check (SlotNo -> Bool) -> (Word64 -> SlotNo) -> Word64 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
out) (SlotNo -> Word64
inn SlotNo
lastSlot) (SlotNo -> Word64
inn SlotNo
lo) of
Just SlotNo
hi -> SlotNo -> SlotNo -> Gen SlotNo
genSlot SlotNo
lo SlotNo
hi
Maybe SlotNo
Nothing -> [Char] -> Gen SlotNo
forall a. HasCallStack => [Char] -> a
error ([Char] -> Gen SlotNo) -> [Char] -> Gen SlotNo
forall a b. (a -> b) -> a -> b
$
[Char]
"Cannot find viable Byron NodeJoinPlan: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
(PBftParams, NumSlots, NodeJoinPlan, State) -> [Char]
forall a. Show a => a -> [Char]
show (PBftParams
params, NumSlots
numSlots, NodeJoinPlan
nodeJoinPlan, State
st)
let m' :: Map CoreNodeId SlotNo
m' = CoreNodeId
-> SlotNo -> Map CoreNodeId SlotNo -> Map CoreNodeId SlotNo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CoreNodeId
nid SlotNo
s' Map CoreNodeId SlotNo
m
st' :: State
st' = PBftParams -> NodeJoinPlan -> State -> SlotNo -> State
Ref.advanceUpTo PBftParams
params NodeJoinPlan
nodeJoinPlan State
st SlotNo
s'
NodeJoinPlan -> State -> Gen NodeJoinPlan
go (Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan Map CoreNodeId SlotNo
m') State
st'
where
nid :: CoreNodeId
nid = Word64 -> CoreNodeId
CoreNodeId Word64
i
i :: Word64
i = case (CoreNodeId, SlotNo) -> CoreNodeId
forall a b. (a, b) -> a
fst ((CoreNodeId, SlotNo) -> CoreNodeId)
-> Maybe (CoreNodeId, SlotNo) -> Maybe CoreNodeId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map CoreNodeId SlotNo -> Maybe (CoreNodeId, SlotNo)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map CoreNodeId SlotNo
m of
Maybe CoreNodeId
Nothing -> Word64
0
Just (CoreNodeId Word64
h) -> Word64 -> Word64
forall a. Enum a => a -> a
succ Word64
h
genNodeRekeys ::
PBftParams
-> NodeJoinPlan
-> NodeTopology
-> NumSlots
-> NodeRestarts
-> Gen NodeRestarts
genNodeRekeys :: PBftParams
-> NodeJoinPlan
-> NodeTopology
-> NumSlots
-> NodeRestarts
-> Gen NodeRestarts
genNodeRekeys PBftParams
params NodeJoinPlan
nodeJoinPlan NodeTopology
nodeTopology numSlots :: NumSlots
numSlots@(NumSlots Word64
t)
nodeRestarts :: NodeRestarts
nodeRestarts@(NodeRestarts Map SlotNo (Map CoreNodeId NodeRestart)
nrs)
| Word64
t Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0 = NodeRestarts -> Gen NodeRestarts
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeRestarts
nodeRestarts
| Bool
otherwise =
(\Gen NodeRestarts
x -> [(Int, Gen NodeRestarts)] -> Gen NodeRestarts
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
2, NodeRestarts -> Gen NodeRestarts
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeRestarts
nodeRestarts), (Int
8, Gen NodeRestarts
x)]) (Gen NodeRestarts -> Gen NodeRestarts)
-> Gen NodeRestarts -> Gen NodeRestarts
forall a b. (a -> b) -> a -> b
$
case Map CoreNodeId SlotNo -> Maybe (CoreNodeId, SlotNo)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map CoreNodeId SlotNo
njp of
Just (CoreNodeId
cid, SlotNo
jslot)
| SlotNo
jslot SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= SlotNo
beginSecondEpoch
, SecurityParam -> NumCoreNodes -> SlotNo -> SlotNo
latestPossibleDlgMaturation SecurityParam
pbftSecurityParam NumCoreNodes
numCoreNodes SlotNo
jslot
SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
sentinel
, let nodeJoinPlan' :: NodeJoinPlan
nodeJoinPlan' =
Map CoreNodeId SlotNo -> NodeJoinPlan
NodeJoinPlan (Map CoreNodeId SlotNo -> NodeJoinPlan)
-> Map CoreNodeId SlotNo -> NodeJoinPlan
forall a b. (a -> b) -> a -> b
$ CoreNodeId
-> SlotNo -> Map CoreNodeId SlotNo -> Map CoreNodeId SlotNo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CoreNodeId
cid (SlotNo
jslot SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ SlotNo
twoK) Map CoreNodeId SlotNo
njp
, PBftParams -> Result -> Bool
Ref.definitelyEnoughBlocks PBftParams
params (Result -> Bool) -> Result -> Bool
forall a b. (a -> b) -> a -> b
$
HasCallStack => PBftParams -> NodeJoinPlan -> NumSlots -> Result
PBftParams -> NodeJoinPlan -> NumSlots -> Result
Ref.simulate PBftParams
params NodeJoinPlan
nodeJoinPlan' NumSlots
numSlots
, let nextLeader :: CoreNodeId
nextLeader = PBftParams -> SlotNo -> CoreNodeId
Ref.mkLeaderOf PBftParams
params (SlotNo -> CoreNodeId) -> SlotNo -> CoreNodeId
forall a b. (a -> b) -> a -> b
$ SlotNo -> SlotNo
forall a. Enum a => a -> a
succ SlotNo
jslot
, SlotNo
jslot SlotNo -> SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
/= HasCallStack => NodeJoinPlan -> CoreNodeId -> SlotNo
NodeJoinPlan -> CoreNodeId -> SlotNo
coreNodeIdJoinSlot NodeJoinPlan
nodeJoinPlan CoreNodeId
nextLeader Bool -> Bool -> Bool
||
CoreNodeId
cid CoreNodeId -> [CoreNodeId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HasCallStack => NodeTopology -> CoreNodeId -> [CoreNodeId]
NodeTopology -> CoreNodeId -> [CoreNodeId]
coreNodeIdNeighbors NodeTopology
nodeTopology CoreNodeId
nextLeader
-> NodeRestarts -> Gen NodeRestarts
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeRestarts -> Gen NodeRestarts)
-> NodeRestarts -> Gen NodeRestarts
forall a b. (a -> b) -> a -> b
$ Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
NodeRestarts (Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts)
-> Map SlotNo (Map CoreNodeId NodeRestart) -> NodeRestarts
forall a b. (a -> b) -> a -> b
$
SlotNo
-> Map CoreNodeId NodeRestart
-> Map SlotNo (Map CoreNodeId NodeRestart)
-> Map SlotNo (Map CoreNodeId NodeRestart)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SlotNo
jslot (CoreNodeId -> NodeRestart -> Map CoreNodeId NodeRestart
forall k a. k -> a -> Map k a
Map.singleton CoreNodeId
cid NodeRestart
NodeRekey) Map SlotNo (Map CoreNodeId NodeRestart)
nrs
Maybe (CoreNodeId, SlotNo)
_ -> NodeRestarts -> Gen NodeRestarts
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeRestarts
nodeRestarts
where
PBftParams{SecurityParam
pbftSecurityParam :: SecurityParam
pbftSecurityParam :: PBftParams -> SecurityParam
pbftSecurityParam} = PBftParams
params
k :: Word64
k = SecurityParam -> Word64
maxRollbacks SecurityParam
pbftSecurityParam
sentinel :: SlotNo
sentinel = Word64 -> SlotNo
SlotNo Word64
t
numCoreNodes :: NumCoreNodes
numCoreNodes = Word64 -> NumCoreNodes
NumCoreNodes (Word64 -> NumCoreNodes) -> Word64 -> NumCoreNodes
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Map CoreNodeId SlotNo -> Int
forall k a. Map k a -> Int
Map.size Map CoreNodeId SlotNo
njp
NodeJoinPlan Map CoreNodeId SlotNo
njp = NodeJoinPlan
nodeJoinPlan
twoK :: SlotNo
twoK = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
k
beginSecondEpoch :: SlotNo
beginSecondEpoch = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Word64
10 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
k
mkRekeyUpd ::
Monad m
=> Genesis.Config
-> Genesis.GeneratedSecrets
-> CoreNodeId
-> ProtocolInfo ByronBlock
-> m [BlockForging m ByronBlock]
-> EpochNo
-> Crypto.SignKeyDSIGN Crypto.ByronDSIGN
-> m (Maybe (TestNodeInitialization m ByronBlock))
mkRekeyUpd :: forall (m :: * -> *).
Monad m =>
Config
-> GeneratedSecrets
-> CoreNodeId
-> ProtocolInfo ByronBlock
-> m [BlockForging m ByronBlock]
-> EpochNo
-> SignKeyDSIGN ByronDSIGN
-> m (Maybe (TestNodeInitialization m ByronBlock))
mkRekeyUpd Config
genesisConfig GeneratedSecrets
genesisSecrets CoreNodeId
cid ProtocolInfo ByronBlock
pInfo m [BlockForging m ByronBlock]
blockForging EpochNo
eno SignKeyDSIGN ByronDSIGN
newSK = do
m [BlockForging m ByronBlock]
blockForging m [BlockForging m ByronBlock]
-> ([BlockForging m ByronBlock]
-> Maybe (TestNodeInitialization m ByronBlock))
-> m (Maybe (TestNodeInitialization m ByronBlock))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
[] -> Maybe (TestNodeInitialization m ByronBlock)
forall a. Maybe a
Nothing
(BlockForging m ByronBlock
_:[BlockForging m ByronBlock]
_) ->
let genSK :: SignKeyDSIGN ByronDSIGN
genSK = Config -> GeneratedSecrets -> CoreNodeId -> SignKeyDSIGN ByronDSIGN
genesisSecretFor Config
genesisConfig GeneratedSecrets
genesisSecrets CoreNodeId
cid
creds' :: ByronLeaderCredentials
creds' = SignKeyDSIGN ByronDSIGN
-> BlockConfig ByronBlock
-> CoreNodeId
-> EpochNumber
-> SignKeyDSIGN ByronDSIGN
-> ByronLeaderCredentials
updSignKey SignKeyDSIGN ByronDSIGN
genSK BlockConfig ByronBlock
bcfg CoreNodeId
cid (EpochNo -> EpochNumber
forall a b. Coercible a b => a -> b
coerce EpochNo
eno) SignKeyDSIGN ByronDSIGN
newSK
blockForging' :: BlockForging m ByronBlock
blockForging' = ByronLeaderCredentials -> BlockForging m ByronBlock
forall (m :: * -> *).
Monad m =>
ByronLeaderCredentials -> BlockForging m ByronBlock
byronBlockForging ByronLeaderCredentials
creds'
in TestNodeInitialization m ByronBlock
-> Maybe (TestNodeInitialization m ByronBlock)
forall a. a -> Maybe a
Just TestNodeInitialization
{ tniCrucialTxs :: [GenTx ByronBlock]
tniCrucialTxs = [Certificate -> GenTx ByronBlock
dlgTx (ByronLeaderCredentials -> Certificate
blcDlgCert ByronLeaderCredentials
creds')]
, tniProtocolInfo :: ProtocolInfo ByronBlock
tniProtocolInfo = ProtocolInfo ByronBlock
pInfo
, tniBlockForging :: m [BlockForging m ByronBlock]
tniBlockForging = [BlockForging m ByronBlock] -> m [BlockForging m ByronBlock]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [BlockForging m ByronBlock
blockForging']
}
where
bcfg :: BlockConfig ByronBlock
bcfg = TopLevelConfig ByronBlock -> BlockConfig ByronBlock
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock (ProtocolInfo ByronBlock -> TopLevelConfig ByronBlock
forall b. ProtocolInfo b -> TopLevelConfig b
pInfoConfig ProtocolInfo ByronBlock
pInfo)
genesisSecretFor ::
Genesis.Config
-> Genesis.GeneratedSecrets
-> CoreNodeId
-> Crypto.SignKeyDSIGN Crypto.ByronDSIGN
genesisSecretFor :: Config -> GeneratedSecrets -> CoreNodeId -> SignKeyDSIGN ByronDSIGN
genesisSecretFor Config
genesisConfig GeneratedSecrets
genesisSecrets CoreNodeId
cid =
case [SigningKey]
hits of
[SigningKey
sec] -> SigningKey -> SignKeyDSIGN ByronDSIGN
Crypto.SignKeyByronDSIGN SigningKey
sec
[SigningKey]
_ -> [Char] -> SignKeyDSIGN ByronDSIGN
forall a. HasCallStack => [Char] -> a
error ([Char] -> SignKeyDSIGN ByronDSIGN)
-> [Char] -> SignKeyDSIGN ByronDSIGN
forall a b. (a -> b) -> a -> b
$ [Char]
"Not exactly one genesis key " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (CoreNodeId, [SigningKey]) -> [Char]
forall a. Show a => a -> [Char]
show (CoreNodeId
cid, [SigningKey]
hits)
where
hits :: [Crypto.SigningKey]
hits :: [SigningKey]
hits =
(SigningKey -> Bool) -> [SigningKey] -> [SigningKey]
forall a. (a -> Bool) -> [a] -> [a]
filter
((CoreNodeId -> Maybe CoreNodeId
forall a. a -> Maybe a
Just CoreNodeId
cid Maybe CoreNodeId -> Maybe CoreNodeId -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe CoreNodeId -> Bool)
-> (SigningKey -> Maybe CoreNodeId) -> SigningKey -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey -> Maybe CoreNodeId
gkToIdx)
(GeneratedSecrets -> [SigningKey]
Genesis.gsDlgIssuersSecrets GeneratedSecrets
genesisSecrets)
gkToIdx :: Crypto.SigningKey -> Maybe CoreNodeId
gkToIdx :: SigningKey -> Maybe CoreNodeId
gkToIdx =
Config -> VerKeyDSIGN ByronDSIGN -> Maybe CoreNodeId
genesisKeyCoreNodeId Config
genesisConfig
(VerKeyDSIGN ByronDSIGN -> Maybe CoreNodeId)
-> (SigningKey -> VerKeyDSIGN ByronDSIGN)
-> SigningKey
-> Maybe CoreNodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey -> VerKeyDSIGN ByronDSIGN
Crypto.VerKeyByronDSIGN (VerificationKey -> VerKeyDSIGN ByronDSIGN)
-> (SigningKey -> VerificationKey)
-> SigningKey
-> VerKeyDSIGN ByronDSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey -> VerificationKey
Crypto.toVerification
updSignKey ::
Crypto.SignKeyDSIGN Crypto.ByronDSIGN
-> BlockConfig ByronBlock
-> CoreNodeId
-> EpochNumber
-> Crypto.SignKeyDSIGN Crypto.ByronDSIGN
-> ByronLeaderCredentials
updSignKey :: SignKeyDSIGN ByronDSIGN
-> BlockConfig ByronBlock
-> CoreNodeId
-> EpochNumber
-> SignKeyDSIGN ByronDSIGN
-> ByronLeaderCredentials
updSignKey SignKeyDSIGN ByronDSIGN
genSK BlockConfig ByronBlock
extCfg CoreNodeId
cid EpochNumber
eno SignKeyDSIGN ByronDSIGN
newSK =
ByronLeaderCredentials {
$sel:blcSignKey:ByronLeaderCredentials :: SigningKey
blcSignKey = SigningKey
sk'
, $sel:blcDlgCert:ByronLeaderCredentials :: Certificate
blcDlgCert = Certificate
newCert
, $sel:blcCoreNodeId:ByronLeaderCredentials :: CoreNodeId
blcCoreNodeId = CoreNodeId
cid
, $sel:blcLabel:ByronLeaderCredentials :: Text
blcLabel = Text
"Updated Byron credentials"
}
where
newCert :: Certificate
newCert =
ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
Delegation.signCertificate
(BlockConfig ByronBlock -> ProtocolMagicId
Byron.byronProtocolMagicId BlockConfig ByronBlock
extCfg)
(SigningKey -> VerificationKey
Crypto.toVerification SigningKey
sk')
EpochNumber
eno
(SigningKey -> SafeSigner
Crypto.noPassSafeSigner SigningKey
gsk')
Crypto.SignKeyByronDSIGN SigningKey
gsk' = SignKeyDSIGN ByronDSIGN
genSK
Crypto.SignKeyByronDSIGN SigningKey
sk' = SignKeyDSIGN ByronDSIGN
newSK
dlgTx :: Delegation.Certificate -> Byron.GenTx ByronBlock
dlgTx :: Certificate -> GenTx ByronBlock
dlgTx Certificate
cert =
let ann :: ByteString
ann = Certificate -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize' (Certificate
cert :: Delegation.Certificate)
cert' :: ACertificate ByteString
cert' = Certificate
cert
{ Delegation.aEpoch =
reAnnotate byronProtVer (Delegation.aEpoch cert)
, Delegation.annotation = ann
}
in CertificateId -> ACertificate ByteString -> GenTx ByronBlock
Byron.ByronDlg (ACertificate ByteString -> CertificateId
Delegation.recoverCertificateId ACertificate ByteString
cert') ACertificate ByteString
cert'