diff --git a/eras/allegra/impl/cardano-ledger-allegra.cabal b/eras/allegra/impl/cardano-ledger-allegra.cabal index 5d1233075a3..43f66bf4f55 100644 --- a/eras/allegra/impl/cardano-ledger-allegra.cabal +++ b/eras/allegra/impl/cardano-ledger-allegra.cabal @@ -11,11 +11,7 @@ description: category: Network build-type: Simple -data-files: - cddl-files/allegra.cddl - cddl-files/crypto.cddl - cddl-files/extras.cddl - +data-files: cddl-files/allegra.cddl extra-source-files: CHANGELOG.md source-repository head @@ -85,6 +81,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 @@ -108,6 +105,7 @@ library testlib cardano-ledger-shelley:{cardano-ledger-shelley, testlib}, cardano-strict-containers, containers, + cuddle, generic-random, microlens, mtl, @@ -115,6 +113,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..a9085a8f255 --- /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 +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 9dbad6c108d..c05a2d3b020 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -148,6 +148,13 @@ library testlib build-depends: base, bytestring, + cardano-data:{cardano-data, testlib}, + containers, + cuddle >=0.3.1.0, + plutus-ledger-api, + deepseq, + here, + microlens, cardano-crypto-class, cardano-data:{cardano-data, testlib}, cardano-ledger-allegra, diff --git a/eras/mary/impl/cardano-ledger-mary.cabal b/eras/mary/impl/cardano-ledger-mary.cabal index 613068525f3..926635bf43c 100644 --- a/eras/mary/impl/cardano-ledger-mary.cabal +++ b/eras/mary/impl/cardano-ledger-mary.cabal @@ -12,11 +12,7 @@ description: category: Network build-type: Simple -data-files: - cddl-files/mary.cddl - cddl-files/crypto.cddl - cddl-files/extras.cddl - +data-files: cddl-files/mary.cddl extra-source-files: CHANGELOG.md source-repository head @@ -95,6 +91,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 @@ -121,8 +118,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..e1acc797d11 --- /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 +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/hie.yaml b/hie.yaml index 38ee0f21ec5..6d9fd7d996c 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" diff --git a/scripts/gen-cddl.sh b/scripts/gen-cddl.sh index 6863396f5ff..7a976348323 100755 --- a/scripts/gen-cddl.sh +++ b/scripts/gen-cddl.sh @@ -2,7 +2,7 @@ set -euo pipefail -eras=("shelley" "conway") +eras=("shelley" "allegra" "mary" "conway") for era in ${eras[@]}; do