Merge pull request #4437 from IntersectMBO/nc/cuddle

Test Conway CDDL using Cuddle
IntersectMBO · Jul 25, 2024 · 88d7885 · 88d7885
2 parents 4a1222b + d2ee81f
commit 88d7885
Show file tree

Hide file tree

Showing 6 changed files with 1,266 additions and 23 deletions.
diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal
@@ -115,6 +115,7 @@ library testlib
         Test.Cardano.Ledger.Conway.Binary.Cddl
         Test.Cardano.Ledger.Conway.Binary.RoundTrip
         Test.Cardano.Ledger.Conway.Binary.Regression
+        Test.Cardano.Ledger.Conway.CDDL
         Test.Cardano.Ledger.Conway.ImpTest
         Test.Cardano.Ledger.Conway.Imp
         Test.Cardano.Ledger.Conway.Imp.BbodySpec
@@ -144,6 +145,7 @@ library testlib
         bytestring,
         cardano-data:{cardano-data, testlib},
         containers,
+        cuddle,
         plutus-ledger-api,
         deepseq,
         microlens,

diff --git a/eras/conway/impl/cddl-files/conway.cddl b/eras/conway/impl/cddl-files/conway.cddl
@@ -320,8 +320,6 @@ unreg_drep_cert = (17, drep_credential, coin)
 update_drep_cert = (18, drep_credential, anchor / null)
 
 
-delta_coin = int
-
 credential =
   [  0, addr_keyhash
   // 1, scripthash

diff --git a/eras/conway/impl/test/Test/Cardano/Ledger/Conway/Binary/CddlSpec.hs b/eras/conway/impl/test/Test/Cardano/Ledger/Conway/Binary/CddlSpec.hs
@@ -15,28 +15,58 @@ import Test.Cardano.Ledger.Binary.Cddl (
   cddlRoundTripAnnCborSpec,
   cddlRoundTripCborSpec,
  )
+import Test.Cardano.Ledger.Binary.Cuddle (
+  huddleRoundTripAnnCborSpec,
+  huddleRoundTripCborSpec,
+  specWithHuddle,
+ )
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Conway.Binary.Cddl (readConwayCddlFiles)
+import qualified Test.Cardano.Ledger.Conway.CDDL as ConwayCDDL
 
 spec :: Spec
-spec =
-  describe "CDDL" $ beforeAllCddlFile 3 readConwayCddlFiles $ do
-    let v = eraProtVerHigh @Conway
-    cddlRoundTripCborSpec @(Value Conway) v "positive_coin"
-    cddlRoundTripCborSpec @(Value Conway) v "value"
-    cddlRoundTripAnnCborSpec @(TxBody Conway) v "transaction_body"
-    cddlRoundTripAnnCborSpec @(TxAuxData Conway) v "auxiliary_data"
-    cddlRoundTripAnnCborSpec @(Timelock Conway) v "native_script"
-    cddlRoundTripAnnCborSpec @(Data Conway) v "plutus_data"
-    cddlRoundTripCborSpec @(TxOut Conway) v "transaction_output"
-    cddlRoundTripAnnCborSpec @(Script Conway) v "script"
-    cddlRoundTripCborSpec @(Datum Conway) v "datum_option"
-    cddlRoundTripAnnCborSpec @(TxWits Conway) v "transaction_witness_set"
-    cddlRoundTripCborSpec @(PParamsUpdate Conway) v "protocol_param_update"
-    cddlRoundTripCborSpec @CostModels v "costmdls"
-    cddlRoundTripAnnCborSpec @(Redeemers Conway) v "redeemers"
-    cddlRoundTripAnnCborSpec @(Tx Conway) v "transaction"
-    cddlRoundTripCborSpec @(VotingProcedure Conway) v "voting_procedure"
-    cddlRoundTripCborSpec @(ProposalProcedure Conway) v "proposal_procedure"
-    cddlRoundTripCborSpec @(GovAction Conway) v "gov_action"
-    cddlRoundTripCborSpec @(TxCert Conway) v "certificate"
+spec = do
+  newSpec
+  describe "CDDL" $
+    beforeAllCddlFile 3 readConwayCddlFiles $ do
+      let v = eraProtVerHigh @Conway
+      cddlRoundTripCborSpec @(Value Conway) v "positive_coin"
+      cddlRoundTripCborSpec @(Value Conway) v "value"
+      cddlRoundTripAnnCborSpec @(TxBody Conway) v "transaction_body"
+      cddlRoundTripAnnCborSpec @(TxAuxData Conway) v "auxiliary_data"
+      cddlRoundTripAnnCborSpec @(Timelock Conway) v "native_script"
+      cddlRoundTripAnnCborSpec @(Data Conway) v "plutus_data"
+      cddlRoundTripCborSpec @(TxOut Conway) v "transaction_output"
+      cddlRoundTripAnnCborSpec @(Script Conway) v "script"
+      cddlRoundTripCborSpec @(Datum Conway) v "datum_option"
+      cddlRoundTripAnnCborSpec @(TxWits Conway) v "transaction_witness_set"
+      cddlRoundTripCborSpec @(PParamsUpdate Conway) v "protocol_param_update"
+      cddlRoundTripCborSpec @CostModels v "costmdls"
+      cddlRoundTripAnnCborSpec @(Redeemers Conway) v "redeemers"
+      cddlRoundTripAnnCborSpec @(Tx Conway) v "transaction"
+      cddlRoundTripCborSpec @(VotingProcedure Conway) v "voting_procedure"
+      cddlRoundTripCborSpec @(ProposalProcedure Conway) v "proposal_procedure"
+      cddlRoundTripCborSpec @(GovAction Conway) v "gov_action"
+      cddlRoundTripCborSpec @(TxCert Conway) v "certificate"
+
+newSpec :: Spec
+newSpec = describe "Huddle" $ specWithHuddle ConwayCDDL.conway 100 $ do
+  let v = eraProtVerHigh @Conway
+  huddleRoundTripCborSpec @(Value Conway) v "positive_coin"
+  huddleRoundTripCborSpec @(Value Conway) v "value"
+  huddleRoundTripCborSpec @(Datum Conway) v "datum_option"
+  huddleRoundTripCborSpec @CostModels v "costmdls"
+  huddleRoundTripCborSpec @(VotingProcedure Conway) v "voting_procedure"
+  huddleRoundTripCborSpec @(PParamsUpdate Conway) v "protocol_param_update"
+  huddleRoundTripCborSpec @(ProposalProcedure Conway) v "proposal_procedure"
+  huddleRoundTripCborSpec @(GovAction Conway) v "gov_action"
+  huddleRoundTripCborSpec @(TxCert Conway) v "certificate"
+  huddleRoundTripCborSpec @(TxOut Conway) v "transaction_output"
+  huddleRoundTripAnnCborSpec @(TxBody Conway) v "transaction_body"
+  huddleRoundTripAnnCborSpec @(TxAuxData Conway) v "auxiliary_data"
+  huddleRoundTripAnnCborSpec @(Timelock Conway) v "native_script"
+  huddleRoundTripAnnCborSpec @(Data Conway) v "plutus_data"
+  huddleRoundTripAnnCborSpec @(Script Conway) v "script"
+  huddleRoundTripAnnCborSpec @(TxWits Conway) v "transaction_witness_set"
+  huddleRoundTripAnnCborSpec @(Redeemers Conway) v "redeemers"
+  huddleRoundTripAnnCborSpec @(Tx Conway) v "transaction"