{-# 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 'PlutusV1 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" ShelleyPoolPredFailure 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