packages feed

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 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