{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} module Main where import Cardano.Ledger.Allegra (AllegraEra) import Cardano.Ledger.Core import Cardano.Ledger.Mary (MaryEra) import qualified Cardano.Protocol.TPraos.Rules.Tickn as TPraos import Data.Proxy (Proxy (..)) import System.Environment (lookupEnv) import Test.Cardano.Ledger.Allegra.ScriptTranslation (testScriptPostTranslation) import Test.Cardano.Ledger.Allegra.Translation (allegraTranslationTests) import Test.Cardano.Ledger.AllegraEraGen () import Test.Cardano.Ledger.Mary.Examples.MultiAssets (multiAssetsExample) import Test.Cardano.Ledger.Mary.Golden (goldenScaledMinDeposit) import Test.Cardano.Ledger.Mary.ImpTest () import Test.Cardano.Ledger.Mary.Translation (maryTranslationTests) import Test.Cardano.Ledger.Mary.Value (valTests) import Test.Cardano.Ledger.MaryEraGen () import qualified Test.Cardano.Ledger.Shelley.PropertyTests as Shelley (commonTests) import qualified Test.Cardano.Ledger.Shelley.Rules.AdaPreservation as AdaPreservation import qualified Test.Cardano.Ledger.Shelley.Rules.ClassifyTraces as ClassifyTraces ( onlyValidChainSignalsAreGenerated, relevantCasesAreCovered, ) import qualified Test.Cardano.Ledger.Shelley.Rules.IncrementalStake as IncrementalStake import qualified Test.Cardano.Ledger.Shelley.WitVKeys as WitVKeys (tests) import qualified Test.Cardano.Ledger.ShelleyMA.Serialisation as Serialisation import Test.QuickCheck (Args (maxSuccess), stdArgs) import Test.Tasty import qualified Test.Tasty.QuickCheck as TQC type instance EraRule "TICKN" MaryEra = TPraos.TICKN type instance EraRule "TICKN" AllegraEra = TPraos.TICKN main :: IO () IO () main = do Maybe String nightly <- String -> IO (Maybe String) lookupEnv String "NIGHTLY" TestTree -> IO () defaultMain (TestTree -> IO ()) -> TestTree -> IO () forall a b. (a -> b) -> a -> b $ case Maybe String nightly of Maybe String Nothing -> TestTree defaultTests Just String _ -> TestTree nightlyTests defaultTests :: TestTree defaultTests :: TestTree defaultTests = String -> [TestTree] -> TestTree testGroup String "ShelleyMA Ledger Tests" [ TestTree allegraTests , TestTree maryTests , String -> [TestTree] -> TestTree testGroup String "Mixed MA Ledger Tests" [ TestTree Serialisation.tests ] ] allegraTests :: TestTree allegraTests :: TestTree allegraTests = String -> [TestTree] -> TestTree testGroup String "Allegra Ledger Tests" [ TestTree allegraTranslationTests , ( QuickCheckMaxRatio -> TestTree -> TestTree forall v. IsOption v => v -> TestTree -> TestTree localOption (Int -> QuickCheckMaxRatio TQC.QuickCheckMaxRatio Int 50) (forall era. (EraGen era, EraStake era, ChainProperty era, HasTrace (CHAIN era) (GenEnv MockCrypto era)) => Int -> TestTree ClassifyTraces.relevantCasesAreCovered @AllegraEra (Args -> Int maxSuccess Args stdArgs)) ) , forall era. (EraGen era, EraStake era, ChainProperty era, HasTrace (CHAIN era) (GenEnv MockCrypto era), GovState era ~ ShelleyGovState era, State (EraRule "LEDGER" era) ~ LedgerState era, Signal (EraRule "LEDGER" era) ~ Tx era, Environment (EraRule "LEDGER" era) ~ LedgerEnv era, BaseM (EraRule "LEDGER" era) ~ ShelleyBase, STS (EraRule "LEDGER" era)) => Int -> TestTree AdaPreservation.tests @AllegraEra (Args -> Int maxSuccess Args stdArgs) , forall era. (EraGen era, EraGov era, EraStake era, HasTrace (CHAIN era) (GenEnv MockCrypto era)) => TestTree ClassifyTraces.onlyValidChainSignalsAreGenerated @AllegraEra , TestTree WitVKeys.tests , TestTree testScriptPostTranslation ] maryTests :: TestTree maryTests :: TestTree maryTests = String -> [TestTree] -> TestTree testGroup String "Mary Ledger Tests" [ TestTree maryTranslationTests , TestTree valTests , TestTree multiAssetsExample , TestTree goldenScaledMinDeposit ] nightlyTests :: TestTree nightlyTests :: TestTree nightlyTests = String -> [TestTree] -> TestTree testGroup String "ShelleyMA Ledger - nightly" [ String -> [TestTree] -> TestTree testGroup String "Allegra Ledger - nightly" ( forall era. (EraGen era, EraStake era, ShelleyEraAccounts era, ApplyBlock era, GetLedgerView era, Embed (EraRule "BBODY" era) (CHAIN era), Embed (EraRule "TICK" era) (CHAIN era), Embed (EraRule "TICKN" era) (CHAIN era), HasTrace (EraRule "LEDGERS" era) (GenEnv MockCrypto era), State (EraRule "TICKN" era) ~ TicknState, Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era, Environment (EraRule "TICKN" era) ~ TicknEnv, Signal (EraRule "LEDGERS" era) ~ Seq (Tx era), Signal (EraRule "TICKN" era) ~ Bool, BaseM (EraRule "LEDGERS" era) ~ ShelleyBase, ProtVerAtMost era 6, GovState era ~ ShelleyGovState era, InstantStake era ~ ShelleyInstantStake era, BaseEnv (EraRule "LEDGER" era) ~ Globals, HasTrace (EraRule "LEDGER" era) (GenEnv MockCrypto era), State (EraRule "TICK" era) ~ NewEpochState era, State (EraRule "LEDGER" era) ~ LedgerState era, BaseM (EraRule "LEDGER" era) ~ ShelleyBase, State (EraRule "BBODY" era) ~ ShelleyBbodyState era, Environment (EraRule "LEDGER" era) ~ LedgerEnv era, Environment (EraRule "TICK" era) ~ (), Signal (EraRule "LEDGER" era) ~ Tx era, State (EraRule "LEDGERS" era) ~ LedgerState era, Environment (EraRule "BBODY" era) ~ BbodyEnv era, Signal (EraRule "TICK" era) ~ SlotNo, Signal (EraRule "BBODY" era) ~ Block BHeaderView era) => [TestTree] Shelley.commonTests @AllegraEra [TestTree] -> [TestTree] -> [TestTree] forall a. [a] -> [a] -> [a] ++ [Proxy AllegraEra -> TestTree forall era. (EraGen era, EraGov era, EraStake era, ShelleyEraAccounts era, HasTrace (CHAIN era) (GenEnv MockCrypto era)) => Proxy era -> TestTree IncrementalStake.incrStakeComparisonTest (Proxy AllegraEra forall {k} (t :: k). Proxy t Proxy :: Proxy AllegraEra)] ) , String -> [TestTree] -> TestTree testGroup String "Mary Ledger - nightly" ( forall era. (EraGen era, EraStake era, ShelleyEraAccounts era, ApplyBlock era, GetLedgerView era, Embed (EraRule "BBODY" era) (CHAIN era), Embed (EraRule "TICK" era) (CHAIN era), Embed (EraRule "TICKN" era) (CHAIN era), HasTrace (EraRule "LEDGERS" era) (GenEnv MockCrypto era), State (EraRule "TICKN" era) ~ TicknState, Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era, Environment (EraRule "TICKN" era) ~ TicknEnv, Signal (EraRule "LEDGERS" era) ~ Seq (Tx era), Signal (EraRule "TICKN" era) ~ Bool, BaseM (EraRule "LEDGERS" era) ~ ShelleyBase, ProtVerAtMost era 6, GovState era ~ ShelleyGovState era, InstantStake era ~ ShelleyInstantStake era, BaseEnv (EraRule "LEDGER" era) ~ Globals, HasTrace (EraRule "LEDGER" era) (GenEnv MockCrypto era), State (EraRule "TICK" era) ~ NewEpochState era, State (EraRule "LEDGER" era) ~ LedgerState era, BaseM (EraRule "LEDGER" era) ~ ShelleyBase, State (EraRule "BBODY" era) ~ ShelleyBbodyState era, Environment (EraRule "LEDGER" era) ~ LedgerEnv era, Environment (EraRule "TICK" era) ~ (), Signal (EraRule "LEDGER" era) ~ Tx era, State (EraRule "LEDGERS" era) ~ LedgerState era, Environment (EraRule "BBODY" era) ~ BbodyEnv era, Signal (EraRule "TICK" era) ~ SlotNo, Signal (EraRule "BBODY" era) ~ Block BHeaderView era) => [TestTree] Shelley.commonTests @MaryEra [TestTree] -> [TestTree] -> [TestTree] forall a. [a] -> [a] -> [a] ++ [Proxy MaryEra -> TestTree forall era. (EraGen era, EraGov era, EraStake era, ShelleyEraAccounts era, HasTrace (CHAIN era) (GenEnv MockCrypto era)) => Proxy era -> TestTree IncrementalStake.incrStakeComparisonTest (Proxy MaryEra forall {k} (t :: k). Proxy t Proxy :: Proxy MaryEra)] ) ]