CDDL with typeclasses: conway

eras/allegra/impl/CHANGELOG.md

@@ -14,6 +14,7 @@
 
 ### `cddl`
 
+* Make `max_int64`, `min_int64` and `int64` era generic.
 * Export for cross-era reuse:
   - `auxiliaryScriptsRule`, `auxiliaryDataArrayRule`, `auxiliaryDataRule`
   - `minInt64Rule`, `maxInt64Rule`, `int64Rule`

eras/allegra/impl/cddl/lib/Cardano/Ledger/Allegra/HuddleSpec.hs

@@ -18,9 +18,6 @@ module Cardano.Ledger.Allegra.HuddleSpec (
   auxiliaryScriptsRule,
   auxiliaryDataArrayRule,
   auxiliaryDataRule,
-  minInt64Rule,
-  maxInt64Rule,
-  int64Rule,
   nativeScriptRule,
   scriptNOfKGroup,
   scriptInvalidBeforeGroup,
@@ -99,16 +96,6 @@ auxiliaryDataRule p =
     =:= huddleRule @"metadata" p
     / huddleRule @"auxiliary_data_array" p
 
-minInt64Rule :: Rule
-minInt64Rule = "min_int64" =:= (-9223372036854775808 :: Integer)
-
-maxInt64Rule :: Rule
-maxInt64Rule = "max_int64" =:= (9223372036854775807 :: Integer)
-
-int64Rule ::
-  forall era. (HuddleRule "min_int64" era, HuddleRule "max_int64" era) => Proxy era -> Rule
-int64Rule p = "int64" =:= huddleRule @"min_int64" p ... huddleRule @"max_int64" p
-
 nativeScriptRule ::
   forall era.
   ( HuddleGroup "script_pubkey" era
@@ -140,7 +127,7 @@ nativeScriptRule p =
 
 scriptNOfKGroup ::
   forall era.
-  (HuddleRule "int64" era, HuddleRule "native_script" era) =>
+  HuddleRule "native_script" era =>
   Proxy era ->
   Named Group
 scriptNOfKGroup p =
@@ -198,14 +185,14 @@ instance HuddleRule "header_body" AllegraEra where
 instance HuddleRule "header" AllegraEra where
   huddleRule = headerRule @AllegraEra
 
-instance HuddleRule "min_int64" AllegraEra where
-  huddleRule _ = minInt64Rule
+instance Era era => HuddleRule "min_int64" era where
+  huddleRule _ = "min_int64" =:= (-9223372036854775808 :: Integer)
 
-instance HuddleRule "max_int64" AllegraEra where
-  huddleRule _ = maxInt64Rule
+instance Era era => HuddleRule "max_int64" era where
+  huddleRule _ = "max_int64" =:= (9223372036854775807 :: Integer)
 
-instance HuddleRule "int64" AllegraEra where
-  huddleRule = int64Rule @AllegraEra
+instance Era era => HuddleRule "int64" era where
+  huddleRule p = "int64" =:= huddleRule @"min_int64" p ... huddleRule @"max_int64" p
 
 instance HuddleGroup "script_all" AllegraEra where
   huddleGroup = scriptAllGroup @AllegraEra
@@ -304,7 +291,7 @@ instance HuddleRule "certificate" AllegraEra where
   huddleRule = certificateRule @AllegraEra
 
 instance HuddleRule "withdrawals" AllegraEra where
-  huddleRule = withdrawalsRule @AllegraEra
+  huddleRule = shelleyWithdrawalsRule @AllegraEra
 
 instance HuddleRule "auxiliary_scripts" AllegraEra where
   huddleRule = auxiliaryScriptsRule @AllegraEra

eras/alonzo/impl/CHANGELOG.md

@@ -52,6 +52,7 @@
 
 ### `cddl`
 
+* Make `plutus_v1_script` and `plutus_data` era generic.
 * Add full `HuddleSpec`.
 
 ### `testlib`

eras/alonzo/impl/cddl/lib/Cardano/Ledger/Alonzo/HuddleSpec.hs

@@ -2,12 +2,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MonoLocalBinds #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Alonzo.HuddleSpec (
@@ -23,8 +25,8 @@ module Cardano.Ledger.Alonzo.HuddleSpec (
   scriptDataHashRule,
   boundedBytesRule,
   distinctBytesRule,
-  plutusV1ScriptRule,
-  plutusDataRule,
+  alonzoRedeemer,
+  alonzoRedeemerTag,
 ) where
 
 import Cardano.Ledger.Alonzo (AlonzoEra)
@@ -99,26 +101,6 @@ distinctBytesRule =
       / (VBytes `sized` (30 :: Word64))
       / (VBytes `sized` (32 :: Word64))
 
-plutusV1ScriptRule :: forall era. HuddleRule "distinct_bytes" era => Proxy era -> Rule
-plutusV1ScriptRule p =
-  comment
-    [str|Alonzo introduces Plutus smart contracts.
-        |Plutus V1 scripts are opaque bytestrings.
-        |]
-    $ "plutus_v1_script" =:= huddleRule @"distinct_bytes" p
-
-plutusDataRule ::
-  forall era.
-  (HuddleRule "plutus_data" era, HuddleRule "bounded_bytes" era, HuddleRule "big_int" era) =>
-  Proxy era -> Rule
-plutusDataRule p =
-  "plutus_data"
-    =:= constr (huddleRule @"plutus_data" p)
-    / smp [0 <+ asKey (huddleRule @"plutus_data" p) ==> huddleRule @"plutus_data" p]
-    / sarr [0 <+ a (huddleRule @"plutus_data" p)]
-    / huddleRule @"big_int" p
-    / huddleRule @"bounded_bytes" p
-
 instance HuddleGroup "operational_cert" AlonzoEra where
   huddleGroup = shelleyOperationalCertGroup @AlonzoEra
 
@@ -153,7 +135,7 @@ instance HuddleGroup "move_instantaneous_rewards_cert" AlonzoEra where
   huddleGroup = moveInstantaneousRewardsCertGroup @AlonzoEra
 
 instance HuddleRule "withdrawals" AlonzoEra where
-  huddleRule = withdrawalsRule @AlonzoEra
+  huddleRule = shelleyWithdrawalsRule @AlonzoEra
 
 instance HuddleRule "genesis_hash" AlonzoEra where
   huddleRule = genesisHashRule @AlonzoEra
@@ -203,15 +185,6 @@ instance HuddleRule "auxiliary_scripts" AlonzoEra where
 instance HuddleRule "auxiliary_data_array" AlonzoEra where
   huddleRule = auxiliaryDataArrayRule @AlonzoEra
 
-instance HuddleRule "int64" AlonzoEra where
-  huddleRule = int64Rule @AlonzoEra
-
-instance HuddleRule "min_int64" AlonzoEra where
-  huddleRule _ = minInt64Rule
-
-instance HuddleRule "max_int64" AlonzoEra where
-  huddleRule _ = maxInt64Rule
-
 instance HuddleGroup "script_pubkey" AlonzoEra where
   huddleGroup = scriptPubkeyGroup @AlonzoEra
 
@@ -240,13 +213,10 @@ instance HuddleRule "native_script" AlonzoEra where
   huddleRule = nativeScriptRule @AlonzoEra
 
 instance HuddleRule "value" AlonzoEra where
-  huddleRule p =
-    "value"
-      =:= huddleRule @"coin" p
-      / sarr [a $ huddleRule @"coin" p, a $ multiasset p VUInt]
+  huddleRule = maryValueRule @AlonzoEra
 
 instance HuddleRule "mint" AlonzoEra where
-  huddleRule p = "mint" =:= multiasset p (huddleRule @"int64" p)
+  huddleRule = maryMintRule @AlonzoEra
 
 instance HuddleRule "block" AlonzoEra where
   huddleRule p =
@@ -338,7 +308,7 @@ instance HuddleRule "transaction_output" AlonzoEra where
       =:= arr
         [ a (huddleRule @"address" p)
         , "amount" ==> huddleRule @"value" p
-        , opt ("datum_hash" ==> huddleRule @"hash32" p) //- "new"
+        , opt ("datum_hash" ==> huddleRule @"hash32" p)
         ]
 
 instance HuddleRule "update" AlonzoEra where
@@ -491,8 +461,13 @@ instance HuddleRule "required_signers" AlonzoEra where
 instance HuddleRule "network_id" AlonzoEra where
   huddleRule _ = networkIdRule
 
-instance HuddleRule "plutus_v1_script" AlonzoEra where
-  huddleRule = plutusV1ScriptRule
+instance (Era era, HuddleRule "distinct_bytes" era) => HuddleRule "plutus_v1_script" era where
+  huddleRule p =
+    comment
+      [str|Alonzo introduces Plutus smart contracts.
+          |Plutus V1 scripts are opaque bytestrings.
+          |]
+      $ "plutus_v1_script" =:= huddleRule @"distinct_bytes" p
 
 instance HuddleRule "distinct_bytes" AlonzoEra where
   huddleRule _ = distinctBytesRule
@@ -509,8 +484,14 @@ instance HuddleRule "big_nint" AlonzoEra where
 instance HuddleRule "big_int" AlonzoEra where
   huddleRule = bigIntRule
 
-instance HuddleRule "plutus_data" AlonzoEra where
-  huddleRule = plutusDataRule
+instance (Era era, HuddleRule "big_int" era, HuddleRule "bounded_bytes" era) => HuddleRule "plutus_data" era where
+  huddleRule p =
+    "plutus_data"
+      =:= constr (huddleRule @"plutus_data" p)
+      / smp [0 <+ asKey (huddleRule @"plutus_data" p) ==> huddleRule @"plutus_data" p]
+      / sarr [0 <+ a (huddleRule @"plutus_data" p)]
+      / huddleRule @"big_int" p
+      / huddleRule @"bounded_bytes" p
 
 constr :: IsType0 a => a -> GRuleCall
 constr =
@@ -528,25 +509,38 @@ constr =
 instance HuddleRule "redeemers" AlonzoEra where
   huddleRule p = "redeemers" =:= arr [0 <+ a (huddleRule @"redeemer" p)]
 
+alonzoRedeemer ::
+  forall era.
+  ( HuddleRule "redeemer_tag" era
+  , HuddleRule "plutus_data" era
+  , HuddleRule "ex_units" era
+  ) =>
+  Proxy era ->
+  Rule
+alonzoRedeemer p =
+  "redeemer"
+    =:= arr
+      [ "tag" ==> huddleRule @"redeemer_tag" p
+      , "index" ==> VUInt
+      , "data" ==> huddleRule @"plutus_data" p
+      , "ex_units" ==> huddleRule @"ex_units" p
+      ]
+
 instance HuddleRule "redeemer" AlonzoEra where
-  huddleRule p =
-    "redeemer"
-      =:= arr
-        [ "tag" ==> huddleRule @"redeemer_tag" p
-        , "index" ==> VUInt
-        , "data" ==> huddleRule @"plutus_data" p
-        , "ex_units" ==> huddleRule @"ex_units" p
-        ]
+  huddleRule = alonzoRedeemer @AlonzoEra
+
+alonzoRedeemerTag :: Rule
+alonzoRedeemerTag =
+  comment
+    [str|0: spend
+        |1: mint
+        |2: cert
+        |3: reward
+        |]
+    $ "redeemer_tag" =:= (0 :: Integer) ... (3 :: Integer)
 
 instance HuddleRule "redeemer_tag" AlonzoEra where
-  huddleRule _ =
-    comment
-      [str|0: spend
-          |1: mint
-          |2: cert
-          |3: reward
-          |]
-      $ "redeemer_tag" =:= int 0 / int 1 / int 2 / int 3
+  huddleRule _ = alonzoRedeemerTag
 
 instance HuddleRule "ex_units" AlonzoEra where
   huddleRule _ = exUnitsRule

eras/babbage/impl/cddl/lib/Cardano/Ledger/Babbage/HuddleSpec.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Babbage.HuddleSpec (
@@ -88,7 +89,7 @@ instance HuddleRule "certificate" BabbageEra where
   huddleRule = certificateRule @BabbageEra
 
 instance HuddleRule "withdrawals" BabbageEra where
-  huddleRule = withdrawalsRule @BabbageEra
+  huddleRule = shelleyWithdrawalsRule @BabbageEra
 
 instance HuddleRule "genesis_hash" BabbageEra where
   huddleRule = genesisHashRule @BabbageEra
@@ -138,29 +139,17 @@ instance HuddleRule "vkeywitness" BabbageEra where
 instance HuddleRule "bootstrap_witness" BabbageEra where
   huddleRule = bootstrapWitnessRule @BabbageEra
 
-instance HuddleRule "int64" BabbageEra where
-  huddleRule = int64Rule @BabbageEra
-
-instance HuddleRule "min_int64" BabbageEra where
-  huddleRule _ = minInt64Rule
-
-instance HuddleRule "max_int64" BabbageEra where
-  huddleRule _ = maxInt64Rule
-
 instance HuddleRule "policy_id" BabbageEra where
   huddleRule p = "policy_id" =:= huddleRule @"script_hash" p
 
 instance HuddleRule "asset_name" BabbageEra where
   huddleRule _ = "asset_name" =:= VBytes `sized` (0 :: Word64, 32 :: Word64)
 
 instance HuddleRule "value" BabbageEra where
-  huddleRule p =
-    "value"
-      =:= huddleRule @"coin" p
-      / sarr [a $ huddleRule @"coin" p, a $ multiasset p VUInt]
+  huddleRule = maryValueRule @BabbageEra
 
 instance HuddleRule "mint" BabbageEra where
-  huddleRule p = "mint" =:= multiasset p (huddleRule @"int64" p)
+  huddleRule = maryMintRule @BabbageEra
 
 instance HuddleRule "proposed_protocol_parameter_updates" BabbageEra where
   huddleRule = proposedProtocolParameterUpdatesRule @BabbageEra
@@ -189,9 +178,6 @@ instance HuddleRule "big_int" BabbageEra where
 instance HuddleRule "distinct_bytes" BabbageEra where
   huddleRule _ = distinctBytesRule
 
-instance HuddleRule "plutus_v1_script" BabbageEra where
-  huddleRule = plutusV1ScriptRule
-
 instance HuddleRule "redeemers" BabbageEra where
   huddleRule p = "redeemers" =:= arr [0 <+ a (huddleRule @"redeemer" p)]
 
@@ -200,23 +186,10 @@ instance HuddleRule "redeemer" BabbageEra where
     comment
       [str|NEW
           |]
-      $ "redeemer"
-        =:= arr
-          [ "tag" ==> huddleRule @"redeemer_tag" p
-          , "index" ==> VUInt
-          , "data" ==> huddleRule @"plutus_data" p
-          , "ex_units" ==> huddleRule @"ex_units" p
-          ]
+      $ alonzoRedeemer p
 
 instance HuddleRule "redeemer_tag" BabbageEra where
-  huddleRule _ =
-    comment
-      [str|0: spend
-          |1: mint
-          |2: cert
-          |3: reward
-          |]
-      $ "redeemer_tag" =:= int 0 / int 1 / int 2 / int 3
+  huddleRule _ = alonzoRedeemerTag
 
 instance HuddleRule "ex_units" BabbageEra where
   huddleRule _ = exUnitsRule
@@ -410,12 +383,12 @@ instance HuddleRule "transaction_output" BabbageEra where
           |and can be used interchangeably.
           |]
       $ "transaction_output"
-        =:= huddleRule @"shelley_transaction_output" p
+        =:= huddleRule @"alonzo_transaction_output" p
         / babbageTransactionOutput p (huddleRule @"script" p)
 
-instance HuddleRule "shelley_transaction_output" BabbageEra where
+instance HuddleRule "alonzo_transaction_output" BabbageEra where
   huddleRule p =
-    "shelley_transaction_output"
+    "alonzo_transaction_output"
       =:= arr
         [ a (huddleRule @"address" p)
         , "amount" ==> huddleRule @"value" p
@@ -479,10 +452,7 @@ instance HuddleGroup "script_invalid_before" BabbageEra where
 instance HuddleGroup "script_invalid_hereafter" BabbageEra where
   huddleGroup = scriptInvalidHereafterGroup @BabbageEra
 
-instance HuddleRule "plutus_data" BabbageEra where
-  huddleRule = plutusDataRule
-
-instance HuddleRule "plutus_v2_script" BabbageEra where
+instance (Era era, HuddleRule "distinct_bytes" era) => HuddleRule "plutus_v2_script" era where
   huddleRule p =
     comment
       [str|Babbage introduces Plutus V2 with improved cost model
@@ -518,7 +488,7 @@ instance HuddleRule "language" BabbageEra where
       [str|0: Plutus v1
           |1: Plutus v2
           |]
-      $ "language" =:= int 0 / int 1
+      $ "language" =:= (0 :: Integer) ... (1 :: Integer)
 
 instance HuddleRule "cost_models" BabbageEra where
   huddleRule p =