diff --git a/eras/allegra/impl/cardano-ledger-allegra.cabal b/eras/allegra/impl/cardano-ledger-allegra.cabal index 13fe43a79d8..1ca4014e98b 100644 --- a/eras/allegra/impl/cardano-ledger-allegra.cabal +++ b/eras/allegra/impl/cardano-ledger-allegra.cabal @@ -84,6 +84,7 @@ library testlib exposed-modules: Test.Cardano.Ledger.Allegra.Arbitrary Test.Cardano.Ledger.Allegra.Binary.Cddl + Test.Cardano.Ledger.Allegra.CDDL Test.Cardano.Ledger.Allegra.Imp Test.Cardano.Ledger.Allegra.Imp.UtxowSpec Test.Cardano.Ledger.Allegra.ImpTest @@ -107,6 +108,7 @@ library testlib cardano-ledger-shelley:{cardano-ledger-shelley, testlib}, cardano-strict-containers, containers, + cuddle, generic-random, microlens, mtl, @@ -114,6 +116,21 @@ library testlib text, QuickCheck +executable huddle-cddl + main-is: Main.hs + hs-source-dirs: huddle-cddl + other-modules: Paths_cardano_ledger_allegra + default-language: Haskell2010 + ghc-options: + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints -Wpartial-fields + -Wunused-packages -threaded -rtsopts -with-rtsopts=-N + + build-depends: + base, + testlib, + cardano-ledger-binary:testlib >=1.3.4.0 + test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs diff --git a/eras/allegra/impl/cddl-files/allegra.cddl b/eras/allegra/impl/cddl-files/allegra.cddl index 18e8c8b3cca..82fe695d450 100644 --- a/eras/allegra/impl/cddl-files/allegra.cddl +++ b/eras/allegra/impl/cddl-files/allegra.cddl @@ -1,277 +1,266 @@ -block = - [ header - , transaction_bodies : [* transaction_body] - , transaction_witness_sets : [* transaction_witness_set] - , auxiliary_data_set : - { * transaction_index => auxiliary_data } - ]; 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 - -transaction = - [ transaction_body - , transaction_witness_set - , auxiliary_data / null - ] +; This file was auto-generated from huddle. Please do not modify it directly! +; Pseudo-rule introduced by Cuddle to collect root elements +huddle_root_defs = [block, transaction] -transaction_index = uint .size 2 +$hash28 = bytes .size 28 -header = - [ header_body - , body_signature : $kes_signature - ] - -header_body = - [ block_number : uint - , slot : uint - , prev_hash : $hash32 / null - , issuer_vkey : $vkey - , vrf_vkey : $vrf_vkey - , nonce_vrf : $vrf_cert - , leader_vrf : $vrf_cert - , block_body_size : uint - , block_body_hash : $hash32 ; merkle triple root - , operational_cert - , protocol_version - ] - -operational_cert = - ( hot_vkey : $kes_vkey - , sequence_number : uint - , kes_period : uint - , sigma : $signature - ) - -next_major_protocol_version = 5 - -major_protocol_version = 1..next_major_protocol_version +$hash32 = bytes .size 32 -protocol_version = (major_protocol_version, uint) +$kes_signature = bytes .size 448 + +$kes_vkey = bytes .size 32 + +$signature = bytes .size 64 + +$vkey = bytes .size 32 -transaction_input = [ transaction_id : $hash32 - , index : uint - ] +$vrf_cert = [bytes, bytes .size 80] + +$vrf_vkey = bytes .size 32 + +addr_keyhash = $hash28 ; address = bytes -; reward_account = bytes - -; address format: -; [ 8 bit header | payload ]; -; -; shelley payment addresses: -; bit 7: 0 -; bit 6: base/other -; bit 5: pointer/enterprise [for base: stake cred is keyhash/scripthash] -; bit 4: payment cred is keyhash/scripthash -; bits 3-0: network id -; -; reward addresses: -; bits 7-5: 111 -; bit 4: credential is keyhash/scripthash -; bits 3-0: network id -; -; byron addresses: -; bits 7-4: 1000 - -; 0000: base address: keyhash28,keyhash28 -; 0001: base address: scripthash28,keyhash28 -; 0010: base address: keyhash28,scripthash28 -; 0011: base address: scripthash28,scripthash28 -; 0100: pointer address: keyhash28, 3 variable length uint -; 0101: pointer address: scripthash28, 3 variable length uint -; 0110: enterprise address: keyhash28 -; 0111: enterprise address: scripthash28 -; 1000: byron address -; 1110: reward account: keyhash28 -; 1111: reward account: scripthash28 -; 1001 - 1101: future formats - -certificate = - [ stake_registration - // stake_deregistration - // stake_delegation - // pool_registration - // pool_retirement - // genesis_key_delegation - // move_instantaneous_rewards_cert - ] +; reward_account = bytes +; +; address format: +; [ 8 bit header | payload ]; +; +; shelley payment addresses: +; bit 7: 0 +; bit 6: base/other +; bit 5: pointer/enterprise [for base: stake cred is keyhash/scripthash] +; bit 4: payment cred is keyhash/scripthash +; bits 3-0: network id +; +; reward addresses: +; bits 7-5: 111 +; bit 4: credential is keyhash/scripthash +; bits 3-0: network id +; +; byron addresses: +; bits 7-4: 1000 +; +; 0000: base address: keyhash28,keyhash28 +; 0001: base address: scripthash28,keyhash28 +; 0010: base address: keyhash28,scripthash28 +; 0011: base address: scripthash28,scripthash28 +; 0100: pointer address: keyhash28, 3 variable length uint +; 0101: pointer address: scripthash28, 3 variable length uint +; 0110: enterprise address: keyhash28 +; 0111: enterprise address: scripthash28 +; 1000: byron address +; 1110: reward account: keyhash28 +; 1111: reward account: scripthash28 +; 1001 - 1101: future formats +address = h'001000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000' + / h'102000000000000000000000000000000000000000000000000000000022000000000000000000000000000000000000000000000000000000' + / h'203000000000000000000000000000000000000000000000000000000033000000000000000000000000000000000000000000000000000000' + / h'304000000000000000000000000000000000000000000000000000000044000000000000000000000000000000000000000000000000000000' + / h'405000000000000000000000000000000000000000000000000000000087680203' + / h'506000000000000000000000000000000000000000000000000000000087680203' + / h'6070000000000000000000000000000000000000000000000000000000' + / h'7080000000000000000000000000000000000000000000000000000000' + +auxiliary_data = {* transaction_metadatum_label => transaction_metadatum} + / [transaction_metadata : {* transaction_metadatum_label => transaction_metadatum}, + auxiliary_scripts : [* native_script]] + +block = [header, + transaction_bodies : [* transaction_body], + transaction_witness_sets : [* transaction_witness_set], + auxiliary_data_set : {* transaction_index => auxiliary_data}] + +bootstrap_witness = [public_key : $vkey, + signature : $signature, + chain_code : bytes .size 32, + attributes : bytes] + +certificate = [stake_registration // + stake_deregistration // + stake_delegation // + pool_registration // + pool_retirement // + genesis_key_delegation // + move_instantaneous_rewards_cert] -stake_registration = (0, stake_credential) -stake_deregistration = (1, stake_credential) -stake_delegation = (2, stake_credential, pool_keyhash) -pool_registration = (3, pool_params) -pool_retirement = (4, pool_keyhash, epoch) -genesis_key_delegation = (5, genesishash, genesis_delegate_hash, vrf_keyhash) -move_instantaneous_rewards_cert = (6, move_instantaneous_reward) +coin = uint -move_instantaneous_reward = [ 0 / 1, { * stake_credential => coin } ] -; The first field determines where the funds are drawn from. -; 0 denotes the reserves, 1 denotes the treasury. - -stake_credential = - [ 0, addr_keyhash - // 1, scripthash - ] - -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 / null - ) +dns_name = text .size (0 .. 64) + +epoch = uint + +genesis_delegate_hash = $hash28 + +genesishash = $hash28 + +header = [header_body, body_signature : $kes_signature] + +header_body = [block_number : uint, + slot : uint, + prev_hash : $hash32 / nil, + issuer_vkey : $vkey, + vrf_vkey : $vrf_vkey, + nonce_vrf : $vrf_cert, + leader_vrf : $vrf_cert, + block_body_size : uint .size 4, + block_body_hash : $hash32, + operational_cert, + protocol_version] + +int64 = -9223372036854775808 .. 9223372036854775807 -port = uint .le 65535 ipv4 = bytes .size 4 + ipv6 = bytes .size 16 -dns_name = tstr .size (0..64) - -single_host_addr = ( 0 - , port / null - , ipv4 / null - , ipv6 / null - ) -single_host_name = ( 1 - , port / null - , dns_name ; An A or AAAA DNS record - ) -multi_host_name = ( 2 - , dns_name ; A SRV DNS record - ) -relay = - [ single_host_addr - // single_host_name - // multi_host_name - ] + +major_protocol_version = 1 .. 3 + +metadata_hash = $hash32 + +move_instantaneous_reward = [0 / 1, {* stake_credential => coin}] + +; Timelock validity intervals are half-open intervals [a, b). +native_script = [script_pubkey // + script_all // + script_any // + script_n_of_k // + invalid_before // + invalid_hereafter] + +nonce = [0 // + 1, bytes .size 32] + +nonnegative_interval = #6.30([uint, positive_int]) + +pool_keyhash = $hash28 pool_metadata = [url, metadata_hash] -url = tstr .size (0..64) - -withdrawals = { * reward_account => coin } - -update = [ proposed_protocol_parameter_updates - , epoch - ] - -proposed_protocol_parameter_updates = - { * genesishash => protocol_param_update } - -protocol_param_update = - { ? 0: uint ; minfee A - , ? 1: uint ; minfee B - , ? 2: uint ; max block body size - , ? 3: uint ; max transaction size - , ? 4: uint ; max block header size - , ? 5: coin ; key deposit - , ? 6: coin ; pool deposit - , ? 7: epoch ; maximum epoch - , ? 8: uint ; 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 ; d. decentralization constant - , ? 13: $nonce ; extra entropy - , ? 14: [protocol_version] ; protocol version - , ? 15: coin ; min utxo value - } - -transaction_witness_set = - { ? 0: [* vkeywitness ] - , ? 1: [* native_script ] - , ? 2: [* bootstrap_witness ] - ; In the future, new kinds of witnesses can be added like this: - ; , ? 4: [* foo_script ] - ; , ? 5: [* plutus_script ] - } - -transaction_metadatum = - { * transaction_metadatum => transaction_metadatum } - / [ * transaction_metadatum ] - / int - / bytes .size (0..64) - / text .size (0..64) + +port = uint .le 65535 + +positive_int = 1 .. 18446744073709551615 + +proposed_protocol_parameter_updates = {* genesishash => protocol_param_update} + +protocol_param_update = {? 0 : uint, + ? 1 : uint, + ? 2 : uint, + ? 3 : uint, + ? 4 : uint .size 2, + ? 5 : coin, + ? 6 : coin, + ? 7 : epoch, + ? 8 : uint, + ? 9 : nonnegative_interval, + ? 10 : unit_interval, + ? 11 : unit_interval, + ? 12 : unit_interval, + ? 13 : nonce, + ? 14 : [protocol_version], + ? 15 : coin} + +relay = [single_host_addr // + single_host_name // + multi_host_name] + +reward_account = h'E090000000000000000000000000000000000000000000000000000000' + / h'F0A0000000000000000000000000000000000000000000000000000000' + +scripthash = $hash28 + +stake_credential = [0, addr_keyhash // + 1, scripthash] + +transaction = [transaction_body, transaction_witness_set, auxiliary_data / nil] + +; Allegra transaction body adds the validity interval start at index 8 +transaction_body = {0 : set, + 1 : [* transaction_output], + 2 : coin, + 3 : uint, + ? 4 : [* certificate], + ? 5 : withdrawals, + ? 6 : update, + ? 7 : metadata_hash, + ? 8 : uint} + +transaction_index = uint .size 2 + +transaction_input = [transaction_id : $hash32, index : uint] + +transaction_metadatum = {* transaction_metadatum => transaction_metadatum} + / [* transaction_metadatum] + / int + / bytes .size (0 .. 64) + / text .size (0 .. 64) transaction_metadatum_label = uint -auxiliary_data = - { * transaction_metadatum_label => transaction_metadatum } - / [ transaction_metadata: { * transaction_metadatum_label => transaction_metadatum } - , auxiliary_scripts: [ * native_script ] - ; other types of metadata... - ] - -vkeywitness = [ $vkey, $signature ] - -bootstrap_witness = - [ public_key : $vkey - , signature : $signature - , chain_code : bytes .size 32 - , attributes : bytes - ] - -native_script = - [ script_pubkey - // script_all - // script_any - // script_n_of_k - // invalid_before - ; Timelock validity intervals are half-open intervals [a, b). - ; This field specifies the left (included) endpoint a. - // invalid_hereafter - ; Timelock validity intervals are half-open intervals [a, b). - ; This field specifies the right (excluded) endpoint b. - ] +transaction_output = [address, amount : coin] + +transaction_witness_set = {? 0 : [* vkeywitness], + ? 1 : [* native_script], + ? 2 : [* bootstrap_witness]} + +unit_interval = #6.30([1, 2]) + +update = [proposed_protocol_parameter_updates, epoch] + +url = text .size (0 .. 64) + +vkeywitness = [$vkey, $signature] + +vrf_keyhash = $hash32 + +withdrawals = {* reward_account => coin} + +genesis_key_delegation = (5, genesishash, genesis_delegate_hash, vrf_keyhash) -script_pubkey = (0, addr_keyhash) -script_all = (1, [ * native_script ]) -script_any = (2, [ * native_script ]) -script_n_of_k = (3, n: uint, [ * native_script ]) invalid_before = (4, uint) + invalid_hereafter = (5, uint) -coin = uint +move_instantaneous_rewards_cert = (6, move_instantaneous_reward) -multiasset = { * policy_id => { * asset_name => a } } -policy_id = scripthash -asset_name = bytes .size (0..32) +multi_host_name = (2, dns_name) -value = coin / [coin,multiasset] -mint = multiasset +operational_cert = ($kes_vkey, uint, uint, $signature) -int64 = -9223372036854775808 .. 9223372036854775807 +pool_params = (pool_keyhash, + vrf_keyhash, + coin, + coin, + unit_interval, + reward_account, + set, + [* relay], + pool_metadata / nil) -epoch = uint +pool_registration = (3, pool_params) -addr_keyhash = $hash28 -genesis_delegate_hash = $hash28 -pool_keyhash = $hash28 -genesishash = $hash28 - -vrf_keyhash = $hash32 -metadata_hash = $hash32 - -; 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. -; In the Allegra and Mary eras there is only one such tag, -; namely "\x00" for multisig scripts. -scripthash = $hash28 - -; allegra differences -transaction_body = - { 0 : set - , 1 : [* transaction_output] - , 2 : coin ; fee - , ? 3 : uint ; ttl - , ? 4 : [* certificate] - , ? 5 : withdrawals - , ? 6 : update - , ? 7 : metadata_hash - , ? 8 : uint ; validity interval start - } -transaction_output = [address, amount : coin] +pool_retirement = (4, pool_keyhash, epoch) + +protocol_version = (major_protocol_version, uint) + +script_all = (1, [* native_script]) + +script_any = (2, [* native_script]) + +script_n_of_k = (3, int64, [* native_script]) + +script_pubkey = (0, addr_keyhash) + +single_host_addr = (0, port / nil, ipv4 / nil, ipv6 / nil) + +single_host_name = (1, port / nil, dns_name) + +stake_delegation = (2, stake_credential, pool_keyhash) + +; This will be deprecated in a future era +stake_deregistration = (1, stake_credential) + +; This will be deprecated in a future era +stake_registration = (0, stake_credential) + +set = [* a0] diff --git a/eras/allegra/impl/cddl-files/crypto.cddl b/eras/allegra/impl/cddl-files/crypto.cddl deleted file mode 100644 index 339444964d2..00000000000 --- a/eras/allegra/impl/cddl-files/crypto.cddl +++ /dev/null @@ -1,13 +0,0 @@ -$hash28 /= bytes .size 28 -$hash32 /= bytes .size 32 - -$vkey /= bytes .size 32 - -$vrf_vkey /= bytes .size 32 -$vrf_cert /= [bytes, bytes .size 80] - -$kes_vkey /= bytes .size 32 -$kes_signature /= bytes .size 448 -signkeyKES = bytes .size 64 - -$signature /= bytes .size 64 diff --git a/eras/allegra/impl/cddl-files/extras.cddl b/eras/allegra/impl/cddl-files/extras.cddl deleted file mode 100644 index e7fb0b6937e..00000000000 --- a/eras/allegra/impl/cddl-files/extras.cddl +++ /dev/null @@ -1,27 +0,0 @@ -finite_set = [* a] - -set = [* a] - -;unit_interval = #6.30([uint, uint]) -unit_interval = #6.30([1, 2]) - ; real unit_interval is: #6.30([uint, uint]) - ; but this produces numbers outside the unit interval - ; and can also produce a zero in the denominator - -positive_int = 1 .. 18446744073709551615 - -nonnegative_interval = #6.30([uint, positive_int]) - -address = - h'001000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000' / - h'102000000000000000000000000000000000000000000000000000000022000000000000000000000000000000000000000000000000000000' / - h'203000000000000000000000000000000000000000000000000000000033000000000000000000000000000000000000000000000000000000' / - h'304000000000000000000000000000000000000000000000000000000044000000000000000000000000000000000000000000000000000000' / - h'405000000000000000000000000000000000000000000000000000000087680203' / - h'506000000000000000000000000000000000000000000000000000000087680203' / - h'6070000000000000000000000000000000000000000000000000000000' / - h'7080000000000000000000000000000000000000000000000000000000' - -reward_account = - h'E090000000000000000000000000000000000000000000000000000000' / - h'F0A0000000000000000000000000000000000000000000000000000000' diff --git a/eras/allegra/impl/huddle-cddl/Main.hs b/eras/allegra/impl/huddle-cddl/Main.hs new file mode 100644 index 00000000000..f94a9483fa5 --- /dev/null +++ b/eras/allegra/impl/huddle-cddl/Main.hs @@ -0,0 +1,11 @@ +module Main where + +import Paths_cardano_ledger_allegra +import qualified Test.Cardano.Ledger.Allegra.CDDL as Allegra +import Test.Cardano.Ledger.Binary.Cuddle (writeSpec) + +-- Generate cddl files for all relevant specifications +main :: IO () +main = do + specFile <- getDataFileName "cddl-files/allegra.cddl" + writeSpec Allegra.cddl specFile diff --git a/eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/Binary/CddlSpec.hs b/eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/Binary/CddlSpec.hs index 070ddf250e3..c60b64771b5 100644 --- a/eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/Binary/CddlSpec.hs +++ b/eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/Binary/CddlSpec.hs @@ -6,18 +6,29 @@ module Test.Cardano.Ledger.Allegra.Binary.CddlSpec (spec) where import Cardano.Ledger.Allegra (Allegra) import Cardano.Ledger.Core import Test.Cardano.Ledger.Allegra.Binary.Cddl (readAllegraCddlFiles) +import qualified Test.Cardano.Ledger.Allegra.CDDL as AllegraCDDL import Test.Cardano.Ledger.Binary.Cddl ( beforeAllCddlFile, cddlRoundTripAnnCborSpec, cddlRoundTripCborSpec, ) +import Test.Cardano.Ledger.Binary.Cuddle import Test.Cardano.Ledger.Common spec :: Spec -spec = +spec = do describe "CDDL" $ beforeAllCddlFile 3 readAllegraCddlFiles $ do let v = eraProtVerLow @Allegra cddlRoundTripCborSpec @(Value Allegra) v "coin" cddlRoundTripAnnCborSpec @(TxBody Allegra) v "transaction_body" cddlRoundTripAnnCborSpec @(Script Allegra) v "native_script" cddlRoundTripAnnCborSpec @(TxAuxData Allegra) v "auxiliary_data" + newSpec + +newSpec :: Spec +newSpec = describe "Huddle" $ specWithHuddle AllegraCDDL.cddl 100 $ do + let v = eraProtVerHigh @Allegra + huddleRoundTripCborSpec @(Value Allegra) v "coin" + huddleRoundTripAnnCborSpec @(TxBody Allegra) v "transaction_body" + huddleRoundTripAnnCborSpec @(TxAuxData Allegra) v "auxiliary_data" + huddleRoundTripAnnCborSpec @(Script Allegra) v "native_script" diff --git a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Binary/Cddl.hs b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Binary/Cddl.hs index 385866c1e83..24b2eaed7ac 100644 --- a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Binary/Cddl.hs +++ b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Binary/Cddl.hs @@ -9,10 +9,7 @@ import Paths_cardano_ledger_allegra readAllegraCddlFileNames :: IO [FilePath] readAllegraCddlFileNames = do base <- getDataFileName "cddl-files/allegra.cddl" - crypto <- getDataFileName "cddl-files/crypto.cddl" - extras <- getDataFileName "cddl-files/extras.cddl" - -- extras contains the types whose restrictions cannot be expressed in CDDL - pure [base, crypto, extras] + pure [base] readAllegraCddlFiles :: IO [BSL.ByteString] readAllegraCddlFiles = mapM BSL.readFile =<< readAllegraCddlFileNames diff --git a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/CDDL.hs b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/CDDL.hs new file mode 100644 index 00000000000..daca7577b6f --- /dev/null +++ b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/CDDL.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use camelCase" #-} +{-# HLINT ignore "Evaluate" #-} + +module Test.Cardano.Ledger.Allegra.CDDL where + +import Codec.CBOR.Cuddle.Huddle +import Data.Function (($)) +import Test.Cardano.Ledger.Core.Binary.CDDL hiding (set) +import Test.Cardano.Ledger.Shelley.CDDL ( + bootstrap_witness, + certificate, + header, + metadata_hash, + set, + transaction_index, + transaction_input, + transaction_metadatum, + transaction_metadatum_label, + transaction_output, + update, + vkeywitness, + withdrawals, + ) + +cddl :: Huddle +cddl = collectFrom [block, transaction] + +-------------------------------------------------------------------------------- +-- Things changed in Allegra +-------------------------------------------------------------------------------- + +native_script :: Rule +native_script = + comment "Timelock validity intervals are half-open intervals [a, b)." $ + "native_script" + =:= arr [a script_pubkey] + / arr [a script_all] + / arr [a script_any] + / arr [a script_n_of_k] + / arr [a invalid_before] + -- Timelock validity intervals are half-open intervals [a, b). + -- This field specifies the left (included) endpoint a. + / arr [a invalid_hereafter] + +-- Timelock validity intervals are half-open intervals [a, b). +-- This field specifies the right (excluded) endpoint b. + +script_pubkey :: Named Group +script_pubkey = "script_pubkey" =:~ grp [0, a addr_keyhash] + +script_all :: Named Group +script_all = "script_all" =:~ grp [1, a (arr [0 <+ a native_script])] + +script_any :: Named Group +script_any = "script_any" =:~ grp [2, a (arr [0 <+ a native_script])] + +script_n_of_k :: Named Group +script_n_of_k = + "script_n_of_k" + =:~ grp [3, "n" ==> int64, a (arr [0 <+ a native_script])] + +invalid_before :: Named Group +invalid_before = "invalid_before" =:~ grp [4, a VUInt] + +invalid_hereafter :: Named Group +invalid_hereafter = "invalid_hereafter" =:~ grp [5, a VUInt] + +transaction_witness_set :: Rule +transaction_witness_set = + "transaction_witness_set" + =:= mp + [ opt $ idx 0 ==> arr [0 <+ a vkeywitness] + , opt $ idx 1 ==> arr [0 <+ a native_script] + , opt $ idx 2 ==> arr [0 <+ a bootstrap_witness] + ] + +auxiliary_data :: Rule +auxiliary_data = + "auxiliary_data" + =:= smp + [ 0 + <+ asKey transaction_metadatum_label + ==> transaction_metadatum + ] + / sarr + [ "transaction_metadata" + ==> mp + [ 0 + <+ asKey transaction_metadatum_label + ==> transaction_metadatum + ] + , "auxiliary_scripts" ==> arr [0 <+ a native_script] + ] + +transaction_body :: Rule +transaction_body = + comment + "Allegra transaction body adds the validity interval start at index 8" + $ "transaction_body" + =:= mp + [ idx 0 ==> set transaction_input + , idx 1 ==> arr [0 <+ a transaction_output] + , idx 2 ==> coin + , idx 3 ==> VUInt + , opt (idx 4 ==> arr [0 <+ a certificate]) + , opt (idx 5 ==> withdrawals) + , opt (idx 6 ==> update) + , opt (idx 7 ==> metadata_hash) + , opt (idx 8 ==> VUInt) + ] + +-------------------------------------------------------------------------------- +-- Closure +-------------------------------------------------------------------------------- + +block :: Rule +block = + "block" + =:= arr + [ a header + , "transaction_bodies" ==> arr [0 <+ a transaction_body] + , "transaction_witness_sets" + ==> arr [0 <+ a transaction_witness_set] + , "auxiliary_data_set" + ==> mp [0 <+ asKey transaction_index ==> auxiliary_data] + ] + +transaction :: Rule +transaction = + "transaction" + =:= arr + [ a transaction_body + , a transaction_witness_set + , a (auxiliary_data / VNil) + ] diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index 9434a379957..c9309c4fe80 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -143,9 +143,10 @@ library testlib bytestring, cardano-data:{cardano-data, testlib}, containers, - cuddle >=0.3.0.0, + cuddle >=0.3.1.0, plutus-ledger-api, deepseq, + here, microlens, cardano-crypto-class, cardano-ledger-allegra, @@ -155,7 +156,7 @@ library testlib cardano-ledger-conway, cardano-ledger-core:{cardano-ledger-core, testlib}, cardano-ledger-mary, - cardano-ledger-shelley, + cardano-ledger-shelley:{cardano-ledger-shelley, testlib}, cardano-strict-containers, data-default-class, FailT, diff --git a/eras/conway/impl/cddl-files/conway.cddl b/eras/conway/impl/cddl-files/conway.cddl index 2b93b588f8d..60ff200c755 100644 --- a/eras/conway/impl/cddl-files/conway.cddl +++ b/eras/conway/impl/cddl-files/conway.cddl @@ -1,4 +1,12 @@ ; This file was auto-generated from huddle. Please do not modify it directly! +; Pseudo-rule introduced by Cuddle to collect root elements +huddle_root_defs = [block, + transaction, + $kes_signature, + language, + potential_languages, + signkeyKES] + $hash28 = bytes .size 28 $hash32 = bytes .size 32 @@ -17,6 +25,39 @@ $vrf_vkey = bytes .size 32 addr_keyhash = $hash28 +; address = bytes +; reward_account = bytes +; +; address format: +; [ 8 bit header | payload ]; +; +; shelley payment addresses: +; bit 7: 0 +; bit 6: base/other +; bit 5: pointer/enterprise [for base: stake cred is keyhash/scripthash] +; bit 4: payment cred is keyhash/scripthash +; bits 3-0: network id +; +; reward addresses: +; bits 7-5: 111 +; bit 4: credential is keyhash/scripthash +; bits 3-0: network id +; +; byron addresses: +; bits 7-4: 1000 +; +; 0000: base address: keyhash28,keyhash28 +; 0001: base address: scripthash28,keyhash28 +; 0010: base address: keyhash28,scripthash28 +; 0011: base address: scripthash28,scripthash28 +; 0100: pointer address: keyhash28, 3 variable length uint +; 0101: pointer address: scripthash28, 3 variable length uint +; 0110: enterprise address: keyhash28 +; 0111: enterprise address: scripthash28 +; 1000: byron address +; 1110: reward account: keyhash28 +; 1111: reward account: scripthash28 +; 1001 - 1101: future formats address = h'001000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000' / h'102000000000000000000000000000000000000000000000000000000022000000000000000000000000000000000000000000000000000000' / h'203000000000000000000000000000000000000000000000000000000033000000000000000000000000000000000000000000000000000000' @@ -30,18 +71,14 @@ anchor = [anchor_url : url, anchor_data_hash : $hash32] asset_name = bytes .size (0 .. 32) -auth_committee_hot_cert = (14 - , committee_cold_credential - , committee_hot_credential) - auxiliary_data = metadata - / [transaction_metadata : metadata - , auxiliary_scripts : [* native_script]] - / #6.259({? 0 : metadata - , ? 1 : [* native_script] - , ? 2 : [* plutus_v1_script] - , ? 3 : [* plutus_v2_script] - , ? 4 : [* plutus_v3_script]}) + / [transaction_metadata : metadata, + auxiliary_scripts : [* native_script]] + / #6.259({? 0 : metadata, + ? 1 : [* native_script], + ? 2 : [* plutus_v1_script], + ? 3 : [* plutus_v2_script], + ? 4 : [* plutus_v3_script]}) auxiliary_data_hash = $hash32 @@ -51,38 +88,43 @@ big_nint = #6.3(bounded_bytes) big_uint = #6.2(bounded_bytes) -block = [header - , transaction_bodies : [* transaction_body] - , transaction_witness_sets : [* transaction_witness_set] - , auxiliary_data_set : {* transaction_index => auxiliary_data} - , invalid_transactions : [* transaction_index]] +; 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 = [header, + transaction_bodies : [* transaction_body], + transaction_witness_sets : [* transaction_witness_set], + auxiliary_data_set : {* transaction_index => auxiliary_data}, + invalid_transactions : [* transaction_index]] block_no = uint .size 8 -bootstrap_witness = [public_key : $vkey - , signature : $signature - , chain_code : bytes .size 32 - , attributes : bytes] +bootstrap_witness = [public_key : $vkey, + signature : $signature, + chain_code : bytes .size 32, + attributes : bytes] bounded_bytes = bytes .size (0 .. 64) -certificate = [stake_registration - // stake_deregistration - // stake_delegation - // pool_registration - // pool_retirement - // reg_cert - // unreg_cert - // vote_deleg_cert - // stake_vote_deleg_cert - // stake_reg_deleg_cert - // vote_reg_deleg_cert - // stake_vote_reg_deleg_cert - // auth_committee_hot_cert - // resign_committee_cold_cert - // reg_drep_cert - // unreg_drep_cert - // update_drep_cert] +certificate = [stake_registration // + stake_deregistration // + stake_delegation // + pool_registration // + pool_retirement // + reg_cert // + unreg_cert // + vote_deleg_cert // + stake_vote_deleg_cert // + stake_reg_deleg_cert // + vote_reg_deleg_cert // + stake_vote_reg_deleg_cert // + auth_committee_hot_cert // + resign_committee_cold_cert // + reg_drep_cert // + unreg_drep_cert // + update_drep_cert] certificates = nonempty_set @@ -94,29 +136,22 @@ committee_hot_credential = credential constitution = [anchor, scripthash / nil] -constr = #6.121([* a0]) - / #6.122([* a0]) - / #6.123([* a0]) - / #6.124([* a0]) - / #6.125([* a0]) - / #6.126([* a0]) - / #6.127([* a0]) - / #6.102([uint, [* a0]]) - ; The format for costmdls is flexible enough to allow adding Plutus ; built-ins and language versions in the future. -costmdls = {? 0 : [* int64] - , ? 1 : [* int64] - , ? 2 : [* int64] - , * 3 .. 255 => [* int64]} +costmdls = {? 0 : [* int64], + ? 1 : [* int64], + ? 2 : [* int64], + * 3 .. 255 => [* int64]} -credential = [0, addr_keyhash // 1, scripthash] +credential = [0, addr_keyhash // + 1, scripthash] data = #6.24(bytes .cbor plutus_data) datum_hash = $hash32 -datum_option = [0, $hash32 // 1, data] +datum_option = [0, $hash32 // + 1, data] distinct_VBytes = bytes .size 8 / bytes .size 16 @@ -127,63 +162,60 @@ distinct_VBytes = bytes .size 8 dns_name = text .size (0 .. 128) -drep = [0, addr_keyhash // 1, scripthash // 2 // 3] +drep = [0, addr_keyhash // + 1, scripthash // + 2 // + 3] drep_credential = credential -drep_voting_thresholds = [unit_interval - , unit_interval - , unit_interval - , unit_interval - , unit_interval - , unit_interval - , unit_interval - , unit_interval - , unit_interval - , unit_interval] +drep_voting_thresholds = [unit_interval, + unit_interval, + unit_interval, + unit_interval, + unit_interval, + unit_interval, + unit_interval, + unit_interval, + unit_interval, + unit_interval] epoch_interval = uint .size 4 epoch_no = uint .size 8 -ex_unit_prices = [mem_price : nonnegative_interval - , step_price : nonnegative_interval] +ex_unit_prices = [mem_price : nonnegative_interval, + step_price : nonnegative_interval] ex_units = [mem : uint, steps : uint] -gov_action = [parameter_change_action - // hard_fork_initiation_action - // treasury_withdrawals_action - // no_confidence - // update_committee - // new_constitution - // info_action] +gov_action = [parameter_change_action // + hard_fork_initiation_action // + treasury_withdrawals_action // + no_confidence // + update_committee // + new_constitution // + info_action] gov_action_id = [transaction_id : $hash32, gov_action_index : uint .size 2] -hard_fork_initiation_action = (1, gov_action_id / nil, protocol_version) - header = [header_body, body_signature : $kes_signature] -header_body = [block_number : block_no - , slot : slot_no - , prev_hash : $hash32 / nil - , issuer_vkey : $vkey - , vrf_vkey : $vrf_vkey - , vrf_result : $vrf_cert - , block_body_size : uint .size 4 - , block_body_hash : $hash32 - , operational_cert - , protocol_version] +header_body = [block_number : block_no, + slot : slot_no, + prev_hash : $hash32 / nil, + issuer_vkey : $vkey, + vrf_vkey : $vrf_vkey, + vrf_result : $vrf_cert, + block_body_size : uint .size 4, + block_body_hash : $hash32, + operational_cert, + protocol_version] info_action = 6 int64 = -9223372036854775808 .. 9223372036854775807 -invalid_before = (4, slot_no) - -invalid_hereafter = (5, slot_no) - ipv4 = bytes .size 4 ipv6 = bytes .size 16 @@ -196,40 +228,25 @@ metadata = {* transaction_metadatum_label => transaction_metadatum} mint = multiasset -multi_host_name = (2, dns_name) - -multiasset = {+ policy_id => {+ asset_name => a0}} - -native_script = [script_pubkey - // script_all - // script_any - // script_n_of_k - // invalid_before - // invalid_hereafter] +native_script = [script_pubkey // + script_all // + script_any // + script_n_of_k // + invalid_before // + invalid_hereafter] negInt64 = -9223372036854775808 .. -1 network_id = 0 / 1 -new_constitution = (5, gov_action_id / nil, constitution) - -no_confidence = (3, gov_action_id / nil) - nonZeroInt64 = negInt64 / posInt64 -nonempty_set = #6.258([+ a0]) / [+ a0] - nonnegative_interval = #6.30([uint, positive_int]) -operational_cert = [hot_vkey : $kes_vkey - , sequence_number : uint .size 8 - , kes_period : uint - , sigma : $signature] - -parameter_change_action = (0 - , gov_action_id / nil - , protocol_param_update - , policy_hash / nil) +operational_cert = [hot_vkey : $kes_vkey, + sequence_number : uint .size 8, + kes_period : uint, + sigma : $signature] plutus_data = constr / {* plutus_data => plutus_data} @@ -258,25 +275,11 @@ pool_metadata = [url, pool_metadata_hash] pool_metadata_hash = $hash32 -pool_params = (pool_keyhash - , vrf_keyhash - , coin - , coin - , unit_interval - , reward_account - , set - , [* relay] - , pool_metadata / nil) - -pool_registration = (3, pool_params) - -pool_retirement = (4, pool_keyhash, epoch_no) - -pool_voting_thresholds = [unit_interval - , unit_interval - , unit_interval - , unit_interval - , unit_interval] +pool_voting_thresholds = [unit_interval, + unit_interval, + unit_interval, + unit_interval, + unit_interval] port = uint .le 65535 @@ -286,51 +289,51 @@ positive_coin = 1 .. 18446744073709551615 positive_int = 1 .. 18446744073709551615 -post_alonzo_transaction_output = {0 : address - , 1 : value - , ? 2 : datum_option - , ? 3 : script_ref} +post_alonzo_transaction_output = {0 : address, + 1 : value, + ? 2 : datum_option, + ? 3 : script_ref} potential_languages = 0 .. 255 -pre_babbage_transaction_output = [address - , amount : value - , ? datum_hash : datum_hash] +pre_babbage_transaction_output = [address, + amount : value, + ? datum_hash : datum_hash] proposal_procedure = [deposit : coin, reward_account, gov_action, anchor] proposal_procedures = nonempty_set -protocol_param_update = {? 0 : coin - , ? 1 : coin - , ? 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 - , ? 16 : coin - , ? 17 : coin - , ? 18 : costmdls - , ? 19 : ex_unit_prices - , ? 20 : ex_units - , ? 21 : ex_units - , ? 22 : uint .size 4 - , ? 23 : uint .size 2 - , ? 24 : uint .size 2 - , ? 25 : pool_voting_thresholds - , ? 26 : drep_voting_thresholds - , ? 27 : uint .size 2 - , ? 28 : epoch_interval - , ? 29 : epoch_interval - , ? 30 : coin - , ? 31 : coin - , ? 32 : epoch_interval - , ? 33 : nonnegative_interval} +protocol_param_update = {? 0 : coin, + ? 1 : coin, + ? 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, + ? 16 : coin, + ? 17 : coin, + ? 18 : costmdls, + ? 19 : ex_unit_prices, + ? 20 : ex_units, + ? 21 : ex_units, + ? 22 : uint .size 4, + ? 23 : uint .size 2, + ? 24 : uint .size 2, + ? 25 : pool_voting_thresholds, + ? 26 : drep_voting_thresholds, + ? 27 : uint .size 2, + ? 28 : epoch_interval, + ? 29 : epoch_interval, + ? 30 : coin, + ? 31 : coin, + ? 32 : epoch_interval, + ? 33 : nonnegative_interval} protocol_version = [major_protocol_version, uint] @@ -338,42 +341,96 @@ redeemer_tag = 0 / 1 / 2 / 3 / 4 / 5 ; 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 = [+ [tag : redeemer_tag - , index : uint .size 4 - , data : plutus_data - , ex_units : ex_units]] - / {+ [tag : redeemer_tag - , index : uint .size 4] => [data : plutus_data - , ex_units : ex_units]} - -reg_cert = (7, stake_credential, coin) - -reg_drep_cert = (16, drep_credential, coin, anchor / nil) - -relay = [single_host_addr // single_host_name // multi_host_name] +redeemers = [+ [tag : redeemer_tag, + index : uint .size 4, + data : plutus_data, + ex_units : ex_units]] + / {+ [tag : redeemer_tag, + index : uint .size 4] => [data : plutus_data, + ex_units : ex_units]} + +relay = [single_host_addr // + single_host_name // + multi_host_name] required_signers = nonempty_set -resign_committee_cold_cert = (15, committee_cold_credential, anchor / nil) - reward_account = h'E090000000000000000000000000000000000000000000000000000000' / h'F0A0000000000000000000000000000000000000000000000000000000' -script = [0, native_script - // 1, plutus_v1_script - // 2, plutus_v2_script - // 3, plutus_v3_script] - -script_all = (1, [* native_script]) - -script_any = (2, [* native_script]) - +script = [0, native_script // + 1, plutus_v1_script // + 2, plutus_v2_script // + 3, plutus_v3_script] + +; 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. +; For PlutusV3 (language id 2), the language view is the following: +; - the value of costmdls 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 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): +; [ 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. script_data_hash = $hash32 -script_n_of_k = (3, int64, [* native_script]) - -script_pubkey = (0, addr_keyhash) - script_ref = #6.24(bytes .cbor script) ; To compute a script hash, note that you must prepend @@ -387,57 +444,37 @@ script_ref = #6.24(bytes .cbor script) ; scripthash = $hash28 -set = #6.258([* a0]) / [* a0] - signkeyKES = bytes .size 64 -single_host_addr = (0, port / nil, ipv4 / nil, ipv6 / nil) - -single_host_name = (1, port / nil, dns_name) - slot_no = uint .size 8 stake_credential = credential -stake_delegation = (2, stake_credential, pool_keyhash) - -; This will be deprecated in a future era -stake_deregistration = (1, stake_credential) - -stake_reg_deleg_cert = (11, stake_credential, pool_keyhash, coin) - -; This will be deprecated in a future era -stake_registration = (0, stake_credential) - -stake_vote_deleg_cert = (10, stake_credential, pool_keyhash, drep) - -stake_vote_reg_deleg_cert = (13, stake_credential, pool_keyhash, drep, coin) - -transaction = [transaction_body - , transaction_witness_set - , bool - , auxiliary_data / nil] - -transaction_body = {0 : set - , 1 : [* transaction_output] - , 2 : coin - , ? 3 : slot_no - , ? 4 : certificates - , ? 5 : withdrawals - , ? 7 : auxiliary_data_hash - , ? 8 : slot_no - , ? 9 : mint - , ? 11 : script_data_hash - , ? 13 : nonempty_set - , ? 14 : required_signers - , ? 15 : network_id - , ? 16 : transaction_output - , ? 17 : coin - , ? 18 : nonempty_set - , ? 19 : voting_procedures - , ? 20 : proposal_procedures - , ? 21 : coin - , ? 22 : positive_coin} +transaction = [transaction_body, + transaction_witness_set, + bool, + auxiliary_data / nil] + +transaction_body = {0 : set, + 1 : [* transaction_output], + 2 : coin, + ? 3 : slot_no, + ? 4 : certificates, + ? 5 : withdrawals, + ? 7 : auxiliary_data_hash, + ? 8 : slot_no, + ? 9 : mint, + ? 11 : script_data_hash, + ? 13 : nonempty_set, + ? 14 : required_signers, + ? 15 : network_id, + ? 16 : transaction_output, + ? 17 : coin, + ? 18 : nonempty_set, + ? 19 : voting_procedures, + ? 20 : proposal_procedures, + ? 21 : coin, + ? 22 : positive_coin} transaction_index = uint .size 2 @@ -451,34 +488,22 @@ transaction_metadatum = {* transaction_metadatum => transaction_metadatum} transaction_metadatum_label = uint .size 8 +; Both of the Alonzo and Babbage style TxOut formats are equally valid +; and can be used interchangeably transaction_output = pre_babbage_transaction_output / post_alonzo_transaction_output -transaction_witness_set = {? 0 : nonempty_set - , ? 1 : nonempty_set - , ? 2 : nonempty_set - , ? 3 : nonempty_set - , ? 4 : nonempty_set - , ? 5 : redeemers - , ? 6 : nonempty_set - , ? 7 : nonempty_set} - -treasury_withdrawals_action = (2, {reward_account => coin}, policy_hash / nil) +transaction_witness_set = {? 0 : nonempty_set, + ? 1 : nonempty_set, + ? 2 : nonempty_set, + ? 3 : nonempty_set, + ? 4 : nonempty_set, + ? 5 : redeemers, + ? 6 : nonempty_set, + ? 7 : nonempty_set} unit_interval = #6.30([1, 2]) -unreg_cert = (8, stake_credential, coin) - -unreg_drep_cert = (17, drep_credential, coin) - -update_committee = (4 - , gov_action_id / nil - , set - , {committee_cold_credential => epoch_no} - , unit_interval) - -update_drep_cert = (18, drep_credential, anchor / nil) - url = text .size (0 .. 128) value = coin / [coin, multiasset] @@ -487,15 +512,16 @@ vkeywitness = [$vkey, $signature] vote = 0 .. 2 -vote_deleg_cert = (9, stake_credential, drep) - -vote_reg_deleg_cert = (12, stake_credential, drep, coin) - -voter = [0, addr_keyhash - // 1, scripthash - // 2, addr_keyhash - // 3, scripthash - // 4, addr_keyhash] +; Constitutional Committee Hot KeyHash: 0 +; Constitutional Committee Hot ScriptHash: 1 +; DRep KeyHash: 2 +; DRep ScriptHash: 3 +; StakingPool KeyHash: 4 +voter = [0, addr_keyhash // + 1, scripthash // + 2, addr_keyhash // + 3, scripthash // + 4, addr_keyhash] voting_procedure = [vote, anchor / nil] @@ -504,3 +530,103 @@ voting_procedures = {+ voter => {+ gov_action_id => voting_procedure}} vrf_keyhash = $hash32 withdrawals = {+ reward_account => coin} + +auth_committee_hot_cert = (14, + committee_cold_credential, + committee_hot_credential) + +hard_fork_initiation_action = (1, gov_action_id / nil, protocol_version) + +invalid_before = (4, slot_no) + +invalid_hereafter = (5, slot_no) + +multi_host_name = (2, dns_name) + +new_constitution = (5, gov_action_id / nil, constitution) + +no_confidence = (3, gov_action_id / nil) + +parameter_change_action = (0, + gov_action_id / nil, + protocol_param_update, + policy_hash / nil) + +pool_params = (pool_keyhash, + vrf_keyhash, + coin, + coin, + unit_interval, + reward_account, + set, + [* relay], + pool_metadata / nil) + +pool_registration = (3, pool_params) + +pool_retirement = (4, pool_keyhash, epoch_no) + +reg_cert = (7, stake_credential, coin) + +reg_drep_cert = (16, drep_credential, coin, anchor / nil) + +resign_committee_cold_cert = (15, committee_cold_credential, anchor / nil) + +script_all = (1, [* native_script]) + +script_any = (2, [* native_script]) + +script_n_of_k = (3, int64, [* native_script]) + +script_pubkey = (0, addr_keyhash) + +single_host_addr = (0, port / nil, ipv4 / nil, ipv6 / nil) + +single_host_name = (1, port / nil, dns_name) + +stake_delegation = (2, stake_credential, pool_keyhash) + +; This will be deprecated in a future era +stake_deregistration = (1, stake_credential) + +stake_reg_deleg_cert = (11, stake_credential, pool_keyhash, coin) + +; This will be deprecated in a future era +stake_registration = (0, stake_credential) + +stake_vote_deleg_cert = (10, stake_credential, pool_keyhash, drep) + +stake_vote_reg_deleg_cert = (13, stake_credential, pool_keyhash, drep, coin) + +treasury_withdrawals_action = (2, {reward_account => coin}, policy_hash / nil) + +unreg_cert = (8, stake_credential, coin) + +unreg_drep_cert = (17, drep_credential, coin) + +update_committee = (4, + gov_action_id / nil, + set, + {committee_cold_credential => epoch_no}, + unit_interval) + +update_drep_cert = (18, drep_credential, anchor / nil) + +vote_deleg_cert = (9, stake_credential, drep) + +vote_reg_deleg_cert = (12, stake_credential, drep, coin) + +constr = #6.121([* a0]) + / #6.122([* a0]) + / #6.123([* a0]) + / #6.124([* a0]) + / #6.125([* a0]) + / #6.126([* a0]) + / #6.127([* a0]) + / #6.102([uint, [* a0]]) + +multiasset = {+ policy_id => {+ asset_name => a0}} + +nonempty_set = #6.258([+ a0]) / [+ a0] + +set = #6.258([* a0]) / [* a0] diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs index 1711f9a7313..fd30e2e6a4f 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} @@ -12,10 +13,18 @@ module Test.Cardano.Ledger.Conway.CDDL (conway) where import Codec.CBOR.Cuddle.Huddle import Data.Function (($)) import Data.Semigroup ((<>)) -import Data.Text qualified as T +import Data.String.Here (here) import Data.Word (Word64) import GHC.Num (Integer) -import GHC.Show (Show (show)) +import Test.Cardano.Ledger.Core.Binary.CDDL +import Test.Cardano.Ledger.Shelley.CDDL ( + bootstrap_witness, + port, + single_host_addr, + transaction_index, + transaction_metadatum, + vkeywitness, + ) conway :: Huddle conway = @@ -25,16 +34,25 @@ conway = block :: Rule block = - "block" - =:= arr - [ a header - , "transaction_bodies" ==> arr [0 <+ a transaction_body] - , "transaction_witness_sets" - ==> arr [0 <+ a transaction_witness_set] - , "auxiliary_data_set" - ==> mp [0 <+ asKey transaction_index ==> auxiliary_data] - , "invalid_transactions" ==> arr [0 <+ a transaction_index] - ] + comment + [here| + 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 header + , "transaction_bodies" ==> arr [0 <+ a transaction_body] + , "transaction_witness_sets" + ==> arr [0 <+ a transaction_witness_set] + , "auxiliary_data_set" + ==> mp [0 <+ asKey transaction_index ==> auxiliary_data] + , "invalid_transactions" ==> arr [0 <+ a transaction_index] + ] transaction :: Rule transaction = @@ -46,9 +64,6 @@ transaction = , a (auxiliary_data / VNil) ] -transaction_index :: Rule -transaction_index = "transaction_index" =:= VUInt `sized` (2 :: Word64) - header :: Rule header = "header" @@ -213,12 +228,20 @@ info_action = "info_action" =:= int 6 voter :: Rule voter = - "voter" - =:= arr [0, a addr_keyhash] - / arr [1, a scripthash] - / arr [2, a addr_keyhash] - / arr [3, a scripthash] - / arr [4, a addr_keyhash] + comment + [here| + Constitutional Committee Hot KeyHash: 0 + Constitutional Committee Hot ScriptHash: 1 + DRep KeyHash: 2 + DRep ScriptHash: 3 + StakingPool KeyHash: 4 + |] + $ "voter" + =:= arr [0, a addr_keyhash] + / arr [1, a scripthash] + / arr [2, a addr_keyhash] + / arr [3, a scripthash] + / arr [4, a addr_keyhash] anchor :: Rule anchor = @@ -252,9 +275,14 @@ transaction_input = transaction_output :: Rule transaction_output = - "transaction_output" - =:= pre_babbage_transaction_output - / post_alonzo_transaction_output + comment + [here| + Both of the Alonzo and Babbage style TxOut formats are equally valid + and can be used interchangeably + |] + $ "transaction_output" + =:= pre_babbage_transaction_output + / post_alonzo_transaction_output pre_babbage_transaction_output :: Rule pre_babbage_transaction_output = @@ -276,7 +304,77 @@ post_alonzo_transaction_output = ] script_data_hash :: Rule -script_data_hash = "script_data_hash" =:= hash32 +script_data_hash = + comment + [here| + 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. + For PlutusV3 (language id 2), the language view is the following: + - the value of costmdls 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 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): + [ 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. + |] + $ "script_data_hash" =:= hash32 certificate :: Rule certificate = @@ -416,28 +514,9 @@ pool_params = , "pool_metadata" ==> (pool_metadata / VNil) ] -port :: Rule -port = "port" =:= VUInt `le` 65535 - -ipv4 :: Rule -ipv4 = "ipv4" =:= VBytes `sized` (4 :: Word64) - -ipv6 :: Rule -ipv6 = "ipv6" =:= VBytes `sized` (16 :: Word64) - dns_name :: Rule dns_name = "dns_name" =:= VText `sized` (0 :: Word64, 128 :: Word64) -single_host_addr :: Named Group -single_host_addr = - "single_host_addr" - =:~ grp - [ 0 - , port / VNil - , ipv4 / VNil - , ipv6 / VNil - ] - single_host_name :: Named Group single_host_name = "single_host_name" @@ -573,15 +652,6 @@ plutus_data = / big_int / bounded_bytes -big_int :: Rule -big_int = "big_int" =:= VInt / big_uint / big_nint - -big_uint :: Rule -big_uint = "big_uint" =:= tag 2 bounded_bytes - -big_nint :: Rule -big_nint = "big_nint" =:= tag 3 bounded_bytes - constr :: IsType0 x => x -> GRuleCall constr = binding $ \x -> "constr" @@ -670,15 +740,6 @@ costmdls = , 0 <+ asKey (3 ... 255) ==> arr [0 <+ a int64] -- Any 8-bit unsigned number can be used as a key. ] -transaction_metadatum :: Rule -transaction_metadatum = - "transaction_metadatum" - =:= smp [0 <+ asKey transaction_metadatum ==> transaction_metadatum] - / sarr [0 <+ a transaction_metadatum] - / VInt - / (VBytes `sized` (0 :: Word64, 64 :: Word64)) - / (VText `sized` (0 :: Word64, 64 :: Word64)) - transaction_metadatum_label :: Rule transaction_metadatum_label = "transaction_metadatum_label" =:= (VUInt `sized` (8 :: Word64)) @@ -710,19 +771,6 @@ auxiliary_data = ] ) -vkeywitness :: Rule -vkeywitness = "vkeywitness" =:= arr [a vkey, a signature] - -bootstrap_witness :: Rule -bootstrap_witness = - "bootstrap_witness" - =:= arr - [ "public_key" ==> vkey - , "signature" ==> signature - , "chain_code" ==> (VBytes `sized` (32 :: Word64)) - , "attributes" ==> VBytes - ] - native_script :: Rule native_script = "native_script" @@ -758,9 +806,6 @@ invalid_before = "invalid_before" =:~ grp [4, a slot_no] invalid_hereafter :: Named Group invalid_hereafter = "invalid_hereafter" =:~ grp [5, a slot_no] -coin :: Rule -coin = "coin" =:= VUInt - multiasset :: IsType0 a => a -> GRuleCall multiasset = binding $ \x -> "multiasset" @@ -772,51 +817,12 @@ policy_id = "policy_id" =:= scripthash asset_name :: Rule asset_name = "asset_name" =:= VBytes `sized` (0 :: Word64, 32 :: Word64) --- Once https://github.com/input-output-hk/cuddle/issues/29 is in place, replace --- with: --- --- minInt64 :: Rule --- minInt64 = "minInt64" =:= -9223372036854775808 -minInt64 :: Integer -minInt64 = -9223372036854775808 - --- Once https://github.com/input-output-hk/cuddle/issues/29 is in place, replace --- with: --- --- maxInt64 :: Rule --- maxInt64 = "maxInt64" =:= 9223372036854775807 -maxInt64 :: Integer -maxInt64 = 9223372036854775807 - --- Once https://github.com/input-output-hk/cuddle/issues/29 is in place, replace --- with: --- --- maxWord64 :: Rule --- maxWord64 = "maxWord64" =:= 18446744073709551615 -maxWord64 :: Integer -maxWord64 = 18446744073709551615 - -negInt64 :: Rule -negInt64 = "negInt64" =:= minInt64 ... (-1) - -posInt64 :: Rule -posInt64 = "posInt64" =:= 1 ... maxInt64 - -nonZeroInt64 :: Rule -nonZeroInt64 = "nonZeroInt64" =:= negInt64 / posInt64 -- this is the same as the current int64 definition but without zero - -positive_coin :: Rule -positive_coin = "positive_coin" =:= 1 ... maxWord64 - value :: Rule value = "value" =:= coin / sarr [a coin, a (multiasset positive_coin)] mint :: Rule mint = "mint" =:= multiasset nonZeroInt64 -int64 :: Rule -int64 = "int64" =:= minInt64 ... maxInt64 - network_id :: Rule network_id = "network_id" =:= int 0 / int 1 @@ -832,15 +838,6 @@ slot_no = "slot_no" =:= VUInt `sized` (8 :: Word64) block_no :: Rule block_no = "block_no" =:= VUInt `sized` (8 :: Word64) -addr_keyhash :: Rule -addr_keyhash = "addr_keyhash" =:= hash28 - -pool_keyhash :: Rule -pool_keyhash = "pool_keyhash" =:= hash28 - -vrf_keyhash :: Rule -vrf_keyhash = "vrf_keyhash" =:= hash32 - auxiliary_data_hash :: Rule auxiliary_data_hash = "auxiliary_data_hash" =:= hash32 @@ -888,123 +885,3 @@ script = / arr [1, a plutus_v1_script] / arr [2, a plutus_v2_script] / arr [3, a plutus_v3_script] - --------------------------------------------------------------------------------- --- Crypto --------------------------------------------------------------------------------- - -hash28 :: Rule -hash28 = "$hash28" =:= VBytes `sized` (28 :: Word64) - -hash32 :: Rule -hash32 = "$hash32" =:= VBytes `sized` (32 :: Word64) - -vkey :: Rule -vkey = "$vkey" =:= VBytes `sized` (32 :: Word64) - -vrf_vkey :: Rule -vrf_vkey = "$vrf_vkey" =:= VBytes `sized` (32 :: Word64) - -vrf_cert :: Rule -vrf_cert = "$vrf_cert" =:= arr [a VBytes, a (VBytes `sized` (80 :: Word64))] - -kes_vkey :: Rule -kes_vkey = "$kes_vkey" =:= VBytes `sized` (32 :: Word64) - -kes_signature :: Rule -kes_signature = "$kes_signature" =:= VBytes `sized` (448 :: Word64) - -signkeyKES :: Rule -signkeyKES = "signkeyKES" =:= VBytes `sized` (64 :: Word64) - -signature :: Rule -signature = "$signature" =:= VBytes `sized` (64 :: Word64) - --------------------------------------------------------------------------------- --- Extras --------------------------------------------------------------------------------- - --- Conway era introduces an optional 258 tag for sets, which will become mandatory in the --- second era after Conway. We recommend all the tooling to account for this future breaking --- change sooner rather than later, in order to provide a smooth transition for their users. - -set :: IsType0 t0 => t0 -> GRuleCall -set = binding $ \x -> "set" =:= tag 258 (arr [0 <+ a x]) / sarr [0 <+ a x] - -nonempty_set :: IsType0 t0 => t0 -> GRuleCall -nonempty_set = binding $ \x -> - "nonempty_set" - =:= tag 258 (arr [1 <+ a x]) - / sarr [1 <+ a x] - -positive_int :: Rule -positive_int = "positive_int" =:= 1 ... 18446744073709551615 - -unit_interval :: Rule -unit_interval = "unit_interval" =:= tag 30 (arr [1, 2]) - --- unit_interval = tag 0 [uint, uint] --- --- Comment above depicts the actual definition for `unit_interval`. --- --- Unit interval is a number in the range between 0 and 1, which --- means there are two extra constraints: --- \* numerator <= denominator --- \* denominator > 0 --- --- Relation between numerator and denominator cannot be expressed in CDDL, which --- poses a problem for testing. We need to be able to generate random valid data --- for testing implementation of our encoders/decoders. Which means we cannot use --- the actual definition here and we hard code the value to 1/2 - --- nonnegative_interval = tag 0 [uint, positive_int] -nonnegative_interval :: Rule -nonnegative_interval = "nonnegative_interval" =:= tag 30 (arr [a VUInt, a positive_int]) - -address :: Rule -address = - "address" - =:= bstr - "001000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000" - / bstr - "102000000000000000000000000000000000000000000000000000000022000000000000000000000000000000000000000000000000000000" - / bstr - "203000000000000000000000000000000000000000000000000000000033000000000000000000000000000000000000000000000000000000" - / bstr - "304000000000000000000000000000000000000000000000000000000044000000000000000000000000000000000000000000000000000000" - / bstr "405000000000000000000000000000000000000000000000000000000087680203" - / bstr "506000000000000000000000000000000000000000000000000000000087680203" - / bstr "6070000000000000000000000000000000000000000000000000000000" - / bstr "7080000000000000000000000000000000000000000000000000000000" - -reward_account :: Rule -reward_account = - "reward_account" - =:= bstr "E090000000000000000000000000000000000000000000000000000000" - / bstr "F0A0000000000000000000000000000000000000000000000000000000" - -bounded_bytes :: Rule -bounded_bytes = "bounded_bytes" =:= VBytes `sized` (0 :: Word64, 64 :: Word64) - --- 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 ) - --- a type for distinct values. --- The type parameter must support .size, for example: bytes or uint -distinct :: IsSizeable s => Value s -> Rule -distinct x = - "distinct_" - <> T.pack (show x) - =:= (x `sized` (8 :: Word64)) - / (x `sized` (16 :: Word64)) - / (x `sized` (20 :: Word64)) - / (x `sized` (24 :: Word64)) - / (x `sized` (30 :: Word64)) - / (x `sized` (32 :: Word64)) diff --git a/eras/mary/impl/cardano-ledger-mary.cabal b/eras/mary/impl/cardano-ledger-mary.cabal index 7e3479e0364..a537dda4995 100644 --- a/eras/mary/impl/cardano-ledger-mary.cabal +++ b/eras/mary/impl/cardano-ledger-mary.cabal @@ -94,6 +94,7 @@ library testlib exposed-modules: Test.Cardano.Ledger.Mary.Arbitrary Test.Cardano.Ledger.Mary.Binary.Cddl + Test.Cardano.Ledger.Mary.CDDL Test.Cardano.Ledger.Mary.Imp Test.Cardano.Ledger.Mary.ImpTest Test.Cardano.Ledger.Mary.Imp.UtxoSpec @@ -120,8 +121,24 @@ library testlib cardano-ledger-allegra:{cardano-ledger-allegra, testlib}, cardano-ledger-shelley:{cardano-ledger-shelley, testlib}, cardano-strict-containers, + cuddle, microlens +executable huddle-cddl + main-is: Main.hs + hs-source-dirs: huddle-cddl + 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 -threaded -rtsopts -with-rtsopts=-N + + build-depends: + base, + testlib, + cardano-ledger-binary:testlib >=1.3.4.0 + test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs diff --git a/eras/mary/impl/cddl-files/crypto.cddl b/eras/mary/impl/cddl-files/crypto.cddl deleted file mode 100644 index 339444964d2..00000000000 --- a/eras/mary/impl/cddl-files/crypto.cddl +++ /dev/null @@ -1,13 +0,0 @@ -$hash28 /= bytes .size 28 -$hash32 /= bytes .size 32 - -$vkey /= bytes .size 32 - -$vrf_vkey /= bytes .size 32 -$vrf_cert /= [bytes, bytes .size 80] - -$kes_vkey /= bytes .size 32 -$kes_signature /= bytes .size 448 -signkeyKES = bytes .size 64 - -$signature /= bytes .size 64 diff --git a/eras/mary/impl/cddl-files/extras.cddl b/eras/mary/impl/cddl-files/extras.cddl deleted file mode 100644 index 96714ecbac7..00000000000 --- a/eras/mary/impl/cddl-files/extras.cddl +++ /dev/null @@ -1,27 +0,0 @@ -finite_set = [* a ] - -set = [* a] - -;unit_interval = #6.30([uint, uint]) -unit_interval = #6.30([1, 2]) - ; real unit_interval is: #6.30([uint, uint]) - ; but this produces numbers outside the unit interval - ; and can also produce a zero in the denominator - -positive_int = 1 .. 18446744073709551615 - -nonnegative_interval = #6.30([uint, positive_int]) - -address = - h'001000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000' / - h'102000000000000000000000000000000000000000000000000000000022000000000000000000000000000000000000000000000000000000' / - h'203000000000000000000000000000000000000000000000000000000033000000000000000000000000000000000000000000000000000000' / - h'304000000000000000000000000000000000000000000000000000000044000000000000000000000000000000000000000000000000000000' / - h'405000000000000000000000000000000000000000000000000000000087680203' / - h'506000000000000000000000000000000000000000000000000000000087680203' / - h'6070000000000000000000000000000000000000000000000000000000' / - h'7080000000000000000000000000000000000000000000000000000000' - -reward_account = - h'E090000000000000000000000000000000000000000000000000000000' / - h'F0A0000000000000000000000000000000000000000000000000000000' diff --git a/eras/mary/impl/cddl-files/mary.cddl b/eras/mary/impl/cddl-files/mary.cddl index cd59d1743e4..fedec1d948d 100644 --- a/eras/mary/impl/cddl-files/mary.cddl +++ b/eras/mary/impl/cddl-files/mary.cddl @@ -1,292 +1,276 @@ -block = - [ header - , transaction_bodies : [* transaction_body] - , transaction_witness_sets : [* transaction_witness_set] - , auxiliary_data_set : - { * transaction_index => auxiliary_data } - ]; 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 - -transaction = - [ transaction_body - , transaction_witness_set - , auxiliary_data / null - ] +; This file was auto-generated from huddle. Please do not modify it directly! +; Pseudo-rule introduced by Cuddle to collect root elements +huddle_root_defs = [block, transaction] -transaction_index = uint .size 2 +$hash28 = bytes .size 28 -header = - [ header_body - , body_signature : $kes_signature - ] - -header_body = - [ block_number : uint - , slot : uint - , prev_hash : $hash32 / null - , issuer_vkey : $vkey - , vrf_vkey : $vrf_vkey - , nonce_vrf : $vrf_cert - , leader_vrf : $vrf_cert - , block_body_size : uint - , block_body_hash : $hash32 ; merkle triple root - , operational_cert - , protocol_version - ] - -operational_cert = - ( hot_vkey : $kes_vkey - , sequence_number : uint - , kes_period : uint - , sigma : $signature - ) - -next_major_protocol_version = 5 - -major_protocol_version = 1..next_major_protocol_version +$hash32 = bytes .size 32 -protocol_version = (major_protocol_version, uint) +$kes_signature = bytes .size 448 -transaction_body = - { 0 : set - , 1 : [* transaction_output] - , 2 : coin ; fee - , ? 3 : uint ; ttl - , ? 4 : [* certificate] - , ? 5 : withdrawals - , ? 6 : update - , ? 7 : metadata_hash - , ? 8 : uint ; validity interval start - , ? 9 : mint - } - -transaction_input = [ transaction_id : $hash32 - , index : uint - ] +$kes_vkey = bytes .size 32 -transaction_output = [address, amount : value] +$signature = bytes .size 64 + +$vkey = bytes .size 32 + +$vrf_cert = [bytes, bytes .size 80] + +$vrf_vkey = bytes .size 32 + +addr_keyhash = $hash28 ; address = bytes -; reward_account = bytes - -; address format: -; [ 8 bit header | payload ]; -; -; shelley payment addresses: -; bit 7: 0 -; bit 6: base/other -; bit 5: pointer/enterprise [for base: stake cred is keyhash/scripthash] -; bit 4: payment cred is keyhash/scripthash -; bits 3-0: network id -; -; reward addresses: -; bits 7-5: 111 -; bit 4: credential is keyhash/scripthash -; bits 3-0: network id -; -; byron addresses: -; bits 7-4: 1000 - -; 0000: base address: keyhash28,keyhash28 -; 0001: base address: scripthash28,keyhash28 -; 0010: base address: keyhash28,scripthash28 -; 0011: base address: scripthash28,scripthash28 -; 0100: pointer address: keyhash28, 3 variable length uint -; 0101: pointer address: scripthash28, 3 variable length uint -; 0110: enterprise address: keyhash28 -; 0111: enterprise address: scripthash28 -; 1000: byron address -; 1110: reward account: keyhash28 -; 1111: reward account: scripthash28 -; 1001 - 1101: future formats - -certificate = - [ stake_registration - // stake_deregistration - // stake_delegation - // pool_registration - // pool_retirement - // genesis_key_delegation - // move_instantaneous_rewards_cert - ] +; reward_account = bytes +; +; address format: +; [ 8 bit header | payload ]; +; +; shelley payment addresses: +; bit 7: 0 +; bit 6: base/other +; bit 5: pointer/enterprise [for base: stake cred is keyhash/scripthash] +; bit 4: payment cred is keyhash/scripthash +; bits 3-0: network id +; +; reward addresses: +; bits 7-5: 111 +; bit 4: credential is keyhash/scripthash +; bits 3-0: network id +; +; byron addresses: +; bits 7-4: 1000 +; +; 0000: base address: keyhash28,keyhash28 +; 0001: base address: scripthash28,keyhash28 +; 0010: base address: keyhash28,scripthash28 +; 0011: base address: scripthash28,scripthash28 +; 0100: pointer address: keyhash28, 3 variable length uint +; 0101: pointer address: scripthash28, 3 variable length uint +; 0110: enterprise address: keyhash28 +; 0111: enterprise address: scripthash28 +; 1000: byron address +; 1110: reward account: keyhash28 +; 1111: reward account: scripthash28 +; 1001 - 1101: future formats +address = h'001000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000' + / h'102000000000000000000000000000000000000000000000000000000022000000000000000000000000000000000000000000000000000000' + / h'203000000000000000000000000000000000000000000000000000000033000000000000000000000000000000000000000000000000000000' + / h'304000000000000000000000000000000000000000000000000000000044000000000000000000000000000000000000000000000000000000' + / h'405000000000000000000000000000000000000000000000000000000087680203' + / h'506000000000000000000000000000000000000000000000000000000087680203' + / h'6070000000000000000000000000000000000000000000000000000000' + / h'7080000000000000000000000000000000000000000000000000000000' + +asset_name = bytes .size (0 .. 32) + +auxiliary_data = {* transaction_metadatum_label => transaction_metadatum} + / [transaction_metadata : {* transaction_metadatum_label => transaction_metadatum}, + auxiliary_scripts : [* native_script]] + +block = [header, + transaction_bodies : [* transaction_body], + transaction_witness_sets : [* transaction_witness_set], + auxiliary_data_set : {* transaction_index => auxiliary_data}] + +bootstrap_witness = [public_key : $vkey, + signature : $signature, + chain_code : bytes .size 32, + attributes : bytes] + +certificate = [stake_registration // + stake_deregistration // + stake_delegation // + pool_registration // + pool_retirement // + genesis_key_delegation // + move_instantaneous_rewards_cert] -stake_registration = (0, stake_credential) -stake_deregistration = (1, stake_credential) -stake_delegation = (2, stake_credential, pool_keyhash) -pool_registration = (3, pool_params) -pool_retirement = (4, pool_keyhash, epoch) -genesis_key_delegation = (5, genesishash, genesis_delegate_hash, vrf_keyhash) -move_instantaneous_rewards_cert = (6, move_instantaneous_reward) +coin = uint -move_instantaneous_reward = [ 0 / 1, { * stake_credential => coin } ] -; The first field determines where the funds are drawn from. -; 0 denotes the reserves, 1 denotes the treasury. - -stake_credential = - [ 0, addr_keyhash - // 1, scripthash - ] - -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 / null - ) +dns_name = text .size (0 .. 64) + +epoch = uint + +genesis_delegate_hash = $hash28 + +genesishash = $hash28 + +header = [header_body, body_signature : $kes_signature] + +header_body = [block_number : uint, + slot : uint, + prev_hash : $hash32 / nil, + issuer_vkey : $vkey, + vrf_vkey : $vrf_vkey, + nonce_vrf : $vrf_cert, + leader_vrf : $vrf_cert, + block_body_size : uint .size 4, + block_body_hash : $hash32, + operational_cert, + protocol_version] + +int64 = -9223372036854775808 .. 9223372036854775807 -port = uint .le 65535 ipv4 = bytes .size 4 + ipv6 = bytes .size 16 -dns_name = tstr .size (0..64) - -single_host_addr = ( 0 - , port / null - , ipv4 / null - , ipv6 / null - ) -single_host_name = ( 1 - , port / null - , dns_name ; An A or AAAA DNS record - ) -multi_host_name = ( 2 - , dns_name ; A SRV DNS record - ) -relay = - [ single_host_addr - // single_host_name - // multi_host_name - ] + +major_protocol_version = 1 .. 3 + +metadata_hash = $hash32 + +mint = multiasset + +move_instantaneous_reward = [0 / 1, {* stake_credential => coin}] + +; Timelock validity intervals are half-open intervals [a, b). +native_script = [script_pubkey // + script_all // + script_any // + script_n_of_k // + invalid_before // + invalid_hereafter] + +nonce = [0 // + 1, bytes .size 32] + +nonnegative_interval = #6.30([uint, positive_int]) + +policy_id = scripthash + +pool_keyhash = $hash28 pool_metadata = [url, metadata_hash] -url = tstr .size (0..64) - -withdrawals = { * reward_account => coin } - -update = [ proposed_protocol_parameter_updates - , epoch - ] - -proposed_protocol_parameter_updates = - { * genesishash => protocol_param_update } - -protocol_param_update = - { ? 0: uint ; minfee A - , ? 1: uint ; minfee B - , ? 2: uint ; max block body size - , ? 3: uint ; max transaction size - , ? 4: uint ; max block header size - , ? 5: coin ; key deposit - , ? 6: coin ; pool deposit - , ? 7: epoch ; maximum epoch - , ? 8: uint ; 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 ; d. decentralization constant - , ? 13: $nonce ; extra entropy - , ? 14: [protocol_version] ; protocol version - , ? 15: coin ; min utxo value - } - -transaction_witness_set = - { ? 0: [* vkeywitness ] - , ? 1: [* native_script ] - , ? 2: [* bootstrap_witness ] - ; In the future, new kinds of witnesses can be added like this: - ; , ? 4: [* foo_script ] - ; , ? 5: [* plutus_script ] - } - -transaction_metadatum = - { * transaction_metadatum => transaction_metadatum } - / [ * transaction_metadatum ] - / int - / bytes .size (0..64) - / text .size (0..64) + +port = uint .le 65535 + +positive_int = 1 .. 18446744073709551615 + +proposed_protocol_parameter_updates = {* genesishash => protocol_param_update} + +protocol_param_update = {? 0 : uint, + ? 1 : uint, + ? 2 : uint, + ? 3 : uint, + ? 4 : uint .size 2, + ? 5 : coin, + ? 6 : coin, + ? 7 : epoch, + ? 8 : uint, + ? 9 : nonnegative_interval, + ? 10 : unit_interval, + ? 11 : unit_interval, + ? 12 : unit_interval, + ? 13 : nonce, + ? 14 : [protocol_version], + ? 15 : coin} + +relay = [single_host_addr // + single_host_name // + multi_host_name] + +reward_account = h'E090000000000000000000000000000000000000000000000000000000' + / h'F0A0000000000000000000000000000000000000000000000000000000' + +scripthash = $hash28 + +stake_credential = [0, addr_keyhash // + 1, scripthash] + +transaction = [transaction_body, transaction_witness_set, auxiliary_data / nil] + +transaction_body = {0 : set, + 1 : [* transaction_output], + 2 : coin, + 3 : uint, + ? 4 : [* certificate], + ? 5 : withdrawals, + ? 6 : update, + ? 7 : metadata_hash, + ? 8 : uint, + ? 9 : mint} + +transaction_index = uint .size 2 + +transaction_input = [transaction_id : $hash32, index : uint] + +transaction_metadatum = {* transaction_metadatum => transaction_metadatum} + / [* transaction_metadatum] + / int + / bytes .size (0 .. 64) + / text .size (0 .. 64) transaction_metadatum_label = uint -auxiliary_data = - { * transaction_metadatum_label => transaction_metadatum } - / [ transaction_metadata: { * transaction_metadatum_label => transaction_metadatum } - , auxiliary_scripts: [ * native_script ] - ; other types of metadata... - ] - -vkeywitness = [ $vkey, $signature ] - -bootstrap_witness = - [ public_key : $vkey - , signature : $signature - , chain_code : bytes .size 32 - , attributes : bytes - ] - -native_script = - [ script_pubkey - // script_all - // script_any - // script_n_of_k - // invalid_before - ; Timelock validity intervals are half-open intervals [a, b). - ; This field specifies the left (included) endpoint a. - // invalid_hereafter - ; Timelock validity intervals are half-open intervals [a, b). - ; This field specifies the right (excluded) endpoint b. - ] +transaction_output = [address, amount : value] + +transaction_witness_set = {? 0 : [* vkeywitness], + ? 1 : [* native_script], + ? 2 : [* bootstrap_witness]} + +unit_interval = #6.30([1, 2]) + +update = [proposed_protocol_parameter_updates, epoch] + +url = text .size (0 .. 64) + +value = coin / [coin, multiasset] + +vkeywitness = [$vkey, $signature] + +vrf_keyhash = $hash32 + +withdrawals = {* reward_account => coin} + +genesis_key_delegation = (5, genesishash, genesis_delegate_hash, vrf_keyhash) -script_pubkey = (0, addr_keyhash) -script_all = (1, [ * native_script ]) -script_any = (2, [ * native_script ]) -script_n_of_k = (3, n: uint, [ * native_script ]) invalid_before = (4, uint) + invalid_hereafter = (5, uint) -coin = uint +move_instantaneous_rewards_cert = (6, move_instantaneous_reward) -multiasset = { * policy_id => { * asset_name => a } } -policy_id = scripthash -asset_name = bytes .size (0..32) +multi_host_name = (2, dns_name) -value = coin / [coin,multiasset] -mint = multiasset +operational_cert = ($kes_vkey, uint, uint, $signature) -int64 = -9223372036854775808 .. 9223372036854775807 +pool_params = (pool_keyhash, + vrf_keyhash, + coin, + coin, + unit_interval, + reward_account, + set, + [* relay], + pool_metadata / nil) -epoch = uint +pool_registration = (3, pool_params) -addr_keyhash = $hash28 -genesis_delegate_hash = $hash28 -pool_keyhash = $hash28 -genesishash = $hash28 - -vrf_keyhash = $hash32 -metadata_hash = $hash32 - -; 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. -; In the Allegra and Mary eras there is only one such tag, -; namely "\x00" for multisig scripts. -scripthash = $hash28 - -; allegra differences -transaction_body_allegra = - { 0 : set - , 1 : [* transaction_output_allegra] - , 2 : coin ; fee - , ? 3 : uint ; ttl - , ? 4 : [* certificate] - , ? 5 : withdrawals - , ? 6 : update - , ? 7 : metadata_hash - , ? 8 : uint ; validity interval start - } -transaction_output_allegra = [address, amount : coin] +pool_retirement = (4, pool_keyhash, epoch) + +protocol_version = (major_protocol_version, uint) + +script_all = (1, [* native_script]) + +script_any = (2, [* native_script]) + +script_n_of_k = (3, int64, [* native_script]) + +script_pubkey = (0, addr_keyhash) + +single_host_addr = (0, port / nil, ipv4 / nil, ipv6 / nil) + +single_host_name = (1, port / nil, dns_name) + +stake_delegation = (2, stake_credential, pool_keyhash) + +; This will be deprecated in a future era +stake_deregistration = (1, stake_credential) + +; This will be deprecated in a future era +stake_registration = (0, stake_credential) + +multiasset = {+ policy_id => {+ asset_name => a0}} + +set = [* a0] diff --git a/eras/mary/impl/huddle-cddl/Main.hs b/eras/mary/impl/huddle-cddl/Main.hs new file mode 100644 index 00000000000..2b389c9356d --- /dev/null +++ b/eras/mary/impl/huddle-cddl/Main.hs @@ -0,0 +1,11 @@ +module Main where + +import Paths_cardano_ledger_mary +import Test.Cardano.Ledger.Binary.Cuddle (writeSpec) +import qualified Test.Cardano.Ledger.Mary.CDDL as Mary + +-- Generate cddl files for all relevant specifications +main :: IO () +main = do + specFile <- getDataFileName "cddl-files/mary.cddl" + writeSpec Mary.cddl specFile diff --git a/eras/mary/impl/test/Test/Cardano/Ledger/Mary/Binary/CddlSpec.hs b/eras/mary/impl/test/Test/Cardano/Ledger/Mary/Binary/CddlSpec.hs index f4692945aea..148dcbe9f54 100644 --- a/eras/mary/impl/test/Test/Cardano/Ledger/Mary/Binary/CddlSpec.hs +++ b/eras/mary/impl/test/Test/Cardano/Ledger/Mary/Binary/CddlSpec.hs @@ -10,14 +10,25 @@ import Test.Cardano.Ledger.Binary.Cddl ( cddlRoundTripAnnCborSpec, cddlRoundTripCborSpec, ) +import Test.Cardano.Ledger.Binary.Cuddle import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Mary.Binary.Cddl (readMaryCddlFiles) +import qualified Test.Cardano.Ledger.Mary.CDDL as MaryCDDL spec :: Spec -spec = +spec = do describe "CDDL" $ beforeAllCddlFile 3 readMaryCddlFiles $ do let v = eraProtVerLow @Mary cddlRoundTripCborSpec @(Value Mary) v "value" cddlRoundTripAnnCborSpec @(TxBody Mary) v "transaction_body" cddlRoundTripAnnCborSpec @(Script Mary) v "native_script" cddlRoundTripAnnCborSpec @(TxAuxData Mary) v "auxiliary_data" + newSpec + +newSpec :: Spec +newSpec = describe "Huddle" $ specWithHuddle MaryCDDL.cddl 100 $ do + let v = eraProtVerHigh @Mary + huddleRoundTripCborSpec @(Value Mary) v "value" + huddleRoundTripAnnCborSpec @(TxBody Mary) v "transaction_body" + huddleRoundTripAnnCborSpec @(TxAuxData Mary) v "auxiliary_data" + huddleRoundTripAnnCborSpec @(Script Mary) v "native_script" diff --git a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Binary/Cddl.hs b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Binary/Cddl.hs index 6efbd4f1963..7c281402b88 100644 --- a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Binary/Cddl.hs +++ b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Binary/Cddl.hs @@ -9,10 +9,7 @@ import Paths_cardano_ledger_mary readMaryCddlFileNames :: IO [FilePath] readMaryCddlFileNames = do base <- getDataFileName "cddl-files/mary.cddl" - crypto <- getDataFileName "cddl-files/crypto.cddl" - extras <- getDataFileName "cddl-files/extras.cddl" - -- extras contains the types whose restrictions cannot be expressed in CDDL - pure [base, crypto, extras] + pure [base] readMaryCddlFiles :: IO [BSL.ByteString] readMaryCddlFiles = mapM BSL.readFile =<< readMaryCddlFileNames diff --git a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/CDDL.hs b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/CDDL.hs new file mode 100644 index 00000000000..55b30ffa67d --- /dev/null +++ b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/CDDL.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use camelCase" #-} +{-# HLINT ignore "Evaluate" #-} + +module Test.Cardano.Ledger.Mary.CDDL where + +import Codec.CBOR.Cuddle.Huddle +import Data.Function (($)) +import Data.Word (Word64) +import Test.Cardano.Ledger.Allegra.CDDL (auxiliary_data, transaction_witness_set) +import Test.Cardano.Ledger.Core.Binary.CDDL hiding (set) +import Test.Cardano.Ledger.Shelley.CDDL ( + certificate, + header, + metadata_hash, + scripthash, + set, + transaction_index, + transaction_input, + update, + withdrawals, + ) + +cddl :: Huddle +cddl = collectFrom [block, transaction] + +-------------------------------------------------------------------------------- +-- Things changed in Mary +-------------------------------------------------------------------------------- +multiasset :: IsType0 a => a -> GRuleCall +multiasset = binding $ \x -> + "multiasset" + =:= mp [1 <+ asKey policy_id ==> mp [1 <+ asKey asset_name ==> x]] + +policy_id :: Rule +policy_id = "policy_id" =:= scripthash + +asset_name :: Rule +asset_name = "asset_name" =:= VBytes `sized` (0 :: Word64, 32 :: Word64) + +value :: Rule +value = "value" =:= coin / sarr [a coin, a (multiasset VUInt)] + +mint :: Rule +mint = "mint" =:= multiasset int64 + +transaction_body :: Rule +transaction_body = + "transaction_body" + =:= mp + [ idx 0 ==> set transaction_input + , idx 1 ==> arr [0 <+ a transaction_output] + , idx 2 ==> coin + , idx 3 ==> VUInt + , opt (idx 4 ==> arr [0 <+ a certificate]) + , opt (idx 5 ==> withdrawals) + , opt (idx 6 ==> update) + , opt (idx 7 ==> metadata_hash) + , opt (idx 8 ==> VUInt) + , opt (idx 9 ==> mint) + ] + +transaction_output :: Rule +transaction_output = + "transaction_output" + =:= arr + [ a address + , "amount" ==> value + ] + +-------------------------------------------------------------------------------- +-- Closure +-------------------------------------------------------------------------------- + +block :: Rule +block = + "block" + =:= arr + [ a header + , "transaction_bodies" ==> arr [0 <+ a transaction_body] + , "transaction_witness_sets" + ==> arr [0 <+ a transaction_witness_set] + , "auxiliary_data_set" + ==> mp [0 <+ asKey transaction_index ==> auxiliary_data] + ] + +transaction :: Rule +transaction = + "transaction" + =:= arr + [ a transaction_body + , a transaction_witness_set + , a (auxiliary_data / VNil) + ] diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index cdab762fb50..e0d684851c1 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -6,11 +6,7 @@ maintainer: operations@iohk.io author: IOHK synopsis: Shelley Ledger Executable Model build-type: Simple -data-files: - cddl-files/shelley.cddl - cddl-files/crypto.cddl - cddl-files/extras.cddl - +data-files: cddl-files/shelley.cddl extra-source-files: CHANGELOG.md source-repository head @@ -137,6 +133,7 @@ library testlib Test.Cardano.Ledger.Shelley.Binary.Cddl Test.Cardano.Ledger.Shelley.Binary.Golden Test.Cardano.Ledger.Shelley.Binary.RoundTrip + Test.Cardano.Ledger.Shelley.CDDL Test.Cardano.Ledger.Shelley.Constants Test.Cardano.Ledger.Shelley.ImpTest Test.Cardano.Ledger.Shelley.Imp @@ -170,6 +167,7 @@ library testlib cardano-slotting:{cardano-slotting, testlib}, cardano-strict-containers, containers, + cuddle >=0.3.1.0, FailT, generic-random, hedgehog-quickcheck, @@ -190,6 +188,21 @@ library testlib unliftio, vector-map +executable huddle-cddl + main-is: Main.hs + hs-source-dirs: huddle-cddl + other-modules: Paths_cardano_ledger_shelley + default-language: Haskell2010 + ghc-options: + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints -Wpartial-fields + -Wunused-packages -threaded -rtsopts -with-rtsopts=-N + + build-depends: + base, + testlib, + cardano-ledger-binary:testlib >=1.3.4.0 + test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs diff --git a/eras/shelley/impl/cddl-files/crypto.cddl b/eras/shelley/impl/cddl-files/crypto.cddl deleted file mode 100644 index 339444964d2..00000000000 --- a/eras/shelley/impl/cddl-files/crypto.cddl +++ /dev/null @@ -1,13 +0,0 @@ -$hash28 /= bytes .size 28 -$hash32 /= bytes .size 32 - -$vkey /= bytes .size 32 - -$vrf_vkey /= bytes .size 32 -$vrf_cert /= [bytes, bytes .size 80] - -$kes_vkey /= bytes .size 32 -$kes_signature /= bytes .size 448 -signkeyKES = bytes .size 64 - -$signature /= bytes .size 64 diff --git a/eras/shelley/impl/cddl-files/extras.cddl b/eras/shelley/impl/cddl-files/extras.cddl deleted file mode 100644 index 97de1c130ef..00000000000 --- a/eras/shelley/impl/cddl-files/extras.cddl +++ /dev/null @@ -1,27 +0,0 @@ -finite_set = [* a] - -;unit_interval = #6.30([uint, uint]) -unit_interval = #6.30([1, 2]) - ; real unit_interval is: #6.30([uint, uint]) - ; but this produces numbers outside the unit interval - ; and can also produce a zero in the denominator - -positive_int = 1 .. 18446744073709551615 - -nonnegative_interval = #6.30([uint, positive_int]) - -set = [* a] - -address = - h'001000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000' / - h'102000000000000000000000000000000000000000000000000000000022000000000000000000000000000000000000000000000000000000' / - h'203000000000000000000000000000000000000000000000000000000033000000000000000000000000000000000000000000000000000000' / - h'304000000000000000000000000000000000000000000000000000000044000000000000000000000000000000000000000000000000000000' / - h'405000000000000000000000000000000000000000000000000000000087680203' / - h'506000000000000000000000000000000000000000000000000000000087680203' / - h'6070000000000000000000000000000000000000000000000000000000' / - h'7080000000000000000000000000000000000000000000000000000000' - -reward_account = - h'E090000000000000000000000000000000000000000000000000000000' / - h'F0A0000000000000000000000000000000000000000000000000000000' diff --git a/eras/shelley/impl/cddl-files/shelley.cddl b/eras/shelley/impl/cddl-files/shelley.cddl index c0c3f337e3d..c96d10f1611 100644 --- a/eras/shelley/impl/cddl-files/shelley.cddl +++ b/eras/shelley/impl/cddl-files/shelley.cddl @@ -1,258 +1,257 @@ -; Shelley Types - -block = - [ header - , transaction_bodies : [* transaction_body] - , transaction_witness_sets : [* transaction_witness_set] - , transaction_metadata_set : - { * transaction_index => transaction_metadata } - ]; 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 - -transaction = - [ transaction_body - , transaction_witness_set - , transaction_metadata / null - ] +; This file was auto-generated from huddle. Please do not modify it directly! +; Pseudo-rule introduced by Cuddle to collect root elements +huddle_root_defs = [block, transaction, signkeyKES] -transaction_index = uint .size 2 +$hash28 = bytes .size 28 -header = - [ header_body - , body_signature : $kes_signature - ] - -header_body = - [ block_number : uint - , slot : uint - , prev_hash : $hash32 / null - , issuer_vkey : $vkey - , vrf_vkey : $vrf_vkey - , nonce_vrf : $vrf_cert - , leader_vrf : $vrf_cert - , block_body_size : uint - , block_body_hash : $hash32 ; merkle triple root - , operational_cert - , protocol_version - ] - -operational_cert = - ( hot_vkey : $kes_vkey - , sequence_number : uint - , kes_period : uint - , sigma : $signature - ) - -next_major_protocol_version = 3 - -major_protocol_version = 1..next_major_protocol_version +$hash32 = bytes .size 32 -protocol_version = (major_protocol_version, uint) +$kes_signature = bytes .size 448 -transaction_body = - { 0 : set - , 1 : [* transaction_output] - , 2 : coin ; fee - , 3 : uint ; ttl - , ? 4 : [* certificate] - , ? 5 : withdrawals - , ? 6 : update - , ? 7 : metadata_hash - } - -transaction_input = [ transaction_id : $hash32 - , index : uint - ] +$kes_vkey = bytes .size 32 -transaction_output = [address, amount : coin] +$signature = bytes .size 64 + +$vkey = bytes .size 32 + +$vrf_cert = [bytes, bytes .size 80] + +$vrf_vkey = bytes .size 32 + +addr_keyhash = $hash28 ; address = bytes -; reward_account = bytes - -; address format: -; [ 8 bit header | payload ]; -; -; shelley payment addresses: -; bit 7: 0 -; bit 6: base/other -; bit 5: pointer/enterprise [for base: stake cred is keyhash/scripthash] -; bit 4: payment cred is keyhash/scripthash -; bits 3-0: network id -; -; reward addresses: -; bits 7-5: 111 -; bit 4: credential is keyhash/scripthash -; bits 3-0: network id -; -; byron addresses: -; bits 7-4: 1000 - -; 0000: base address: keyhash28,keyhash28 -; 0001: base address: scripthash28,keyhash28 -; 0010: base address: keyhash28,scripthash28 -; 0011: base address: scripthash28,scripthash28 -; 0100: pointer address: keyhash28, 3 variable length uint -; 0101: pointer address: scripthash28, 3 variable length uint -; 0110: enterprise address: keyhash28 -; 0111: enterprise address: scripthash28 -; 1000: byron address -; 1110: reward account: keyhash28 -; 1111: reward account: scripthash28 -; 1001 - 1101: future formats - -certificate = - [ stake_registration - // stake_deregistration - // stake_delegation - // pool_registration - // pool_retirement - // genesis_key_delegation - // move_instantaneous_rewards_cert - ] +; reward_account = bytes +; +; address format: +; [ 8 bit header | payload ]; +; +; shelley payment addresses: +; bit 7: 0 +; bit 6: base/other +; bit 5: pointer/enterprise [for base: stake cred is keyhash/scripthash] +; bit 4: payment cred is keyhash/scripthash +; bits 3-0: network id +; +; reward addresses: +; bits 7-5: 111 +; bit 4: credential is keyhash/scripthash +; bits 3-0: network id +; +; byron addresses: +; bits 7-4: 1000 +; +; 0000: base address: keyhash28,keyhash28 +; 0001: base address: scripthash28,keyhash28 +; 0010: base address: keyhash28,scripthash28 +; 0011: base address: scripthash28,scripthash28 +; 0100: pointer address: keyhash28, 3 variable length uint +; 0101: pointer address: scripthash28, 3 variable length uint +; 0110: enterprise address: keyhash28 +; 0111: enterprise address: scripthash28 +; 1000: byron address +; 1110: reward account: keyhash28 +; 1111: reward account: scripthash28 +; 1001 - 1101: future formats +address = h'001000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000' + / h'102000000000000000000000000000000000000000000000000000000022000000000000000000000000000000000000000000000000000000' + / h'203000000000000000000000000000000000000000000000000000000033000000000000000000000000000000000000000000000000000000' + / h'304000000000000000000000000000000000000000000000000000000044000000000000000000000000000000000000000000000000000000' + / h'405000000000000000000000000000000000000000000000000000000087680203' + / h'506000000000000000000000000000000000000000000000000000000087680203' + / h'6070000000000000000000000000000000000000000000000000000000' + / h'7080000000000000000000000000000000000000000000000000000000' + +block = [header, + transaction_bodies : [* transaction_body], + transaction_witness_sets : [* transaction_witness_set], + transaction_metadata_set : {* transaction_index => transaction_metadata}] + +bootstrap_witness = [public_key : $vkey, + signature : $signature, + chain_code : bytes .size 32, + attributes : bytes] + +certificate = [stake_registration // + stake_deregistration // + stake_delegation // + pool_registration // + pool_retirement // + genesis_key_delegation // + move_instantaneous_rewards_cert] -stake_registration = (0, stake_credential) -stake_deregistration = (1, stake_credential) -stake_delegation = (2, stake_credential, pool_keyhash) -pool_registration = (3, pool_params) -pool_retirement = (4, pool_keyhash, epoch) -genesis_key_delegation = (5, genesishash, genesis_delegate_hash, vrf_keyhash) -move_instantaneous_rewards_cert = (6, move_instantaneous_reward) +coin = uint -move_instantaneous_reward = [ 0 / 1, { * stake_credential => coin } ] -; The first field determines where the funds are drawn from. -; 0 denotes the reserves, 1 denotes the treasury. - -stake_credential = - [ 0, addr_keyhash - // 1, scripthash - ] - -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 / null - ) +dns_name = text .size (0 .. 64) + +epoch = uint + +genesis_delegate_hash = $hash28 + +genesishash = $hash28 + +header = [header_body, body_signature : $kes_signature] + +header_body = [block_number : uint, + slot : uint, + prev_hash : $hash32 / nil, + issuer_vkey : $vkey, + vrf_vkey : $vrf_vkey, + nonce_vrf : $vrf_cert, + leader_vrf : $vrf_cert, + block_body_size : uint .size 4, + block_body_hash : $hash32, + operational_cert, + protocol_version] -port = uint .le 65535 ipv4 = bytes .size 4 + ipv6 = bytes .size 16 -dns_name = tstr .size (0..64) - -single_host_addr = ( 0 - , port / null - , ipv4 / null - , ipv6 / null - ) -single_host_name = ( 1 - , port / null - , dns_name ; An A or AAAA DNS record - ) -multi_host_name = ( 2 - , dns_name ; A SRV DNS record - ) -relay = - [ single_host_addr - // single_host_name - // multi_host_name - ] + +major_protocol_version = 1 .. 3 + +metadata_hash = $hash32 + +move_instantaneous_reward = [0 / 1, {* stake_credential => coin}] + +multisig_script = [multisig_pubkey // + multisig_all // + multisig_any // + multisig_n_of_k] + +nonce = [0 // + 1, bytes .size 32] + +nonnegative_interval = #6.30([uint, positive_int]) + +pool_keyhash = $hash28 pool_metadata = [url, metadata_hash] -url = tstr .size (0..64) - -withdrawals = { * reward_account => coin } - -update = [ proposed_protocol_parameter_updates - , epoch - ] - -proposed_protocol_parameter_updates = - { * genesishash => protocol_param_update } - -protocol_param_update = - { ? 0: uint ; minfee A - , ? 1: uint ; minfee B - , ? 2: uint ; max block body size - , ? 3: uint ; max transaction size - , ? 4: uint ; max block header size - , ? 5: coin ; key deposit - , ? 6: coin ; pool deposit - , ? 7: epoch ; maximum epoch - , ? 8: uint ; 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 ; d. decentralization constant - , ? 13: $nonce ; extra entropy - , ? 14: [protocol_version] ; protocol version - , ? 15: coin ; min utxo value - } - -transaction_witness_set = - { ?0 => [* vkeywitness ] - , ?1 => [* multisig_script ] - , ?2 => [* bootstrap_witness ] - ; In the future, new kinds of witnesses can be added like this: - ; , ?3 => [* monetary_policy_script ] - ; , ?4 => [* plutus_script ] - } - -transaction_metadatum = - { * transaction_metadatum => transaction_metadatum } - / [ * transaction_metadatum ] - / int - / bytes .size (0..64) - / text .size (0..64) + +port = uint .le 65535 + +positive_int = 1 .. 18446744073709551615 + +proposed_protocol_parameter_updates = {* genesishash => protocol_param_update} + +protocol_param_update = {? 0 : uint, + ? 1 : uint, + ? 2 : uint, + ? 3 : uint, + ? 4 : uint .size 2, + ? 5 : coin, + ? 6 : coin, + ? 7 : epoch, + ? 8 : uint, + ? 9 : nonnegative_interval, + ? 10 : unit_interval, + ? 11 : unit_interval, + ? 12 : unit_interval, + ? 13 : nonce, + ? 14 : [protocol_version], + ? 15 : coin} + +relay = [single_host_addr // + single_host_name // + multi_host_name] + +reward_account = h'E090000000000000000000000000000000000000000000000000000000' + / h'F0A0000000000000000000000000000000000000000000000000000000' + +scripthash = $hash28 + +signkeyKES = bytes .size 64 + +stake_credential = [0, addr_keyhash // + 1, scripthash] + +transaction = [transaction_body, + transaction_witness_set, + transaction_metadata / nil] + +transaction_body = {0 : set, + 1 : [* transaction_output], + 2 : coin, + 3 : uint, + ? 4 : [* certificate], + ? 5 : withdrawals, + ? 6 : update, + ? 7 : metadata_hash} + +transaction_index = uint .size 2 + +transaction_input = [transaction_id : $hash32, index : uint] + +transaction_metadata = {* transaction_metadatum_label => transaction_metadatum} + +transaction_metadatum = {* transaction_metadatum => transaction_metadatum} + / [* transaction_metadatum] + / int + / bytes .size (0 .. 64) + / text .size (0 .. 64) transaction_metadatum_label = uint -transaction_metadata = - { * transaction_metadatum_label => transaction_metadatum } +transaction_output = [address, amount : coin] + +transaction_witness_set = {? 0 : [* vkeywitness], + ? 1 : [* multisig_script], + ? 2 : [* bootstrap_witness]} + +unit_interval = #6.30([1, 2]) + +update = [proposed_protocol_parameter_updates, epoch] + +url = text .size (0 .. 64) + +vkeywitness = [$vkey, $signature] + +vrf_keyhash = $hash32 + +withdrawals = {* reward_account => coin} + +genesis_key_delegation = (5, genesishash, genesis_delegate_hash, vrf_keyhash) + +move_instantaneous_rewards_cert = (6, move_instantaneous_reward) -vkeywitness = [ $vkey, $signature ] +multi_host_name = (2, dns_name) -bootstrap_witness = - [ public_key : $vkey - , signature : $signature - , chain_code : bytes .size 32 - , attributes : bytes - ] +multisig_all = (1, [* multisig_script]) -multisig_script = - [ multisig_pubkey - // multisig_all - // multisig_any - // multisig_n_of_k - ] +multisig_any = (2, [* multisig_script]) + +multisig_n_of_k = (3, uint, [* multisig_script]) multisig_pubkey = (0, addr_keyhash) -multisig_all = (1, [ * multisig_script ]) -multisig_any = (2, [ * multisig_script ]) -multisig_n_of_k = (3, n: uint, [ * multisig_script ]) -coin = uint -epoch = uint +operational_cert = ($kes_vkey, uint, uint, $signature) -addr_keyhash = $hash28 -genesis_delegate_hash = $hash28 -pool_keyhash = $hash28 -genesishash = $hash28 +pool_params = (pool_keyhash, + vrf_keyhash, + coin, + coin, + unit_interval, + reward_account, + set, + [* relay], + pool_metadata / nil) + +pool_registration = (3, pool_params) + +pool_retirement = (4, pool_keyhash, epoch) -vrf_keyhash = $hash32 -metadata_hash = $hash32 +protocol_version = (major_protocol_version, uint) + +single_host_addr = (0, port / nil, ipv4 / nil, ipv6 / nil) + +single_host_name = (1, port / nil, dns_name) + +stake_delegation = (2, stake_credential, pool_keyhash) + +; This will be deprecated in a future era +stake_deregistration = (1, stake_credential) -; 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. -; In the Shelley era there is only one such tag, -; namely "\x00" for multisig scripts. -scripthash = $hash28 +; This will be deprecated in a future era +stake_registration = (0, stake_credential) -$nonce /= [ 0 // 1, bytes .size 32 ] +set = [* a0] diff --git a/eras/shelley/impl/huddle-cddl/Main.hs b/eras/shelley/impl/huddle-cddl/Main.hs new file mode 100644 index 00000000000..bbd2280c4d4 --- /dev/null +++ b/eras/shelley/impl/huddle-cddl/Main.hs @@ -0,0 +1,11 @@ +module Main where + +import Paths_cardano_ledger_shelley +import Test.Cardano.Ledger.Binary.Cuddle (writeSpec) +import qualified Test.Cardano.Ledger.Shelley.CDDL as Shelley + +-- Generate cddl files for all relevant specifications +main :: IO () +main = do + specFile <- getDataFileName "cddl-files/shelley.cddl" + writeSpec Shelley.shelley specFile diff --git a/eras/shelley/impl/test/Test/Cardano/Ledger/Shelley/Binary/CddlSpec.hs b/eras/shelley/impl/test/Test/Cardano/Ledger/Shelley/Binary/CddlSpec.hs index dc0ce45b610..9ba0750c849 100644 --- a/eras/shelley/impl/test/Test/Cardano/Ledger/Shelley/Binary/CddlSpec.hs +++ b/eras/shelley/impl/test/Test/Cardano/Ledger/Shelley/Binary/CddlSpec.hs @@ -25,11 +25,18 @@ import Test.Cardano.Ledger.Binary.Cddl ( cddlRoundTripAnnCborSpec, cddlRoundTripCborSpec, ) +import Test.Cardano.Ledger.Binary.Cuddle ( + huddleRoundTripAnnCborSpec, + huddleRoundTripCborSpec, + specWithHuddle, + ) import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Shelley.Binary.Cddl (readShelleyCddlFiles) +import qualified Test.Cardano.Ledger.Shelley.CDDL as ShelleyCDDL spec :: Spec -spec = +spec = do + newSpec describe "CDDL" $ beforeAllCddlFile 3 readShelleyCddlFiles $ do let v = eraProtVerLow @Shelley cddlRoundTripAnnCborSpec @(BootstrapWitness StandardCrypto) v "bootstrap_witness" @@ -47,3 +54,23 @@ spec = cddlRoundTripCborSpec @(ProposedPPUpdates Shelley) v "proposed_protocol_parameter_updates" cddlRoundTripCborSpec @(PParamsUpdate Shelley) v "protocol_param_update" cddlRoundTripAnnCborSpec @(Tx Shelley) v "transaction" + +newSpec :: Spec +newSpec = describe "Huddle" $ specWithHuddle ShelleyCDDL.shelley 100 $ do + let v = eraProtVerHigh @Shelley + huddleRoundTripCborSpec @(Addr StandardCrypto) v "address" + huddleRoundTripAnnCborSpec @(BootstrapWitness StandardCrypto) v "bootstrap_witness" + huddleRoundTripCborSpec @(RewardAccount StandardCrypto) v "reward_account" + huddleRoundTripCborSpec @(Credential 'Staking StandardCrypto) v "stake_credential" + huddleRoundTripAnnCborSpec @(TxBody Shelley) v "transaction_body" + huddleRoundTripCborSpec @(TxOut Shelley) v "transaction_output" + huddleRoundTripCborSpec @StakePoolRelay v "relay" + huddleRoundTripCborSpec @(TxCert Shelley) v "certificate" + huddleRoundTripCborSpec @(TxIn StandardCrypto) v "transaction_input" + huddleRoundTripAnnCborSpec @(TxAuxData Shelley) v "transaction_metadata" + huddleRoundTripAnnCborSpec @(MultiSig Shelley) v "multisig_script" + huddleRoundTripCborSpec @(Update Shelley) v "update" + huddleRoundTripCborSpec @(ProposedPPUpdates Shelley) v "proposed_protocol_parameter_updates" + huddleRoundTripCborSpec @(PParamsUpdate Shelley) v "protocol_param_update" + huddleRoundTripAnnCborSpec @(Tx Shelley) v "transaction" + huddleRoundTripAnnCborSpec @(TxWits Shelley) v "transaction_witness_set" diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Binary/Cddl.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Binary/Cddl.hs index 535ba1533c0..46a31c50d5d 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Binary/Cddl.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Binary/Cddl.hs @@ -9,10 +9,8 @@ import Paths_cardano_ledger_shelley readShelleyCddlFileNames :: IO [FilePath] readShelleyCddlFileNames = do base <- getDataFileName "cddl-files/shelley.cddl" - crypto <- getDataFileName "cddl-files/crypto.cddl" - extras <- getDataFileName "cddl-files/extras.cddl" -- extras contains the types whose restrictions cannot be expressed in CDDL - pure [base, crypto, extras] + pure [base] readShelleyCddlFiles :: IO [BSL.ByteString] readShelleyCddlFiles = mapM BSL.readFile =<< readShelleyCddlFileNames diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs new file mode 100644 index 00000000000..0a382cedcd2 --- /dev/null +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs @@ -0,0 +1,377 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use camelCase" #-} +{-# HLINT ignore "Evaluate" #-} +module Test.Cardano.Ledger.Shelley.CDDL where + +import Codec.CBOR.Cuddle.Huddle +import Data.Function (($)) +import Data.Word (Word64) +import GHC.Num (Integer) +import Test.Cardano.Ledger.Core.Binary.CDDL hiding ( + nonempty_set, + set, + ) + +shelley :: Huddle +shelley = collectFrom [block, transaction, signkeyKES] + +block :: Rule +block = + "block" + =:= arr + [ a header + , "transaction_bodies" ==> arr [0 <+ a transaction_body] + , "transaction_witness_sets" + ==> arr [0 <+ a transaction_witness_set] + , "transaction_metadata_set" + ==> mp [0 <+ asKey transaction_index ==> transaction_metadata] + ] + +transaction :: Rule +transaction = + "transaction" + =:= arr + [ a transaction_body + , a transaction_witness_set + , a (transaction_metadata / VNil) + ] + +transaction_index :: Rule +transaction_index = "transaction_index" =:= VUInt `sized` (2 :: Word64) + +header :: Rule +header = + "header" + =:= arr + [ a header_body + , "body_signature" ==> kes_signature + ] + +header_body :: Rule +header_body = + "header_body" + =:= arr + [ "block_number" ==> VUInt + , "slot" ==> VUInt + , "prev_hash" ==> (hash32 / VNil) + , "issuer_vkey" ==> vkey + , "vrf_vkey" ==> vrf_vkey + , "nonce_vrf" ==> vrf_cert + , "leader_vrf" ==> vrf_cert + , "block_body_size" ==> (VUInt `sized` (4 :: Word64)) + , "block_body_hash" ==> hash32 + , a operational_cert + , a protocol_version + ] + +operational_cert :: Named Group +operational_cert = + "operational_cert" + =:~ grp + [ "hot_vkey" ==> kes_vkey + , "sequence_number" ==> VUInt + , "kes_period" ==> VUInt + , "sigma" ==> signature + ] + +-- TODO Replace with the following once +-- https://github.com/input-output-hk/cuddle/issues/29 is addressed in cuddle. +-- +-- next_major_protocol_version :: Rule +-- next_major_protocol_version = "next_major_protocol_version" =:= (10 :: Integer) +next_major_protocol_version :: Integer +next_major_protocol_version = 3 + +major_protocol_version :: Rule +major_protocol_version = "major_protocol_version" =:= (1 :: Integer) ... next_major_protocol_version + +protocol_version :: Named Group +protocol_version = "protocol_version" =:~ grp [a major_protocol_version, a VUInt] + +transaction_body :: Rule +transaction_body = + "transaction_body" + =:= mp + [ idx 0 ==> set transaction_input + , idx 1 ==> arr [0 <+ a transaction_output] + , idx 2 ==> coin + , idx 3 ==> VUInt + , opt (idx 4 ==> arr [0 <+ a certificate]) + , opt (idx 5 ==> withdrawals) + , opt (idx 6 ==> update) + , opt (idx 7 ==> metadata_hash) + ] + +transaction_input :: Rule +transaction_input = + "transaction_input" + =:= arr + [ "transaction_id" ==> hash32 + , "index" ==> VUInt + ] + +transaction_output :: Rule +transaction_output = + "transaction_output" + =:= arr + [ a address + , "amount" ==> coin + ] + +certificate :: Rule +certificate = + "certificate" + =:= arr [a stake_registration] + / arr [a stake_deregistration] + / arr [a stake_delegation] + / arr [a pool_registration] + / arr [a pool_retirement] + / arr [a genesis_key_delegation] + / arr [a move_instantaneous_rewards_cert] + +stake_registration :: Named Group +stake_registration = + comment "This will be deprecated in a future era" $ + "stake_registration" =:~ grp [0, a stake_credential] + +stake_deregistration :: Named Group +stake_deregistration = + comment "This will be deprecated in a future era" $ + "stake_deregistration" =:~ grp [1, a stake_credential] + +stake_delegation :: Named Group +stake_delegation = + "stake_delegation" + =:~ grp [2, a stake_credential, a pool_keyhash] + +-- POOL +pool_registration :: Named Group +pool_registration = "pool_registration" =:~ grp [3, a pool_params] + +pool_retirement :: Named Group +pool_retirement = "pool_retirement" =:~ grp [4, a pool_keyhash, a epoch] + +genesis_key_delegation :: Named Group +genesis_key_delegation = + "genesis_key_delegation" + =:~ grp [5, a genesishash, a genesis_delegate_hash, a vrf_keyhash] + +move_instantaneous_rewards_cert :: Named Group +move_instantaneous_rewards_cert = + "move_instantaneous_rewards_cert" + =:~ grp [6, a move_instantaneous_reward] + +move_instantaneous_reward :: Rule +move_instantaneous_reward = + "move_instantaneous_reward" + =:= arr [a (int 0 / int 1), a $ mp [0 <+ asKey stake_credential ==> coin]] + +stake_credential :: Rule +stake_credential = + "stake_credential" + =:= arr + [0, a addr_keyhash] + / arr [1, a scripthash] + +pool_params :: Named Group +pool_params = + "pool_params" + =:~ grp + [ "operator" ==> pool_keyhash + , "vrf_keyhash" ==> vrf_keyhash + , "pledge" ==> coin + , "cost" ==> coin + , "margin" ==> unit_interval + , "reward_account" ==> reward_account + , "pool_owners" ==> set addr_keyhash + , "relays" ==> arr [0 <+ a relay] + , "pool_metadata" ==> (pool_metadata / VNil) + ] + +port :: Rule +port = "port" =:= VUInt `le` 65535 + +ipv4 :: Rule +ipv4 = "ipv4" =:= VBytes `sized` (4 :: Word64) + +ipv6 :: Rule +ipv6 = "ipv6" =:= VBytes `sized` (16 :: Word64) + +dns_name :: Rule +dns_name = "dns_name" =:= VText `sized` (0 :: Word64, 64 :: Word64) + +single_host_addr :: Named Group +single_host_addr = + "single_host_addr" + =:~ grp + [ 0 + , port / VNil + , ipv4 / VNil + , ipv6 / VNil + ] + +single_host_name :: Named Group +single_host_name = + "single_host_name" + =:~ grp + [ 1 + , port / VNil + , a dns_name -- An A or AAAA DNS record + ] + +multi_host_name :: Named Group +multi_host_name = + "multi_host_name" + =:~ grp + [ 2 + , a dns_name -- A SRV DNS record + ] + +relay :: Rule +relay = + "relay" + =:= arr [a single_host_addr] + / arr [a single_host_name] + / arr [a multi_host_name] + +pool_metadata :: Rule +pool_metadata = "pool_metadata" =:= arr [a url, a metadata_hash] + +url :: Rule +url = "url" =:= VText `sized` (0 :: Word64, 64 :: Word64) + +withdrawals :: Rule +withdrawals = "withdrawals" =:= mp [0 <+ asKey reward_account ==> coin] + +update :: Rule +update = "update" =:= arr [a proposed_protocol_parameter_updates, a epoch] + +proposed_protocol_parameter_updates :: Rule +proposed_protocol_parameter_updates = + "proposed_protocol_parameter_updates" + =:= mp [0 <+ asKey genesishash ==> protocol_param_update] + +protocol_param_update :: Rule +protocol_param_update = + "protocol_param_update" + =:= mp + [ opt (idx 0 ==> VUInt) -- minfee A + , opt (idx 1 ==> VUInt) -- minfee B + , opt (idx 2 ==> VUInt) -- max block body size + , opt (idx 3 ==> VUInt) -- max transaction size + , opt (idx 4 ==> (VUInt `sized` (2 :: Word64))) -- max block header size + , opt (idx 5 ==> coin) -- key deposit + , opt (idx 6 ==> coin) -- pool deposit + , opt (idx 7 ==> epoch) -- maximum epoch + , opt (idx 8 ==> VUInt) -- n_opt: desired number of stake pools + , opt (idx 9 ==> nonnegative_interval) -- pool pledge influence + , opt (idx 10 ==> unit_interval) -- expansion rate + , opt (idx 11 ==> unit_interval) -- treasury growth rate + , opt (idx 12 ==> unit_interval) -- decentralisation constant + , opt (idx 13 ==> nonce) -- extra entropy + , opt (idx 14 ==> arr [a protocol_version]) -- protocol version + , opt (idx 15 ==> coin) -- min utxo value + ] + +transaction_witness_set :: Rule +transaction_witness_set = + "transaction_witness_set" + =:= mp + [ opt $ idx 0 ==> arr [0 <+ a vkeywitness] + , opt $ idx 1 ==> arr [0 <+ a multisig_script] + , opt $ idx 2 ==> arr [0 <+ a bootstrap_witness] + ] + +transaction_metadatum :: Rule +transaction_metadatum = + "transaction_metadatum" + =:= smp [0 <+ asKey transaction_metadatum ==> transaction_metadatum] + / sarr [0 <+ a transaction_metadatum] + / VInt + / (VBytes `sized` (0 :: Word64, 64 :: Word64)) + / (VText `sized` (0 :: Word64, 64 :: Word64)) + +transaction_metadatum_label :: Rule +transaction_metadatum_label = "transaction_metadatum_label" =:= VUInt + +transaction_metadata :: Rule +transaction_metadata = + "transaction_metadata" + =:= mp + [ 0 + <+ asKey transaction_metadatum_label + ==> transaction_metadatum + ] + +vkeywitness :: Rule +vkeywitness = "vkeywitness" =:= arr [a vkey, a signature] + +bootstrap_witness :: Rule +bootstrap_witness = + "bootstrap_witness" + =:= arr + [ "public_key" ==> vkey + , "signature" ==> signature + , "chain_code" ==> (VBytes `sized` (32 :: Word64)) + , "attributes" ==> VBytes + ] + +multisig_script :: Rule +multisig_script = + "multisig_script" + =:= arr [a multisig_pubkey] + / arr [a multisig_all] + / arr [a multisig_any] + / arr [a multisig_n_of_k] + +multisig_pubkey :: Named Group +multisig_pubkey = "multisig_pubkey" =:~ grp [0, a addr_keyhash] + +multisig_all :: Named Group +multisig_all = "multisig_all" =:~ grp [1, a (arr [0 <+ a multisig_script])] + +multisig_any :: Named Group +multisig_any = "multisig_any" =:~ grp [2, a (arr [0 <+ a multisig_script])] + +multisig_n_of_k :: Named Group +multisig_n_of_k = + "multisig_n_of_k" + =:~ grp [3, "n" ==> VUInt, a (arr [0 <+ a multisig_script])] + +epoch :: Rule +epoch = "epoch" =:= VUInt + +genesis_delegate_hash :: Rule +genesis_delegate_hash = "genesis_delegate_hash" =:= hash28 + +genesishash :: Rule +genesishash = "genesishash" =:= hash28 + +scripthash :: Rule +scripthash = "scripthash" =:= hash28 + +metadata_hash :: Rule +metadata_hash = "metadata_hash" =:= hash32 + +nonce :: Rule +nonce = + "nonce" + =:= arr [0] + / arr [1, a (VBytes `sized` (32 :: Word64))] + +-------------------------------------------------------------------------------- +-- Shelley does not support some of the tagged core datastructured that we rely +-- on in future eras. In order to have the "correct" common specification in +-- core, we override them here +-------------------------------------------------------------------------------- +set :: IsType0 t0 => t0 -> GRuleCall +set = binding $ \x -> "set" =:= arr [0 <+ a x] + +nonempty_set :: IsType0 t0 => t0 -> GRuleCall +nonempty_set = binding $ \x -> + "nonempty_set" + =:= arr [1 <+ a x] diff --git a/flake.lock b/flake.lock index ff92b17f209..a65973e6854 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1723068470, - "narHash": "sha256-I3afsEv18Uspc61hRTUgE86HM8q7NZZzkMrjfJHNQEA=", + "lastModified": 1723730199, + "narHash": "sha256-0A7eS9bHkk65jmOcOWPRnaRdpRGMkMWTkZh1NDFM240=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "7b7fa5b21ae6e06489b26eddd1fb5e925f1595c3", + "rev": "de3964f328b8d543ed3e2c167297a5d5ddf6fac4", "type": "github" }, "original": { diff --git a/hie.yaml b/hie.yaml index c5294fc6686..ed6d5c2b055 100644 --- a/hie.yaml +++ b/hie.yaml @@ -6,6 +6,12 @@ cradle: - path: "eras/allegra/impl/testlib" component: "cardano-ledger-allegra:lib:testlib" + - path: "eras/allegra/impl/huddle-cddl/Main.hs" + component: "cardano-ledger-allegra:exe:huddle-cddl" + + - path: "eras/allegra/impl/huddle-cddl/Paths_cardano_ledger_allegra.hs" + component: "cardano-ledger-allegra:exe:huddle-cddl" + - path: "eras/allegra/impl/test" component: "cardano-ledger-allegra:test:tests" @@ -117,6 +123,12 @@ cradle: - path: "eras/mary/impl/testlib" component: "cardano-ledger-mary:lib:testlib" + - path: "eras/mary/impl/huddle-cddl/Main.hs" + component: "cardano-ledger-mary:exe:huddle-cddl" + + - path: "eras/mary/impl/huddle-cddl/Paths_cardano_ledger_mary.hs" + component: "cardano-ledger-mary:exe:huddle-cddl" + - path: "eras/mary/impl/test" component: "cardano-ledger-mary:test:tests" @@ -126,6 +138,12 @@ cradle: - path: "eras/shelley/impl/testlib" component: "cardano-ledger-shelley:lib:testlib" + - path: "eras/shelley/impl/huddle-cddl/Main.hs" + component: "cardano-ledger-shelley:exe:huddle-cddl" + + - path: "eras/shelley/impl/huddle-cddl/Paths_cardano_ledger_shelley.hs" + component: "cardano-ledger-shelley:exe:huddle-cddl" + - path: "eras/shelley/impl/test" component: "cardano-ledger-shelley:test:tests" diff --git a/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Cuddle.hs b/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Cuddle.hs index 7c877b4c72b..afbf4c0d069 100644 --- a/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Cuddle.hs +++ b/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Cuddle.hs @@ -217,6 +217,6 @@ writeSpec hddl path = preface = "; This file was auto-generated from huddle. Please do not modify it directly!" in withFile path WriteMode $ \h -> do hPutStrLn h preface - hPutDoc h (pretty $ Cuddle.sortCDDL cddl) + hPutDoc h (pretty cddl) -- Write an empty line at the end of the file hPutStrLn h "" diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index 304c75e232e..7930274cd3a 100644 --- a/libs/cardano-ledger-core/cardano-ledger-core.cabal +++ b/libs/cardano-ledger-core/cardano-ledger-core.cabal @@ -146,6 +146,7 @@ library testlib Test.Cardano.Ledger.Core.Address Test.Cardano.Ledger.Core.Arbitrary Test.Cardano.Ledger.Core.Binary + Test.Cardano.Ledger.Core.Binary.CDDL Test.Cardano.Ledger.Core.Binary.RoundTrip Test.Cardano.Ledger.Core.JSON Test.Cardano.Ledger.Core.KeyPair @@ -182,6 +183,7 @@ library testlib cardano-ledger-byron, cardano-ledger-byron-test, containers, + cuddle, data-default-class, deepseq, FailT, @@ -189,6 +191,7 @@ library testlib genvalidity, hspec, hedgehog-quickcheck, + here, HUnit, mtl, nothunks, diff --git a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/CDDL.hs b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/CDDL.hs new file mode 100644 index 00000000000..72420a2ef09 --- /dev/null +++ b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/CDDL.hs @@ -0,0 +1,238 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use camelCase" #-} +{-# HLINT ignore "Evaluate" #-} + +module Test.Cardano.Ledger.Core.Binary.CDDL where + +import Codec.CBOR.Cuddle.Huddle +import Data.Function (($)) +import Data.Semigroup ((<>)) +import Data.String.Here (here) +import qualified Data.Text as T +import Data.Word (Word64) +import GHC.Show (Show (show)) +import Prelude (Integer) + +-------------------------------------------------------------------------------- +-- Base Types +-------------------------------------------------------------------------------- +coin :: Rule +coin = "coin" =:= VUInt + +positive_coin :: Rule +positive_coin = "positive_coin" =:= 1 ... maxWord64 + +address :: Rule +address = + comment + [here| + address = bytes + reward_account = bytes + + address format: + [ 8 bit header | payload ]; + + shelley payment addresses: + bit 7: 0 + bit 6: base/other + bit 5: pointer/enterprise [for base: stake cred is keyhash/scripthash] + bit 4: payment cred is keyhash/scripthash + bits 3-0: network id + + reward addresses: + bits 7-5: 111 + bit 4: credential is keyhash/scripthash + bits 3-0: network id + + byron addresses: + bits 7-4: 1000 + + 0000: base address: keyhash28,keyhash28 + 0001: base address: scripthash28,keyhash28 + 0010: base address: keyhash28,scripthash28 + 0011: base address: scripthash28,scripthash28 + 0100: pointer address: keyhash28, 3 variable length uint + 0101: pointer address: scripthash28, 3 variable length uint + 0110: enterprise address: keyhash28 + 0111: enterprise address: scripthash28 + 1000: byron address + 1110: reward account: keyhash28 + 1111: reward account: scripthash28 + 1001 - 1101: future formats + |] + $ "address" + =:= bstr + "001000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000" + / bstr + "102000000000000000000000000000000000000000000000000000000022000000000000000000000000000000000000000000000000000000" + / bstr + "203000000000000000000000000000000000000000000000000000000033000000000000000000000000000000000000000000000000000000" + / bstr + "304000000000000000000000000000000000000000000000000000000044000000000000000000000000000000000000000000000000000000" + / bstr "405000000000000000000000000000000000000000000000000000000087680203" + / bstr "506000000000000000000000000000000000000000000000000000000087680203" + / bstr "6070000000000000000000000000000000000000000000000000000000" + / bstr "7080000000000000000000000000000000000000000000000000000000" + +reward_account :: Rule +reward_account = + "reward_account" + =:= bstr "E090000000000000000000000000000000000000000000000000000000" + / bstr "F0A0000000000000000000000000000000000000000000000000000000" + +addr_keyhash :: Rule +addr_keyhash = "addr_keyhash" =:= hash28 + +pool_keyhash :: Rule +pool_keyhash = "pool_keyhash" =:= hash28 + +vrf_keyhash :: Rule +vrf_keyhash = "vrf_keyhash" =:= hash32 + +-------------------------------------------------------------------------------- +-- Crypto +-------------------------------------------------------------------------------- + +hash28 :: Rule +hash28 = "$hash28" =:= VBytes `sized` (28 :: Word64) + +hash32 :: Rule +hash32 = "$hash32" =:= VBytes `sized` (32 :: Word64) + +vkey :: Rule +vkey = "$vkey" =:= VBytes `sized` (32 :: Word64) + +vrf_vkey :: Rule +vrf_vkey = "$vrf_vkey" =:= VBytes `sized` (32 :: Word64) + +vrf_cert :: Rule +vrf_cert = "$vrf_cert" =:= arr [a VBytes, a (VBytes `sized` (80 :: Word64))] + +kes_vkey :: Rule +kes_vkey = "$kes_vkey" =:= VBytes `sized` (32 :: Word64) + +kes_signature :: Rule +kes_signature = "$kes_signature" =:= VBytes `sized` (448 :: Word64) + +signkeyKES :: Rule +signkeyKES = "signkeyKES" =:= VBytes `sized` (64 :: Word64) + +signature :: Rule +signature = "$signature" =:= VBytes `sized` (64 :: Word64) + +-------------------------------------------------------------------------------- +-- Utility +-------------------------------------------------------------------------------- + +big_int :: Rule +big_int = "big_int" =:= VInt / big_uint / big_nint + +big_uint :: Rule +big_uint = "big_uint" =:= tag 2 bounded_bytes + +big_nint :: Rule +big_nint = "big_nint" =:= tag 3 bounded_bytes + +-- Once https://github.com/input-output-hk/cuddle/issues/29 is in place, replace +-- with: +-- +-- minInt64 :: Rule +-- minInt64 = "minInt64" =:= -9223372036854775808 +minInt64 :: Integer +minInt64 = -9223372036854775808 + +-- Once https://github.com/input-output-hk/cuddle/issues/29 is in place, replace +-- with: +-- +-- maxInt64 :: Rule +-- maxInt64 = "maxInt64" =:= 9223372036854775807 +maxInt64 :: Integer +maxInt64 = 9223372036854775807 + +-- Once https://github.com/input-output-hk/cuddle/issues/29 is in place, replace +-- with: +-- +-- maxWord64 :: Rule +-- maxWord64 = "maxWord64" =:= 18446744073709551615 +maxWord64 :: Integer +maxWord64 = 18446744073709551615 + +negInt64 :: Rule +negInt64 = "negInt64" =:= minInt64 ... (-1) + +posInt64 :: Rule +posInt64 = "posInt64" =:= 1 ... maxInt64 + +nonZeroInt64 :: Rule +nonZeroInt64 = "nonZeroInt64" =:= negInt64 / posInt64 -- this is the same as the current int64 definition but without zero + +int64 :: Rule +int64 = "int64" =:= minInt64 ... maxInt64 + +-- Conway era introduces an optional 258 tag for sets, which will become mandatory in the +-- second era after Conway. We recommend all the tooling to account for this future breaking +-- change sooner rather than later, in order to provide a smooth transition for their users. + +set :: IsType0 t0 => t0 -> GRuleCall +set = binding $ \x -> "set" =:= tag 258 (arr [0 <+ a x]) / sarr [0 <+ a x] + +nonempty_set :: IsType0 t0 => t0 -> GRuleCall +nonempty_set = binding $ \x -> + "nonempty_set" + =:= tag 258 (arr [1 <+ a x]) + / sarr [1 <+ a x] + +positive_int :: Rule +positive_int = "positive_int" =:= 1 ... 18446744073709551615 + +unit_interval :: Rule +unit_interval = "unit_interval" =:= tag 30 (arr [1, 2]) + +-- unit_interval = tag 0 [uint, uint] +-- +-- Comment above depicts the actual definition for `unit_interval`. +-- +-- Unit interval is a number in the range between 0 and 1, which +-- means there are two extra constraints: +-- \* numerator <= denominator +-- \* denominator > 0 +-- +-- Relation between numerator and denominator cannot be expressed in CDDL, which +-- poses a problem for testing. We need to be able to generate random valid data +-- for testing implementation of our encoders/decoders. Which means we cannot use +-- the actual definition here and we hard code the value to 1/2 + +-- nonnegative_interval = tag 0 [uint, positive_int] +nonnegative_interval :: Rule +nonnegative_interval = "nonnegative_interval" =:= tag 30 (arr [a VUInt, a positive_int]) + +bounded_bytes :: Rule +bounded_bytes = "bounded_bytes" =:= VBytes `sized` (0 :: Word64, 64 :: Word64) + +-- 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 ) + +-- a type for distinct values. +-- The type parameter must support .size, for example: bytes or uint +distinct :: IsSizeable s => Value s -> Rule +distinct x = + "distinct_" + <> T.pack (show x) + =:= (x `sized` (8 :: Word64)) + / (x `sized` (16 :: Word64)) + / (x `sized` (20 :: Word64)) + / (x `sized` (24 :: Word64)) + / (x `sized` (30 :: Word64)) + / (x `sized` (32 :: Word64)) diff --git a/scripts/gen-cddl.sh b/scripts/gen-cddl.sh index 444e6d598ef..7a976348323 100755 --- a/scripts/gen-cddl.sh +++ b/scripts/gen-cddl.sh @@ -2,8 +2,14 @@ set -euo pipefail -changed=$(git diff --name-only origin/master -- 'eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs') +eras=("shelley" "allegra" "mary" "conway") -if [[ -n "$changed" ]]; then - cabal run cardano-ledger-conway:exe:huddle-cddl -fi +for era in ${eras[@]}; do + + changed=$(git diff --name-only origin/master -- 'eras/${era}/impl/testlib/Test/Cardano/Ledger/${era^}/CDDL.hs') + + if [[ -n "$changed" ]]; then + cabal run cardano-ledger-$era:exe:huddle-cddl + fi + +done