{-# 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.Binary.Cuddle (
  huddleDecoderEquivalenceSpec,
  huddleRoundTripAnnCborSpec,
  huddleRoundTripArbitraryValidate,
  huddleRoundTripCborSpec,
  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
    Huddle -> Int -> SpecWith CuddleData -> Spec
specWithHuddle Huddle
conwayCDDL Int
100 (SpecWith CuddleData -> Spec) -> SpecWith CuddleData -> Spec
forall a b. (a -> b) -> a -> b
$ do
      -- Value
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(Value ConwayEra) Version
v Text
"positive_coin"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(Value ConwayEra) Version
v Text
"value"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(Value ConwayEra) Version
v Text
"value"
      -- TxBody
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripAnnCborSpec @(TxBody TopTx ConwayEra) Version
v Text
"transaction_body"
      -- TODO enable this once map/list expansion has been optimized in cuddle
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"hangs" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$ forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(TxBody TopTx ConwayEra) Version
v Text
"transaction_body"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(TxBody TopTx ConwayEra) Version
v Text
"transaction_body"
      -- AuxData
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripAnnCborSpec @(TxAuxData ConwayEra) Version
v Text
"auxiliary_data"
      -- TODO fails because of plutus scripts
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix plutus scripts" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$
        forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(TxAuxData ConwayEra) Version
v Text
"auxiliary_data"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(TxAuxData ConwayEra) Version
v Text
"auxiliary_data"
      -- NativeScript
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripAnnCborSpec @(Timelock ConwayEra) Version
v Text
"native_script"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(Timelock ConwayEra) Version
v Text
"native_script"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(Timelock ConwayEra) Version
v Text
"native_script"
      -- Data
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripAnnCborSpec @(Data ConwayEra) Version
v Text
"plutus_data"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(Data ConwayEra) Version
v Text
"plutus_data"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(Data ConwayEra) Version
v Text
"plutus_data"
      -- TxOut
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(TxOut ConwayEra) Version
v Text
"transaction_output"
      -- TODO fails because of `address`
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix address" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$ forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(TxOut ConwayEra) Version
v Text
"transaction_output"
      -- Script
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripAnnCborSpec @(Script ConwayEra) Version
v Text
"script"
      -- TODO fails because of `plutus_v1_script`
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix plutus_v1_script" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$ forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(Script ConwayEra) Version
v Text
"script"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(Script ConwayEra) Version
v Text
"script"
      -- Datum
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(Datum ConwayEra) Version
v Text
"datum_option"
      -- TODO NoDatum is encoded as an empty bytestring
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix NoDatum" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$ forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(Datum ConwayEra) Version
v Text
"datum_option"
      -- TxWits
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripAnnCborSpec @(TxWits ConwayEra) Version
v Text
"transaction_witness_set"
      -- TODO fails because of plutus_v1_script
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix plutus_v1_script" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$
        forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(TxWits ConwayEra) Version
v Text
"transaction_witness_set"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(TxWits ConwayEra) Version
v Text
"transaction_witness_set"
      -- PParamsUpdate
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(PParamsUpdate ConwayEra) Version
v Text
"protocol_param_update"
      -- TODO enable this once map/list expansion has been optimized in cuddle
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"hangs" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$
        forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(PParamsUpdate ConwayEra) Version
v Text
"protocol_param_update"
      -- CostModels
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @CostModels Version
v Text
"cost_models"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @CostModels Version
v Text
"cost_models"
      -- Redeemers
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripAnnCborSpec @(Redeemers ConwayEra) Version
v Text
"redeemers"
      -- TODO arbitrary can generate empty redeemers, which is not allowed in the CDDL
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix redeemers" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$ forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(Redeemers ConwayEra) Version
v Text
"redeemers"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(Redeemers ConwayEra) Version
v Text
"redeemers"
      -- Tx
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripAnnCborSpec @(Tx TopTx ConwayEra) Version
v Text
"transaction"
      -- TODO enable this once map/list expansion has been optimized in cuddle
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"hangs" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$ forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(Tx TopTx ConwayEra) Version
v Text
"transaction"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(Tx TopTx ConwayEra) Version
v Text
"transaction"
      -- VotingProcedure
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(VotingProcedure ConwayEra) Version
v Text
"voting_procedure"
      forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(VotingProcedure ConwayEra) Version
v Text
"voting_procedure"
      -- ProposalProcedure
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(ProposalProcedure ConwayEra) Version
v Text
"proposal_procedure"
      -- TODO This fails because of the hard-coded `reward_account` in the CDDL
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix reward_account" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$
        forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(ProposalProcedure ConwayEra) Version
v Text
"proposal_procedure"
      -- GovAction
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(GovAction ConwayEra) Version
v Text
"gov_action"
      -- TODO enable this once map/list expansion has been optimized in cuddle
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"hangs" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$ forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(GovAction ConwayEra) Version
v Text
"gov_action"
      -- TxCert
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(TxCert ConwayEra) Version
v Text
"certificate"
      -- TODO this fails because of the hard-coded `unit_interval` in the CDDL
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"fix unit_interval" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$ forall a.
(DecCBOR a, EncCBOR a, Arbitrary a, Show a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripArbitraryValidate @(TxCert ConwayEra) Version
v Text
"certificate"
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DecCBOR instances equivalence via CDDL" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$ do
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleDecoderEquivalenceSpec @(TxBody TopTx ConwayEra) Version
v Text
"transaction_body"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleDecoderEquivalenceSpec @(TxAuxData ConwayEra) Version
v Text
"auxiliary_data"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleDecoderEquivalenceSpec @(Timelock ConwayEra) Version
v Text
"native_script"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleDecoderEquivalenceSpec @(Data ConwayEra) Version
v Text
"plutus_data"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleDecoderEquivalenceSpec @(Script ConwayEra) Version
v Text
"script"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleDecoderEquivalenceSpec @(TxWits ConwayEra) Version
v Text
"transaction_witness_set"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleDecoderEquivalenceSpec @(Redeemers ConwayEra) Version
v Text
"redeemers"
        forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleDecoderEquivalenceSpec @(Tx TopTx ConwayEra) Version
v Text
"transaction"