From 2a9488c8eadb889a3cb0dc036530fb75afbc2b42 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Tue, 13 Aug 2024 09:31:01 +0200 Subject: [PATCH 01/13] Move extras and crypto types to core CDDL Now that the CDDL is defined with Cuddle, we can begin to properly modularise it. As a first step, we move the common crypto and utility types into the core package. --- .../Test/Cardano/Ledger/Conway/CDDL.hs | 121 +--------------- .../cardano-ledger-core.cabal | 2 + .../Test/Cardano/Ledger/Core/Binary/CDDL.hs | 136 ++++++++++++++++++ 3 files changed, 139 insertions(+), 120 deletions(-) create mode 100644 libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/CDDL.hs 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..8e64fc78258 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs @@ -16,6 +16,7 @@ import Data.Text qualified as T import Data.Word (Word64) import GHC.Num (Integer) import GHC.Show (Show (show)) +import Test.Cardano.Ledger.Core.Binary.CDDL conway :: Huddle conway = @@ -888,123 +889,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/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index 304c75e232e..847ee12e2b5 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, 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..03a3c686f79 --- /dev/null +++ b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/CDDL.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# 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 qualified Data.Text as T +import Data.Word (Word64) +import GHC.Show (Show (show)) + +-------------------------------------------------------------------------------- +-- 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)) From ed05a1881e1abd8f512aec98b36665abaf579101 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Tue, 13 Aug 2024 10:15:50 +0200 Subject: [PATCH 02/13] Define Shelley CDDL via Huddle --- .../shelley/impl/cardano-ledger-shelley.cabal | 2 + .../Test/Cardano/Ledger/Shelley/CDDL.hs | 358 ++++++++++++++++++ 2 files changed, 360 insertions(+) create mode 100644 eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index cdab762fb50..28032fc039f 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -137,6 +137,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 +171,7 @@ library testlib cardano-slotting:{cardano-slotting, testlib}, cardano-strict-containers, containers, + cuddle, FailT, generic-random, hedgehog-quickcheck, 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..b6ee2e7464b --- /dev/null +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs @@ -0,0 +1,358 @@ +{-# 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 + +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 :: Rule +operational_cert = + "operational_cert" + =:= arr + [ "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 :: Rule +protocol_version = "protocol_version" =:= arr [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, + opt (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 pool_metadata_hash] + +url :: Rule +url = "url" =:= VText `sized` (0 :: Word64, 64 :: Word64) + +withdrawals :: Rule +withdrawals = "withdrawals" =:= mp [1 <+ 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 ==> coin), -- minfee A + opt (idx 1 ==> coin), -- minfee B + opt (idx 2 ==> (VUInt `sized` (4 :: Word64))), -- max block body size + opt (idx 3 ==> (VUInt `sized` (4 :: Word64))), -- max transaction size + opt (idx 4 ==> (VUInt `sized` (2 :: Word64))), -- max block header size + opt (idx 5 ==> coin), -- key deposit + opt (idx 6 ==> coin), -- pool deposit + opt (idx 7 ==> epoch), -- maximum epoch + opt (idx 8 ==> (VUInt `sized` (2 :: Word64))), -- 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 script_pubkey] + / arr [a script_all] + / arr [a script_any] + / arr [a script_n_of_k] + +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 multisig_script])] + +script_any :: Named Group +script_any = "script_any" =:~ grp [2, a (arr [0 <+ a multisig_script])] + +script_n_of_k :: Named Group +script_n_of_k = + "script_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 + +pool_metadata_hash :: Rule +pool_metadata_hash = "pool_metadata_hash" =:= hash32 + +nonce :: Rule +nonce = "nonce" =:= + arr [ a (int 0 / int 1), a (VBytes `sized` (32 :: Word64))] From 830e1c4ef5dc997ec0f7f9c6a013cbf50c7f0083 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Tue, 13 Aug 2024 12:00:41 +0200 Subject: [PATCH 03/13] Generate Shelley CDDL using Huddle. - Switch existing tests to using the generated CDDL - Add additional Huddle based tests for Shelley types - Add a tool to regenerate the Shelley CDDL from Huddle - Move additional core types to the core CDDL - Make a few fixes in the Shelley Huddle spec There is one unusual thing here: the size bound on the max block header size in the protocol param update. This does not reflect the original CDDL, but it is consistent with the FromCBOR instance and the underlying data type in PParams. I can only assume that the CDDL generator wasn't exploring the whole range and thus never found this error. --- .../shelley/impl/cardano-ledger-shelley.cabal | 21 +- eras/shelley/impl/cddl-files/crypto.cddl | 13 - eras/shelley/impl/cddl-files/extras.cddl | 27 -- eras/shelley/impl/cddl-files/shelley.cddl | 425 ++++++++---------- eras/shelley/impl/huddle-cddl/Main.hs | 11 + .../Cardano/Ledger/Shelley/Binary/CddlSpec.hs | 29 +- .../Cardano/Ledger/Shelley/Binary/Cddl.hs | 4 +- .../Test/Cardano/Ledger/Shelley/CDDL.hs | 93 ++-- .../Test/Cardano/Ledger/Core/Binary/CDDL.hs | 115 +++-- 9 files changed, 393 insertions(+), 345 deletions(-) delete mode 100644 eras/shelley/impl/cddl-files/crypto.cddl delete mode 100644 eras/shelley/impl/cddl-files/extras.cddl create mode 100644 eras/shelley/impl/huddle-cddl/Main.hs diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index 28032fc039f..228c64d574e 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 @@ -192,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..a2d684363b6 100644 --- a/eras/shelley/impl/cddl-files/shelley.cddl +++ b/eras/shelley/impl/cddl-files/shelley.cddl @@ -1,258 +1,217 @@ -; 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! +$hash28 = bytes .size 28 -transaction_index = uint .size 2 +$hash32 = bytes .size 32 -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 +$kes_signature = bytes .size 448 -protocol_version = (major_protocol_version, uint) +$kes_vkey = bytes .size 32 -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 - ] +$signature = bytes .size 64 -transaction_output = [address, amount : coin] +$vkey = bytes .size 32 -; 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 - ] +$vrf_cert = [bytes, bytes .size 80] + +$vrf_vkey = bytes .size 32 + +addr_keyhash = $hash28 + +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] + +coin = uint + +dns_name = text .size (0 .. 64) + +epoch = uint + +genesis_delegate_hash = $hash28 -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) -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 - ) +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 - ] -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) +major_protocol_version = 1 .. 3 -transaction_metadatum_label = uint +metadata_hash = $hash32 -transaction_metadata = - { * transaction_metadatum_label => transaction_metadatum } +move_instantaneous_reward = [0 / 1, {* stake_credential => coin}] + +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 +multisig_script = [multisig_pubkey + // multisig_all + // multisig_any + // multisig_n_of_k] -addr_keyhash = $hash28 -genesis_delegate_hash = $hash28 -pool_keyhash = $hash28 -genesishash = $hash28 +nonce = [0 // 1, bytes .size 32] + +nonnegative_interval = #6.30([uint, positive_int]) + +operational_cert = ($kes_vkey, uint, uint, $signature) + +pool_keyhash = $hash28 + +pool_metadata = [url, metadata_hash] + +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) + +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} + +protocol_version = (major_protocol_version, uint) + +relay = [single_host_addr // single_host_name // multi_host_name] + +reward_account = h'E090000000000000000000000000000000000000000000000000000000' + / h'F0A0000000000000000000000000000000000000000000000000000000' + +scripthash = $hash28 + +set = [* a0] + +signkeyKES = bytes .size 64 + +single_host_addr = (0, port / nil, ipv4 / nil, ipv6 / nil) + +single_host_name = (1, port / nil, dns_name) + +stake_credential = [0, addr_keyhash // 1, scripthash] + +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) + +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_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) -vrf_keyhash = $hash32 -metadata_hash = $hash32 +vkeywitness = [$vkey, $signature] -; 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 +vrf_keyhash = $hash32 -$nonce /= [ 0 // 1, bytes .size 32 ] +withdrawals = {* reward_account => coin} 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 index b6ee2e7464b..1d9f7e1ccc3 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs @@ -11,7 +11,13 @@ import Codec.CBOR.Cuddle.Huddle import Data.Function (($)) import Data.Word (Word64) import GHC.Num (Integer) -import Test.Cardano.Ledger.Core.Binary.CDDL +import Test.Cardano.Ledger.Core.Binary.CDDL hiding + ( nonempty_set, + set, + ) + +shelley :: Huddle +shelley = collectFrom [block, transaction, signkeyKES] block :: Rule block = @@ -62,10 +68,10 @@ header_body = a protocol_version ] -operational_cert :: Rule +operational_cert :: Named Group operational_cert = "operational_cert" - =:= arr + =:~ grp [ "hot_vkey" ==> kes_vkey, "sequence_number" ==> VUInt, "kes_period" ==> VUInt, @@ -83,8 +89,8 @@ next_major_protocol_version = 3 major_protocol_version :: Rule major_protocol_version = "major_protocol_version" =:= (1 :: Integer) ... next_major_protocol_version -protocol_version :: Rule -protocol_version = "protocol_version" =:= arr [a major_protocol_version, a VUInt] +protocol_version :: Named Group +protocol_version = "protocol_version" =:~ grp [a major_protocol_version, a VUInt] transaction_body :: Rule transaction_body = @@ -93,7 +99,7 @@ transaction_body = [ idx 0 ==> set transaction_input, idx 1 ==> arr [0 <+ a transaction_output], idx 2 ==> coin, - opt (idx 3 ==> VUInt), + idx 3 ==> VUInt, opt (idx 4 ==> arr [0 <+ a certificate]), opt (idx 5 ==> withdrawals), opt (idx 6 ==> update), @@ -233,34 +239,35 @@ relay = / arr [a multi_host_name] pool_metadata :: Rule -pool_metadata = "pool_metadata" =:= arr [a url, a pool_metadata_hash] +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 [1 <+ asKey reward_account ==> coin] +withdrawals = "withdrawals" =:= mp [0 <+ asKey reward_account ==> coin] update :: Rule -update = "update" =:= arr [ a proposed_protocol_parameter_updates, a epoch] +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] +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 ==> coin), -- minfee A - opt (idx 1 ==> coin), -- minfee B - opt (idx 2 ==> (VUInt `sized` (4 :: Word64))), -- max block body size - opt (idx 3 ==> (VUInt `sized` (4 :: Word64))), -- max transaction size + [ opt (idx 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 `sized` (2 :: Word64))), -- n_opt: desired number of stake pools + 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 @@ -274,9 +281,9 @@ 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] + [ 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 @@ -316,23 +323,23 @@ bootstrap_witness = multisig_script :: Rule multisig_script = "multisig_script" - =:= arr [a script_pubkey] - / arr [a script_all] - / arr [a script_any] - / arr [a script_n_of_k] + =:= arr [a multisig_pubkey] + / arr [a multisig_all] + / arr [a multisig_any] + / arr [a multisig_n_of_k] -script_pubkey :: Named Group -script_pubkey = "script_pubkey" =:~ grp [0, a addr_keyhash] +multisig_pubkey :: Named Group +multisig_pubkey = "multisig_pubkey" =:~ grp [0, a addr_keyhash] -script_all :: Named Group -script_all = "script_all" =:~ grp [1, a (arr [0 <+ a multisig_script])] +multisig_all :: Named Group +multisig_all = "multisig_all" =:~ grp [1, a (arr [0 <+ a multisig_script])] -script_any :: Named Group -script_any = "script_any" =:~ grp [2, a (arr [0 <+ a multisig_script])] +multisig_any :: Named Group +multisig_any = "multisig_any" =:~ grp [2, a (arr [0 <+ a multisig_script])] -script_n_of_k :: Named Group -script_n_of_k = - "script_n_of_k" +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 @@ -350,9 +357,21 @@ scripthash = "scripthash" =:= hash28 metadata_hash :: Rule metadata_hash = "metadata_hash" =:= hash32 -pool_metadata_hash :: Rule -pool_metadata_hash = "pool_metadata_hash" =:= hash32 - nonce :: Rule -nonce = "nonce" =:= - arr [ a (int 0 / int 1), a (VBytes `sized` (32 :: Word64))] +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/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 index 03a3c686f79..588413f7191 100644 --- 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 @@ -14,7 +14,47 @@ import Data.Semigroup ((<>)) 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 = + "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 -------------------------------------------------------------------------------- @@ -47,17 +87,62 @@ signature :: Rule signature = "$signature" =:= VBytes `sized` (64 :: Word64) -------------------------------------------------------------------------------- --- Extras +-- 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 :: (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 :: (IsType0 t0) => t0 -> GRuleCall nonempty_set = binding $ \x -> "nonempty_set" =:= tag 258 (arr [1 <+ a x]) @@ -87,28 +172,6 @@ unit_interval = "unit_interval" =:= tag 30 (arr [1, 2]) 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) @@ -124,7 +187,7 @@ bounded_bytes = "bounded_bytes" =:= VBytes `sized` (0 :: Word64, 64 :: Word64) -- a type for distinct values. -- The type parameter must support .size, for example: bytes or uint -distinct :: IsSizeable s => Value s -> Rule +distinct :: (IsSizeable s) => Value s -> Rule distinct x = "distinct_" <> T.pack (show x) From 529bdd3f3abea1fadfc8953a29f18211b4a5d551 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Thu, 15 Aug 2024 12:53:08 +0200 Subject: [PATCH 04/13] Use common CDDL definitions from Shelley. Now that Shelley is defined using Huddle, we can rely on the relevant parts from Conway. --- eras/conway/impl/cardano-ledger-conway.cabal | 2 +- .../Test/Cardano/Ledger/Conway/CDDL.hs | 410 +++++++----------- 2 files changed, 159 insertions(+), 253 deletions(-) diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index 9434a379957..f449c23df18 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -155,7 +155,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/testlib/Test/Cardano/Ledger/Conway/CDDL.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs index 8e64fc78258..2c397b8bed2 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs @@ -12,11 +12,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.Word (Word64) import GHC.Num (Integer) -import GHC.Show (Show (show)) import Test.Cardano.Ledger.Core.Binary.CDDL +import Test.Cardano.Ledger.Shelley.CDDL + ( + transaction_index, + transaction_metadatum, + vkeywitness, + bootstrap_witness, + port, + single_host_addr + ) conway :: Huddle conway = @@ -28,60 +35,57 @@ 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] + [ 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 = "transaction" =:= arr - [ a transaction_body - , a transaction_witness_set - , a VBool - , a (auxiliary_data / VNil) + [ a transaction_body, + a transaction_witness_set, + a VBool, + a (auxiliary_data / VNil) ] -transaction_index :: Rule -transaction_index = "transaction_index" =:= VUInt `sized` (2 :: Word64) - header :: Rule header = "header" =:= arr - [ a header_body - , "body_signature" ==> kes_signature + [ a header_body, + "body_signature" ==> kes_signature ] header_body :: Rule header_body = "header_body" =:= arr - [ "block_number" ==> block_no - , "slot" ==> slot_no - , "prev_hash" ==> (hash32 / VNil) - , "issuer_vkey" ==> vkey - , "vrf_vkey" ==> vrf_vkey - , "vrf_result" ==> vrf_cert - , "block_body_size" ==> (VUInt `sized` (4 :: Word64)) - , "block_body_hash" ==> hash32 - , a operational_cert - , a protocol_version + [ "block_number" ==> block_no, + "slot" ==> slot_no, + "prev_hash" ==> (hash32 / VNil), + "issuer_vkey" ==> vkey, + "vrf_vkey" ==> vrf_vkey, + "vrf_result" ==> vrf_cert, + "block_body_size" ==> (VUInt `sized` (4 :: Word64)), + "block_body_hash" ==> hash32, + a operational_cert, + a protocol_version ] operational_cert :: Rule operational_cert = "operational_cert" =:= arr - [ "hot_vkey" ==> kes_vkey - , "sequence_number" ==> (VUInt `sized` (8 :: Word64)) - , "kes_period" ==> VUInt - , "sigma" ==> signature + [ "hot_vkey" ==> kes_vkey, + "sequence_number" ==> (VUInt `sized` (8 :: Word64)), + "kes_period" ==> VUInt, + "sigma" ==> signature ] protocol_version :: Rule @@ -102,26 +106,26 @@ transaction_body :: Rule transaction_body = "transaction_body" =:= mp - [ idx 0 ==> set transaction_input - , idx 1 ==> arr [0 <+ a transaction_output] - , idx 2 ==> coin - , opt (idx 3 ==> slot_no) - , opt (idx 4 ==> certificates) - , opt (idx 5 ==> withdrawals) - , opt (idx 7 ==> auxiliary_data_hash) - , opt (idx 8 ==> slot_no) -- Validity interval start - , opt (idx 9 ==> mint) - , opt (idx 11 ==> script_data_hash) - , opt (idx 13 ==> nonempty_set transaction_input) - , opt (idx 14 ==> required_signers) - , opt (idx 15 ==> network_id) - , opt (idx 16 ==> transaction_output) - , opt (idx 17 ==> coin) - , opt (idx 18 ==> nonempty_set transaction_input) - , opt (idx 19 ==> voting_procedures) - , opt (idx 20 ==> proposal_procedures) - , opt (idx 21 ==> coin) - , opt (idx 22 ==> positive_coin) + [ idx 0 ==> set transaction_input, + idx 1 ==> arr [0 <+ a transaction_output], + idx 2 ==> coin, + opt (idx 3 ==> slot_no), + opt (idx 4 ==> certificates), + opt (idx 5 ==> withdrawals), + opt (idx 7 ==> auxiliary_data_hash), + opt (idx 8 ==> slot_no), -- Validity interval start + opt (idx 9 ==> mint), + opt (idx 11 ==> script_data_hash), + opt (idx 13 ==> nonempty_set transaction_input), + opt (idx 14 ==> required_signers), + opt (idx 15 ==> network_id), + opt (idx 16 ==> transaction_output), + opt (idx 17 ==> coin), + opt (idx 18 ==> nonempty_set transaction_input), + opt (idx 19 ==> voting_procedures), + opt (idx 20 ==> proposal_procedures), + opt (idx 21 ==> coin), + opt (idx 22 ==> positive_coin) ] voting_procedures :: Rule @@ -136,10 +140,10 @@ proposal_procedure :: Rule proposal_procedure = "proposal_procedure" =:= arr - [ "deposit" ==> coin - , a reward_account - , a gov_action - , a anchor + [ "deposit" ==> coin, + a reward_account, + a gov_action, + a anchor ] proposal_procedures :: Rule @@ -166,10 +170,10 @@ parameter_change_action :: Named Group parameter_change_action = "parameter_change_action" =:~ grp - [ 0 - , gov_action_id / VNil - , a protocol_param_update - , policy_hash / VNil + [ 0, + gov_action_id / VNil, + a protocol_param_update, + policy_hash / VNil ] hard_fork_initiation_action :: Named Group @@ -189,11 +193,11 @@ update_committee :: Named Group update_committee = "update_committee" =:~ grp - [ 4 - , gov_action_id / VNil - , a (set committee_cold_credential) - , a (mp [asKey committee_cold_credential ==> epoch_no]) - , a unit_interval + [ 4, + gov_action_id / VNil, + a (set committee_cold_credential), + a (mp [asKey committee_cold_credential ==> epoch_no]), + a unit_interval ] new_constitution :: Named Group @@ -205,8 +209,8 @@ constitution :: Rule constitution = "constitution" =:= arr - [ a anchor - , a (scripthash / VNil) + [ a anchor, + a (scripthash / VNil) ] info_action :: Rule @@ -225,8 +229,8 @@ anchor :: Rule anchor = "anchor" =:= arr - [ "anchor_url" ==> url - , "anchor_data_hash" ==> hash32 + [ "anchor_url" ==> url, + "anchor_data_hash" ==> hash32 ] vote :: Rule @@ -236,8 +240,8 @@ gov_action_id :: Rule gov_action_id = "gov_action_id" =:= arr - [ "transaction_id" ==> hash32 - , "gov_action_index" ==> (VUInt `sized` (2 :: Word64)) + [ "transaction_id" ==> hash32, + "gov_action_index" ==> (VUInt `sized` (2 :: Word64)) ] required_signers :: Rule @@ -247,8 +251,8 @@ transaction_input :: Rule transaction_input = "transaction_input" =:= arr - [ "transaction_id" ==> hash32 - , "index" ==> (VUInt `sized` (2 :: Word64)) + [ "transaction_id" ==> hash32, + "index" ==> (VUInt `sized` (2 :: Word64)) ] transaction_output :: Rule @@ -261,19 +265,19 @@ pre_babbage_transaction_output :: Rule pre_babbage_transaction_output = "pre_babbage_transaction_output" =:= arr - [ a address - , "amount" ==> value - , opt ("datum_hash" ==> datum_hash) + [ a address, + "amount" ==> value, + opt ("datum_hash" ==> datum_hash) ] post_alonzo_transaction_output :: Rule post_alonzo_transaction_output = "post_alonzo_transaction_output" =:= mp - [ idx 0 ==> address - , idx 1 ==> value - , opt (idx 2 ==> datum_option) -- datum option - , opt (idx 3 ==> script_ref) -- script reference + [ idx 0 ==> address, + idx 1 ==> value, + opt (idx 2 ==> datum_option), -- datum option + opt (idx 3 ==> script_ref) -- script reference ] script_data_hash :: Rule @@ -417,27 +421,10 @@ 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 = @@ -476,77 +463,77 @@ protocol_param_update :: Rule protocol_param_update = "protocol_param_update" =:= mp - [ opt (idx 0 ==> coin) -- minfee A - , opt (idx 1 ==> coin) -- minfee B - , opt (idx 2 ==> (VUInt `sized` (4 :: Word64))) -- max block body size - , opt (idx 3 ==> (VUInt `sized` (4 :: Word64))) -- max transaction size - , opt (idx 4 ==> (VUInt `sized` (2 :: Word64))) -- max block header size - , opt (idx 5 ==> coin) -- key deposit - , opt (idx 6 ==> coin) -- pool deposit - , opt (idx 7 ==> epoch_interval) -- maximum epoch - , opt (idx 8 ==> (VUInt `sized` (2 :: Word64))) -- 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 16 ==> coin) -- min pool cost - , opt (idx 17 ==> coin) -- ada per utxo byte - , opt (idx 18 ==> costmdls) -- cost models for script languages - , opt (idx 19 ==> ex_unit_prices) -- execution costs - , opt (idx 20 ==> ex_units) -- max tx ex units - , opt (idx 21 ==> ex_units) -- max block ex units - , opt (idx 22 ==> (VUInt `sized` (4 :: Word64))) -- max value size - , opt (idx 23 ==> (VUInt `sized` (2 :: Word64))) -- collateral percentage - , opt (idx 24 ==> (VUInt `sized` (2 :: Word64))) -- max collateral inputs - , opt (idx 25 ==> pool_voting_thresholds) -- pool voting thresholds - , opt (idx 26 ==> drep_voting_thresholds) -- DRep voting thresholds - , opt (idx 27 ==> (VUInt `sized` (2 :: Word64))) -- min committee size - , opt (idx 28 ==> epoch_interval) -- committee term limit - , opt (idx 29 ==> epoch_interval) -- governance action validity period - , opt (idx 30 ==> coin) -- governance action deposit - , opt (idx 31 ==> coin) -- DRep deposit - , opt (idx 32 ==> epoch_interval) -- DRep inactivity period - , opt (idx 33 ==> nonnegative_interval) -- MinFee RefScriptCoinsPerByte + [ opt (idx 0 ==> coin), -- minfee A + opt (idx 1 ==> coin), -- minfee B + opt (idx 2 ==> (VUInt `sized` (4 :: Word64))), -- max block body size + opt (idx 3 ==> (VUInt `sized` (4 :: Word64))), -- max transaction size + opt (idx 4 ==> (VUInt `sized` (2 :: Word64))), -- max block header size + opt (idx 5 ==> coin), -- key deposit + opt (idx 6 ==> coin), -- pool deposit + opt (idx 7 ==> epoch_interval), -- maximum epoch + opt (idx 8 ==> (VUInt `sized` (2 :: Word64))), -- 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 16 ==> coin), -- min pool cost + opt (idx 17 ==> coin), -- ada per utxo byte + opt (idx 18 ==> costmdls), -- cost models for script languages + opt (idx 19 ==> ex_unit_prices), -- execution costs + opt (idx 20 ==> ex_units), -- max tx ex units + opt (idx 21 ==> ex_units), -- max block ex units + opt (idx 22 ==> (VUInt `sized` (4 :: Word64))), -- max value size + opt (idx 23 ==> (VUInt `sized` (2 :: Word64))), -- collateral percentage + opt (idx 24 ==> (VUInt `sized` (2 :: Word64))), -- max collateral inputs + opt (idx 25 ==> pool_voting_thresholds), -- pool voting thresholds + opt (idx 26 ==> drep_voting_thresholds), -- DRep voting thresholds + opt (idx 27 ==> (VUInt `sized` (2 :: Word64))), -- min committee size + opt (idx 28 ==> epoch_interval), -- committee term limit + opt (idx 29 ==> epoch_interval), -- governance action validity period + opt (idx 30 ==> coin), -- governance action deposit + opt (idx 31 ==> coin), -- DRep deposit + opt (idx 32 ==> epoch_interval), -- DRep inactivity period + opt (idx 33 ==> nonnegative_interval) -- MinFee RefScriptCoinsPerByte ] pool_voting_thresholds :: Rule pool_voting_thresholds = "pool_voting_thresholds" =:= arr - [ a unit_interval -- motion no confidence - , a unit_interval -- committee normal - , a unit_interval -- committee no confidence - , a unit_interval -- hard fork initiation - , a unit_interval -- security relevant parameter voting threshold + [ a unit_interval, -- motion no confidence + a unit_interval, -- committee normal + a unit_interval, -- committee no confidence + a unit_interval, -- hard fork initiation + a unit_interval -- security relevant parameter voting threshold ] drep_voting_thresholds :: Rule drep_voting_thresholds = "drep_voting_thresholds" =:= arr - [ a unit_interval -- motion no confidence - , a unit_interval -- committee normal - , a unit_interval -- committee no confidence - , a unit_interval -- update constitution - , a unit_interval -- hard fork initiation - , a unit_interval -- PP network group - , a unit_interval -- PP economic group - , a unit_interval -- PP technical group - , a unit_interval -- PP governance group - , a unit_interval -- treasury withdrawal + [ a unit_interval, -- motion no confidence + a unit_interval, -- committee normal + a unit_interval, -- committee no confidence + a unit_interval, -- update constitution + a unit_interval, -- hard fork initiation + a unit_interval, -- PP network group + a unit_interval, -- PP economic group + a unit_interval, -- PP technical group + a unit_interval, -- PP governance group + a unit_interval -- treasury withdrawal ] transaction_witness_set :: Rule transaction_witness_set = "transaction_witness_set" =:= mp - [ opt $ idx 0 ==> nonempty_set vkeywitness - , opt $ idx 1 ==> nonempty_set native_script - , opt $ idx 2 ==> nonempty_set bootstrap_witness - , opt $ idx 3 ==> nonempty_set plutus_v1_script - , opt $ idx 4 ==> nonempty_set plutus_data - , opt $ idx 5 ==> redeemers - , opt $ idx 6 ==> nonempty_set plutus_v2_script - , opt $ idx 7 ==> nonempty_set plutus_v3_script + [ opt $ idx 0 ==> nonempty_set vkeywitness, + opt $ idx 1 ==> nonempty_set native_script, + opt $ idx 2 ==> nonempty_set bootstrap_witness, + opt $ idx 3 ==> nonempty_set plutus_v1_script, + opt $ idx 4 ==> nonempty_set plutus_data, + opt $ idx 5 ==> redeemers, + opt $ idx 6 ==> nonempty_set plutus_v2_script, + opt $ idx 7 ==> nonempty_set plutus_v3_script ] plutus_v1_script :: Rule @@ -574,16 +561,8 @@ 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 :: (IsType0 x) => x -> GRuleCall constr = binding $ \x -> "constr" =:= tag 121 (arr [0 <+ a x]) @@ -607,10 +586,10 @@ redeemers = [ 1 <+ a ( arr - [ "tag" ==> redeemer_tag - , "index" ==> (VUInt `sized` (4 :: Word64)) - , "data" ==> plutus_data - , "ex_units" ==> ex_units + [ "tag" ==> redeemer_tag, + "index" ==> (VUInt `sized` (4 :: Word64)), + "data" ==> plutus_data, + "ex_units" ==> ex_units ] ) ] @@ -618,8 +597,8 @@ redeemers = [ 1 <+ asKey ( arr - [ "tag" ==> redeemer_tag - , "index" ==> (VUInt `sized` (4 :: Word64)) + [ "tag" ==> redeemer_tag, + "index" ==> (VUInt `sized` (4 :: Word64)) ] ) ==> arr ["data" ==> plutus_data, "ex_units" ==> ex_units] @@ -642,8 +621,8 @@ ex_unit_prices :: Rule ex_unit_prices = "ex_unit_prices" =:= arr - [ "mem_price" ==> nonnegative_interval - , "step_price" ==> nonnegative_interval + [ "mem_price" ==> nonnegative_interval, + "step_price" ==> nonnegative_interval ] language :: Rule @@ -665,21 +644,12 @@ costmdls = "The format for costmdls is flexible enough to allow adding Plutus\n built-ins and language versions in the future." $ "costmdls" =:= mp - [ opt $ idx 0 ==> arr [0 <+ a int64] -- Plutus v1, only 166 integers are used, but more are accepted (and ignored) - , opt $ idx 1 ==> arr [0 <+ a int64] -- Plutus v2, only 175 integers are used, but more are accepted (and ignored) - , opt $ idx 2 ==> arr [0 <+ a int64] -- Plutus v3, only 223 integers are used, but more are accepted (and ignored) - , 0 <+ asKey (3 ... 255) ==> arr [0 <+ a int64] -- Any 8-bit unsigned number can be used as a key. + [ opt $ idx 0 ==> arr [0 <+ a int64], -- Plutus v1, only 166 integers are used, but more are accepted (and ignored) + opt $ idx 1 ==> arr [0 <+ a int64], -- Plutus v2, only 175 integers are used, but more are accepted (and ignored) + opt $ idx 2 ==> arr [0 <+ a int64], -- Plutus v3, only 223 integers are used, but more are accepted (and ignored) + 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)) @@ -697,33 +667,20 @@ auxiliary_data = "auxiliary_data" =:= metadata -- Shelley / sarr - [ "transaction_metadata" ==> metadata -- Shelley-ma - , "auxiliary_scripts" ==> arr [0 <+ a native_script] + [ "transaction_metadata" ==> metadata, -- Shelley-ma + "auxiliary_scripts" ==> arr [0 <+ a native_script] ] / tag 259 ( mp - [ opt (idx 0 ==> metadata) -- Alonzo and beyond - , opt (idx 1 ==> arr [0 <+ a native_script]) - , opt (idx 2 ==> arr [0 <+ a plutus_v1_script]) - , opt (idx 3 ==> arr [0 <+ a plutus_v2_script]) - , opt (idx 4 ==> arr [0 <+ a plutus_v3_script]) + [ opt (idx 0 ==> metadata), -- Alonzo and beyond + opt (idx 1 ==> arr [0 <+ a native_script]), + opt (idx 2 ==> arr [0 <+ a plutus_v1_script]), + opt (idx 3 ==> arr [0 <+ a plutus_v2_script]), + opt (idx 4 ==> arr [0 <+ a plutus_v3_script]) ] ) -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" @@ -759,10 +716,7 @@ 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 :: (IsType0 a) => a -> GRuleCall multiasset = binding $ \x -> "multiasset" =:= mp [1 <+ asKey policy_id ==> mp [1 <+ asKey asset_name ==> x]] @@ -773,51 +727,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 @@ -833,15 +748,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 From 16106f4dd7fcd3b7861317bedc1dccaa74321c26 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Thu, 15 Aug 2024 12:54:39 +0200 Subject: [PATCH 05/13] Fourmolu --- .../Test/Cardano/Ledger/Conway/CDDL.hs | 318 +++++++++--------- .../Test/Cardano/Ledger/Shelley/CDDL.hs | 168 ++++----- .../Test/Cardano/Ledger/Core/Binary/CDDL.hs | 7 +- 3 files changed, 245 insertions(+), 248 deletions(-) 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 2c397b8bed2..d0aeb9caee3 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs @@ -15,15 +15,14 @@ import Data.Semigroup ((<>)) import Data.Word (Word64) import GHC.Num (Integer) import Test.Cardano.Ledger.Core.Binary.CDDL -import Test.Cardano.Ledger.Shelley.CDDL - ( - transaction_index, - transaction_metadatum, - vkeywitness, - bootstrap_witness, - port, - single_host_addr - ) +import Test.Cardano.Ledger.Shelley.CDDL ( + bootstrap_witness, + port, + single_host_addr, + transaction_index, + transaction_metadatum, + vkeywitness, + ) conway :: Huddle conway = @@ -35,57 +34,57 @@ 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] + [ 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 = "transaction" =:= arr - [ a transaction_body, - a transaction_witness_set, - a VBool, - a (auxiliary_data / VNil) + [ a transaction_body + , a transaction_witness_set + , a VBool + , a (auxiliary_data / VNil) ] header :: Rule header = "header" =:= arr - [ a header_body, - "body_signature" ==> kes_signature + [ a header_body + , "body_signature" ==> kes_signature ] header_body :: Rule header_body = "header_body" =:= arr - [ "block_number" ==> block_no, - "slot" ==> slot_no, - "prev_hash" ==> (hash32 / VNil), - "issuer_vkey" ==> vkey, - "vrf_vkey" ==> vrf_vkey, - "vrf_result" ==> vrf_cert, - "block_body_size" ==> (VUInt `sized` (4 :: Word64)), - "block_body_hash" ==> hash32, - a operational_cert, - a protocol_version + [ "block_number" ==> block_no + , "slot" ==> slot_no + , "prev_hash" ==> (hash32 / VNil) + , "issuer_vkey" ==> vkey + , "vrf_vkey" ==> vrf_vkey + , "vrf_result" ==> vrf_cert + , "block_body_size" ==> (VUInt `sized` (4 :: Word64)) + , "block_body_hash" ==> hash32 + , a operational_cert + , a protocol_version ] operational_cert :: Rule operational_cert = "operational_cert" =:= arr - [ "hot_vkey" ==> kes_vkey, - "sequence_number" ==> (VUInt `sized` (8 :: Word64)), - "kes_period" ==> VUInt, - "sigma" ==> signature + [ "hot_vkey" ==> kes_vkey + , "sequence_number" ==> (VUInt `sized` (8 :: Word64)) + , "kes_period" ==> VUInt + , "sigma" ==> signature ] protocol_version :: Rule @@ -106,26 +105,26 @@ transaction_body :: Rule transaction_body = "transaction_body" =:= mp - [ idx 0 ==> set transaction_input, - idx 1 ==> arr [0 <+ a transaction_output], - idx 2 ==> coin, - opt (idx 3 ==> slot_no), - opt (idx 4 ==> certificates), - opt (idx 5 ==> withdrawals), - opt (idx 7 ==> auxiliary_data_hash), - opt (idx 8 ==> slot_no), -- Validity interval start - opt (idx 9 ==> mint), - opt (idx 11 ==> script_data_hash), - opt (idx 13 ==> nonempty_set transaction_input), - opt (idx 14 ==> required_signers), - opt (idx 15 ==> network_id), - opt (idx 16 ==> transaction_output), - opt (idx 17 ==> coin), - opt (idx 18 ==> nonempty_set transaction_input), - opt (idx 19 ==> voting_procedures), - opt (idx 20 ==> proposal_procedures), - opt (idx 21 ==> coin), - opt (idx 22 ==> positive_coin) + [ idx 0 ==> set transaction_input + , idx 1 ==> arr [0 <+ a transaction_output] + , idx 2 ==> coin + , opt (idx 3 ==> slot_no) + , opt (idx 4 ==> certificates) + , opt (idx 5 ==> withdrawals) + , opt (idx 7 ==> auxiliary_data_hash) + , opt (idx 8 ==> slot_no) -- Validity interval start + , opt (idx 9 ==> mint) + , opt (idx 11 ==> script_data_hash) + , opt (idx 13 ==> nonempty_set transaction_input) + , opt (idx 14 ==> required_signers) + , opt (idx 15 ==> network_id) + , opt (idx 16 ==> transaction_output) + , opt (idx 17 ==> coin) + , opt (idx 18 ==> nonempty_set transaction_input) + , opt (idx 19 ==> voting_procedures) + , opt (idx 20 ==> proposal_procedures) + , opt (idx 21 ==> coin) + , opt (idx 22 ==> positive_coin) ] voting_procedures :: Rule @@ -140,10 +139,10 @@ proposal_procedure :: Rule proposal_procedure = "proposal_procedure" =:= arr - [ "deposit" ==> coin, - a reward_account, - a gov_action, - a anchor + [ "deposit" ==> coin + , a reward_account + , a gov_action + , a anchor ] proposal_procedures :: Rule @@ -170,10 +169,10 @@ parameter_change_action :: Named Group parameter_change_action = "parameter_change_action" =:~ grp - [ 0, - gov_action_id / VNil, - a protocol_param_update, - policy_hash / VNil + [ 0 + , gov_action_id / VNil + , a protocol_param_update + , policy_hash / VNil ] hard_fork_initiation_action :: Named Group @@ -193,11 +192,11 @@ update_committee :: Named Group update_committee = "update_committee" =:~ grp - [ 4, - gov_action_id / VNil, - a (set committee_cold_credential), - a (mp [asKey committee_cold_credential ==> epoch_no]), - a unit_interval + [ 4 + , gov_action_id / VNil + , a (set committee_cold_credential) + , a (mp [asKey committee_cold_credential ==> epoch_no]) + , a unit_interval ] new_constitution :: Named Group @@ -209,8 +208,8 @@ constitution :: Rule constitution = "constitution" =:= arr - [ a anchor, - a (scripthash / VNil) + [ a anchor + , a (scripthash / VNil) ] info_action :: Rule @@ -229,8 +228,8 @@ anchor :: Rule anchor = "anchor" =:= arr - [ "anchor_url" ==> url, - "anchor_data_hash" ==> hash32 + [ "anchor_url" ==> url + , "anchor_data_hash" ==> hash32 ] vote :: Rule @@ -240,8 +239,8 @@ gov_action_id :: Rule gov_action_id = "gov_action_id" =:= arr - [ "transaction_id" ==> hash32, - "gov_action_index" ==> (VUInt `sized` (2 :: Word64)) + [ "transaction_id" ==> hash32 + , "gov_action_index" ==> (VUInt `sized` (2 :: Word64)) ] required_signers :: Rule @@ -251,8 +250,8 @@ transaction_input :: Rule transaction_input = "transaction_input" =:= arr - [ "transaction_id" ==> hash32, - "index" ==> (VUInt `sized` (2 :: Word64)) + [ "transaction_id" ==> hash32 + , "index" ==> (VUInt `sized` (2 :: Word64)) ] transaction_output :: Rule @@ -265,19 +264,19 @@ pre_babbage_transaction_output :: Rule pre_babbage_transaction_output = "pre_babbage_transaction_output" =:= arr - [ a address, - "amount" ==> value, - opt ("datum_hash" ==> datum_hash) + [ a address + , "amount" ==> value + , opt ("datum_hash" ==> datum_hash) ] post_alonzo_transaction_output :: Rule post_alonzo_transaction_output = "post_alonzo_transaction_output" =:= mp - [ idx 0 ==> address, - idx 1 ==> value, - opt (idx 2 ==> datum_option), -- datum option - opt (idx 3 ==> script_ref) -- script reference + [ idx 0 ==> address + , idx 1 ==> value + , opt (idx 2 ==> datum_option) -- datum option + , opt (idx 3 ==> script_ref) -- script reference ] script_data_hash :: Rule @@ -421,11 +420,9 @@ pool_params = , "pool_metadata" ==> (pool_metadata / VNil) ] - dns_name :: Rule dns_name = "dns_name" =:= VText `sized` (0 :: Word64, 128 :: Word64) - single_host_name :: Named Group single_host_name = "single_host_name" @@ -463,77 +460,77 @@ protocol_param_update :: Rule protocol_param_update = "protocol_param_update" =:= mp - [ opt (idx 0 ==> coin), -- minfee A - opt (idx 1 ==> coin), -- minfee B - opt (idx 2 ==> (VUInt `sized` (4 :: Word64))), -- max block body size - opt (idx 3 ==> (VUInt `sized` (4 :: Word64))), -- max transaction size - opt (idx 4 ==> (VUInt `sized` (2 :: Word64))), -- max block header size - opt (idx 5 ==> coin), -- key deposit - opt (idx 6 ==> coin), -- pool deposit - opt (idx 7 ==> epoch_interval), -- maximum epoch - opt (idx 8 ==> (VUInt `sized` (2 :: Word64))), -- 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 16 ==> coin), -- min pool cost - opt (idx 17 ==> coin), -- ada per utxo byte - opt (idx 18 ==> costmdls), -- cost models for script languages - opt (idx 19 ==> ex_unit_prices), -- execution costs - opt (idx 20 ==> ex_units), -- max tx ex units - opt (idx 21 ==> ex_units), -- max block ex units - opt (idx 22 ==> (VUInt `sized` (4 :: Word64))), -- max value size - opt (idx 23 ==> (VUInt `sized` (2 :: Word64))), -- collateral percentage - opt (idx 24 ==> (VUInt `sized` (2 :: Word64))), -- max collateral inputs - opt (idx 25 ==> pool_voting_thresholds), -- pool voting thresholds - opt (idx 26 ==> drep_voting_thresholds), -- DRep voting thresholds - opt (idx 27 ==> (VUInt `sized` (2 :: Word64))), -- min committee size - opt (idx 28 ==> epoch_interval), -- committee term limit - opt (idx 29 ==> epoch_interval), -- governance action validity period - opt (idx 30 ==> coin), -- governance action deposit - opt (idx 31 ==> coin), -- DRep deposit - opt (idx 32 ==> epoch_interval), -- DRep inactivity period - opt (idx 33 ==> nonnegative_interval) -- MinFee RefScriptCoinsPerByte + [ opt (idx 0 ==> coin) -- minfee A + , opt (idx 1 ==> coin) -- minfee B + , opt (idx 2 ==> (VUInt `sized` (4 :: Word64))) -- max block body size + , opt (idx 3 ==> (VUInt `sized` (4 :: Word64))) -- max transaction size + , opt (idx 4 ==> (VUInt `sized` (2 :: Word64))) -- max block header size + , opt (idx 5 ==> coin) -- key deposit + , opt (idx 6 ==> coin) -- pool deposit + , opt (idx 7 ==> epoch_interval) -- maximum epoch + , opt (idx 8 ==> (VUInt `sized` (2 :: Word64))) -- 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 16 ==> coin) -- min pool cost + , opt (idx 17 ==> coin) -- ada per utxo byte + , opt (idx 18 ==> costmdls) -- cost models for script languages + , opt (idx 19 ==> ex_unit_prices) -- execution costs + , opt (idx 20 ==> ex_units) -- max tx ex units + , opt (idx 21 ==> ex_units) -- max block ex units + , opt (idx 22 ==> (VUInt `sized` (4 :: Word64))) -- max value size + , opt (idx 23 ==> (VUInt `sized` (2 :: Word64))) -- collateral percentage + , opt (idx 24 ==> (VUInt `sized` (2 :: Word64))) -- max collateral inputs + , opt (idx 25 ==> pool_voting_thresholds) -- pool voting thresholds + , opt (idx 26 ==> drep_voting_thresholds) -- DRep voting thresholds + , opt (idx 27 ==> (VUInt `sized` (2 :: Word64))) -- min committee size + , opt (idx 28 ==> epoch_interval) -- committee term limit + , opt (idx 29 ==> epoch_interval) -- governance action validity period + , opt (idx 30 ==> coin) -- governance action deposit + , opt (idx 31 ==> coin) -- DRep deposit + , opt (idx 32 ==> epoch_interval) -- DRep inactivity period + , opt (idx 33 ==> nonnegative_interval) -- MinFee RefScriptCoinsPerByte ] pool_voting_thresholds :: Rule pool_voting_thresholds = "pool_voting_thresholds" =:= arr - [ a unit_interval, -- motion no confidence - a unit_interval, -- committee normal - a unit_interval, -- committee no confidence - a unit_interval, -- hard fork initiation - a unit_interval -- security relevant parameter voting threshold + [ a unit_interval -- motion no confidence + , a unit_interval -- committee normal + , a unit_interval -- committee no confidence + , a unit_interval -- hard fork initiation + , a unit_interval -- security relevant parameter voting threshold ] drep_voting_thresholds :: Rule drep_voting_thresholds = "drep_voting_thresholds" =:= arr - [ a unit_interval, -- motion no confidence - a unit_interval, -- committee normal - a unit_interval, -- committee no confidence - a unit_interval, -- update constitution - a unit_interval, -- hard fork initiation - a unit_interval, -- PP network group - a unit_interval, -- PP economic group - a unit_interval, -- PP technical group - a unit_interval, -- PP governance group - a unit_interval -- treasury withdrawal + [ a unit_interval -- motion no confidence + , a unit_interval -- committee normal + , a unit_interval -- committee no confidence + , a unit_interval -- update constitution + , a unit_interval -- hard fork initiation + , a unit_interval -- PP network group + , a unit_interval -- PP economic group + , a unit_interval -- PP technical group + , a unit_interval -- PP governance group + , a unit_interval -- treasury withdrawal ] transaction_witness_set :: Rule transaction_witness_set = "transaction_witness_set" =:= mp - [ opt $ idx 0 ==> nonempty_set vkeywitness, - opt $ idx 1 ==> nonempty_set native_script, - opt $ idx 2 ==> nonempty_set bootstrap_witness, - opt $ idx 3 ==> nonempty_set plutus_v1_script, - opt $ idx 4 ==> nonempty_set plutus_data, - opt $ idx 5 ==> redeemers, - opt $ idx 6 ==> nonempty_set plutus_v2_script, - opt $ idx 7 ==> nonempty_set plutus_v3_script + [ opt $ idx 0 ==> nonempty_set vkeywitness + , opt $ idx 1 ==> nonempty_set native_script + , opt $ idx 2 ==> nonempty_set bootstrap_witness + , opt $ idx 3 ==> nonempty_set plutus_v1_script + , opt $ idx 4 ==> nonempty_set plutus_data + , opt $ idx 5 ==> redeemers + , opt $ idx 6 ==> nonempty_set plutus_v2_script + , opt $ idx 7 ==> nonempty_set plutus_v3_script ] plutus_v1_script :: Rule @@ -561,8 +558,7 @@ plutus_data = / big_int / bounded_bytes - -constr :: (IsType0 x) => x -> GRuleCall +constr :: IsType0 x => x -> GRuleCall constr = binding $ \x -> "constr" =:= tag 121 (arr [0 <+ a x]) @@ -586,10 +582,10 @@ redeemers = [ 1 <+ a ( arr - [ "tag" ==> redeemer_tag, - "index" ==> (VUInt `sized` (4 :: Word64)), - "data" ==> plutus_data, - "ex_units" ==> ex_units + [ "tag" ==> redeemer_tag + , "index" ==> (VUInt `sized` (4 :: Word64)) + , "data" ==> plutus_data + , "ex_units" ==> ex_units ] ) ] @@ -597,8 +593,8 @@ redeemers = [ 1 <+ asKey ( arr - [ "tag" ==> redeemer_tag, - "index" ==> (VUInt `sized` (4 :: Word64)) + [ "tag" ==> redeemer_tag + , "index" ==> (VUInt `sized` (4 :: Word64)) ] ) ==> arr ["data" ==> plutus_data, "ex_units" ==> ex_units] @@ -621,8 +617,8 @@ ex_unit_prices :: Rule ex_unit_prices = "ex_unit_prices" =:= arr - [ "mem_price" ==> nonnegative_interval, - "step_price" ==> nonnegative_interval + [ "mem_price" ==> nonnegative_interval + , "step_price" ==> nonnegative_interval ] language :: Rule @@ -644,10 +640,10 @@ costmdls = "The format for costmdls is flexible enough to allow adding Plutus\n built-ins and language versions in the future." $ "costmdls" =:= mp - [ opt $ idx 0 ==> arr [0 <+ a int64], -- Plutus v1, only 166 integers are used, but more are accepted (and ignored) - opt $ idx 1 ==> arr [0 <+ a int64], -- Plutus v2, only 175 integers are used, but more are accepted (and ignored) - opt $ idx 2 ==> arr [0 <+ a int64], -- Plutus v3, only 223 integers are used, but more are accepted (and ignored) - 0 <+ asKey (3 ... 255) ==> arr [0 <+ a int64] -- Any 8-bit unsigned number can be used as a key. + [ opt $ idx 0 ==> arr [0 <+ a int64] -- Plutus v1, only 166 integers are used, but more are accepted (and ignored) + , opt $ idx 1 ==> arr [0 <+ a int64] -- Plutus v2, only 175 integers are used, but more are accepted (and ignored) + , opt $ idx 2 ==> arr [0 <+ a int64] -- Plutus v3, only 223 integers are used, but more are accepted (and ignored) + , 0 <+ asKey (3 ... 255) ==> arr [0 <+ a int64] -- Any 8-bit unsigned number can be used as a key. ] transaction_metadatum_label :: Rule @@ -667,17 +663,17 @@ auxiliary_data = "auxiliary_data" =:= metadata -- Shelley / sarr - [ "transaction_metadata" ==> metadata, -- Shelley-ma - "auxiliary_scripts" ==> arr [0 <+ a native_script] + [ "transaction_metadata" ==> metadata -- Shelley-ma + , "auxiliary_scripts" ==> arr [0 <+ a native_script] ] / tag 259 ( mp - [ opt (idx 0 ==> metadata), -- Alonzo and beyond - opt (idx 1 ==> arr [0 <+ a native_script]), - opt (idx 2 ==> arr [0 <+ a plutus_v1_script]), - opt (idx 3 ==> arr [0 <+ a plutus_v2_script]), - opt (idx 4 ==> arr [0 <+ a plutus_v3_script]) + [ opt (idx 0 ==> metadata) -- Alonzo and beyond + , opt (idx 1 ==> arr [0 <+ a native_script]) + , opt (idx 2 ==> arr [0 <+ a plutus_v1_script]) + , opt (idx 3 ==> arr [0 <+ a plutus_v2_script]) + , opt (idx 4 ==> arr [0 <+ a plutus_v3_script]) ] ) @@ -716,7 +712,7 @@ invalid_before = "invalid_before" =:~ grp [4, a slot_no] invalid_hereafter :: Named Group invalid_hereafter = "invalid_hereafter" =:~ grp [5, a slot_no] -multiasset :: (IsType0 a) => a -> GRuleCall +multiasset :: IsType0 a => a -> GRuleCall multiasset = binding $ \x -> "multiasset" =:= mp [1 <+ asKey policy_id ==> mp [1 <+ asKey asset_name ==> x]] diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs index 1d9f7e1ccc3..0a382cedcd2 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs @@ -11,10 +11,10 @@ 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, - ) +import Test.Cardano.Ledger.Core.Binary.CDDL hiding ( + nonempty_set, + set, + ) shelley :: Huddle shelley = collectFrom [block, transaction, signkeyKES] @@ -23,11 +23,11 @@ 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" + [ 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] ] @@ -35,9 +35,9 @@ transaction :: Rule transaction = "transaction" =:= arr - [ a transaction_body, - a transaction_witness_set, - a (transaction_metadata / VNil) + [ a transaction_body + , a transaction_witness_set + , a (transaction_metadata / VNil) ] transaction_index :: Rule @@ -47,35 +47,35 @@ header :: Rule header = "header" =:= arr - [ a header_body, - "body_signature" ==> kes_signature + [ 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 + [ "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 + [ "hot_vkey" ==> kes_vkey + , "sequence_number" ==> VUInt + , "kes_period" ==> VUInt + , "sigma" ==> signature ] -- TODO Replace with the following once @@ -96,30 +96,30 @@ 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) + [ 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_id" ==> hash32 + , "index" ==> VUInt ] transaction_output :: Rule transaction_output = "transaction_output" =:= arr - [ a address, - "amount" ==> coin + [ a address + , "amount" ==> coin ] certificate :: Rule @@ -181,15 +181,15 @@ 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) + [ "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 @@ -208,27 +208,27 @@ single_host_addr :: Named Group single_host_addr = "single_host_addr" =:~ grp - [ 0, - port / VNil, - ipv4 / VNil, - ipv6 / VNil + [ 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 + [ 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 + [ 2 + , a dns_name -- A SRV DNS record ] relay :: Rule @@ -259,31 +259,31 @@ 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 + [ 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] + [ 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 @@ -314,10 +314,10 @@ bootstrap_witness :: Rule bootstrap_witness = "bootstrap_witness" =:= arr - [ "public_key" ==> vkey, - "signature" ==> signature, - "chain_code" ==> (VBytes `sized` (32 :: Word64)), - "attributes" ==> VBytes + [ "public_key" ==> vkey + , "signature" ==> signature + , "chain_code" ==> (VBytes `sized` (32 :: Word64)) + , "attributes" ==> VBytes ] multisig_script :: Rule @@ -368,10 +368,10 @@ nonce = -- on in future eras. In order to have the "correct" common specification in -- core, we override them here -------------------------------------------------------------------------------- -set :: (IsType0 t0) => t0 -> GRuleCall +set :: IsType0 t0 => t0 -> GRuleCall set = binding $ \x -> "set" =:= arr [0 <+ a x] -nonempty_set :: (IsType0 t0) => t0 -> GRuleCall +nonempty_set :: IsType0 t0 => t0 -> GRuleCall nonempty_set = binding $ \x -> "nonempty_set" =:= arr [1 <+ a x] 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 index 588413f7191..5f803048645 100644 --- 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 @@ -55,6 +55,7 @@ pool_keyhash = "pool_keyhash" =:= hash28 vrf_keyhash :: Rule vrf_keyhash = "vrf_keyhash" =:= hash32 + -------------------------------------------------------------------------------- -- Crypto -------------------------------------------------------------------------------- @@ -139,10 +140,10 @@ int64 = "int64" =:= minInt64 ... maxInt64 -- 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 :: 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 :: IsType0 t0 => t0 -> GRuleCall nonempty_set = binding $ \x -> "nonempty_set" =:= tag 258 (arr [1 <+ a x]) @@ -187,7 +188,7 @@ bounded_bytes = "bounded_bytes" =:= VBytes `sized` (0 :: Word64, 64 :: Word64) -- a type for distinct values. -- The type parameter must support .size, for example: bytes or uint -distinct :: (IsSizeable s) => Value s -> Rule +distinct :: IsSizeable s => Value s -> Rule distinct x = "distinct_" <> T.pack (show x) From 9c7954d557536c27beab993d312b698923e7180f Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Thu, 15 Aug 2024 13:04:30 +0200 Subject: [PATCH 06/13] Update gen-cddl script to handle multiple eras --- scripts/gen-cddl.sh | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/scripts/gen-cddl.sh b/scripts/gen-cddl.sh index 444e6d598ef..6863396f5ff 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" "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 From f87081c6744e4bb83329908c7d1dfcbd4fadd54b Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Mon, 19 Aug 2024 10:11:04 +0200 Subject: [PATCH 07/13] Update hie file. --- hie.yaml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/hie.yaml b/hie.yaml index c5294fc6686..ca5cda55700 100644 --- a/hie.yaml +++ b/hie.yaml @@ -126,6 +126,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" From abeb1312212940640810c1ec3539639e100fa6cf Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Fri, 16 Aug 2024 12:23:27 +0200 Subject: [PATCH 08/13] Reintroduce detailed comments in CDDL. We use 'here' QuasiQuotes to make handling multiline comments somewhat less painful. --- eras/conway/impl/cardano-ledger-conway.cabal | 1 + eras/conway/impl/cddl-files/conway.cddl | 108 ++++++++++++++ .../Test/Cardano/Ledger/Conway/CDDL.hs | 132 +++++++++++++++--- eras/shelley/impl/cddl-files/shelley.cddl | 33 +++++ .../cardano-ledger-core.cabal | 1 + .../Test/Cardano/Ledger/Core/Binary/CDDL.hs | 64 +++++++-- 6 files changed, 306 insertions(+), 33 deletions(-) diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index f449c23df18..4dadfd12174 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -146,6 +146,7 @@ library testlib cuddle >=0.3.0.0, plutus-ledger-api, deepseq, + here, microlens, cardano-crypto-class, cardano-ledger-allegra, diff --git a/eras/conway/impl/cddl-files/conway.cddl b/eras/conway/impl/cddl-files/conway.cddl index 2b93b588f8d..130029f5331 100644 --- a/eras/conway/impl/cddl-files/conway.cddl +++ b/eras/conway/impl/cddl-files/conway.cddl @@ -17,6 +17,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' @@ -51,6 +84,11 @@ big_nint = #6.3(bounded_bytes) big_uint = #6.2(bounded_bytes) +; 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] @@ -368,6 +406,69 @@ script_all = (1, [* native_script]) script_any = (2, [* native_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): +; [ 80 | datums | A0 ] +; corresponding to a CBOR empty list and an empty map. +; Note that a transaction might include the redeemers field and it to the +; empty map, in which case the user supplied encoding of the empty map is used. script_data_hash = $hash32 script_n_of_k = (3, int64, [* native_script]) @@ -451,6 +552,8 @@ 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 @@ -491,6 +594,11 @@ vote_deleg_cert = (9, stake_credential, drep) vote_reg_deleg_cert = (12, stake_credential, drep, coin) +; 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 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 d0aeb9caee3..dd8605b608c 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,6 +13,7 @@ module Test.Cardano.Ledger.Conway.CDDL (conway) where import Codec.CBOR.Cuddle.Huddle import Data.Function (($)) import Data.Semigroup ((<>)) +import Data.String.Here (here) import Data.Word (Word64) import GHC.Num (Integer) import Test.Cardano.Ledger.Core.Binary.CDDL @@ -32,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 = @@ -217,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 = @@ -256,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 = @@ -280,7 +304,75 @@ 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): + [ 80 | datums | A0 ] + corresponding to a CBOR empty list and an empty map. + Note that a transaction might include the redeemers field and it to the + empty map, in which case the user supplied encoding of the empty map is used. + + |] + $ "script_data_hash" =:= hash32 certificate :: Rule certificate = diff --git a/eras/shelley/impl/cddl-files/shelley.cddl b/eras/shelley/impl/cddl-files/shelley.cddl index a2d684363b6..0e37d9505a1 100644 --- a/eras/shelley/impl/cddl-files/shelley.cddl +++ b/eras/shelley/impl/cddl-files/shelley.cddl @@ -17,6 +17,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' diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index 847ee12e2b5..7930274cd3a 100644 --- a/libs/cardano-ledger-core/cardano-ledger-core.cabal +++ b/libs/cardano-ledger-core/cardano-ledger-core.cabal @@ -191,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 index 5f803048645..72420a2ef09 100644 --- 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 @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} @@ -11,6 +12,7 @@ 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)) @@ -27,19 +29,55 @@ positive_coin = "positive_coin" =:= 1 ... maxWord64 address :: Rule address = - "address" - =:= bstr - "001000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000" - / bstr - "102000000000000000000000000000000000000000000000000000000022000000000000000000000000000000000000000000000000000000" - / bstr - "203000000000000000000000000000000000000000000000000000000033000000000000000000000000000000000000000000000000000000" - / bstr - "304000000000000000000000000000000000000000000000000000000044000000000000000000000000000000000000000000000000000000" - / bstr "405000000000000000000000000000000000000000000000000000000087680203" - / bstr "506000000000000000000000000000000000000000000000000000000087680203" - / bstr "6070000000000000000000000000000000000000000000000000000000" - / bstr "7080000000000000000000000000000000000000000000000000000000" + 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 = From bd29e181a859297f78f72e01b62b3dd474dc9448 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Fri, 16 Aug 2024 13:07:10 +0200 Subject: [PATCH 09/13] Add a CDDL root element. This addresses issue #4535. The first rule in a CDDL file is taken to be the root element. --- eras/conway/impl/cardano-ledger-conway.cabal | 2 +- eras/conway/impl/cddl-files/conway.cddl | 559 +++++++++--------- .../shelley/impl/cardano-ledger-shelley.cabal | 2 +- eras/shelley/impl/cddl-files/shelley.cddl | 227 +++---- flake.lock | 6 +- .../Test/Cardano/Ledger/Binary/Cuddle.hs | 2 +- 6 files changed, 410 insertions(+), 388 deletions(-) diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index 4dadfd12174..c9309c4fe80 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -143,7 +143,7 @@ library testlib bytestring, cardano-data:{cardano-data, testlib}, containers, - cuddle >=0.3.0.0, + cuddle >=0.3.1.0, plutus-ledger-api, deepseq, here, diff --git a/eras/conway/impl/cddl-files/conway.cddl b/eras/conway/impl/cddl-files/conway.cddl index 130029f5331..f416c366da3 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 @@ -63,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 @@ -89,38 +93,38 @@ big_uint = #6.2(bounded_bytes) ; 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 = [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 @@ -132,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 @@ -165,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 @@ -234,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} @@ -296,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 @@ -324,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] @@ -376,35 +341,27 @@ 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: @@ -471,10 +428,6 @@ script_any = (2, [* native_script]) ; empty map, in which case the user supplied encoding of the empty map is used. 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 @@ -488,57 +441,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 @@ -557,31 +490,17 @@ transaction_metadatum_label = uint .size 8 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] @@ -590,20 +509,16 @@ vkeywitness = [$vkey, $signature] vote = 0 .. 2 -vote_deleg_cert = (9, stake_credential, drep) - -vote_reg_deleg_cert = (12, stake_credential, drep, coin) - ; 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] +voter = [0, addr_keyhash // + 1, scripthash // + 2, addr_keyhash // + 3, scripthash // + 4, addr_keyhash] voting_procedure = [vote, anchor / nil] @@ -612,3 +527,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/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index 228c64d574e..e0d684851c1 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -167,7 +167,7 @@ library testlib cardano-slotting:{cardano-slotting, testlib}, cardano-strict-containers, containers, - cuddle, + cuddle >=0.3.1.0, FailT, generic-random, hedgehog-quickcheck, diff --git a/eras/shelley/impl/cddl-files/shelley.cddl b/eras/shelley/impl/cddl-files/shelley.cddl index 0e37d9505a1..c96d10f1611 100644 --- a/eras/shelley/impl/cddl-files/shelley.cddl +++ b/eras/shelley/impl/cddl-files/shelley.cddl @@ -1,4 +1,7 @@ ; 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] + $hash28 = bytes .size 28 $hash32 = bytes .size 32 @@ -59,23 +62,23 @@ address = h'00100000000000000000000000000000000000000000000000000000001100000000 / h'6070000000000000000000000000000000000000000000000000000000' / h'7080000000000000000000000000000000000000000000000000000000' -block = [header - , transaction_bodies : [* transaction_body] - , transaction_witness_sets : [* transaction_witness_set] - , transaction_metadata_set : {* transaction_index => transaction_metadata}] +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] +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] +certificate = [stake_registration // + stake_deregistration // + stake_delegation // + pool_registration // + pool_retirement // + genesis_key_delegation // + move_instantaneous_rewards_cert] coin = uint @@ -85,23 +88,21 @@ epoch = uint genesis_delegate_hash = $hash28 -genesis_key_delegation = (5, genesishash, genesis_delegate_hash, vrf_keyhash) - 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] +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] ipv4 = bytes .size 4 @@ -113,109 +114,69 @@ metadata_hash = $hash32 move_instantaneous_reward = [0 / 1, {* stake_credential => coin}] -move_instantaneous_rewards_cert = (6, move_instantaneous_reward) - -multi_host_name = (2, dns_name) +multisig_script = [multisig_pubkey // + multisig_all // + multisig_any // + multisig_n_of_k] -multisig_all = (1, [* multisig_script]) - -multisig_any = (2, [* multisig_script]) - -multisig_n_of_k = (3, uint, [* multisig_script]) - -multisig_pubkey = (0, addr_keyhash) - -multisig_script = [multisig_pubkey - // multisig_all - // multisig_any - // multisig_n_of_k] - -nonce = [0 // 1, bytes .size 32] +nonce = [0 // + 1, bytes .size 32] nonnegative_interval = #6.30([uint, positive_int]) -operational_cert = ($kes_vkey, uint, uint, $signature) - pool_keyhash = $hash28 pool_metadata = [url, metadata_hash] -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) - 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} - -protocol_version = (major_protocol_version, uint) - -relay = [single_host_addr // single_host_name // multi_host_name] +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 -set = [* a0] - signkeyKES = bytes .size 64 -single_host_addr = (0, port / nil, ipv4 / nil, ipv6 / nil) - -single_host_name = (1, port / nil, dns_name) - -stake_credential = [0, addr_keyhash // 1, scripthash] - -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) +stake_credential = [0, addr_keyhash // + 1, scripthash] -transaction = [transaction_body - , transaction_witness_set - , transaction_metadata / nil] +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_body = {0 : set, + 1 : [* transaction_output], + 2 : coin, + 3 : uint, + ? 4 : [* certificate], + ? 5 : withdrawals, + ? 6 : update, + ? 7 : metadata_hash} transaction_index = uint .size 2 @@ -233,9 +194,9 @@ transaction_metadatum_label = uint transaction_output = [address, amount : coin] -transaction_witness_set = {? 0 : [* vkeywitness] - , ? 1 : [* multisig_script] - , ? 2 : [* bootstrap_witness]} +transaction_witness_set = {? 0 : [* vkeywitness], + ? 1 : [* multisig_script], + ? 2 : [* bootstrap_witness]} unit_interval = #6.30([1, 2]) @@ -248,3 +209,49 @@ 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) + +multi_host_name = (2, dns_name) + +multisig_all = (1, [* multisig_script]) + +multisig_any = (2, [* multisig_script]) + +multisig_n_of_k = (3, uint, [* multisig_script]) + +multisig_pubkey = (0, addr_keyhash) + +operational_cert = ($kes_vkey, uint, uint, $signature) + +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) + +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) + +; This will be deprecated in a future era +stake_registration = (0, stake_credential) + +set = [* a0] 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/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 "" From 1759af1f6d0c01e33f3a4c5612333e9a65079aeb Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 20 Aug 2024 17:44:37 -0600 Subject: [PATCH 10/13] Update a comment describing change in behavior of hashIntegrity --- eras/conway/impl/cddl-files/conway.cddl | 11 +++++++---- .../impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs | 12 +++++++----- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/eras/conway/impl/cddl-files/conway.cddl b/eras/conway/impl/cddl-files/conway.cddl index f416c366da3..60ff200c755 100644 --- a/eras/conway/impl/cddl-files/conway.cddl +++ b/eras/conway/impl/cddl-files/conway.cddl @@ -422,10 +422,13 @@ script = [0, native_script // ; ; Finally, note that in the case that a transaction includes datums but does not ; include the redeemers field, the script data format becomes (in hex): -; [ 80 | datums | A0 ] -; corresponding to a CBOR empty list and an empty map. -; Note that a transaction might include the redeemers field and it to the -; empty map, in which case the user supplied encoding of the empty map is used. +; [ 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_ref = #6.24(bytes .cbor script) 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 dd8605b608c..fd30e2e6a4f 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs @@ -366,11 +366,13 @@ script_data_hash = Finally, note that in the case that a transaction includes datums but does not include the redeemers field, the script data format becomes (in hex): - [ 80 | datums | A0 ] - corresponding to a CBOR empty list and an empty map. - Note that a transaction might include the redeemers field and it to the - empty map, in which case the user supplied encoding of the empty map is used. - + [ 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 From 9ea8ff476b1e70d18c17933e0fa24b28d1f20d98 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Wed, 21 Aug 2024 13:55:24 +0200 Subject: [PATCH 11/13] Define CDDL for Allegra in Huddle. Includes tests and generation utility. --- .../allegra/impl/cardano-ledger-allegra.cabal | 17 + eras/allegra/impl/cddl-files/allegra.cddl | 493 +++++++++--------- eras/allegra/impl/cddl-files/crypto.cddl | 13 - eras/allegra/impl/cddl-files/extras.cddl | 27 - eras/allegra/impl/huddle-cddl/Main.hs | 11 + .../Cardano/Ledger/Allegra/Binary/CddlSpec.hs | 13 +- .../Cardano/Ledger/Allegra/Binary/Cddl.hs | 5 +- .../Test/Cardano/Ledger/Allegra/CDDL.hs | 140 +++++ hie.yaml | 6 + 9 files changed, 428 insertions(+), 297 deletions(-) delete mode 100644 eras/allegra/impl/cddl-files/crypto.cddl delete mode 100644 eras/allegra/impl/cddl-files/extras.cddl create mode 100644 eras/allegra/impl/huddle-cddl/Main.hs create mode 100644 eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/CDDL.hs 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/hie.yaml b/hie.yaml index ca5cda55700..11b5b17089e 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" From 8c36768ae2ce01d3f2cd98cfd5cbe3724b510c06 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Wed, 21 Aug 2024 15:52:28 +0200 Subject: [PATCH 12/13] Define CDDL for Mary in Huddle. Also includes testing and cddl generation tool. --- eras/mary/impl/cardano-ledger-mary.cabal | 17 + eras/mary/impl/cddl-files/crypto.cddl | 13 - eras/mary/impl/cddl-files/extras.cddl | 27 - eras/mary/impl/cddl-files/mary.cddl | 516 +++++++++--------- eras/mary/impl/huddle-cddl/Main.hs | 11 + .../Cardano/Ledger/Mary/Binary/CddlSpec.hs | 13 +- .../Test/Cardano/Ledger/Mary/Binary/Cddl.hs | 5 +- .../testlib/Test/Cardano/Ledger/Mary/CDDL.hs | 98 ++++ hie.yaml | 6 + 9 files changed, 395 insertions(+), 311 deletions(-) delete mode 100644 eras/mary/impl/cddl-files/crypto.cddl delete mode 100644 eras/mary/impl/cddl-files/extras.cddl create mode 100644 eras/mary/impl/huddle-cddl/Main.hs create mode 100644 eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/CDDL.hs 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/hie.yaml b/hie.yaml index 11b5b17089e..ed6d5c2b055 100644 --- a/hie.yaml +++ b/hie.yaml @@ -123,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" From bcd26f0882504170a532e7e0da118c4f566e86af Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Wed, 21 Aug 2024 15:54:25 +0200 Subject: [PATCH 13/13] Update gen-cddl script for Mary and Allegra. --- scripts/gen-cddl.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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