{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.Cardano.Ledger.Alonzo.Binary.RoundTrip (
roundTripAlonzoCommonSpec,
roundTripAlonzoEraTypesSpec,
) where
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Compactible
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus
import Cardano.Ledger.Shelley.Governance
import Cardano.Ledger.Shelley.LedgerState
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary (genValidCostModels)
import Test.Cardano.Ledger.Core.Binary.RoundTrip (
RuleListEra (..),
roundTripAnnEraTypeSpec,
roundTripEraExpectation,
roundTripEraTypeSpec,
)
import Test.Cardano.Ledger.Shelley.Binary.RoundTrip (roundTripShelleyCommonSpec)
roundTripAlonzoCommonSpec ::
forall era.
( EraTx era
, EraGov era
, StashedAVVMAddresses era ~ ()
, Arbitrary (Tx era)
, Arbitrary (TxBody era)
, Arbitrary (TxOut era)
, Arbitrary (TxCert era)
, Arbitrary (TxWits era)
, Arbitrary (TxAuxData era)
, Arbitrary (Value era)
, Arbitrary (CompactForm (Value era))
, Arbitrary (Script era)
, Arbitrary (GovState era)
, Arbitrary (PParams era)
, Arbitrary (PParamsUpdate era)
, RuleListEra era
) =>
Spec
roundTripAlonzoCommonSpec :: forall era.
(EraTx era, EraGov era, StashedAVVMAddresses era ~ (),
Arbitrary (Tx era), Arbitrary (TxBody era), Arbitrary (TxOut era),
Arbitrary (TxCert era), Arbitrary (TxWits era),
Arbitrary (TxAuxData era), Arbitrary (Value era),
Arbitrary (CompactForm (Value era)), Arbitrary (Script era),
Arbitrary (GovState era), Arbitrary (PParams era),
Arbitrary (PParamsUpdate era), RuleListEra era) =>
Spec
roundTripAlonzoCommonSpec = do
forall era. Era era => Spec
roundTripAlonzoEraTypesSpec @era
forall era.
(EraTx era, EraGov era, Eq (StashedAVVMAddresses era),
Show (StashedAVVMAddresses era),
EncCBOR (StashedAVVMAddresses era),
DecCBOR (StashedAVVMAddresses era),
Arbitrary (StashedAVVMAddresses era), Arbitrary (Tx era),
Arbitrary (TxBody era), Arbitrary (TxOut era),
Arbitrary (TxCert era), Arbitrary (TxWits era),
Arbitrary (TxAuxData era), Arbitrary (Value era),
Arbitrary (CompactForm (Value era)), Arbitrary (Script era),
Arbitrary (GovState era), Arbitrary (PParams era),
Arbitrary (PParamsUpdate era), RuleListEra era) =>
Spec
roundTripShelleyCommonSpec @era
roundTripAlonzoEraTypesSpec ::
forall era.
Era era =>
Spec
roundTripAlonzoEraTypesSpec :: forall era. Era era => Spec
roundTripAlonzoEraTypesSpec = do
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Alonzo era types" forall a b. (a -> b) -> a -> b
$ do
forall era (t :: * -> *).
(Era era, Show (t era), Eq (t era), ToCBOR (t era),
DecCBOR (Annotator (t era)), Arbitrary (t era), HasCallStack) =>
Spec
roundTripAnnEraTypeSpec @era @Data
forall era (t :: * -> *).
(Era era, Show (t era), Eq (t era), EncCBOR (t era),
DecCBOR (t era), Arbitrary (t era), HasCallStack) =>
Spec
roundTripEraTypeSpec @era @BinaryData
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"CostModels" forall a b. (a -> b) -> a -> b
$
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Set Language -> Gen CostModels
genValidCostModels [Language
PlutusV1, Language
PlutusV2]) forall a b. (a -> b) -> a -> b
$
forall era t.
(Era era, Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripEraExpectation @era
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"Datum doesn't roundtrip" forall a b. (a -> b) -> a -> b
$ do
forall era (t :: * -> *).
(Era era, Show (t era), Eq (t era), EncCBOR (t era),
DecCBOR (t era), Arbitrary (t era), HasCallStack) =>
Spec
roundTripEraTypeSpec @era @Datum
instance RuleListEra AlonzoEra where
type
EraRules AlonzoEra =
'[ "DELEG"
, "DELEGS"
, "DELPL"
, "LEDGER"
, "LEDGERS"
, "POOL"
, "PPUP"
, "UTXO"
, "UTXOW"
, "UTXOS"
]