{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Conway.Binary.CddlSpec (spec) where

import Cardano.Ledger.Allegra.Scripts
import Cardano.Ledger.Alonzo.Scripts (CostModels)
import Cardano.Ledger.Alonzo.TxWits (Redeemers)
import Cardano.Ledger.Conway (ConwayEra)
import Cardano.Ledger.Conway.Governance (GovAction, ProposalProcedure, VotingProcedure)
import Cardano.Ledger.Conway.HuddleSpec (conwayCDDL)
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus.Data (Data, Datum)
import Test.Cardano.Ledger.Alonzo.Arbitrary (genNonEmptyRedeemers)
import Test.Cardano.Ledger.Binary.Cuddle (
  huddleAntiCborSpec,
  huddleDecoderEquivalenceSpec,
  huddleRoundTripAnnCborSpec,
  huddleRoundTripArbitraryValidate,
  huddleRoundTripCborSpec,
  huddleRoundTripGenValidate,
  noTwiddle,
  specWithHuddle,
 )
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Conway.Binary.Annotator ()

spec :: Spec
spec :: Spec
spec = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"CDDL" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    let v :: Version
v = forall era. Era era => Version
eraProtVerHigh @ConwayEra
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Huddle" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ Huddle -> SpecWith HuddleEnv -> Spec
specWithHuddle Huddle
conwayCDDL (SpecWith HuddleEnv -> Spec)
-> (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv
-> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecWith HuddleEnv -> SpecWith HuddleEnv
noTwiddle (SpecWith HuddleEnv -> Spec) -> SpecWith HuddleEnv -> Spec
forall a b. (a -> b) -> a -> b
$ do
      -- Value
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(Value ConwayEra) Version
v Text
"positive_coin"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(Value ConwayEra) Version
v Text
"value"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(Value ConwayEra) Version
v Text
"value"
      forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(Value ConwayEra) Version
v Text
"value"
      -- TxBody
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripAnnCborSpec @(TxBody TopTx ConwayEra) Version
v Text
"transaction_body"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(TxBody TopTx ConwayEra) Version
v Text
"transaction_body"
      String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix problems with fields" (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$ do
        forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(TxBody TopTx ConwayEra) Version
v Text
"transaction_body"
        forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(TxBody TopTx ConwayEra) Version
v Text
"transaction_body"
      -- AuxData
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripAnnCborSpec @(TxAuxData ConwayEra) Version
v Text
"auxiliary_data"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(TxAuxData ConwayEra) Version
v Text
"auxiliary_data"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(TxAuxData ConwayEra) Version
v Text
"auxiliary_data"
      forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(TxAuxData ConwayEra) Version
v Text
"auxiliary_data"
      -- NativeScript
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripAnnCborSpec @(Timelock ConwayEra) Version
v Text
"native_script"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(Timelock ConwayEra) Version
v Text
"native_script"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(Timelock ConwayEra) Version
v Text
"native_script"
      forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(Timelock ConwayEra) Version
v Text
"native_script"
      -- Data
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripAnnCborSpec @(Data ConwayEra) Version
v Text
"plutus_data"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(Data ConwayEra) Version
v Text
"plutus_data"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(Data ConwayEra) Version
v Text
"plutus_data"
      forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(Data ConwayEra) Version
v Text
"plutus_data"
      -- TxOut
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(TxOut ConwayEra) Version
v Text
"transaction_output"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(TxOut ConwayEra) Version
v Text
"transaction_output"
      forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(TxOut ConwayEra) Version
v Text
"transaction_output"
      -- Script
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripAnnCborSpec @(Script ConwayEra) Version
v Text
"script"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(Script ConwayEra) Version
v Text
"script"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(Script ConwayEra) Version
v Text
"script"
      forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(Script ConwayEra) Version
v Text
"script"
      -- Datum
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(Datum ConwayEra) Version
v Text
"datum_option"
      forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(Datum ConwayEra) Version
v Text
"datum_option"
      -- TODO NoDatum is encoded as an empty bytestring
      String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix NoDatum" (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$ forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(Datum ConwayEra) Version
v Text
"datum_option"
      -- TxWits
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripAnnCborSpec @(TxWits ConwayEra) Version
v Text
"transaction_witness_set"
      forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(TxWits ConwayEra) Version
v Text
"transaction_witness_set"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(TxWits ConwayEra) Version
v Text
"transaction_witness_set"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(TxWits ConwayEra) Version
v Text
"transaction_witness_set"
      -- PParamsUpdate
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(PParamsUpdate ConwayEra) Version
v Text
"protocol_param_update"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(PParamsUpdate ConwayEra) Version
v Text
"protocol_param_update"
      String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix protocol_param_update" (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$
        forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(PParamsUpdate ConwayEra) Version
v Text
"protocol_param_update"
      -- CostModels
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @CostModels Version
v Text
"cost_models"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @CostModels Version
v Text
"cost_models"
      -- Redeemers
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripAnnCborSpec @(Redeemers ConwayEra) Version
v Text
"redeemers"
      forall a.
(DecCBOR a, Show a, EncCBOR a) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
huddleRoundTripGenValidate @(Redeemers ConwayEra) Gen (Redeemers ConwayEra)
forall era.
(AlonzoEraScript era, Arbitrary (PlutusPurpose AsIx era)) =>
Gen (Redeemers era)
genNonEmptyRedeemers Version
v Text
"redeemers"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(Redeemers ConwayEra) Version
v Text
"redeemers"
      forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(Redeemers ConwayEra) Version
v Text
"redeemers"
      -- Tx
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripAnnCborSpec @(Tx TopTx ConwayEra) Version
v Text
"transaction"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(Tx TopTx ConwayEra) Version
v Text
"transaction"
      String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix txbody" (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$ do
        forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(Tx TopTx ConwayEra) Version
v Text
"transaction"
        forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(Tx TopTx ConwayEra) Version
v Text
"transaction"
      -- VotingProcedure
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(VotingProcedure ConwayEra) Version
v Text
"voting_procedure"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(VotingProcedure ConwayEra) Version
v Text
"voting_procedure"
      forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(VotingProcedure ConwayEra) Version
v Text
"voting_procedure"
      -- ProposalProcedure
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(ProposalProcedure ConwayEra) Version
v Text
"proposal_procedure"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(ProposalProcedure ConwayEra) Version
v Text
"proposal_procedure"
      String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix protver decoder" (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$
        forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(ProposalProcedure ConwayEra) Version
v Text
"proposal_procedure"
      -- GovAction
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(GovAction ConwayEra) Version
v Text
"gov_action"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(GovAction ConwayEra) Version
v Text
"gov_action"
      String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix protver decoder" (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$
        forall a. DecCBOR a => Version -> Text -> SpecWith HuddleEnv
huddleAntiCborSpec @(GovAction ConwayEra) Version
v Text
"gov_action"
      -- TxCert
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(TxCert ConwayEra) Version
v Text
"certificate"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripArbitraryValidate @(TxCert ConwayEra) Version
v Text
"certificate"
      String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DecCBOR instances equivalence via CDDL" (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$ do
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleDecoderEquivalenceSpec @(TxBody TopTx ConwayEra) Version
v Text
"transaction_body"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleDecoderEquivalenceSpec @(TxAuxData ConwayEra) Version
v Text
"auxiliary_data"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleDecoderEquivalenceSpec @(Timelock ConwayEra) Version
v Text
"native_script"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleDecoderEquivalenceSpec @(Data ConwayEra) Version
v Text
"plutus_data"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleDecoderEquivalenceSpec @(Script ConwayEra) Version
v Text
"script"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleDecoderEquivalenceSpec @(TxWits ConwayEra) Version
v Text
"transaction_witness_set"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleDecoderEquivalenceSpec @(Redeemers ConwayEra) Version
v Text
"redeemers"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleDecoderEquivalenceSpec @(Tx TopTx ConwayEra) Version
v Text
"transaction"