{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Test.Cardano.Ledger.Shelley.PropertyTests ( commonTests, ) where import Cardano.Ledger.BaseTypes (Globals) import Cardano.Ledger.Core import Cardano.Ledger.Shelley.API (LedgerState) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.Rules (LedgerEnv) import Control.Monad.Trans.Reader (ReaderT) import Control.State.Transition import Data.Functor.Identity (Identity) import Test.Cardano.Ledger.Shelley.Generator.Core (GenEnv) import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen) import Test.Cardano.Ledger.Shelley.Rules.Chain (CHAIN) import qualified Test.Control.State.Transition.Trace.Generator.QuickCheck as QC import qualified Test.Cardano.Ledger.Shelley.ByronTranslation as ByronTranslation ( testGroupByronTranslation, ) import qualified Test.Cardano.Ledger.Shelley.Rules.AdaPreservation as AdaPreservation import qualified Test.Cardano.Ledger.Shelley.Rules.ClassifyTraces as ClassifyTraces ( onlyValidChainSignalsAreGenerated, onlyValidLedgerSignalsAreGenerated, relevantCasesAreCovered, ) import qualified Test.Cardano.Ledger.Shelley.Rules.CollisionFreeness as ColllisionFree (tests) import qualified Test.Cardano.Ledger.Shelley.Rules.Deleg as Deleg (tests) import qualified Test.Cardano.Ledger.Shelley.Rules.IncrementalStake as IncrementalStake ( incrStakeComputationTest, ) import qualified Test.Cardano.Ledger.Shelley.Rules.Pool as Pool (tests) import qualified Test.Cardano.Ledger.Shelley.Rules.PoolReap as PoolReap (tests) import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators () import qualified Test.Cardano.Ledger.Shelley.ShelleyTranslation as ShelleyTranslation ( testGroupShelleyTranslation, ) import Test.Cardano.Ledger.Shelley.Utils (ChainProperty) import Test.QuickCheck (Args (maxSuccess), stdArgs) import Test.Tasty (TestTree, localOption, testGroup) import qualified Test.Tasty.QuickCheck as TQC commonTests :: forall era ledger. ( EraGen era , ChainProperty era , QC.HasTrace (CHAIN era) (GenEnv era) , QC.HasTrace ledger (GenEnv era) , Embed (EraRule "DELEGS" era) ledger , Embed (EraRule "UTXOW" era) ledger , Environment ledger ~ LedgerEnv era , QC.BaseEnv ledger ~ Globals , BaseM ledger ~ ReaderT Globals Identity , State ledger ~ LedgerState era , Signal ledger ~ Tx era , GovState era ~ ShelleyGovState era ) => [TestTree] commonTests :: forall era ledger. (EraGen era, ChainProperty era, HasTrace (CHAIN era) (GenEnv era), HasTrace ledger (GenEnv era), Embed (EraRule "DELEGS" era) ledger, Embed (EraRule "UTXOW" era) ledger, Environment ledger ~ LedgerEnv era, BaseEnv ledger ~ Globals, BaseM ledger ~ ReaderT Globals Identity, State ledger ~ LedgerState era, Signal ledger ~ Tx era, GovState era ~ ShelleyGovState era) => [TestTree] commonTests = [ ( forall v. IsOption v => v -> TestTree -> TestTree localOption (Int -> QuickCheckMaxRatio TQC.QuickCheckMaxRatio Int 100) forall a b. (a -> b) -> a -> b $ (forall era. (EraGen era, ChainProperty era, HasTrace (CHAIN era) (GenEnv era)) => Int -> TestTree ClassifyTraces.relevantCasesAreCovered @era (Args -> Int maxSuccess Args stdArgs)) ) , forall era. (EraGen era, HasTrace (CHAIN era) (GenEnv era), ChainProperty era) => TestTree Deleg.tests @era , forall era. (EraGen era, ChainProperty era, HasTrace (CHAIN era) (GenEnv era)) => TestTree Pool.tests @era , forall era. (ChainProperty era, EraGen era, HasTrace (CHAIN era) (GenEnv era)) => TestTree PoolReap.tests @era , TestName -> [TestTree] -> TestTree testGroup TestName "CHAIN level Properties" [ forall era ledger. (EraGen era, TestingLedger era ledger, ChainProperty era, HasTrace (CHAIN era) (GenEnv era), GovState era ~ ShelleyGovState era) => Int -> TestTree AdaPreservation.tests @era @ledger (Args -> Int maxSuccess Args stdArgs) , forall era ledger. (EraGen era, ChainProperty era, TestingLedger era ledger, HasTrace (CHAIN era) (GenEnv era)) => TestTree ColllisionFree.tests @era @ledger , forall era ledger. (EraGen era, TestingLedger era ledger, ChainProperty era, HasTrace (CHAIN era) (GenEnv era)) => TestTree IncrementalStake.incrStakeComputationTest @era @ledger ] , TestName -> [TestTree] -> TestTree testGroup TestName "Trace generators properties" [ forall era ledger. (EraGen era, HasTrace ledger (GenEnv era), BaseEnv ledger ~ Globals, State ledger ~ LedgerState era, Show (Environment ledger), Show (Signal ledger), EraGov era) => TestTree ClassifyTraces.onlyValidLedgerSignalsAreGenerated @era @ledger , forall era. (EraGen era, HasTrace (CHAIN era) (GenEnv era), EraGov era) => TestTree ClassifyTraces.onlyValidChainSignalsAreGenerated @era ] , TestTree ByronTranslation.testGroupByronTranslation , TestTree ShelleyTranslation.testGroupShelleyTranslation ]