{-# 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.TxWits (Redeemers, TxDats)
import Cardano.Ledger.Plutus
import Test.Cardano.Ledger.Alonzo.Arbitrary (genNonEmptyRedeemers, genNonEmptyTxDats)
import Test.Cardano.Ledger.Alonzo.Binary.Annotator ()
import Test.Cardano.Ledger.Alonzo.Era (AlonzoEraTest)
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.
  ( AlonzoEraTest era
  , RuleListEra era
  ) =>
  Spec
roundTripAlonzoCommonSpec :: forall era. (AlonzoEraTest era, RuleListEra era) => Spec
roundTripAlonzoCommonSpec = do
  forall era.
(AlonzoEraScript era, Arbitrary (PlutusPurpose AsIx era)) =>
Spec
roundTripAlonzoEraTypesSpec @era
  forall era. (ShelleyEraTest era, RuleListEra 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"
       ]