{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use camelCase" #-}
{-# HLINT ignore "Evaluate" #-}

module Test.Cardano.Ledger.Alonzo.CDDL (
  module Test.Cardano.Ledger.Mary.CDDL,
  module Test.Cardano.Ledger.Alonzo.CDDL,
) where

import Codec.CBOR.Cuddle.Huddle
import Data.Function (($))
import Data.Word (Word64)
import GHC.Num (Integer)
import Test.Cardano.Ledger.Mary.CDDL hiding (
  auxiliary_data,
  block,
  header,
  header_body,
  major_protocol_version,
  mint,
  multiasset,
  native_script,
  next_major_protocol_version,
  proposed_protocol_parameter_updates,
  protocol_param_update,
  protocol_version,
  script_n_of_k,
  transaction,
  transaction_body,
  transaction_output,
  transaction_witness_set,
  update,
  value,
 )
import Text.Heredoc

alonzoCDDL :: Huddle
alonzoCDDL :: Huddle
alonzoCDDL = [Rule] -> Huddle
collectFrom [Item [Rule]
Rule
block, Item [Rule]
Rule
transaction, Item [Rule]
Rule
kes_signature, Item [Rule]
Rule
language, Item [Rule]
Rule
signkeyKES]

block :: Rule
block :: Rule
block =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str|Valid blocks must also satisfy the following two constraints:
        |  1) the length of transaction_bodies and transaction_witness_sets must be
        |     the same
        |  2) every transaction_index must be strictly smaller than the length of
        |     transaction_bodies
        |NEW:
        |  invalid_transactions
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"block"
      Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr
        [ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
header
        , Key
"transaction_bodies" Key -> ArrayChoice -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
transaction_body]
        , Key
"transaction_witness_sets" Key -> ArrayChoice -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
transaction_witness_set]
        , Key
"auxiliary_data_set" Key -> MapChoice -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> MapChoice -> MapChoice
mp [Word64
0 Word64 -> MapEntry -> MapEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> Key
forall r. IsType0 r => r -> Key
asKey Rule
transaction_index Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
auxiliary_data]
        , Key
"invalid_transactions" Key -> ArrayChoice -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
transaction_index]
        ]

transaction :: Rule
transaction :: Rule
transaction =
  Text
"transaction"
    Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr
      [ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
transaction_body
      , Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
transaction_witness_set
      , Value Bool -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Value Bool
VBool
      , Choice Type2 -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (Rule
auxiliary_data Rule -> Value Void -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Value Void
VNil)
      ]

-- TODO Replace with the following once
-- https://github.com/input-output-hk/cuddle/issues/29 is addressed in cuddle.
--
-- next_major_protocol_version :: Rule
-- next_major_protocol_version = "next_major_protocol_version" =:= (7 :: Integer)
next_major_protocol_version :: Integer
next_major_protocol_version :: Integer
next_major_protocol_version = Integer
7

major_protocol_version :: Rule
major_protocol_version :: Rule
major_protocol_version = Text
"major_protocol_version" Text -> Ranged -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= (Integer
1 :: Integer) Integer -> Integer -> Ranged
... Integer
next_major_protocol_version

protocol_version :: Named Group
protocol_version :: Named Group
protocol_version = Text
"protocol_version" Text -> Group -> Named Group
=:~ Group -> Group
grp [Rule -> Choice Type2
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
major_protocol_version, Value Int -> Choice Type2
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Value Int
VUInt]

transaction_body :: Rule
transaction_body :: Rule
transaction_body =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str| 2: fee
        | 3: time to live
        | 8: validity interval start
        |13: collateral
        |NEW:
        |  11: script_data_hash
        |  13: set transaction_input
        |  14: required_signers
        |  15: network_id
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"transaction_body"
      Text -> MapChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= MapChoice -> MapChoice
mp
        [ Word64 -> Key
idx Word64
0 Key -> GRuleCall -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule -> GRuleCall
forall t0. IsType0 t0 => t0 -> GRuleCall
set Rule
transaction_input
        , Word64 -> Key
idx Word64
1 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
transaction_output]
        , Word64 -> Key
idx Word64
2 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
coin
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
3 Key -> Value Int -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
4 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
certificate])
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
5 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
withdrawals)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
6 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
update)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
7 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
auxiliary_data_hash)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
8 Key -> Value Int -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
9 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
mint)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
11 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
script_data_hash)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
13 Key -> GRuleCall -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule -> GRuleCall
forall t0. IsType0 t0 => t0 -> GRuleCall
set Rule
transaction_input)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
14 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
required_signers)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
15 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
network_id)
        ]

required_signers :: Rule
required_signers :: Rule
required_signers = Text
"required_signers" Text -> GRuleCall -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule -> GRuleCall
forall t0. IsType0 t0 => t0 -> GRuleCall
set Rule
addr_keyhash

transaction_output :: Rule
transaction_output :: Rule
transaction_output =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str|NEW:
        |  datum_hash: $hash32
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"transaction_output"
      Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr [Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
address, Key
"amount" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
value, ArrayEntry -> ArrayEntry
forall a. CanQuantify a => a -> a
opt (Key
"datum_hash" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
hash32)]

script_data_hash :: Rule
script_data_hash :: Rule
script_data_hash =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str|This is a hash of data which may affect evaluation of a script.
        |
        |This data consists of:
        |  - The redeemers from the transaction_witness_set (the value of field 5).
        |  - The datums from the transaction_witness_set (the value of field 4).
        |  - The value in the cost_models 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 cost_models map at key 0 is encoded as an indefinite length
        |    list and the result is encoded as a bytestring. (our apologies)
        |  - the language ID tag is also encoded twice. first as a uint then as
        |    a bytestring. (our apologies)
        |
        |Note that each Plutus language represented inside a transaction
        |must have a cost model in the cost_models protocol parameter in
        |order to execute, regardless of what the script integrity data
        |is. In the Alonzo era, this means cost_models must have a key 0
        |for Plutus V1.
        |
        |Finally, note that in the case that a transaction includes
        |datums but does not include any redeemers, the script data
        |format becomes (in hex):
        |  [ 80 | datums | A0 ]
        |
        |corresponding to a CBOR empty list and an empty map (our
        |apologies).,
        |
        |NEW:
        |  script_data_hash
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"script_data_hash" Text -> Rule -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule
hash32

certificates :: Rule
certificates :: Rule
certificates = Text
"certificates" Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
certificate]

protocol_param_update :: Rule
protocol_param_update :: Rule
protocol_param_update =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str| 0: minfee A
        | 1: minfee B
        | 2: max block body size
        | 3: max transaction size
        | 4: max block header size
        | 5: key deposit
        | 6: pool deposit
        | 7: maximum epoch
        | 8: n_opt: desired number of stake pools
        | 9: pool pledge influence
        |10: expansion rate
        |11: treasury growth rate
        |12: d. decentralization constant
        |13: extra entropy
        |14: protocol version
        |16: min pool cost ; NEW
        |17: ada per utxo byte ; NEW
        |18: cost models for script languages ; NEW
        |19: execution costs ; NEW
        |20: max tx ex units ; NEW
        |21: max block ex units ; NEW
        |22: max value size ; NEW
        |23: collateral percentage ; NEW
        |24: max collateral inputs ; NEW
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"protocol_param_update"
      Text -> MapChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= MapChoice -> MapChoice
mp
        [ MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
0 Key -> Value Int -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
1 Key -> Value Int -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
2 Key -> Constrained -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> (Value Int
VUInt Value Int -> Word64 -> Constrained
forall a s. (IsSizeable a, IsSize s) => Value a -> s -> Constrained
`sized` (Word64
4 :: Word64)))
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
3 Key -> Constrained -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> (Value Int
VUInt Value Int -> Word64 -> Constrained
forall a s. (IsSizeable a, IsSize s) => Value a -> s -> Constrained
`sized` (Word64
4 :: Word64)))
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
4 Key -> Constrained -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> (Value Int
VUInt Value Int -> Word64 -> Constrained
forall a s. (IsSizeable a, IsSize s) => Value a -> s -> Constrained
`sized` (Word64
2 :: Word64)))
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
5 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
coin)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
6 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
coin)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
7 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
epoch)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
8 Key -> Constrained -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt Value Int -> Word64 -> Constrained
forall a s. (IsSizeable a, IsSize s) => Value a -> s -> Constrained
`sized` (Word64
2 :: Word64))
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
9 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
nonnegative_interval)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
10 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
unit_interval)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
11 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
unit_interval)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
12 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
unit_interval)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
13 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
nonce)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
14 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
protocol_version])
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
16 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
coin)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
17 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
coin)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
18 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
cost_models)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
19 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
ex_unit_prices)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
20 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
ex_units)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
21 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
ex_units)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
22 Key -> Value Int -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
23 Key -> Value Int -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
24 Key -> Value Int -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt)
        ]

proposed_protocol_parameter_updates :: Rule
proposed_protocol_parameter_updates :: Rule
proposed_protocol_parameter_updates =
  Text
"proposed_protocol_parameter_updates"
    Text -> MapChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= MapChoice -> MapChoice
mp [Word64
0 Word64 -> MapEntry -> MapEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> Key
forall r. IsType0 r => r -> Key
asKey Rule
genesis_hash Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
protocol_param_update]

update :: Rule
update :: Rule
update = Text
"update" Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr [Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
proposed_protocol_parameter_updates, Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
epoch]

transaction_witness_set :: Rule
transaction_witness_set :: Rule
transaction_witness_set =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str|
        |NEW:
        |  3: [* plutus_script ]
        |  4: [* plutus_data ]
        |  5: redeemers
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"transaction_witness_set"
      Text -> MapChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= MapChoice -> MapChoice
mp
        [ Item MapChoice -> Item MapChoice
forall a. CanQuantify a => a -> a
opt (Item MapChoice -> Item MapChoice)
-> Item MapChoice -> Item MapChoice
forall a b. (a -> b) -> a -> b
$ Word64 -> Key
idx Word64
0 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
vkeywitness]
        , Item MapChoice -> Item MapChoice
forall a. CanQuantify a => a -> a
opt (Item MapChoice -> Item MapChoice)
-> Item MapChoice -> Item MapChoice
forall a b. (a -> b) -> a -> b
$ Word64 -> Key
idx Word64
1 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
native_script]
        , Item MapChoice -> Item MapChoice
forall a. CanQuantify a => a -> a
opt (Item MapChoice -> Item MapChoice)
-> Item MapChoice -> Item MapChoice
forall a b. (a -> b) -> a -> b
$ Word64 -> Key
idx Word64
2 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
bootstrap_witness]
        , Item MapChoice -> Item MapChoice
forall a. CanQuantify a => a -> a
opt (Item MapChoice -> Item MapChoice)
-> Item MapChoice -> Item MapChoice
forall a b. (a -> b) -> a -> b
$ Word64 -> Key
idx Word64
3 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
plutus_script]
        , Item MapChoice -> Item MapChoice
forall a. CanQuantify a => a -> a
opt (Item MapChoice -> Item MapChoice)
-> Item MapChoice -> Item MapChoice
forall a b. (a -> b) -> a -> b
$ Word64 -> Key
idx Word64
4 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
plutus_data]
        , Item MapChoice -> Item MapChoice
forall a. CanQuantify a => a -> a
opt (Item MapChoice -> Item MapChoice)
-> Item MapChoice -> Item MapChoice
forall a b. (a -> b) -> a -> b
$ Word64 -> Key
idx Word64
5 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
redeemers
        ]

redeemers :: Rule
redeemers :: Rule
redeemers = Text
"redeemers" Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
redeemer]

plutus_script :: Rule
plutus_script :: Rule
plutus_script = Text
"plutus_script" Text -> Value ByteString -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Value ByteString
VBytes

plutus_data :: Rule
plutus_data :: Rule
plutus_data =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment Text
[str|NEW|] (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$
    Text
"plutus_data"
      Text -> Choice Type2 -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule -> GRuleCall
forall t0. IsType0 t0 => t0 -> GRuleCall
constr Rule
plutus_data
      GRuleCall -> Seal Map -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ MapChoice -> Seal Map
smp [Word64
0 Word64 -> MapEntry -> MapEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> Key
forall r. IsType0 r => r -> Key
asKey Rule
plutus_data Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
plutus_data]
      Choice Type2 -> Seal Array -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> Seal Array
sarr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
plutus_data]
      Choice Type2 -> Rule -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Rule
big_int
      Choice Type2 -> Rule -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Rule
bounded_bytes

-- FIXME: `GRuleCall` does not serialise the comment in the resulting CDDL
constr :: IsType0 x => x -> GRuleCall
constr :: forall t0. IsType0 t0 => t0 -> GRuleCall
constr = (GRef -> Rule) -> x -> GRuleCall
forall t0. IsType0 t0 => (GRef -> Rule) -> t0 -> GRuleCall
binding ((GRef -> Rule) -> x -> GRuleCall)
-> (GRef -> Rule) -> x -> GRuleCall
forall a b. (a -> b) -> a -> b
$ \GRef
x ->
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str|NEW
        |  #6.102([uint, [* a]]): For tag range 6.1280 .. 6.1400 inclusive
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"constr"
      Text -> Choice Type2 -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
121 (ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ GRef -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a GRef
x])
      Tagged ArrayChoice -> Tagged ArrayChoice -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
122 (ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ GRef -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a GRef
x])
      Choice Type2 -> Tagged ArrayChoice -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
123 (ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ GRef -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a GRef
x])
      Choice Type2 -> Tagged ArrayChoice -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
124 (ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ GRef -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a GRef
x])
      Choice Type2 -> Tagged ArrayChoice -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
125 (ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ GRef -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a GRef
x])
      Choice Type2 -> Tagged ArrayChoice -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
126 (ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ GRef -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a GRef
x])
      Choice Type2 -> Tagged ArrayChoice -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
127 (ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ GRef -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a GRef
x])
      Choice Type2 -> Tagged ArrayChoice -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
102 (ArrayChoice -> ArrayChoice
arr [Value Int -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Value Int
VUInt, ArrayChoice -> Item ArrayChoice
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (ArrayChoice -> Item ArrayChoice)
-> ArrayChoice -> Item ArrayChoice
forall a b. (a -> b) -> a -> b
$ ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ GRef -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a GRef
x]])

redeemer :: Rule
redeemer :: Rule
redeemer =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment Text
[str|NEW|] (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$
    Text
"redeemer"
      Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr
        [ Key
"tag" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
redeemer_tag
        , Key
"index" Key -> Value Int -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt
        , Key
"data" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
plutus_data
        , Key
"ex_units" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
ex_units
        ]

redeemer_tag :: Rule
redeemer_tag :: Rule
redeemer_tag =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str|0: spend
        |1: mint
        |2: cert
        |3: reward
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"redeemer_tag" Text -> Choice Type2 -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Integer -> Literal
int Integer
0 Literal -> Literal -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Integer -> Literal
int Integer
1 Choice Type2 -> Literal -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Integer -> Literal
int Integer
2 Choice Type2 -> Literal -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Integer -> Literal
int Integer
3

ex_units :: Rule
ex_units :: Rule
ex_units = Text
"ex_units" Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr [Key
"mem" Key -> Value Int -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt, Key
"steps" Key -> Value Int -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt]

ex_unit_prices :: Rule
ex_unit_prices :: Rule
ex_unit_prices =
  Text
"ex_unit_prices"
    Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr
      [ Key
"mem_price" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
positive_interval
      , Key
"step_price" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
positive_interval
      ]

language :: Rule
language :: Rule
language =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str|NOTE: NEW
        |  This is an enumeration. for now there's only one value. Plutus V1
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"language" Text -> Literal -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Integer -> Literal
int Integer
0

cost_models :: Rule
cost_models :: Rule
cost_models = Text
"cost_models" Text -> MapChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= MapChoice -> MapChoice
mp [Word64
0 Word64 -> MapEntry -> MapEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> Key
forall r. IsType0 r => r -> Key
asKey Rule
language Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
cost_model]

cost_model :: Rule
cost_model :: Rule
cost_model =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str|NOTE: NEW
        |  The keys to the cost model map are not present in the serialization.
        |  The values in the serialization are assumed to be ordered
        |  lexicographically by their correpsonding key value.
        |  See Plutus' `ParamName` for parameter ordering
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"cost_model" Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr [Word64
166 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
int64 ArrayEntry -> Word64 -> ArrayEntry
forall a. CanQuantify a => a -> Word64 -> a
+> Word64
166]

auxiliary_data :: Rule
auxiliary_data :: Rule
auxiliary_data =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str|            metadata: shelley
        |transaction_metadata: shelley-ma
        |NEW
        |  #6.259(0 ==> metadata): alonzo onwards
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"auxiliary_data"
      Text -> Choice Type2 -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule
metadata
      Rule -> Seal Array -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> Seal Array
sarr
        [ Key
"transaction_metadata" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
metadata
        , Key
"auxiliary_scripts" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
auxiliary_scripts
        ]
      Choice Type2 -> Tagged MapChoice -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Word64 -> MapChoice -> Tagged MapChoice
forall a. Word64 -> a -> Tagged a
tag
        Word64
259
        ( MapChoice -> MapChoice
mp
            [ MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
0 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
metadata)
            , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
1 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
native_script])
            , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
2 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
plutus_script])
            ]
        )

header :: Rule
header :: Rule
header = Text
"header" Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr [Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
header_body, Key
"body_signature" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
kes_signature]

header_body :: Rule
header_body :: Rule
header_body =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str| block_body_size: merkle triple root
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"header_body"
      Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr
        [ Key
"block_number" Key -> Value Int -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt
        , Key
"slot" Key -> Value Int -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt
        , Key
"prev_hash" Key -> Choice Type2 -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> (Rule
hash32 Rule -> Value Void -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Value Void
VNil)
        , Key
"issuer_vkey" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
vkey
        , Key
"vrf_vkey" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
vrf_vkey
        , Key
"nonce_vrf" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
vrf_cert
        , Key
"leader_vrf" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
vrf_cert
        , Key
"block_body_size" Key -> Value Int -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt
        , Key
"block_body_hash" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
hash32
        , Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
operational_cert
        , Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
protocol_version
        ]

native_script :: Rule
native_script :: Rule
native_script =
  Text -> Rule -> Rule
forall a. Text -> Named a -> Named a
comment
    Text
[str|Timelock validity intervals are half-open intervals [a, b).
        |
        |  invalid_before:
        |    specifies the left (included) endpoint a.
        |
        |  invalid_hereafter:
        |    specifies the right (excluded) endpoint b.
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"native_script"
      Text -> Array -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
script_pubkey]
      ArrayChoice -> ArrayChoice -> Array
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
script_all]
      Array -> ArrayChoice -> Array
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
script_any]
      Array -> ArrayChoice -> Array
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
script_n_of_k]
      Array -> ArrayChoice -> Array
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
invalid_before]
      Array -> ArrayChoice -> Array
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
invalid_hereafter]

script_n_of_k :: Named Group
script_n_of_k :: Named Group
script_n_of_k = Text
"script_n_of_k" Text -> Group -> Named Group
=:~ Group -> Group
grp [Item Group
Choice Type2
3, Key
"n" Key -> Value Int -> Choice Type2
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt, ArrayChoice -> Choice Type2
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
native_script])]

positive_interval :: Rule
positive_interval :: Rule
positive_interval = Text
"positive_interval" Text -> Tagged ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
30 (ArrayChoice -> ArrayChoice
arr [Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
positive_int, Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
positive_int])

network_id :: Rule
network_id :: Rule
network_id = Text
"network_id" Text -> Choice Type2 -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Integer -> Literal
int Integer
0 Literal -> Literal -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Integer -> Literal
int Integer
1

auxiliary_data_hash :: Rule
auxiliary_data_hash :: Rule
auxiliary_data_hash = Text
"auxiliary_data_hash" Text -> Rule -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule
hash32

multiasset :: IsType0 a => a -> GRuleCall
multiasset :: forall t0. IsType0 t0 => t0 -> GRuleCall
multiasset =
  (GRef -> Rule) -> a -> GRuleCall
forall t0. IsType0 t0 => (GRef -> Rule) -> t0 -> GRuleCall
binding ((GRef -> Rule) -> a -> GRuleCall)
-> (GRef -> Rule) -> a -> GRuleCall
forall a b. (a -> b) -> a -> b
$ \GRef
x ->
    Text
"multiasset"
      Text -> MapChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= MapChoice -> MapChoice
mp [Word64
0 Word64 -> MapEntry -> MapEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> Key
forall r. IsType0 r => r -> Key
asKey Rule
policy_id Key -> MapChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> MapChoice -> MapChoice
mp [Word64
0 Word64 -> MapEntry -> MapEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> Key
forall r. IsType0 r => r -> Key
asKey Rule
asset_name Key -> GRef -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> GRef
x]]

mint :: Rule
mint :: Rule
mint = Text
"mint" Text -> GRuleCall -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule -> GRuleCall
forall t0. IsType0 t0 => t0 -> GRuleCall
multiasset Rule
int64

value :: Rule
value :: Rule
value = Text
"value" Text -> Choice Type2 -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule
coin Rule -> Seal Array -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> Seal Array
sarr [Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
coin, GRuleCall -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (Value Int -> GRuleCall
forall t0. IsType0 t0 => t0 -> GRuleCall
multiasset Value Int
VUInt)]