cuddle 1.5.0.0 → 1.6.0.0
raw patch · 48 files changed
+2284/−2476 lines, 48 filesdep ~QuickCheckdep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: QuickCheck, base, bytestring, megaparsec, prettyprinter, random, text
API changes (from Hackage documentation)
- Codec.CBOR.Cuddle.Parser.Lexer: sameLineComment :: Parser Comment
+ Codec.CBOR.Cuddle.Parser.Lexer: trailingSpace :: Parser Comment
+ Codec.CBOR.Cuddle.Pretty: renderCDDL :: LayoutOptions -> CDDL PrettyStage -> Text
Files
- CHANGELOG.md +8/−0
- bin/Main.hs +2/−7
- cddl/basic_assign.cddl +47/−0
- cddl/byron.cddl +209/−0
- cddl/conway.cddl +683/−0
- cddl/costmdls_min.cddl +3/−0
- cddl/issue80-min.cddl +8/−0
- cddl/pretty.cddl +13/−0
- cddl/shelley.cddl +288/−0
- cddl/validator.cddl +13/−0
- cddl/validator/negative/args-to-postlude.cddl +1/−0
- cddl/validator/negative/too-few-args.cddl +3/−0
- cddl/validator/negative/too-many-args.cddl +3/−0
- cddl/validator/negative/unknown-name.cddl +1/−0
- cuddle.cabal +6/−33
- example/Conway.hs +0/−972
- example/Main.hs +0/−79
- example/Monad.hs +0/−53
- example/cddl-files/basic_assign.cddl +0/−47
- example/cddl-files/byron.cddl +0/−209
- example/cddl-files/conway.cddl +0/−683
- example/cddl-files/costmdls_min.cddl +0/−3
- example/cddl-files/issue80-min.cddl +0/−8
- example/cddl-files/pretty.cddl +0/−13
- example/cddl-files/shelley.cddl +0/−288
- example/cddl-files/validator.cddl +0/−13
- example/cddl-files/validator/negative/args-to-postlude.cddl +0/−1
- example/cddl-files/validator/negative/too-few-args.cddl +0/−3
- example/cddl-files/validator/negative/too-many-args.cddl +0/−3
- example/cddl-files/validator/negative/unknown-name.cddl +0/−1
- golden/pretty/basic_assign.txt +52/−0
- golden/pretty/conway.txt +717/−0
- golden/pretty/costmdls_min.txt +4/−0
- golden/pretty/issue80-min.txt +5/−0
- golden/pretty/pretty.txt +10/−0
- src/Codec/CBOR/Cuddle/CBOR/Gen.hs +16/−11
- src/Codec/CBOR/Cuddle/Comments.hs +1/−6
- src/Codec/CBOR/Cuddle/Parser.hs +2/−1
- src/Codec/CBOR/Cuddle/Parser/Lexer.hs +24/−6
- src/Codec/CBOR/Cuddle/Pretty.hs +13/−7
- src/Codec/CBOR/Cuddle/Pretty/Columnar.hs +4/−1
- test/Main.hs +5/−0
- test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs +10/−10
- test/Test/Codec/CBOR/Cuddle/CDDL/Examples/Huddle.hs +8/−0
- test/Test/Codec/CBOR/Cuddle/CDDL/GeneratorSpec.hs +32/−1
- test/Test/Codec/CBOR/Cuddle/CDDL/Pretty.hs +43/−10
- test/Test/Codec/CBOR/Cuddle/CDDL/Pretty/Golden.hs +43/−0
- test/Test/Codec/CBOR/Cuddle/CDDL/Validator.hs +7/−7
CHANGELOG.md view
@@ -1,5 +1,13 @@ # Changelog for `cuddle` +## 1.6.0.0++* Remove `example` executable+* Make generator omit tags when zapped+* Add `renderCDDL` for pretty printing CDDL with trailing whitespace removal+* Fix CDDL pretty printing: remove spurious blank lines after commented fields, never break generic arguments across lines+* Fix prettyprinter adding an extra space at the start of comments+ ## 1.5.0.0 * Fix custom validators not running when reached via type-specific validators
bin/Main.hs view
@@ -23,7 +23,7 @@ ) import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..), mapCDDLDropExt) import Codec.CBOR.Cuddle.Parser (ParserStage, pCDDL)-import Codec.CBOR.Cuddle.Pretty (PrettyStage)+import Codec.CBOR.Cuddle.Pretty (PrettyStage, renderCDDL) import Codec.CBOR.FlatTerm (toFlatTerm) import Codec.CBOR.Pretty (prettyHexEnc) import Codec.CBOR.Read (deserialiseFromBytes)@@ -48,13 +48,10 @@ import Prettyprinter ( LayoutOptions (..), PageWidth (..),- Pretty (pretty), defaultLayoutOptions, layoutPretty,- removeTrailingWhitespace, ) import Prettyprinter.Render.Terminal qualified as Ansi-import Prettyprinter.Render.Text qualified as PT import System.Exit (exitFailure, exitSuccess) import System.IO (hPutStrLn, stderr) import System.Random (newStdGen)@@ -348,9 +345,7 @@ | sort fOpts = fromRules $ sortCDDL res | otherwise = res layoutOptions = defaultLayoutOptions {layoutPageWidth = AvailablePerLine 80 1}- formattedText =- PT.renderStrict . removeTrailingWhitespace . layoutPretty layoutOptions . pretty $- mapIndex @_ @_ @PrettyStage defs+ formattedText = renderCDDL layoutOptions $ mapIndex @_ @_ @PrettyStage defs T.putStr formattedText Validate vOpts cddlFile -> do res <- tryParseFromFile cddlFile
+ cddl/basic_assign.cddl view
@@ -0,0 +1,47 @@+coin = uint+epoch = uint++header =+ [ header_body+ , body_signature : $kes_signature+ , test : coin / null+ , withComment : null ; This is a comment+ , true+ ]++header_body = [+ issuer : text+]++$kes_signature = bytes .size 32+unit_interval<denominator> = [0 .. denominator, denominator]++unit_int = unit_interval<4294967295>++mysize = 16++sz1 = bytes .size 1+sz2 = bytes .size 2+sz32 = bytes .size 32+sz16 = bytes .size mysize++usz4 = uint .size 4+usz8 = uint .size 8++group = (usz4, usz8 / mysize, header_body, { * uint => coin })++set<a> = [ * a]+set2<a> = set<a>++coin_bag = set2<coin>++big_group = (+ "hello",+ 32,+ 8* 4,+ & group,+ uint,+ unit_interval<3>,+ 5 ...10,+ h'11aaff3351bc'+)
+ cddl/byron.cddl view
@@ -0,0 +1,209 @@+; Cardano Byron blockchain CBOR schema++block = [0, ebblock]+ / [1, mainblock]++mainblock = [ "header" : blockhead+ , "body" : blockbody+ , "extra" : [attributes]+ ]++ebblock = [ "header" : ebbhead+ , "body" : [+ stakeholderid]+ , extra : [attributes]+ ]++u8 = uint .lt 256+u16 = uint .lt 65536+u32 = uint+u64 = uint++; Basic Cardano Types++blake2b-256 = bytes .size 32++txid = blake2b-256+blockid = blake2b-256+updid = blake2b-256+hash = blake2b-256++blake2b-224 = bytes .size 28++addressid = blake2b-224+stakeholderid = blake2b-224++epochid = u64+slotid = [ epoch: epochid, slot : u64 ]++pubkey = bytes+signature = bytes++; Attributes - at the moment we do not bother deserialising these, since they+; don't contain anything++attributes = {* any => any}++; Addresses++addrdistr = [1] / [0, stakeholderid]++addrtype = &("PubKey" : 0, "Script" : 1, "Redeem" : 2) / (u64 .gt 2)+addrattr = { ? 0 : addrdistr+ , ? 1 : bytes}+address = [ #6.24(bytes .cbor ([addressid, addrattr, addrtype])), u64 ]++; Transactions++txin = [0, #6.24(bytes .cbor ([txid, u32]))] / [u8 .ne 0, encoded-cbor]+txout = [address, u64]++tx = [[+ txin], [+ txout], attributes]++txproof = [u32, hash, hash]++twit = [0, #6.24(bytes .cbor ([pubkey, signature]))]+ / [1, #6.24(bytes .cbor ([[u16, bytes], [u16, bytes]]))]+ / [2, #6.24(bytes .cbor ([pubkey, signature]))]+ / [u8 .gt 2, encoded-cbor]++; Shared Seed Computation++vsspubkey = bytes ; This is encoded using the 'Binary' instance+ ; for Scrape.PublicKey+vsssec = bytes ; This is encoded using the 'Binary' instance+ ; for Scrape.Secret.+vssenc = [bytes] ; This is encoded using the 'Binary' instance+ ; for Scrape.EncryptedSi.+ ; TODO work out why this seems to be in a length 1 array+vssdec = bytes ; This is encoded using the 'Binary' instance+ ; for Scrape.DecryptedShare+vssproof = [bytes, bytes, bytes, [* bytes]] ; This is encoded using the+ ; 'Binary' instance for Scrape.Proof++ssccomm = [pubkey, [{vsspubkey => vssenc},vssproof], signature]+ssccomms = #6.258([* ssccomm])++sscopens = {stakeholderid => vsssec}++sscshares = {addressid => [addressid, [* vssdec]]}++ssccert = [vsspubkey, pubkey, epochid, signature]+ssccerts = #6.258([* ssccert])++ssc = [0, ssccomms, ssccerts]+ / [1, sscopens, ssccerts]+ / [2, sscshares, ssccerts]+ / [3, ssccerts]++sscproof = [0, hash, hash]+ / [1, hash, hash]+ / [2, hash, hash]+ / [3, hash]++; Delegation++dlg = [ epoch : epochid+ , issuer : pubkey+ , delegate : pubkey+ , certificate : signature+ ]++dlgsig = [dlg, signature]++lwdlg = [ epochRange : [epochid, epochid]+ , issuer : pubkey+ , delegate : pubkey+ , certificate : signature+ ]++lwdlgsig = [lwdlg, signature]++; Updates++bver = [u16, u16, u8]++txfeepol = [0, #6.24(bytes .cbor ([bigint, bigint]))]+ / [u8 .gt 0, encoded-cbor]++bvermod = [ scriptVersion : [? u16]+ , slotDuration : [? bigint]+ , maxBlockSize : [? bigint]+ , maxHeaderSize : [? bigint]+ , maxTxSize : [? bigint]+ , maxProposalSize : [? bigint]+ , mpcThd : [? u64]+ , heavyDelThd : [? u64]+ , updateVoteThd : [? u64]+ , updateProposalThd : [? u64]+ , updateImplicit : [? u64]+ , softForkRule : [? [u64, u64, u64]]+ , txFeePolicy : [? txfeepol]+ , unlockStakeEpoch : [? epochid]+ ]++updata = [ hash, hash, hash, hash ]++upprop = [ "blockVersion" : bver+ , "blockVersionMod" : bvermod+ , "softwareVersion" : [ text, u32 ]+ , "data" : #6.258([text, updata])+ , "attributes" : attributes+ , "from" : pubkey+ , "signature" : signature+ ]++upvote = [ "voter" : pubkey+ , "proposalId" : updid+ , "vote" : bool+ , "signature" : signature+ ]++up = [ "proposal" : [? upprop]+ , votes : [* upvote]+ ]++; Blocks++difficulty = [u64]++blocksig = [0, signature]+ / [1, lwdlgsig]+ / [2, dlgsig]++blockcons = [slotid, pubkey, difficulty, blocksig]++blockheadex = [ "blockVersion" : bver+ , "softwareVersion" : [ text, u32 ]+ , "attributes" : attributes+ , "extraProof" : hash+ ]++blockproof = [ "txProof" : txproof+ , "sscProof" : sscproof+ , "dlgProof" : hash+ , "updProof" : hash+ ]++blockhead = [ "protocolMagic" : u32+ , "prevBlock" : blockid+ , "bodyProof" : blockproof+ , "consensusData" : blockcons+ , "extraData" : blockheadex+ ]++blockbody = [ "txPayload" : [* [tx, [* twit]]]+ , "sscPayload" : ssc+ , "dlgPayload" : [* dlg]+ , "updPayload" : up+ ]++; Epoch Boundary Blocks++ebbcons = [ epochid, difficulty ]++ebbhead = [ "protocolMagic" : u32+ , "prevBlock" : blockid+ , "bodyProof" : hash+ , "consensusData" : ebbcons+ , "extraData" : [attributes]+ ]
+ cddl/conway.cddl view
@@ -0,0 +1,683 @@+; crypto.cddl+$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++; extra.cddl+; 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.++; This is an unordered set. Duplicate elements are not allowed and the order of elements is implementation specific.+set<a> = #6.258([* a]) / [* a]++; Just like `set`, but must contain at least one element.+nonempty_set<a> = #6.258([+ a]) / [+ a]++; This is a non-empty ordered set. Duplicate elements are not allowed and the order of elements will be preserved.+nonempty_oset<a> = #6.258([+ a]) / [+ a]++positive_int = 1 .. 18446744073709551615++unit_interval = #6.30([1, 2])+ ; unit_interval = #6.30([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 = #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'++bounded_bytes = bytes .size (0..64)+ ; 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<a> = a .size 8 / a .size 16 / a .size 20 / a .size 24 / a .size 30 / a .size 32++; conway.cddl+block =+ [ header+ , transaction_bodies : [* transaction_body]+ , transaction_witness_sets : [* transaction_witness_set]+ , auxiliary_data_set : {* transaction_index => auxiliary_data }+ , invalid_transactions : [* transaction_index ]+ ]; Valid blocks must also satisfy the following two constraints:+ ; 1) the length of transaction_bodies and transaction_witness_sets+ ; must be the same+ ; 2) every transaction_index must be strictly smaller than the+ ; length of transaction_bodies++transaction =+ [ transaction_body+ , transaction_witness_set+ , bool+ , auxiliary_data / null+ ]++transaction_index = uint .size 2++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+ , vrf_result : $vrf_cert ; replaces nonce_vrf and leader_vrf+ , 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 = 10++major_protocol_version = 1..next_major_protocol_version++protocol_version = (major_protocol_version, uint)++transaction_body =+ { 0 : set<transaction_input> ; inputs+ , 1 : [* transaction_output]+ , 2 : coin ; fee+ , ? 3 : uint ; time to live+ , ? 4 : certificates+ , ? 5 : withdrawals+ , ? 7 : auxiliary_data_hash+ , ? 8 : uint ; validity interval start+ , ? 9 : mint+ , ? 11 : script_data_hash+ , ? 13 : nonempty_set<transaction_input> ; collateral inputs+ , ? 14 : required_signers+ , ? 15 : network_id+ , ? 16 : transaction_output ; collateral return+ , ? 17 : coin ; total collateral+ , ? 18 : nonempty_set<transaction_input> ; reference inputs+ , ? 19 : voting_procedures ; New; Voting procedures+ , ? 20 : proposal_procedures ; New; Proposal procedures+ , ? 21 : coin ; New; current treasury value+ , ? 22 : positive_coin ; New; donation+ }++voting_procedures = { + voter => { + gov_action_id => voting_procedure } }++voting_procedure =+ [ vote+ , anchor / null+ ]++proposal_procedure =+ [ deposit : coin+ , reward_account+ , gov_action+ , anchor+ ]++proposal_procedures = nonempty_set<proposal_procedure>++certificates = nonempty_set<certificate>++gov_action =+ [ parameter_change_action+ // hard_fork_initiation_action+ // treasury_withdrawals_action+ // no_confidence+ // update_committee+ // new_constitution+ // info_action+ ]++policy_hash = scripthash++parameter_change_action = (0, gov_action_id / null, protocol_param_update, policy_hash / null)++hard_fork_initiation_action = (1, gov_action_id / null, [protocol_version])++treasury_withdrawals_action = (2, { reward_account => coin }, policy_hash / null)++no_confidence = (3, gov_action_id / null)++update_committee = (4, gov_action_id / null, set<committee_cold_credential>, { committee_cold_credential => epoch }, unit_interval)++new_constitution = (5, gov_action_id / null, constitution)++constitution =+ [ anchor+ , scripthash / null+ ]++info_action = 6++; 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+ ]++anchor =+ [ anchor_url : url+ , anchor_data_hash : $hash32+ ]++; no - 0+; yes - 1+; abstain - 2+vote = 0 .. 2++gov_action_id =+ [ transaction_id : $hash32+ , gov_action_index : uint+ ]++required_signers = nonempty_set<addr_keyhash>++transaction_input = [ transaction_id : $hash32+ , index : uint+ ]++transaction_output = legacy_transaction_output / post_alonzo_transaction_output++legacy_transaction_output =+ [ address+ , amount : value+ , ? datum_hash : $hash32+ ]++post_alonzo_transaction_output =+ { 0 : address+ , 1 : value+ , ? 2 : datum_option ; datum option+ , ? 3 : script_ref ; script reference+ }++script_data_hash = $hash32+; 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.++; 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+ // 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+ ]++stake_registration = (0, stake_credential) ; to be deprecated in era after Conway+stake_deregistration = (1, stake_credential) ; to be deprecated in era after Conway+stake_delegation = (2, stake_credential, pool_keyhash)++; POOL+pool_registration = (3, pool_params)+pool_retirement = (4, pool_keyhash, epoch)++; numbers 5 and 6 used to be the Genesis and MIR certificates respectively,+; which were deprecated in Conway++; DELEG+reg_cert = (7, stake_credential, coin)+unreg_cert = (8, stake_credential, coin)+vote_deleg_cert = (9, stake_credential, drep)+stake_vote_deleg_cert = (10, stake_credential, pool_keyhash, drep)+stake_reg_deleg_cert = (11, stake_credential, pool_keyhash, coin)+vote_reg_deleg_cert = (12, stake_credential, drep, coin)+stake_vote_reg_deleg_cert = (13, stake_credential, pool_keyhash, drep, coin)++; GOVCERT+auth_committee_hot_cert = (14, committee_cold_credential, committee_hot_credential)+resign_committee_cold_cert = (15, committee_cold_credential, anchor / null)+reg_drep_cert = (16, drep_credential, coin, anchor / null)+unreg_drep_cert = (17, drep_credential, coin)+update_drep_cert = (18, drep_credential, anchor / null)+++delta_coin = int++credential =+ [ 0, addr_keyhash+ // 1, scripthash+ ]++drep =+ [ 0, addr_keyhash+ // 1, scripthash+ // 2 ; always abstain+ // 3 ; always no confidence+ ]++stake_credential = credential+drep_credential = credential+committee_cold_credential = credential+committee_hot_credential = credential++pool_params = ( operator: pool_keyhash+ , vrf_keyhash: vrf_keyhash+ , pledge: coin+ , cost: coin+ , margin: unit_interval+ , reward_account: reward_account+ , pool_owners: set<addr_keyhash>+ , relays: [* relay]+ , pool_metadata: pool_metadata / null+ )++port = uint .le 65535+ipv4 = bytes .size 4+ipv6 = bytes .size 16+dns_name = tstr .size (0..128)++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, pool_metadata_hash]+url = tstr .size (0..128)++withdrawals = { + reward_account => coin }++protocol_param_update =+ { ? 0: coin ; minfee A+ , ? 1: coin ; 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+ , ? 16: coin ; min pool cost+ , ? 17: coin ; ada per utxo byte+ , ? 18: costmdls ; cost models for script languages+ , ? 19: ex_unit_prices ; execution costs+ , ? 20: ex_units ; max tx ex units+ , ? 21: ex_units ; max block ex units+ , ? 22: uint ; max value size+ , ? 23: uint ; collateral percentage+ , ? 24: uint ; max collateral inputs+ , ? 25: pool_voting_thresholds ; pool voting thresholds+ , ? 26: drep_voting_thresholds ; DRep voting thresholds+ , ? 27: uint ; min committee size+ , ? 28: epoch ; committee term limit+ , ? 29: epoch ; governance action validity period+ , ? 30: coin ; governance action deposit+ , ? 31: coin ; DRep deposit+ , ? 32: epoch ; DRep inactivity period+ }++pool_voting_thresholds =+ [ unit_interval ; motion no confidence+ , unit_interval ; committee normal+ , unit_interval ; committee no confidence+ , unit_interval ; hard fork initiation+ , unit_interval ; security relevant parameter voting threshold+ ]++drep_voting_thresholds =+ [ unit_interval ; motion no confidence+ , unit_interval ; committee normal+ , unit_interval ; committee no confidence+ , unit_interval ; update constitution+ , unit_interval ; hard fork initiation+ , unit_interval ; PP network group+ , unit_interval ; PP economic group+ , unit_interval ; PP technical group+ , unit_interval ; PP governance group+ , unit_interval ; treasury withdrawal+ ]++transaction_witness_set =+ { ? 0: nonempty_set<vkeywitness>+ , ? 1: nonempty_set<native_script>+ , ? 2: nonempty_set<bootstrap_witness>+ , ? 3: nonempty_set<plutus_v1_script>+ , ? 4: nonempty_set<plutus_data>+ , ? 5: redeemers+ , ? 6: nonempty_set<plutus_v2_script>+ , ? 7: nonempty_set<plutus_v3_script>+ }++; The real type of plutus_v1_script, plutus_v2_script and plutus_v3_script is bytes.+; However, because we enforce uniqueness when many scripts are supplied,+; we need to hack around for tests in order to avoid generating duplicates,+; since the cddl tool we use for roundtrip testing doesn't generate distinct collections.+plutus_v1_script = distinct<bytes>+plutus_v2_script = distinct<bytes>+plutus_v3_script = distinct<bytes>++plutus_data =+ constr<plutus_data>+ / { * plutus_data => plutus_data }+ / [ * plutus_data ]+ / big_int+ / bounded_bytes++big_int = int / big_uint / big_nint+big_uint = #6.2(bounded_bytes)+big_nint = #6.3(bounded_bytes)++constr<a> =+ #6.121([* a])+ / #6.122([* a])+ / #6.123([* a])+ / #6.124([* a])+ / #6.125([* a])+ / #6.126([* a])+ / #6.127([* a]) ; similarly for tag range: 6.1280 .. 6.1400 inclusive+ / #6.102([uint, [* a]])++redeemers =+ [ + [ tag: redeemer_tag, index: uint, data: plutus_data, ex_units: ex_units ] ]+; TODO: Add alternative implementation that reflects the reality more accuratly:+; / { + [ tag: redeemer_tag, index: uint ] => [ data: plutus_data, ex_units: ex_units ] }++redeemer_tag =+ 0 ; Spending+ / 1 ; Minting+ / 2 ; Certifying+ / 3 ; Rewarding+ / 4 ; Voting+ / 5 ; Proposing++ex_units = [mem: uint, steps: uint]++ex_unit_prices =+ [ mem_price: nonnegative_interval, step_price: nonnegative_interval ]++language = 0 ; Plutus v1+ / 1 ; Plutus v2+ / 2 ; Plutus v3++potential_languages = 0 .. 255++; The format for costmdls is flexible enough to allow adding Plutus built-ins and language+; versions in the future.+;+costmdls =+ { ? 0 : [ 166* int ] ; Plutus v1, only 166 integers are used, but more are accepted (and ignored)+ , ? 1 : [ 175* int ] ; Plutus v2, only 175 integers are used, but more are accepted (and ignored)+ , ? 2 : [ 223* int ] ; Plutus v3, only 223 integers are used, but more are accepted (and ignored)+ , ? 3 : [ int ] ; Any 8-bit unsigned number can be used as a key.+ }++transaction_metadatum =+ { * transaction_metadatum => transaction_metadatum }+ / [ * transaction_metadatum ]+ / int+ / bytes .size (0..64)+ / text .size (0..64)++transaction_metadatum_label = uint+metadata = { * transaction_metadatum_label => transaction_metadatum }++auxiliary_data =+ metadata ; Shelley+ / [ transaction_metadata: metadata ; Shelley-ma+ , auxiliary_scripts: [ * native_script ]+ ]+ / #6.259({ ? 0 => metadata ; Alonzo and beyond+ , ? 1 => [ * native_script ]+ , ? 2 => [ * plutus_v1_script ]+ , ? 3 => [ * plutus_v2_script ]+ , ? 4 => [ * plutus_v3_script ]+ })++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.+ ]++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++multiasset<a> = { + policy_id => { + asset_name => a } }+policy_id = scripthash+asset_name = bytes .size (0..32)++negInt64 = -9223372036854775808 .. -1+posInt64 = 1 .. 9223372036854775807+nonZeroInt64 = negInt64 / posInt64 ; this is the same as the current int64 definition but without zero++positive_coin = 1 .. 18446744073709551615++value = coin / [coin, multiasset<positive_coin>]++mint = multiasset<nonZeroInt64>++int64 = -9223372036854775808 .. 9223372036854775807++network_id = 0 / 1++epoch = uint++addr_keyhash = $hash28+pool_keyhash = $hash28++vrf_keyhash = $hash32+auxiliary_data_hash = $hash32+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 = $hash28++datum_hash = $hash32+data = #6.24(bytes .cbor plutus_data)++datum_option = [ 0, $hash32 // 1, data ]++script_ref = #6.24(bytes .cbor script)++script = [ 0, native_script // 1, plutus_v1_script // 2, plutus_v2_script // 3, plutus_v3_script ]
+ cddl/costmdls_min.cddl view
@@ -0,0 +1,3 @@+costmdls =+ { 0 : [ 11* int ] ; Plutus v1, only 166 integers are used, but more are accepted (and ignored)+ }
+ cddl/issue80-min.cddl view
@@ -0,0 +1,8 @@+main = test<int, int>+set<x> = [x]+test<x, x1> = [+ 1,+ x,+ set<x>+]+
+ cddl/pretty.cddl view
@@ -0,0 +1,13 @@+set<a > = [* a]++a = [ 2*30 2 : uint+ , ? 33 : bytes+ , 4444 : set<uint>+ , * 55 => uint+ ]++b = [1,uint,(3,4)]++c = { 1: a +, 2: b ; hello+}
+ cddl/shelley.cddl view
@@ -0,0 +1,288 @@+; 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+ ]++transaction_index = uint .size 2++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++protocol_version = (major_protocol_version, uint)++transaction_body =+ { 0 : set<transaction_input>+ , 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+ ]++transaction_output = [address, amount : coin]++; 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+ ]++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<addr_keyhash>+ , relays: [* relay]+ , pool_metadata: pool_metadata / null+ )++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: rational ; 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)++transaction_metadatum_label = uint++transaction_metadata =+ { * transaction_metadatum_label => transaction_metadatum }++vkeywitness = [ $vkey, $signature ]++bootstrap_witness =+ [ public_key : $vkey+ , signature : $signature+ , chain_code : bytes .size 32+ , attributes : bytes+ ]++multisig_script =+ [ multisig_pubkey+ // multisig_all+ // multisig_any+ // multisig_n_of_k+ ]++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++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 Shelley era there is only one such tag,+; namely "\x00" for multisig scripts.+scripthash = $hash28++$nonce /= [ 0 // 1, bytes .size 32 ]++$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++finite_set<a> = [* 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++rational = #6.30([uint, uint])++set<a> = [* a]++address = bytes++reward_account = bytes
+ cddl/validator.cddl view
@@ -0,0 +1,13 @@+negative = nint++anyfloat = f16 / f32 / f64++f16 = float16+f32 = float32+f64 = float64++bs = bstr / bytes+txt = tstr / text++my_bigint = #6.2(bstr)+my_any = any
+ cddl/validator/negative/args-to-postlude.cddl view
@@ -0,0 +1,1 @@+x = uint<3>
+ cddl/validator/negative/too-few-args.cddl view
@@ -0,0 +1,3 @@+foo<a, b> = [a, b]++x = foo<uint>
+ cddl/validator/negative/too-many-args.cddl view
@@ -0,0 +1,3 @@+foo<a> = [a]++x = foo<uint, uint>
+ cddl/validator/negative/unknown-name.cddl view
@@ -0,0 +1,1 @@+x = a
cuddle.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: cuddle-version: 1.5.0.0+version: 1.6.0.0 synopsis: CDDL Generator and test utilities description: Cuddle is a library for generating and manipulating [CDDL](https://datatracker.ietf.org/doc/html/rfc8610).@@ -23,19 +23,15 @@ extra-doc-files: CHANGELOG.md tested-with: ghc ==9.6 || ==9.8 || ==9.10 || ==9.12 data-files:- example/cddl-files/*.cddl- example/cddl-files/validator/negative/*.cddl+ cddl/*.cddl+ cddl/validator/negative/*.cddl golden/*.txt+ golden/pretty/*.txt source-repository head type: git location: https://github.com/input-output-hk/cuddle -flag example- description: Enable the example executable- manual: True- default: False- common warnings ghc-options: -Wall @@ -62,7 +58,7 @@ Codec.CBOR.Cuddle.Pretty.Utils build-depends:- QuickCheck >=2.14.3 && <2.18,+ QuickCheck >=2.14.3, antigen ^>=0.4, base >=4.18 && <5, base16-bytestring >=1.0.2,@@ -95,30 +91,6 @@ hs-source-dirs: src default-language: GHC2021 -executable example- import: warnings-- if flag(example)- buildable: True- else- buildable: False-- default-language: GHC2021- other-modules:- Conway- Monad-- hs-source-dirs: example- main-is: Main.hs- build-depends:- base,- bytestring,- cuddle,- megaparsec,- prettyprinter,- random,- text,- executable cuddle import: warnings default-language: GHC2021@@ -161,6 +133,7 @@ Test.Codec.CBOR.Cuddle.CDDL.GeneratorSpec Test.Codec.CBOR.Cuddle.CDDL.Parser Test.Codec.CBOR.Cuddle.CDDL.Pretty+ Test.Codec.CBOR.Cuddle.CDDL.Pretty.Golden Test.Codec.CBOR.Cuddle.CDDL.Validator Test.Codec.CBOR.Cuddle.CDDL.Validator.Golden Test.Codec.CBOR.Cuddle.Huddle
− example/Conway.hs
@@ -1,972 +0,0 @@-{-# LANGUAGE OverloadedLists #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoImplicitPrelude #-}--{- HLINT ignore "Use camelCase" -}-{- HLINT ignore "Evaluate" -}--module 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.Float (Double)-import GHC.Num (Integer)-import GHC.Show (Show (show))--default (Integer, Double)--conway :: Huddle-conway = collectFrom [HIRule block]--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]- ]--transaction :: Rule-transaction =- "transaction"- =:= arr- [ 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]--header_body :: Rule-header_body =- "header_body"- =:= arr- [ "block_number" ==> VUInt- , "slot" ==> VUInt- , "prev_hash" ==> hash32- , "issuer_vkey" ==> vkey- , "vrf_vkey" ==> vkey- , "vrf_result" ==> vrf_cert- , "block_body_size" ==> VUInt- , "block_body_hash" ==> hash32- , a operational_cert- , a (arr [a protocol_version])- ]--operational_cert :: Rule-operational_cert =- "operational_cert"- =:= arr- [ "hot_vkey" ==> kes_vkey- , "sequence_number" ==> VUInt- , "kes_period" ==> VUInt- , "sigma" ==> signature- ]--protocol_version :: Named Group-protocol_version = "protocol_version" =:~ grp [a major_protocol_version, a VUInt]--next_major_protocol_version :: Rule-next_major_protocol_version = "next_major_protocol_version" =:= (10 :: Integer)--major_protocol_version :: Rule-major_protocol_version = "major_protocol_version" =:= (1 :: Integer)--transaction_body :: Rule-transaction_body =- "transaction_body"- =:= mp- [ idx 0 ==> set transaction_index- , idx 1 ==> arr [0 <+ a transaction_output]- , idx 2 ==> coin- , opt (idx 3 ==> VUInt)- , opt (idx 4 ==> certificates)- , opt (idx 5 ==> withdrawals)- , opt (idx 7 ==> auxiliary_data_hash)- , opt (idx 8 ==> VUInt)- , 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-voting_procedures =- "voting_procedures"- =:= mp [1 <+ "voter" ==> mp [1 <+ "gov_action_id" ==> voting_procedure]]--voting_procedure :: Rule-voting_procedure = "voting_procedure" =:= arr [a vote, a (anchor / VNil)]--proposal_procedure :: Rule-proposal_procedure =- "proposal_procedure"- =:= arr- [ "deposit" ==> coin- , a reward_account- , a gov_action- , a anchor- ]--proposal_procedures :: Rule-proposal_procedures = "proposal_procedures" =:= nonempty_set proposal_procedure--certificates :: Rule-certificates = "certificates" =:= nonempty_set certificate--gov_action :: Rule-gov_action =- "gov_action"- =:= arr- [ a- ( parameter_change_action- / hard_fork_initiation_action- / treasury_withdrawals_action- / no_confidence- / update_committee- / new_constitution- / info_action- )- ]--policy_hash :: Rule-policy_hash = "policy_hash" =:= scripthash--parameter_change_action :: Named Group-parameter_change_action =- "parameter_change_action"- =:~ grp- [ 0- , a (gov_action_id / VNil)- , a protocol_param_update- , a (policy_hash / VNil)- ]--hard_fork_initiation_action :: Named Group-hard_fork_initiation_action =- "hard_fork_initiation_action"- =:~ grp [1, a (gov_action_id / VNil), a (arr [a protocol_version])]--treasury_withdrawals_action :: Named Group-treasury_withdrawals_action =- "treasury_withdrawals_action"- =:~ grp [2, a (arr [asKey reward_account ==> coin / VInt]), a (policy_hash / VNil)]--no_confidence :: Named Group-no_confidence = "no_confidence" =:~ grp [3, a (gov_action_id / VNil)]--update_committee :: Named Group-update_committee =- "update_committee"- =:~ grp- [ 4- , a (gov_action_id / VNil)- , a (set committee_cold_credential)- , a (arr [asKey committee_cold_credential ==> epoch])- , a unit_interval- ]--new_constitution :: Named Group-new_constitution =- "new_constitution"- =:~ grp [5, a (gov_action_id / VNil), a constitution]--constitution :: Rule-constitution =- "constitution"- =:= arr- [ a anchor- , a (scripthash / VNil)- ]--info_action :: Rule-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]--anchor :: Rule-anchor =- "anchor"- =:= arr- [ "anchor_url" ==> url- , "anchor_data_hash" ==> hash32- ]--vote :: Rule-vote = "vote" =:= int 0 / int 1 / int 2--gov_action_id :: Rule-gov_action_id =- "gov_action_id"- =:= arr- [ "transaction_id" ==> hash32- , "gov_action_index" ==> VUInt- ]--required_signers :: Rule-required_signers = "required_signers" =:= nonempty_set addr_keyhash--transaction_input :: Rule-transaction_input =- "transaction_input"- =:= arr- [ "transaction_id" ==> hash32- , "index" ==> VUInt- ]--transaction_output :: Rule-transaction_output =- "transaction_output"- =:= legacy_transaction_output- / post_alonzo_transaction_output--legacy_transaction_output :: Rule-legacy_transaction_output =- "legacy_transaction_output"- =:= arr- [ a address- , "amount" ==> value- , opt ("datum_hash" ==> hash32)- ]--post_alonzo_transaction_output :: Rule-post_alonzo_transaction_output =- "post_alonzo_transaction_output"- =:= arr- [ idx 0 ==> address- , idx 1 ==> value- , opt (idx 2 ==> datum_option) -- datum option- , opt (idx 3 ==> script_ref) -- script reference- ]--script_data_hash :: Rule-script_data_hash = "script_data_hash" =:= hash32--certificate :: Rule-certificate =- "certificate"- =:= arr- [ a- ( 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- )- ]--stake_registration :: Named Group-stake_registration = "stake_registration" =:~ grp [0, a stake_credential]--stake_deregistration :: Named Group-stake_deregistration = "stake_deregistration" =:~ grp [0, a stake_credential]--stake_delegation :: Named Group-stake_delegation =- "stake_delegation"- =:~ grp [0, 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]---- 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]--unreg_cert :: Named Group-unreg_cert = "unreg_cert" =:~ grp [8, a stake_credential, a coin]--vote_deleg_cert :: Named Group-vote_deleg_cert = "vote_deleg_cert" =:~ grp [9, a stake_credential, a drep]--stake_vote_deleg_cert :: Named Group-stake_vote_deleg_cert =- "stake_vote_deleg_cert"- =:~ grp [10, a stake_credential, a pool_keyhash, a drep]--stake_reg_deleg_cert :: Named Group-stake_reg_deleg_cert =- "stake_reg_deleg_cert"- =:~ grp [11, a stake_credential, a pool_keyhash, a coin]--vote_reg_deleg_cert :: Named Group-vote_reg_deleg_cert =- "vote_reg_deleg_cert"- =:~ grp [12, a stake_credential, a drep, a coin]--stake_vote_reg_deleg_cert :: Named Group-stake_vote_reg_deleg_cert =- "stake_vote_reg_deleg_cert"- =:~ grp [13, a stake_credential, a pool_keyhash, a drep, a coin]---- GOVCERT-auth_committee_hot_cert :: Named Group-auth_committee_hot_cert =- "auth_committee_hot_cert"- =:~ grp [14, a committee_cold_credential, a committee_hot_credential]--resign_committee_cold_cert :: Named Group-resign_committee_cold_cert =- "resign_committee_cold_cert"- =:~ grp [15, a committee_cold_credential, a (anchor / VNil)]--reg_drep_cert :: Named Group-reg_drep_cert = "reg_drep_cert" =:~ grp [16, a drep_credential, a coin, a (anchor / VNil)]--unreg_drep_cert :: Named Group-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, a (anchor / VNil)]--delta_coin :: Rule-delta_coin = "delta_coin" =:= VUInt--credential :: Rule-credential =- "credential"- =:= arr- [0, a addr_keyhash]- / arr [1, a scripthash]--drep :: Rule-drep =- "drep"- =:= sarr [0, a addr_keyhash]- / sarr [1, a scripthash]- / int 2 -- always abstain- / int 3 -- always no confidence--stake_credential :: Rule-stake_credential = "stake_credential" =:= credential--drep_credential :: Rule-drep_credential = "drep_credential" =:= credential--committee_cold_credential :: Rule-committee_cold_credential = "committee_cold_credential" =:= credential--committee_hot_credential :: Rule-committee_hot_credential = "committee_hot_credential" =:= credential--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, 128 :: Word64)--single_host_addr :: Named Group-single_host_addr =- "single_host_addr"- =:~ grp- [ 0- , a (port / VNil)- , a (ipv4 / VNil)- , a (ipv6 / VNil)- ]--single_host_name :: Named Group-single_host_name =- "single_host_name"- =:~ grp- [ 1- , a (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- / single_host_name- / 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, 128 :: Word64)--withdrawals :: Rule-withdrawals = "withdrawals" =:= mp [1 <+ asKey reward_account ==> coin]--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) -- max block body size- , opt (idx 3 ==> VUInt) -- max transaction size- , opt (idx 4 ==> VUInt) -- 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 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) -- max value size- , opt (idx 23 ==> VUInt) -- collateral percentage- , opt (idx 24 ==> VUInt) -- 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) -- min committee size- , opt (idx 28 ==> epoch) -- committee term limit- , opt (idx 29 ==> epoch) -- governance action validity period- , opt (idx 30 ==> coin) -- governance action deposit- , opt (idx 31 ==> coin) -- DRep deposit- , opt (idx 32 ==> epoch) -- DRep inactivity period- ]--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- ]--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- ]--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- ]---- The real type of plutus_v1_script, plutus_v2_script and plutus_v3_script is bytes.--- However, because we enforce uniqueness when many scripts are supplied,--- we need to hack around for tests in order to avoid generating duplicates,--- since the cddl tool we use for roundtrip testing doesn't generate distinct collections.-plutus_v1_script :: Rule-plutus_v1_script =- comment- ( "The real type of plutus_v1_script, plutus_v2_script and plutus_v3_script is bytes.\n"- <> "However, because we enforce uniqueness when many scripts are supplied,\n"- <> "we need to hack around for tests in order to avoid generating duplicates,\n"- <> "since the cddl tool we use for roundtrip testing doesn't generate distinct collections.\n"- )- $ "plutus_v1_script" =:= distinct VBytes--plutus_v2_script :: Rule-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--big_int :: Rule-big_int = "big_int" =:= VInt / big_VUInt / big_nint--big_VUInt :: Rule-big_VUInt = "big_VUInt" =:= tag 2 bounded_bytes--big_nint :: Rule-big_nint = "big_nint" =:= tag 3 bounded_bytes--constr :: IsType0 x => x -> GRuleCall-constr = binding $ \x ->- "constr"- =:= tag 1 (arr [0 <+ a x])- / tag 2 (arr [0 <+ a x])- / tag 3 (arr [0 <+ a x])- / tag 4 (arr [0 <+ a x])- / tag 5 (arr [0 <+ a x])- / tag 6 (arr [0 <+ a x])- / tag 7 (arr [0 <+ a x])- -- similarly for tag range: 6.1280 .. 6.1400 inclusive- / tag 2 (arr [a VUInt, a $ arr [0 <+ a x]])--redeemers :: Rule-redeemers =- "redeemers"- =:= sarr- [ 1- <+ a- ( arr- [ "tag" ==> redeemer_tag- , "index" ==> VUInt- , "data" ==> plutus_data- , "ex_units" ==> ex_units- ]- )- ]- / smp- [ 1- <+ asKey (mp ["tag" ==> redeemer_tag, "index" ==> VUInt])- ==> arr ["data" ==> plutus_data, "ex_units" ==> ex_units]- ]--redeemer_tag :: Rule-redeemer_tag =- "redeemer_tag"- =:= int 0 -- Spending- / int 1 -- Minting- / int 2 -- Certifying- / int 3 -- Rewarding- / 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"- =:= arr- [ "mem_price" ==> nonnegative_interval- , "step_price" ==> nonnegative_interval- ]--language :: Rule-language =- "language"- =:= int 0 -- Plutus v1- / int 1 -- Plutus v2- / int 2 -- Plutus v3--potential_languages :: Rule-potential_languages = "potential_languages" =:= int 0 ... int 255---- The format for costmdls is flexible enough to allow adding Plutus built-ins and language--- versions in the future.----costmdls :: Rule-costmdls =- comment- "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 [166 <+ a VInt] -- Plutus v1, only 166 integers are used, but more are accepted (and ignored)- , opt $ idx 1 ==> arr [175 <+ a VInt] -- Plutus v2, only 175 integers are used, but more are accepted (and ignored)- , opt $ idx 2 ==> arr [223 <+ a VInt] -- Plutus v3, only 223 integers are used, but more are accepted (and ignored)- , opt $ idx 3 ==> arr [a VInt] -- 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--metadata :: Rule-metadata =- "metadata"- =:= mp- [ 0- <+ asKey transaction_metadatum_label- ==> transaction_metadatum- ]--auxiliary_data :: Rule-auxiliary_data =- "auxiliary_data"- =:= metadata -- Shelley- / sarr- [ "transaction_metadata" ==> metadata -- Shelley-ma- , "auxiliary_scripts" ==> arr [0 <+ a native_script]- ]- / smp- [ 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"- =:= arr- [ a- ( 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.- )- ]--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]--coin :: Rule-coin = "coin" =:= VUInt--multiasset :: (Show a, IsType0 a) => a -> Rule-multiasset x =- "multiasset_"- <> T.pack (show x)- =:= 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)--negInt64 :: Rule-negInt64 = "negInt64" =:= int (-9223372036854775808) ... int (-1)--posInt64 :: Rule-posInt64 = "posInt64" =:= int 1 ... int 9223372036854775807--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" =:= int 1 ... int 18446744073709551615--value :: Rule-value = "value" =:= coin / sarr [a coin, a (multiasset positive_coin)]--mint :: Rule-mint = "mint" =:= multiasset nonZeroInt64--int64 :: Rule-int64 = "int64" =:= int (-9223372036854775808) ... int 9223372036854775807--network_id :: Rule-network_id = "network_id" =:= int 0 / int 1--epoch :: Rule-epoch = "epoch" =:= VUInt--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--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--data_a :: Rule-data_a = "data" =:= VBytes `cbor` plutus_data--datum_option :: Rule-datum_option = "datum_option" =:= arr [0, a hash32] / arr [1, a data_a]--script_ref :: Rule-script_ref = "script_ref" =:= VBytes `cbor` script--script :: Rule-script =- "script"- =:= arr [0, a native_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" =:= arr [0 <+ a x]--nonempty_set :: IsType0 t0 => t0 -> GRuleCall-nonempty_set = binding $ \x -> "nonempty_set" =:= set x---- TODO Should we give this a name?-nonempty_oset :: IsType0 t0 => t0 -> GRuleCall-nonempty_oset = nonempty_set--positive_int :: Rule-positive_int = "positive_int" =:= int 1 ... int 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 :: (IsType0 a, IsConstrainable a b) => a -> GRuleCall-distinct = binding $ \x ->- "distinct"- =:= (x `sized` (8 :: Word64))- / (x `sized` (16 :: Word64))- / (x `sized` (20 :: Word64))- / (x `sized` (24 :: Word64))- / (x `sized` (30 :: Word64))- / (x `sized` (32 :: Word64))
− example/Main.hs
@@ -1,79 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}--module Main (main) where--import Codec.CBOR.Cuddle.CBOR.Gen (generateCBORTerm)-import Codec.CBOR.Cuddle.CDDL (Name (..))-import Codec.CBOR.Cuddle.CDDL.Resolve (- asMap,- buildMonoCTree,- buildRefCTree,- buildResolvedCTree,- )-import Codec.CBOR.Cuddle.Huddle (toCDDL)-import Codec.CBOR.Cuddle.Parser (pCDDL)-import Codec.CBOR.Cuddle.Pretty ()-import Conway (conway)-import Data.Text qualified as T-import Data.Text.IO qualified as T-import Monad qualified-import Prettyprinter (Pretty (pretty))-import Prettyprinter.Util (putDocW)-import System.Environment (getArgs)-import System.Random (getStdGen)-import Text.Megaparsec (ParseErrorBundle, Parsec, errorBundlePretty, runParser)--main :: IO ()-main = do- args <- getArgs- case args of- [fn] -> do- parseFromFile pCDDL fn >>= \case- Left err -> putStrLn $ errorBundlePretty err- Right res -> do- print res- putDocW 80 $ pretty res- putStrLn "\n"- putStrLn "--------------------------------------------------------------------------------"- putStrLn " As a CTree"- putStrLn "--------------------------------------------------------------------------------"- let refCTree = buildRefCTree (asMap res)- print refCTree- putStrLn "--------------------------------------------------------------------------------"- putStrLn " After name resolution"- putStrLn "--------------------------------------------------------------------------------"- let resolvedCTree = buildResolvedCTree refCTree- print resolvedCTree- putStrLn "--------------------------------------------------------------------------------"- putStrLn " After monomorphisation"- putStrLn "--------------------------------------------------------------------------------"- let monoCTree = buildMonoCTree <$> resolvedCTree- print monoCTree- [fn, name] -> do- putStrLn "--------------------------------------------------------------------------------"- putStrLn " Generating a term"- putStrLn "--------------------------------------------------------------------------------"- parseFromFile pCDDL fn >>= \case- Left err -> putStrLn $ errorBundlePretty err- Right res -> do- stdGen <- getStdGen- case buildMonoCTree =<< buildResolvedCTree (buildRefCTree (asMap res)) of- Left nre -> error $ show nre- Right mt ->- let term = generateCBORTerm mt (Name (T.pack name) mempty) stdGen- in print term- [] -> do- let cw = toCDDL conway- putDocW 80 $ pretty cw- putStrLn "--------------------------------------"- putDocW 80 $ pretty (toCDDL Monad.spec)- putStrLn "--------------------------------------"- putDocW 80 $ pretty (toCDDL Monad.spec2)- _ -> putStrLn "Expected filename"--parseFromFile ::- Parsec e T.Text a ->- String ->- IO (Either (ParseErrorBundle T.Text e) a)-parseFromFile p file = runParser p file <$> T.readFile file
− example/Monad.hs
@@ -1,53 +0,0 @@-{-# LANGUAGE OverloadedLists #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecursiveDo #-}--{- HLINT ignore "Use camelCase" -}--module Monad where--import Codec.CBOR.Cuddle.Comments ((//-))-import Codec.CBOR.Cuddle.Huddle qualified as Huddle-import Codec.CBOR.Cuddle.Huddle.HuddleM-import Data.Word (Word64)--hdl_set :: IsType0 t0 => t0 -> GRuleCall-hdl_set = Huddle.binding $ \x -> "set" Huddle.=:= arr [0 <+ a x]--spec :: Huddle-spec = huddleDef $ mdo- transaction <-- "transaction"- =:= mp- [ idx 0 ==> set txIn- , idx 1 ==> set txOut- ]- txIn <- "txIn" =:= arr ["transaction_id" ==> hash32, "index" ==> txId]- txOut <- "txOut" =:= arr [idx 0 ==> address, idx 1 ==> value]- txId <- "txId" =:= VUInt `sized` (2 :: Word64)- address <- "address" =:= VBytes `sized` (32 :: Word64)- hash32 <- "hash32" =:= VBytes `sized` (32 :: Word64)- value <- "value" =:= VUInt- set <- include hdl_set-- setRootRules [transaction]--spec2 :: Huddle-spec2 =- spec- <> huddleDef- ( mdo- set <- include hdl_set- txIn <- unsafeIncludeFromHuddle spec "txIn"- txOut <- unsafeIncludeFromHuddle spec "txOut"- _transaction <-- "transaction"- =:= mp- [ idx 0 ==> set txIn //- "Transaction inputs"- , idx 1 ==> set txOut //- "Transaction outputs"- , idx 2 ==> metadata //- "Metadata"- ]- metadata <- "metadata" =:= VBytes- _value <- "value" =:= mp ["token" ==> VText, "quantity" ==> VUInt]- pure ()- )
− example/cddl-files/basic_assign.cddl
@@ -1,47 +0,0 @@-coin = uint-epoch = uint--header =- [ header_body- , body_signature : $kes_signature- , test : coin / null- , withComment : null ; This is a comment- , true- ]--header_body = [- issuer : text-]--$kes_signature = bytes .size 32-unit_interval<denominator> = [0 .. denominator, denominator]--unit_int = unit_interval<4294967295>--mysize = 16--sz1 = bytes .size 1-sz2 = bytes .size 2-sz32 = bytes .size 32-sz16 = bytes .size mysize--usz4 = uint .size 4-usz8 = uint .size 8--group = (usz4, usz8 / mysize, header_body, { * uint => coin })--set<a> = [ * a]-set2<a> = set<a>--coin_bag = set2<coin>--big_group = (- "hello",- 32,- 8* 4,- & group,- uint,- unit_interval<3>,- 5 ...10,- h'11aaff3351bc'-)
− example/cddl-files/byron.cddl
@@ -1,209 +0,0 @@-; Cardano Byron blockchain CBOR schema--block = [0, ebblock]- / [1, mainblock]--mainblock = [ "header" : blockhead- , "body" : blockbody- , "extra" : [attributes]- ]--ebblock = [ "header" : ebbhead- , "body" : [+ stakeholderid]- , extra : [attributes]- ]--u8 = uint .lt 256-u16 = uint .lt 65536-u32 = uint-u64 = uint--; Basic Cardano Types--blake2b-256 = bytes .size 32--txid = blake2b-256-blockid = blake2b-256-updid = blake2b-256-hash = blake2b-256--blake2b-224 = bytes .size 28--addressid = blake2b-224-stakeholderid = blake2b-224--epochid = u64-slotid = [ epoch: epochid, slot : u64 ]--pubkey = bytes-signature = bytes--; Attributes - at the moment we do not bother deserialising these, since they-; don't contain anything--attributes = {* any => any}--; Addresses--addrdistr = [1] / [0, stakeholderid]--addrtype = &("PubKey" : 0, "Script" : 1, "Redeem" : 2) / (u64 .gt 2)-addrattr = { ? 0 : addrdistr- , ? 1 : bytes}-address = [ #6.24(bytes .cbor ([addressid, addrattr, addrtype])), u64 ]--; Transactions--txin = [0, #6.24(bytes .cbor ([txid, u32]))] / [u8 .ne 0, encoded-cbor]-txout = [address, u64]--tx = [[+ txin], [+ txout], attributes]--txproof = [u32, hash, hash]--twit = [0, #6.24(bytes .cbor ([pubkey, signature]))]- / [1, #6.24(bytes .cbor ([[u16, bytes], [u16, bytes]]))]- / [2, #6.24(bytes .cbor ([pubkey, signature]))]- / [u8 .gt 2, encoded-cbor]--; Shared Seed Computation--vsspubkey = bytes ; This is encoded using the 'Binary' instance- ; for Scrape.PublicKey-vsssec = bytes ; This is encoded using the 'Binary' instance- ; for Scrape.Secret.-vssenc = [bytes] ; This is encoded using the 'Binary' instance- ; for Scrape.EncryptedSi.- ; TODO work out why this seems to be in a length 1 array-vssdec = bytes ; This is encoded using the 'Binary' instance- ; for Scrape.DecryptedShare-vssproof = [bytes, bytes, bytes, [* bytes]] ; This is encoded using the- ; 'Binary' instance for Scrape.Proof--ssccomm = [pubkey, [{vsspubkey => vssenc},vssproof], signature]-ssccomms = #6.258([* ssccomm])--sscopens = {stakeholderid => vsssec}--sscshares = {addressid => [addressid, [* vssdec]]}--ssccert = [vsspubkey, pubkey, epochid, signature]-ssccerts = #6.258([* ssccert])--ssc = [0, ssccomms, ssccerts]- / [1, sscopens, ssccerts]- / [2, sscshares, ssccerts]- / [3, ssccerts]--sscproof = [0, hash, hash]- / [1, hash, hash]- / [2, hash, hash]- / [3, hash]--; Delegation--dlg = [ epoch : epochid- , issuer : pubkey- , delegate : pubkey- , certificate : signature- ]--dlgsig = [dlg, signature]--lwdlg = [ epochRange : [epochid, epochid]- , issuer : pubkey- , delegate : pubkey- , certificate : signature- ]--lwdlgsig = [lwdlg, signature]--; Updates--bver = [u16, u16, u8]--txfeepol = [0, #6.24(bytes .cbor ([bigint, bigint]))]- / [u8 .gt 0, encoded-cbor]--bvermod = [ scriptVersion : [? u16]- , slotDuration : [? bigint]- , maxBlockSize : [? bigint]- , maxHeaderSize : [? bigint]- , maxTxSize : [? bigint]- , maxProposalSize : [? bigint]- , mpcThd : [? u64]- , heavyDelThd : [? u64]- , updateVoteThd : [? u64]- , updateProposalThd : [? u64]- , updateImplicit : [? u64]- , softForkRule : [? [u64, u64, u64]]- , txFeePolicy : [? txfeepol]- , unlockStakeEpoch : [? epochid]- ]--updata = [ hash, hash, hash, hash ]--upprop = [ "blockVersion" : bver- , "blockVersionMod" : bvermod- , "softwareVersion" : [ text, u32 ]- , "data" : #6.258([text, updata])- , "attributes" : attributes- , "from" : pubkey- , "signature" : signature- ]--upvote = [ "voter" : pubkey- , "proposalId" : updid- , "vote" : bool- , "signature" : signature- ]--up = [ "proposal" : [? upprop]- , votes : [* upvote]- ]--; Blocks--difficulty = [u64]--blocksig = [0, signature]- / [1, lwdlgsig]- / [2, dlgsig]--blockcons = [slotid, pubkey, difficulty, blocksig]--blockheadex = [ "blockVersion" : bver- , "softwareVersion" : [ text, u32 ]- , "attributes" : attributes- , "extraProof" : hash- ]--blockproof = [ "txProof" : txproof- , "sscProof" : sscproof- , "dlgProof" : hash- , "updProof" : hash- ]--blockhead = [ "protocolMagic" : u32- , "prevBlock" : blockid- , "bodyProof" : blockproof- , "consensusData" : blockcons- , "extraData" : blockheadex- ]--blockbody = [ "txPayload" : [* [tx, [* twit]]]- , "sscPayload" : ssc- , "dlgPayload" : [* dlg]- , "updPayload" : up- ]--; Epoch Boundary Blocks--ebbcons = [ epochid, difficulty ]--ebbhead = [ "protocolMagic" : u32- , "prevBlock" : blockid- , "bodyProof" : hash- , "consensusData" : ebbcons- , "extraData" : [attributes]- ]
− example/cddl-files/conway.cddl
@@ -1,683 +0,0 @@-; crypto.cddl-$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--; extra.cddl-; 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.--; This is an unordered set. Duplicate elements are not allowed and the order of elements is implementation specific.-set<a> = #6.258([* a]) / [* a]--; Just like `set`, but must contain at least one element.-nonempty_set<a> = #6.258([+ a]) / [+ a]--; This is a non-empty ordered set. Duplicate elements are not allowed and the order of elements will be preserved.-nonempty_oset<a> = #6.258([+ a]) / [+ a]--positive_int = 1 .. 18446744073709551615--unit_interval = #6.30([1, 2])- ; unit_interval = #6.30([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 = #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'--bounded_bytes = bytes .size (0..64)- ; 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<a> = a .size 8 / a .size 16 / a .size 20 / a .size 24 / a .size 30 / a .size 32--; conway.cddl-block =- [ header- , transaction_bodies : [* transaction_body]- , transaction_witness_sets : [* transaction_witness_set]- , auxiliary_data_set : {* transaction_index => auxiliary_data }- , invalid_transactions : [* transaction_index ]- ]; Valid blocks must also satisfy the following two constraints:- ; 1) the length of transaction_bodies and transaction_witness_sets- ; must be the same- ; 2) every transaction_index must be strictly smaller than the- ; length of transaction_bodies--transaction =- [ transaction_body- , transaction_witness_set- , bool- , auxiliary_data / null- ]--transaction_index = uint .size 2--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- , vrf_result : $vrf_cert ; replaces nonce_vrf and leader_vrf- , 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 = 10--major_protocol_version = 1..next_major_protocol_version--protocol_version = (major_protocol_version, uint)--transaction_body =- { 0 : set<transaction_input> ; inputs- , 1 : [* transaction_output]- , 2 : coin ; fee- , ? 3 : uint ; time to live- , ? 4 : certificates- , ? 5 : withdrawals- , ? 7 : auxiliary_data_hash- , ? 8 : uint ; validity interval start- , ? 9 : mint- , ? 11 : script_data_hash- , ? 13 : nonempty_set<transaction_input> ; collateral inputs- , ? 14 : required_signers- , ? 15 : network_id- , ? 16 : transaction_output ; collateral return- , ? 17 : coin ; total collateral- , ? 18 : nonempty_set<transaction_input> ; reference inputs- , ? 19 : voting_procedures ; New; Voting procedures- , ? 20 : proposal_procedures ; New; Proposal procedures- , ? 21 : coin ; New; current treasury value- , ? 22 : positive_coin ; New; donation- }--voting_procedures = { + voter => { + gov_action_id => voting_procedure } }--voting_procedure =- [ vote- , anchor / null- ]--proposal_procedure =- [ deposit : coin- , reward_account- , gov_action- , anchor- ]--proposal_procedures = nonempty_set<proposal_procedure>--certificates = nonempty_set<certificate>--gov_action =- [ parameter_change_action- // hard_fork_initiation_action- // treasury_withdrawals_action- // no_confidence- // update_committee- // new_constitution- // info_action- ]--policy_hash = scripthash--parameter_change_action = (0, gov_action_id / null, protocol_param_update, policy_hash / null)--hard_fork_initiation_action = (1, gov_action_id / null, [protocol_version])--treasury_withdrawals_action = (2, { reward_account => coin }, policy_hash / null)--no_confidence = (3, gov_action_id / null)--update_committee = (4, gov_action_id / null, set<committee_cold_credential>, { committee_cold_credential => epoch }, unit_interval)--new_constitution = (5, gov_action_id / null, constitution)--constitution =- [ anchor- , scripthash / null- ]--info_action = 6--; 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- ]--anchor =- [ anchor_url : url- , anchor_data_hash : $hash32- ]--; no - 0-; yes - 1-; abstain - 2-vote = 0 .. 2--gov_action_id =- [ transaction_id : $hash32- , gov_action_index : uint- ]--required_signers = nonempty_set<addr_keyhash>--transaction_input = [ transaction_id : $hash32- , index : uint- ]--transaction_output = legacy_transaction_output / post_alonzo_transaction_output--legacy_transaction_output =- [ address- , amount : value- , ? datum_hash : $hash32- ]--post_alonzo_transaction_output =- { 0 : address- , 1 : value- , ? 2 : datum_option ; datum option- , ? 3 : script_ref ; script reference- }--script_data_hash = $hash32-; 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.--; 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- // 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- ]--stake_registration = (0, stake_credential) ; to be deprecated in era after Conway-stake_deregistration = (1, stake_credential) ; to be deprecated in era after Conway-stake_delegation = (2, stake_credential, pool_keyhash)--; POOL-pool_registration = (3, pool_params)-pool_retirement = (4, pool_keyhash, epoch)--; numbers 5 and 6 used to be the Genesis and MIR certificates respectively,-; which were deprecated in Conway--; DELEG-reg_cert = (7, stake_credential, coin)-unreg_cert = (8, stake_credential, coin)-vote_deleg_cert = (9, stake_credential, drep)-stake_vote_deleg_cert = (10, stake_credential, pool_keyhash, drep)-stake_reg_deleg_cert = (11, stake_credential, pool_keyhash, coin)-vote_reg_deleg_cert = (12, stake_credential, drep, coin)-stake_vote_reg_deleg_cert = (13, stake_credential, pool_keyhash, drep, coin)--; GOVCERT-auth_committee_hot_cert = (14, committee_cold_credential, committee_hot_credential)-resign_committee_cold_cert = (15, committee_cold_credential, anchor / null)-reg_drep_cert = (16, drep_credential, coin, anchor / null)-unreg_drep_cert = (17, drep_credential, coin)-update_drep_cert = (18, drep_credential, anchor / null)---delta_coin = int--credential =- [ 0, addr_keyhash- // 1, scripthash- ]--drep =- [ 0, addr_keyhash- // 1, scripthash- // 2 ; always abstain- // 3 ; always no confidence- ]--stake_credential = credential-drep_credential = credential-committee_cold_credential = credential-committee_hot_credential = credential--pool_params = ( operator: pool_keyhash- , vrf_keyhash: vrf_keyhash- , pledge: coin- , cost: coin- , margin: unit_interval- , reward_account: reward_account- , pool_owners: set<addr_keyhash>- , relays: [* relay]- , pool_metadata: pool_metadata / null- )--port = uint .le 65535-ipv4 = bytes .size 4-ipv6 = bytes .size 16-dns_name = tstr .size (0..128)--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, pool_metadata_hash]-url = tstr .size (0..128)--withdrawals = { + reward_account => coin }--protocol_param_update =- { ? 0: coin ; minfee A- , ? 1: coin ; 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- , ? 16: coin ; min pool cost- , ? 17: coin ; ada per utxo byte- , ? 18: costmdls ; cost models for script languages- , ? 19: ex_unit_prices ; execution costs- , ? 20: ex_units ; max tx ex units- , ? 21: ex_units ; max block ex units- , ? 22: uint ; max value size- , ? 23: uint ; collateral percentage- , ? 24: uint ; max collateral inputs- , ? 25: pool_voting_thresholds ; pool voting thresholds- , ? 26: drep_voting_thresholds ; DRep voting thresholds- , ? 27: uint ; min committee size- , ? 28: epoch ; committee term limit- , ? 29: epoch ; governance action validity period- , ? 30: coin ; governance action deposit- , ? 31: coin ; DRep deposit- , ? 32: epoch ; DRep inactivity period- }--pool_voting_thresholds =- [ unit_interval ; motion no confidence- , unit_interval ; committee normal- , unit_interval ; committee no confidence- , unit_interval ; hard fork initiation- , unit_interval ; security relevant parameter voting threshold- ]--drep_voting_thresholds =- [ unit_interval ; motion no confidence- , unit_interval ; committee normal- , unit_interval ; committee no confidence- , unit_interval ; update constitution- , unit_interval ; hard fork initiation- , unit_interval ; PP network group- , unit_interval ; PP economic group- , unit_interval ; PP technical group- , unit_interval ; PP governance group- , unit_interval ; treasury withdrawal- ]--transaction_witness_set =- { ? 0: nonempty_set<vkeywitness>- , ? 1: nonempty_set<native_script>- , ? 2: nonempty_set<bootstrap_witness>- , ? 3: nonempty_set<plutus_v1_script>- , ? 4: nonempty_set<plutus_data>- , ? 5: redeemers- , ? 6: nonempty_set<plutus_v2_script>- , ? 7: nonempty_set<plutus_v3_script>- }--; The real type of plutus_v1_script, plutus_v2_script and plutus_v3_script is bytes.-; However, because we enforce uniqueness when many scripts are supplied,-; we need to hack around for tests in order to avoid generating duplicates,-; since the cddl tool we use for roundtrip testing doesn't generate distinct collections.-plutus_v1_script = distinct<bytes>-plutus_v2_script = distinct<bytes>-plutus_v3_script = distinct<bytes>--plutus_data =- constr<plutus_data>- / { * plutus_data => plutus_data }- / [ * plutus_data ]- / big_int- / bounded_bytes--big_int = int / big_uint / big_nint-big_uint = #6.2(bounded_bytes)-big_nint = #6.3(bounded_bytes)--constr<a> =- #6.121([* a])- / #6.122([* a])- / #6.123([* a])- / #6.124([* a])- / #6.125([* a])- / #6.126([* a])- / #6.127([* a]) ; similarly for tag range: 6.1280 .. 6.1400 inclusive- / #6.102([uint, [* a]])--redeemers =- [ + [ tag: redeemer_tag, index: uint, data: plutus_data, ex_units: ex_units ] ]-; TODO: Add alternative implementation that reflects the reality more accuratly:-; / { + [ tag: redeemer_tag, index: uint ] => [ data: plutus_data, ex_units: ex_units ] }--redeemer_tag =- 0 ; Spending- / 1 ; Minting- / 2 ; Certifying- / 3 ; Rewarding- / 4 ; Voting- / 5 ; Proposing--ex_units = [mem: uint, steps: uint]--ex_unit_prices =- [ mem_price: nonnegative_interval, step_price: nonnegative_interval ]--language = 0 ; Plutus v1- / 1 ; Plutus v2- / 2 ; Plutus v3--potential_languages = 0 .. 255--; The format for costmdls is flexible enough to allow adding Plutus built-ins and language-; versions in the future.-;-costmdls =- { ? 0 : [ 166* int ] ; Plutus v1, only 166 integers are used, but more are accepted (and ignored)- , ? 1 : [ 175* int ] ; Plutus v2, only 175 integers are used, but more are accepted (and ignored)- , ? 2 : [ 223* int ] ; Plutus v3, only 223 integers are used, but more are accepted (and ignored)- , ? 3 : [ int ] ; Any 8-bit unsigned number can be used as a key.- }--transaction_metadatum =- { * transaction_metadatum => transaction_metadatum }- / [ * transaction_metadatum ]- / int- / bytes .size (0..64)- / text .size (0..64)--transaction_metadatum_label = uint-metadata = { * transaction_metadatum_label => transaction_metadatum }--auxiliary_data =- metadata ; Shelley- / [ transaction_metadata: metadata ; Shelley-ma- , auxiliary_scripts: [ * native_script ]- ]- / #6.259({ ? 0 => metadata ; Alonzo and beyond- , ? 1 => [ * native_script ]- , ? 2 => [ * plutus_v1_script ]- , ? 3 => [ * plutus_v2_script ]- , ? 4 => [ * plutus_v3_script ]- })--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.- ]--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--multiasset<a> = { + policy_id => { + asset_name => a } }-policy_id = scripthash-asset_name = bytes .size (0..32)--negInt64 = -9223372036854775808 .. -1-posInt64 = 1 .. 9223372036854775807-nonZeroInt64 = negInt64 / posInt64 ; this is the same as the current int64 definition but without zero--positive_coin = 1 .. 18446744073709551615--value = coin / [coin, multiasset<positive_coin>]--mint = multiasset<nonZeroInt64>--int64 = -9223372036854775808 .. 9223372036854775807--network_id = 0 / 1--epoch = uint--addr_keyhash = $hash28-pool_keyhash = $hash28--vrf_keyhash = $hash32-auxiliary_data_hash = $hash32-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 = $hash28--datum_hash = $hash32-data = #6.24(bytes .cbor plutus_data)--datum_option = [ 0, $hash32 // 1, data ]--script_ref = #6.24(bytes .cbor script)--script = [ 0, native_script // 1, plutus_v1_script // 2, plutus_v2_script // 3, plutus_v3_script ]
− example/cddl-files/costmdls_min.cddl
@@ -1,3 +0,0 @@-costmdls =- { 0 : [ 11* int ] ; Plutus v1, only 166 integers are used, but more are accepted (and ignored)- }
− example/cddl-files/issue80-min.cddl
@@ -1,8 +0,0 @@-main = test<int, int>-set<x> = [x]-test<x, x1> = [- 1,- x,- set<x>-]-
− example/cddl-files/pretty.cddl
@@ -1,13 +0,0 @@-set<a > = [* a]--a = [ 2*30 2 : uint- , ? 33 : bytes- , 4444 : set<uint>- , * 55 => uint- ]--b = [1,uint,(3,4)]--c = { 1: a -, 2: b ; hello-}
− example/cddl-files/shelley.cddl
@@ -1,288 +0,0 @@-; 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- ]--transaction_index = uint .size 2--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--protocol_version = (major_protocol_version, uint)--transaction_body =- { 0 : set<transaction_input>- , 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- ]--transaction_output = [address, amount : coin]--; 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- ]--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<addr_keyhash>- , relays: [* relay]- , pool_metadata: pool_metadata / null- )--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: rational ; 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)--transaction_metadatum_label = uint--transaction_metadata =- { * transaction_metadatum_label => transaction_metadatum }--vkeywitness = [ $vkey, $signature ]--bootstrap_witness =- [ public_key : $vkey- , signature : $signature- , chain_code : bytes .size 32- , attributes : bytes- ]--multisig_script =- [ multisig_pubkey- // multisig_all- // multisig_any- // multisig_n_of_k- ]--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--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 Shelley era there is only one such tag,-; namely "\x00" for multisig scripts.-scripthash = $hash28--$nonce /= [ 0 // 1, bytes .size 32 ]--$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--finite_set<a> = [* 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--rational = #6.30([uint, uint])--set<a> = [* a]--address = bytes--reward_account = bytes
− example/cddl-files/validator.cddl
@@ -1,13 +0,0 @@-negative = nint--anyfloat = f16 / f32 / f64--f16 = float16-f32 = float32-f64 = float64--bs = bstr / bytes-txt = tstr / text--my_bigint = #6.2(bstr)-my_any = any
− example/cddl-files/validator/negative/args-to-postlude.cddl
@@ -1,1 +0,0 @@-x = uint<3>
− example/cddl-files/validator/negative/too-few-args.cddl
@@ -1,3 +0,0 @@-foo<a, b> = [a, b]--x = foo<uint>
− example/cddl-files/validator/negative/too-many-args.cddl
@@ -1,3 +0,0 @@-foo<a> = [a]--x = foo<uint, uint>
− example/cddl-files/validator/negative/unknown-name.cddl
@@ -1,1 +0,0 @@-x = a
+ golden/pretty/basic_assign.txt view
@@ -0,0 +1,52 @@+coin = uint++epoch = uint++header =+ [ header_body+ , body_signature : $kes_signature+ , test : coin/ null+ , withComment : null ; This is a comment+ , true+ ]++header_body = [issuer : text]++$kes_signature = bytes .size 32++unit_interval<denominator> = [0 .. denominator, denominator]++unit_int = unit_interval<4294967295>++mysize = 16++sz1 = bytes .size 1++sz2 = bytes .size 2++sz32 = bytes .size 32++sz16 = bytes .size mysize++usz4 = uint .size 4++usz8 = uint .size 8++group = (usz4, usz8/ mysize, header_body, {* uint => coin})++set<a> = [* a]++set2<a> = set<a>++coin_bag = set2<coin>++big_group =+ ( "hello"+ , 32+ , 8* 4+ , & group+ , uint+ , unit_interval<3>+ , 5 ... 10+ , h'11aaff3351bc'+ )
+ golden/pretty/conway.txt view
@@ -0,0 +1,717 @@+; crypto.cddl+$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++; extra.cddl+; 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.++; This is an unordered set. Duplicate elements are not allowed and the order of elements is implementation specific.+set<a> = #6.258([* a])/ [* a]++; Just like `set`, but must contain at least one element.+nonempty_set<a> = #6.258([+ a])/ [+ a]++; This is a non-empty ordered set. Duplicate elements are not allowed and the order of elements will be preserved.+nonempty_oset<a> = #6.258([+ a])/ [+ a]++positive_int = 1 .. 18446744073709551615++unit_interval =+ #6.30([1, 2]) ; unit_interval = #6.30([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 = #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'++bounded_bytes =+ bytes .size ( 0 .. 64+ ) ; 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<a> =+ a .size 8/ a .size 16/ a .size 20/ a .size 24/ a .size 30/ a .size 32++; conway.cddl+block =+ [ header+ , transaction_bodies : [* transaction_body]+ , transaction_witness_sets : [* transaction_witness_set]+ , auxiliary_data_set : {* transaction_index => auxiliary_data}+ , invalid_transactions : [* transaction_index]+ ] ; Valid blocks must also satisfy the following two constraints:+ ; 1) the length of transaction_bodies and transaction_witness_sets+ ; must be the same+ ; 2) every transaction_index must be strictly smaller than the+ ; length of transaction_bodies++transaction =+ [transaction_body, transaction_witness_set, bool, auxiliary_data/ null]++transaction_index = uint .size 2++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+ , vrf_result : $vrf_cert ; replaces nonce_vrf and leader_vrf+ , 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 = 10++major_protocol_version = 1 .. next_major_protocol_version++protocol_version = (major_protocol_version, uint)++transaction_body =+ { 0 : set<transaction_input> ; inputs+ , 1 : [* transaction_output]+ , 2 : coin ; fee+ , ? 3 : uint ; time to live+ , ? 4 : certificates+ , ? 5 : withdrawals+ , ? 7 : auxiliary_data_hash+ , ? 8 : uint ; validity interval start+ , ? 9 : mint+ , ? 11 : script_data_hash+ , ? 13 : nonempty_set<transaction_input> ; collateral inputs+ , ? 14 : required_signers+ , ? 15 : network_id+ , ? 16 : transaction_output ; collateral return+ , ? 17 : coin ; total collateral+ , ? 18 : nonempty_set<transaction_input> ; reference inputs+ , ? 19 : voting_procedures ; New; Voting procedures+ , ? 20 : proposal_procedures ; New; Proposal procedures+ , ? 21 : coin ; New; current treasury value+ , ? 22 : positive_coin ; New; donation+ }++voting_procedures = {+ voter => {+ gov_action_id => voting_procedure}}++voting_procedure = [vote, anchor/ null]++proposal_procedure = [deposit : coin, reward_account, gov_action, anchor]++proposal_procedures = nonempty_set<proposal_procedure>++certificates = nonempty_set<certificate>++gov_action =+ [ parameter_change_action+ // hard_fork_initiation_action+ // treasury_withdrawals_action+ // no_confidence+ // update_committee+ // new_constitution+ // info_action+ ]++policy_hash = scripthash++parameter_change_action =+ (0, gov_action_id/ null, protocol_param_update, policy_hash/ null)++hard_fork_initiation_action = (1, gov_action_id/ null, [protocol_version])++treasury_withdrawals_action = (2, {reward_account => coin}, policy_hash/ null)++no_confidence = (3, gov_action_id/ null)++update_committee =+ ( 4+ , gov_action_id/ null+ , set<committee_cold_credential>+ , {committee_cold_credential => epoch}+ , unit_interval+ )++new_constitution = (5, gov_action_id/ null, constitution)++constitution = [anchor, scripthash/ null]++info_action = 6++; 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+ ]++anchor = [anchor_url : url, anchor_data_hash : $hash32]++; no - 0+; yes - 1+; abstain - 2+vote = 0 .. 2++gov_action_id = [transaction_id : $hash32, gov_action_index : uint]++required_signers = nonempty_set<addr_keyhash>++transaction_input = [transaction_id : $hash32, index : uint]++transaction_output = legacy_transaction_output/ post_alonzo_transaction_output++legacy_transaction_output = [address, amount : value, ? datum_hash : $hash32]++post_alonzo_transaction_output =+ { 0 : address+ , 1 : value+ , ? 2 : datum_option ; datum option+ , ? 3 : script_ref ; script reference+ }++script_data_hash =+ $hash32 ; 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.++; 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+ // 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+ ]++stake_registration = (0, stake_credential)++; to be deprecated in era after Conway+stake_deregistration = (1, stake_credential)++; to be deprecated in era after Conway+stake_delegation = (2, stake_credential, pool_keyhash)++; POOL+pool_registration = (3, pool_params)++pool_retirement = (4, pool_keyhash, epoch)++; numbers 5 and 6 used to be the Genesis and MIR certificates respectively,+; which were deprecated in Conway++; DELEG+reg_cert = (7, stake_credential, coin)++unreg_cert = (8, stake_credential, coin)++vote_deleg_cert = (9, stake_credential, drep)++stake_vote_deleg_cert = (10, stake_credential, pool_keyhash, drep)++stake_reg_deleg_cert = (11, stake_credential, pool_keyhash, coin)++vote_reg_deleg_cert = (12, stake_credential, drep, coin)++stake_vote_reg_deleg_cert = (13, stake_credential, pool_keyhash, drep, coin)++; GOVCERT+auth_committee_hot_cert =+ (14, committee_cold_credential, committee_hot_credential)++resign_committee_cold_cert = (15, committee_cold_credential, anchor/ null)++reg_drep_cert = (16, drep_credential, coin, anchor/ null)++unreg_drep_cert = (17, drep_credential, coin)++update_drep_cert = (18, drep_credential, anchor/ null)++delta_coin = int++credential = [0, addr_keyhash// 1, scripthash]++drep =+ [ 0, addr_keyhash+ // 1, scripthash+ // 2 ; always abstain+ // 3 ; always no confidence+ ]++stake_credential = credential++drep_credential = credential++committee_cold_credential = credential++committee_hot_credential = credential++pool_params =+ ( operator : pool_keyhash+ , vrf_keyhash : vrf_keyhash+ , pledge : coin+ , cost : coin+ , margin : unit_interval+ , reward_account : reward_account+ , pool_owners : set<addr_keyhash>+ , relays : [* relay]+ , pool_metadata : pool_metadata/ null+ )++port = uint .le 65535++ipv4 = bytes .size 4++ipv6 = bytes .size 16++dns_name = tstr .size (0 .. 128)++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, pool_metadata_hash]++url = tstr .size (0 .. 128)++withdrawals = {+ reward_account => coin}++protocol_param_update =+ { ? 0 : coin ; minfee A+ , ? 1 : coin ; 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+ , ? 16 : coin ; min pool cost+ , ? 17 : coin ; ada per utxo byte+ , ? 18 : costmdls ; cost models for script languages+ , ? 19 : ex_unit_prices ; execution costs+ , ? 20 : ex_units ; max tx ex units+ , ? 21 : ex_units ; max block ex units+ , ? 22 : uint ; max value size+ , ? 23 : uint ; collateral percentage+ , ? 24 : uint ; max collateral inputs+ , ? 25 : pool_voting_thresholds ; pool voting thresholds+ , ? 26 : drep_voting_thresholds ; DRep voting thresholds+ , ? 27 : uint ; min committee size+ , ? 28 : epoch ; committee term limit+ , ? 29 : epoch ; governance action validity period+ , ? 30 : coin ; governance action deposit+ , ? 31 : coin ; DRep deposit+ , ? 32 : epoch ; DRep inactivity period+ }++pool_voting_thresholds =+ [ unit_interval ; motion no confidence+ , unit_interval ; committee normal+ , unit_interval ; committee no confidence+ , unit_interval ; hard fork initiation+ , unit_interval ; security relevant parameter voting threshold+ ]++drep_voting_thresholds =+ [ unit_interval ; motion no confidence+ , unit_interval ; committee normal+ , unit_interval ; committee no confidence+ , unit_interval ; update constitution+ , unit_interval ; hard fork initiation+ , unit_interval ; PP network group+ , unit_interval ; PP economic group+ , unit_interval ; PP technical group+ , unit_interval ; PP governance group+ , unit_interval ; treasury withdrawal+ ]++transaction_witness_set =+ { ? 0 : nonempty_set<vkeywitness>+ , ? 1 : nonempty_set<native_script>+ , ? 2 : nonempty_set<bootstrap_witness>+ , ? 3 : nonempty_set<plutus_v1_script>+ , ? 4 : nonempty_set<plutus_data>+ , ? 5 : redeemers+ , ? 6 : nonempty_set<plutus_v2_script>+ , ? 7 : nonempty_set<plutus_v3_script>+ }++; The real type of plutus_v1_script, plutus_v2_script and plutus_v3_script is bytes.+; However, because we enforce uniqueness when many scripts are supplied,+; we need to hack around for tests in order to avoid generating duplicates,+; since the cddl tool we use for roundtrip testing doesn't generate distinct collections.+plutus_v1_script = distinct<bytes>++plutus_v2_script = distinct<bytes>++plutus_v3_script = distinct<bytes>++plutus_data =+ constr<plutus_data>+ / {* plutus_data => plutus_data}+ / [* plutus_data]+ / big_int+ / bounded_bytes++big_int = int/ big_uint/ big_nint++big_uint = #6.2(bounded_bytes)++big_nint = #6.3(bounded_bytes)++constr<a> =+ #6.121([* a])+ / #6.122([* a])+ / #6.123([* a])+ / #6.124([* a])+ / #6.125([* a])+ / #6.126([* a])+ / #6.127(+ [* a]+ ) ; similarly for tag range: 6.1280 .. 6.1400 inclusive+ / #6.102([uint, [* a]])++redeemers =+ [ + [ tag : redeemer_tag+ , index : uint+ , data : plutus_data+ , ex_units : ex_units+ ]+ ] ; TODO: Add alternative implementation that reflects the reality more accuratly:+ ; / { + [ tag: redeemer_tag, index: uint ] => [ data: plutus_data, ex_units: ex_units ] }++redeemer_tag =+ 0 ; Spending+ / 1 ; Minting+ / 2 ; Certifying+ / 3 ; Rewarding+ / 4 ; Voting+ / 5 ; Proposing++ex_units = [mem : uint, steps : uint]++ex_unit_prices =+ [mem_price : nonnegative_interval, step_price : nonnegative_interval]++language =+ 0 ; Plutus v1+ / 1 ; Plutus v2+ / 2 ; Plutus v3++potential_languages = 0 .. 255++; The format for costmdls is flexible enough to allow adding Plutus built-ins and language+; versions in the future.+;+costmdls =+ { ? 0 : [ 166* int+ ] ; Plutus v1, only 166 integers are used, but more are accepted (and ignored)+ , ? 1 : [ 175* int+ ] ; Plutus v2, only 175 integers are used, but more are accepted (and ignored)+ , ? 2 : [ 223* int+ ] ; Plutus v3, only 223 integers are used, but more are accepted (and ignored)+ , ? 3 : [ int+ ] ; Any 8-bit unsigned number can be used as a key.+ }++transaction_metadatum =+ {* transaction_metadatum => transaction_metadatum}+ / [* transaction_metadatum]+ / int+ / bytes .size (0 .. 64)+ / text .size (0 .. 64)++transaction_metadatum_label = uint++metadata = {* transaction_metadatum_label => transaction_metadatum}++auxiliary_data =+ metadata ; Shelley+ / [ transaction_metadata : metadata ; Shelley-ma+ , auxiliary_scripts : [* native_script]+ ]+ / #6.259(+ { ? 0 => metadata ; Alonzo and beyond+ , ? 1 => [* native_script]+ , ? 2 => [* plutus_v1_script]+ , ? 3 => [* plutus_v2_script]+ , ? 4 => [* plutus_v3_script]+ }+ )++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.+ ]++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++multiasset<a> = {+ policy_id => {+ asset_name => a}}++policy_id = scripthash++asset_name = bytes .size (0 .. 32)++negInt64 = -9223372036854775808 .. -1++posInt64 = 1 .. 9223372036854775807++nonZeroInt64 =+ negInt64+ / posInt64 ; this is the same as the current int64 definition but without zero++positive_coin = 1 .. 18446744073709551615++value = coin/ [coin, multiasset<positive_coin>]++mint = multiasset<nonZeroInt64>++int64 = -9223372036854775808 .. 9223372036854775807++network_id = 0/ 1++epoch = uint++addr_keyhash = $hash28++pool_keyhash = $hash28++vrf_keyhash = $hash32++auxiliary_data_hash = $hash32++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 = $hash28++datum_hash = $hash32++data = #6.24(bytes .cbor plutus_data)++datum_option = [0, $hash32// 1, data]++script_ref = #6.24(bytes .cbor script)++script =+ [ 0, native_script+ // 1, plutus_v1_script+ // 2, plutus_v2_script+ // 3, plutus_v3_script+ ]
+ golden/pretty/costmdls_min.txt view
@@ -0,0 +1,4 @@+costmdls =+ { 0 : [ 11* int+ ] ; Plutus v1, only 166 integers are used, but more are accepted (and ignored)+ }
+ golden/pretty/issue80-min.txt view
@@ -0,0 +1,5 @@+main = test<int, int>++set<x> = [x]++test<x, x1> = [1, x, set<x>]
+ golden/pretty/pretty.txt view
@@ -0,0 +1,10 @@+set<a> = [* a]++a = [2*30 2 : uint, ? 33 : bytes, 4444 : set<uint>, * 55 => uint]++b = [1, uint, (3, 4)]++c =+ { 1 : a+ , 2 : b ; hello+ }
src/Codec/CBOR/Cuddle/CBOR/Gen.hs view
@@ -82,6 +82,7 @@ import Test.AntiGen ( AntiGen, antiChoose,+ faultyBool, faultyNum, reweigh, runAntiGen,@@ -407,7 +408,7 @@ -- No term was produced, keep the index same x y = scale (\s -> max 0 (s - 1)) $ genNodes i x y optGenKV kNode vNode = sized $ \sz ->- frequency [(100, pure Nothing), (max 0 sz, ann $ tryGenKV 10 m kNode vNode)]+ frequency [(1, pure Nothing), (max 0 sz, ann $ tryGenKV 10 m kNode vNode)] in case n of KV kNode vNode _ -> do@@ -558,16 +559,20 @@ -- | Generate a tagged value genTag :: HasCallStack => Word64 -> CTree GenPhase -> CBORGen WrappedTerm genTag t node = do- tag <- liftAntiGen $ faultyNum t- enc <- case tag of- n- | n == 2 || n == 3 ->- -- TODO remove this once `cborg` can decode indefinite bytes in bignums- withTwiddle False $ genForCTree node- _ -> genForCTree node- case enc of- S x -> pure $ S $ TTagged tag x- _ -> error "Tag controller does not correspond to a single term"+ omitTag <- liftAntiGen $ faultyBool False+ if omitTag+ then genForCTree node+ else do+ tag <- liftAntiGen $ faultyNum t+ enc <- case tag of+ n+ | n == 2 || n == 3 ->+ -- TODO remove this once `cborg` can decode indefinite bytes in bignums+ withTwiddle False $ genForCTree node+ _ -> genForCTree node+ case enc of+ S x -> pure $ S $ TTagged tag x+ _ -> error "Tag controller does not correspond to a single term" genForNode :: HasCallStack => Name -> CBORGen WrappedTerm genForNode = genForCTree <=< resolveRef
src/Codec/CBOR/Cuddle/Comments.hs view
@@ -33,13 +33,8 @@ newtype Comment = Comment T.Text deriving (Eq, Ord, Generic, Show)- deriving newtype (Monoid)+ deriving newtype (Semigroup, Monoid) deriving anyclass (ToExpr, Hashable)--instance Semigroup Comment where- Comment "" <> x = x- x <> Comment "" = x- Comment x <> Comment y = Comment $ x <> "\n" <> y unComment :: Comment -> [T.Text] unComment (Comment c) = T.lines c
src/Codec/CBOR/Cuddle/Parser.hs view
@@ -23,6 +23,7 @@ charInRange, pCommentBlock, space,+ trailingSpace, ) import Control.Applicative.Combinators.NonEmpty qualified as NE import Data.ByteString.Base16 qualified as Base16@@ -143,7 +144,7 @@ <$> between "<" ">" (NE.sepBy1 (space !*> pType1 <*! space) ",") pType0 :: Parser (Type0 ParserStage)-pType0 = Type0 <$> sepBy1' (space !*> pType1 <*! space) (try "/")+pType0 = Type0 <$> sepBy1' (space !*> pType1 <*! trailingSpace) (try "/") pType1 :: Parser (Type1 ParserStage) pType1 = do
src/Codec/CBOR/Cuddle/Parser/Lexer.hs view
@@ -4,8 +4,8 @@ Parser, charInRange, space,+ trailingSpace, pComment,- sameLineComment, (|||), pCommentBlock, ) where@@ -13,12 +13,12 @@ import Codec.CBOR.Cuddle.Comments (Comment (..)) import Control.Applicative.Combinators.NonEmpty qualified as NE import Data.Foldable1 (Foldable1 (..))-import Data.Functor (($>)) import Data.Text (Text) import Data.Void (Void) import Text.Megaparsec ( MonadParsec (..), Parsec,+ many, sepEndBy, (<|>), )@@ -35,7 +35,7 @@ pComment :: Parser Comment pComment =- Comment <$> label "comment" (char ';' *> takeWhileP Nothing validChar <* eol)+ Comment . (<> "\n") <$> label "comment" (char ';' *> takeWhileP Nothing validChar <* eol) where validChar = charInRange '\x20' '\x7e' ||| charInRange '\x80' '\x10fffd' @@ -45,6 +45,24 @@ space :: Parser Comment space = mconcat <$> (L.space *> sepEndBy pComment L.space) -sameLineComment :: Parser Comment-sameLineComment =- try ((<>) <$> (L.hspace *> pComment) <*> space) <|> (L.space $> mempty)+-- | Non-greedy space consumer for use at construct boundaries.+-- Consumes a same-line comment and any immediately adjacent comment lines+-- (no blank line gap), then eats trailing blank lines.+-- Does NOT cross blank-line boundaries to consume further comment blocks.+trailingSpace :: Parser Comment+trailingSpace = do+ _ <- L.hspace+ comments <- sameLineComments+ L.space+ pure $ mconcat comments+ where+ sameLineComments =+ ( do+ c <- pComment+ rest <- adjacentComments+ pure (c : rest)+ )+ <|> (eol *> adjacentComments)+ <|> pure []++ adjacentComments = many (try (L.hspace *> pComment))
src/Codec/CBOR/Cuddle/Pretty.hs view
@@ -15,6 +15,7 @@ XTerm (..), XCddl (..), XRule (..),+ renderCDDL, ) where import Codec.CBOR.Cuddle.CDDL@@ -40,12 +41,14 @@ import Data.Foldable (Foldable (..)) import Data.List.NonEmpty qualified as NE import Data.String (IsString, fromString)+import Data.Text (Text) import Data.Text qualified as T import Data.TreeDiff (ToExpr) import Data.Void (Void, absurd) import GHC.Generics (Generic) import Optics.Core ((^.)) import Prettyprinter+import Prettyprinter.Render.Text qualified as PT type data PrettyStage @@ -86,7 +89,7 @@ | PostComment prettyCommentNoBreak :: Comment -> Doc ann-prettyCommentNoBreak = align . vsep . toList . fmap (pretty . ("; " <>)) . unComment+prettyCommentNoBreak = align . vsep . toList . fmap (pretty . (";" <>)) . unComment prettyCommentNoBreakWS :: Comment -> Doc ann prettyCommentNoBreakWS cmt@@ -118,17 +121,15 @@ AssignExt -> "//=" instance Pretty (GenericArg PrettyStage) where- pretty (GenericArg (NE.toList -> l))- | null (collectComments l) = group . cEncloseSep "<" ">" "," $ fmap pretty l- | otherwise = columnarListing "<" ">" "," . Columnar $ singletonRow . pretty <$> l+ pretty (GenericArg l) =+ "<" <> concatWith (\x y -> x <> "," <+> y) (pretty <$> NE.toList l) <> ">" instance Pretty (GenericParameter PrettyStage) where pretty (GenericParameter n (PrettyXTerm c)) = pretty n <> prettyCommentNoBreakWS c instance Pretty (GenericParameters PrettyStage) where- pretty (GenericParameters (NE.toList -> l))- | null (collectComments l) = group . cEncloseSep "<" ">" "," $ pretty <$> l- | otherwise = columnarListing "<" ">" "," . Columnar $ singletonRow . pretty <$> l+ pretty (GenericParameters l) =+ "<" <> concatWith (\x y -> x <> "," <+> y) (pretty <$> NE.toList l) <> ">" instance Pretty (Type0 PrettyStage) where pretty t0@(Type0 (NE.toList -> l)) =@@ -273,3 +274,8 @@ PTAny -> "any" PTNil -> "nil" PTUndefined -> "undefined"++-- | Render a pretty-stage CDDL to 'Text', removing trailing whitespace.+renderCDDL :: LayoutOptions -> CDDL PrettyStage -> Text+renderCDDL opts =+ PT.renderStrict . removeTrailingWhitespace . layoutPretty opts . pretty
src/Codec/CBOR/Cuddle/Pretty/Columnar.hs view
@@ -117,8 +117,11 @@ columnarSepBy :: Doc ann -> Columnar ann -> Doc ann columnarSepBy _ (Columnar []) = mempty columnarSepBy s (Columnar rows@(Row x : xs)) =- prettyRow columnWidths x <> line' <> prettyColumnar (Columnar $ prependRow <$> xs)+ prettyRow columnWidths x <> rest where+ rest+ | null xs = mempty+ | otherwise = line' <> prettyColumnar (Columnar $ prependRow <$> xs) prependRow (Row (Cell c al : cs)) = Row $ Cell (s <+> c) al : cs prependRow (Row []) = Row [] columnWidths =
test/Main.hs view
@@ -4,6 +4,8 @@ import Test.Codec.CBOR.Cuddle.CDDL.Examples qualified as Examples import Test.Codec.CBOR.Cuddle.CDDL.GeneratorSpec qualified as Generator import Test.Codec.CBOR.Cuddle.CDDL.Parser (parserSpec)+import Test.Codec.CBOR.Cuddle.CDDL.Pretty (roundtripSpec)+import Test.Codec.CBOR.Cuddle.CDDL.Pretty.Golden qualified as PrettyGolden import Test.Codec.CBOR.Cuddle.CDDL.Validator qualified as Validator import Test.Codec.CBOR.Cuddle.CDDL.Validator.Golden qualified as ValidatorGolden import Test.Codec.CBOR.Cuddle.Huddle (huddleSpec)@@ -25,6 +27,9 @@ describe "Huddle" huddleSpec describe "Examples" Examples.spec describe "Generator" Generator.spec+ describe "Pretty" $ do+ describe "Golden" PrettyGolden.spec+ describe "Roundtrip" roundtripSpec describe "Validator" $ do describe "Properties" Validator.spec describe "Golden" ValidatorGolden.spec
test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs view
@@ -46,18 +46,18 @@ spec = do describe "Validator" $ do describe "Positive" $ do- validateExpectSuccess "example/cddl-files/byron.cddl"- validateExpectSuccess "example/cddl-files/conway.cddl"- validateExpectSuccess "example/cddl-files/shelley.cddl"- validateExpectSuccess "example/cddl-files/basic_assign.cddl"- validateExpectSuccess "example/cddl-files/issue80-min.cddl"- validateExpectSuccess "example/cddl-files/pretty.cddl"+ validateExpectSuccess "cddl/byron.cddl"+ validateExpectSuccess "cddl/conway.cddl"+ validateExpectSuccess "cddl/shelley.cddl"+ validateExpectSuccess "cddl/basic_assign.cddl"+ validateExpectSuccess "cddl/issue80-min.cddl"+ validateExpectSuccess "cddl/pretty.cddl" describe "Negative" $ do- validateExpectFailure "example/cddl-files/validator/negative/unknown-name.cddl" $+ validateExpectFailure "cddl/validator/negative/unknown-name.cddl" $ UnboundReference "a"- validateExpectFailure "example/cddl-files/validator/negative/too-few-args.cddl" $+ validateExpectFailure "cddl/validator/negative/too-few-args.cddl" $ MismatchingArgs "foo" ["a", "b"]- validateExpectFailure "example/cddl-files/validator/negative/too-many-args.cddl" $+ validateExpectFailure "cddl/validator/negative/too-many-args.cddl" $ MismatchingArgs "foo" ["a"]- validateExpectFailure "example/cddl-files/validator/negative/args-to-postlude.cddl" $+ validateExpectFailure "cddl/validator/negative/args-to-postlude.cddl" $ ArgsToPostlude PTUInt [Literal (Value (VUInt 3) mempty)]
test/Test/Codec/CBOR/Cuddle/CDDL/Examples/Huddle.hs view
@@ -26,6 +26,7 @@ listZeroOrMoreExample, mapNestedValueExample, deeplyNestedRefExample,+ taggedUintExample, ) where import Codec.CBOR.Cuddle.CDDL (Name)@@ -43,6 +44,7 @@ idx, mp, opt,+ tag, withCBORGen, (...), (=:=),@@ -305,3 +307,9 @@ barRef = "bar" =:= bazRef aRef = "a_ref" =:= barRef listRule = "list_rule" =:= arr [a VInt, a VInt]++taggedUintExample :: Huddle+taggedUintExample =+ collectFrom+ [ HIRule $ "root" =:= tag 42 VBytes+ ]
test/Test/Codec/CBOR/Cuddle/CDDL/GeneratorSpec.hs view
@@ -30,12 +30,13 @@ refTermExample, sizeBytesExample, sizeTextExample,+ taggedUintExample, ) import Test.Codec.CBOR.Cuddle.CDDL.Validator (expectInvalid, genAndValidateRule) import Test.Hspec (HasCallStack, Spec, describe, runIO, shouldSatisfy, xdescribe) import Test.Hspec.Core.Spec (SpecM) import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck (Gen, Property, Testable (..), counterexample)+import Test.QuickCheck (Gen, Property, Testable (..), classify, counterexample) import Text.Pretty.Simple (pShow) generateCDDL :: CTreeRoot GenPhase -> Gen Term@@ -138,3 +139,33 @@ TBytes "\x01\x02\x03\xff" -> True TBytesI "\x01\x02\x03\xff" -> True _ -> False++ describe "Tagged bytes zapping" $ do+ taggedBytesCddl <- tryResolveHuddle taggedUintExample+ let env =+ GenEnv+ { geRoot = mapIndex taggedBytesCddl+ , geTwiddle = True+ }+ prop "labels zapped result" $ do+ ZapResult {zrValue} <-+ zapAntiGenResult 1 . runCBORGen env $ generateFromName "root"+ let+ isBytes TBytes {} = True+ isBytes TBytesI {} = True+ isBytes _ = False+ tagOmitted = case zrValue of+ TTagged {} -> False+ _ -> True+ tagChanged = case zrValue of+ TTagged t _ -> t /= 42+ _ -> False+ innerValueZapped = case zrValue of+ TTagged 42 inner -> not (isBytes inner)+ _ -> False+ pure+ . classify tagOmitted "tag omitted"+ . classify tagChanged "tag changed"+ . classify innerValueZapped "inner value zapped"+ $ expectInvalid+ (validateCBOR (toStrictByteString $ encodeTerm zrValue) "root" $ mapIndex taggedBytesCddl)
test/Test/Codec/CBOR/Cuddle/CDDL/Pretty.hs view
@@ -4,6 +4,7 @@ module Test.Codec.CBOR.Cuddle.CDDL.Pretty ( spec,+ roundtripSpec, ) where import Codec.CBOR.Cuddle.CDDL (@@ -25,18 +26,23 @@ import Codec.CBOR.Cuddle.Huddle (HuddleItem (..), a, bstr, (<+), (=:=), (=:~)) import Codec.CBOR.Cuddle.Huddle qualified as H import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..))-import Codec.CBOR.Cuddle.Pretty (PrettyStage, XRule (..))+import Codec.CBOR.Cuddle.Parser (pCDDL)+import Codec.CBOR.Cuddle.Pretty (PrettyStage, XRule (..), renderCDDL) import Data.Default.Class (Default (..)) import Data.List.NonEmpty (NonEmpty (..)) import Data.Text qualified as T+import Data.Text.IO qualified as T import Data.TreeDiff (ToExpr (..), prettyExpr)+import Paths_cuddle (getDataFileName) import Prettyprinter (Pretty (..), defaultLayoutOptions, layoutPretty) import Prettyprinter.Render.String (renderString) import Test.Codec.CBOR.Cuddle.CDDL.Gen () import Test.HUnit (assertEqual)-import Test.Hspec (Expectation, Spec, describe, it, shouldBe, xit)+import Test.Hspec (Expectation, Spec, describe, it, runIO, shouldBe, xit) import Test.Hspec.QuickCheck (xprop) import Test.QuickCheck (counterexample)+import Text.Megaparsec (parse)+import Text.Megaparsec.Error (errorBundlePretty) import Prelude hiding ((/)) prettyPrintsTo :: (Pretty a, ToExpr a) => a -> String -> Expectation@@ -164,7 +170,7 @@ :| [] ) )- `prettyPrintsTo` "[ 1 ; one\n, 2 ; two\n]"+ `prettyPrintsTo` "[ 1 ;one\n, 2 ;two\n]" it "two elements with multiline comments" $ T2Array ( Group@@ -182,7 +188,7 @@ :| [] ) )- `prettyPrintsTo` "[ 1 ; first\n ; multiline comment\n, 2 ; second\n ; multiline comment\n]"+ `prettyPrintsTo` "[ 1 ;first\n ;multiline comment\n, 2 ;second\n ;multiline comment\n]" describe "Rule" $ do it "simple assignment" $ Rule @PrettyStage@@ -199,7 +205,7 @@ AssignEq (TOGType (Type0 (Type1 (T2Name (Name "b") mempty) Nothing mempty :| []))) (PrettyXRule "comment")- `prettyPrintsTo` "; comment\na = b"+ `prettyPrintsTo` ";comment\na = b" xit "drep" $ drep `prettyPrintsTo` "drep = [0, addr_keyhash // 1, script_hash // 2 // 3]"@@ -214,14 +220,14 @@ `huddlePrettyPrintsTo` "a = true\n" it "simple assignment with comment" $ [HIRule $ H.comment "comment" $ "a" =:= H.bool True]- `huddlePrettyPrintsTo` "; comment\na = true\n"+ `huddlePrettyPrintsTo` ";comment\na = true\n" it "comment and reference" $ let b = H.comment "this is rule 'b'" $ "b" =:= H.text "bee" in [ HIRule $ H.comment "comment" $ "a" =:= b ]- `huddlePrettyPrintsTo` "; comment\na = b\n\n; this is rule 'b'\nb = \"bee\"\n"+ `huddlePrettyPrintsTo` ";comment\na = b\n\n;this is rule 'b'\nb = \"bee\"\n" it "bstr expects hex, not bytes" $ [ HIRule $ "a" =:= bstr "010200ff" ]@@ -234,18 +240,45 @@ in [ HIRule . H.comment "foo" $ "a" =:= b (H.bool True) ]- `huddlePrettyPrintsTo` "; foo\na = b<true>\n\n; bar\nb<a0> = [* a0]\n"+ `huddlePrettyPrintsTo` ";foo\na = b<true>\n\n;bar\nb<a0> = [* a0]\n" describe "GroupDef" $ do it "simple pair" $ [HIGroup $ "a" =:~ [a $ H.bool True, a $ H.int 3]] `huddlePrettyPrintsTo` "a = (true, 3)\n" it "simple pair with comment" $ [HIGroup $ H.comment "comment" $ "a" =:~ [a $ H.bool True, a $ H.int 3]]- `huddlePrettyPrintsTo` "; comment\na = (true, 3)\n"+ `huddlePrettyPrintsTo` ";comment\na = (true, 3)\n" it "comment and reference" $ let b = H.comment "bar" $ "b" =:~ [a $ H.int 2, a $ H.text "bee"] in [ HIGroup . H.comment "foo" $ "a" =:~ [a $ H.bool True, a b] ]- `huddlePrettyPrintsTo` "; foo\na = (true, b)\n\n; bar\nb = (2, \"bee\")\n"+ `huddlePrettyPrintsTo` ";foo\na = (true, b)\n\n;bar\nb = (2, \"bee\")\n"++roundtripSpec :: Spec+roundtripSpec = describe "Roundtrip (parse -> pretty -> parse)" $ do+ prettyRoundtrip "basic_assign" "cddl/basic_assign.cddl"+ prettyRoundtrip "pretty" "cddl/pretty.cddl"+ prettyRoundtrip "costmdls_min" "cddl/costmdls_min.cddl"+ prettyRoundtrip "issue80-min" "cddl/issue80-min.cddl"+ prettyRoundtrip "conway" "cddl/conway.cddl"++prettyRoundtrip :: String -> FilePath -> Spec+prettyRoundtrip testName cddlPath = do+ original <- runIO $ do+ absolutePath <- getDataFileName cddlPath+ contents <- T.readFile absolutePath+ case parse pCDDL "" contents of+ Left err -> fail $ "Failed to parse CDDL:\n" <> errorBundlePretty err+ Right x -> pure x+ it testName $ do+ let+ prettyStage1 = mapIndex @_ @_ @PrettyStage original+ rendered = renderCDDL defaultLayoutOptions prettyStage1+ case parse pCDDL "" rendered of+ Left err ->+ fail $ "Failed to re-parse pretty-printed CDDL:\n" <> errorBundlePretty err+ Right reparsed ->+ let prettyStage2 = mapIndex @_ @_ @PrettyStage reparsed+ in prettyStage2 `shouldBe` prettyStage1
+ test/Test/Codec/CBOR/Cuddle/CDDL/Pretty/Golden.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Codec.CBOR.Cuddle.CDDL.Pretty.Golden (spec) where++import Codec.CBOR.Cuddle.IndexMappable (mapIndex)+import Codec.CBOR.Cuddle.Parser (pCDDL)+import Codec.CBOR.Cuddle.Pretty (PrettyStage, renderCDDL)+import Control.Monad ((<=<))+import Data.Text.IO qualified as T+import Paths_cuddle (getDataFileName)+import Prettyprinter (defaultLayoutOptions)+import System.FilePath ((</>))+import Test.Hspec (Spec, describe, it, runIO)+import Test.Hspec.Golden (Golden (..))+import Text.Megaparsec (parse)+import Text.Megaparsec.Error (errorBundlePretty)++prettyPrintGolden :: String -> FilePath -> Spec+prettyPrintGolden testName cddlPath = do+ cddl <- runIO $ do+ absolutePath <- getDataFileName cddlPath+ contents <- T.readFile absolutePath+ case parse pCDDL "" contents of+ Left err -> fail $ "Failed to parse CDDL:\n" <> errorBundlePretty err+ Right x -> pure x+ it testName $+ Golden+ { goldenFile = "golden" </> "pretty" </> testName <> ".txt"+ , readFromFile = T.readFile <=< getDataFileName+ , writeToFile = \fp txt -> getDataFileName fp >>= (`T.writeFile` txt)+ , actualFile = Nothing+ , output = renderCDDL defaultLayoutOptions $ mapIndex @_ @_ @PrettyStage cddl+ , encodePretty = show+ , failFirstTime = False+ }++spec :: Spec+spec = describe "golden" $ do+ prettyPrintGolden "basic_assign" "cddl/basic_assign.cddl"+ prettyPrintGolden "pretty" "cddl/pretty.cddl"+ prettyPrintGolden "costmdls_min" "cddl/costmdls_min.cddl"+ prettyPrintGolden "issue80-min" "cddl/issue80-min.cddl"+ prettyPrintGolden "conway" "cddl/conway.cddl"
test/Test/Codec/CBOR/Cuddle/CDDL/Validator.hs view
@@ -294,13 +294,13 @@ spec :: Spec spec = describe "Validator" $ do describe "Generate and validate from file" $ do- genAndValidateFromFile "example/cddl-files/basic_assign.cddl"- genAndValidateFromFile "example/cddl-files/conway.cddl"- genAndValidateFromFile "example/cddl-files/costmdls_min.cddl"- genAndValidateFromFile "example/cddl-files/issue80-min.cddl"- genAndValidateFromFile "example/cddl-files/pretty.cddl"- genAndValidateFromFile "example/cddl-files/shelley.cddl"- genAndValidateFromFile "example/cddl-files/validator.cddl"+ genAndValidateFromFile "cddl/basic_assign.cddl"+ genAndValidateFromFile "cddl/conway.cddl"+ genAndValidateFromFile "cddl/costmdls_min.cddl"+ genAndValidateFromFile "cddl/issue80-min.cddl"+ genAndValidateFromFile "cddl/pretty.cddl"+ genAndValidateFromFile "cddl/shelley.cddl"+ genAndValidateFromFile "cddl/validator.cddl" describe "Term tests" $ do describe "Maps and arrays" $ do describe "Positive" $ do