{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

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.Genesis
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Core
import Data.Default (def)
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.RoundTrip (roundTripConwayCommonSpec)
import Test.Cardano.Ledger.Conway.TreeDiff ()
import Test.Cardano.Ledger.Core.Binary (specUpgrade)
import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec, txSizeSpec)
import Test.Cardano.Ledger.Core.Binary.RoundTrip (roundTripEraSpec)

spec :: Spec
spec :: Spec
spec = do
  forall era.
(Arbitrary (TxOut (PreviousEra era)),
 Arbitrary (TxCert (PreviousEra era)),
 Arbitrary (TxAuxData (PreviousEra era)),
 Arbitrary (TxWits (PreviousEra era)),
 Arbitrary (TxBody (PreviousEra era)), EraTx (PreviousEra era),
 EraTx era, Arbitrary (Tx (PreviousEra era)),
 Arbitrary (Script (PreviousEra era)), HasCallStack,
 ToExpr (Tx era), ToExpr (TxBody era), ToExpr (TxWits era),
 ToExpr (TxAuxData era), DecCBOR (Annotator (TxAuxData era)),
 DecCBOR (Annotator (Script era)), DecCBOR (Annotator (TxWits era)),
 DecCBOR (Annotator (TxBody era)), DecCBOR (Annotator (Tx era))) =>
BinaryUpgradeOpts -> Spec
specUpgrade @ConwayEra BinaryUpgradeOpts
forall a. Default a => a
def
  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 ConwayEra)
    forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @(GovPurposeId 'HardForkPurpose ConwayEra)
    forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @(GovPurposeId 'CommitteePurpose ConwayEra)
    forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @(GovPurposeId 'ConstitutionPurpose ConwayEra)
    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 (Annotator (Script era)),
 DecCBOR (Annotator (TxAuxData era)),
 DecCBOR (Annotator (TxWits era)), DecCBOR (Annotator (TxBody era)),
 DecCBOR (Annotator (Tx era)), RuleListEra era) =>
Spec
roundTripConwayCommonSpec @ConwayEra
    -- ConwayGenesis only makes sense in Conway era
    forall era t.
(Era era, Show t, Eq t, EncCBOR t, DecCBOR t, Arbitrary t,
 HasCallStack) =>
Spec
roundTripEraSpec @ConwayEra @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), DecCBOR (Annotator (Tx era)),
 DecCBOR (Annotator (TxBody era)), DecCBOR (Annotator (TxWits era)),
 DecCBOR (Annotator (TxAuxData era)),
 DecCBOR (Annotator (Script era)), HasCallStack) =>
Spec
Binary.decoderEquivalenceCoreEraTypesSpec @ConwayEra
    forall t.
(Arbitrary t, Eq t, EncCBOR t, DecCBOR t, DecCBOR (Annotator t),
 Show t) =>
Spec
decoderEquivalenceLenientSpec @(TxDats ConwayEra)
    forall t.
(Arbitrary t, Eq t, EncCBOR t, DecCBOR t, DecCBOR (Annotator t),
 Show t) =>
Spec
decoderEquivalenceLenientSpec @(Redeemers ConwayEra)
  forall era.
(EraTx era, Arbitrary (Tx era), SafeToHash (TxWits era)) =>
Spec
Binary.txSizeSpec @ConwayEra
  where
    -- The expectation used in this spec allows for the deserialization to fail, in which case
    -- it only checks that it fails for both decoders.
    -- This is necessary because for some arbitrarily generated values, the deserialization fails
    -- starting with Conway (for example: empty TxDats or Redeemers)
    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)