diff --git a/eras/allegra/impl/cddl-files/allegra.cddl b/eras/allegra/impl/cddl-files/allegra.cddl index 9f1a4af15f6..8497550ec33 100644 --- a/eras/allegra/impl/cddl-files/allegra.cddl +++ b/eras/allegra/impl/cddl-files/allegra.cddl @@ -166,6 +166,7 @@ pool_keyhash = hash28 pool_registration_cert = (3, pool_params) +; Pool parameters for stake pool registration pool_params = ( operator : pool_keyhash , vrf_keyhash : vrf_keyhash @@ -292,8 +293,6 @@ transaction_witness_set = vkeywitness = [vkey, signature] ; Allegra introduces timelock support for native scripts. -; This is the 6-variant native script format used by -; Allegra, Mary, Alonzo, Babbage, and Conway. ; ; Timelock validity intervals are half-open intervals [a, b). ; script_invalid_before: specifies the left (included) endpoint a. diff --git a/eras/allegra/impl/cddl/lib/Cardano/Ledger/Allegra/HuddleSpec.hs b/eras/allegra/impl/cddl/lib/Cardano/Ledger/Allegra/HuddleSpec.hs index a4f0e2be0e7..1157d2b32bd 100644 --- a/eras/allegra/impl/cddl/lib/Cardano/Ledger/Allegra/HuddleSpec.hs +++ b/eras/allegra/impl/cddl/lib/Cardano/Ledger/Allegra/HuddleSpec.hs @@ -304,7 +304,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 diff --git a/eras/alonzo/impl/cddl-files/alonzo.cddl b/eras/alonzo/impl/cddl-files/alonzo.cddl index 9cc6ab39138..a3f2c9301ad 100644 --- a/eras/alonzo/impl/cddl-files/alonzo.cddl +++ b/eras/alonzo/impl/cddl-files/alonzo.cddl @@ -5,20 +5,17 @@ ; the same ; 2) every transaction_index must be strictly smaller than the length of ; transaction_bodies -; NEW: -; invalid_transactions block = [ header , transaction_bodies : [* transaction_body] , transaction_witness_sets : [* transaction_witness_set] , auxiliary_data_set : {* transaction_index => auxiliary_data} - , invalid_transactions : [* transaction_index] + , invalid_transactions : [* transaction_index] ; new ] header = [header_body, body_signature : kes_signature] -; block_body_size: merkle triple root header_body = [ block_number : block_number , slot : slot @@ -28,7 +25,7 @@ header_body = , nonce_vrf : vrf_cert , leader_vrf : vrf_cert , block_body_size : uint - , block_body_hash : hash32 + , block_body_hash : hash32 ; merkle triple root , operational_cert , protocol_version ] @@ -67,30 +64,21 @@ major_protocol_version = 0 .. 7 kes_signature = bytes .size 448 -; 2: fee -; 3: time to live -; 8: validity interval start -; 13: collateral -; NEW: -; 11: script_data_hash -; 13: set transaction_input -; 14: required_signers -; 15: network_id transaction_body = { 0 : set , 1 : [* transaction_output] - , 2 : coin - , ? 3 : slot + , 2 : coin ; fee + , ? 3 : slot ; time to live , ? 4 : [* certificate] , ? 5 : withdrawals , ? 6 : update , ? 7 : auxiliary_data_hash - , ? 8 : slot + , ? 8 : slot ; validity interval start , ? 9 : mint - , ? 11 : script_data_hash - , ? 13 : set - , ? 14 : required_signers - , ? 15 : network_id + , ? 11 : script_data_hash ; new + , ? 13 : set ; collateral + , ? 14 : required_signers ; new + , ? 15 : network_id ; new } @@ -100,9 +88,12 @@ transaction_input = [id : transaction_id, index : uint .size 2] transaction_id = hash32 -; NEW: -; datum_hash: $hash32 -transaction_output = [address, amount : value, ? datum_hash : hash32] +transaction_output = + [ address + , amount : value + , ? datum_hash : hash32 ; new + ] + ; address = bytes ; @@ -198,6 +189,7 @@ pool_keyhash = hash28 pool_registration_cert = (3, pool_params) +; Pool parameters for stake pool registration pool_params = ( operator : pool_keyhash , vrf_keyhash : vrf_keyhash @@ -285,55 +277,31 @@ update = [proposed_protocol_parameter_updates, epoch] proposed_protocol_parameter_updates = {* genesis_hash => protocol_param_update} -; 0: minfee A -; 1: minfee B -; 2: max block body size -; 3: max transaction size -; 4: max block header size -; 5: key deposit -; 6: pool deposit -; 7: maximum epoch -; 8: n_opt: desired number of stake pools -; 9: pool pledge influence -; 10: expansion rate -; 11: treasury growth rate -; 12: d. decentralization constant -; 13: extra entropy -; 14: protocol version -; 16: min pool cost ; NEW -; 17: ada per utxo byte ; NEW -; 18: cost models for script languages ; NEW -; 19: execution costs ; NEW -; 20: max tx ex units ; NEW -; 21: max block ex units ; NEW -; 22: max value size ; NEW -; 23: collateral percentage ; NEW -; 24: max collateral inputs ; NEW protocol_param_update = - { ? 0 : uint - , ? 1 : uint - , ? 2 : uint .size 4 - , ? 3 : uint .size 4 - , ? 4 : uint .size 2 - , ? 5 : coin - , ? 6 : coin - , ? 7 : epoch_interval - , ? 8 : uint .size 2 - , ? 9 : nonnegative_interval - , ? 10 : unit_interval - , ? 11 : unit_interval - , ? 12 : unit_interval - , ? 13 : nonce - , ? 14 : [protocol_version] - , ? 16 : coin - , ? 17 : coin - , ? 18 : cost_models - , ? 19 : ex_unit_prices - , ? 20 : ex_units - , ? 21 : ex_units - , ? 22 : uint - , ? 23 : uint - , ? 24 : uint + { ? 0 : uint ; minfee A + , ? 1 : uint ; minfee B + , ? 2 : uint .size 4 ; max block body size + , ? 3 : uint .size 4 ; max transaction size + , ? 4 : uint .size 2 ; max block header size + , ? 5 : coin ; key deposit + , ? 6 : coin ; pool deposit + , ? 7 : epoch_interval ; maximum epoch + , ? 8 : uint .size 2 ; n_opt: desired number of stake pools + , ? 9 : nonnegative_interval ; pool pledge influence + , ? 10 : unit_interval ; expansion rate + , ? 11 : unit_interval ; treasury growth rate + , ? 12 : unit_interval ; decentralization constant + , ? 13 : nonce ; extra entropy + , ? 14 : [protocol_version] ; protocol version + , ? 16 : coin ; min pool cost + , ? 17 : coin ; ada per utxo byte + , ? 18 : cost_models ; cost models for script languages + , ? 19 : ex_unit_prices ; execution costs + , ? 20 : ex_units ; max tx ex units + , ? 21 : ex_units ; max block ex units + , ? 22 : uint ; max value size + , ? 23 : uint ; collateral percentage + , ? 24 : uint ; max collateral inputs } @@ -429,36 +397,26 @@ mint = multiasset ; [ 80 | datums | A0 ] ; ; corresponding to a CBOR empty list and an empty map (our -; apologies)., -; -; NEW: -; script_data_hash +; apologies). script_data_hash = hash32 required_signers = set network_id = 0/ 1 -; -; NEW: -; 3: [* plutus_v1_script ] -; 4: [* plutus_data ] -; 5: redeemers transaction_witness_set = { ? 0 : [* vkeywitness] , ? 1 : [* native_script] , ? 2 : [* bootstrap_witness] - , ? 3 : [* plutus_v1_script] - , ? 4 : [* plutus_data] - , ? 5 : redeemers + , ? 3 : [* plutus_v1_script] ; new + , ? 4 : [* plutus_data] ; new + , ? 5 : redeemers ; new } vkeywitness = [vkey, signature] ; Allegra introduces timelock support for native scripts. -; This is the 6-variant native script format used by -; Allegra, Mary, Alonzo, Babbage, and Conway. ; ; Timelock validity intervals are half-open intervals [a, b). ; script_invalid_before: specifies the left (included) endpoint a. @@ -513,7 +471,6 @@ distinct_bytes = / bytes .size 30 / bytes .size 32 -; NEW plutus_data = constr @@ -553,7 +510,6 @@ big_nint = #6.3(bounded_bytes) redeemers = [* redeemer] -; NEW redeemer = [tag : redeemer_tag, index : uint, data : plutus_data, ex_units : ex_units] @@ -561,7 +517,7 @@ redeemer = ; 1: mint ; 2: cert ; 3: reward -redeemer_tag = 0/ 1/ 2/ 3 +redeemer_tag = 0 .. 3 transaction_index = uint .size 2 diff --git a/eras/alonzo/impl/cddl/lib/Cardano/Ledger/Alonzo/HuddleSpec.hs b/eras/alonzo/impl/cddl/lib/Cardano/Ledger/Alonzo/HuddleSpec.hs index 08abbb68071..896c7206fd8 100644 --- a/eras/alonzo/impl/cddl/lib/Cardano/Ledger/Alonzo/HuddleSpec.hs +++ b/eras/alonzo/impl/cddl/lib/Cardano/Ledger/Alonzo/HuddleSpec.hs @@ -25,6 +25,9 @@ module Cardano.Ledger.Alonzo.HuddleSpec ( distinctBytesRule, plutusV1ScriptRule, plutusDataRule, + alonzoTransactionOutputRule, + alonzoRedeemer, + alonzoRedeemerTag, ) where import Cardano.Ledger.Alonzo (AlonzoEra) @@ -119,6 +122,19 @@ plutusDataRule p = / huddleRule @"big_int" p / huddleRule @"bounded_bytes" p +alonzoTransactionOutputRule :: + forall era. + HuddleRule "value" era => + Proxy era -> + Rule +alonzoTransactionOutputRule p = + "transaction_output" + =:= arr + [ a (huddleRule @"address" p) + , "amount" ==> huddleRule @"value" p + , opt ("datum_hash" ==> huddleRule @"hash32" p) + ] + instance HuddleGroup "operational_cert" AlonzoEra where huddleGroup = shelleyOperationalCertGroup @AlonzoEra @@ -153,7 +169,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 @@ -240,13 +256,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 = @@ -333,13 +346,7 @@ instance HuddleRule "transaction_body" AlonzoEra where ] instance HuddleRule "transaction_output" AlonzoEra where - huddleRule p = - "transaction_output" - =:= arr - [ a (huddleRule @"address" p) - , "amount" ==> huddleRule @"value" p - , opt ("datum_hash" ==> huddleRule @"hash32" p) //- "new" - ] + huddleRule = alonzoTransactionOutputRule @AlonzoEra instance HuddleRule "update" AlonzoEra where huddleRule p = @@ -528,25 +535,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 diff --git a/eras/babbage/impl/cddl-files/babbage.cddl b/eras/babbage/impl/cddl-files/babbage.cddl index 5922038ef3a..9898f3866a9 100644 --- a/eras/babbage/impl/cddl-files/babbage.cddl +++ b/eras/babbage/impl/cddl-files/babbage.cddl @@ -16,17 +16,15 @@ block = header = [header_body, body_signature : kes_signature] -; block_body_size: merkle triple root -; vrf_result: NEW, replaces nonce_vrf and leader_vrf header_body = [ block_number : block_number , slot : slot , prev_hash : hash32/ nil , issuer_vkey : vkey , vrf_vkey : vrf_vkey - , vrf_result : vrf_cert + , vrf_result : vrf_cert ; replaces nonce_vrf and leader_vrf , block_body_size : uint - , block_body_hash : hash32 + , block_body_hash : hash32 ; merkle triple root , operational_cert , protocol_version ] @@ -66,32 +64,24 @@ major_protocol_version = 0 .. 9 kes_signature = bytes .size 448 -; 2: fee -; 3: time to live -; 8: validity interval start -; 13: collateral inputs -; NEW: -; 16: collateral return -; 17: total collateral -; 18: reference inputs transaction_body = { 0 : set , 1 : [* transaction_output] - , 2 : coin - , ? 3 : slot + , 2 : coin ; fee + , ? 3 : slot ; time to live , ? 4 : [* certificate] , ? 5 : withdrawals , ? 6 : update , ? 7 : auxiliary_data_hash - , ? 8 : slot + , ? 8 : slot ; validity interval start , ? 9 : mint , ? 11 : script_data_hash - , ? 13 : set + , ? 13 : set ; collateral , ? 14 : required_signers , ? 15 : network_id - , ? 16 : transaction_output - , ? 17 : coin - , ? 18 : set + , ? 16 : transaction_output ; collateral return + , ? 17 : coin ; total collateral + , ? 18 : set ; reference inputs } @@ -103,11 +93,9 @@ transaction_id = hash32 ; Both of the Alonzo and Babbage style TxOut formats are equally valid ; and can be used interchangeably. -; NEW: -; babbage_transaction_output -transaction_output = shelley_transaction_output/ babbage_transaction_output +transaction_output = alonzo_transaction_output/ babbage_transaction_output -shelley_transaction_output = [address, amount : value, ? datum_hash : hash32] +alonzo_transaction_output = [address, amount : value, ? datum_hash : hash32] ; address = bytes ; @@ -174,11 +162,13 @@ hash28 = bytes .size 28 asset_name = bytes .size (0 .. 32) -; NEW starting with babbage -; datum_option -; script_ref babbage_transaction_output = - {0 : address, 1 : value, ? 2 : datum_option, ? 3 : script_ref} + { 0 : address + , 1 : value + , ? 2 : datum_option ; new + , ? 3 : script_ref ; new + } + datum_option = [0, hash32// 1, data] @@ -230,8 +220,6 @@ script_ref = #6.24(bytes .cbor script) script = [0, native_script// 1, plutus_v1_script// 2, plutus_v2_script] ; Allegra introduces timelock support for native scripts. -; This is the 6-variant native script format used by -; Allegra, Mary, Alonzo, Babbage, and Conway. ; ; Timelock validity intervals are half-open intervals [a, b). ; script_invalid_before: specifies the left (included) endpoint a. @@ -317,6 +305,7 @@ pool_keyhash = hash28 pool_registration_cert = (3, pool_params) +; Pool parameters for stake pool registration pool_params = ( operator : pool_keyhash , vrf_keyhash : vrf_keyhash @@ -404,51 +393,29 @@ update = [proposed_protocol_parameter_updates, epoch] proposed_protocol_parameter_updates = {* genesis_hash => protocol_param_update} -; 0: minfee A -; 1: minfee B -; 2: max block body size -; 3: max transaction size -; 4: max block header size -; 5: key deposit -; 6: pool deposit -; 7: maximum epoch -; 8: n_opt: desired number of stake pools -; 9: pool pledge influence -; 10: expansion rate -; 11: treasury growth rate -; 14: protocol version -; 16: min pool cost -; 17: ada per utxo byte -; 18: cost models for script languages -; 19: execution costs -; 20: max tx ex units -; 21: max block ex units -; 22: max value size -; 23: collateral percentage -; 24: max collateral inputs protocol_param_update = - { ? 0 : uint - , ? 1 : uint - , ? 2 : uint .size 4 - , ? 3 : uint .size 4 - , ? 4 : uint .size 2 - , ? 5 : coin - , ? 6 : coin - , ? 7 : epoch_interval - , ? 8 : uint .size 2 - , ? 9 : nonnegative_interval - , ? 10 : unit_interval - , ? 11 : unit_interval - , ? 14 : protocol_version - , ? 16 : coin - , ? 17 : coin - , ? 18 : cost_models - , ? 19 : ex_unit_prices - , ? 20 : ex_units - , ? 21 : ex_units - , ? 22 : uint - , ? 23 : uint - , ? 24 : uint + { ? 0 : uint ; minfee A + , ? 1 : uint ; minfee B + , ? 2 : uint .size 4 ; max block body size + , ? 3 : uint .size 4 ; max transaction size + , ? 4 : uint .size 2 ; max block header size + , ? 5 : coin ; key deposit + , ? 6 : coin ; pool deposit + , ? 7 : epoch_interval ; maximum epoch + , ? 8 : uint .size 2 ; n_opt: desired number of stake pools + , ? 9 : nonnegative_interval ; pool pledge influence + , ? 10 : unit_interval ; expansion rate + , ? 11 : unit_interval ; treasury growth rate + , ? 14 : protocol_version ; protocol version + , ? 16 : coin ; min pool cost + , ? 17 : coin ; ada per utxo byte + , ? 18 : cost_models ; cost models for script languages + , ? 19 : ex_unit_prices ; execution costs + , ? 20 : ex_units ; max tx ex units + , ? 21 : ex_units ; max block ex units + , ? 22 : uint ; max value size + , ? 23 : uint ; collateral percentage + , ? 24 : uint ; max collateral inputs } @@ -460,8 +427,6 @@ positive_int = 1 .. max_word64 max_word64 = 18446744073709551615 -; 0: Plutus v1 -; 1: Plutus v2 cost_models = {? 0 : [166*166 int64], ? 1 : [175*175 int64]} ex_unit_prices = [mem_price : positive_interval, step_price : positive_interval] @@ -541,9 +506,6 @@ required_signers = set network_id = 0/ 1 -; -; NEW: -; 6: [* plutus_v2_script] transaction_witness_set = { ? 0 : [* vkeywitness] , ? 1 : [* native_script] @@ -575,7 +537,7 @@ redeemer = ; 1: mint ; 2: cert ; 3: reward -redeemer_tag = 0/ 1/ 2/ 3 +redeemer_tag = 0 .. 3 transaction_index = uint .size 2 @@ -618,7 +580,7 @@ transaction = ; 0: Plutus v1 ; 1: Plutus v2 -language = 0/ 1 +language = 0 .. 1 signkey_kes = bytes .size 64 diff --git a/eras/babbage/impl/cddl/lib/Cardano/Ledger/Babbage/HuddleSpec.hs b/eras/babbage/impl/cddl/lib/Cardano/Ledger/Babbage/HuddleSpec.hs index 1d64056dfcd..e1cd3605be8 100644 --- a/eras/babbage/impl/cddl/lib/Cardano/Ledger/Babbage/HuddleSpec.hs +++ b/eras/babbage/impl/cddl/lib/Cardano/Ledger/Babbage/HuddleSpec.hs @@ -88,7 +88,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 @@ -154,13 +154,10 @@ 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 @@ -200,23 +197,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,17 +394,11 @@ 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 - huddleRule p = - "shelley_transaction_output" - =:= arr - [ a (huddleRule @"address" p) - , "amount" ==> huddleRule @"value" p - , opt ("datum_hash" ==> huddleRule @"hash32" p) - ] +instance HuddleRule "alonzo_transaction_output" BabbageEra where + huddleRule p = "alonzo_transaction_output" =:= alonzoTransactionOutputRule @BabbageEra p babbageTransactionOutput :: forall era. @@ -518,7 +496,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 = diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index 18847a3aa0e..a7898bbc656 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.21.0.0 +* Add `cddl` sub-library, and `generate-cddl` executable. * Changed the type of the following fields to `CompactForm Coin` in `ConwayPParams`: - `cppMinFeeA` - `cppMinFeeB` @@ -32,6 +33,10 @@ - Add `hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule` to `Conway.Era`. - Add `updateDormantDRepExpiries` and `updateVotingDRepExpiries` +### `cddl` + +* Add full `HuddleSpec`. + ### `testlib` * Add CDDL definitions: diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index 48106cf73c0..09f1518db32 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -122,6 +122,51 @@ library if flag(asserts) ghc-options: -fno-ignore-asserts +library cddl + exposed-modules: + Cardano.Ledger.Conway.HuddleSpec + + visibility: public + hs-source-dirs: cddl/lib + default-language: Haskell2010 + ghc-options: + -Wall + -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wredundant-constraints + -Wpartial-fields + -Wunused-packages + + build-depends: + base, + cardano-ledger-babbage:cddl, + cardano-ledger-conway, + cuddle >=0.4, + heredoc, + text, + +executable generate-cddl + main-is: Main.hs + hs-source-dirs: cddl/exe + other-modules: Paths_cardano_ledger_conway + default-language: Haskell2010 + ghc-options: + -Wall + -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wredundant-constraints + -Wpartial-fields + -Wunused-packages + + build-depends: + base, + cardano-ledger-binary:testlib >=1.5, + cddl, + directory, + filepath, + library testlib exposed-modules: Test.Cardano.Ledger.Conway.Arbitrary diff --git a/eras/conway/impl/cddl-files/conway.cddl b/eras/conway/impl/cddl-files/conway.cddl index fed83a70a32..b22dce2211b 100644 --- a/eras/conway/impl/cddl-files/conway.cddl +++ b/eras/conway/impl/cddl-files/conway.cddl @@ -1,10 +1,10 @@ ; This file was auto-generated from huddle. Please do not modify it directly! ; Valid blocks must also satisfy the following two constraints: -; 1. the length of transaction_bodies and transaction_witness_sets -; must be the same -; 2. every transaction_index must be strictly smaller than the -; length of transaction_bodies +; 1) the length of transaction_bodies and transaction_witness_sets must be +; the same +; 2) every transaction_index must be strictly smaller than the length of +; transaction_bodies block = [ header , transaction_bodies : [* transaction_body] @@ -19,7 +19,10 @@ transaction = kes_signature = bytes .size 448 -language = 0/ 1/ 2 +; 0: Plutus v1 +; 1: Plutus v2 +; 2: Plutus v3 +language = 0 .. 2 potential_languages = 0 .. 255 @@ -46,27 +49,17 @@ certificate = ] -; dns_name: An A or AAAA DNS record -single_host_name = (1, port/ nil, dns_name) - -; dns_name: An SRV DNS record -multi_host_name = (2, dns_name) +policy_id = script_hash -pool_metadata = [url, bytes] +asset_name = bytes .size (0 .. 32) -relay = [single_host_addr// single_host_name// multi_host_name] +redeemer = + [ tag : redeemer_tag + , index : uint .size 4 + , data : plutus_data + , ex_units : ex_units + ] -pool_params = - ( operator : pool_keyhash - , vrf_keyhash : vrf_keyhash - , pledge : coin - , cost : coin - , margin : unit_interval - , reward_account : reward_account - , pool_owners : set - , relays : [* relay] - , pool_metadata : pool_metadata/ nil - ) header = [header_body, body_signature : kes_signature] @@ -78,7 +71,7 @@ header_body = , vrf_vkey : vrf_vkey , vrf_result : vrf_cert , block_body_size : uint .size 4 - , block_body_hash : hash32 + , block_body_hash : hash32 ; merkle triple root , operational_cert , protocol_version ] @@ -119,24 +112,24 @@ major_protocol_version = 0 .. 12 transaction_body = { 0 : set , 1 : [* transaction_output] - , 2 : coin - , ? 3 : slot + , 2 : coin ; fee + , ? 3 : slot ; time to live , ? 4 : certificates , ? 5 : withdrawals , ? 7 : auxiliary_data_hash - , ? 8 : slot + , ? 8 : slot ; validity interval start , ? 9 : mint , ? 11 : script_data_hash - , ? 13 : nonempty_set + , ? 13 : nonempty_set ; collateral , ? 14 : required_signers , ? 15 : network_id - , ? 16 : transaction_output - , ? 17 : coin - , ? 18 : nonempty_set + , ? 16 : transaction_output ; collateral return + , ? 17 : coin ; total collateral + , ? 18 : nonempty_set ; reference inputs , ? 19 : voting_procedures , ? 20 : proposal_procedures - , ? 21 : coin - , ? 22 : positive_coin + , ? 21 : coin ; current treasury value + , ? 22 : positive_coin ; donation } @@ -148,10 +141,9 @@ transaction_id = hash32 ; Both of the Alonzo and Babbage style TxOut formats are equally valid ; and can be used interchangeably -transaction_output = shelley_transaction_output/ babbage_transaction_output +transaction_output = alonzo_transaction_output/ babbage_transaction_output -; hash32: datum_hash -shelley_transaction_output = [address, amount : value, ? hash32] +alonzo_transaction_output = [address, amount : value, ? datum_hash : hash32] ; address = bytes ; @@ -201,8 +193,6 @@ coin = uint multiasset = {* policy_id => {+ asset_name => a0}} -policy_id = script_hash - ; To compute a script hash, note that you must prepend ; a tag to the bytes of the script before hashing. ; The tag is determined by the language. @@ -216,17 +206,17 @@ script_hash = hash28 hash28 = bytes .size 28 -asset_name = bytes .size (0 .. 32) - positive_coin = 1 .. max_word64 max_word64 = 18446744073709551615 -; NEW starting with babbage -; datum_option -; script_ref babbage_transaction_output = - {0 : address, 1 : value, ? 2 : datum_option, ? 3 : script_ref} + { 0 : address + , 1 : value + , ? 2 : datum_option ; new + , ? 3 : script_ref ; new + } + datum_option = [0, hash32// 1, data] @@ -275,7 +265,7 @@ script_ref = #6.24(bytes .cbor script) ; 0: Native scripts (timelock) - unchanged from Allegra ; 1: Plutus V1 scripts ; 2: Plutus V2 scripts -; 3: Plutus V3 scripts (NEW) +; 3: Plutus V3 scripts script = [ 0, native_script // 1, plutus_v1_script @@ -285,8 +275,6 @@ script = ; Allegra introduces timelock support for native scripts. -; This is the 6-variant native script format used by -; Allegra, Mary, Alonzo, Babbage, and Conway. ; ; Timelock validity intervals are half-open intervals [a, b). ; script_invalid_before: specifies the left (included) endpoint a. @@ -372,6 +360,19 @@ pool_keyhash = hash28 pool_registration_cert = (3, pool_params) +; Pool parameters for stake pool registration +pool_params = + ( operator : pool_keyhash + , vrf_keyhash : vrf_keyhash + , pledge : coin + , cost : coin + , margin : unit_interval + , reward_account : reward_account + , pool_owners : set + , relays : [* relay] + , pool_metadata : pool_metadata/ nil + ) + vrf_keyhash = hash32 ; The real unit_interval is: #6.30([uint, uint]) @@ -395,6 +396,8 @@ reward_account = h'E090000000000000000000000000000000000000000000000000000000' / h'F0A0000000000000000000000000000000000000000000000000000000' +relay = [single_host_addr// single_host_name// multi_host_name] + single_host_addr = (0, port/ nil, ipv4/ nil, ipv6/ nil) port = uint .le 65535 @@ -403,8 +406,16 @@ ipv4 = bytes .size 4 ipv6 = bytes .size 16 +; dns_name: An A or AAAA DNS record +single_host_name = (1, port/ nil, dns_name) + dns_name = text .size (0 .. 128) +; dns_name: An SRV DNS record +multi_host_name = (2, dns_name) + +pool_metadata = [url, bytes] + url = text .size (0 .. 128) pool_retirement_cert = (4, pool_keyhash, epoch) @@ -431,7 +442,6 @@ account_registration_delegation_to_drep_cert = account_registration_delegation_to_stake_pool_and_drep_cert = (13, stake_credential, pool_keyhash, drep, coin) -; Authorize committee hot key for cold key committee_authorization_cert = (14, committee_cold_credential, committee_hot_credential) @@ -439,7 +449,6 @@ committee_cold_credential = credential committee_hot_credential = credential -; Resign from committee with cold key committee_resignation_cert = (15, committee_cold_credential, anchor/ nil) anchor = [anchor_url : url, anchor_data_hash : hash32] @@ -541,16 +550,11 @@ network_id = 0/ 1 voting_procedures = {+ voter => {+ gov_action_id => voting_procedure}} voter = - [ 0 - , addr_keyhash - // 1 - , script_hash - // 2 - , addr_keyhash - // 3 - , script_hash - // 4 - , addr_keyhash + [ 0, addr_keyhash + // 1, script_hash + // 2, addr_keyhash + // 3, script_hash + // 4, addr_keyhash ] @@ -706,14 +710,8 @@ bootstrap_witness = ; will be removed in the next era. It is recommended for tools to ; adopt using a Map instead of Array going forward. redeemers = - [ + [ tag : redeemer_tag - , index : uint .size 4 - , data : plutus_data - , ex_units : ex_units - ] - - - ] + [ + redeemer + ] / { + [tag : redeemer_tag, index : uint .size 4] => [ data : plutus_data , ex_units : ex_units ] @@ -721,13 +719,13 @@ redeemers = } -redeemer_tag = - 0 ; spend - / 1 ; mint - / 2 ; cert - / 3 ; reward - / 4 ; voting - / 5 ; proposing +; 0: spend +; 1: mint +; 2: cert +; 3: reward +; 4: voting +; 5: proposing +redeemer_tag = 0 .. 5 transaction_index = uint .size 2 diff --git a/eras/conway/impl/cddl/exe/Main.hs b/eras/conway/impl/cddl/exe/Main.hs new file mode 100644 index 00000000000..0d07b8c24b6 --- /dev/null +++ b/eras/conway/impl/cddl/exe/Main.hs @@ -0,0 +1,14 @@ +module Main where + +import Cardano.Ledger.Conway.HuddleSpec (conwayCDDL) +import Paths_cardano_ledger_conway (getDataFileName) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (takeDirectory) +import Test.Cardano.Ledger.Binary.Cuddle (writeSpec) + +main :: IO () +main = do + outputPath <- getDataFileName "cddl-files/conway.cddl" + createDirectoryIfMissing True (takeDirectory outputPath) + writeSpec conwayCDDL outputPath + putStrLn $ "Generated CDDL file at: " ++ outputPath diff --git a/eras/conway/impl/cddl/lib/Cardano/Ledger/Conway/HuddleSpec.hs b/eras/conway/impl/cddl/lib/Cardano/Ledger/Conway/HuddleSpec.hs new file mode 100644 index 00000000000..5f697acec74 --- /dev/null +++ b/eras/conway/impl/cddl/lib/Cardano/Ledger/Conway/HuddleSpec.hs @@ -0,0 +1,1256 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Cardano.Ledger.Conway.HuddleSpec ( + module Cardano.Ledger.Babbage.HuddleSpec, + conwayCDDL, + conwayMultiasset, + conwayValueRule, + conwayMintRule, + conwayWithdrawalsRule, + conwayRedeemer, + conwayRedeemerTag, + anchorRule, + drepRule, + voterRule, + govActionIdRule, + negativeInt64Rule, + positiveInt64Rule, + nonzeroInt64Rule, + accountRegistrationDepositCertGroup, + accountUnregistrationDepositCertGroup, + delegationToDrepCertGroup, + delegationToStakePoolAndDrepCertGroup, + accountRegistrationDelegationToStakePoolCertGroup, + accountRegistrationDelegationToDrepCertGroup, + accountRegistrationDelegationToStakePoolAndDrepCertGroup, + committeeAuthorizationCertGroup, + committeeResignationCertGroup, + drepRegistrationCertGroup, + drepUnregistrationCertGroup, + drepUpdateCertGroup, + votingProcedureRule, + votingProceduresRule, + constitutionRule, + parameterChangeActionGroup, + hardForkInitiationActionGroup, + treasuryWithdrawalsActionGroup, + noConfidenceGroup, + updateCommitteeGroup, + newConstitutionGroup, + infoActionRule, + govActionRule, + proposalProcedureRule, + proposalProceduresRule, + poolVotingThresholdsRule, + drepVotingThresholdsRule, + maybeTaggedSet, + maybeTaggedNonemptySet, + maybeTaggedOset, + maybeTaggedNonemptyOset, +) where + +import Cardano.Ledger.Babbage.HuddleSpec hiding ( + alonzoRedeemer, + alonzoRedeemerTag, + maryMintRule, + maryMultiasset, + maryValueRule, + shelleyWithdrawalsRule, + ) +import Cardano.Ledger.Conway (ConwayEra) +import Codec.CBOR.Cuddle.Comments ((//-)) +import Codec.CBOR.Cuddle.Huddle +import Data.Proxy (Proxy (..)) +import Data.Text qualified as T +import Data.Word (Word64) +import Text.Heredoc +import Prelude hiding ((/)) + +conwayCDDL :: Huddle +conwayCDDL = + collectFromInit + [ HIRule $ huddleRule @"block" (Proxy @ConwayEra) + , HIRule $ huddleRule @"transaction" (Proxy @ConwayEra) + , HIRule $ huddleRule @"kes_signature" (Proxy @ConwayEra) + , HIRule $ huddleRule @"language" (Proxy @ConwayEra) + , HIRule $ huddleRule @"potential_languages" (Proxy @ConwayEra) + , HIRule $ huddleRule @"signkey_kes" (Proxy @ConwayEra) + , HIRule $ huddleRule @"certificate" (Proxy @ConwayEra) + , HIRule $ huddleRule @"policy_id" (Proxy @ConwayEra) + , HIRule $ huddleRule @"asset_name" (Proxy @ConwayEra) + , HIRule $ huddleRule @"redeemer" (Proxy @ConwayEra) + ] + +anchorRule :: forall era. (HuddleRule "url" era, HuddleRule "hash32" era) => Proxy era -> Rule +anchorRule p = + "anchor" + =:= arr + [ "anchor_url" ==> huddleRule @"url" p + , "anchor_data_hash" ==> huddleRule @"hash32" p + ] + +drepRule :: + forall era. (HuddleRule "addr_keyhash" era, HuddleRule "script_hash" era) => Proxy era -> Rule +drepRule p = + "drep" + =:= arr [0, a (huddleRule @"addr_keyhash" p)] + / arr [1, a (huddleRule @"script_hash" p)] + / arr [2] + / arr [3] + +voterRule :: + forall era. (HuddleRule "addr_keyhash" era, HuddleRule "script_hash" era) => Proxy era -> Rule +voterRule p = + "voter" + =:= arr [0, a (huddleRule @"addr_keyhash" p)] + / arr [1, a (huddleRule @"script_hash" p)] + / arr [2, a (huddleRule @"addr_keyhash" p)] + / arr [3, a (huddleRule @"script_hash" p)] + / arr [4, a (huddleRule @"addr_keyhash" p)] + +govActionIdRule :: forall era. HuddleRule "transaction_id" era => Proxy era -> Rule +govActionIdRule p = + "gov_action_id" + =:= arr + [ "transaction_id" ==> huddleRule @"transaction_id" p + , "gov_action_index" ==> (VUInt `sized` (2 :: Word64)) + ] + +negativeInt64Rule :: forall era. HuddleRule "min_int64" era => Proxy era -> Rule +negativeInt64Rule p = + "negative_int64" + =:= huddleRule @"min_int64" p + ... (-1 :: Integer) + +positiveInt64Rule :: forall era. HuddleRule "max_int64" era => Proxy era -> Rule +positiveInt64Rule p = + "positive_int64" + =:= (1 :: Integer) + ... huddleRule @"max_int64" p + +nonzeroInt64Rule :: + forall era. + (HuddleRule "negative_int64" era, HuddleRule "positive_int64" era) => + Proxy era -> + Rule +nonzeroInt64Rule p = + "nonzero_int64" + =:= huddleRule @"negative_int64" p + / huddleRule @"positive_int64" p + +accountRegistrationDepositCertGroup :: + forall era. + (HuddleRule "stake_credential" era, HuddleRule "coin" era) => + Proxy era -> + Named Group +accountRegistrationDepositCertGroup p = + "account_registration_deposit_cert" + =:~ grp [7, a (huddleRule @"stake_credential" p), a (huddleRule @"coin" p)] + +accountUnregistrationDepositCertGroup :: + forall era. + (HuddleRule "stake_credential" era, HuddleRule "coin" era) => + Proxy era -> + Named Group +accountUnregistrationDepositCertGroup p = + "account_unregistration_deposit_cert" + =:~ grp [8, a (huddleRule @"stake_credential" p), a (huddleRule @"coin" p)] + +delegationToDrepCertGroup :: + forall era. + (HuddleRule "stake_credential" era, HuddleRule "drep" era) => + Proxy era -> + Named Group +delegationToDrepCertGroup p = + "delegation_to_drep_cert" + =:~ grp [9, a (huddleRule @"stake_credential" p), a (huddleRule @"drep" p)] + +delegationToStakePoolAndDrepCertGroup :: + forall era. + (HuddleRule "stake_credential" era, HuddleRule "pool_keyhash" era, HuddleRule "drep" era) => + Proxy era -> + Named Group +delegationToStakePoolAndDrepCertGroup p = + "delegation_to_stake_pool_and_drep_cert" + =:~ grp + [ 10 + , a (huddleRule @"stake_credential" p) + , a (huddleRule @"pool_keyhash" p) + , a (huddleRule @"drep" p) + ] + +accountRegistrationDelegationToStakePoolCertGroup :: + forall era. + (HuddleRule "stake_credential" era, HuddleRule "pool_keyhash" era, HuddleRule "coin" era) => + Proxy era -> + Named Group +accountRegistrationDelegationToStakePoolCertGroup p = + "account_registration_delegation_to_stake_pool_cert" + =:~ grp + [ 11 + , a (huddleRule @"stake_credential" p) + , a (huddleRule @"pool_keyhash" p) + , a (huddleRule @"coin" p) + ] + +accountRegistrationDelegationToDrepCertGroup :: + forall era. + (HuddleRule "stake_credential" era, HuddleRule "drep" era, HuddleRule "coin" era) => + Proxy era -> + Named Group +accountRegistrationDelegationToDrepCertGroup p = + "account_registration_delegation_to_drep_cert" + =:~ grp + [ 12 + , a (huddleRule @"stake_credential" p) + , a (huddleRule @"drep" p) + , a (huddleRule @"coin" p) + ] + +accountRegistrationDelegationToStakePoolAndDrepCertGroup :: + forall era. + ( HuddleRule "stake_credential" era + , HuddleRule "pool_keyhash" era + , HuddleRule "drep" era + , HuddleRule "coin" era + ) => + Proxy era -> + Named Group +accountRegistrationDelegationToStakePoolAndDrepCertGroup p = + "account_registration_delegation_to_stake_pool_and_drep_cert" + =:~ grp + [ 13 + , a (huddleRule @"stake_credential" p) + , a (huddleRule @"pool_keyhash" p) + , a (huddleRule @"drep" p) + , a (huddleRule @"coin" p) + ] + +committeeAuthorizationCertGroup :: + forall era. + ( HuddleRule "committee_cold_credential" era + , HuddleRule "committee_hot_credential" era + ) => + Proxy era -> + Named Group +committeeAuthorizationCertGroup p = + "committee_authorization_cert" + =:~ grp + [ 14 + , a (huddleRule @"committee_cold_credential" p) + , a (huddleRule @"committee_hot_credential" p) + ] + +committeeResignationCertGroup :: + forall era. + (HuddleRule "committee_cold_credential" era, HuddleRule "anchor" era) => + Proxy era -> + Named Group +committeeResignationCertGroup p = + "committee_resignation_cert" + =:~ grp [15, a (huddleRule @"committee_cold_credential" p), a (huddleRule @"anchor" p / VNil)] + +drepRegistrationCertGroup :: + forall era. + (HuddleRule "drep_credential" era, HuddleRule "coin" era, HuddleRule "anchor" era) => + Proxy era -> + Named Group +drepRegistrationCertGroup p = + "drep_registration_cert" + =:~ grp + [ 16 + , a (huddleRule @"drep_credential" p) + , a (huddleRule @"coin" p) + , a (huddleRule @"anchor" p / VNil) + ] + +drepUnregistrationCertGroup :: + forall era. + (HuddleRule "drep_credential" era, HuddleRule "coin" era) => + Proxy era -> + Named Group +drepUnregistrationCertGroup p = + "drep_unregistration_cert" + =:~ grp [17, a (huddleRule @"drep_credential" p), a (huddleRule @"coin" p)] + +drepUpdateCertGroup :: + forall era. + (HuddleRule "drep_credential" era, HuddleRule "anchor" era) => + Proxy era -> + Named Group +drepUpdateCertGroup p = + "drep_update_cert" + =:~ grp [18, a (huddleRule @"drep_credential" p), a (huddleRule @"anchor" p / VNil)] + +votingProcedureRule :: + forall era. + (HuddleRule "vote" era, HuddleRule "anchor" era) => + Proxy era -> + Rule +votingProcedureRule p = + "voting_procedure" + =:= arr [a (huddleRule @"vote" p), a (huddleRule @"anchor" p / VNil)] + +votingProceduresRule :: + forall era. + ( HuddleRule "voter" era + , HuddleRule "gov_action_id" era + , HuddleRule "voting_procedure" era + ) => + Proxy era -> + Rule +votingProceduresRule p = + "voting_procedures" + =:= mp + [ 1 + <+ asKey (huddleRule @"voter" p) + ==> mp [1 <+ asKey (huddleRule @"gov_action_id" p) ==> huddleRule @"voting_procedure" p] + ] + +constitutionRule :: + forall era. + (HuddleRule "anchor" era, HuddleRule "script_hash" era) => + Proxy era -> + Rule +constitutionRule p = + "constitution" + =:= arr + [ a (huddleRule @"anchor" p) + , a (huddleRule @"script_hash" p / VNil) + ] + +parameterChangeActionGroup :: + forall era. + ( HuddleRule "gov_action_id" era + , HuddleRule "protocol_param_update" era + , HuddleRule "policy_hash" era + ) => + Proxy era -> + Named Group +parameterChangeActionGroup p = + "parameter_change_action" + =:~ grp + [ 0 + , a $ huddleRule @"gov_action_id" p / VNil + , a $ huddleRule @"protocol_param_update" p + , a $ huddleRule @"policy_hash" p / VNil + ] + +hardForkInitiationActionGroup :: + forall era. + (HuddleRule "gov_action_id" era, HuddleRule "protocol_version" era) => + Proxy era -> + Named Group +hardForkInitiationActionGroup p = + "hard_fork_initiation_action" + =:~ grp [1, a $ huddleRule @"gov_action_id" p / VNil, a $ huddleRule @"protocol_version" p] + +treasuryWithdrawalsActionGroup :: + forall era. + (HuddleRule "reward_account" era, HuddleRule "coin" era, HuddleRule "policy_hash" era) => + Proxy era -> + Named Group +treasuryWithdrawalsActionGroup p = + "treasury_withdrawals_action" + =:~ grp + [ 2 + , a $ + mp + [ 0 + <+ asKey (huddleRule @"reward_account" p) + ==> huddleRule @"coin" p + ] + , a $ huddleRule @"policy_hash" p / VNil + ] + +noConfidenceGroup :: forall era. HuddleRule "gov_action_id" era => Proxy era -> Named Group +noConfidenceGroup p = + "no_confidence" + =:~ grp [3, a $ huddleRule @"gov_action_id" p / VNil] + +updateCommitteeGroup :: + forall era. + ( HuddleRule "gov_action_id" era + , HuddleRule "committee_cold_credential" era + , HuddleRule "epoch" era + , HuddleRule "unit_interval" era + ) => + Proxy era -> + Named Group +updateCommitteeGroup p = + "update_committee" + =:~ grp + [ 4 + , a $ huddleRule @"gov_action_id" p / VNil + , a $ maybeTaggedSet (huddleRule @"committee_cold_credential" p) + , a $ + mp + [ 0 + <+ asKey (huddleRule @"committee_cold_credential" p) + ==> huddleRule @"epoch" p + ] + , a $ huddleRule @"unit_interval" p + ] + +newConstitutionGroup :: + forall era. + (HuddleRule "gov_action_id" era, HuddleRule "constitution" era) => + Proxy era -> + Named Group +newConstitutionGroup p = + "new_constitution" + =:~ grp + [ 5 + , a $ huddleRule @"gov_action_id" p / VNil + , a $ huddleRule @"constitution" p + ] + +infoActionRule :: Rule +infoActionRule = "info_action" =:= int 6 + +govActionRule :: + forall era. + ( HuddleGroup "parameter_change_action" era + , HuddleGroup "hard_fork_initiation_action" era + , HuddleGroup "treasury_withdrawals_action" era + , HuddleGroup "no_confidence" era + , HuddleGroup "update_committee" era + , HuddleGroup "new_constitution" era + , HuddleRule "info_action" era + ) => + Proxy era -> + Rule +govActionRule p = + "gov_action" + =:= arr [a (huddleGroup @"parameter_change_action" p)] + / arr [a (huddleGroup @"hard_fork_initiation_action" p)] + / arr [a (huddleGroup @"treasury_withdrawals_action" p)] + / arr [a (huddleGroup @"no_confidence" p)] + / arr [a (huddleGroup @"update_committee" p)] + / arr [a (huddleGroup @"new_constitution" p)] + / arr [a (huddleRule @"info_action" p)] + +proposalProcedureRule :: + forall era. + ( HuddleRule "coin" era + , HuddleRule "reward_account" era + , HuddleRule "gov_action" era + , HuddleRule "anchor" era + ) => + Proxy era -> + Rule +proposalProcedureRule p = + "proposal_procedure" + =:= arr + [ "deposit" ==> huddleRule @"coin" p + , a (huddleRule @"reward_account" p) + , a (huddleRule @"gov_action" p) + , a (huddleRule @"anchor" p) + ] + +proposalProceduresRule :: + forall era. + HuddleRule "proposal_procedure" era => + Proxy era -> + Rule +proposalProceduresRule p = + "proposal_procedures" + =:= maybeTaggedNonemptyOset (huddleRule @"proposal_procedure" p) + +poolVotingThresholdsRule :: forall era. HuddleRule "unit_interval" era => Proxy era -> Rule +poolVotingThresholdsRule p = + "pool_voting_thresholds" + =:= arr + [ a (huddleRule @"unit_interval" p) //- "motion no confidence" + , a (huddleRule @"unit_interval" p) //- "committee normal" + , a (huddleRule @"unit_interval" p) //- "committee no confidence" + , a (huddleRule @"unit_interval" p) //- "hard fork initiation" + , a (huddleRule @"unit_interval" p) //- "security relevant parameter voting threshold" + ] + +drepVotingThresholdsRule :: forall era. HuddleRule "unit_interval" era => Proxy era -> Rule +drepVotingThresholdsRule p = + "drep_voting_thresholds" + =:= arr + [ a (huddleRule @"unit_interval" p) //- "motion no confidence" + , a (huddleRule @"unit_interval" p) //- "committee normal" + , a (huddleRule @"unit_interval" p) //- "committee no confidence" + , a (huddleRule @"unit_interval" p) //- "update constitution" + , a (huddleRule @"unit_interval" p) //- "hard fork initiation" + , a (huddleRule @"unit_interval" p) //- "PP network group" + , a (huddleRule @"unit_interval" p) //- "PP economic group" + , a (huddleRule @"unit_interval" p) //- "PP technical group" + , a (huddleRule @"unit_interval" p) //- "PP governance group" + , a (huddleRule @"unit_interval" p) //- "treasury withdrawal" + ] + +conwayMultiasset :: + forall era a. + (HuddleRule "policy_id" era, HuddleRule "asset_name" era, IsType0 a) => + Proxy era -> + a -> + GRuleCall +conwayMultiasset p = + binding $ \x -> + "multiasset" + =:= mp + [ 0 + <+ asKey (huddleRule @"policy_id" p) + ==> mp [1 <+ asKey (huddleRule @"asset_name" p) ==> x] + ] + +conwayValueRule :: + forall era. + ( HuddleRule "policy_id" era + , HuddleRule "asset_name" era + , HuddleRule "positive_coin" era + ) => + Proxy era -> + Rule +conwayValueRule p = + "value" + =:= huddleRule @"coin" p + / sarr [a $ huddleRule @"coin" p, a $ conwayMultiasset p (huddleRule @"positive_coin" p)] + +conwayMintRule :: + forall era. + ( HuddleRule "policy_id" era + , HuddleRule "asset_name" era + , HuddleRule "nonzero_int64" era + ) => + Proxy era -> + Rule +conwayMintRule p = + "mint" + =:= mp + [ 1 + <+ asKey (huddleRule @"policy_id" p) + ==> mp [1 <+ asKey (huddleRule @"asset_name" p) ==> huddleRule @"nonzero_int64" p] + ] + +conwayWithdrawalsRule :: forall era. Era era => Proxy era -> Rule +conwayWithdrawalsRule p = + "withdrawals" + =:= mp + [ 1 + <+ asKey (huddleRule @"reward_account" p) + ==> huddleRule @"coin" p + ] + +conwayRedeemerTag :: Rule +conwayRedeemerTag = + comment + [str|0: spend + |1: mint + |2: cert + |3: reward + |4: voting + |5: proposing + |] + $ "redeemer_tag" + =:= (0 :: Integer) + ... (5 :: Integer) + +conwayRedeemer :: + forall era. + ( HuddleRule "redeemer_tag" era + , HuddleRule "plutus_data" era + , HuddleRule "ex_units" era + ) => + Proxy era -> + Rule +conwayRedeemer p = + "redeemer" + =:= arr + [ "tag" ==> huddleRule @"redeemer_tag" p + , "index" ==> (VUInt `sized` (4 :: Word64)) + , "data" ==> huddleRule @"plutus_data" p + , "ex_units" ==> huddleRule @"ex_units" p + ] + +instance HuddleRule "min_int64" ConwayEra where + huddleRule _ = minInt64Rule + +instance HuddleRule "max_int64" ConwayEra where + huddleRule _ = maxInt64Rule + +instance HuddleRule "int64" ConwayEra where + huddleRule = int64Rule @ConwayEra + +instance HuddleRule "bounded_bytes" ConwayEra where + huddleRule _ = boundedBytesRule + +instance HuddleRule "distinct_bytes" ConwayEra where + huddleRule _ = distinctBytesRule + +instance HuddleRule "big_uint" ConwayEra where + huddleRule = bigUintRule + +instance HuddleRule "big_nint" ConwayEra where + huddleRule = bigNintRule + +instance HuddleRule "big_int" ConwayEra where + huddleRule = bigIntRule + +instance HuddleRule "network_id" ConwayEra where + huddleRule _ = networkIdRule + +instance HuddleRule "dns_name" ConwayEra where + huddleRule _ = "dns_name" =:= VText `sized` (0 :: Word64, 128 :: Word64) + +instance HuddleRule "url" ConwayEra where + huddleRule _ = "url" =:= VText `sized` (0 :: Word64, 128 :: Word64) + +instance HuddleRule "major_protocol_version" ConwayEra where + huddleRule = majorProtocolVersionRule @ConwayEra + +instance HuddleRule "genesis_hash" ConwayEra where + huddleRule = genesisHashRule @ConwayEra + +instance HuddleRule "genesis_delegate_hash" ConwayEra where + huddleRule = genesisDelegateHashRule @ConwayEra + +instance HuddleRule "transaction_id" ConwayEra where + huddleRule = transactionIdRule @ConwayEra + +instance HuddleRule "vkeywitness" ConwayEra where + huddleRule = vkeywitnessRule @ConwayEra + +instance HuddleRule "bootstrap_witness" ConwayEra where + huddleRule = bootstrapWitnessRule @ConwayEra + +instance HuddleRule "ex_units" ConwayEra where + huddleRule _ = exUnitsRule + +instance HuddleRule "positive_interval" ConwayEra where + huddleRule = positiveIntervalRule + +instance HuddleRule "vote" ConwayEra where + huddleRule _ = "vote" =:= (0 :: Integer) ... (2 :: Integer) + +instance HuddleRule "asset_name" ConwayEra where + huddleRule _ = "asset_name" =:= VBytes `sized` (0 :: Word64, 32 :: Word64) + +instance HuddleRule "plutus_data" ConwayEra where + huddleRule = plutusDataRule + +instance HuddleRule "drep_credential" ConwayEra where + huddleRule p = "drep_credential" =:= huddleRule @"credential" p + +instance HuddleRule "committee_cold_credential" ConwayEra where + huddleRule p = "committee_cold_credential" =:= huddleRule @"credential" p + +instance HuddleRule "committee_hot_credential" ConwayEra where + huddleRule p = "committee_hot_credential" =:= huddleRule @"credential" p + +instance HuddleRule "anchor" ConwayEra where + huddleRule = anchorRule @ConwayEra + +instance HuddleRule "drep" ConwayEra where + huddleRule = drepRule @ConwayEra + +instance HuddleRule "voter" ConwayEra where + huddleRule = voterRule @ConwayEra + +instance HuddleRule "gov_action_id" ConwayEra where + huddleRule = govActionIdRule @ConwayEra + +instance HuddleRule "operational_cert" ConwayEra where + huddleRule = babbageOperationalCertRule @ConwayEra + +instance HuddleRule "protocol_version" ConwayEra where + huddleRule = babbageProtocolVersionRule @ConwayEra + +instance HuddleRule "plutus_v1_script" ConwayEra where + huddleRule = plutusV1ScriptRule + +instance HuddleRule "plutus_v2_script" ConwayEra where + huddleRule p = + comment + [str|Babbage introduces Plutus V2 with improved cost model + |and additional builtins. + |] + $ "plutus_v2_script" =:= huddleRule @"distinct_bytes" p + +instance HuddleRule "plutus_v3_script" ConwayEra where + huddleRule p = + comment + [str|Conway introduces Plutus V3 with support for new governance features. + | + |Note: distinct VBytes ensures uniqueness in test generation. + |The cddl tool we use for roundtrip testing doesn't generate + |distinct collections, so we use sized variants to ensure uniqueness. + |] + $ "plutus_v3_script" =:= huddleRule @"distinct_bytes" p + +instance HuddleRule "negative_int64" ConwayEra where + huddleRule = negativeInt64Rule @ConwayEra + +instance HuddleRule "positive_int64" ConwayEra where + huddleRule = positiveInt64Rule @ConwayEra + +instance HuddleRule "nonzero_int64" ConwayEra where + huddleRule = nonzeroInt64Rule @ConwayEra + +instance HuddleRule "policy_id" ConwayEra where + huddleRule p = "policy_id" =:= huddleRule @"script_hash" p + +instance HuddleRule "policy_hash" ConwayEra where + huddleRule p = "policy_hash" =:= huddleRule @"script_hash" p + +instance HuddleGroup "script_pubkey" ConwayEra where + huddleGroup = scriptPubkeyGroup @ConwayEra + +instance HuddleGroup "script_all" ConwayEra where + huddleGroup = scriptAllGroup @ConwayEra + +instance HuddleGroup "script_any" ConwayEra where + huddleGroup = scriptAnyGroup @ConwayEra + +instance HuddleGroup "script_n_of_k" ConwayEra where + huddleGroup = scriptNOfKGroup @ConwayEra + +instance HuddleGroup "script_invalid_before" ConwayEra where + huddleGroup = scriptInvalidBeforeGroup @ConwayEra + +instance HuddleGroup "script_invalid_hereafter" ConwayEra where + huddleGroup = scriptInvalidHereafterGroup @ConwayEra + +instance HuddleRule "native_script" ConwayEra where + huddleRule = nativeScriptRule @ConwayEra + +instance HuddleGroup "single_host_addr" ConwayEra where + huddleGroup = singleHostAddrGroup @ConwayEra + +instance HuddleGroup "single_host_name" ConwayEra where + huddleGroup = singleHostNameGroup @ConwayEra + +instance HuddleGroup "multi_host_name" ConwayEra where + huddleGroup = multiHostNameGroup @ConwayEra + +instance HuddleRule "relay" ConwayEra where + huddleRule = relayRule @ConwayEra + +instance HuddleRule "pool_metadata" ConwayEra where + huddleRule = poolMetadataRule @ConwayEra + +instance HuddleGroup "pool_params" ConwayEra where + huddleGroup = poolParamsGroup @ConwayEra + +instance HuddleGroup "account_registration_cert" ConwayEra where + huddleGroup = accountRegistrationCertGroup @ConwayEra + +instance HuddleGroup "account_unregistration_cert" ConwayEra where + huddleGroup = accountUnregistrationCertGroup @ConwayEra + +instance HuddleGroup "delegation_to_stake_pool_cert" ConwayEra where + huddleGroup = delegationToStakePoolCertGroup @ConwayEra + +instance HuddleGroup "pool_registration_cert" ConwayEra where + huddleGroup = poolRegistrationCertGroup @ConwayEra + +instance HuddleGroup "pool_retirement_cert" ConwayEra where + huddleGroup = poolRetirementCertGroup @ConwayEra + +instance HuddleGroup "account_registration_deposit_cert" ConwayEra where + huddleGroup = accountRegistrationDepositCertGroup @ConwayEra + +instance HuddleGroup "account_unregistration_deposit_cert" ConwayEra where + huddleGroup = accountUnregistrationDepositCertGroup @ConwayEra + +instance HuddleGroup "delegation_to_drep_cert" ConwayEra where + huddleGroup = delegationToDrepCertGroup @ConwayEra + +instance HuddleGroup "delegation_to_stake_pool_and_drep_cert" ConwayEra where + huddleGroup = delegationToStakePoolAndDrepCertGroup @ConwayEra + +instance HuddleGroup "account_registration_delegation_to_stake_pool_cert" ConwayEra where + huddleGroup = accountRegistrationDelegationToStakePoolCertGroup @ConwayEra + +instance HuddleGroup "account_registration_delegation_to_drep_cert" ConwayEra where + huddleGroup = accountRegistrationDelegationToDrepCertGroup @ConwayEra + +instance HuddleGroup "account_registration_delegation_to_stake_pool_and_drep_cert" ConwayEra where + huddleGroup = accountRegistrationDelegationToStakePoolAndDrepCertGroup @ConwayEra + +instance HuddleGroup "committee_authorization_cert" ConwayEra where + huddleGroup = committeeAuthorizationCertGroup @ConwayEra + +instance HuddleGroup "committee_resignation_cert" ConwayEra where + huddleGroup = committeeResignationCertGroup @ConwayEra + +instance HuddleGroup "drep_registration_cert" ConwayEra where + huddleGroup = drepRegistrationCertGroup @ConwayEra + +instance HuddleGroup "drep_unregistration_cert" ConwayEra where + huddleGroup = drepUnregistrationCertGroup @ConwayEra + +instance HuddleGroup "drep_update_cert" ConwayEra where + huddleGroup = drepUpdateCertGroup @ConwayEra + +instance HuddleRule "certificate" ConwayEra where + huddleRule p = + "certificate" + =:= arr [a $ huddleGroup @"account_registration_cert" p] + / arr [a $ huddleGroup @"account_unregistration_cert" p] + / arr [a $ huddleGroup @"delegation_to_stake_pool_cert" p] + / arr [a $ huddleGroup @"pool_registration_cert" p] + / arr [a $ huddleGroup @"pool_retirement_cert" p] + / arr [a $ huddleGroup @"account_registration_deposit_cert" p] + / arr [a $ huddleGroup @"account_unregistration_deposit_cert" p] + / arr [a $ huddleGroup @"delegation_to_drep_cert" p] + / arr [a $ huddleGroup @"delegation_to_stake_pool_and_drep_cert" p] + / arr [a $ huddleGroup @"account_registration_delegation_to_stake_pool_cert" p] + / arr [a $ huddleGroup @"account_registration_delegation_to_drep_cert" p] + / arr [a $ huddleGroup @"account_registration_delegation_to_stake_pool_and_drep_cert" p] + / arr [a $ huddleGroup @"committee_authorization_cert" p] + / arr [a $ huddleGroup @"committee_resignation_cert" p] + / arr [a $ huddleGroup @"drep_registration_cert" p] + / arr [a $ huddleGroup @"drep_unregistration_cert" p] + / arr [a $ huddleGroup @"drep_update_cert" p] + +instance HuddleRule "certificates" ConwayEra where + huddleRule p = + "certificates" + =:= maybeTaggedNonemptyOset (huddleRule @"certificate" p) + +instance HuddleRule "voting_procedure" ConwayEra where + huddleRule = votingProcedureRule @ConwayEra + +instance HuddleRule "voting_procedures" ConwayEra where + huddleRule = votingProceduresRule @ConwayEra + +instance HuddleRule "constitution" ConwayEra where + huddleRule = constitutionRule @ConwayEra + +instance HuddleGroup "parameter_change_action" ConwayEra where + huddleGroup = parameterChangeActionGroup @ConwayEra + +instance HuddleGroup "hard_fork_initiation_action" ConwayEra where + huddleGroup = hardForkInitiationActionGroup @ConwayEra + +instance HuddleGroup "treasury_withdrawals_action" ConwayEra where + huddleGroup = treasuryWithdrawalsActionGroup @ConwayEra + +instance HuddleGroup "no_confidence" ConwayEra where + huddleGroup = noConfidenceGroup @ConwayEra + +instance HuddleGroup "update_committee" ConwayEra where + huddleGroup = updateCommitteeGroup @ConwayEra + +instance HuddleGroup "new_constitution" ConwayEra where + huddleGroup = newConstitutionGroup @ConwayEra + +instance HuddleRule "info_action" ConwayEra where + huddleRule _ = infoActionRule + +instance HuddleRule "gov_action" ConwayEra where + huddleRule = govActionRule @ConwayEra + +instance HuddleRule "proposal_procedure" ConwayEra where + huddleRule = proposalProcedureRule @ConwayEra + +instance HuddleRule "proposal_procedures" ConwayEra where + huddleRule = proposalProceduresRule @ConwayEra + +instance HuddleRule "transaction_input" ConwayEra where + huddleRule p = + "transaction_input" + =:= arr + [ "transaction_id" ==> huddleRule @"transaction_id" p + , "index" ==> (VUInt `sized` (2 :: Word64)) + ] + +instance HuddleRule "required_signers" ConwayEra where + huddleRule p = + "required_signers" + =:= maybeTaggedNonemptySet (huddleRule @"addr_keyhash" p) + +instance HuddleRule "value" ConwayEra where + huddleRule = conwayValueRule @ConwayEra + +instance HuddleRule "mint" ConwayEra where + huddleRule = conwayMintRule @ConwayEra + +instance HuddleRule "withdrawals" ConwayEra where + huddleRule = conwayWithdrawalsRule @ConwayEra + +instance HuddleRule "data" ConwayEra where + huddleRule p = + "data" =:= tag 24 (VBytes `cbor` huddleRule @"plutus_data" p) + +instance HuddleRule "datum_option" ConwayEra where + huddleRule p = + "datum_option" + =:= arr [0, a (huddleRule @"hash32" p)] + / arr [1, a (huddleRule @"data" p)] + +instance HuddleRule "alonzo_transaction_output" ConwayEra where + huddleRule p = "alonzo_transaction_output" =:= alonzoTransactionOutputRule @ConwayEra p + +instance HuddleRule "transaction_output" ConwayEra where + huddleRule p = + comment + [str|Both of the Alonzo and Babbage style TxOut formats are equally valid + |and can be used interchangeably + |] + $ "transaction_output" + =:= huddleRule @"alonzo_transaction_output" p + / babbageTransactionOutput p (huddleRule @"script" p) + +instance HuddleRule "script" ConwayEra where + huddleRule p = + comment + [str|Conway supports four script types: + | 0: Native scripts (timelock) - unchanged from Allegra + | 1: Plutus V1 scripts + | 2: Plutus V2 scripts + | 3: Plutus V3 scripts + |] + $ "script" + =:= arr [0, a (huddleRule @"native_script" p)] + / arr [1, a (huddleRule @"plutus_v1_script" p)] + / arr [2, a (huddleRule @"plutus_v2_script" p)] + / arr [3, a (huddleRule @"plutus_v3_script" p)] + +instance HuddleRule "language" ConwayEra where + huddleRule _ = + comment + [str|0: Plutus v1 + |1: Plutus v2 + |2: Plutus v3 + |] + $ "language" =:= (0 :: Integer) ... (2 :: Integer) + +instance HuddleRule "potential_languages" ConwayEra where + huddleRule _ = "potential_languages" =:= (0 :: Integer) ... (255 :: Integer) + +instance HuddleRule "cost_models" ConwayEra where + huddleRule p = + comment + [str|The format for cost_models is flexible enough to allow adding + |Plutus built-ins and language versions in the future. + | + |Plutus v1: only 166 integers are used, but more are accepted (and ignored) + |Plutus v2: only 175 integers are used, but more are accepted (and ignored) + |Plutus v3: only 223 integers are used, but more are accepted (and ignored) + | + |Any 8-bit unsigned number can be used as a key. + |] + $ "cost_models" + =:= mp + [ opt $ idx 0 ==> arr [0 <+ a (huddleRule @"int64" p)] + , opt $ idx 1 ==> arr [0 <+ a (huddleRule @"int64" p)] + , opt $ idx 2 ==> arr [0 <+ a (huddleRule @"int64" p)] + , 0 <+ asKey ((3 :: Integer) ... (255 :: Integer)) ==> arr [0 <+ a (huddleRule @"int64" p)] + ] + +instance HuddleRule "redeemer_tag" ConwayEra where + huddleRule _ = conwayRedeemerTag + +instance HuddleRule "redeemer" ConwayEra where + huddleRule = conwayRedeemer @ConwayEra + +instance HuddleRule "redeemers" ConwayEra where + huddleRule p = + comment + [str|Flat Array support is included for backwards compatibility and + |will be removed in the next era. It is recommended for tools to + |adopt using a Map instead of Array going forward. + |] + $ "redeemers" + =:= sarr [1 <+ a (huddleRule @"redeemer" p)] + / smp + [ 1 + <+ asKey + ( arr + [ "tag" ==> huddleRule @"redeemer_tag" p + , "index" ==> (VUInt `sized` (4 :: Word64)) + ] + ) + ==> arr + [ "data" ==> huddleRule @"plutus_data" p + , "ex_units" ==> huddleRule @"ex_units" p + ] + ] + +instance HuddleRule "script_data_hash" ConwayEra where + huddleRule p = + comment + [str|This is a hash of data which may affect evaluation of a script. + |This data consists of: + | - The redeemers from the transaction_witness_set (the value of field 5). + | - The datums from the transaction_witness_set (the value of field 4). + | - The value in the cost_models map corresponding to the script's language + | (in field 18 of protocol_param_update.) + |(In the future it may contain additional protocol parameters.) + | + |Since this data does not exist in contiguous form inside a transaction, it needs + |to be independently constructed by each recipient. + | + |The bytestring which is hashed is the concatenation of three things: + | redeemers || datums || language views + |The redeemers are exactly the data present in the transaction witness set. + |Similarly for the datums, if present. If no datums are provided, the middle + |field is omitted (i.e. it is the empty/null bytestring). + | + |language views CDDL: + |{ * language => script_integrity_data } + | + |This must be encoded canonically, using the same scheme as in + |RFC7049 section 3.9: + | - Maps, strings, and bytestrings must use a definite-length encoding + | - Integers must be as small as possible. + | - The expressions for map length, string length, and bytestring length + | must be as short as possible. + | - The keys in the map must be sorted as follows: + | - If two keys have different lengths, the shorter one sorts earlier. + | - If two keys have the same length, the one with the lower value + | in (byte-wise) lexical order sorts earlier. + | + |For PlutusV1 (language id 0), the language view is the following: + | - the value of cost_models map at key 0 (in other words, the script_integrity_data) + | is encoded as an indefinite length list and the result is encoded as a bytestring. + | (our apologies) + | For example, the script_integrity_data corresponding to the all zero costmodel for V1 + | would be encoded as (in hex): + | 58a89f00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ff + | - the language ID tag is also encoded twice. first as a uint then as + | a bytestring. (our apologies) + | Concretely, this means that the language version for V1 is encoded as + | 4100 in hex. + |For PlutusV2 (language id 1), the language view is the following: + | - the value of cost_models map at key 1 is encoded as an definite length list. + | For example, the script_integrity_data corresponding to the all zero costmodel for V2 + | would be encoded as (in hex): + | 98af0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 + | - the language ID tag is encoded as expected. + | Concretely, this means that the language version for V2 is encoded as + | 01 in hex. + |For PlutusV3 (language id 2), the language view is the following: + | - the value of cost_models map at key 2 is encoded as a definite length list. + | + |Note that each Plutus language represented inside a transaction must have + |a cost model in the cost_models protocol parameter in order to execute, + |regardless of what the script integrity data is. + | + |Finally, note that in the case that a transaction includes datums but does not + |include the redeemers field, the script data format becomes (in hex): + |[ A0 | datums | A0 ] + |corresponding to a CBOR empty map and an empty map for language view. + |This empty redeeemer case has changed from the previous eras, since default + |representation for redeemers has been changed to a map. Also whenever redeemers are + |supplied either as a map or as an array they must contain at least one element, + |therefore there is no way to override this behavior by providing a custom + |representation for empty redeemers. + |] + $ scriptDataHashRule p + +instance HuddleRule "transaction_body" ConwayEra where + huddleRule p = + "transaction_body" + =:= mp + [ idx 0 ==> maybeTaggedSet (huddleRule @"transaction_input" p) + , idx 1 ==> arr [0 <+ a (huddleRule @"transaction_output" p)] + , idx 2 ==> huddleRule @"coin" p //- "fee" + , opt (idx 3 ==> huddleRule @"slot" p) //- "time to live" + , opt (idx 4 ==> huddleRule @"certificates" p) + , opt (idx 5 ==> huddleRule @"withdrawals" p) + , opt (idx 7 ==> huddleRule @"auxiliary_data_hash" p) + , opt (idx 8 ==> huddleRule @"slot" p) //- "validity interval start" + , opt (idx 9 ==> huddleRule @"mint" p) + , opt (idx 11 ==> huddleRule @"script_data_hash" p) + , opt (idx 13 ==> maybeTaggedNonemptySet (huddleRule @"transaction_input" p)) //- "collateral" + , opt (idx 14 ==> huddleRule @"required_signers" p) + , opt (idx 15 ==> huddleRule @"network_id" p) + , opt (idx 16 ==> huddleRule @"transaction_output" p) //- "collateral return" + , opt (idx 17 ==> huddleRule @"coin" p) //- "total collateral" + , opt (idx 18 ==> maybeTaggedNonemptySet (huddleRule @"transaction_input" p)) //- "reference inputs" + , opt (idx 19 ==> huddleRule @"voting_procedures" p) + , opt (idx 20 ==> huddleRule @"proposal_procedures" p) + , opt (idx 21 ==> huddleRule @"coin" p) //- "current treasury value" + , opt (idx 22 ==> huddleRule @"positive_coin" p) //- "donation" + ] + +instance HuddleRule "transaction_witness_set" ConwayEra where + huddleRule p = + "transaction_witness_set" + =:= mp + [ opt $ idx 0 ==> maybeTaggedNonemptySet (huddleRule @"vkeywitness" p) + , opt $ idx 1 ==> maybeTaggedNonemptySet (huddleRule @"native_script" p) + , opt $ idx 2 ==> maybeTaggedNonemptySet (huddleRule @"bootstrap_witness" p) + , opt $ idx 3 ==> maybeTaggedNonemptySet (huddleRule @"plutus_v1_script" p) + , opt $ idx 4 ==> maybeTaggedNonemptySet (huddleRule @"plutus_data" p) + , opt $ idx 5 ==> huddleRule @"redeemers" p + , opt $ idx 6 ==> maybeTaggedNonemptySet (huddleRule @"plutus_v2_script" p) + , opt $ idx 7 ==> maybeTaggedNonemptySet (huddleRule @"plutus_v3_script" p) + ] + +instance HuddleRule "transaction" ConwayEra where + huddleRule p = + "transaction" + =:= arr + [ a $ huddleRule @"transaction_body" p + , a $ huddleRule @"transaction_witness_set" p + , a VBool + , a (huddleRule @"auxiliary_data" p / VNil) + ] + +instance HuddleRule "ex_unit_prices" ConwayEra where + huddleRule p = + "ex_unit_prices" + =:= arr + [ "mem_price" ==> huddleRule @"nonnegative_interval" p + , "step_price" ==> huddleRule @"nonnegative_interval" p + ] + +instance HuddleRule "pool_voting_thresholds" ConwayEra where + huddleRule = poolVotingThresholdsRule @ConwayEra + +instance HuddleRule "drep_voting_thresholds" ConwayEra where + huddleRule = drepVotingThresholdsRule @ConwayEra + +instance HuddleRule "protocol_param_update" ConwayEra where + huddleRule p = + "protocol_param_update" + =:= mp + [ opt (idx 0 ==> huddleRule @"coin" p) //- "minfeeA" + , opt (idx 1 ==> huddleRule @"coin" p) //- "minfeeB" + , opt (idx 2 ==> (VUInt `sized` (4 :: Word64))) //- "max block body size" + , opt (idx 3 ==> (VUInt `sized` (4 :: Word64))) //- "max transaction size" + , opt (idx 4 ==> (VUInt `sized` (2 :: Word64))) //- "max block header size" + , opt (idx 5 ==> huddleRule @"coin" p) //- "key deposit" + , opt (idx 6 ==> huddleRule @"coin" p) //- "pool deposit" + , opt (idx 7 ==> huddleRule @"epoch_interval" p) //- "maximum epoch" + , opt (idx 8 ==> VUInt `sized` (2 :: Word64)) //- "n_opt: desired number of stake pools" + , opt (idx 9 ==> huddleRule @"nonnegative_interval" p) //- "pool pledge influence" + , opt (idx 10 ==> huddleRule @"unit_interval" p) //- "expansion rate" + , opt (idx 11 ==> huddleRule @"unit_interval" p) //- "treasury growth rate" + , opt (idx 16 ==> huddleRule @"coin" p) //- "min pool cost" + , opt (idx 17 ==> huddleRule @"coin" p) //- "ada per utxo byte" + , opt (idx 18 ==> huddleRule @"cost_models" p) //- "cost models for script languages" + , opt (idx 19 ==> huddleRule @"ex_unit_prices" p) //- "execution costs" + , opt (idx 20 ==> huddleRule @"ex_units" p) //- "max tx ex units" + , opt (idx 21 ==> huddleRule @"ex_units" p) //- "max block ex units" + , opt (idx 22 ==> (VUInt `sized` (4 :: Word64))) //- "max value size" + , opt (idx 23 ==> (VUInt `sized` (2 :: Word64))) //- "collateral percentage" + , opt (idx 24 ==> (VUInt `sized` (2 :: Word64))) //- "max collateral inputs" + , opt (idx 25 ==> huddleRule @"pool_voting_thresholds" p) //- "pool voting thresholds" + , opt (idx 26 ==> huddleRule @"drep_voting_thresholds" p) //- "drep voting thresholds" + , opt (idx 27 ==> (VUInt `sized` (2 :: Word64))) //- "min committee size" + , opt (idx 28 ==> huddleRule @"epoch_interval" p) //- "committee term limit" + , opt (idx 29 ==> huddleRule @"epoch_interval" p) //- "goveranance action validity period" + , opt (idx 30 ==> huddleRule @"coin" p) //- "governance action deposit" + , opt (idx 31 ==> huddleRule @"coin" p) //- "drep deposit" + , opt (idx 32 ==> huddleRule @"epoch_interval" p) //- "drep inactivity period" + , opt (idx 33 ==> huddleRule @"nonnegative_interval" p) //- "minfee refscriptcoinsperbyte" + ] + +instance HuddleRule "proposed_protocol_parameter_updates" ConwayEra where + huddleRule = proposedProtocolParameterUpdatesRule @ConwayEra + +instance HuddleRule "update" ConwayEra where + huddleRule = updateRule @ConwayEra + +instance HuddleRule "header_body" ConwayEra where + huddleRule p = + "header_body" + =:= arr + [ "block_number" ==> huddleRule @"block_number" p + , "slot" ==> huddleRule @"slot" p + , "prev_hash" ==> (huddleRule @"hash32" p / VNil) + , "issuer_vkey" ==> huddleRule @"vkey" p + , "vrf_vkey" ==> huddleRule @"vrf_vkey" p + , "vrf_result" ==> huddleRule @"vrf_cert" p + , "block_body_size" ==> (VUInt `sized` (4 :: Word64)) + , "block_body_hash" ==> huddleRule @"hash32" p //- "merkle triple root" + , a $ huddleRule @"operational_cert" p + , a $ huddleRule @"protocol_version" p + ] + +instance HuddleRule "header" ConwayEra where + huddleRule = headerRule @ConwayEra + +instance HuddleRule "block" ConwayEra where + huddleRule p = + comment + [str|Valid blocks must also satisfy the following two constraints: + | 1) the length of transaction_bodies and transaction_witness_sets must be + | the same + | 2) every transaction_index must be strictly smaller than the length of + | transaction_bodies + |] + $ "block" + =:= arr + [ a $ huddleRule @"header" p + , "transaction_bodies" ==> arr [0 <+ a (huddleRule @"transaction_body" p)] + , "transaction_witness_sets" ==> arr [0 <+ a (huddleRule @"transaction_witness_set" p)] + , "auxiliary_data_set" + ==> mp + [ 0 + <+ asKey (huddleRule @"transaction_index" p) + ==> huddleRule @"auxiliary_data" p + ] + , "invalid_transactions" ==> arr [0 <+ a (huddleRule @"transaction_index" p)] + ] + +instance HuddleRule "auxiliary_scripts" ConwayEra where + huddleRule = auxiliaryScriptsRule @ConwayEra + +instance HuddleRule "auxiliary_data_map" ConwayEra where + huddleRule p = + "auxiliary_data_map" + =:= tag + 259 + ( mp + [ opt (idx 0 ==> huddleRule @"metadata" p) + , opt (idx 1 ==> arr [0 <+ a (huddleRule @"native_script" p)]) + , opt (idx 2 ==> arr [0 <+ a (huddleRule @"plutus_v1_script" p)]) + , opt (idx 3 ==> arr [0 <+ a (huddleRule @"plutus_v2_script" p)]) + , opt (idx 4 ==> arr [0 <+ a (huddleRule @"plutus_v3_script" p)]) + ] + ) + +instance HuddleRule "auxiliary_data_array" ConwayEra where + huddleRule = auxiliaryDataArrayRule @ConwayEra + +instance HuddleRule "auxiliary_data" ConwayEra where + huddleRule p = + comment + [str|auxiliary_data supports three serialization formats: + | 1. metadata (raw) - Supported since Shelley + | 2. auxiliary_data_array - Array format, introduced in Allegra + | 3. auxiliary_data_map - Tagged map format, introduced in Alonzo + | Conway adds plutus_v3_script support at index 4 + |] + $ "auxiliary_data" + =:= huddleRule @"metadata" p + / huddleRule @"auxiliary_data_array" p + / huddleRule @"auxiliary_data_map" p + +mkMaybeTaggedSet :: IsType0 a => T.Text -> Word64 -> a -> GRuleCall +mkMaybeTaggedSet label n = binding $ \x -> label =:= tag 258 (arr [n <+ a x]) / sarr [n <+ a x] + +maybeTaggedSet :: IsType0 a => a -> GRuleCall +maybeTaggedSet = mkMaybeTaggedSet "set" 0 + +maybeTaggedNonemptySet :: IsType0 a => a -> GRuleCall +maybeTaggedNonemptySet = mkMaybeTaggedSet "nonempty_set" 1 + +maybeTaggedOset :: IsType0 a => a -> GRuleCall +maybeTaggedOset = mkMaybeTaggedSet "oset" 0 + +maybeTaggedNonemptyOset :: IsType0 a => a -> GRuleCall +maybeTaggedNonemptyOset = mkMaybeTaggedSet "nonempty_oset" 1 diff --git a/eras/mary/impl/CHANGELOG.md b/eras/mary/impl/CHANGELOG.md index 0d6a31ae037..307a37cf18d 100644 --- a/eras/mary/impl/CHANGELOG.md +++ b/eras/mary/impl/CHANGELOG.md @@ -12,6 +12,7 @@ ### `cddl` +* Rename 'multiasset' to `maryMultiasset` * Add full `HuddleSpec`. ### `testlib` diff --git a/eras/mary/impl/cddl-files/mary.cddl b/eras/mary/impl/cddl-files/mary.cddl index 1020910827a..0093bb7db1f 100644 --- a/eras/mary/impl/cddl-files/mary.cddl +++ b/eras/mary/impl/cddl-files/mary.cddl @@ -174,6 +174,7 @@ pool_keyhash = hash28 pool_registration_cert = (3, pool_params) +; Pool parameters for stake pool registration pool_params = ( operator : pool_keyhash , vrf_keyhash : vrf_keyhash @@ -308,8 +309,6 @@ transaction_witness_set = vkeywitness = [vkey, signature] ; Allegra introduces timelock support for native scripts. -; This is the 6-variant native script format used by -; Allegra, Mary, Alonzo, Babbage, and Conway. ; ; Timelock validity intervals are half-open intervals [a, b). ; script_invalid_before: specifies the left (included) endpoint a. diff --git a/eras/mary/impl/cddl/lib/Cardano/Ledger/Mary/HuddleSpec.hs b/eras/mary/impl/cddl/lib/Cardano/Ledger/Mary/HuddleSpec.hs index 9b04efb2d25..13add00c3ac 100644 --- a/eras/mary/impl/cddl/lib/Cardano/Ledger/Mary/HuddleSpec.hs +++ b/eras/mary/impl/cddl/lib/Cardano/Ledger/Mary/HuddleSpec.hs @@ -13,7 +13,9 @@ module Cardano.Ledger.Mary.HuddleSpec ( module Cardano.Ledger.Allegra.HuddleSpec, maryCDDL, - multiasset, + maryMultiasset, + maryValueRule, + maryMintRule, ) where import Cardano.Ledger.Allegra.HuddleSpec @@ -32,6 +34,35 @@ maryCDDL = , HIRule $ huddleRule @"asset_name" (Proxy @MaryEra) ] +maryMultiasset :: + forall era a. + (HuddleRule "policy_id" era, HuddleRule "asset_name" era, IsType0 a) => Proxy era -> a -> GRuleCall +maryMultiasset p = + binding $ \x -> + "multiasset" + =:= mp + [ 0 + <+ asKey (huddleRule @"policy_id" p) + ==> mp [1 <+ asKey (huddleRule @"asset_name" p) ==> x] + ] + +maryValueRule :: + forall era. + (HuddleRule "policy_id" era, HuddleRule "asset_name" era) => + Proxy era -> + Rule +maryValueRule p = + "value" + =:= huddleRule @"coin" p + / sarr [a $ huddleRule @"coin" p, a $ maryMultiasset p VUInt] + +maryMintRule :: + forall era. + (HuddleRule "policy_id" era, HuddleRule "asset_name" era, HuddleRule "int64" era) => + Proxy era -> + Rule +maryMintRule p = "mint" =:= maryMultiasset p (huddleRule @"int64" p) + instance HuddleRule "block" MaryEra where huddleRule = blockRule @MaryEra @@ -78,7 +109,7 @@ instance HuddleRule "transaction_witness_set" MaryEra where huddleRule = transactionWitnessSetRule @MaryEra instance HuddleRule "withdrawals" MaryEra where - huddleRule = withdrawalsRule @MaryEra + huddleRule = shelleyWithdrawalsRule @MaryEra instance HuddleRule "certificate" MaryEra where huddleRule = certificateRule @MaryEra @@ -194,23 +225,8 @@ instance HuddleRule "transaction_output" MaryEra where , "amount" ==> huddleRule @"value" p ] -multiasset :: - forall era a. - (HuddleRule "policy_id" era, HuddleRule "asset_name" era, IsType0 a) => Proxy era -> a -> GRuleCall -multiasset p = - binding $ \x -> - "multiasset" - =:= mp - [ 0 - <+ asKey (huddleRule @"policy_id" p) - ==> mp [1 <+ asKey (huddleRule @"asset_name" p) ==> x] - ] - instance HuddleRule "value" MaryEra where - huddleRule p = - "value" - =:= huddleRule @"coin" p - / sarr [a $ huddleRule @"coin" p, a $ multiasset p VUInt] + huddleRule = maryValueRule @MaryEra instance HuddleRule "policy_id" MaryEra where huddleRule p = "policy_id" =:= huddleRule @"script_hash" p @@ -219,7 +235,7 @@ instance HuddleRule "asset_name" MaryEra where huddleRule _ = "asset_name" =:= VBytes `sized` (0 :: Word64, 32 :: Word64) instance HuddleRule "mint" MaryEra where - huddleRule p = "mint" =:= multiasset p (huddleRule @"int64" p) + huddleRule = maryMintRule @MaryEra instance HuddleRule "auxiliary_data" MaryEra where huddleRule = auxiliaryDataRule @MaryEra diff --git a/eras/shelley/impl/cddl-files/shelley.cddl b/eras/shelley/impl/cddl-files/shelley.cddl index 03129935051..daf73b64b52 100644 --- a/eras/shelley/impl/cddl-files/shelley.cddl +++ b/eras/shelley/impl/cddl-files/shelley.cddl @@ -164,6 +164,7 @@ pool_keyhash = hash28 pool_registration_cert = (3, pool_params) +; Pool parameters for stake pool registration pool_params = ( operator : pool_keyhash , vrf_keyhash : vrf_keyhash diff --git a/eras/shelley/impl/cddl/lib/Cardano/Ledger/Shelley/HuddleSpec.hs b/eras/shelley/impl/cddl/lib/Cardano/Ledger/Shelley/HuddleSpec.hs index 07e0b7474d9..232f6e90953 100644 --- a/eras/shelley/impl/cddl/lib/Cardano/Ledger/Shelley/HuddleSpec.hs +++ b/eras/shelley/impl/cddl/lib/Cardano/Ledger/Shelley/HuddleSpec.hs @@ -31,7 +31,7 @@ module Cardano.Ledger.Shelley.HuddleSpec ( transactionIdRule, transactionInputRule, transactionOutputRule, - withdrawalsRule, + shelleyWithdrawalsRule, dnsNameRule, urlRule, poolMetadataRule, @@ -210,8 +210,8 @@ transactionOutputRule p = "transaction_output" =:= arr [a $ huddleRule @"address" p, "amount" ==> huddleRule @"coin" p] -withdrawalsRule :: forall era. Era era => Proxy era -> Rule -withdrawalsRule p = +shelleyWithdrawalsRule :: forall era. Era era => Proxy era -> Rule +shelleyWithdrawalsRule p = "withdrawals" =:= mp [0 <+ asKey (huddleRule @"reward_account" p) ==> huddleRule @"coin" p] @@ -456,7 +456,7 @@ instance HuddleRule "certificate" ShelleyEra where huddleRule = certificateRule @ShelleyEra instance HuddleRule "withdrawals" ShelleyEra where - huddleRule = withdrawalsRule @ShelleyEra + huddleRule = shelleyWithdrawalsRule @ShelleyEra instance HuddleRule "major_protocol_version" ShelleyEra where huddleRule = majorProtocolVersionRule @ShelleyEra diff --git a/hie.yaml b/hie.yaml index 23939101a5c..9c36afa987b 100644 --- a/hie.yaml +++ b/hie.yaml @@ -126,6 +126,15 @@ cradle: - path: "eras/conway/impl/src" component: "lib:cardano-ledger-conway" + - path: "eras/conway/impl/cddl/lib" + component: "cardano-ledger-conway:lib:cddl" + + - path: "eras/conway/impl/cddl/exe/Main.hs" + component: "cardano-ledger-conway:exe:generate-cddl" + + - path: "eras/conway/impl/cddl/exe/Paths_cardano_ledger_conway.hs" + component: "cardano-ledger-conway:exe:generate-cddl" + - path: "eras/conway/impl/testlib" component: "cardano-ledger-conway:lib:testlib"