+
{-# LANGUAGE DeriveGeneric #-}
+
{-# LANGUAGE DerivingVia #-}
+
{-# LANGUAGE FlexibleContexts #-}
+
{-# LANGUAGE FlexibleInstances #-}
+
{-# LANGUAGE LambdaCase #-}
+
{-# LANGUAGE MultiWayIf #-}
+
{-# LANGUAGE NamedFieldPuns #-}
+
{-# LANGUAGE OverloadedStrings #-}
+
{-# LANGUAGE ScopedTypeVariables #-}
+
{-# LANGUAGE StandaloneDeriving #-}
+
{-# LANGUAGE TypeApplications #-}
+
{-# LANGUAGE TypeFamilies #-}
+
{-# LANGUAGE UndecidableInstances #-}
+
{-# OPTIONS_GHC -Wno-orphans #-}
+
module Test.ThreadNet.MaryAlonzo (tests) where
+
import Control.Monad (replicateM)
+
import qualified Data.Map as Map
+
import Data.Maybe (maybeToList)
+
import Data.Proxy (Proxy (..))
+
import Data.SOP.Strict (NP (..))
+
import qualified Data.Set as Set
+
import Data.Word (Word64)
+
import Test.Tasty.QuickCheck
+
import Cardano.Crypto.Hash (ShortHash)
+
import Cardano.Slotting.Slot (EpochSize (..), SlotNo (..))
+
import Ouroboros.Consensus.BlockchainTime
+
import Ouroboros.Consensus.Config.SecurityParam
+
import Ouroboros.Consensus.Ledger.SupportsMempool (extractTxs)
+
import Ouroboros.Consensus.Node.NetworkProtocolVersion
+
import Ouroboros.Consensus.Node.ProtocolInfo
+
import Ouroboros.Consensus.NodeId
+
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
+
(isHardForkNodeToNodeEnabled)
+
import qualified Cardano.Ledger.Alonzo.Scripts as SL
+
import Cardano.Ledger.Alonzo.Translation (AlonzoGenesis (..))
+
import qualified Shelley.Spec.Ledger.API as SL
+
import Ouroboros.Consensus.Shelley.Eras
+
import Ouroboros.Consensus.Shelley.Node
+
(ProtocolParamsShelleyBased (..), ShelleyGenesis (..))
+
import Ouroboros.Consensus.Cardano.Condense ()
+
import Ouroboros.Consensus.Cardano.Node
+
(ProtocolParamsTransition (..), TriggerHardFork (..))
+
import Test.ThreadNet.General
+
import Test.ThreadNet.Network (NodeOutput (..),
+
TestNodeInitialization (..))
+
import Test.ThreadNet.Util.Expectations (NumBlocks (..))
+
import Test.ThreadNet.Util.NodeJoinPlan (trivialNodeJoinPlan)
+
import Test.ThreadNet.Util.NodeRestarts (noRestarts)
+
import Test.ThreadNet.Util.NodeToNodeVersion (genVersionFiltered)
+
import Test.ThreadNet.Util.Seed (runGen)
+
import qualified Test.Util.BoolProps as BoolProps
+
import Test.Util.HardFork.Future (EraSize (..), Future (..))
+
import Test.Util.Nightly (askIohkNightlyEnabled)
+
import Test.Util.Orphans.Arbitrary ()
+
import Test.Util.Slots (NumSlots (..))
+
import Test.Consensus.Shelley.MockCrypto (MockCrypto)
+
import qualified Test.ThreadNet.Infra.Shelley as Shelley
+
import Test.ThreadNet.Infra.ShelleyBasedHardFork
+
import Test.ThreadNet.TxGen
+
import Test.ThreadNet.TxGen.Mary ()
+
import Test.ThreadNet.TxGen.Alonzo ()
+
import Test.ThreadNet.Infra.TwoEras
+
-- | No Byron era, so our crypto can be trivial.
+
type Crypto = MockCrypto ShortHash
+
ShelleyBasedHardForkBlock (MaryEra Crypto) (AlonzoEra Crypto)
+
-- | The varying data of this test
+
-- Note: The Shelley nodes in this test all join, propose an update, and endorse
+
-- it literally as soon as possible. Therefore, if the test reaches the end of
+
-- the first epoch, the proposal will be adopted.
+
data TestSetup = TestSetup
+
{ setupD :: Shelley.DecentralizationParam
+
, setupHardFork :: Bool
+
-- ^ whether the proposal should trigger a hard fork or not
+
, setupInitialNonce :: SL.Nonce
+
-- ^ the initial Shelley 'SL.ticknStateEpochNonce'
+
-- We vary it to ensure we explore different leader schedules.
+
, setupK :: SecurityParam
+
, setupPartition :: Partition
+
, setupSlotLength :: SlotLength
+
, setupTestConfig :: TestConfig
+
, setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion MaryAlonzoBlock)
+
instance Arbitrary TestSetup where
+
-- The decentralization parameter cannot be 0 in the first
+
-- Shelley epoch, since stake pools can only be created and
+
-- delegated to via Shelley transactions.
+
`suchThat` ((/= 0) . Shelley.decentralizationParamToRational)
+
setupK <- SecurityParam <$> choose (8, 10)
+
-- If k < 8, common prefix violations become too likely in
+
-- Praos mode for thin overlay schedules (ie low d), even for
+
setupInitialNonce <- genNonce
+
setupSlotLength <- arbitrary
+
let epochSize = EpochSize $ shelleyEpochSize setupK
+
setupTestConfig <- genTestConfig
+
let TestConfig{numCoreNodes, numSlots} = setupTestConfig
+
setupHardFork <- frequency [(49, pure True), (1, pure False)]
+
-- TODO How reliable is the Byron-based partition duration logic when
+
setupPartition <- genPartition numCoreNodes numSlots setupK
+
setupVersion <- genVersionFiltered
+
isHardForkNodeToNodeEnabled
+
(Proxy @MaryAlonzoBlock)
+
-- | Run relatively fewer tests
+
-- These tests are slow, so we settle for running fewer of them in this test
+
-- suite since it is invoked frequently (eg CI for each push).
+
oneTenthTestCount :: QuickCheckTests -> QuickCheckTests
+
oneTenthTestCount (QuickCheckTests n) = QuickCheckTests $
+
tests = testGroup "MaryAlonzo ThreadNet" $
+
[ let name = "simple convergence" in
+
askIohkNightlyEnabled $ \enabled ->
+
(if enabled then id else adjustOption oneTenthTestCount) $
+
testProperty name $ \setup ->
+
prop_simple_allegraAlonzo_convergence setup
+
prop_simple_allegraAlonzo_convergence :: TestSetup -> Property
+
prop_simple_allegraAlonzo_convergence TestSetup
+
prop_general_semisync pga testOutput .&&.
+
prop_inSync testOutput .&&.
+
prop_ReachesEra2 reachesEra2 .&&.
+
prop_noCPViolation .&&.
+
( tabulate "ReachesEra2 label" [label_ReachesEra2 reachesEra2] $
+
tabulate "Observed forge during a non-overlay slot in the second era"
+
[ label_hadActiveNonOverlaySlots
+
tabulatePartitionDuration setupK setupPartition $
+
tabulateFinalIntersectionDepth
+
(NumBlocks finalIntersectionDepth)
+
tabulatePartitionPosition
+
(NumSlots numFirstEraSlots)
+
(ledgerReachesEra2 reachesEra2) $