diff --git a/eras/allegra/impl/cardano-ledger-allegra.cabal b/eras/allegra/impl/cardano-ledger-allegra.cabal index 5fa3e1dc599..1ba7426e19e 100644 --- a/eras/allegra/impl/cardano-ledger-allegra.cabal +++ b/eras/allegra/impl/cardano-ledger-allegra.cabal @@ -107,6 +107,7 @@ library testlib containers, cuddle, generic-random, + heredoc, microlens, mtl, small-steps, diff --git a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/CDDL.hs b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/CDDL.hs index a9085a8f255..d2df47b8be9 100644 --- a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/CDDL.hs +++ b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/CDDL.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} @@ -11,21 +12,8 @@ module Test.Cardano.Ledger.Allegra.CDDL where import Codec.CBOR.Cuddle.Huddle import Data.Function (($)) import Test.Cardano.Ledger.Core.Binary.CDDL -import Test.Cardano.Ledger.Shelley.CDDL ( - bootstrap_witness, - certificate, - header, - metadata_hash, - set, - transaction_index, - transaction_input, - transaction_metadatum, - transaction_metadatum_label, - transaction_output, - update, - vkeywitness, - withdrawals, - ) +import Test.Cardano.Ledger.Shelley.CDDL hiding (block, transaction, transaction_body) +import Text.Heredoc cddl :: Huddle cddl = collectFrom [block, transaction] @@ -36,20 +24,23 @@ cddl = collectFrom [block, transaction] native_script :: Rule native_script = - comment "Timelock validity intervals are half-open intervals [a, b)." $ - "native_script" + comment + [str| + |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. + |] + $ "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] @@ -70,15 +61,6 @@ 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" diff --git a/eras/alonzo/impl/.ghcid b/eras/alonzo/impl/.ghcid index 081c5d317b6..5b411c7e963 100644 --- a/eras/alonzo/impl/.ghcid +++ b/eras/alonzo/impl/.ghcid @@ -1 +1 @@ ---command="cabal repl --repl-options='-isrc -fwarn-unused-binds -fwarn-unused-imports -fno-code -fobject-code -g2 -fno-break-on-exception -fno-break-on-error -ferror-spans -j -Wno-unused-packages'" --clear --no-height-limit --reverse-errors --reload=../../../ --outputfile=/tmp/cardano-ledger-alonzo-ghcid.txt \ No newline at end of file +--command="cabal repl --repl-options='-isrc -fwarn-unused-binds -fwarn-unused-imports -fno-code -fobject-code -g2 -fno-break-on-exception -fno-break-on-error -ferror-spans -j -Wno-unused-packages'" --clear --no-height-limit --reverse-errors --reload=../../../ --outputfile=/tmp/cardano-ledger-alonzo-ghcid.txt diff --git a/eras/alonzo/impl/cardano-ledger-alonzo.cabal b/eras/alonzo/impl/cardano-ledger-alonzo.cabal index 9167e1a0b3e..34984973a5f 100644 --- a/eras/alonzo/impl/cardano-ledger-alonzo.cabal +++ b/eras/alonzo/impl/cardano-ledger-alonzo.cabal @@ -103,6 +103,7 @@ library library testlib exposed-modules: Test.Cardano.Ledger.Alonzo.Arbitrary + Test.Cardano.Ledger.Alonzo.CDDL Test.Cardano.Ledger.Alonzo.Binary.Cddl Test.Cardano.Ledger.Alonzo.Binary.CostModelsSpec Test.Cardano.Ledger.Alonzo.Binary.RoundTrip @@ -135,13 +136,15 @@ library testlib cardano-crypto-class, cardano-data, cardano-ledger-alonzo, - cardano-ledger-allegra, + cardano-ledger-allegra:{cardano-ledger-allegra, testlib}, cardano-ledger-binary, cardano-ledger-mary:testlib, cardano-ledger-core:{cardano-ledger-core, testlib}, cardano-ledger-shelley:{cardano-ledger-shelley, testlib}, cardano-strict-containers, cardano-slotting, + cuddle, + heredoc, plutus-ledger-api, generic-random, microlens, @@ -153,6 +156,21 @@ library testlib tree-diff, QuickCheck +executable huddle-cddl + main-is: Main.hs + hs-source-dirs: huddle-cddl + other-modules: Paths_cardano_ledger_alonzo + default-language: Haskell2010 + ghc-options: + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints -Wpartial-fields + -Wunused-packages -threaded -rtsopts -with-rtsopts=-N + + build-depends: + base, + testlib, + cardano-ledger-binary:testlib >=1.5 + executable gen-golden main-is: GenerateGoldenFileMain.hs hs-source-dirs: test diff --git a/eras/alonzo/impl/cddl-files/alonzo.cddl b/eras/alonzo/impl/cddl-files/alonzo.cddl index 1885af7c4e6..c59f43bdc00 100644 --- a/eras/alonzo/impl/cddl-files/alonzo.cddl +++ b/eras/alonzo/impl/cddl-files/alonzo.cddl @@ -341,8 +341,6 @@ auxiliary_data = , ? 2 => [ * plutus_script ] }) - - vkeywitness = [ $vkey, $signature ] bootstrap_witness = diff --git a/eras/alonzo/impl/huddle-cddl/Main.hs b/eras/alonzo/impl/huddle-cddl/Main.hs new file mode 100644 index 00000000000..eba1430e613 --- /dev/null +++ b/eras/alonzo/impl/huddle-cddl/Main.hs @@ -0,0 +1,11 @@ +module Main where + +import Paths_cardano_ledger_alonzo +import Test.Cardano.Ledger.Binary.Cuddle (writeSpec) +import qualified Test.Cardano.Ledger.Alonzo.CDDL as Alonzo + +-- Generate cddl files for all relevant specifications +main :: IO () +main = do + specFile <- getDataFileName "cddl-files/alonzo.cddl" + writeSpec Alonzo.alonzo specFile diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/CDDL.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/CDDL.hs new file mode 100644 index 00000000000..f1f485a43dc --- /dev/null +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/CDDL.hs @@ -0,0 +1,454 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use camelCase" #-} +{-# HLINT ignore "Evaluate" #-} + +module Test.Cardano.Ledger.Alonzo.CDDL where + +import Codec.CBOR.Cuddle.Huddle +import Data.Function (($)) +import Data.Semigroup ((<>)) +import Data.Word (Word64) +import GHC.Num (Integer) +import Test.Cardano.Ledger.Core.Binary.CDDL +import Test.Cardano.Ledger.Shelley.CDDL hiding ( + block, + transaction, + transaction_body, + transaction_witness_set, + transaction_output + ) +import Test.Cardano.Ledger.Allegra.CDDL hiding ( + block, + transaction, + transaction_body, + auxiliary_data + ) +import Test.Cardano.Ledger.Mary.CDDL hiding ( + block, + transaction, + transaction_body, + ) +import Text.Heredoc + +alonzo :: Huddle +alonzo = + collectFrom $ + [block, transaction] + <> [kes_signature, language, signkeyKES] + +block :: Rule +block = + comment + [str| + |COMMENTS: + | 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 + |NEW: + | invalid_transactions + |] + $ "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 = + "transaction" + =:= arr + [ a transaction_body + , a transaction_witness_set + , a VBool + , a (auxiliary_data / VNil) + ] + +-- 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" =:= (7 :: Integer) +next_major_protocol_version :: Integer +next_major_protocol_version = 7 + +transaction_body :: Rule +transaction_body = + comment + [str| + |COMMENTS: + | 2 : coin ; fee + | 3 : uint ; time to live + | 8 : uint ; validity interval start + | 13 : set transaction_input ; collateral + |NEW: + | 11 : script_data_hash + | 13 : set transaction_input + | 14 : required_signers + | 15 : network_id + |] + $ "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 ==> auxiliary_data_hash) + , opt (idx 8 ==> VUInt) + , opt (idx 9 ==> mint) + , opt (idx 11 ==> script_data_hash) + , opt (idx 13 ==> set transaction_input) + , opt (idx 14 ==> required_signers) + , opt (idx 15 ==> network_id) + ] + +required_signers :: Rule +required_signers = "required_signers" =:= set addr_keyhash + +transaction_output :: Rule +transaction_output = + comment + [str| + |NEW: + | ? datum_hash : $hash32 + |] + $ "transaction_output" + =:= arr + [ a address + , "amount" ==> value + , opt ("datum_hash" ==> hash32) + ] + +script_data_hash :: Rule +script_data_hash = + comment + [str| + |This is a hash of data which may affect evaluation of a script. + | + |This data consists of: + | - The redeemers from the transaction_witness_set (the value of field 5). + | - The datums from the transaction_witness_set (the value of field 4). + | - The value in the costmdls map corresponding to the script's language + | (in field 18 of protocol_param_update.) + |(In the future it may contain additional protocol parameters.) + | + |Since this data does not exist in contiguous form inside a transaction, it needs + |to be independently constructed by each recipient. + | + |The bytestring which is hashed is the concatenation of three things: + | redeemers || datums || language views + |The redeemers are exactly the data present in the transaction witness set. + |Similarly for the datums, if present. If no datums are provided, the middle + |field is omitted (i.e. it is the empty/null bytestring). + | + |language views CDDL: + |{ * language => script_integrity_data } + | + |This must be encoded canonically, using the same scheme as in + |RFC7049 section 3.9: + | - Maps, strings, and bytestrings must use a definite-length encoding + | - Integers must be as small as possible. + | - The expressions for map length, string length, and bytestring length + | must be as short as possible. + | - The keys in the map must be sorted as follows: + | - If two keys have different lengths, the shorter one sorts earlier. + | - If two keys have the same length, the one with the lower value + | in (byte-wise) lexical order sorts earlier. + | + |For PlutusV1 (language id 0), the language view is the following: + | - the value of costmdls map at key 0 is encoded as an indefinite length + | list and the result is encoded as a bytestring. (our apologies) + | - the language ID tag is also encoded twice. first as a uint then as + | a bytestring. (our apologies) + | + |Note that each Plutus language represented inside a transaction must have + |a cost model in the costmdls protocol parameter in order to execute, + |regardless of what the script integrity data is. In the Alonzo era, + |this means costmdls must have a key 0 for Plutus V1. + | + |Finally, note that in the case that a transaction includes datums but does not + |include any redeemers, the script data format becomes (in hex): + |[ 80 | datums | A0 ] + |corresponding to a CBOR empty list and an empty map (our apologies). + | + |NEW: + | script_data_hash + |] + $ "script_data_hash" =:= hash32 + +certificates :: Rule +certificates = "certificates" =:= arr [0 <+ a certificate] + +genesis_key_delegation :: Named Group +genesis_key_delegation = "genesis_key_delegation" =:~ grp [5, a genesishash, a genesis_delegate_hash, a vrf_keyhash] + +protocol_param_update :: Rule +protocol_param_update = + comment + [str| + |? 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 + |? 16: coin ; min pool cost ; New + |? 17: coin ; ada per utxo byte ; New + |? 18: costmdls ; cost models for script languages ; New + |? 19: ex_unit_prices ; execution costs ; New + |? 20: ex_units ; max tx ex units ; New + |? 21: ex_units ; max block ex units ; New + |? 22: uint ; max value size ; New + |? 23: uint ; collateral percentage ; New + |? 24: uint ; max collateral inputs ; New + |] + $ "protocol_param_update" + =:= mp + [ opt (idx 0 ==> VUInt) + , opt (idx 1 ==> VUInt) + , opt (idx 2 ==> VUInt) + , opt (idx 3 ==> VUInt) + , opt (idx 4 ==> (VUInt `sized` (2 :: Word64))) + , opt (idx 5 ==> coin) + , opt (idx 6 ==> coin) + , opt (idx 7 ==> epoch) + , opt (idx 8 ==> VUInt) + , opt (idx 9 ==> nonnegative_interval) + , opt (idx 10 ==> unit_interval) + , opt (idx 11 ==> unit_interval) + , opt (idx 12 ==> unit_interval) + , opt (idx 13 ==> nonce) + , opt (idx 14 ==> arr [a protocol_version]) + + , opt (idx 16 ==> coin) + , opt (idx 17 ==> coin) + , opt (idx 18 ==> costmdls) + , opt (idx 19 ==> ex_unit_prices) + , opt (idx 20 ==> ex_units) + , opt (idx 21 ==> ex_units) + , opt (idx 22 ==> VUInt) + , opt (idx 23 ==> VUInt) + , opt (idx 24 ==> VUInt) + ] + +transaction_witness_set :: Rule +transaction_witness_set = + comment + [str| + |NEW: + | ? 3: [* plutus_script ] + | ? 4: [* plutus_data ] + | ? 5: [* redeemer ] + |] + $ "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] + , opt $ idx 3 ==> arr [0 <+ a plutus_script] + , opt $ idx 4 ==> arr [0 <+ a plutus_data] + , opt $ idx 5 ==> arr [0 <+ a redeemer] + ] + +plutus_script :: Rule +plutus_script = "plutus_script" =:= VBytes + +plutus_data :: Rule +plutus_data = + comment + [str| + |NEW + |] + $ "plutus_data" + =:= constr plutus_data + / smp [0 <+ asKey plutus_data ==> plutus_data] + / sarr [0 <+ a plutus_data] + / big_int + / bounded_bytes + +constr :: IsType0 x => x -> GRuleCall +constr = binding $ \x -> + comment + [str| + |NEW + |NOTE: + | For tag range: 6.1280 .. 6.1400 inclusive + | #6.102([uint, [* a]]) + |] + $ "constr" + =:= tag 121 (arr [0 <+ a x]) + / tag 122 (arr [0 <+ a x]) + / tag 123 (arr [0 <+ a x]) + / tag 124 (arr [0 <+ a x]) + / tag 125 (arr [0 <+ a x]) + / tag 126 (arr [0 <+ a x]) + / tag 127 (arr [0 <+ a x]) + -- similarly for tag range: 6.1280 .. 6.1400 inclusive + / tag 102 (arr [a VUInt, a $ arr [0 <+ a x]]) + +redeemer :: Rule +redeemer = + comment + [str| + |NEW + |] + $ "redeemer" + =:= arr + [ "tag" ==> redeemer_tag + , "index" ==> VUInt + , "data" ==> plutus_data + , "ex_units" ==> ex_units + ] + +redeemer_tag :: Rule +redeemer_tag = + comment + [str| + |0 ; spend + |1 ; mint + |2 ; cert + |3 ; reward + |] + $ "redeemer_tag" + =:= int 0 + / int 1 + / int 2 + / int 3 + +ex_units :: Rule +ex_units = "ex_units" =:= arr ["mem" ==> VUInt, "steps" ==> VUInt] + +ex_unit_prices :: Rule +ex_unit_prices = + "ex_unit_prices" + =:= arr + [ "mem_price" ==> positive_interval + , "step_price" ==> positive_interval + ] + +language :: Rule +language = + comment + [str| + |New + |This is an enumeration. for now there's only one value + |] + $ "language" =:= int 0 + +costmdls :: Rule +costmdls = "costmdls" =:= mp [0 <+ asKey language ==> cost_model] + +cost_model :: Rule +cost_model = + comment + [str| + |NEW + |The keys to the cost model map are not present in the serialization. + |The values in the serialization are assumed to be ordered + |lexicographically by their correpsonding key value. + |See Plutus' `ParamName` for parameter ordering + |] + $ "cost_model" + -- cost_model = [ 166*166 int64 ] -- TODO: Get right @aniketd + =:= arr [166 <+ a int64 +> 166] + +metadata :: Rule +metadata = + "metadata" + =:= mp + [ 0 + <+ asKey transaction_metadatum_label + ==> transaction_metadatum + ] + +auxiliary_data :: Rule +auxiliary_data = + comment + [str| + |metadata : shelley + |transaction_metadata : shelley-ma + |#6.259(0 ==> metadata) ; alonzo onwards NEW + |] + $ "auxiliary_data" + =:= metadata -- Shelley + / sarr + [ "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_script]) + ] + ) +header_body :: Rule +header_body = + "header_body" + =:= arr + [ "block_number" ==> VUInt + , "slot" ==> VUInt + , "prev_hash" ==> (hash32 / VNil) + , "issuer_vkey" ==> vkey + , "vrf_vkey" ==> vrf_vkey + , "vrf_result" ==> vrf_cert + , "block_body_size" ==> VUInt + , "block_body_hash" ==> hash32 + , a operational_cert + , a protocol_version + ] + + +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" ==> VUInt, 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] + +positive_interval :: Rule +positive_interval = "positive_interval" =:= tag 30 (arr [a positive_int, a positive_int]) + +network_id :: Rule +network_id = "network_id" =:= int 0 / int 1 + +auxiliary_data_hash :: Rule +auxiliary_data_hash = "auxiliary_data_hash" =:= hash32 diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index 51a6a43f9ce..93000b3874e 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -153,11 +153,11 @@ library testlib cuddle >=0.3.1.0, plutus-ledger-api, deepseq, - here, microlens, cardano-crypto-class, cardano-data:{cardano-data, testlib}, - cardano-ledger-allegra, + cardano-ledger-allegra:{cardano-ledger-allegra, testlib}, + cardano-ledger-mary:testlib, cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib}, cardano-ledger-binary:{cardano-ledger-binary, testlib}, cardano-ledger-babbage:{cardano-ledger-babbage, testlib}, @@ -171,7 +171,7 @@ library testlib deepseq, FailT, generic-random, - here, + heredoc, microlens, microlens-mtl, mtl, 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 8ed31fc396a..f5ca12a4c3d 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/CDDL.hs @@ -8,23 +8,74 @@ {-# HLINT ignore "Use camelCase" #-} {-# HLINT ignore "Evaluate" #-} -module Test.Cardano.Ledger.Conway.CDDL (conway) where +module Test.Cardano.Ledger.Conway.CDDL 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.Allegra.CDDL hiding ( + auxiliary_data, + block, + transaction, + transaction_body, + ) +import Test.Cardano.Ledger.Alonzo.CDDL hiding ( + -- Since the comments are different + + auxiliary_data, + block, + certificates, + costmdls, + ex_unit_prices, + language, + metadata, + next_major_protocol_version, + protocol_param_update, + redeemer_tag, + required_signers, + script_data_hash, + transaction, + transaction_body, + transaction_output, + transaction_witness_set, + ) +import Test.Cardano.Ledger.Alonzo.CDDL qualified as Alonzo (transaction_output) import Test.Cardano.Ledger.Core.Binary.CDDL -import Test.Cardano.Ledger.Shelley.CDDL ( - bootstrap_witness, - port, - single_host_addr, - transaction_index, - transaction_metadatum, - vkeywitness, +import Test.Cardano.Ledger.Mary.CDDL hiding ( + block, + mint, + transaction, + transaction_body, + value, + ) +import Test.Cardano.Ledger.Shelley.CDDL hiding ( + block, + certificate, + dns_name, + multi_host_name, + next_major_protocol_version, + nonempty_set, + operational_cert, + pool_metadata, + pool_params, + pool_registration, + protocol_param_update, + relay, + set, + single_host_name, + transaction, + transaction_body, + transaction_input, + transaction_metadatum_label, + transaction_output, + transaction_witness_set, + url, ) +import Text.Heredoc + +-- import Test.Cardano.Ledger.Babbage.CDDL conway :: Huddle conway = @@ -35,14 +86,13 @@ conway = block :: Rule block = 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 - - |] + [str| + |Valid blocks must also satisfy the following two constraints: + |1) the length of transaction_bodies and transaction_witness_sets + | must be the same + |2) every transaction_index must be strictly smaller than the + | length of transaction_bodies + |] $ "block" =:= arr [ a header @@ -64,30 +114,6 @@ transaction = , a (auxiliary_data / VNil) ] -header :: Rule -header = - "header" - =:= arr - [ 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 - ] - operational_cert :: Rule operational_cert = "operational_cert" @@ -98,9 +124,6 @@ operational_cert = , "sigma" ==> signature ] -protocol_version :: Rule -protocol_version = "protocol_version" =:= arr [a major_protocol_version, a VUInt] - -- TODO Replace with the following once -- https://github.com/input-output-hk/cuddle/issues/29 is addressed in cuddle. -- @@ -229,13 +252,13 @@ info_action = "info_action" =:= int 6 voter :: Rule voter = comment - [here| - Constitutional Committee Hot KeyHash: 0 - Constitutional Committee Hot ScriptHash: 1 - DRep KeyHash: 2 - DRep ScriptHash: 3 - StakingPool KeyHash: 4 - |] + [str| + |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] @@ -276,23 +299,14 @@ transaction_input = transaction_output :: Rule transaction_output = comment - [here| - Both of the Alonzo and Babbage style TxOut formats are equally valid - and can be used interchangeably - |] + [str| + |Both of the Alonzo and Babbage style TxOut formats are equally valid + |and can be used interchangeably + |] $ "transaction_output" - =:= pre_babbage_transaction_output + =:= Alonzo.transaction_output / post_alonzo_transaction_output -pre_babbage_transaction_output :: Rule -pre_babbage_transaction_output = - "pre_babbage_transaction_output" - =:= arr - [ a address - , "amount" ==> value - , opt ("datum_hash" ==> datum_hash) - ] - post_alonzo_transaction_output :: Rule post_alonzo_transaction_output = "post_alonzo_transaction_output" @@ -306,74 +320,74 @@ post_alonzo_transaction_output = script_data_hash :: Rule script_data_hash = comment - [here| - This is a hash of data which may affect evaluation of a script. - This data consists of: - - The redeemers from the transaction_witness_set (the value of field 5). - - The datums from the transaction_witness_set (the value of field 4). - - The value in the costmdls map corresponding to the script's language - (in field 18 of protocol_param_update.) - (In the future it may contain additional protocol parameters.) - - Since this data does not exist in contiguous form inside a transaction, it needs - to be independently constructed by each recipient. - - The bytestring which is hashed is the concatenation of three things: - redeemers || datums || language views - The redeemers are exactly the data present in the transaction witness set. - Similarly for the datums, if present. If no datums are provided, the middle - field is omitted (i.e. it is the empty/null bytestring). - - language views CDDL: - { * language => script_integrity_data } - - This must be encoded canonically, using the same scheme as in - RFC7049 section 3.9: - - Maps, strings, and bytestrings must use a definite-length encoding - - Integers must be as small as possible. - - The expressions for map length, string length, and bytestring length - must be as short as possible. - - The keys in the map must be sorted as follows: - - If two keys have different lengths, the shorter one sorts earlier. - - If two keys have the same length, the one with the lower value - in (byte-wise) lexical order sorts earlier. - - For PlutusV1 (language id 0), the language view is the following: - - the value of costmdls map at key 0 (in other words, the script_integrity_data) - is encoded as an indefinite length list and the result is encoded as a bytestring. - (our apologies) - For example, the script_integrity_data corresponding to the all zero costmodel for V1 - would be encoded as (in hex): - 58a89f00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ff - - the language ID tag is also encoded twice. first as a uint then as - a bytestring. (our apologies) - Concretely, this means that the language version for V1 is encoded as - 4100 in hex. - For PlutusV2 (language id 1), the language view is the following: - - the value of costmdls map at key 1 is encoded as an definite length list. - For example, the script_integrity_data corresponding to the all zero costmodel for V2 - would be encoded as (in hex): - 98af0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 - - the language ID tag is encoded as expected. - Concretely, this means that the language version for V2 is encoded as - 01 in hex. - For PlutusV3 (language id 2), the language view is the following: - - the value of costmdls map at key 2 is encoded as a definite length list. - - Note that each Plutus language represented inside a transaction must have - a cost model in the costmdls protocol parameter in order to execute, - regardless of what the script integrity data is. - - Finally, note that in the case that a transaction includes datums but does not - include the redeemers field, the script data format becomes (in hex): - [ A0 | datums | A0 ] - corresponding to a CBOR empty map and an empty map for language view. - This empty redeeemer case has changed from the previous eras, since default - representation for redeemers has been changed to a map. Also whenever redeemers are - supplied either as a map or as an array they must contain at least one element, - therefore there is no way to override this behavior by providing a custom - representation for empty redeemers. - |] + [str| + |This is a hash of data which may affect evaluation of a script. + |This data consists of: + | - The redeemers from the transaction_witness_set (the value of field 5). + | - The datums from the transaction_witness_set (the value of field 4). + | - The value in the costmdls map corresponding to the script's language + | (in field 18 of protocol_param_update.) + |(In the future it may contain additional protocol parameters.) + | + |Since this data does not exist in contiguous form inside a transaction, it needs + |to be independently constructed by each recipient. + | + |The bytestring which is hashed is the concatenation of three things: + | redeemers || datums || language views + |The redeemers are exactly the data present in the transaction witness set. + |Similarly for the datums, if present. If no datums are provided, the middle + |field is omitted (i.e. it is the empty/null bytestring). + | + |language views CDDL: + |{ * language => script_integrity_data } + | + |This must be encoded canonically, using the same scheme as in + |RFC7049 section 3.9: + | - Maps, strings, and bytestrings must use a definite-length encoding + | - Integers must be as small as possible. + | - The expressions for map length, string length, and bytestring length + | must be as short as possible. + | - The keys in the map must be sorted as follows: + | - If two keys have different lengths, the shorter one sorts earlier. + | - If two keys have the same length, the one with the lower value + | in (byte-wise) lexical order sorts earlier. + | + |For PlutusV1 (language id 0), the language view is the following: + | - the value of costmdls map at key 0 (in other words, the script_integrity_data) + | is encoded as an indefinite length list and the result is encoded as a bytestring. + | (our apologies) + | For example, the script_integrity_data corresponding to the all zero costmodel for V1 + | would be encoded as (in hex): + | 58a89f00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ff + | - the language ID tag is also encoded twice. first as a uint then as + | a bytestring. (our apologies) + | Concretely, this means that the language version for V1 is encoded as + | 4100 in hex. + |For PlutusV2 (language id 1), the language view is the following: + | - the value of costmdls map at key 1 is encoded as an definite length list. + | For example, the script_integrity_data corresponding to the all zero costmodel for V2 + | would be encoded as (in hex): + | 98af0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 + | - the language ID tag is encoded as expected. + | Concretely, this means that the language version for V2 is encoded as + | 01 in hex. + |For PlutusV3 (language id 2), the language view is the following: + | - the value of costmdls map at key 2 is encoded as a definite length list. + | + |Note that each Plutus language represented inside a transaction must have + |a cost model in the costmdls protocol parameter in order to execute, + |regardless of what the script integrity data is. + | + |Finally, note that in the case that a transaction includes datums but does not + |include the redeemers field, the script data format becomes (in hex): + |[ A0 | datums | A0 ] + |corresponding to a CBOR empty map and an empty map for language view. + |This empty redeeemer case has changed from the previous eras, since default + |representation for redeemers has been changed to a map. Also whenever redeemers are + |supplied either as a map or as an array they must contain at least one element, + |therefore there is no way to override this behavior by providing a custom + |representation for empty redeemers. + |] $ "script_data_hash" =:= hash32 certificate :: Rule @@ -397,31 +411,10 @@ certificate = / arr [a unreg_drep_cert] / arr [a update_drep_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_no] - --- numbers 5 and 6 used to be the Genesis and MIR certificates respectively, --- which were deprecated in Conway - -- DELEG reg_cert :: Named Group reg_cert = "reg_cert" =:~ grp [7, a stake_credential, a coin] @@ -472,13 +465,6 @@ unreg_drep_cert = "unreg_drep_cert" =:~ grp [17, a drep_credential, a coin] update_drep_cert :: Named Group update_drep_cert = "update_drep_cert" =:~ grp [18, a drep_credential, anchor / VNil] -credential :: Rule -credential = - "credential" - =:= arr - [0, a addr_keyhash] - / arr [1, a scripthash] - drep :: Rule drep = "drep" @@ -487,9 +473,6 @@ drep = / arr [2] -- always abstain / arr [3] -- always no confidence -stake_credential :: Rule -stake_credential = "stake_credential" =:= credential - drep_credential :: Rule drep_credential = "drep_credential" =:= credential @@ -547,9 +530,6 @@ pool_metadata = "pool_metadata" =:= arr [a url, a pool_metadata_hash] url :: Rule url = "url" =:= VText `sized` (0 :: Word64, 128 :: Word64) -withdrawals :: Rule -withdrawals = "withdrawals" =:= mp [1 <+ asKey reward_account ==> coin] - protocol_param_update :: Rule protocol_param_update = "protocol_param_update" @@ -643,15 +623,6 @@ plutus_v2_script = "plutus_v2_script" =:= distinct VBytes plutus_v3_script :: Rule plutus_v3_script = "plutus_v3_script" =:= distinct VBytes -plutus_data :: Rule -plutus_data = - "plutus_data" - =:= constr plutus_data - / smp [0 <+ asKey plutus_data ==> plutus_data] - / sarr [0 <+ a plutus_data] - / big_int - / bounded_bytes - constr :: IsType0 x => x -> GRuleCall constr = binding $ \x -> "constr" @@ -704,9 +675,6 @@ redeemer_tag = / int 4 -- Voting / int 5 -- Proposing -ex_units :: Rule -ex_units = "ex_units" =:= arr ["mem" ==> VUInt, "steps" ==> VUInt] - ex_unit_prices :: Rule ex_unit_prices = "ex_unit_prices" @@ -771,21 +739,6 @@ auxiliary_data = ] ) -native_script :: Rule -native_script = - "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] @@ -806,26 +759,12 @@ 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 = 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 positive_coin)] mint :: Rule mint = "mint" =:= multiasset nonZeroInt64 -network_id :: Rule -network_id = "network_id" =:= int 0 / int 1 - epoch_no :: Rule epoch_no = "epoch_no" =:= VUInt `sized` (8 :: Word64) @@ -838,34 +777,9 @@ slot_no = "slot_no" =:= VUInt `sized` (8 :: Word64) block_no :: Rule block_no = "block_no" =:= VUInt `sized` (8 :: Word64) -auxiliary_data_hash :: Rule -auxiliary_data_hash = "auxiliary_data_hash" =:= hash32 - pool_metadata_hash :: Rule pool_metadata_hash = "pool_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. --- The tags in the Conway era are: --- "\x00" for multisig scripts --- "\x01" for Plutus V1 scripts --- "\x02" for Plutus V2 scripts --- "\x03" for Plutus V3 scripts -scripthash :: Rule -scripthash = - comment - ( "To compute a script hash, note that you must prepend\n" - <> "a tag to the bytes of the script before hashing.\n" - <> "The tag is determined by the language.\n" - <> "The tags in the Conway era are:\n" - <> "\"\\x00\" for multisig scripts\n" - <> "\"\\x01\" for Plutus V1 scripts\n" - <> "\"\\x02\" for Plutus V2 scripts\n" - <> "\"\\x03\" for Plutus V3 scripts\n" - ) - $ "scripthash" =:= hash28 - datum_hash :: Rule datum_hash = "datum_hash" =:= hash32 @@ -886,12 +800,15 @@ script = / arr [2, a plutus_v2_script] / arr [3, a plutus_v3_script] --- 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] +set = binding $ \x -> + comment + [str| + |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" =:= tag 258 (arr [0 <+ a x]) / sarr [0 <+ a x] nonempty_set :: IsType0 t0 => t0 -> GRuleCall nonempty_set = binding $ \x -> diff --git a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/CDDL.hs b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/CDDL.hs index e1acc797d11..f9e1a304bc9 100644 --- a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/CDDL.hs +++ b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/CDDL.hs @@ -11,19 +11,9 @@ 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.Allegra.CDDL hiding (block, transaction, transaction_body) import Test.Cardano.Ledger.Core.Binary.CDDL -import Test.Cardano.Ledger.Shelley.CDDL ( - certificate, - header, - metadata_hash, - scripthash, - set, - transaction_index, - transaction_input, - update, - withdrawals, - ) +import Test.Cardano.Ledger.Shelley.CDDL hiding (block, transaction, transaction_body) cddl :: Huddle cddl = collectFrom [block, transaction] @@ -64,14 +54,6 @@ transaction_body = , opt (idx 9 ==> mint) ] -transaction_output :: Rule -transaction_output = - "transaction_output" - =:= arr - [ a address - , "amount" ==> value - ] - -------------------------------------------------------------------------------- -- Closure -------------------------------------------------------------------------------- diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index 1ffea744259..4634a4f9d62 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -166,6 +166,7 @@ library testlib FailT, generic-random, hedgehog-quickcheck, + heredoc, ImpSpec, prettyprinter, prettyprinter-ansi-terminal, @@ -194,7 +195,8 @@ executable huddle-cddl build-depends: base, testlib, - cardano-ledger-binary:testlib >=1.4 + cardano-ledger-binary:testlib >=1.4, + raw-strings-qq test-suite tests type: exitcode-stdio-1.0 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 3ac32234211..86ba0054dc1 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/CDDL.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} @@ -12,6 +13,7 @@ import Data.Function (($)) import Data.Word (Word64) import GHC.Num (Integer) import Test.Cardano.Ledger.Core.Binary.CDDL +import Text.Heredoc shelley :: Huddle shelley = collectFrom [block, transaction, signkeyKES] @@ -164,12 +166,30 @@ move_instantaneous_rewards_cert = move_instantaneous_reward :: Rule move_instantaneous_reward = - "move_instantaneous_reward" - =:= arr [a (int 0 / int 1), a $ mp [0 <+ asKey stake_credential ==> coin]] + comment + [str| + |The first field determines where the funds are drawn from. + |0 denotes the reserves, 1 denotes the treasury. + |If the second field is a map, funds are moved to stake credentials, + |otherwise the funds are given to the other accounting pot. + |NOTE: + | This has been safely backported from Alonzo. + |] + $ "move_instantaneous_reward" + =:= arr + [ a (int 0 / int 1) + , a $ mp [0 <+ asKey stake_credential ==> delta_coin] -- / coin] -- TODO: @aniketd + ] + +delta_coin :: Rule +delta_coin = "delta_coin" =:= VInt stake_credential :: Rule -stake_credential = - "stake_credential" +stake_credential = "stake_credential" =:= credential + +credential :: Rule +credential = + "credential" =:= arr [0, a addr_keyhash] / arr [1, a scripthash] @@ -349,7 +369,19 @@ genesishash :: Rule genesishash = "genesishash" =:= hash28 scripthash :: Rule -scripthash = "scripthash" =:= hash28 +scripthash = + comment + [str| + |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. + |The tags in the Conway era are: + | "\\x00\" for multisig scripts + | "\\x01\" for Plutus V1 scripts + | "\\x02\" for Plutus V2 scripts + | "\\x03\" for Plutus V3 scripts + |] + $ "scripthash" =:= hash28 metadata_hash :: Rule metadata_hash = "metadata_hash" =:= hash32