{-# 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"
  Spec -> IO ()
defaultMain (Spec -> IO ()) -> Spec -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe String
nightly of
    Maybe String
Nothing -> Spec
defaultTests
    Just String
_ -> Spec
nightlyTests

defaultTests :: TestTree
defaultTests :: Spec
defaultTests =
  String -> [Spec] -> Spec
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"ShelleyMA Ledger Tests"
    [ Spec
allegraTests
    , Spec
maryTests
    , String -> [Spec] -> Spec
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
        String
"Mixed MA Ledger Tests"
        [ Spec
Serialisation.tests
        ]
    ]

allegraTests :: TestTree
allegraTests :: Spec
allegraTests =
  String -> [Spec] -> Spec
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"Allegra Ledger Tests"
    [ Spec
allegraTranslationTests
    , ( QuickCheckMaxRatio -> Spec -> Spec
forall a. QuickCheckMaxRatio -> SpecWith a -> SpecWith a
localOption
          (Int -> QuickCheckMaxRatio
TQC.QuickCheckMaxRatio Int
50)
          (forall era.
(EraGen era, EraStake era, ChainProperty era,
 HasTrace (CHAIN era) (GenEnv MockCrypto era)) =>
Int -> Spec
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 -> Spec
AdaPreservation.tests @AllegraEra (Args -> Int
maxSuccess Args
stdArgs)
    , forall era.
(EraGen era, EraGov era, EraStake era,
 HasTrace (CHAIN era) (GenEnv MockCrypto era)) =>
Spec
ClassifyTraces.onlyValidChainSignalsAreGenerated @AllegraEra
    , Spec
WitVKeys.tests
    , Spec
testScriptPostTranslation
    ]

maryTests :: TestTree
maryTests :: Spec
maryTests =
  String -> [Spec] -> Spec
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"Mary Ledger Tests"
    [ Spec
maryTranslationTests
    , Spec
valTests
    , Spec
multiAssetsExample
    , Spec
goldenScaledMinDeposit
    ]

nightlyTests :: TestTree
nightlyTests :: Spec
nightlyTests =
  String -> [Spec] -> Spec
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"ShelleyMA Ledger - nightly"
    [ String -> [Spec] -> Spec
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
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,
 AtMostEra "Alonzo" era, 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) =>
[Spec]
Shelley.commonTests @AllegraEra
            [Spec] -> [Spec] -> [Spec]
forall a. [a] -> [a] -> [a]
++ [Proxy AllegraEra -> Spec
forall era.
(EraGen era, EraGov era, EraStake era, ShelleyEraAccounts era,
 HasTrace (CHAIN era) (GenEnv MockCrypto era)) =>
Proxy era -> Spec
IncrementalStake.incrStakeComparisonTest (Proxy AllegraEra
forall {k} (t :: k). Proxy t
Proxy :: Proxy AllegraEra)]
        )
    , String -> [Spec] -> Spec
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
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,
 AtMostEra "Alonzo" era, 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) =>
[Spec]
Shelley.commonTests @MaryEra
            [Spec] -> [Spec] -> [Spec]
forall a. [a] -> [a] -> [a]
++ [Proxy MaryEra -> Spec
forall era.
(EraGen era, EraGov era, EraStake era, ShelleyEraAccounts era,
 HasTrace (CHAIN era) (GenEnv MockCrypto era)) =>
Proxy era -> Spec
IncrementalStake.incrStakeComparisonTest (Proxy MaryEra
forall {k} (t :: k). Proxy t
Proxy :: Proxy MaryEra)]
        )
    ]