{-# LANGUAGE TypeApplications #-} module Main where import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway (ConwayEra) import Cardano.Ledger.Conway.Tx (tierRefScriptFee) import Test.Cardano.Ledger.Common import qualified Test.Cardano.Ledger.Conway.Binary.CddlSpec as Cddl import qualified Test.Cardano.Ledger.Conway.GenesisSpec as Genesis import qualified Test.Cardano.Ledger.Conway.GoldenSpec as GoldenSpec import qualified Test.Cardano.Ledger.Conway.GoldenTranslation as GoldenTranslation import qualified Test.Cardano.Ledger.Conway.GovActionReorderSpec as GovActionReorder import Test.Cardano.Ledger.Conway.Plutus.PlutusSpec as PlutusSpec import qualified Test.Cardano.Ledger.Conway.Spec as ConwaySpec import Test.Cardano.Ledger.Shelley.JSON (roundTripJsonShelleyEraSpec) main :: IO () Expectation main = Spec -> Expectation ledgerTestMain (Spec -> Expectation) -> Spec -> Expectation forall a b. (a -> b) -> a -> b $ do String -> Spec -> Spec forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Conway era-generic" (Spec -> Spec) -> Spec -> Spec forall a b. (a -> b) -> a -> b $ forall era. (EraPlutusTxInfo 'PlutusV2 era, EraPlutusTxInfo 'PlutusV3 era, RuleListEra era, ConwayEraImp era, ApplyTx era, DecCBOR (TxWits era), DecCBOR (TxBody era), DecCBOR (Tx era), Arbitrary (PlutusPurpose AsIx era), SafeToHash (TxWits era), StashedAVVMAddresses era ~ (), Inject (BabbageContextError era) (ContextError era), Inject (ConwayContextError era) (ContextError era), Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era, Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era, Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era, InjectRuleFailure "BBODY" ConwayBbodyPredFailure era, InjectRuleFailure "LEDGER" ConwayGovPredFailure era, InjectRuleFailure "LEDGER" ConwayCertsPredFailure era, InjectRuleFailure "LEDGER" BabbageUtxoPredFailure era, InjectRuleFailure "LEDGER" BabbageUtxowPredFailure era, InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era, InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era, InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era, InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era, InjectRuleFailure "LEDGER" ConwayDelegPredFailure era, InjectRuleFailure "LEDGER" ConwayGovCertPredFailure era, InjectRuleFailure "LEDGER" ConwayLedgerPredFailure era, InjectRuleFailure "LEDGER" ConwayUtxoPredFailure era, InjectRuleFailure "LEDGER" ConwayUtxowPredFailure era, InjectRuleEvent "TICK" ConwayEpochEvent era, NFData (Event (EraRule "ENACT" era)), ToExpr (Event (EraRule "ENACT" era)), Eq (Event (EraRule "ENACT" era)), Typeable (Event (EraRule "ENACT" era)), ToExpr (Event (EraRule "BBODY" era)), TxCert era ~ ConwayTxCert era) => Spec ConwaySpec.spec @ConwayEra String -> Spec -> Spec forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Conway era-specific" (Spec -> Spec) -> Spec -> Spec forall a b. (a -> b) -> a -> b $ do Spec GoldenTranslation.spec Spec Genesis.spec Spec GovActionReorder.spec String -> Spec -> Spec forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Plutus" (Spec -> Spec) -> Spec -> Spec forall a b. (a -> b) -> a -> b $ do Spec PlutusSpec.spec Spec Cddl.spec Spec GoldenSpec.spec String -> Spec -> Spec forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Various tests for functions defined in Conway" (Spec -> Spec) -> Spec -> Spec forall a b. (a -> b) -> a -> b $ do String -> (Positive Int -> Rational -> NonNegative Int -> Property) -> Spec forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "tierRefScriptFee is a linear function when growth is 1" ((Positive Int -> Rational -> NonNegative Int -> Property) -> Spec) -> (Positive Int -> Rational -> NonNegative Int -> Property) -> Spec forall a b. (a -> b) -> a -> b $ \(Positive Int sizeIncrement) Rational baseFee (NonNegative Int size) -> HasCallStack => Rational -> Int -> Rational -> Int -> Coin Rational -> Int -> Rational -> Int -> Coin tierRefScriptFee Rational 1 Int sizeIncrement Rational baseFee Int size Coin -> Coin -> Property forall a. (Eq a, Show a) => a -> a -> Property === Integer -> Coin Coin (Rational -> Integer forall b. Integral b => Rational -> b forall a b. (RealFrac a, Integral b) => a -> b floor (Int -> Rational forall a b. (Integral a, Num b) => a -> b fromIntegral Int size Rational -> Rational -> Rational forall a. Num a => a -> a -> a * Rational baseFee)) String -> Expectation -> SpecWith (Arg Expectation) forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "tierRefScriptFee" (Expectation -> SpecWith (Arg Expectation)) -> Expectation -> SpecWith (Arg Expectation) forall a b. (a -> b) -> a -> b $ do let step :: Int step = Int 25600 (Int -> Coin) -> [Int] -> [Coin] forall a b. (a -> b) -> [a] -> [b] map (HasCallStack => Rational -> Int -> Rational -> Int -> Coin Rational -> Int -> Rational -> Int -> Coin tierRefScriptFee Rational 1.5 Int step Rational 15) [Int 0, Int step .. Int 204800] [Coin] -> [Coin] -> Expectation forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation `shouldBe` (Integer -> Coin) -> [Integer] -> [Coin] forall a b. (a -> b) -> [a] -> [b] map Integer -> Coin Coin [Integer 0, Integer 384000, Integer 960000, Integer 1824000, Integer 3120000, Integer 5064000, Integer 7980000, Integer 12354000, Integer 18915000] forall era. ShelleyEraTest era => Spec roundTripJsonShelleyEraSpec @ConwayEra