{-# 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.Alonzo.Scripts (
  AlonzoEraScript (..),
  AsIx (..),
 )
import Cardano.Ledger.Alonzo.State
import Cardano.Ledger.Alonzo.TxWits (Redeemers, TxDats)
import Cardano.Ledger.Binary
import Cardano.Ledger.Compactible
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus
import Cardano.Ledger.Shelley.LedgerState
import Test.Cardano.Ledger.Alonzo.Arbitrary (genNonEmptyRedeemers, genNonEmptyTxDats)
import Test.Cardano.Ledger.Alonzo.Binary.Annotator ()
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary (genValidCostModels)
import Test.Cardano.Ledger.Core.Binary.RoundTrip (
  RuleListEra (..),
  roundTripAnnEraTypeSpec,
  roundTripEraExpectation,
  roundTripEraTypeExpectation,
  roundTripEraTypeSpec,
 )
import Test.Cardano.Ledger.Shelley.Binary.RoundTrip (roundTripShelleyCommonSpec)

roundTripAlonzoCommonSpec ::
  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 (CertState era)
  , Arbitrary (InstantStake era)
  , DecCBOR (Annotator (Script era))
  , DecCBOR (Annotator (TxAuxData era))
  , DecCBOR (Annotator (TxWits era))
  , DecCBOR (Annotator (TxBody era))
  , DecCBOR (Annotator (Tx era))
  , RuleListEra era
  ) =>
  Spec
roundTripAlonzoCommonSpec :: 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 (CertState era), Arbitrary (InstantStake era),
 DecCBOR (Annotator (Script era)),
 DecCBOR (Annotator (TxAuxData era)),
 DecCBOR (Annotator (TxWits era)), DecCBOR (Annotator (TxBody era)),
 DecCBOR (Annotator (Tx era)), RuleListEra era) =>
Spec
roundTripAlonzoCommonSpec = do
  forall era.
(AlonzoEraScript era, Arbitrary (PlutusPurpose AsIx era)) =>
Spec
roundTripAlonzoEraTypesSpec @era
  forall era.
(EraTx era, EraGov era, EraStake 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), Arbitrary (InstantStake era),
 RuleListEra era, EraCertState era, Arbitrary (CertState era),
 DecCBOR (Annotator (Script era)),
 DecCBOR (Annotator (TxAuxData era)),
 DecCBOR (Annotator (TxWits era)), DecCBOR (Annotator (TxBody era)),
 DecCBOR (Annotator (Tx era))) =>
Spec
roundTripShelleyCommonSpec @era

roundTripAlonzoEraTypesSpec ::
  forall era.
  (AlonzoEraScript era, Arbitrary (PlutusPurpose AsIx era)) =>
  Spec
roundTripAlonzoEraTypesSpec :: forall era.
(AlonzoEraScript era, Arbitrary (PlutusPurpose AsIx era)) =>
Spec
roundTripAlonzoEraTypesSpec = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Alonzo era types" (Spec -> Spec) -> Spec -> Spec
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 @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
    -- CostModel serialization changes drastically for Conway, which requires a different
    -- QuickCheck generator, hence Arbitrary can't be reused
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"CostModels" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Gen CostModels -> (CostModels -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Set Language -> Gen CostModels
genValidCostModels [Item (Set Language)
Language
PlutusV1, Item (Set Language)
Language
PlutusV2]) ((CostModels -> Expectation) -> Property)
-> (CostModels -> Expectation) -> Property
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
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"Datum doesn't roundtrip" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      -- TODO: Adjust Datum implementation somehow to avoid this situtaiton
      -- It doesn't roundtrip because we do not en/decode NoDatum
      -- Possibly use peekAvailable, but haven't looked into the issue too deeply
      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
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"TxDats" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Gen (TxDats era) -> (TxDats era -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (TxDats era)
forall era. Era era => Gen (TxDats era)
genNonEmptyTxDats ((TxDats era -> Expectation) -> Property)
-> (TxDats era -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$
        forall era (t :: * -> *).
(Era era, Show (t era), Eq (t era), EncCBOR (t era),
 DecCBOR (t era), HasCallStack) =>
t era -> Expectation
roundTripEraTypeExpectation @era @TxDats
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Redeemers" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Gen (Redeemers era) -> (Redeemers era -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (Redeemers era)
forall era.
(AlonzoEraScript era, Arbitrary (PlutusPurpose AsIx era)) =>
Gen (Redeemers era)
genNonEmptyRedeemers ((Redeemers era -> Expectation) -> Property)
-> (Redeemers era -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$
        forall era (t :: * -> *).
(Era era, Show (t era), Eq (t era), EncCBOR (t era),
 DecCBOR (t era), HasCallStack) =>
t era -> Expectation
roundTripEraTypeExpectation @era @Redeemers

instance RuleListEra AlonzoEra where
  type
    EraRules AlonzoEra =
      '[ "DELEG"
       , "DELEGS"
       , "DELPL"
       , "LEDGER"
       , "LEDGERS"
       , "POOL"
       , "PPUP"
       , "UTXO"
       , "UTXOW"
       , "UTXOS"
       ]