{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Main where import Cardano.Ledger.Alonzo (AlonzoEra) import Data.Proxy (Proxy (..)) import System.Environment (lookupEnv) import qualified Test.Cardano.Ledger.Alonzo.ChainTrace as ChainTrace import qualified Test.Cardano.Ledger.Alonzo.Golden as Golden import Test.Cardano.Ledger.Alonzo.ImpTest () import qualified Test.Cardano.Ledger.Alonzo.Serialisation.Canonical as Canonical import qualified Test.Cardano.Ledger.Alonzo.Serialisation.Tripping as Tripping import qualified Test.Cardano.Ledger.Alonzo.Translation as Translation import qualified Test.Cardano.Ledger.Alonzo.TxInfo as TxInfo import qualified Test.Cardano.Ledger.Shelley.PropertyTests as Shelley import qualified Test.Cardano.Ledger.Shelley.Rules.AdaPreservation as AdaPreservation import qualified Test.Cardano.Ledger.Shelley.Rules.IncrementalStake as IncrementalStake import Test.Tasty 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 "Alonzo tests" [ forall era. (EraGen era, ShelleyEraImp era, ChainProperty era, HasTrace (CHAIN era) (GenEnv MockCrypto era), GovState era ~ ShelleyGovState era) => Int -> TestTree AdaPreservation.tests @AlonzoEra Int 50 , TestTree Tripping.tests , TestTree Translation.tests , TestTree Canonical.tests , TestTree Golden.tests , TestTree TxInfo.tests ] nightlyTests :: TestTree nightlyTests :: TestTree nightlyTests = String -> [TestTree] -> TestTree testGroup String "Alonzo tests - nightly" ([TestTree] -> TestTree) -> [TestTree] -> TestTree forall a b. (a -> b) -> a -> b $ forall era. (ShelleyEraImp era, EraGen 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)) => [TestTree] Shelley.commonTests @AlonzoEra [TestTree] -> [TestTree] -> [TestTree] forall a. [a] -> [a] -> [a] ++ [ Proxy AlonzoEra -> TestTree forall era. (EraGen era, EraGov era, EraStake era, HasTrace (CHAIN era) (GenEnv MockCrypto era)) => Proxy era -> TestTree IncrementalStake.incrStakeComparisonTest (Proxy AlonzoEra forall {k} (t :: k). Proxy t Proxy :: Proxy AlonzoEra) , TestTree ChainTrace.tests ]