{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Test.Cardano.Ledger.Conway.BinarySpec (spec) where
import Cardano.Ledger.Alonzo.TxWits (Redeemers, TxDats)
import Cardano.Ledger.Binary
import Cardano.Ledger.Conway
import Cardano.Ledger.Conway.Core (AlonzoEraScript (..), AsIx)
import Cardano.Ledger.Conway.Genesis
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses)
import Data.Proxy
import Data.Typeable (typeRep)
import Test.Cardano.Ledger.Binary (decoderEquivalenceExpectation)
import Test.Cardano.Ledger.Binary.RoundTrip
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Conway.Binary.Annotator ()
import Test.Cardano.Ledger.Conway.Binary.RoundTrip (roundTripConwayCommonSpec)
import Test.Cardano.Ledger.Conway.ImpTest (ConwayEraImp)
import Test.Cardano.Ledger.Conway.TreeDiff ()
import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec, txSizeSpec)
import Test.Cardano.Ledger.Core.Binary.RoundTrip (RuleListEra, roundTripEraSpec)
spec ::
forall era.
( ConwayEraImp era
, DecCBOR (TxAuxData era)
, DecCBOR (TxWits era)
, DecCBOR (TxBody era)
, DecCBOR (Tx era)
, Arbitrary (PlutusPurpose AsIx era)
, RuleListEra era
, StashedAVVMAddresses era ~ ()
, SafeToHash (TxWits era)
) =>
Spec
spec :: forall era.
(ConwayEraImp era, DecCBOR (TxAuxData era), DecCBOR (TxWits era),
DecCBOR (TxBody era), DecCBOR (Tx era),
Arbitrary (PlutusPurpose AsIx era), RuleListEra era,
StashedAVVMAddresses era ~ (), SafeToHash (TxWits era)) =>
Spec
spec = do
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"RoundTrip" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @GovActionId
forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @(GovPurposeId 'PParamUpdatePurpose)
forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @(GovPurposeId 'HardForkPurpose)
forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @(GovPurposeId 'CommitteePurpose)
forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @(GovPurposeId 'ConstitutionPurpose)
forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @Vote
forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @Voter
forall era.
(EraTx era, EraGov era, EraStake era, EraCertState era,
AlonzoEraScript 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 (PlutusPurpose AsIx era),
Arbitrary (PParams era), Arbitrary (PParamsUpdate era),
Arbitrary (PParamsHKD StrictMaybe era),
Arbitrary (InstantStake era), Arbitrary (CertState era),
DecCBOR (Script era), DecCBOR (TxAuxData era),
DecCBOR (TxWits era), DecCBOR (TxBody era), DecCBOR (Tx era),
RuleListEra era) =>
Spec
roundTripConwayCommonSpec @era
forall era t.
(Era era, Show t, Eq t, EncCBOR t, DecCBOR t, Arbitrary t,
HasCallStack) =>
Spec
roundTripEraSpec @era @ConwayGenesis
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DecCBOR instances equivalence" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
forall era.
(EraTx era, Arbitrary (Tx era), Arbitrary (TxBody era),
Arbitrary (TxWits era), Arbitrary (TxAuxData era),
Arbitrary (Script era), HasCallStack) =>
Spec
Binary.decoderEquivalenceCoreEraTypesSpec @era
forall t.
(Arbitrary t, Eq t, EncCBOR t, DecCBOR t, DecCBOR (Annotator t),
Show t) =>
Spec
decoderEquivalenceLenientSpec @(TxDats era)
forall t.
(Arbitrary t, Eq t, EncCBOR t, DecCBOR t, DecCBOR (Annotator t),
Show t) =>
Spec
decoderEquivalenceLenientSpec @(Redeemers era)
forall era.
(EraTx era, Arbitrary (Tx era), SafeToHash (TxWits era)) =>
Spec
Binary.txSizeSpec @era
where
decoderEquivalenceLenientSpec ::
forall t. (Arbitrary t, Eq t, EncCBOR t, DecCBOR t, DecCBOR (Annotator t), Show t) => Spec
decoderEquivalenceLenientSpec :: forall t.
(Arbitrary t, Eq t, EncCBOR t, DecCBOR t, DecCBOR (Annotator t),
Show t) =>
Spec
decoderEquivalenceLenientSpec =
String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t -> TypeRep) -> Proxy t -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t)) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$ (t -> IO ()) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> IO ()) -> Property) -> (t -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \(t
x :: t) ->
[Version] -> (Version -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [forall era. Era era => Version
eraProtVerLow @ConwayEra .. forall era. Era era => Version
eraProtVerHigh @ConwayEra] ((Version -> IO ()) -> IO ()) -> (Version -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Version
v ->
forall t.
(Eq t, DecCBOR t, DecCBOR (Annotator t), Show t) =>
Version -> ByteString -> IO ()
decoderEquivalenceExpectation @t Version
v (Version -> t -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
v t
x)