diff --git a/eras/allegra/impl/CHANGELOG.md b/eras/allegra/impl/CHANGELOG.md index cbc44fb0fe2..586f3ef931b 100644 --- a/eras/allegra/impl/CHANGELOG.md +++ b/eras/allegra/impl/CHANGELOG.md @@ -2,7 +2,7 @@ ## 1.9.0.0 -* Add `cddl` sub-library. +* Add `cddl` sub-library, and `generate-cddl` executable. * Remove deprecated type `Allegra` * Remove deprecated type `TimelockConstr` * Add `invalidBeforeL`, `invalidHereAfterL` @@ -14,6 +14,11 @@ ### `cddl` +* Export for cross-era reuse: + - `auxiliaryScriptsRule`, `auxiliaryDataArrayRule`, `auxiliaryDataRule` + - `minInt64Rule`, `maxInt64Rule`, `int64Rule` + - `nativeScriptRule` + - `scriptNOfKGroup`, `scriptInvalidBeforeGroup`, `scriptInvalidHereafterGroup` * Add `HuddleSpec` module with `Huddle{Rule|Group}` instances for all types. * Add smart constructors `mkBlock` and `mkTransaction`. * Add `generate-cddl` executable target to test the generation of `.cddl` files against the existing `huddle-cddl` executable. 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 f0fecacbf5f..a4f0e2be0e7 100644 --- a/eras/allegra/impl/cddl/lib/Cardano/Ledger/Allegra/HuddleSpec.hs +++ b/eras/allegra/impl/cddl/lib/Cardano/Ledger/Allegra/HuddleSpec.hs @@ -11,9 +11,20 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Allegra.HuddleSpec ( + module Cardano.Ledger.Shelley.HuddleSpec, allegraCDDL, blockRule, transactionRule, + auxiliaryScriptsRule, + auxiliaryDataArrayRule, + auxiliaryDataRule, + minInt64Rule, + maxInt64Rule, + int64Rule, + nativeScriptRule, + scriptNOfKGroup, + scriptInvalidBeforeGroup, + scriptInvalidHereafterGroup, ) where import Cardano.Ledger.Allegra (AllegraEra) @@ -69,11 +80,102 @@ transactionRule p = , a (huddleRule @"auxiliary_data" p / VNil) ] +auxiliaryScriptsRule :: forall era. HuddleRule "native_script" era => Proxy era -> Rule +auxiliaryScriptsRule p = "auxiliary_scripts" =:= arr [0 <+ a (huddleRule @"native_script" p)] + +auxiliaryDataArrayRule :: + forall era. HuddleRule "auxiliary_scripts" era => Proxy era -> Rule +auxiliaryDataArrayRule p = + "auxiliary_data_array" + =:= arr + [ "transaction_metadata" ==> huddleRule @"metadata" p + , "auxiliary_scripts" ==> huddleRule @"auxiliary_scripts" p + ] + +auxiliaryDataRule :: + forall era. HuddleRule "auxiliary_data_array" era => Proxy era -> Rule +auxiliaryDataRule p = + "auxiliary_data" + =:= 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 + , HuddleGroup "script_all" era + , HuddleGroup "script_any" era + , HuddleGroup "script_n_of_k" era + , HuddleGroup "script_invalid_before" era + , HuddleGroup "script_invalid_hereafter" era + ) => + Proxy era -> + Rule +nativeScriptRule p = + comment + [str|Allegra introduces timelock support for native scripts. + | + |Timelock validity intervals are half-open intervals [a, b). + | script_invalid_before: specifies the left (included) endpoint a. + | script_invalid_hereafter: specifies the right (excluded) endpoint b. + | + |Note: Allegra switched to int64 for script_n_of_k thresholds. + |] + $ "native_script" + =:= arr [a $ huddleGroup @"script_pubkey" p] + / arr [a $ huddleGroup @"script_all" p] + / arr [a $ huddleGroup @"script_any" p] + / arr [a $ huddleGroup @"script_n_of_k" p] + / arr [a $ huddleGroup @"script_invalid_before" p] + / arr [a $ huddleGroup @"script_invalid_hereafter" p] + +scriptNOfKGroup :: + forall era. + (HuddleRule "int64" era, HuddleRule "native_script" era) => + Proxy era -> + Named Group +scriptNOfKGroup p = + "script_n_of_k" + =:~ grp + [ 3 + , "n" ==> huddleRule @"int64" p + , a $ arr [0 <+ a (huddleRule @"native_script" p)] + ] + +scriptInvalidBeforeGroup :: + forall era. Era era => Proxy era -> Named Group +scriptInvalidBeforeGroup p = + comment + [str|Timelock validity intervals are half-open intervals [a, b). + |This field specifies the left (included) endpoint a. + |] + $ "script_invalid_before" + =:~ grp [4, a (huddleRule @"slot" p)] + +scriptInvalidHereafterGroup :: + forall era. Era era => Proxy era -> Named Group +scriptInvalidHereafterGroup p = + comment + [str|Timelock validity intervals are half-open intervals [a, b). + |This field specifies the right (excluded) endpoint b. + |] + $ "script_invalid_hereafter" + =:~ grp [5, a (huddleRule @"slot" p)] + instance HuddleRule "major_protocol_version" AllegraEra where huddleRule = majorProtocolVersionRule @AllegraEra instance HuddleGroup "protocol_version" AllegraEra where - huddleGroup = protocolVersionGroup @AllegraEra + huddleGroup = shelleyProtocolVersionGroup @AllegraEra instance HuddleRule "protocol_param_update" AllegraEra where huddleRule = protocolParamUpdateRule @AllegraEra @@ -88,7 +190,7 @@ instance HuddleRule "genesis_hash" AllegraEra where huddleRule = genesisHashRule @AllegraEra instance HuddleGroup "operational_cert" AllegraEra where - huddleGroup = operationalCertGroup @AllegraEra + huddleGroup = shelleyOperationalCertGroup @AllegraEra instance HuddleRule "header_body" AllegraEra where huddleRule = headerBodyRule @AllegraEra @@ -97,65 +199,31 @@ instance HuddleRule "header" AllegraEra where huddleRule = headerRule @AllegraEra instance HuddleRule "min_int64" AllegraEra where - huddleRule _ = "min_int64" =:= (-9223372036854775808 :: Integer) + huddleRule _ = minInt64Rule instance HuddleRule "max_int64" AllegraEra where - huddleRule _ = "max_int64" =:= (9223372036854775807 :: Integer) + huddleRule _ = maxInt64Rule instance HuddleRule "int64" AllegraEra where - huddleRule p = "int64" =:= huddleRule @"min_int64" p ... huddleRule @"max_int64" p + huddleRule = int64Rule @AllegraEra instance HuddleGroup "script_all" AllegraEra where - huddleGroup p = "script_all" =:~ grp [1, a $ arr [0 <+ a (huddleRule @"native_script" p)]] + huddleGroup = scriptAllGroup @AllegraEra instance HuddleGroup "script_any" AllegraEra where - huddleGroup p = "script_any" =:~ grp [2, a $ arr [0 <+ a (huddleRule @"native_script" p)]] + huddleGroup = scriptAnyGroup @AllegraEra instance HuddleGroup "script_n_of_k" AllegraEra where - huddleGroup p = - "script_n_of_k" - =:~ grp - [ 3 - , "n" ==> huddleRule @"int64" p - , a $ arr [0 <+ a (huddleRule @"native_script" p)] - ] + huddleGroup = scriptNOfKGroup @AllegraEra instance HuddleGroup "script_invalid_before" AllegraEra where - huddleGroup p = - comment - [str|Timelock validity intervals are half-open intervals [a, b). - |This field specifies the left (included) endpoint a. - |] - $ "script_invalid_before" - =:~ grp [4, a (huddleRule @"slot" p)] + huddleGroup = scriptInvalidBeforeGroup @AllegraEra instance HuddleGroup "script_invalid_hereafter" AllegraEra where - huddleGroup p = - comment - [str|Timelock validity intervals are half-open intervals [a, b). - |This field specifies the right (excluded) endpoint b. - |] - $ "script_invalid_hereafter" - =:~ grp [5, a (huddleRule @"slot" p)] + huddleGroup = scriptInvalidHereafterGroup @AllegraEra instance HuddleRule "native_script" AllegraEra where - huddleRule p = - comment - [str|Allegra introduces timelock support for native scripts. - | - |Timelock validity intervals are half-open intervals [a, b). - | script_invalid_before: specifies the left (included) endpoint a. - | script_invalid_hereafter: specifies the right (excluded) endpoint b. - | - |Note: Allegra switched to int64 for script_n_of_k thresholds. - |] - $ "native_script" - =:= arr [a $ huddleGroup @"script_pubkey" p] - / arr [a $ huddleGroup @"script_all" p] - / arr [a $ huddleGroup @"script_any" p] - / arr [a $ huddleGroup @"script_n_of_k" p] - / arr [a $ huddleGroup @"script_invalid_before" p] - / arr [a $ huddleGroup @"script_invalid_hereafter" p] + huddleRule = nativeScriptRule @AllegraEra instance HuddleRule "vkeywitness" AllegraEra where huddleRule = vkeywitnessRule @AllegraEra @@ -239,21 +307,13 @@ instance HuddleRule "withdrawals" AllegraEra where huddleRule = withdrawalsRule @AllegraEra instance HuddleRule "auxiliary_scripts" AllegraEra where - huddleRule p = "auxiliary_scripts" =:= arr [0 <+ a (huddleRule @"native_script" p)] + huddleRule = auxiliaryScriptsRule @AllegraEra instance HuddleRule "auxiliary_data_array" AllegraEra where - huddleRule p = - "auxiliary_data_array" - =:= arr - [ "transaction_metadata" ==> huddleRule @"metadata" p - , "auxiliary_scripts" ==> huddleRule @"auxiliary_scripts" p - ] + huddleRule = auxiliaryDataArrayRule @AllegraEra instance HuddleRule "auxiliary_data" AllegraEra where - huddleRule p = - "auxiliary_data" - =:= huddleRule @"metadata" p - / huddleRule @"auxiliary_data_array" p + huddleRule = auxiliaryDataRule @AllegraEra instance HuddleRule "transaction_body" AllegraEra where huddleRule p = diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md index b09b29fa353..1accf23741a 100644 --- a/eras/alonzo/impl/CHANGELOG.md +++ b/eras/alonzo/impl/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.15.0.0 +* Add `cddl` sub-library, and `generate-cddl` executable. * Renamed `uappCostModels` to `uappPlutusV1CostModel` and changed its type from `CostModels` to `CostModel` * Renamed `agCostModels` to `agPlutusV1CostModel` @@ -42,6 +43,10 @@ * Add `PlutusTxInInfo` type family * Add `toPlutusTxInInfo` method to `EraPlutusTxInfo` +### `cddl` + +* Add full `HuddleSpec`. + ### `testlib` * Added `Arbitrary` instance for `AlonzoExtraConfig` diff --git a/eras/alonzo/impl/cardano-ledger-alonzo.cabal b/eras/alonzo/impl/cardano-ledger-alonzo.cabal index caa41e0f4ef..230681203f1 100644 --- a/eras/alonzo/impl/cardano-ledger-alonzo.cabal +++ b/eras/alonzo/impl/cardano-ledger-alonzo.cabal @@ -103,6 +103,50 @@ library transformers, validation-selective, +library cddl + exposed-modules: + Cardano.Ledger.Alonzo.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-alonzo, + cardano-ledger-mary:cddl, + cuddle >=0.4, + heredoc, + +executable generate-cddl + main-is: Main.hs + hs-source-dirs: cddl/exe + other-modules: Paths_cardano_ledger_alonzo + 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.Alonzo.Arbitrary diff --git a/eras/alonzo/impl/cddl-files/alonzo.cddl b/eras/alonzo/impl/cddl-files/alonzo.cddl index 9cc6ab39138..8d464eb4cdd 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] diff --git a/eras/alonzo/impl/cddl/exe/Main.hs b/eras/alonzo/impl/cddl/exe/Main.hs new file mode 100644 index 00000000000..cf3fe2a1846 --- /dev/null +++ b/eras/alonzo/impl/cddl/exe/Main.hs @@ -0,0 +1,14 @@ +module Main where + +import Cardano.Ledger.Alonzo.HuddleSpec (alonzoCDDL) +import Paths_cardano_ledger_alonzo (getDataFileName) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (takeDirectory) +import Test.Cardano.Ledger.Binary.Cuddle (writeSpec) + +main :: IO () +main = do + outputPath <- getDataFileName "cddl-files/alonzo.cddl" + createDirectoryIfMissing True (takeDirectory outputPath) + writeSpec alonzoCDDL outputPath + putStrLn $ "Generated CDDL file at: " ++ outputPath diff --git a/eras/alonzo/impl/cddl/lib/Cardano/Ledger/Alonzo/HuddleSpec.hs b/eras/alonzo/impl/cddl/lib/Cardano/Ledger/Alonzo/HuddleSpec.hs new file mode 100644 index 00000000000..08abbb68071 --- /dev/null +++ b/eras/alonzo/impl/cddl/lib/Cardano/Ledger/Alonzo/HuddleSpec.hs @@ -0,0 +1,587 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Cardano.Ledger.Alonzo.HuddleSpec ( + module Cardano.Ledger.Mary.HuddleSpec, + alonzoCDDL, + constr, + exUnitsRule, + networkIdRule, + positiveIntervalRule, + bigUintRule, + bigNintRule, + bigIntRule, + scriptDataHashRule, + boundedBytesRule, + distinctBytesRule, + plutusV1ScriptRule, + plutusDataRule, +) where + +import Cardano.Ledger.Alonzo (AlonzoEra) +import Cardano.Ledger.Mary.HuddleSpec +import Codec.CBOR.Cuddle.Comments ((//-)) +import Codec.CBOR.Cuddle.Huddle +import Data.Proxy (Proxy (..)) +import Data.Word (Word64) +import Text.Heredoc +import Prelude hiding ((/)) + +alonzoCDDL :: Huddle +alonzoCDDL = + collectFrom + [ HIRule $ huddleRule @"block" (Proxy @AlonzoEra) + , HIRule $ huddleRule @"transaction" (Proxy @AlonzoEra) + , HIRule $ huddleRule @"kes_signature" (Proxy @AlonzoEra) + , HIRule $ huddleRule @"language" (Proxy @AlonzoEra) + , HIRule $ huddleRule @"signkey_kes" (Proxy @AlonzoEra) + ] + +exUnitsRule :: Rule +exUnitsRule = "ex_units" =:= arr ["mem" ==> VUInt, "steps" ==> VUInt] + +networkIdRule :: Rule +networkIdRule = "network_id" =:= int 0 / int 1 + +positiveIntervalRule :: forall era. Era era => Proxy era -> Rule +positiveIntervalRule p = + "positive_interval" + =:= tag 30 (arr [a (huddleRule @"positive_int" p), a (huddleRule @"positive_int" p)]) + +bigUintRule :: forall era. HuddleRule "bounded_bytes" era => Proxy era -> Rule +bigUintRule p = "big_uint" =:= tag 2 (huddleRule @"bounded_bytes" p) + +bigNintRule :: forall era. HuddleRule "bounded_bytes" era => Proxy era -> Rule +bigNintRule p = "big_nint" =:= tag 3 (huddleRule @"bounded_bytes" p) + +bigIntRule :: forall era. HuddleRule "bounded_bytes" era => Proxy era -> Rule +bigIntRule p = "big_int" =:= VInt / bigUintRule p / bigNintRule p + +scriptDataHashRule :: forall era. Era era => Proxy era -> Rule +scriptDataHashRule p = "script_data_hash" =:= huddleRule @"hash32" p + +boundedBytesRule :: Rule +boundedBytesRule = + comment + [str|The real bounded_bytes does not have this limit. it instead has + |a different limit which cannot be expressed in CDDL. + | + |The limit is as follows: + | - bytes with a definite-length encoding are limited to size 0..64 + | - for bytes with an indefinite-length CBOR encoding, each chunk is + | limited to size 0..64 + | ( reminder: in CBOR, the indefinite-length encoding of + | bytestrings consists of a token #2.31 followed by a sequence + | of definite-length encoded bytestrings and a stop code ) + |] + $ "bounded_bytes" =:= VBytes `sized` (0 :: Word64, 64 :: Word64) + +distinctBytesRule :: Rule +distinctBytesRule = + comment + [str|A type for distinct values. + |The type parameter must support .size, for example: bytes or uint + |] + $ "distinct_bytes" + =:= (VBytes `sized` (8 :: Word64)) + / (VBytes `sized` (16 :: Word64)) + / (VBytes `sized` (20 :: Word64)) + / (VBytes `sized` (24 :: Word64)) + / (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 + +instance HuddleRule "transaction_id" AlonzoEra where + huddleRule = transactionIdRule @AlonzoEra + +instance HuddleRule "transaction_input" AlonzoEra where + huddleRule = transactionInputRule @AlonzoEra + +instance HuddleRule "certificate" AlonzoEra where + huddleRule = certificateRule @AlonzoEra + +instance HuddleGroup "account_registration_cert" AlonzoEra where + huddleGroup = accountRegistrationCertGroup @AlonzoEra + +instance HuddleGroup "account_unregistration_cert" AlonzoEra where + huddleGroup = accountUnregistrationCertGroup @AlonzoEra + +instance HuddleGroup "delegation_to_stake_pool_cert" AlonzoEra where + huddleGroup = delegationToStakePoolCertGroup @AlonzoEra + +instance HuddleGroup "pool_registration_cert" AlonzoEra where + huddleGroup = poolRegistrationCertGroup @AlonzoEra + +instance HuddleGroup "pool_retirement_cert" AlonzoEra where + huddleGroup = poolRetirementCertGroup @AlonzoEra + +instance HuddleGroup "genesis_delegation_cert" AlonzoEra where + huddleGroup = genesisDelegationCertGroup @AlonzoEra + +instance HuddleGroup "move_instantaneous_rewards_cert" AlonzoEra where + huddleGroup = moveInstantaneousRewardsCertGroup @AlonzoEra + +instance HuddleRule "withdrawals" AlonzoEra where + huddleRule = withdrawalsRule @AlonzoEra + +instance HuddleRule "genesis_hash" AlonzoEra where + huddleRule = genesisHashRule @AlonzoEra + +instance HuddleRule "genesis_delegate_hash" AlonzoEra where + huddleRule = genesisDelegateHashRule @AlonzoEra + +instance HuddleGroup "pool_params" AlonzoEra where + huddleGroup = poolParamsGroup @AlonzoEra + +instance HuddleRule "pool_metadata" AlonzoEra where + huddleRule = poolMetadataRule @AlonzoEra + +instance HuddleRule "dns_name" AlonzoEra where + huddleRule _ = dnsNameRule + +instance HuddleRule "url" AlonzoEra where + huddleRule _ = urlRule + +instance HuddleGroup "single_host_addr" AlonzoEra where + huddleGroup = singleHostAddrGroup @AlonzoEra + +instance HuddleGroup "single_host_name" AlonzoEra where + huddleGroup = singleHostNameGroup @AlonzoEra + +instance HuddleGroup "multi_host_name" AlonzoEra where + huddleGroup = multiHostNameGroup @AlonzoEra + +instance HuddleRule "relay" AlonzoEra where + huddleRule = relayRule @AlonzoEra + +instance HuddleRule "move_instantaneous_reward" AlonzoEra where + huddleRule = moveInstantaneousRewardRule @AlonzoEra + +instance HuddleRule "delta_coin" AlonzoEra where + huddleRule _ = deltaCoinRule + +instance HuddleRule "vkeywitness" AlonzoEra where + huddleRule = vkeywitnessRule @AlonzoEra + +instance HuddleRule "bootstrap_witness" AlonzoEra where + huddleRule = bootstrapWitnessRule @AlonzoEra + +instance HuddleRule "auxiliary_scripts" AlonzoEra where + huddleRule = auxiliaryScriptsRule @AlonzoEra + +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 + +instance HuddleGroup "script_all" AlonzoEra where + huddleGroup = scriptAllGroup @AlonzoEra + +instance HuddleGroup "script_any" AlonzoEra where + huddleGroup = scriptAnyGroup @AlonzoEra + +instance HuddleGroup "script_n_of_k" AlonzoEra where + huddleGroup = scriptNOfKGroup @AlonzoEra + +instance HuddleGroup "script_invalid_before" AlonzoEra where + huddleGroup = scriptInvalidBeforeGroup @AlonzoEra + +instance HuddleGroup "script_invalid_hereafter" AlonzoEra where + huddleGroup = scriptInvalidHereafterGroup @AlonzoEra + +instance HuddleRule "policy_id" AlonzoEra where + huddleRule p = "policy_id" =:= huddleRule @"script_hash" p + +instance HuddleRule "asset_name" AlonzoEra where + huddleRule _ = "asset_name" =:= VBytes `sized` (0 :: Word64, 32 :: Word64) + +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] + +instance HuddleRule "mint" AlonzoEra where + huddleRule p = "mint" =:= multiasset p (huddleRule @"int64" p) + +instance HuddleRule "block" AlonzoEra 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)] //- "new" + ] + +instance HuddleRule "header" AlonzoEra where + huddleRule p = + "header" + =:= arr + [ a $ huddleRule @"header_body" p + , "body_signature" ==> huddleRule @"kes_signature" p + ] + +instance HuddleRule "header_body" AlonzoEra 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 + , "nonce_vrf" ==> huddleRule @"vrf_cert" p + , "leader_vrf" ==> huddleRule @"vrf_cert" p + , "block_body_size" ==> VUInt + , "block_body_hash" ==> huddleRule @"hash32" p //- "merkle triple root" + , a $ huddleGroup @"operational_cert" p + , a $ huddleGroup @"protocol_version" p + ] + +instance HuddleGroup "protocol_version" AlonzoEra where + huddleGroup = shelleyProtocolVersionGroup @AlonzoEra + +instance HuddleRule "major_protocol_version" AlonzoEra where + huddleRule = majorProtocolVersionRule @AlonzoEra + +instance HuddleRule "transaction" AlonzoEra 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 "transaction_body" AlonzoEra where + huddleRule p = + "transaction_body" + =:= mp + [ idx 0 ==> untaggedSet (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 ==> arr [0 <+ a (huddleRule @"certificate" p)]) + , opt (idx 5 ==> huddleRule @"withdrawals" p) + , opt (idx 6 ==> huddleRule @"update" 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) //- "new" + , opt (idx 13 ==> untaggedSet (huddleRule @"transaction_input" p)) //- "collateral" + , opt (idx 14 ==> huddleRule @"required_signers" p) //- "new" + , opt (idx 15 ==> huddleRule @"network_id" p) //- "new" + ] + +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" + ] + +instance HuddleRule "update" AlonzoEra where + huddleRule p = + "update" + =:= arr + [ a (huddleRule @"proposed_protocol_parameter_updates" p) + , a (huddleRule @"epoch" p) + ] + +instance HuddleRule "proposed_protocol_parameter_updates" AlonzoEra where + huddleRule p = + "proposed_protocol_parameter_updates" + =:= mp + [ 0 + <+ asKey (huddleRule @"genesis_hash" p) + ==> huddleRule @"protocol_param_update" p + ] + +instance HuddleRule "protocol_param_update" AlonzoEra where + huddleRule p = + "protocol_param_update" + =:= mp + [ opt (idx 0 ==> VUInt) //- "minfee A" + , opt (idx 1 ==> VUInt) //- "minfee B" + , 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 12 ==> huddleRule @"unit_interval" p) //- "decentralization constant" + , opt (idx 13 ==> huddleRule @"nonce" p) //- "extra entropy" + , opt (idx 14 ==> arr [a (huddleGroup @"protocol_version" p)]) //- "protocol version" + , 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) //- "max value size" + , opt (idx 23 ==> VUInt) //- "collateral percentage" + , opt (idx 24 ==> VUInt) //- "max collateral inputs" + ] + +instance HuddleRule "transaction_witness_set" AlonzoEra where + huddleRule p = + "transaction_witness_set" + =:= mp + [ opt $ idx 0 ==> arr [0 <+ a (huddleRule @"vkeywitness" p)] + , opt $ idx 1 ==> arr [0 <+ a (huddleRule @"native_script" p)] + , opt $ idx 2 ==> arr [0 <+ a (huddleRule @"bootstrap_witness" p)] + , opt $ idx 3 ==> arr [0 <+ a (huddleRule @"plutus_v1_script" p)] //- "new" + , opt $ idx 4 ==> arr [0 <+ a (huddleRule @"plutus_data" p)] //- "new" + , opt $ idx 5 ==> huddleRule @"redeemers" p //- "new" + ] + +instance HuddleRule "auxiliary_data" AlonzoEra 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 + |] + $ "auxiliary_data" + =:= huddleRule @"metadata" p + / huddleRule @"auxiliary_data_array" p + / huddleRule @"auxiliary_data_map" p + +instance HuddleRule "auxiliary_data_map" AlonzoEra 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)]) + ] + ) + +instance HuddleRule "script_data_hash" AlonzoEra 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 is encoded as an indefinite length + | list and the result is encoded as a bytestring. (our apologies) + | - the language ID tag is also encoded twice. first as a uint then as + | a bytestring. (our apologies) + | + |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. In the Alonzo era, this means cost_models must have a key 0 + |for Plutus V1. + | + |Finally, note that in the case that a transaction includes + |datums but does not include any redeemers, the script data + |format becomes (in hex): + | [ 80 | datums | A0 ] + | + |corresponding to a CBOR empty list and an empty map (our + |apologies). + |] + $ scriptDataHashRule p + +instance HuddleRule "required_signers" AlonzoEra where + huddleRule p = "required_signers" =:= untaggedSet (huddleRule @"addr_keyhash" p) + +instance HuddleRule "network_id" AlonzoEra where + huddleRule _ = networkIdRule + +instance HuddleRule "plutus_v1_script" AlonzoEra where + huddleRule = plutusV1ScriptRule + +instance HuddleRule "distinct_bytes" AlonzoEra where + huddleRule _ = distinctBytesRule + +instance HuddleRule "bounded_bytes" AlonzoEra where + huddleRule _ = boundedBytesRule + +instance HuddleRule "big_uint" AlonzoEra where + huddleRule = bigUintRule + +instance HuddleRule "big_nint" AlonzoEra where + huddleRule = bigNintRule + +instance HuddleRule "big_int" AlonzoEra where + huddleRule = bigIntRule + +instance HuddleRule "plutus_data" AlonzoEra where + huddleRule = plutusDataRule + +constr :: IsType0 a => a -> GRuleCall +constr = + binding $ \x -> + "constr" + =:= tag 121 (arr [0 <+ a x]) + / tag 122 (arr [0 <+ a x]) + / tag 123 (arr [0 <+ a x]) + / tag 124 (arr [0 <+ a x]) + / tag 125 (arr [0 <+ a x]) + / tag 126 (arr [0 <+ a x]) + / tag 127 (arr [0 <+ a x]) + / tag 102 (arr [a VUInt, a $ arr [0 <+ a x]]) + +instance HuddleRule "redeemers" AlonzoEra where + huddleRule p = "redeemers" =:= arr [0 <+ a (huddleRule @"redeemer" 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 + ] + +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 + +instance HuddleRule "ex_units" AlonzoEra where + huddleRule _ = exUnitsRule + +instance HuddleRule "ex_unit_prices" AlonzoEra where + huddleRule p = + "ex_unit_prices" + =:= arr + [ "mem_price" ==> huddleRule @"positive_interval" p + , "step_price" ==> huddleRule @"positive_interval" p + ] + +instance HuddleRule "positive_interval" AlonzoEra where + huddleRule = positiveIntervalRule + +instance HuddleRule "language" AlonzoEra where + huddleRule _ = + comment + [str|NOTE: NEW + | This is an enumeration. for now there's only one value. Plutus V1 + |] + $ "language" =:= int 0 + +instance HuddleRule "cost_models" AlonzoEra where + huddleRule p = + "cost_models" + =:= mp [0 <+ asKey (huddleRule @"language" p) ==> huddleRule @"cost_model" p] + +instance HuddleRule "cost_model" AlonzoEra where + huddleRule p = + comment + [str|NOTE: NEW + | The keys to the cost model map are not present in the serialization. + | The values in the serialization are assumed to be ordered + | lexicographically by their correpsonding key value. + | See Plutus' `ParamName` for parameter ordering + |] + $ "cost_model" =:= arr [166 <+ a (huddleRule @"int64" p) +> 166] diff --git a/eras/babbage/impl/CHANGELOG.md b/eras/babbage/impl/CHANGELOG.md index 47a4fe2eb79..319c0804365 100644 --- a/eras/babbage/impl/CHANGELOG.md +++ b/eras/babbage/impl/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.13.0.0 +* Add `cddl` sub-library, and `generate-cddl` executable. * Remove deprecated functions `txOutData`, `txOutDataHash`, `txOutScript` * Remove deprecated type `Babbage` * Removed deprecated accessor functions: @@ -26,6 +27,10 @@ * Add `EraTxLevel` instance * Add `mkCollateralTxIn` +### `cddl` + +* Add full `HuddleSpec`. + ### `testlib` * Add `plutus_v2_script` to CDDL exports diff --git a/eras/babbage/impl/cardano-ledger-babbage.cabal b/eras/babbage/impl/cardano-ledger-babbage.cabal index ac5b21f070e..eecf6418b57 100644 --- a/eras/babbage/impl/cardano-ledger-babbage.cabal +++ b/eras/babbage/impl/cardano-ledger-babbage.cabal @@ -98,6 +98,50 @@ library transformers, validation-selective, +library cddl + exposed-modules: + Cardano.Ledger.Babbage.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-alonzo:cddl, + cardano-ledger-babbage, + cuddle >=0.4, + heredoc, + +executable generate-cddl + main-is: Main.hs + hs-source-dirs: cddl/exe + other-modules: Paths_cardano_ledger_babbage + 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.Babbage.Arbitrary diff --git a/eras/babbage/impl/cddl-files/babbage.cddl b/eras/babbage/impl/cddl-files/babbage.cddl index 5922038ef3a..cf82a4868a1 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,8 +93,6 @@ 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 shelley_transaction_output = [address, amount : value, ? datum_hash : hash32] @@ -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] diff --git a/eras/babbage/impl/cddl/exe/Main.hs b/eras/babbage/impl/cddl/exe/Main.hs new file mode 100644 index 00000000000..c7ee1e47fd9 --- /dev/null +++ b/eras/babbage/impl/cddl/exe/Main.hs @@ -0,0 +1,14 @@ +module Main where + +import Cardano.Ledger.Babbage.HuddleSpec (babbageCDDL) +import Paths_cardano_ledger_babbage (getDataFileName) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (takeDirectory) +import Test.Cardano.Ledger.Binary.Cuddle (writeSpec) + +main :: IO () +main = do + outputPath <- getDataFileName "cddl-files/babbage.cddl" + createDirectoryIfMissing True (takeDirectory outputPath) + writeSpec babbageCDDL outputPath + putStrLn $ "Generated CDDL file at: " ++ outputPath diff --git a/eras/babbage/impl/cddl/lib/Cardano/Ledger/Babbage/HuddleSpec.hs b/eras/babbage/impl/cddl/lib/Cardano/Ledger/Babbage/HuddleSpec.hs new file mode 100644 index 00000000000..1d64056dfcd --- /dev/null +++ b/eras/babbage/impl/cddl/lib/Cardano/Ledger/Babbage/HuddleSpec.hs @@ -0,0 +1,591 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Cardano.Ledger.Babbage.HuddleSpec ( + module Cardano.Ledger.Alonzo.HuddleSpec, + babbageCDDL, + babbageOperationalCertRule, + babbageProtocolVersionRule, + babbageTransactionOutput, + babbageScript, +) where + +import Cardano.Ledger.Alonzo.HuddleSpec hiding ( + shelleyOperationalCertGroup, + shelleyProtocolVersionGroup, + ) +import Cardano.Ledger.Babbage (BabbageEra) +import Codec.CBOR.Cuddle.Comments ((//-)) +import Codec.CBOR.Cuddle.Huddle +import Data.Proxy (Proxy (..)) +import Data.Word (Word64) +import Text.Heredoc +import Prelude hiding ((/)) + +babbageCDDL :: Huddle +babbageCDDL = + collectFrom + [ HIRule $ huddleRule @"block" (Proxy @BabbageEra) + , HIRule $ huddleRule @"transaction" (Proxy @BabbageEra) + , HIRule $ huddleRule @"kes_signature" (Proxy @BabbageEra) + , HIRule $ huddleRule @"language" (Proxy @BabbageEra) + , HIRule $ huddleRule @"signkey_kes" (Proxy @BabbageEra) + ] + +-- | Babbage changed protocol_version from Named Group to Rule to match actual block +-- serialization. See 'header_body' instance for full explanation. +-- Ref: PR #3762, Issue #3559 +babbageProtocolVersionRule :: + forall era. HuddleRule "major_protocol_version" era => Proxy era -> Rule +babbageProtocolVersionRule p = + "protocol_version" =:= arr [a $ huddleRule @"major_protocol_version" p, a VUInt] + +-- | Babbage changed operational_cert from Named Group to Rule to match actual block +-- serialization. See 'header_body' instance for full explanation. +-- Ref: PR #3762, Issue #3559 +babbageOperationalCertRule :: forall era. Era era => Proxy era -> Rule +babbageOperationalCertRule p = + "operational_cert" + =:= arr + [ "hot_vkey" ==> huddleRule @"kes_vkey" p + , "sequence_number" ==> huddleRule @"sequence_number" p + , "kes_period" ==> huddleRule @"kes_period" p + , "sigma" ==> huddleRule @"signature" p + ] + +instance HuddleGroup "account_registration_cert" BabbageEra where + huddleGroup = accountRegistrationCertGroup @BabbageEra + +instance HuddleGroup "account_unregistration_cert" BabbageEra where + huddleGroup = accountUnregistrationCertGroup @BabbageEra + +instance HuddleGroup "delegation_to_stake_pool_cert" BabbageEra where + huddleGroup = delegationToStakePoolCertGroup @BabbageEra + +instance HuddleGroup "pool_registration_cert" BabbageEra where + huddleGroup = poolRegistrationCertGroup @BabbageEra + +instance HuddleGroup "pool_retirement_cert" BabbageEra where + huddleGroup = poolRetirementCertGroup @BabbageEra + +instance HuddleGroup "genesis_delegation_cert" BabbageEra where + huddleGroup = genesisDelegationCertGroup @BabbageEra + +instance HuddleGroup "move_instantaneous_rewards_cert" BabbageEra where + huddleGroup = moveInstantaneousRewardsCertGroup @BabbageEra + +instance HuddleRule "certificate" BabbageEra where + huddleRule = certificateRule @BabbageEra + +instance HuddleRule "withdrawals" BabbageEra where + huddleRule = withdrawalsRule @BabbageEra + +instance HuddleRule "genesis_hash" BabbageEra where + huddleRule = genesisHashRule @BabbageEra + +instance HuddleRule "genesis_delegate_hash" BabbageEra where + huddleRule = genesisDelegateHashRule @BabbageEra + +instance HuddleGroup "pool_params" BabbageEra where + huddleGroup = poolParamsGroup @BabbageEra + +instance HuddleRule "pool_metadata" BabbageEra where + huddleRule = poolMetadataRule @BabbageEra + +instance HuddleRule "dns_name" BabbageEra where + huddleRule _ = dnsNameRule + +instance HuddleRule "url" BabbageEra where + huddleRule _ = urlRule + +instance HuddleGroup "single_host_addr" BabbageEra where + huddleGroup = singleHostAddrGroup @BabbageEra + +instance HuddleGroup "single_host_name" BabbageEra where + huddleGroup = singleHostNameGroup @BabbageEra + +instance HuddleGroup "multi_host_name" BabbageEra where + huddleGroup = multiHostNameGroup @BabbageEra + +instance HuddleRule "relay" BabbageEra where + huddleRule = relayRule @BabbageEra + +instance HuddleRule "move_instantaneous_reward" BabbageEra where + huddleRule = moveInstantaneousRewardRule @BabbageEra + +instance HuddleRule "delta_coin" BabbageEra where + huddleRule _ = deltaCoinRule + +instance HuddleRule "transaction_id" BabbageEra where + huddleRule = transactionIdRule @BabbageEra + +instance HuddleRule "transaction_input" BabbageEra where + huddleRule = transactionInputRule @BabbageEra + +instance HuddleRule "vkeywitness" BabbageEra where + huddleRule = vkeywitnessRule @BabbageEra + +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] + +instance HuddleRule "mint" BabbageEra where + huddleRule p = "mint" =:= multiasset p (huddleRule @"int64" p) + +instance HuddleRule "proposed_protocol_parameter_updates" BabbageEra where + huddleRule = proposedProtocolParameterUpdatesRule @BabbageEra + +instance HuddleRule "update" BabbageEra where + huddleRule = updateRule @BabbageEra + +instance HuddleRule "required_signers" BabbageEra where + huddleRule p = "required_signers" =:= untaggedSet (huddleRule @"addr_keyhash" p) + +instance HuddleRule "network_id" BabbageEra where + huddleRule _ = networkIdRule + +instance HuddleRule "bounded_bytes" BabbageEra where + huddleRule _ = boundedBytesRule + +instance HuddleRule "big_uint" BabbageEra where + huddleRule = bigUintRule + +instance HuddleRule "big_nint" BabbageEra where + huddleRule = bigNintRule + +instance HuddleRule "big_int" BabbageEra where + huddleRule = bigIntRule + +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)] + +instance HuddleRule "redeemer" BabbageEra where + huddleRule p = + comment + [str|NEW + |] + $ "redeemer" + =:= arr + [ "tag" ==> huddleRule @"redeemer_tag" p + , "index" ==> VUInt + , "data" ==> huddleRule @"plutus_data" p + , "ex_units" ==> huddleRule @"ex_units" 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 + +instance HuddleRule "ex_units" BabbageEra where + huddleRule _ = exUnitsRule + +instance HuddleRule "ex_unit_prices" BabbageEra where + huddleRule p = + "ex_unit_prices" + =:= arr + [ "mem_price" ==> huddleRule @"positive_interval" p + , "step_price" ==> huddleRule @"positive_interval" p + ] + +instance HuddleRule "positive_interval" BabbageEra where + huddleRule = positiveIntervalRule + +instance HuddleRule "operational_cert" BabbageEra where + huddleRule = babbageOperationalCertRule @BabbageEra + +instance HuddleRule "protocol_version" BabbageEra where + huddleRule = babbageProtocolVersionRule @BabbageEra + +instance HuddleRule "major_protocol_version" BabbageEra where + huddleRule = majorProtocolVersionRule @BabbageEra + +instance HuddleRule "block" BabbageEra 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 "header" BabbageEra where + huddleRule p = + "header" + =:= arr + [ a $ huddleRule @"header_body" p + , "body_signature" ==> huddleRule @"kes_signature" p + ] + +-- IMPORTANT: Babbage changed operational_cert and protocol_version from Named Group +-- (grp) to Rule (arr) to match actual block serialization. +-- +-- Semantic difference: +-- * Named Group (grp): Fields are inlined directly into parent array. +-- -> header_body becomes a 14-element flat array +-- * Rule (arr): Fields are nested as separate sub-arrays. +-- -> header_body becomes a 10-element array with nested structures +-- +-- Pre-Babbage eras (Shelley through Alonzo) used Named Group, but actual Babbage+ +-- blocks serialize with Rule (nested arrays). This change corrects the CDDL spec to +-- match the actual CBOR serialization. +-- +-- See 'babbageProtocolVersionRule' and 'operational_cert' instance for details. +-- References: PR #3762, Issue #3559 +instance HuddleRule "header_body" BabbageEra 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 //- "replaces nonce_vrf and leader_vrf" + , "block_body_size" ==> VUInt + , "block_body_hash" ==> huddleRule @"hash32" p //- "merkle triple root" + , a $ huddleRule @"operational_cert" p + , a $ huddleRule @"protocol_version" p + ] + +instance HuddleRule "transaction" BabbageEra 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 "transaction_body" BabbageEra where + huddleRule p = + "transaction_body" + =:= mp + [ idx 0 ==> untaggedSet (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 ==> arr [0 <+ a (huddleRule @"certificate" p)]) + , opt (idx 5 ==> huddleRule @"withdrawals" p) + , opt (idx 6 ==> huddleRule @"update" 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 ==> untaggedSet (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 ==> untaggedSet (huddleRule @"transaction_input" p)) //- "reference inputs" + ] + +instance HuddleRule "script_data_hash" BabbageEra 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 costmdls 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 costmdls 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 costmdls 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. + | + |Note that each Plutus language represented inside a transaction must have + |a cost model in the costmdls 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): + |[ 80 | datums | A0 ] + |corresponding to a CBOR empty list and an empty map. + |Note that a transaction might include the redeemers field and set it to the + |empty map, in which case the user supplied encoding of the empty map is used. + |] + $ scriptDataHashRule p + +instance HuddleRule "transaction_output" BabbageEra 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 @"shelley_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) + ] + +babbageTransactionOutput :: + forall era. + (HuddleRule "address" era, HuddleRule "value" era, HuddleRule "datum_option" era) => + Proxy era -> Rule -> Rule +babbageTransactionOutput p script = + "babbage_transaction_output" + =:= mp + [ idx 0 ==> huddleRule @"address" p + , idx 1 ==> huddleRule @"value" p + , opt $ idx 2 ==> huddleRule @"datum_option" p //- "new" + , opt $ idx 3 ==> ("script_ref" =:= tag 24 (VBytes `cbor` script)) //- "new" + ] + +instance HuddleRule "datum_option" BabbageEra where + huddleRule p = + "datum_option" + =:= arr [0, a (huddleRule @"hash32" p)] + / arr [1, a (huddleRule @"data" p)] + +instance HuddleRule "data" BabbageEra where + huddleRule p = + "data" =:= tag 24 (VBytes `cbor` huddleRule @"plutus_data" p) + +instance HuddleRule "transaction_witness_set" BabbageEra where + huddleRule p = + "transaction_witness_set" + =:= mp + [ opt $ idx 0 ==> arr [0 <+ a (huddleRule @"vkeywitness" p)] + , opt $ idx 1 ==> arr [0 <+ a (huddleRule @"native_script" p)] + , opt $ idx 2 ==> arr [0 <+ a (huddleRule @"bootstrap_witness" p)] + , opt $ idx 3 ==> arr [0 <+ a (huddleRule @"plutus_v1_script" p)] + , opt $ idx 4 ==> arr [0 <+ a (huddleRule @"plutus_data" p)] + , opt $ idx 5 ==> huddleRule @"redeemers" p + , opt $ idx 6 ==> arr [0 <+ a (huddleRule @"plutus_v2_script" p)] + ] + +instance HuddleRule "native_script" BabbageEra where + huddleRule = nativeScriptRule @BabbageEra + +instance HuddleGroup "script_pubkey" BabbageEra where + huddleGroup = scriptPubkeyGroup @BabbageEra + +instance HuddleGroup "script_all" BabbageEra where + huddleGroup = scriptAllGroup @BabbageEra + +instance HuddleGroup "script_any" BabbageEra where + huddleGroup = scriptAnyGroup @BabbageEra + +instance HuddleGroup "script_n_of_k" BabbageEra where + huddleGroup = scriptNOfKGroup @BabbageEra + +instance HuddleGroup "script_invalid_before" BabbageEra where + huddleGroup = scriptInvalidBeforeGroup @BabbageEra + +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 + huddleRule p = + comment + [str|Babbage introduces Plutus V2 with improved cost model + |and additional builtins. + |] + $ "plutus_v2_script" =:= huddleRule @"distinct_bytes" p + +instance HuddleRule "script" BabbageEra where + huddleRule = babbageScript + +babbageScript :: + forall era. + ( HuddleRule "native_script" era + , HuddleRule "plutus_v1_script" era + , HuddleRule "plutus_v2_script" era + ) => + Proxy era -> Rule +babbageScript p = + comment + [str|Babbage supports three script types: + | 0: Native scripts (timelock) + | 1: Plutus V1 scripts + | 2: Plutus V2 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)] + +instance HuddleRule "language" BabbageEra where + huddleRule _ = + comment + [str|0: Plutus v1 + |1: Plutus v2 + |] + $ "language" =:= int 0 / int 1 + +instance HuddleRule "cost_models" BabbageEra where + huddleRule p = + "cost_models" + =:= mp + [ opt $ idx 0 ==> arr [166 <+ a (huddleRule @"int64" p) +> 166] + , opt $ idx 1 ==> arr [175 <+ a (huddleRule @"int64" p) +> 175] + ] + +instance HuddleRule "protocol_param_update" BabbageEra where + huddleRule p = + "protocol_param_update" + =:= mp + [ opt (idx 0 ==> VUInt) //- "minfee A" + , opt (idx 1 ==> VUInt) //- "minfee B" + , 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 14 ==> huddleRule @"protocol_version" p) //- "protocol version" + , 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) //- "max value size" + , opt (idx 23 ==> VUInt) //- "collateral percentage" + , opt (idx 24 ==> VUInt) //- "max collateral inputs" + ] + +instance HuddleRule "auxiliary_data" BabbageEra 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 + | Babbage adds plutus_v2_script support at index 3 + |] + $ "auxiliary_data" + =:= huddleRule @"metadata" p + / huddleRule @"auxiliary_data_array" p + / huddleRule @"auxiliary_data_map" p + +instance HuddleRule "auxiliary_data_array" BabbageEra where + huddleRule = auxiliaryDataArrayRule @BabbageEra + +instance HuddleRule "auxiliary_scripts" BabbageEra where + huddleRule p = + "auxiliary_scripts" =:= arr [0 <+ a (huddleRule @"native_script" p)] + +instance HuddleRule "auxiliary_data_map" BabbageEra 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)]) + ] + ) diff --git a/eras/mary/impl/CHANGELOG.md b/eras/mary/impl/CHANGELOG.md index 2634e44ba75..0d6a31ae037 100644 --- a/eras/mary/impl/CHANGELOG.md +++ b/eras/mary/impl/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.10.0.0 +* Add `cddl` sub-library, and `generate-cddl` executable. * Remove deprecated functions `insert`, `lookup`, `prune` * Remove deprecated type `Mary` * Add `burnedMultiAssets` @@ -9,6 +10,10 @@ * Add `HasEraTxLevel` instances for `Tx` and `TxBody` * Add `EraTxLevel` instance +### `cddl` + +* Add full `HuddleSpec`. + ### `testlib` * Use fixed-sized `uint .size 8` for `slot` in CDDL for transaction validity intervals diff --git a/eras/mary/impl/cardano-ledger-mary.cabal b/eras/mary/impl/cardano-ledger-mary.cabal index dd68a2047d9..7b69ab3eb40 100644 --- a/eras/mary/impl/cardano-ledger-mary.cabal +++ b/eras/mary/impl/cardano-ledger-mary.cabal @@ -95,6 +95,49 @@ library if flag(asserts) ghc-options: -fno-ignore-asserts +library cddl + exposed-modules: + Cardano.Ledger.Mary.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-allegra:cddl, + cardano-ledger-mary, + cuddle >=0.4, + +executable generate-cddl + main-is: Main.hs + hs-source-dirs: cddl/exe + other-modules: Paths_cardano_ledger_mary + 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.4, + cddl, + directory, + filepath, + library testlib exposed-modules: Test.Cardano.Ledger.Mary.Arbitrary 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/exe/Main.hs b/eras/mary/impl/cddl/exe/Main.hs new file mode 100644 index 00000000000..ac47f06ada8 --- /dev/null +++ b/eras/mary/impl/cddl/exe/Main.hs @@ -0,0 +1,14 @@ +module Main where + +import Cardano.Ledger.Mary.HuddleSpec (maryCDDL) +import Paths_cardano_ledger_mary (getDataFileName) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (takeDirectory) +import Test.Cardano.Ledger.Binary.Cuddle (writeSpec) + +main :: IO () +main = do + outputPath <- getDataFileName "cddl-files/mary.cddl" + createDirectoryIfMissing True (takeDirectory outputPath) + writeSpec maryCDDL outputPath + putStrLn $ "Generated CDDL file at: " ++ outputPath diff --git a/eras/mary/impl/cddl/lib/Cardano/Ledger/Mary/HuddleSpec.hs b/eras/mary/impl/cddl/lib/Cardano/Ledger/Mary/HuddleSpec.hs new file mode 100644 index 00000000000..9b04efb2d25 --- /dev/null +++ b/eras/mary/impl/cddl/lib/Cardano/Ledger/Mary/HuddleSpec.hs @@ -0,0 +1,231 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Cardano.Ledger.Mary.HuddleSpec ( + module Cardano.Ledger.Allegra.HuddleSpec, + maryCDDL, + multiasset, +) where + +import Cardano.Ledger.Allegra.HuddleSpec +import Cardano.Ledger.Mary (MaryEra) +import Codec.CBOR.Cuddle.Huddle +import Data.Proxy (Proxy (..)) +import Data.Word (Word64) +import Prelude hiding ((/)) + +maryCDDL :: Huddle +maryCDDL = + collectFrom + [ HIRule $ huddleRule @"block" (Proxy @MaryEra) + , HIRule $ huddleRule @"transaction" (Proxy @MaryEra) + , HIRule $ huddleRule @"policy_id" (Proxy @MaryEra) + , HIRule $ huddleRule @"asset_name" (Proxy @MaryEra) + ] + +instance HuddleRule "block" MaryEra where + huddleRule = blockRule @MaryEra + +instance HuddleRule "transaction" MaryEra where + huddleRule = transactionRule @MaryEra + +instance HuddleRule "header" MaryEra where + huddleRule = headerRule @MaryEra + +instance HuddleRule "header_body" MaryEra where + huddleRule = headerBodyRule @MaryEra + +instance HuddleGroup "protocol_version" MaryEra where + huddleGroup = shelleyProtocolVersionGroup @MaryEra + +instance HuddleRule "major_protocol_version" MaryEra where + huddleRule = majorProtocolVersionRule @MaryEra + +instance HuddleRule "int64" MaryEra where + huddleRule = int64Rule @MaryEra + +instance HuddleRule "min_int64" MaryEra where + huddleRule _ = minInt64Rule + +instance HuddleRule "max_int64" MaryEra where + huddleRule _ = maxInt64Rule + +instance HuddleRule "transaction_id" MaryEra where + huddleRule = transactionIdRule @MaryEra + +instance HuddleRule "transaction_input" MaryEra where + huddleRule = transactionInputRule @MaryEra + +instance HuddleGroup "operational_cert" MaryEra where + huddleGroup = shelleyOperationalCertGroup @MaryEra + +instance HuddleRule "vkeywitness" MaryEra where + huddleRule = vkeywitnessRule @MaryEra + +instance HuddleRule "bootstrap_witness" MaryEra where + huddleRule = bootstrapWitnessRule @MaryEra + +instance HuddleRule "transaction_witness_set" MaryEra where + huddleRule = transactionWitnessSetRule @MaryEra + +instance HuddleRule "withdrawals" MaryEra where + huddleRule = withdrawalsRule @MaryEra + +instance HuddleRule "certificate" MaryEra where + huddleRule = certificateRule @MaryEra + +instance HuddleGroup "account_registration_cert" MaryEra where + huddleGroup = accountRegistrationCertGroup @MaryEra + +instance HuddleGroup "account_unregistration_cert" MaryEra where + huddleGroup = accountUnregistrationCertGroup @MaryEra + +instance HuddleGroup "delegation_to_stake_pool_cert" MaryEra where + huddleGroup = delegationToStakePoolCertGroup @MaryEra + +instance HuddleGroup "pool_registration_cert" MaryEra where + huddleGroup = poolRegistrationCertGroup @MaryEra + +instance HuddleGroup "pool_retirement_cert" MaryEra where + huddleGroup = poolRetirementCertGroup @MaryEra + +instance HuddleGroup "genesis_delegation_cert" MaryEra where + huddleGroup = genesisDelegationCertGroup @MaryEra + +instance HuddleGroup "move_instantaneous_rewards_cert" MaryEra where + huddleGroup = moveInstantaneousRewardsCertGroup @MaryEra + +instance HuddleRule "genesis_hash" MaryEra where + huddleRule = genesisHashRule @MaryEra + +instance HuddleRule "genesis_delegate_hash" MaryEra where + huddleRule = genesisDelegateHashRule @MaryEra + +instance HuddleRule "delta_coin" MaryEra where + huddleRule _ = deltaCoinRule + +instance HuddleRule "move_instantaneous_reward" MaryEra where + huddleRule = moveInstantaneousRewardRule @MaryEra + +instance HuddleGroup "pool_params" MaryEra where + huddleGroup = poolParamsGroup @MaryEra + +instance HuddleRule "pool_metadata" MaryEra where + huddleRule = poolMetadataRule @MaryEra + +instance HuddleRule "dns_name" MaryEra where + huddleRule _ = dnsNameRule + +instance HuddleRule "url" MaryEra where + huddleRule _ = urlRule + +instance HuddleGroup "single_host_addr" MaryEra where + huddleGroup = singleHostAddrGroup @MaryEra + +instance HuddleGroup "single_host_name" MaryEra where + huddleGroup = singleHostNameGroup @MaryEra + +instance HuddleGroup "multi_host_name" MaryEra where + huddleGroup = multiHostNameGroup @MaryEra + +instance HuddleRule "relay" MaryEra where + huddleRule = relayRule @MaryEra + +instance HuddleRule "protocol_param_update" MaryEra where + huddleRule = protocolParamUpdateRule @MaryEra + +instance HuddleRule "proposed_protocol_parameter_updates" MaryEra where + huddleRule = proposedProtocolParameterUpdatesRule @MaryEra + +instance HuddleRule "update" MaryEra where + huddleRule = updateRule @MaryEra + +instance HuddleGroup "script_pubkey" MaryEra where + huddleGroup = scriptPubkeyGroup @MaryEra + +instance HuddleGroup "script_all" MaryEra where + huddleGroup = scriptAllGroup @MaryEra + +instance HuddleGroup "script_any" MaryEra where + huddleGroup = scriptAnyGroup @MaryEra + +instance HuddleGroup "script_n_of_k" MaryEra where + huddleGroup = scriptNOfKGroup @MaryEra + +instance HuddleGroup "script_invalid_before" MaryEra where + huddleGroup = scriptInvalidBeforeGroup @MaryEra + +instance HuddleGroup "script_invalid_hereafter" MaryEra where + huddleGroup = scriptInvalidHereafterGroup @MaryEra + +instance HuddleRule "native_script" MaryEra where + huddleRule = nativeScriptRule @MaryEra + +instance HuddleRule "transaction_body" MaryEra where + huddleRule p = + "transaction_body" + =:= mp + [ idx 0 ==> untaggedSet (huddleRule @"transaction_input" p) + , idx 1 ==> arr [0 <+ a (huddleRule @"transaction_output" p)] + , idx 2 ==> huddleRule @"coin" p + , opt (idx 3 ==> huddleRule @"slot" p) + , opt (idx 4 ==> arr [0 <+ a (huddleRule @"certificate" p)]) + , opt (idx 5 ==> huddleRule @"withdrawals" p) + , opt (idx 6 ==> huddleRule @"update" p) + , opt (idx 7 ==> huddleRule @"auxiliary_data_hash" p) + , opt (idx 8 ==> huddleRule @"slot" p) + , opt (idx 9 ==> huddleRule @"mint" p) + ] + +instance HuddleRule "transaction_output" MaryEra where + huddleRule p = + "transaction_output" + =:= arr + [ a $ huddleRule @"address" p + , "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] + +instance HuddleRule "policy_id" MaryEra where + huddleRule p = "policy_id" =:= huddleRule @"script_hash" p + +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) + +instance HuddleRule "auxiliary_data" MaryEra where + huddleRule = auxiliaryDataRule @MaryEra + +instance HuddleRule "auxiliary_data_array" MaryEra where + huddleRule = auxiliaryDataArrayRule @MaryEra + +instance HuddleRule "auxiliary_scripts" MaryEra where + huddleRule = auxiliaryScriptsRule @MaryEra diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index 60902cdc2a2..1c252cc6daf 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -2,8 +2,8 @@ ## 1.18.0.0 +* Add `cddl` sub-library, and `generate-cddl` executable. * Change the field type of `ShelleyIncompleteWithdrawals` to `Map RewardAccount (Mismatch RelEQ Coin)` -* Add `cddl` sub-library. * Replace `StakePoolState` values in `psFutureStakePoolParams` with `StakePoolParams` * Remove `psFutureStakePoolsL` * Add `psFutureStakePoolParamsL` @@ -35,6 +35,7 @@ ### `cddl` +* Export `scriptAllGroup` and `scriptAnyGroup`. * Add `HuddleSpec` module with `Huddle{Rule|Group}` instances for all types. * Add and export smart constructors for transaction components, certificates, pool infrastructure, and block structures. * Add `generate-cddl` executable target to test the generation of `.cddl` files against the existing `huddle-cddl` executable. diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index cf530830aaf..3ca3c43f661 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -150,7 +150,6 @@ library cddl build-depends: base, - cardano-ledger-core, cardano-ledger-core:cddl, cardano-ledger-shelley, cuddle >=0.4, 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 525f5a90777..07e0b7474d9 100644 --- a/eras/shelley/impl/cddl/lib/Cardano/Ledger/Shelley/HuddleSpec.hs +++ b/eras/shelley/impl/cddl/lib/Cardano/Ledger/Shelley/HuddleSpec.hs @@ -12,20 +12,22 @@ module Cardano.Ledger.Shelley.HuddleSpec ( module Cardano.Ledger.Huddle, + module Cardano.Ledger.Core.HuddleSpec, shelleyCDDL, + shelleyProtocolVersionGroup, headerRule, proposedProtocolParameterUpdatesRule, updateRule, protocolParamUpdateRule, headerBodyRule, - protocolVersionGroup, - majorProtocolVersionRule, transactionWitnessSetRule, vkeywitnessRule, bootstrapWitnessRule, - operationalCertGroup, + shelleyOperationalCertGroup, genesisHashRule, scriptPubkeyGroup, + scriptAllGroup, + scriptAnyGroup, transactionIdRule, transactionInputRule, transactionOutputRule, @@ -52,9 +54,7 @@ module Cardano.Ledger.Shelley.HuddleSpec ( untaggedSet, ) where -import Cardano.Ledger.BaseTypes (getVersion) -import Cardano.Ledger.Core (ByronEra, Era, eraProtVerHigh, eraProtVerLow) -import Cardano.Ledger.Core.HuddleSpec () +import Cardano.Ledger.Core.HuddleSpec (majorProtocolVersionRule) import Cardano.Ledger.Huddle import Cardano.Ledger.Shelley (ShelleyEra) import Codec.CBOR.Cuddle.Comments ((//-)) @@ -72,6 +72,10 @@ shelleyCDDL = , HIRule $ huddleRule @"signkey_kes" (Proxy @ShelleyEra) ] +shelleyProtocolVersionGroup :: + forall era. HuddleRule "major_protocol_version" era => Proxy era -> Named Group +shelleyProtocolVersionGroup p = "protocol_version" =:~ grp [a $ huddleRule @"major_protocol_version" p, a VUInt] + headerRule :: forall era. HuddleRule "header_body" era => Proxy era -> Rule headerRule p = "header" @@ -137,16 +141,6 @@ headerBodyRule p = , a (huddleGroup @"protocol_version" p) ] -protocolVersionGroup :: - forall era. HuddleRule "major_protocol_version" era => Proxy era -> Named Group -protocolVersionGroup p = "protocol_version" =:~ grp [a $ huddleRule @"major_protocol_version" p, a VUInt] - -majorProtocolVersionRule :: forall era. Era era => Proxy era -> Rule -majorProtocolVersionRule _ = - "major_protocol_version" - =:= getVersion @Integer (eraProtVerLow @ByronEra) - ... succ (getVersion @Integer (eraProtVerHigh @era)) - transactionWitnessSetRule :: forall era. ( HuddleRule "vkeywitness" era @@ -178,8 +172,8 @@ bootstrapWitnessRule p = , "attributes" ==> VBytes ] -operationalCertGroup :: forall era. Era era => Proxy era -> Named Group -operationalCertGroup p = +shelleyOperationalCertGroup :: forall era. Era era => Proxy era -> Named Group +shelleyOperationalCertGroup p = "operational_cert" =:~ grp [ "hot_vkey" ==> huddleRule @"kes_vkey" p @@ -194,6 +188,12 @@ genesisHashRule p = "genesis_hash" =:= huddleRule @"hash28" p scriptPubkeyGroup :: forall era. Era era => Proxy era -> Named Group scriptPubkeyGroup p = "script_pubkey" =:~ grp [0, a $ huddleRule @"addr_keyhash" p] +scriptAllGroup :: forall era. HuddleRule "native_script" era => Proxy era -> Named Group +scriptAllGroup p = "script_all" =:~ grp [1, a $ arr [0 <+ a (huddleRule @"native_script" p)]] + +scriptAnyGroup :: forall era. HuddleRule "native_script" era => Proxy era -> Named Group +scriptAnyGroup p = "script_any" =:~ grp [2, a $ arr [0 <+ a (huddleRule @"native_script" p)]] + transactionIdRule :: forall era. Era era => Proxy era -> Rule transactionIdRule p = "transaction_id" =:= huddleRule @"hash32" p @@ -392,6 +392,9 @@ certificateRule p = / arr [a $ huddleGroup @"genesis_delegation_cert" p] / arr [a $ huddleGroup @"move_instantaneous_rewards_cert" p] +untaggedSet :: IsType0 a => a -> GRuleCall +untaggedSet = binding $ \x -> "set" =:= arr [0 <+ a x] + instance HuddleRule "dns_name" ShelleyEra where huddleRule _ = dnsNameRule @@ -416,9 +419,6 @@ instance HuddleRule "relay" ShelleyEra where instance HuddleGroup "pool_params" ShelleyEra where huddleGroup = poolParamsGroup @ShelleyEra -untaggedSet :: IsType0 a => a -> GRuleCall -untaggedSet = binding $ \x -> "set" =:= arr [0 <+ a x] - instance HuddleGroup "pool_registration_cert" ShelleyEra where huddleGroup = poolRegistrationCertGroup @ShelleyEra @@ -462,7 +462,7 @@ instance HuddleRule "major_protocol_version" ShelleyEra where huddleRule = majorProtocolVersionRule @ShelleyEra instance HuddleGroup "protocol_version" ShelleyEra where - huddleGroup = protocolVersionGroup @ShelleyEra + huddleGroup = shelleyProtocolVersionGroup @ShelleyEra instance HuddleRule "protocol_param_update" ShelleyEra where huddleRule = protocolParamUpdateRule @ShelleyEra @@ -474,7 +474,7 @@ instance HuddleRule "update" ShelleyEra where huddleRule = updateRule @ShelleyEra instance HuddleGroup "operational_cert" ShelleyEra where - huddleGroup = operationalCertGroup @ShelleyEra + huddleGroup = shelleyOperationalCertGroup @ShelleyEra instance HuddleRule "header_body" ShelleyEra where huddleRule = headerBodyRule @ShelleyEra @@ -495,10 +495,10 @@ instance HuddleGroup "script_pubkey" ShelleyEra where huddleGroup = scriptPubkeyGroup @ShelleyEra instance HuddleGroup "script_all" ShelleyEra where - huddleGroup p = "script_all" =:~ grp [1, a $ arr [0 <+ a (huddleRule @"native_script" p)]] + huddleGroup = scriptAllGroup @ShelleyEra instance HuddleGroup "script_any" ShelleyEra where - huddleGroup p = "script_any" =:~ grp [2, a $ arr [0 <+ a (huddleRule @"native_script" p)]] + huddleGroup = scriptAnyGroup @ShelleyEra instance HuddleGroup "script_n_of_k" ShelleyEra where huddleGroup p = diff --git a/hie.yaml b/hie.yaml index 000c310f491..23939101a5c 100644 --- a/hie.yaml +++ b/hie.yaml @@ -27,6 +27,15 @@ cradle: - path: "eras/alonzo/impl/src" component: "lib:cardano-ledger-alonzo" + - path: "eras/alonzo/impl/cddl/lib" + component: "cardano-ledger-alonzo:lib:cddl" + + - path: "eras/alonzo/impl/cddl/exe/Main.hs" + component: "cardano-ledger-alonzo:exe:generate-cddl" + + - path: "eras/alonzo/impl/cddl/exe/Paths_cardano_ledger_alonzo.hs" + component: "cardano-ledger-alonzo:exe:generate-cddl" + - path: "eras/alonzo/impl/testlib" component: "cardano-ledger-alonzo:lib:testlib" @@ -54,6 +63,15 @@ cradle: - path: "eras/babbage/impl/src" component: "lib:cardano-ledger-babbage" + - path: "eras/babbage/impl/cddl/lib" + component: "cardano-ledger-babbage:lib:cddl" + + - path: "eras/babbage/impl/cddl/exe/Main.hs" + component: "cardano-ledger-babbage:exe:generate-cddl" + + - path: "eras/babbage/impl/cddl/exe/Paths_cardano_ledger_babbage.hs" + component: "cardano-ledger-babbage:exe:generate-cddl" + - path: "eras/babbage/impl/testlib" component: "cardano-ledger-babbage:lib:testlib" @@ -144,6 +162,15 @@ cradle: - path: "eras/mary/impl/src" component: "lib:cardano-ledger-mary" + - path: "eras/mary/impl/cddl/lib" + component: "cardano-ledger-mary:lib:cddl" + + - path: "eras/mary/impl/cddl/exe/Main.hs" + component: "cardano-ledger-mary:exe:generate-cddl" + + - path: "eras/mary/impl/cddl/exe/Paths_cardano_ledger_mary.hs" + component: "cardano-ledger-mary:exe:generate-cddl" + - path: "eras/mary/impl/testlib" component: "cardano-ledger-mary:lib:testlib" diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md index 8babe05fa77..67d85814d0a 100644 --- a/libs/cardano-ledger-core/CHANGELOG.md +++ b/libs/cardano-ledger-core/CHANGELOG.md @@ -64,6 +64,7 @@ ### `cddl` +* Export `Era` to reuse via the import chain of modules across eras. * Add `HuddleRule`, `HuddleGroup` and `HuddleGRule` type class for era-polymorphic CDDL generation. * Add `HuddleSpec` for all common CDDL types. diff --git a/libs/cardano-ledger-core/cddl/Cardano/Ledger/Core/HuddleSpec.hs b/libs/cardano-ledger-core/cddl/Cardano/Ledger/Core/HuddleSpec.hs index 1e749d448e6..82d032f1b20 100644 --- a/libs/cardano-ledger-core/cddl/Cardano/Ledger/Core/HuddleSpec.hs +++ b/libs/cardano-ledger-core/cddl/Cardano/Ledger/Core/HuddleSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MonoLocalBinds #-} @@ -13,9 +14,11 @@ module Cardano.Ledger.Core.HuddleSpec where -import Cardano.Ledger.Core (Era) +import Cardano.Ledger.BaseTypes (getVersion) +import Cardano.Ledger.Core (ByronEra, eraProtVerHigh, eraProtVerLow) import Cardano.Ledger.Huddle import Codec.CBOR.Cuddle.Huddle +import Data.Proxy (Proxy (..)) import qualified Data.Text as T import Data.Word (Word64) import Text.Heredoc @@ -263,3 +266,9 @@ instance Era era => HuddleRule "ipv4" era where instance Era era => HuddleRule "ipv6" era where huddleRule _ = "ipv6" =:= VBytes `sized` (16 :: Word64) + +majorProtocolVersionRule :: forall era. Era era => Proxy era -> Rule +majorProtocolVersionRule _ = + "major_protocol_version" + =:= getVersion @Integer (eraProtVerLow @ByronEra) + ... succ (getVersion @Integer (eraProtVerHigh @era)) diff --git a/libs/cardano-ledger-core/cddl/Cardano/Ledger/Huddle.hs b/libs/cardano-ledger-core/cddl/Cardano/Ledger/Huddle.hs index 6b5a3f6f359..cb5f79b4bc0 100644 --- a/libs/cardano-ledger-core/cddl/Cardano/Ledger/Huddle.hs +++ b/libs/cardano-ledger-core/cddl/Cardano/Ledger/Huddle.hs @@ -11,6 +11,7 @@ module Cardano.Ledger.Huddle ( HuddleRule (..), HuddleGroup (..), HuddleGRule (..), + Era, ) where import Cardano.Ledger.Core (Era)