{-# 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
    -- 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 @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
    -- 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)