diff --git a/docs/alpha/transaction_rollups.rst b/docs/alpha/transaction_rollups.rst index 18b6cf68c969b426a23672fe491184e9ffa58a43..841a17f8b852a4591855899d0107206a853f80aa 100644 --- a/docs/alpha/transaction_rollups.rst +++ b/docs/alpha/transaction_rollups.rst @@ -1,91 +1,245 @@ Transaction Rollups ===================== -High-frequency transactions are hard to achieve in a blockchain that is -decentralized and open. For this reason, many blockchains offer the possibility -to define layer-2 solutions that relax some constraints in terms of consensus to -increase the transaction throughput. They relies on the layer-1 chain as a -gatekeeper and are optimistic that economic incentives are sufficient to prevent -attacks. +High-frequency transactions are hard to achieve in a blockchain that +is decentralized and open. For this reason, many blockchains offer the +possibility to define **layer-2** solutions that relax some +constraints in terms of consensus to increase the transaction +throughput. They rely on the **layer-1** chain (the main blockchain) +as a gatekeeper and on economic incentives to prevent attacks. Introduction ------------ -Optimistic rollups are a popular layer-2 solution, *e.g.*, on the Ethereum -blockchain (Boba, Arbitrum, Optimism, etc.). - -Definitions -************ - -A **rollup** is a **layer-2** solution for high-frequency transactions. A -**rollup** is characterized by a **rollup context** and a set of **rollup -operations**. - -A **rollup node** is a software component running the rollup. By applying -**rollup operations**, a **rollup node** turns a **rollup context** into a new -one to make the rollup **progress**. - -A **rollup user** interacts with the rollup through the rollup node and the -Tezos node. A **rollup participant** is a user that administrates a rollup node. - -Note that several rollups can simultaneously be alive on the Tezos chain. - -Overview -******** - -Optimistic rollups work as follows. - -**Rollup operations** (signed by **rollup users**) are submitted to the layer-1 -chain, a.k.a the Tezos chain. As a consequence, the consensus algorithm of the -layer-1 chain is used to set and order **rollup operations**, and nothing -more. In particular, **rollup operations** are not interpreted by the nodes of -the layer-1 chain. - -**Rollup nodes** are daemons responsible for interpreting the **rollup -operations**, and computing the **rollup context**. This context is encoded in a -Merkle tree, a ubiquitous data structure in the blockchain universe with many -interesting properties. Two of these properties are significant in the context -of optimistic rollups: - -#. A given Merkle tree is uniquely identified by a root hash, and -#. It is possible to prove the presence of a value in the tree without having to - share the whole tree, by means of Merkle proofs. - -Optimistic rollups implementations leverage these two properties. Firstly, -**rollup nodes** can submit **commitment** to the layer-1 chain, to advertise -the root hash of the **rollup context** after the application of a set of -**rollup operations**. Secondly, **rollup participants** can assert the -correctness of these **commitments**, and provide proofs asserting they are -incorrect, we call **rejections** thereafter. By verifying these proofs, the -layer-1 chain can reject an invalid **commitment** without the need to compute -the **rollup context** itself. - -As a consequence, the correctness of the **rollup operations** application is -guaranteed as long as one honest **rollup node** is participating. By contrast, -in the absence of honest nodes, a malicious **rollup node** can commit an -invalid hash root, and take over the rollup. This is the reason behind the -“optimistic” of optimistic rollups. - -Transaction Rollups on Tezos -**************************** - -In some blockchains, optimistic rollups are usually implemented as smart -contracts on the layer-1 chain. That is, **rollup operations**, **commitments**, -and **rejections** are submitted as layer-1 transactions to a smart contract. - -In Tezos, transaction rollups are implemented inside the economic -protocol. **Rollup users** interact with these rollups by means of a set of -dedicated manager operations. This design choice, permitted by the amendment -feature of Tezos, allows for a specialized, gas- and storage-efficient -implementation of optimistic rollups. - - -.. TODO: https://gitlab.com/tezos/tezos/-/issues/2154 - explain choosen ticket interaction and layer-2 operation. - Transaction rollups can be used to exchange assets (encoded as tickets). A - key feature of this implementation is that these exchanges can be grouped - into formal trades (*i.e.*, sets of ticket transfers that need to happen - atomically). +**Optimistic rollups** are a popular layer-2 solution, *e.g.*, on the +Ethereum blockchain (Boba, Arbitrum, Optimism, etc.). Similarly to the +layer-1 it uses at its gatekeeper, a layer-2 is characterized by a set +of operations (**layer-2 operations**), a context (**layer-2 +context**), and a semantics for the application of layer-2 operations +on top of a layer-2 context. They work as follows: + +#. Certain layer-1 operations allow to store layer-2 operations in the + layer-1 context, which means the consensus of the layer-1 decides + which layer-2 operations are to be applied, and in which order. +#. The layer-2 context is updated off-chain, using the semantics of + the layer-2 operations. +#. A layer-1 operation allows to post the hash of the layer-2 context + after the execution of the layer-2 operations in the layer-1 + context. +#. The layer-1 implements a procedure to reject erroneous hashes of + the layer-2 context (*e.g.*, submitted by an attacker) +#. After a period of time specific to each rollup implementation, and + in the absence of a dispute, the hashes of the layer-2 context + becomes **final**, meaning they cannot be rejected. We call + **finality period** the time necessary for a hash to become final. + +The layer-2 context is encoded in a Merkle tree, a ubiquitous data +structure in the blockchain universe with many interesting +properties. One of these properties are significant in the context of +optimistic rollups: it is possible to prove the presence of a value in +the tree without having to share the whole tree, by means of Merkle +proofs. This property ensures that the procedure to reject a hash does +not require to compute the whole layer-2 context. + +The **rollup node** is the software component responsible for applying +the layer-2 operations (as stored in the layer-1 context) onto the +layer-2 context, and to post the resulting hashes in the layer-1. The +word “optimistic” in “optimistic rollup” refers to the assumption that +at least one honest rollup node will always to be active to reject +erroneous hash. In its absence, nothing prevent a rogue node to post a +malicious hash, referring to a tampered layer-2 context. + +The transaction rollups implemented in Tezos are optimistic rollups +characterized by the following principles: + +#. The semantics of the layer-2 operations is limited to the transfer + of assets between layer-2 addresses. +#. The procedure to reject erroneous hashes allows for a short + finality period of 30 blocks. + +Besides, transaction rollups are implemented as part of the economic +protocol, not as smart contracts like Arbitrum for instance. This +design choice, permitted by the amendment feature of Tezos allows for +a specialized, gas- and storage-efficient implementation of rollups. + +Note that it is possible to create more than one transaction rollup on +Tezos. They are identified with **transaction rollup addresses**, +assigned by the layer-1 at their respective creation (called +origination in Tezos to mimic the terminology of smart contract). + +Workflow Overview +----------------- + +Transaction rollups allow for exchanging financial assets, encoded as +`Michelson tickets +`, at a +higher throughput that what is possible on Tezos natively. + +The expected workflow proceeds as follow. + +#. Layer-1 smart contracts can **deposit** tickets for the benefit of + a **layer-2 address** to a transaction rollup. +#. A layer-2 address is associated to a cryptograhic public key, and + the owner of the companion secret key (called “the owner of the + layer-2 address” afterwards) can sign layer-2 operations to + + - **transfer** tickets for the benefit of another layer-2 address. + - **withdraw** their assets outside of the transaction rollup, for + the benefit of a layer-1 address. + +To be considered by the rollup, transfer and withdraw orders have to +be signed by (1) a valid layer-2 address, and (2) a valid layer-1 +address. This is because they are wrapped in a dedicated layer-1 +operation. + +While owners of layer-2 address who also owns a layer-1 address can +submit their transfer and withdraw orders themselves, the expected +workflow is that they delegate this to a trusted rollup node, which +can batch together several layer-2 operations signed by several owners +of layer-2 address and submit only one layer-1 operation. + +Implementation Overview +----------------------- + +We now dive in more details into the concrete implementation of +transaction rollups in Tezos. + +Origination +*********** + +Anyone can originate a transaction rollup on Tezos, as the result of +the layer-1 operation ``Tx_rollup_origination``. Similarly to smart +contracts, transaction rollups are assigned an address, prefixed by +``tru1``. + +Ticket Deposit +************** + +Initially, the layer-2 ledger of the newly created transaction rollup +is empty. This ledger needs to be provisioned with tickets, that are +deposited into layer-2 by layer-1 smart contracts. They do so by +emitting layer-1 transactions to the transaction rollup address, +targeting more specifically the ``deposit`` entrypoint, whose +argument is a pair of + +#. A ticket (of any type) +#. A layer-2 address (the type ``tx_rollup_l2_address`` in Michelson) + +Only smart contracts can emit transaction targeting a transaction +rollup. An example of a minimal smart contract depositing ``unit`` +tickets to a transaction rollup is:: + + parameter (pair address tx_rollup_l2_address); + storage (unit); + code { + # cast the address to contract type + CAR; + UNPAIR; + CONTRACT %deposit (pair (ticket unit) tx_rollup_l2_address); + + IF_SOME { + SWAP; + + # amount for transferring + PUSH mutez 0; + SWAP; + + # create a ticket + PUSH nat 10; + PUSH unit Unit; + TICKET; + + PAIR ; + + # deposit + TRANSFER_TOKENS; + + DIP { NIL operation }; + CONS; + + DIP { PUSH unit Unit }; + PAIR; + } + { FAIL ; } + } + +When its ``default`` entrypoint is called, this smart contract emits +an internal transaction targeting a transaction rollup in order to +deposit 10 ``unit`` tickets for the benefit of a given layer-2 +address. + +Exchanging Tickets +****************** + +Once a layer-2 address has been provisioned with a ticket, the owner +of this address can transfer it to other layer-2 addresses. They are +identified by a ticket hash, which can be retrieved from the layer-1 +operation’s receipt responsible for the deposit. + +Layer-2 operations which can be issued by owners of layer-2 addresses +share the following information: + +#. The layer-2 account spearheading the operation, also called its + *signer* or its *author*. +#. The counter associated to this layer-2 address, which is an + anti-replay measure. It's the same mechanism as in Tezos, see + `Tezos documentation + `_ for more + information. The counter is encoded as a ``int64`` value. The use + of a bounded integer for the counter theoretically exposes the + chain to a replay attack **if and only if** an integer overflow + happen. However, even with an largely overestimated growth of the + counter, it would take several thousands of centuries for the + situation to happen. +#. The payload of the operation. + +The ``Transfer`` l2-operation comprises the following information: + +#. The layer-2 address targeted by the operation; it becomes the new + owner of the ticket. +#. A ticket hash identifying the asset to exchange. +#. The quantity of the tickets being exchanged, encoded as ``int64`` + value. + +The application of a ``Transfer`` will fail in the following cases: + +#. If the signer of the operation does not own the required + quantity of the ticket. +#. If the new balance of the beneficiary of the transfer after the + application of the operation overflows. The quantity of the ticket + a layer-2 address owns is encoded using a ``int64`` value. This is + a known limitation of the transaction rollups, made necessary to + bound the size of the payload necessary to make a rejection. + +Transfer can be grouped inside a *transaction**. A transaction is +atomic: if any operation of the transaction fails, then the whole +transaction fails and leaves the balances of the related addresses +unchanged. This can be useful to implement trades. For instance, two +parties can agree upon exchanging two tickets without having to trust +each other for the emission of the counter-part operation. For a +transaction to be valid, it needs to be signed by the authors of the +transfers it encompasses. + +The application of a transaction can fail if and only if the application of +an transfer within the transaction fails. + +If this happen, the transfers of the transaction are ignored, but the +counters of their signers are updated nonetheless. This means the +transaction will need to be submitted again, with updated counters, if the +error is involuntary. + +Transactions are submitted in **batches** to the layer-1, *via* the +``Tx_rollup_submit_batch`` layer-1 operation. A batch of transactions +comprises the following data: + +#. The list of transactions batched together. +#. A BLS signature that aggregates together all the signatures + of all the transactions contained by the batch. + +The application (in the layer-2) of a batch of transactions will fail +if the aggregated BLS signature is incorrect. In such a case, the +batch is discarded by the rollup node, and the counter of the signers +of its operations are not incremented. Getting Started --------------- @@ -109,16 +263,32 @@ The origination of a transaction rollup burns ꜩ15. A **transaction rollup address** is attributed to the new transaction rollup. This address is derived from the hash of the Tezos operation with the origination operation similarly to the smart contract origination. It is always -prefixed by ``tru1``. For instance, - -:: +prefixed by ``tru1``. For instance,:: tru1HdK6HiR31Xo1bSAr4mwwCek8ExgwuUeHm is a valid transaction rollup address. When using the ``tezos-client`` to originate a transaction rollup, it outputs -the address. +the newly created address. + +Interacting with a Transaction Rollup using ``tezos-client`` +************************************************************ + +The ``tezos-client`` provides dedicated commands to interact with a +transaction rollup. These commands are not intended to be used in a +daily workflow, but rather for testing and development purposes. + +It is possible to use the ``tezos-client`` to submit a batch of +layer-2 operations. + +.. code:: sh + + tezos-client submit tx rollup batch to from + +It is also possible to retrieve the content of an inbox thanks +to a dedicated RPC of the ``tezos-node``. + +.. code:: sh -:: -.. TODO: https://gitlab.com/tezos/tezos/-/issues/2154 + tezos-client rpc get /chains/main/blocks//context/tx_rollup//inbox/ diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 3a6103d3dc5a57bc408f059684791174a5b2cf7e..983daf7682bc3299e793da02d0a49be343b1b599 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -70,6 +70,7 @@ type type_name = | `TKey | `TTimestamp | `TAddress + | `TTx_rollup_l2_address | `TBool | `TPair | `TUnion @@ -487,19 +488,22 @@ end) val stack : ('a, 'b) Script_typed_ir.stack_ty -> ('a * 'b) sampler end = struct let address rng_state = + let open Alpha_context in if Base_samplers.uniform_bool rng_state then - ( Alpha_context.Contract.implicit_contract - (Crypto_samplers.pkh rng_state), + ( Destination.contract + (Contract.implicit_contract (Crypto_samplers.pkh rng_state)), Alpha_context.Entrypoint.default ) - else + else if (* For a description of the format, see tezos-codec describe alpha.contract binary encoding *) + Base_samplers.uniform_bool rng_state + then let string = "\001" ^ Base_samplers.uniform_string ~nbytes:20 rng_state ^ "\000" in let contract = Data_encoding.Binary.of_string_exn - Alpha_context.Contract.encoding + Alpha_context.Destination.encoding string in let ep = @@ -507,6 +511,28 @@ end) @@ Base_samplers.string ~size:{min = 1; max = 31} rng_state in (contract, ep) + else + let string = + "\002" ^ Base_samplers.uniform_string ~nbytes:20 rng_state ^ "\000" + in + let contract = + Data_encoding.Binary.of_string_exn + Alpha_context.Destination.encoding + string + in + let ep = + Alpha_context.Entrypoint.of_string_strict_exn + @@ + if Base_samplers.uniform_bool rng_state then "deposit" else "withdraw" + in + (contract, ep) + + let tx_rollup_l2_address rng_state = + let seed = + Bytes.init 32 (fun _ -> char_of_int @@ Random.State.int rng_state 255) + in + let secret_key = Bls12_381.Signature.generate_sk seed in + Bls12_381.Signature.derive_pk secret_key let chain_id rng_state = let string = Base_samplers.uniform_string ~nbytes:4 rng_state in @@ -529,6 +555,7 @@ end) | Timestamp_t _ -> Michelson_base.timestamp | Bool_t _ -> Base_samplers.uniform_bool | Address_t _ -> address + | Tx_rollup_l2_address_t _ -> tx_rollup_l2_address | Pair_t ((left_t, _, _), (right_t, _, _), _) -> M.( let* left_v = value left_t in diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.mli b/src/proto_alpha/lib_benchmark/michelson_samplers.mli index 813638f3cab279b01a037571d1179fcdaccb0f50..d588118afaa4601c71bc1a51301f6544478d0b82 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.mli +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.mli @@ -100,6 +100,7 @@ module Make : functor module Internal_for_tests : sig type type_name = [ `TAddress + | `TTx_rollup_l2_address | `TBig_map | `TBls12_381_fr | `TBls12_381_g1 diff --git a/src/proto_alpha/lib_benchmark/test/test_distribution.ml b/src/proto_alpha/lib_benchmark/test/test_distribution.ml index 42bbfbc0638c89aba315fae8a9aef7d400fde0c1..c183043787ff6d7e3dd0799ebe011076495e2411 100644 --- a/src/proto_alpha/lib_benchmark/test/test_distribution.ml +++ b/src/proto_alpha/lib_benchmark/test/test_distribution.ml @@ -23,6 +23,7 @@ let pp_type_name fmtr (t : type_name) = | `TTicket -> "ticket" | `TMap -> "map" | `TAddress -> "address" + | `TTx_rollup_l2_address -> "tx_rollup_l2_address" | `TContract -> "contract" | `TBls12_381_fr -> "bls12_381_fr" | `TSapling_transaction -> "sapling_transaction" @@ -67,6 +68,7 @@ let rec tnames_of_type : | Script_typed_ir.Key_t _ -> `TKey :: acc | Script_typed_ir.Timestamp_t _ -> `TTimestamp :: acc | Script_typed_ir.Address_t _ -> `TAddress :: acc + | Script_typed_ir.Tx_rollup_l2_address_t _ -> `TTx_rollup_l2_address :: acc | Script_typed_ir.Bool_t _ -> `TBool :: acc | Script_typed_ir.Pair_t ((lty, _, _), (rty, _, _), _) -> tnames_of_type lty (tnames_of_type rty (`TPair :: acc)) @@ -114,6 +116,7 @@ and tnames_of_comparable_type : | Script_typed_ir.Timestamp_key _ -> `TTimestamp :: acc | Script_typed_ir.Chain_id_key _ -> `TChain_id :: acc | Script_typed_ir.Address_key _ -> `TAddress :: acc + | Script_typed_ir.Tx_rollup_l2_address_key _ -> `TTx_rollup_l2_address :: acc | Script_typed_ir.Pair_key ((lty, _), (rty, _), _) -> tnames_of_comparable_type lty diff --git a/src/proto_alpha/lib_benchmarks_proto/bls_signature_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/bls_signature_benchmarks.ml new file mode 100644 index 0000000000000000000000000000000000000000..1754ba6a4d34c8afdc62e2b4b3f592052e235ba1 --- /dev/null +++ b/src/proto_alpha/lib_benchmarks_proto/bls_signature_benchmarks.ml @@ -0,0 +1,117 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Bls_check_signature_bench : Benchmark.S = struct + include Interpreter_benchmarks.Default_config + + let name = "BLS_CHECK_SIGNATURE" + + let info = "Benchmarking BLS_CHECK_SIGNATURE" + + let tags = ["tx_rollup"; "bls"] + + type workload = {input_size : int; input_bytes_size : int} + + let workload_encoding : workload Data_encoding.t = + let open Data_encoding in + conv + (fun {input_size; input_bytes_size} -> (input_size, input_bytes_size)) + (fun (input_size, input_bytes_size) -> {input_size; input_bytes_size}) + (obj2 + (req "input_size" Size.encoding) + (req "input_bytes_size" Size.encoding)) + + let workload_to_vector {input_size; input_bytes_size} = + let l = + [ + ("input_size", float_of_int input_size); + ("input_bytes_size", float_of_int input_bytes_size); + ] + in + Sparse_vec.String.of_list l + + let model = + Model.make + ~conv:(fun {input_size; input_bytes_size} -> + (input_size, (input_bytes_size, ()))) + ~model: + (Model.bilinear_affine + ~intercept:(Free_variable.of_string "bls_check_signature_const") + ~coeff1: + (Free_variable.of_string "bls_check_signature_input_size_coeff") + ~coeff2: + (Free_variable.of_string + "bls_check_signature_input_bytes_size_coeff")) + + let models = [("bls_check_signature", model)] + + let create_benchmark rng_state () = + (* typical value is likely to be under 100 *) + let range : Base_samplers.range = {min = 0; max = 100} in + let input_size = Base_samplers.sample_in_interval ~range rng_state in + let range_int : Base_samplers.range = {min = 10; max = 1_000} in + let average = Base_samplers.sample_in_interval ~range:range_int rng_state in + let range : Base_samplers.range = + {min = average / 2; max = 3 * average / 2} + in + + let keys = + Stdlib.List.init input_size (fun _ -> + Tx_rollup_helpers.gen_l2_account ~rng:rng_state ()) + in + + let aux = + List.map + (fun (sk, pk) -> + let bytes = Base_samplers.bytes ~size:range rng_state in + let signature = Bls12_381.Signature.Aug.sign sk bytes in + + ((pk, bytes), signature)) + keys + in + + let (manifest, signatures) = Stdlib.List.split aux in + + let input_bytes_size = + List.fold_left (fun acc (_, input) -> acc + Bytes.length input) 0 manifest + in + + let signature = + match Bls12_381.Signature.aggregate_signature_opt signatures with + | Some x -> x + | _ -> assert false + in + + let closure () = + ignore (Tx_rollup_helpers.Map_context.bls_verify manifest signature) + in + + Generator.Plain {workload = {input_size; input_bytes_size}; closure} + + let create_benchmarks ~rng_state ~bench_num _config = + List.repeat bench_num (create_benchmark rng_state) +end + +let () = Registration_helpers.register (module Bls_check_signature_bench) diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml index 7f48a5271d5b9dfb629b5b0deda830202b1bd96a..bcdf92178c2eab0c5559f2a9e2793bc8f102508d 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml @@ -1140,6 +1140,7 @@ let rec size_of_comparable_value : type a. a comparable_ty -> a -> Size.t = | Key_hash_key _ -> Size.key_hash v | Timestamp_key _ -> Size.timestamp v | Address_key _ -> Size.address v + | Tx_rollup_l2_address_key _ -> Size.tx_rollup_l2_address v | Pair_key ((leaf, _), (node, _), _) -> let (lv, rv) = v in let size = diff --git a/src/proto_alpha/lib_benchmarks_proto/size.ml b/src/proto_alpha/lib_benchmarks_proto/size.ml index e3a3e0c14a619582563723f66f8c0e1530fb2dba..a84b58e4057847aa36f895c8661c90637ffe39e8 100644 --- a/src/proto_alpha/lib_benchmarks_proto/size.ml +++ b/src/proto_alpha/lib_benchmarks_proto/size.ml @@ -143,6 +143,9 @@ let address (addr : Script_typed_ir.address) : t = Signature.Public_key_hash.size + String.length (Alpha_context.Entrypoint.to_string entrypoint) +let tx_rollup_l2_address (addr : Script_typed_ir.tx_rollup_l2_address) : t = + Bls12_381.Signature.pk_to_bytes addr |> Bytes.length + let list (list : 'a Script_typed_ir.boxed_list) : t = list.Script_typed_ir.length diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 97b2768cf793d5c1a183e29698d4f1719c3d7677..85e3f10597595bc6c6681bc717fdeed474a3cac5 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -782,6 +782,40 @@ let originate_tx_rollup (cctxt : #full) ~chain ~block ?confirmations ?dry_run | Apply_results.Single_and_result ((Manager_operation _ as op), result) -> return (oph, op, result) +let submit_tx_rollup_batch (cctxt : #full) ~chain ~block ?confirmations ?dry_run + ?verbose_signing ?simulation ?fee ?gas_limit ?storage_limit ?counter ~source + ~src_pk ~src_sk ~fee_parameter ~content ~tx_rollup () = + let contents : + Kind.tx_rollup_submit_batch Annotated_manager_operation.annotated_list = + Annotated_manager_operation.Single_manager + (Injection.prepare_manager_operation + ~fee:(Limit.of_option fee) + ~gas_limit:(Limit.of_option gas_limit) + ~storage_limit:(Limit.of_option storage_limit) + (Tx_rollup_submit_batch {tx_rollup; content})) + in + Injection.inject_manager_operation + cctxt + ~chain + ~block + ?confirmations + ?dry_run + ?verbose_signing + ?simulation + ?counter + ~source + ~fee:(Limit.of_option fee) + ~storage_limit:(Limit.of_option storage_limit) + ~gas_limit:(Limit.of_option gas_limit) + ~src_pk + ~src_sk + ~fee_parameter + contents + >>=? fun (oph, op, result) -> + match Apply_results.pack_contents_list op result with + | Apply_results.Single_and_result ((Manager_operation _ as op), result) -> + return (oph, op, result) + let sc_rollup_originate (cctxt : #full) ~chain ~block ?confirmations ?dry_run ?verbose_signing ?simulation ?fee ?gas_limit ?storage_limit ?counter ~source ~kind ~boot_sector ~src_pk ~src_sk ~fee_parameter () = diff --git a/src/proto_alpha/lib_client/client_proto_context.mli b/src/proto_alpha/lib_client/client_proto_context.mli index 1d1895ad6f7130e2e8623313cf2c8d3b3aa43f05..a5c09ca833bf507b2f0fbebf0cc97be590bc6d41 100644 --- a/src/proto_alpha/lib_client/client_proto_context.mli +++ b/src/proto_alpha/lib_client/client_proto_context.mli @@ -197,7 +197,7 @@ val build_transaction_operation : ?fee:Tez.t -> ?gas_limit:Gas.Arith.integral -> ?storage_limit:Z.t -> - Contract.t -> + Destination.t -> Kind.transaction Annotated_manager_operation.t val transfer : @@ -212,7 +212,7 @@ val transfer : source:public_key_hash -> src_pk:public_key -> src_sk:Client_keys.sk_uri -> - destination:Contract.t -> + destination:Destination.t -> ?entrypoint:Entrypoint.t -> ?arg:string -> amount:Tez.t -> @@ -409,6 +409,31 @@ val originate_tx_rollup : tzresult Lwt.t +val submit_tx_rollup_batch : + #Protocol_client_context.full -> + chain:Shell_services.chain -> + block:Shell_services.block -> + ?confirmations:int -> + ?dry_run:bool -> + ?verbose_signing:bool -> + ?simulation:bool -> + ?fee:Tez.tez -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + ?counter:Z.t -> + source:Signature.public_key_hash -> + src_pk:Signature.public_key -> + src_sk:Client_keys.sk_uri -> + fee_parameter:Injection.fee_parameter -> + content:string -> + tx_rollup:Tx_rollup.t -> + unit -> + (Operation_hash.t + * Kind.tx_rollup_submit_batch Kind.manager contents + * Kind.tx_rollup_submit_batch Kind.manager Apply_results.contents_result) + tzresult + Lwt.t + val sc_rollup_originate : #Protocol_client_context.full -> chain:Chain_services.chain -> diff --git a/src/proto_alpha/lib_client/client_proto_fa12.ml b/src/proto_alpha/lib_client/client_proto_fa12.ml index e200354baeea5df19b0213324892b5b8552421b4..b6e19e032b22c6ba8fe778cd5bb4fd8e708bccf1 100644 --- a/src/proto_alpha/lib_client/client_proto_fa12.ml +++ b/src/proto_alpha/lib_client/client_proto_fa12.ml @@ -777,7 +777,7 @@ let call_contract (cctxt : #Protocol_client_context.full) ~chain ~block ~source ~src_pk ~src_sk - ~destination:contract + ~destination:(Destination.contract contract) ~arg ~amount:tez_amount ~entrypoint @@ -906,7 +906,7 @@ let prepare_single_token_transfer cctxt ?default_fee ?default_gas_limit ?fee ?gas_limit ?storage_limit - token + (Destination.contract token) action in return (Annotated_manager_operation.Annotated_manager_operation operation) diff --git a/src/proto_alpha/lib_client/client_proto_multisig.ml b/src/proto_alpha/lib_client/client_proto_multisig.ml index 4ed8635c4e456b144d1c28aa6ea521dae6436a27..6fba3a2eff04b794fbe7a82b8b3a408822be9fce 100644 --- a/src/proto_alpha/lib_client/client_proto_multisig.ml +++ b/src/proto_alpha/lib_client/client_proto_multisig.ml @@ -1095,7 +1095,7 @@ let call_multisig (cctxt : #Protocol_client_context.full) ~chain ~block ~source ~src_pk ~src_sk - ~destination:multisig_contract + ~destination:(Destination.contract multisig_contract) ?entrypoint ~arg ~amount diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index 9b58f4b4b7aa27417f9380bd628ae70483d6b9f2..c1f39e8746c799748ec4a7c0f417e2f45de9df35 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -320,6 +320,8 @@ let estimated_gas_single (type kind) | Applied (Set_deposits_limit_result {consumed_gas}) -> Ok consumed_gas | Applied (Tx_rollup_origination_result {consumed_gas; _}) -> Ok consumed_gas + | Applied (Tx_rollup_submit_batch_result {consumed_gas; _}) -> + Ok consumed_gas | Applied (Sc_rollup_originate_result {consumed_gas; _}) -> Ok consumed_gas | Skipped _ -> assert false | Backtracked (_, None) -> @@ -354,6 +356,7 @@ let estimated_storage_single (type kind) ~tx_rollup_origination_size Ok size_of_constant | Applied (Set_deposits_limit_result _) -> Ok Z.zero | Applied (Tx_rollup_origination_result _) -> Ok tx_rollup_origination_size + | Applied (Tx_rollup_submit_batch_result _) -> Ok Z.zero | Applied (Sc_rollup_originate_result {size; _}) -> Ok size | Skipped _ -> assert false | Backtracked (_, None) -> @@ -402,6 +405,7 @@ let originated_contracts_single (type kind) | Applied (Delegation_result _) -> Ok [] | Applied (Set_deposits_limit_result _) -> Ok [] | Applied (Tx_rollup_origination_result _) -> Ok [] + | Applied (Tx_rollup_submit_batch_result _) -> Ok [] | Applied (Sc_rollup_originate_result _) -> Ok [] | Skipped _ -> assert false | Backtracked (_, None) -> diff --git a/src/proto_alpha/lib_client/managed_contract.ml b/src/proto_alpha/lib_client/managed_contract.ml index 676a7d95b03b109847ebddcc847162c809399e0d..3d3cb018671b22d4087cb5a8e28ba78e6598a47b 100644 --- a/src/proto_alpha/lib_client/managed_contract.ml +++ b/src/proto_alpha/lib_client/managed_contract.ml @@ -152,7 +152,7 @@ let build_delegate_operation (cctxt : #full) ~chain ~block ?fee ~parameters ~entrypoint ?fee - contract) + (Destination.contract contract)) let set_delegate (cctxt : #full) ~chain ~block ?confirmations ?dry_run ?verbose_signing ?simulation ?branch ~fee_parameter ?fee ~source ~src_pk @@ -238,7 +238,7 @@ let build_transaction_operation (cctxt : #full) ~chain ~block ~contract Entrypoint.pp entrypoint Contract.pp - destination + contract | None -> (Michelson_v1_entrypoints.contract_entrypoint_type cctxt @@ -282,7 +282,7 @@ let build_transaction_operation (cctxt : #full) ~chain ~block ~contract ?fee ?gas_limit ?storage_limit - contract) + (Destination.contract contract)) let transfer (cctxt : #full) ~chain ~block ?confirmations ?dry_run ?verbose_signing ?simulation ?branch ~source ~src_pk ~src_sk ~contract diff --git a/src/proto_alpha/lib_client/mockup.ml b/src/proto_alpha/lib_client/mockup.ml index 0351135e7b73b1bd9b60dcf8b00b6c9c0b151466..da883f4890d76e5a09eedcdf953ea35fd17642ec 100644 --- a/src/proto_alpha/lib_client/mockup.ml +++ b/src/proto_alpha/lib_client/mockup.ml @@ -70,6 +70,9 @@ module Protocol_constants_overrides = struct Constants.ratio option; tx_rollup_enable : bool option; tx_rollup_origination_size : int option; + tx_rollup_hard_size_limit_per_batch : int option; + tx_rollup_hard_size_limit_per_inbox : int option; + tx_rollup_initial_inbox_cost_per_byte : Tez.t option; sc_rollup_enable : bool option; sc_rollup_origination_size : int option; (* Additional, "bastard" parameters (they are not protocol constants but partially treated the same way). *) @@ -118,7 +121,11 @@ module Protocol_constants_overrides = struct c.chain_id, c.timestamp, c.initial_seed ), - ( (c.tx_rollup_enable, c.tx_rollup_origination_size), + ( ( c.tx_rollup_enable, + c.tx_rollup_origination_size, + c.tx_rollup_hard_size_limit_per_batch, + c.tx_rollup_hard_size_limit_per_inbox, + c.tx_rollup_initial_inbox_cost_per_byte ), (c.sc_rollup_enable, c.sc_rollup_origination_size) ) ) ) ) )) (fun ( ( preserved_cycles, blocks_per_cycle, @@ -155,7 +162,11 @@ module Protocol_constants_overrides = struct chain_id, timestamp, initial_seed ), - ( (tx_rollup_enable, tx_rollup_origination_size), + ( ( tx_rollup_enable, + tx_rollup_origination_size, + tx_rollup_hard_size_limit_per_batch, + tx_rollup_hard_size_limit_per_inbox, + tx_rollup_initial_inbox_cost_per_byte ), (sc_rollup_enable, sc_rollup_origination_size) ) ) ) ) ) -> { preserved_cycles; @@ -192,6 +203,9 @@ module Protocol_constants_overrides = struct ratio_of_frozen_deposits_slashed_per_double_endorsement; tx_rollup_enable; tx_rollup_origination_size; + tx_rollup_hard_size_limit_per_batch; + tx_rollup_hard_size_limit_per_inbox; + tx_rollup_initial_inbox_cost_per_byte; sc_rollup_enable; sc_rollup_origination_size; chain_id; @@ -246,9 +260,14 @@ module Protocol_constants_overrides = struct (opt "initial_timestamp" Time.Protocol.encoding) (opt "initial_seed" (option State_hash.encoding))) (merge_objs - (obj2 + (obj5 (opt "tx_rollup_enable" Data_encoding.bool) - (opt "tx_rollup_origination_size" int31)) + (opt "tx_rollup_origination_size" int31) + (opt "tx_rollup_hard_size_limit_per_batch" int31) + (opt "tx_rollup_hard_size_limit_per_inbox" int31) + (opt + "tx_rollup_initial_inbox_cost_per_byte" + Tez.encoding)) (obj2 (opt "sc_rollup_enable" bool) (opt "sc_rollup_origination_size" int31))))))) @@ -312,6 +331,12 @@ module Protocol_constants_overrides = struct parametric.ratio_of_frozen_deposits_slashed_per_double_endorsement; tx_rollup_enable = Some parametric.tx_rollup_enable; tx_rollup_origination_size = Some parametric.tx_rollup_origination_size; + tx_rollup_hard_size_limit_per_batch = + Some parametric.tx_rollup_hard_size_limit_per_batch; + tx_rollup_hard_size_limit_per_inbox = + Some parametric.tx_rollup_hard_size_limit_per_inbox; + tx_rollup_initial_inbox_cost_per_byte = + Some parametric.tx_rollup_initial_inbox_cost_per_byte; sc_rollup_enable = Some parametric.sc_rollup_enable; sc_rollup_origination_size = Some parametric.sc_rollup_origination_size; (* Bastard additional parameters. *) @@ -358,6 +383,9 @@ module Protocol_constants_overrides = struct ratio_of_frozen_deposits_slashed_per_double_endorsement = None; tx_rollup_enable = None; tx_rollup_origination_size = None; + tx_rollup_hard_size_limit_per_batch = None; + tx_rollup_hard_size_limit_per_inbox = None; + tx_rollup_initial_inbox_cost_per_byte = None; sc_rollup_enable = None; sc_rollup_origination_size = None; chain_id = None; @@ -604,6 +632,24 @@ module Protocol_constants_overrides = struct override_value = o.tx_rollup_origination_size; pp = pp_print_int; }; + O + { + name = "tx_rollup_hard_size_limit_per_batch"; + override_value = o.tx_rollup_hard_size_limit_per_batch; + pp = pp_print_int; + }; + O + { + name = "tx_rollup_hard_size_limit_per_inbox"; + override_value = o.tx_rollup_hard_size_limit_per_inbox; + pp = pp_print_int; + }; + O + { + name = "tx_rollup_initial_inbox_cost_per_byte"; + override_value = o.tx_rollup_initial_inbox_cost_per_byte; + pp = Tez.pp; + }; ] in let fields_with_override = @@ -730,6 +776,18 @@ module Protocol_constants_overrides = struct Option.value ~default:c.tx_rollup_origination_size o.tx_rollup_origination_size; + tx_rollup_hard_size_limit_per_batch = + Option.value + ~default:c.tx_rollup_origination_size + o.tx_rollup_hard_size_limit_per_batch; + tx_rollup_hard_size_limit_per_inbox = + Option.value + ~default:c.tx_rollup_origination_size + o.tx_rollup_hard_size_limit_per_inbox; + tx_rollup_initial_inbox_cost_per_byte = + Option.value + ~default:c.tx_rollup_initial_inbox_cost_per_byte + o.tx_rollup_initial_inbox_cost_per_byte; sc_rollup_enable = Option.value ~default:c.sc_rollup_enable o.sc_rollup_enable; sc_rollup_origination_size = diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index 6bcf9302da4031163d6b575345a77e203c93f830..dcf91ed33ce5280663cc73789df76739382b0425 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -41,7 +41,7 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf amount Contract.pp source - Contract.pp + Destination.pp destination ; if not (Entrypoint.is_default entrypoint) then Format.fprintf ppf "@,Entrypoint: %a" Entrypoint.pp entrypoint ; @@ -174,6 +174,19 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf source pp_result result + | Tx_rollup_submit_batch {tx_rollup; content} -> + Format.fprintf + ppf + "@[%s:%a, %d bytes, From: %a%a@]" + (if internal then "Internal tx rollup transaction" + else "Tx rollup transaction") + Tx_rollup.pp + tx_rollup + (String.length content) + Contract.pp + source + pp_result + result | Sc_rollup_originate {kind; boot_sector} -> let (module R : Sc_rollups.PVM.S) = Sc_rollups.of_kind kind in Format.fprintf @@ -417,6 +430,15 @@ let pp_manager_operation_contents_and_result ppf Tx_rollup.pp originated_tx_rollup in + let pp_tx_rollup_submit_batch_result + (Tx_rollup_submit_batch_result {balance_updates; consumed_gas}) = + Format.fprintf + ppf + "@,Balance updates:@, %a" + pp_balance_updates + balance_updates ; + Format.fprintf ppf "@,Consumed gas: %a" Gas.Arith.pp consumed_gas + in let pp_sc_rollup_originate_result (Sc_rollup_originate_result {address; consumed_gas; size; balance_updates}) = @@ -494,6 +516,17 @@ let pp_manager_operation_contents_and_result ppf "@[This rollup operation was BACKTRACKED, its expected effects \ (as follow) were NOT applied.@]" ; pp_tx_rollup_result op + | Applied (Tx_rollup_submit_batch_result _ as op) -> + Format.fprintf + ppf + "This tx rollup submit operation was successfully applied" ; + pp_tx_rollup_submit_batch_result op + | Backtracked ((Tx_rollup_submit_batch_result _ as op), _err) -> + Format.fprintf + ppf + "@[This rollup submit operation was BACKTRACKED, its expected \ + effects (as follow) were NOT applied.@]" ; + pp_tx_rollup_submit_batch_result op | Applied (Sc_rollup_originate_result _ as op) -> Format.fprintf ppf diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index 9fa5e21205dc2442536ebf81b3b5a58d346d2805..b7432d05258fe2799d2f0ac514fccd4a3390a69d 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -79,6 +79,18 @@ let block_hash_param = try return (Block_hash.of_b58check_exn s) with _ -> failwith "Parameter '%s' is an invalid block hash" s) +let tx_rollup_parameter = + Clic.parameter (fun _ s -> + match Tx_rollup.of_b58check s with + | Ok c -> return c + | Error _ -> failwith "Parameter '%s' is an invalid tx rollup address" s) + +let tx_rollup_param = + Clic.param + ~name:"tx_rollup address" + ~desc:"The tx rollup address that we are sending this batch to." + tx_rollup_parameter + let rollup_kind_param = Clic.parameter (fun _ name -> match Sc_rollups.from ~name with @@ -684,7 +696,7 @@ let transfer_command amount source destination cctxt ?fee ~src_pk ~src_sk - ~destination + ~destination:(Destination.contract destination) ?entrypoint ?arg ~amount @@ -737,7 +749,7 @@ let prepare_batch_operation cctxt ?arg ?fee ?gas_limit ?storage_limit ?fee ?gas_limit ?storage_limit - destination)) + (Destination.contract destination))) >>=? fun operation -> return (Annotated_manager_operation.Annotated_manager_operation operation) @@ -2061,6 +2073,83 @@ let commands_rw () = ~fee_parameter () >>=? fun _res -> return_unit); + command + ~group + ~desc:"Submit a batch of optimistic transaction rollup operations." + (args12 + fee_arg + dry_run_switch + verbose_signing_switch + simulate_switch + minimal_fees_arg + minimal_nanotez_per_byte_arg + minimal_nanotez_per_gas_unit_arg + storage_limit_arg + counter_arg + force_low_fee_arg + fee_cap_arg + burn_cap_arg) + (prefixes ["submit"; "tx"; "rollup"; "batch"] + @@ Clic.param + ~name:"bytes" + ~desc:"a bytes representation of the batch in hexadecimal form." + Client_proto_args.string_parameter + @@ prefix "to" @@ tx_rollup_param @@ prefix "from" + @@ ContractAlias.destination_param + ~name:"src" + ~desc:"name of the account originating the transaction rollup." + @@ stop) + (fun ( fee, + dry_run, + verbose_signing, + simulation, + minimal_fees, + minimal_nanotez_per_byte, + minimal_nanotez_per_gas_unit, + storage_limit, + counter, + force_low_fee, + fee_cap, + burn_cap ) + content + tx_rollup + (_, source) + cctxt -> + match Contract.is_implicit source with + | None -> + failwith + "Only implicit accounts can submit transaction rollup batches" + | Some source -> + Client_keys.get_key cctxt source >>=? fun (_, src_pk, src_sk) -> + let fee_parameter = + { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } + in + submit_tx_rollup_batch + cctxt + ~chain:cctxt#chain + ~block:cctxt#block + ?dry_run:(Some dry_run) + ?verbose_signing:(Some verbose_signing) + ?fee + ?storage_limit + ?counter + ?confirmations:cctxt#confirmations + ~simulation + ~source + ~src_pk + ~src_sk + ~fee_parameter + ~tx_rollup + ~content + () + >>=? fun _res -> return_unit); command ~group ~desc:"Originate a new smart-contract rollup." diff --git a/src/proto_alpha/lib_client_commands/client_proto_stresstest_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_stresstest_commands.ml index 1af3ee99aea1faf63b7a2a9caa7885db456cd5f6..c2de4953632727a923beeaacd380ef6de9fa2ef6 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_stresstest_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_stresstest_commands.ml @@ -390,7 +390,7 @@ let manager_op_of_transfer parameters (Prim (0, Michelson_v1_primitives.D_Unit, [], [])) in let entrypoint = Entrypoint.default in - let destination = Contract.implicit_contract dst in + let destination = Destination.contract (Contract.implicit_contract dst) in Transaction {amount; parameters; entrypoint; destination} in match counter with diff --git a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml index 3a268e4a37a37d71041fb6df16342e30d76ab157..8d07c8d8d241b7e21bc81a20685325dd978bb2ba 100644 --- a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml @@ -204,7 +204,7 @@ let shield_cmd = ~amount ~src_pk ~src_sk - ~destination:contract_dst + ~destination:(Destination.contract contract_dst) ~source:pkh ~arg ?confirmations:cctxt#confirmations @@ -313,7 +313,7 @@ let unshield_cmd = ~amount:Tez.zero ~src_pk ~src_sk - ~destination:contract_dst + ~destination:(Destination.contract contract_dst) ~source ~arg ?confirmations:cctxt#confirmations @@ -525,7 +525,7 @@ let submit_shielded_cmd = ~amount:Tez.zero ~src_pk ~src_sk - ~destination + ~destination:(Destination.contract destination) ~source ~arg:contract_input ?confirmations:cctxt#confirmations diff --git a/src/proto_alpha/lib_parameters/default_parameters.ml b/src/proto_alpha/lib_parameters/default_parameters.ml index 3d77c69fcbf7535883c709e38c9b940469cc8887..fd5f5fbf604a973ded88b847249083ed940ada73 100644 --- a/src/proto_alpha/lib_parameters/default_parameters.ml +++ b/src/proto_alpha/lib_parameters/default_parameters.ml @@ -89,8 +89,13 @@ let constants_mainnet = {numerator = 1; denominator = 2}; initial_seed = None; tx_rollup_enable = false; - (* TODO: https://gitlab.com/tezos/tezos/-/issues/2152 *) + (* TODO: https://gitlab.com/tezos/tezos/-/issues/2152 + Transaction rollups parameters need to be refined, currently + the following values are merely placeholders. *) tx_rollup_origination_size = 60_000; + tx_rollup_hard_size_limit_per_batch = 5_000; + tx_rollup_hard_size_limit_per_inbox = 100_000; + tx_rollup_initial_inbox_cost_per_byte = Tez.of_mutez_exn 250L; sc_rollup_enable = false; (* The following value is chosen to prevent spam. *) sc_rollup_origination_size = 6_314; diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml index a7d82e41150658871f83814d1de368082e0c754f..a7735a58762e70acd161350f18789d7466ddc775 100644 --- a/src/proto_alpha/lib_plugin/plugin.ml +++ b/src/proto_alpha/lib_plugin/plugin.ml @@ -1097,7 +1097,7 @@ module View_helpers = struct Internal_operation {operation = Transaction {destination; parameters; _}; _}; ] - when Contract.equal destination callback -> + when Destination.equal destination (Contract callback) -> ok parameters | [] -> Environment.Error_monad.error @@ -1596,6 +1596,8 @@ module RPC = struct Prim (loc, T_timestamp, [], unparse_type_annot meta.annot) | Address_key meta -> Prim (loc, T_address, [], unparse_type_annot meta.annot) + | Tx_rollup_l2_address_key meta -> + Prim (loc, T_tx_rollup_l2_address, [], unparse_type_annot meta.annot) | Chain_id_key meta -> Prim (loc, T_chain_id, [], unparse_type_annot meta.annot) | Pair_key ((l, al), (r, ar), meta) -> @@ -1637,6 +1639,8 @@ module RPC = struct | Timestamp_t meta -> return (T_timestamp, [], unparse_type_annot meta.annot) | Address_t meta -> return (T_address, [], unparse_type_annot meta.annot) + | Tx_rollup_l2_address_t meta -> + return (T_tx_rollup_l2_address, [], unparse_type_annot meta.annot) | Operation_t meta -> return (T_operation, [], unparse_type_annot meta.annot) | Chain_id_t meta -> diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index 773866de6a4d4fefd6a3ca2ee0c090a80e1f27e6..00647f456b21f8de9b3ec21c717e320dadf9978e 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -39,11 +39,14 @@ "Script_repr", "Cache_memory_helpers", "Contract_repr", + "Entrypoint_repr", "Tx_rollup_repr", + "Tx_rollup_l2_address_repr", + "Tx_rollup_state_repr", "Roll_repr_legacy", "Vote_repr", "Block_header_repr", - "Entrypoint_repr", + "Destination_repr", "Operation_repr", "Manager_repr", "Commitment_repr", @@ -55,6 +58,8 @@ "Raw_context_intf", "Raw_context", + "Ticket_hash_repr", + "Tx_rollup_inbox_repr", "Storage_costs", "Storage_sigs", "Storage_functors", @@ -140,6 +145,11 @@ "Tx_rollup_services", "Alpha_services", + "Tx_rollup_l2_operation", + "Tx_rollup_l2_storage", + "Tx_rollup_l2_context", + "Tx_rollup_l2_apply", + "Main" ] } diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index 438b6deeead53ddbf37ea6f89b557e93395868c2..66d335618b1dc6e41969ae6902e0920e93189e30 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -63,6 +63,7 @@ module Sc_rollup = struct end module Entrypoint = Entrypoint_repr +module Destination = Destination_repr include Operation_repr module Operation = struct @@ -244,6 +245,19 @@ module Contract = struct module Internal_for_tests = Contract_repr end +module Tx_rollup_l2_address = struct + include Tx_rollup_l2_address_repr +end + +module Tx_rollup_inbox = struct + include Tx_rollup_inbox_repr +end + +module Tx_rollup_state = struct + include Tx_rollup_state_repr + module Internal_for_tests = Tx_rollup_state_repr +end + module Tx_rollup = struct include Tx_rollup_repr include Tx_rollup_storage @@ -447,6 +461,7 @@ let description = Raw_context.description module Parameters = Parameters_repr module Liquidity_baking = Liquidity_baking_repr +module Ticket_hash = Ticket_hash_repr module Ticket_balance = struct include Ticket_storage diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 4f64a8755d2f14a0fb22c750eb34146761e7469a..39363fc83107db73e4940d3b58e473b18dde8d5f 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -626,6 +626,7 @@ module Script : sig | T_unit | T_operation | T_address + | T_tx_rollup_l2_address | T_sapling_transaction | T_sapling_state | T_chain_id @@ -763,6 +764,9 @@ module Constants : sig initial_seed : State_hash.t option; tx_rollup_enable : bool; tx_rollup_origination_size : int; + tx_rollup_hard_size_limit_per_batch : int; + tx_rollup_hard_size_limit_per_inbox : int; + tx_rollup_initial_inbox_cost_per_byte : Tez.t; sc_rollup_enable : bool; sc_rollup_origination_size : int; } @@ -850,6 +854,12 @@ module Constants : sig val tx_rollup_origination_size : context -> int + val tx_rollup_hard_size_limit_per_batch : context -> int + + val tx_rollup_hard_size_limit_per_inbox : context -> int + + val tx_rollup_initial_inbox_cost_per_byte : context -> Tez.t + val sc_rollup_enable : context -> bool val sc_rollup_origination_size : context -> int @@ -1514,41 +1524,6 @@ module Receipt : sig val group_balance_updates : balance_updates -> balance_updates tzresult end -(** This simply re-exports [Tx_rollup_repr] and [tx_rollup_storage]. See - [tx_rollup_repr] and [tx_rollup_storage] for additional documentation of this - module *) -module Tx_rollup : sig - include BASIC_DATA - - type tx_rollup = t - - val rpc_arg : tx_rollup RPC_arg.arg - - val to_b58check : tx_rollup -> string - - val of_b58check : string -> tx_rollup tzresult - - val pp : Format.formatter -> tx_rollup -> unit - - val encoding : tx_rollup Data_encoding.t - - val originate : context -> (context * tx_rollup) tzresult Lwt.t - - type state - - val state : context -> tx_rollup -> state option tzresult Lwt.t - - val state_encoding : state Data_encoding.t - - val pp_state : Format.formatter -> state -> unit - - module Internal_for_tests : sig - (** see [tx_rollup_repr.originated_tx_rollup] for documentation *) - val originated_tx_rollup : - Origination_nonce.Internal_for_tests.t -> tx_rollup - end -end - module Delegate : sig val init : context -> @@ -1901,6 +1876,24 @@ module Block_header : sig unit tzresult end +(** This module re-exports functions from [Ticket_hash_repr]. See + documentation of the functions there. *) +module Ticket_hash : sig + type t + + val encoding : t Data_encoding.t + + val to_script_expr_hash : t -> Script_expr_hash.t + + val make : + context -> + ticketer:Script.node -> + typ:Script.node -> + contents:Script.node -> + owner:Script.node -> + (t * context) tzresult +end + (** See {!Sc_rollup_storage} and {!Sc_rollup_repr}. *) module Sc_rollup : sig module PVM : sig @@ -1928,6 +1921,132 @@ module Sc_rollup : sig val kind : context -> t -> Kind.t option tzresult Lwt.t end +(** This simply re-exports {!Tx_rollup_l2_address_repr}. + See {!Tx_rollup_l2_address_repr} for additional documentation of + this module. *) +module Tx_rollup_l2_address : sig + type t = Bls_signature.pk + + val encoding : t Data_encoding.t + + val compare : t -> t -> int + + val in_memory_size : t -> Cache_memory_helpers.sint +end + +(** This simply re-exports {!Tx_rollup_inbox_repr}. + See {!Tx_rollup_inbox_repr} for additional documentation of this + module. *) +module Tx_rollup_inbox : sig + type deposit = { + destination : Tx_rollup_l2_address.t; + key_hash : Ticket_hash.t; + amount : int64; + } + + type message = Batch of string | Deposit of deposit + + val message_encoding : message Data_encoding.t + + type message_hash + + val message_hash_encoding : message_hash Data_encoding.t + + val message_hash_pp : Format.formatter -> message_hash -> unit + + val hash_message : message -> message_hash + + type t = {contents : message_hash list; cumulated_size : int} + + val pp : Format.formatter -> t -> unit + + val encoding : t Data_encoding.t +end + +(** This simply re-exports {!Tx_rollup_state_repr}. + See {!Tx_rollup_state_repr} for additional documentation of this + module. *) +module Tx_rollup_state : sig + type t = {cost_per_byte : Tez.t} + + val encoding : t Data_encoding.t + + module Internal_for_tests : sig + val update_cost_per_byte : + cost_per_byte:Tez.t -> + tx_rollup_cost_per_byte:Tez.t -> + final_size:int -> + hard_limit:int -> + Tez.t + end +end + +(** This simply re-exports {!Tx_rollup_repr} and {!Tx_rollup_storage}. + See {!Tx_rollup_repr} and {!Tx_rollup_storage} for additional + documentation of this module. *) +module Tx_rollup : sig + include BASIC_DATA + + type tx_rollup = t + + val rpc_arg : tx_rollup RPC_arg.arg + + val to_b58check : tx_rollup -> string + + val of_b58check : string -> tx_rollup tzresult + + val pp : Format.formatter -> tx_rollup -> unit + + val encoding : tx_rollup Data_encoding.t + + val deposit_entrypoint : Entrypoint.t + + val originate : context -> (context * tx_rollup) tzresult Lwt.t + + val hash_ticket : + context -> + t -> + contents:Script.node -> + ticketer:Script.node -> + ty:Script.node -> + (Ticket_hash.t * context) tzresult + + val get_state : context -> t -> Tx_rollup_state.t tzresult Lwt.t + + val get_state_opt : context -> t -> Tx_rollup_state.t option tzresult Lwt.t + + val append_message : + context -> t -> Tx_rollup_inbox.message -> (int * context) tzresult Lwt.t + + val inbox : + context -> + ?level:Raw_level.t -> + t -> + (context * Tx_rollup_inbox.t) tzresult Lwt.t + + val inbox_opt : + context -> + ?level:Raw_level.t -> + t -> + (context * Tx_rollup_inbox.t option) tzresult Lwt.t + + val inbox_cumulated_size : + context -> ?level:Raw_level.t -> t -> int tzresult Lwt.t + + val inbox_messages : + context -> + ?level:Raw_level.t -> + t -> + (context * Tx_rollup_inbox.message_hash list) tzresult Lwt.t + + val update_tx_rollup_at_block_finalization : context -> context tzresult Lwt.t + + module Internal_for_tests : sig + val originated_tx_rollup : + Origination_nonce.Internal_for_tests.t -> tx_rollup + end +end + module Kind : sig type preendorsement_consensus_kind = Preendorsement_consensus_kind @@ -1976,6 +2095,8 @@ module Kind : sig type tx_rollup_origination = Tx_rollup_origination_kind + type tx_rollup_submit_batch = Tx_rollup_submit_batch_kind + type sc_rollup_originate = Sc_rollup_originate_kind type 'a manager = @@ -1986,6 +2107,7 @@ module Kind : sig | Register_global_constant_manager_kind : register_global_constant manager | Set_deposits_limit_manager_kind : set_deposits_limit manager | Tx_rollup_origination_manager_kind : tx_rollup_origination manager + | Tx_rollup_submit_batch_manager_kind : tx_rollup_submit_batch manager | Sc_rollup_originate_manager_kind : sc_rollup_originate manager end @@ -2010,6 +2132,30 @@ val consensus_content_encoding : consensus_content Data_encoding.t val pp_consensus_content : Format.formatter -> consensus_content -> unit +module Destination : sig + type t = Contract of Contract.t | Tx_rollup of Tx_rollup.t + + val contract : Contract.t -> t + + val tx_rollup : Tx_rollup.t -> t + + val encoding : t Data_encoding.t + + val pp : Format.formatter -> t -> unit + + val compare : t -> t -> int + + val equal : t -> t -> bool + + val to_b58check : t -> string + + val of_b58check : string -> t tzresult + + val in_memory_size : t -> Cache_memory_helpers.sint + + type error += Invalid_destination_b58check of string +end + type 'kind operation = { shell : Operation.shell_header; protocol_data : 'kind protocol_data; @@ -2084,7 +2230,7 @@ and _ manager_operation = amount : Tez.tez; parameters : Script.lazy_expr; entrypoint : Entrypoint.t; - destination : Contract.contract; + destination : Destination.t; } -> Kind.transaction manager_operation | Origination : { @@ -2105,6 +2251,11 @@ and _ manager_operation = Tez.t option -> Kind.set_deposits_limit manager_operation | Tx_rollup_origination : Kind.tx_rollup_origination manager_operation + | Tx_rollup_submit_batch : { + tx_rollup : Tx_rollup.t; + content : string; + } + -> Kind.tx_rollup_submit_batch manager_operation | Sc_rollup_originate : { kind : Sc_rollup.Kind.t; boot_sector : Sc_rollup.PVM.boot_sector; @@ -2250,6 +2401,9 @@ module Operation : sig val tx_rollup_origination_case : Kind.tx_rollup_origination Kind.manager case + val tx_rollup_submit_batch_case : + Kind.tx_rollup_submit_batch Kind.manager case + val register_global_constant_case : Kind.register_global_constant Kind.manager case @@ -2283,6 +2437,8 @@ module Operation : sig val tx_rollup_origination_case : Kind.tx_rollup_origination case + val tx_rollup_submit_batch_case : Kind.tx_rollup_submit_batch case + val sc_rollup_originate_case : Kind.sc_rollup_originate case end end @@ -2421,22 +2577,11 @@ end documentation of the functions there. *) module Ticket_balance : sig - type key_hash - - val script_expr_hash_of_key_hash : key_hash -> Script_expr_hash.t - - val make_key_hash : - context -> - ticketer:Script.node -> - typ:Script.node -> - contents:Script.node -> - owner:Script.node -> - (key_hash * context) tzresult - val adjust_balance : - context -> key_hash -> delta:Z.t -> (Z.t * context) tzresult Lwt.t + context -> Ticket_hash.t -> delta:Z.t -> (Z.t * context) tzresult Lwt.t - val get_balance : context -> key_hash -> (Z.t option * context) tzresult Lwt.t + val get_balance : + context -> Ticket_hash.t -> (Z.t option * context) tzresult Lwt.t end module First_level_of_tenderbake : sig diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 7c10d7e1be9da0162a4dee0fc2ca6999534c1914..6409ab7f93e4e64347544f65a936d42bce1220c2 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -106,8 +106,10 @@ type error += max_limit : Tez.t; } | (* `Branch *) Empty_transaction of Contract.t - | (* `Permanent *) - Tx_rollup_disabled + | (* `Permanent *) Tx_rollup_disabled + | (* `Permanent *) Tx_rollup_submit_too_big + | (* `Permanent *) Tx_rollup_non_null_transaction + | (* `Permanent *) Tx_rollup_non_internal_transaction | (* `Permanent *) Sc_rollup_feature_disabled | (* `Permanent *) @@ -498,6 +500,40 @@ let () = Data_encoding.unit (function Tx_rollup_disabled -> Some () | _ -> None) (fun () -> Tx_rollup_disabled) ; + register_error_kind + `Permanent + ~id:"operation.tx_rollup_non_null_transaction" + ~title:"Non null transaction to a transaction rollup" + ~description:"Non-null transactions to a tx rollup are forbidden." + ~pp:(fun ppf () -> + Format.fprintf ppf "Transaction to a transaction rollup must be null.") + Data_encoding.unit + (function Tx_rollup_non_null_transaction -> Some () | _ -> None) + (fun () -> Tx_rollup_non_null_transaction) ; + register_error_kind + `Permanent + ~id:"operation.tx_rollup_non_internal_transaction" + ~title:"Non internal transaction to a transaction rollup" + ~description:"Non-internal transactions to a tx rollup are forbidden." + ~pp:(fun ppf () -> + Format.fprintf ppf "Transaction to a transaction rollup must be internal.") + Data_encoding.unit + (function Tx_rollup_non_internal_transaction -> Some () | _ -> None) + (fun () -> Tx_rollup_non_internal_transaction) ; + + register_error_kind + `Permanent + ~id:"operation.tx_rollup_submit_too_big" + ~title:"Tx rollup inbox limit exceeded" + ~description:"The submitted batch is too large" + ~pp:(fun ppf () -> + Format.fprintf + ppf + "Cannot insert this batch in the inbox since it exceeds the authorized \ + size of a batch.") + Data_encoding.unit + (function Tx_rollup_submit_too_big -> Some () | _ -> None) + (fun () -> Tx_rollup_submit_too_big) ; let description = "Smart contract rollups will be enabled in a future proposal." @@ -874,7 +910,8 @@ let apply_manager_operation_content : {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt} : kind successful_manager_operation_result), [] ) - | Transaction {amount; parameters; destination; entrypoint} -> ( + | Transaction + {amount; parameters; destination = Contract destination; entrypoint} -> ( Script.force_decode_in_context ~consume_deserialization_gas ctxt @@ -986,6 +1023,51 @@ let apply_manager_operation_content : } in (ctxt, result, operations) )) + | Transaction + {amount; parameters; destination = Tx_rollup destination; entrypoint} -> + fail_unless + (Alpha_context.Constants.tx_rollup_enable ctxt) + Tx_rollup_disabled + >>=? fun () -> + fail_unless internal Tx_rollup_non_internal_transaction >>=? fun () -> + fail_unless Tez.(amount = zero) Tx_rollup_non_null_transaction + >>=? fun () -> + if Entrypoint.(entrypoint = Alpha_context.Tx_rollup.deposit_entrypoint) + then + Script.force_decode_in_context + ~consume_deserialization_gas + ctxt + parameters + >>?= fun (parameters, ctxt) -> + Script_ir_translator.parse_tx_rollup_deposit_parameters ctxt parameters + >>?= fun ((ticketer, contents, ty, amount, tx_rollup_l2_address), ctxt) + -> + Tx_rollup.hash_ticket ctxt destination ~contents ~ticketer ~ty + >>?= fun (key_hash, ctxt) -> + Tx_rollup.append_message + ctxt + destination + (Deposit {destination = tx_rollup_l2_address; key_hash; amount}) + >>=? fun (message_size, ctxt) -> + Tx_rollup.get_state ctxt destination >>=? fun {cost_per_byte} -> + Tez.(cost_per_byte *? Int64.of_int message_size) >>?= fun cost -> + Token.transfer ctxt (`Contract payer) `Burned cost + >|=? fun (ctxt, balance_updates) -> + let result = + Transaction_result + { + storage = None; + lazy_storage_diff = None; + balance_updates; + originated_contracts = []; + consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt; + storage_size = Z.zero; + paid_storage_size_diff = Z.zero; + allocated_destination_contract = false; + } + in + (ctxt, result, []) + else fail (Script_tc_errors.No_such_entrypoint entrypoint) | Origination {delegate; script; preorigination; credit} -> Script.force_decode_in_context ~consume_deserialization_gas @@ -1155,6 +1237,29 @@ let apply_manager_operation_content : } in return (ctxt, result, []) + | Tx_rollup_submit_batch {tx_rollup; content} -> + fail_unless (Constants.tx_rollup_enable ctxt) Tx_rollup_disabled + >>=? fun () -> + fail_unless + Compare.Int.( + String.length content + < Constants.tx_rollup_hard_size_limit_per_batch ctxt) + Tx_rollup_submit_too_big + >>=? fun () -> + Tx_rollup.append_message ctxt tx_rollup (Batch content) + >>=? fun (message_size, ctxt) -> + Tx_rollup.get_state ctxt tx_rollup >>=? fun {cost_per_byte} -> + Tez.(cost_per_byte *? Int64.of_int message_size) >>?= fun cost -> + Token.transfer ctxt (`Contract source) `Burned cost + >>=? fun (ctxt, balance_updates) -> + let result = + Tx_rollup_submit_batch_result + { + consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt; + balance_updates; + } + in + return (ctxt, result, []) | Sc_rollup_originate {kind; boot_sector} -> let open Sc_rollup_operations in assert_sc_rollup_feature_enabled ctxt >>=? fun () -> @@ -1374,6 +1479,8 @@ let burn_storage_fees : ( ctxt, storage_limit, Tx_rollup_origination_result {payload with balance_updates} ) + | Tx_rollup_submit_batch_result payload -> + return (ctxt, storage_limit, Tx_rollup_submit_batch_result payload) | Sc_rollup_originate_result payload -> let payer = `Contract payer in Fees.burn_sc_rollup_origination_fees @@ -2694,6 +2801,11 @@ let finalize_application ctxt (mode : finalize_application_mode) protocol_data ~payload_producer ~block_producer liquidity_baking_escape_ema implicit_operations_results ~round ~predecessor ~migration_balance_updates = let level = Alpha_context.Level.current ctxt in + (* We update the [cost_per_byte] state variable of each transaction rollup that has + received incoming messages. *) + Alpha_context.Tx_rollup.update_tx_rollup_at_block_finalization ctxt + >>=? fun ctxt -> + (* Then we finalize the consensus. *) let block_endorsing_power = Consensus.current_endorsement_power ctxt in let consensus_threshold = Constants.consensus_threshold ctxt in are_endorsements_required ctxt ~level:level.level diff --git a/src/proto_alpha/lib_protocol/apply.mli b/src/proto_alpha/lib_protocol/apply.mli index be55532b01cdb67c859de21073e8b4b3c4642bb4..0715fa1142433d05438ec0010830fe7176acf80d 100644 --- a/src/proto_alpha/lib_protocol/apply.mli +++ b/src/proto_alpha/lib_protocol/apply.mli @@ -113,6 +113,12 @@ type error += (* `Branch *) Empty_transaction of Contract.t type error += (* `Permanent *) Tx_rollup_disabled +type error += (* `Permanent *) Tx_rollup_submit_too_big + +type error += (* `Permanent *) Tx_rollup_non_null_transaction + +type error += (* `Permanent *) Tx_rollup_non_internal_transaction + type error += (* `Permanent *) Sc_rollup_feature_disabled type error += (* `Permanent *) Inconsistent_counters diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml index fa6f00e0e667d2f7934866a8298c50be80e2fe61..82baff4895dcd76a19e682e7676f1ccbb03b713d 100644 --- a/src/proto_alpha/lib_protocol/apply_results.ml +++ b/src/proto_alpha/lib_protocol/apply_results.ml @@ -92,6 +92,11 @@ type _ successful_manager_operation_result = originated_tx_rollup : Tx_rollup.t; } -> Kind.tx_rollup_origination successful_manager_operation_result + | Tx_rollup_submit_batch_result : { + balance_updates : Receipt.balance_updates; + consumed_gas : Gas.Arith.fp; + } + -> Kind.tx_rollup_submit_batch successful_manager_operation_result | Sc_rollup_originate_result : { balance_updates : Receipt.balance_updates; address : Sc_rollup.Address.t; @@ -518,6 +523,33 @@ module Manager_result = struct originated_tx_rollup; }) + let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + make + ~op_case:Operation.Encoding.Manager_operations.tx_rollup_submit_batch_case + ~encoding: + Data_encoding.( + obj3 + (req "balance_updates" Receipt.balance_updates_encoding) + (dft "consumed_gas" Gas.Arith.n_integral_encoding Gas.Arith.zero) + (dft "consumed_milligas" Gas.Arith.n_fp_encoding Gas.Arith.zero)) + ~iselect:(function + | Internal_operation_result + (({operation = Tx_rollup_submit_batch _; _} as op), res) -> + Some (op, res) + | _ -> None) + ~select:(function + | Successful_manager_result (Tx_rollup_submit_batch_result _ as op) -> + Some op + | _ -> None) + ~kind:Kind.Tx_rollup_submit_batch_manager_kind + ~proj:(function + | Tx_rollup_submit_batch_result {balance_updates; consumed_gas} -> + (balance_updates, Gas.Arith.ceil consumed_gas, consumed_gas)) + ~inj:(fun (balance_updates, consumed_gas, consumed_milligas) -> + assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; + Tx_rollup_submit_batch_result + {balance_updates; consumed_gas = consumed_milligas}) + let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_originate_case @@ -690,6 +722,10 @@ let equal_manager_kind : Kind.Tx_rollup_origination_manager_kind ) -> Some Eq | (Kind.Tx_rollup_origination_manager_kind, _) -> None + | ( Kind.Tx_rollup_submit_batch_manager_kind, + Kind.Tx_rollup_submit_batch_manager_kind ) -> + Some Eq + | (Kind.Tx_rollup_submit_batch_manager_kind, _) -> None | ( Kind.Sc_rollup_originate_manager_kind, Kind.Sc_rollup_originate_manager_kind ) -> Some Eq @@ -1056,6 +1092,17 @@ module Encoding = struct Some (op, res) | _ -> None) + let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + make_manager_case + Operation.Encoding.tx_rollup_submit_batch_case + Manager_result.tx_rollup_submit_batch_case + (function + | Contents_and_result + ( (Manager_operation {operation = Tx_rollup_submit_batch _; _} as op), + res ) -> + Some (op, res) + | _ -> None) + let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = make_manager_case Operation.Encoding.sc_rollup_originate_case @@ -1103,6 +1150,7 @@ let contents_result_encoding = make register_global_constant_case; make set_deposits_limit_case; make tx_rollup_origination_case; + make tx_rollup_submit_batch_case; make sc_rollup_originate_case; ] @@ -1146,6 +1194,7 @@ let contents_and_result_encoding = make register_global_constant_case; make set_deposits_limit_case; make tx_rollup_origination_case; + make tx_rollup_submit_batch_case; make sc_rollup_originate_case; ] @@ -1450,6 +1499,32 @@ let kind_equal : } ) -> Some Eq | (Manager_operation {operation = Tx_rollup_origination; _}, _) -> None + | ( Manager_operation {operation = Tx_rollup_submit_batch _; _}, + Manager_operation_result + {operation_result = Applied (Tx_rollup_submit_batch_result _); _} ) -> + Some Eq + | ( Manager_operation {operation = Tx_rollup_submit_batch _; _}, + Manager_operation_result + {operation_result = Backtracked (Tx_rollup_submit_batch_result _, _); _} + ) -> + Some Eq + | ( Manager_operation {operation = Tx_rollup_submit_batch _; _}, + Manager_operation_result + { + operation_result = + Failed (Alpha_context.Kind.Tx_rollup_submit_batch_manager_kind, _); + _; + } ) -> + Some Eq + | ( Manager_operation {operation = Tx_rollup_submit_batch _; _}, + Manager_operation_result + { + operation_result = + Skipped Alpha_context.Kind.Tx_rollup_submit_batch_manager_kind; + _; + } ) -> + Some Eq + | (Manager_operation {operation = Tx_rollup_submit_batch _; _}, _) -> None | ( Manager_operation {operation = Sc_rollup_originate _; _}, Manager_operation_result {operation_result = Applied (Sc_rollup_originate_result _); _} ) -> diff --git a/src/proto_alpha/lib_protocol/apply_results.mli b/src/proto_alpha/lib_protocol/apply_results.mli index 2c520db0df4aacd73b1de7f035013ea265e2aec9..588b38441eef3131b4fd8772d912509350f5942b 100644 --- a/src/proto_alpha/lib_protocol/apply_results.mli +++ b/src/proto_alpha/lib_protocol/apply_results.mli @@ -111,6 +111,8 @@ and _ successful_manager_operation_result = consumed_gas : Gas.Arith.fp; } -> Kind.reveal successful_manager_operation_result + (* TODO: use an intermediary type for this, to distinguish between + transaction to contracts and rollups *) | Transaction_result : { storage : Script.expr option; lazy_storage_diff : Lazy_storage.diffs option; @@ -164,6 +166,11 @@ and _ successful_manager_operation_result = originated_tx_rollup : Tx_rollup.t; } -> Kind.tx_rollup_origination successful_manager_operation_result + | Tx_rollup_submit_batch_result : { + balance_updates : Receipt.balance_updates; + consumed_gas : Gas.Arith.fp; + } + -> Kind.tx_rollup_submit_batch successful_manager_operation_result | Sc_rollup_originate_result : { balance_updates : Receipt.balance_updates; address : Sc_rollup.Address.t; diff --git a/src/proto_alpha/lib_protocol/cache_memory_helpers.ml b/src/proto_alpha/lib_protocol/cache_memory_helpers.ml index 83bdeb3484941756a3f0a5b744b4dced12b82ec3..663abb687c6a7871a2ba3795ccfff0dbbba3ca28 100644 --- a/src/proto_alpha/lib_protocol/cache_memory_helpers.ml +++ b/src/proto_alpha/lib_protocol/cache_memory_helpers.ml @@ -118,6 +118,8 @@ let bytes_size b = string_size_gen (Bytes.length b) let string_size s = string_size_gen (String.length s) +let blake2b_hash_size = header_size +! word_size +! string_size_gen 20 + let ret_adding (nodes, size) added = (nodes, size +! added) let ret_succ_adding (nodes, size) added = (Nodes.succ nodes, size +! added) diff --git a/src/proto_alpha/lib_protocol/constants_repr.ml b/src/proto_alpha/lib_protocol/constants_repr.ml index 3b239e150a6d2367af139afbd9bbf21ecca7da14..d2f8643fa030a2b0b6599e2d2b89b87738e9e8cc 100644 --- a/src/proto_alpha/lib_protocol/constants_repr.ml +++ b/src/proto_alpha/lib_protocol/constants_repr.ml @@ -174,6 +174,9 @@ type parametric = { initial_seed : State_hash.t option; tx_rollup_enable : bool; tx_rollup_origination_size : int; + tx_rollup_hard_size_limit_per_batch : int; + tx_rollup_hard_size_limit_per_inbox : int; + tx_rollup_initial_inbox_cost_per_byte : Tez_repr.t; sc_rollup_enable : bool; sc_rollup_origination_size : int; } @@ -215,7 +218,11 @@ let parametric_encoding = c.double_baking_punishment, c.ratio_of_frozen_deposits_slashed_per_double_endorsement, c.initial_seed ), - ( (c.tx_rollup_enable, c.tx_rollup_origination_size), + ( ( c.tx_rollup_enable, + c.tx_rollup_origination_size, + c.tx_rollup_hard_size_limit_per_batch, + c.tx_rollup_hard_size_limit_per_inbox, + c.tx_rollup_initial_inbox_cost_per_byte ), (c.sc_rollup_enable, c.sc_rollup_origination_size) ) ) ) ) )) (fun ( ( preserved_cycles, blocks_per_cycle, @@ -250,7 +257,11 @@ let parametric_encoding = double_baking_punishment, ratio_of_frozen_deposits_slashed_per_double_endorsement, initial_seed ), - ( (tx_rollup_enable, tx_rollup_origination_size), + ( ( tx_rollup_enable, + tx_rollup_origination_size, + tx_rollup_hard_size_limit_per_batch, + tx_rollup_hard_size_limit_per_inbox, + tx_rollup_initial_inbox_cost_per_byte ), (sc_rollup_enable, sc_rollup_origination_size) ) ) ) ) ) -> { preserved_cycles; @@ -288,6 +299,9 @@ let parametric_encoding = initial_seed; tx_rollup_enable; tx_rollup_origination_size; + tx_rollup_hard_size_limit_per_batch; + tx_rollup_hard_size_limit_per_inbox; + tx_rollup_initial_inbox_cost_per_byte; sc_rollup_enable; sc_rollup_origination_size; }) @@ -339,9 +353,14 @@ let parametric_encoding = ratio_encoding) (opt "initial_seed" State_hash.encoding)) (merge_objs - (obj2 + (obj5 (req "tx_rollup_enable" bool) - (req "tx_rollup_origination_size" int31)) + (req "tx_rollup_origination_size" int31) + (req "tx_rollup_hard_size_limit_per_batch" int31) + (req "tx_rollup_hard_size_limit_per_inbox" int31) + (req + "tx_rollup_initial_inbox_cost_per_byte" + Tez_repr.encoding)) (obj2 (req "sc_rollup_enable" bool) (req "sc_rollup_origination_size" int31))))))) diff --git a/src/proto_alpha/lib_protocol/constants_repr.mli b/src/proto_alpha/lib_protocol/constants_repr.mli index 83aef81ec16dc147c25f4983847a7327bc57f5fc..15bc8e2fcfa56c4bce67e00bdc8dfc1bd5dc394d 100644 --- a/src/proto_alpha/lib_protocol/constants_repr.mli +++ b/src/proto_alpha/lib_protocol/constants_repr.mli @@ -121,6 +121,20 @@ type parametric = { initial_seed : State_hash.t option; tx_rollup_enable : bool; tx_rollup_origination_size : int; + (* The maximum size (in bytes) a transaction rollup’s batch of L2 + operations is allowed to take in the inbox. *) + tx_rollup_hard_size_limit_per_batch : int; + (* The maximum size (in bytes) a transaction rollup’s inbox is + allowed to reach. + + See {!Tx_rollup_storage.append_message}. *) + tx_rollup_hard_size_limit_per_inbox : int; + (* The initial cost to add one byte into a transaction rollup’s + inbox. This value then may vary based on the activity of the + rollup, though it can never go down this initial value. + + See {!Tx_rollup_inbox_repr.update_cost_per_byte}. *) + tx_rollup_initial_inbox_cost_per_byte : Tez_repr.t; sc_rollup_enable : bool; sc_rollup_origination_size : int; } diff --git a/src/proto_alpha/lib_protocol/constants_storage.ml b/src/proto_alpha/lib_protocol/constants_storage.ml index e45d154842676d9b50b85f140b300fae94ec6075..959b11789de8277377b8cf3683516694762cb743 100644 --- a/src/proto_alpha/lib_protocol/constants_storage.ml +++ b/src/proto_alpha/lib_protocol/constants_storage.ml @@ -153,6 +153,18 @@ let tx_rollup_origination_size c = let constants = Raw_context.constants c in constants.tx_rollup_origination_size +let tx_rollup_hard_size_limit_per_batch c = + let constants = Raw_context.constants c in + constants.tx_rollup_hard_size_limit_per_batch + +let tx_rollup_hard_size_limit_per_inbox c = + let constants = Raw_context.constants c in + constants.tx_rollup_hard_size_limit_per_inbox + +let tx_rollup_initial_inbox_cost_per_byte c = + let constants = Raw_context.constants c in + constants.tx_rollup_initial_inbox_cost_per_byte + let ratio_of_frozen_deposits_slashed_per_double_endorsement c = let constants = Raw_context.constants c in constants.ratio_of_frozen_deposits_slashed_per_double_endorsement diff --git a/src/proto_alpha/lib_protocol/constants_storage.mli b/src/proto_alpha/lib_protocol/constants_storage.mli index bdd45590640e1d67d4a42e6dd4a6f68f422d6f58..ad9c16898c4829f8f55e34aa4e5c6826ddccad40 100644 --- a/src/proto_alpha/lib_protocol/constants_storage.mli +++ b/src/proto_alpha/lib_protocol/constants_storage.mli @@ -87,6 +87,12 @@ val tx_rollup_enable : Raw_context.t -> bool val tx_rollup_origination_size : Raw_context.t -> int +val tx_rollup_hard_size_limit_per_batch : Raw_context.t -> int + +val tx_rollup_hard_size_limit_per_inbox : Raw_context.t -> int + +val tx_rollup_initial_inbox_cost_per_byte : Raw_context.t -> Tez_repr.t + val ratio_of_frozen_deposits_slashed_per_double_endorsement : Raw_context.t -> Constants_repr.ratio diff --git a/src/proto_alpha/lib_protocol/contract_repr.ml b/src/proto_alpha/lib_protocol/contract_repr.ml index 69f3093544c3f612a42241286636875f4042cd9c..290034601d6269130b61eb537068fc3582730e14 100644 --- a/src/proto_alpha/lib_protocol/contract_repr.ml +++ b/src/proto_alpha/lib_protocol/contract_repr.ml @@ -41,10 +41,6 @@ end) type contract = t -let blake2b_hash_size = - let open Cache_memory_helpers in - header_size +! word_size +! string_size_gen 20 - let public_key_hash_in_memory_size = let open Cache_memory_helpers in header_size +! word_size +! blake2b_hash_size @@ -81,6 +77,25 @@ let pp_short ppf = function | Implicit pbk -> Signature.Public_key_hash.pp_short ppf pbk | Originated h -> Contract_hash.pp_short ppf h +let cases is_contract to_contract = + Data_encoding. + [ + case + (Tag 0) + ~title:"Implicit" + Signature.Public_key_hash.encoding + (fun k -> + match is_contract k with Some (Implicit k) -> Some k | _ -> None) + (fun k -> to_contract (Implicit k)); + case + (Tag 1) + (Fixed.add_padding Contract_hash.encoding 1) + ~title:"Originated" + (fun k -> + match is_contract k with Some (Originated k) -> Some k | _ -> None) + (fun k -> to_contract (Originated k)); + ] + let encoding = let open Data_encoding in def @@ -90,23 +105,7 @@ let encoding = "A contract notation as given to an RPC or inside scripts. Can be a \ base58 implicit contract hash or a base58 originated contract hash." @@ splitted - ~binary: - (union - ~tag_size:`Uint8 - [ - case - (Tag 0) - ~title:"Implicit" - Signature.Public_key_hash.encoding - (function Implicit k -> Some k | _ -> None) - (fun k -> Implicit k); - case - (Tag 1) - (Fixed.add_padding Contract_hash.encoding 1) - ~title:"Originated" - (function Originated k -> Some k | _ -> None) - (fun k -> Originated k); - ]) + ~binary:(union ~tag_size:`Uint8 @@ cases (fun x -> Some x) (fun x -> x)) ~json: (conv to_b58check diff --git a/src/proto_alpha/lib_protocol/contract_repr.mli b/src/proto_alpha/lib_protocol/contract_repr.mli index 05f12822cdbcc51d50b9314438b44685b6a35835..e10aa5f66ccdb1c5887eb368e65f06d636e417b8 100644 --- a/src/proto_alpha/lib_protocol/contract_repr.mli +++ b/src/proto_alpha/lib_protocol/contract_repr.mli @@ -85,6 +85,9 @@ val pp_short : Format.formatter -> contract -> unit (** {2 Serializers} *) +val cases : + ('a -> contract option) -> (contract -> 'a) -> 'a Data_encoding.case list + val encoding : contract Data_encoding.t val rpc_arg : contract RPC_arg.arg diff --git a/src/proto_alpha/lib_protocol/destination_repr.ml b/src/proto_alpha/lib_protocol/destination_repr.ml new file mode 100644 index 0000000000000000000000000000000000000000..197f058b4bc3672a1427eabee237d883112388ac --- /dev/null +++ b/src/proto_alpha/lib_protocol/destination_repr.ml @@ -0,0 +1,113 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = Contract of Contract_repr.t | Tx_rollup of Tx_rollup_repr.t + +let contract k = Contract k + +let tx_rollup k = Tx_rollup k + +include Compare.Make (struct + type nonrec t = t + + let compare l1 l2 = + match (l1, l2) with + | (Contract k1, Contract k2) -> Contract_repr.compare k1 k2 + | (Tx_rollup k1, Tx_rollup k2) -> Tx_rollup_repr.compare k1 k2 + | (Contract _, Tx_rollup _) -> -1 + | (Tx_rollup _, Contract _) -> 1 +end) + +let to_b58check = function + | Contract k -> Contract_repr.to_b58check k + | Tx_rollup k -> Tx_rollup_repr.to_b58check k + +type error += Invalid_destination_b58check of string + +let () = + let open Data_encoding in + register_error_kind + `Permanent + ~id:"destination_repr.invalid_b58check" + ~title:"Destination decoding failed" + ~description: + "Failed to read a valid destination from a b58check_encoding data" + (obj1 (req "input" string)) + (function Invalid_destination_b58check x -> Some x | _ -> None) + (fun x -> Invalid_destination_b58check x) + +let of_b58check s = + match Contract_repr.of_b58check s with + | Ok s -> Ok (Contract s) + | Error _ -> ( + match Tx_rollup_repr.of_b58check s with + | Ok s -> Ok (Tx_rollup s) + | Error _ -> error (Invalid_destination_b58check s)) + +let encoding = + let open Data_encoding in + def + "transaction_destination" + ~title:"A destination of a transaction" + ~description: + "A destination notation compatible with the contract notation as given \ + to an RPC or inside scripts. Can be a base58 implicit contract hash or \ + a base58 originated contract hash." + @@ splitted + ~binary: + (union + ~tag_size:`Uint8 + (Contract_repr.cases + (function Contract x -> Some x | _ -> None) + (fun x -> Contract x) + @ [ + case + (Tag 2) + (Fixed.add_padding Tx_rollup_repr.encoding 1) + ~title:"Tx_rollup" + (function Tx_rollup k -> Some k | _ -> None) + (fun k -> Tx_rollup k); + ])) + ~json: + (conv + to_b58check + (fun s -> + match of_b58check s with + | Ok s -> s + | Error _ -> + Data_encoding.Json.cannot_destruct + "Invalid destination notation.") + string) + +let pp : Format.formatter -> t -> unit = + fun fmt -> function + | Contract k -> Contract_repr.pp fmt k + | Tx_rollup k -> Tx_rollup_repr.pp fmt k + +let in_memory_size = function + | Contract k -> Contract_repr.in_memory_size k + | Tx_rollup _ -> Tx_rollup_repr.in_memory_size diff --git a/src/proto_alpha/lib_protocol/destination_repr.mli b/src/proto_alpha/lib_protocol/destination_repr.mli new file mode 100644 index 0000000000000000000000000000000000000000..c7aeff4537e30b80e50ba8336e1e2869a8cd70f0 --- /dev/null +++ b/src/proto_alpha/lib_protocol/destination_repr.mli @@ -0,0 +1,46 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = Contract of Contract_repr.t | Tx_rollup of Tx_rollup_repr.t + +val contract : Contract_repr.t -> t + +val tx_rollup : Tx_rollup_repr.t -> t + +include Compare.S with type t := t + +val to_b58check : t -> string + +val of_b58check : string -> t tzresult + +val encoding : t Data_encoding.t + +val pp : Format.formatter -> t -> unit + +val in_memory_size : t -> Cache_memory_helpers.sint + +type error += Invalid_destination_b58check of string diff --git a/src/proto_alpha/lib_protocol/dune.inc b/src/proto_alpha/lib_protocol/dune.inc index 42b61fb17400668a960b222231ca183dc95cfd84..c6e168b04ed3e74b9dbc4ebf2ec925246b91aaad 100644 --- a/src/proto_alpha/lib_protocol/dune.inc +++ b/src/proto_alpha/lib_protocol/dune.inc @@ -64,11 +64,14 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end script_repr.mli script_repr.ml cache_memory_helpers.ml contract_repr.mli contract_repr.ml + entrypoint_repr.mli entrypoint_repr.ml tx_rollup_repr.mli tx_rollup_repr.ml + tx_rollup_l2_address_repr.mli tx_rollup_l2_address_repr.ml + tx_rollup_state_repr.mli tx_rollup_state_repr.ml roll_repr_legacy.mli roll_repr_legacy.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml - entrypoint_repr.mli entrypoint_repr.ml + destination_repr.mli destination_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml @@ -79,6 +82,8 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end migration_repr.mli migration_repr.ml raw_context_intf.ml raw_context.mli raw_context.ml + ticket_hash_repr.mli ticket_hash_repr.ml + tx_rollup_inbox_repr.mli tx_rollup_inbox_repr.ml storage_costs.mli storage_costs.ml storage_sigs.ml storage_functors.mli storage_functors.ml @@ -156,6 +161,10 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end voting_services.mli voting_services.ml tx_rollup_services.mli tx_rollup_services.ml alpha_services.mli alpha_services.ml + tx_rollup_l2_operation.mli tx_rollup_l2_operation.ml + tx_rollup_l2_storage.mli tx_rollup_l2_storage.ml + tx_rollup_l2_context.mli tx_rollup_l2_context.ml + tx_rollup_l2_apply.mli tx_rollup_l2_apply.ml main.mli main.ml (:src_dir TEZOS_PROTOCOL)) (action @@ -201,11 +210,14 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end script_repr.mli script_repr.ml cache_memory_helpers.ml contract_repr.mli contract_repr.ml + entrypoint_repr.mli entrypoint_repr.ml tx_rollup_repr.mli tx_rollup_repr.ml + tx_rollup_l2_address_repr.mli tx_rollup_l2_address_repr.ml + tx_rollup_state_repr.mli tx_rollup_state_repr.ml roll_repr_legacy.mli roll_repr_legacy.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml - entrypoint_repr.mli entrypoint_repr.ml + destination_repr.mli destination_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml @@ -216,6 +228,8 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end migration_repr.mli migration_repr.ml raw_context_intf.ml raw_context.mli raw_context.ml + ticket_hash_repr.mli ticket_hash_repr.ml + tx_rollup_inbox_repr.mli tx_rollup_inbox_repr.ml storage_costs.mli storage_costs.ml storage_sigs.ml storage_functors.mli storage_functors.ml @@ -293,6 +307,10 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end voting_services.mli voting_services.ml tx_rollup_services.mli tx_rollup_services.ml alpha_services.mli alpha_services.ml + tx_rollup_l2_operation.mli tx_rollup_l2_operation.ml + tx_rollup_l2_storage.mli tx_rollup_l2_storage.ml + tx_rollup_l2_context.mli tx_rollup_l2_context.ml + tx_rollup_l2_apply.mli tx_rollup_l2_apply.ml main.mli main.ml (:src_dir TEZOS_PROTOCOL)) (action (with-stdout-to %{targets} @@ -338,11 +356,14 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end script_repr.mli script_repr.ml cache_memory_helpers.ml contract_repr.mli contract_repr.ml + entrypoint_repr.mli entrypoint_repr.ml tx_rollup_repr.mli tx_rollup_repr.ml + tx_rollup_l2_address_repr.mli tx_rollup_l2_address_repr.ml + tx_rollup_state_repr.mli tx_rollup_state_repr.ml roll_repr_legacy.mli roll_repr_legacy.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml - entrypoint_repr.mli entrypoint_repr.ml + destination_repr.mli destination_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml @@ -353,6 +374,8 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end migration_repr.mli migration_repr.ml raw_context_intf.ml raw_context.mli raw_context.ml + ticket_hash_repr.mli ticket_hash_repr.ml + tx_rollup_inbox_repr.mli tx_rollup_inbox_repr.ml storage_costs.mli storage_costs.ml storage_sigs.ml storage_functors.mli storage_functors.ml @@ -430,6 +453,10 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end voting_services.mli voting_services.ml tx_rollup_services.mli tx_rollup_services.ml alpha_services.mli alpha_services.ml + tx_rollup_l2_operation.mli tx_rollup_l2_operation.ml + tx_rollup_l2_storage.mli tx_rollup_l2_storage.ml + tx_rollup_l2_context.mli tx_rollup_l2_context.ml + tx_rollup_l2_apply.mli tx_rollup_l2_apply.ml main.mli main.ml) (action (write-file %{targets} @@ -497,11 +524,14 @@ include Tezos_raw_protocol_alpha.Main Script_repr Cache_memory_helpers Contract_repr + Entrypoint_repr Tx_rollup_repr + Tx_rollup_l2_address_repr + Tx_rollup_state_repr Roll_repr_legacy Vote_repr Block_header_repr - Entrypoint_repr + Destination_repr Operation_repr Manager_repr Commitment_repr @@ -512,6 +542,8 @@ include Tezos_raw_protocol_alpha.Main Migration_repr Raw_context_intf Raw_context + Ticket_hash_repr + Tx_rollup_inbox_repr Storage_costs Storage_sigs Storage_functors @@ -589,6 +621,10 @@ include Tezos_raw_protocol_alpha.Main Voting_services Tx_rollup_services Alpha_services + Tx_rollup_l2_operation + Tx_rollup_l2_storage + Tx_rollup_l2_context + Tx_rollup_l2_apply Main)) (install @@ -675,11 +711,14 @@ include Tezos_raw_protocol_alpha.Main script_repr.mli script_repr.ml cache_memory_helpers.ml contract_repr.mli contract_repr.ml + entrypoint_repr.mli entrypoint_repr.ml tx_rollup_repr.mli tx_rollup_repr.ml + tx_rollup_l2_address_repr.mli tx_rollup_l2_address_repr.ml + tx_rollup_state_repr.mli tx_rollup_state_repr.ml roll_repr_legacy.mli roll_repr_legacy.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml - entrypoint_repr.mli entrypoint_repr.ml + destination_repr.mli destination_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml @@ -690,6 +729,8 @@ include Tezos_raw_protocol_alpha.Main migration_repr.mli migration_repr.ml raw_context_intf.ml raw_context.mli raw_context.ml + ticket_hash_repr.mli ticket_hash_repr.ml + tx_rollup_inbox_repr.mli tx_rollup_inbox_repr.ml storage_costs.mli storage_costs.ml storage_sigs.ml storage_functors.mli storage_functors.ml @@ -767,6 +808,10 @@ include Tezos_raw_protocol_alpha.Main voting_services.mli voting_services.ml tx_rollup_services.mli tx_rollup_services.ml alpha_services.mli alpha_services.ml + tx_rollup_l2_operation.mli tx_rollup_l2_operation.ml + tx_rollup_l2_storage.mli tx_rollup_l2_storage.ml + tx_rollup_l2_context.mli tx_rollup_l2_context.ml + tx_rollup_l2_apply.mli tx_rollup_l2_apply.ml main.mli main.ml (:src_dir TEZOS_PROTOCOL)) (action (run %{bin:tezos-protocol-compiler} -no-hash-check .))) diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml index 55f8e60ec3641af37134f149c98966e8da29b8db..38509f641f0396ec24bc05dc162c49f841688d97 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml @@ -1353,6 +1353,10 @@ module Cost_of = struct let sz = Signature.Public_key_hash.size + entrypoint_size in atomic_step_cost (cost_N_ICompare sz sz) + (* This is true as long as the address inside a transaction rollup + is a BLS public key *) + let compare_tx_rollup_l2_address = atomic_step_cost (cost_N_ICompare 48 48) + let compare_chain_id = atomic_step_cost (S.safe_int 30) (* Defunctionalized CPS *) @@ -1382,6 +1386,8 @@ module Cost_of = struct | Timestamp_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_timestamp x y) k | Address_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_address) k + | Tx_rollup_l2_address_key _ -> + (apply [@tailcall]) Gas.(acc +@ compare_tx_rollup_l2_address) k | Chain_id_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_chain_id) k | Pair_key ((tl, _), (tr, _), _) -> (* Reasonable over-approximation of the cost of lexicographic comparison. *) @@ -1682,6 +1688,10 @@ module Cost_of = struct (* Reasonable estimate. *) let contract = Gas.(S.safe_int 2 *@ public_key_readable) + (* This is true as long as the address inside a transaction rollup + is a BLS public key *) + let tx_rollup_l2_address = bls12_381_g1 + (* Balance stored at /contracts/index/hash/balance, on 64 bits *) let contract_exists = Gas.cost_of_repr @@ Storage_costs.read_access ~path_length:4 ~read_bytes:8 @@ -1792,6 +1802,10 @@ module Cost_of = struct (* Reasonable estimate. *) let contract = Gas.(S.safe_int 2 *@ public_key_readable) + (* This is true as long as the address inside a transaction rollup + is a BLS public key *) + let tx_rollup_l2_address = bls12_381_g1 + (* Reuse 006 costs. *) let operation bytes = Script.bytes_node_cost bytes diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/michelson_v1_gas.mli index 2b4674cbcca14a3b96ec508f77ce7cd918f48352..66942329e5489e2e6301292928992e4f5d841fea 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.mli @@ -441,6 +441,8 @@ module Cost_of : sig val contract : Gas.cost + val tx_rollup_l2_address : Gas.cost + val contract_exists : Gas.cost val proof_argument : int -> Gas.cost @@ -493,6 +495,8 @@ module Cost_of : sig val contract : Gas.cost + val tx_rollup_l2_address : Gas.cost + val operation : bytes -> Gas.cost val sapling_transaction : Sapling.transaction -> Gas.cost diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml index c1434b14ec1462e2a9a8fc17e0d9a66ddfe7babc..418b996592c2e435c1731d322e3ae3b317435508 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml @@ -172,6 +172,7 @@ type prim = | T_unit | T_operation | T_address + | T_tx_rollup_l2_address | T_sapling_transaction | T_sapling_state | T_chain_id @@ -215,12 +216,12 @@ let namespace = function | I_SWAP | I_TICKET | I_TOTAL_VOTING_POWER | I_TRANSFER_TOKENS | I_UNIT | I_UNPACK | I_UNPAIR | I_UPDATE | I_VOTING_POWER | I_XOR | I_OPEN_CHEST -> Instr_namespace - | T_address | T_big_map | T_bool | T_bytes | T_chain_id | T_contract | T_int - | T_key | T_key_hash | T_lambda | T_list | T_map | T_mutez | T_nat | T_never - | T_operation | T_option | T_or | T_pair | T_sapling_state - | T_sapling_transaction | T_set | T_signature | T_string | T_timestamp - | T_unit | T_bls12_381_fr | T_bls12_381_g1 | T_bls12_381_g2 | T_ticket - | T_chest_key | T_chest -> + | T_address | T_tx_rollup_l2_address | T_big_map | T_bool | T_bytes + | T_chain_id | T_contract | T_int | T_key | T_key_hash | T_lambda | T_list + | T_map | T_mutez | T_nat | T_never | T_operation | T_option | T_or | T_pair + | T_sapling_state | T_sapling_transaction | T_set | T_signature | T_string + | T_timestamp | T_unit | T_bls12_381_fr | T_bls12_381_g1 | T_bls12_381_g2 + | T_ticket | T_chest_key | T_chest -> Type_namespace | H_constant -> Constant_hash_namespace @@ -376,6 +377,7 @@ let string_of_prim = function | T_unit -> "unit" | T_operation -> "operation" | T_address -> "address" + | T_tx_rollup_l2_address -> "tx_rollup_l2_address" | T_sapling_state -> "sapling_state" | T_sapling_transaction -> "sapling_transaction" | T_chain_id -> "chain_id" @@ -526,6 +528,7 @@ let prim_of_string = function | "unit" -> ok T_unit | "operation" -> ok T_operation | "address" -> ok T_address + | "tx_rollup_l2_address" -> ok T_tx_rollup_l2_address | "sapling_state" -> ok T_sapling_state | "sapling_transaction" -> ok T_sapling_transaction | "chain_id" -> ok T_chain_id @@ -748,6 +751,7 @@ let prim_encoding = ("constant", H_constant); (* Alpha_012 addition *) ("SUB_MUTEZ", I_SUB_MUTEZ); + ("tx_rollup_l2_address", T_tx_rollup_l2_address); (* New instructions must be added here, for backward compatibility of the encoding. *) (* Keep the comment above at the end of the list *) ] diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli b/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli index 3c2a65db73dd45007b72c0b7b90821db4b001c80..8b8e5baf39c345788f3613b1a2f8b8029e334207 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli @@ -43,7 +43,7 @@ type error += a few extra atom types for strings and numbers. This variant represents the values the [Prim] atoms in the Michelson subset of Micheline. Other types (such as ['a Micheline.canonical]) are - frequently parameterized by this type. This gives us a strongly-typed + frequently parameterized by this type. This gives us a strongly-typed subset of Micheline while keeping the set of primitives independent from the definition of Micheline for easier changes. *) @@ -185,6 +185,7 @@ type prim = | T_unit | T_operation | T_address + | T_tx_rollup_l2_address | T_sapling_transaction | T_sapling_state | T_chain_id diff --git a/src/proto_alpha/lib_protocol/operation_repr.ml b/src/proto_alpha/lib_protocol/operation_repr.ml index 15a222a675603600c02a889be11bfe551b0ddcc7..6f9174379a1996a04663c8e8783bdd9f5dc02148 100644 --- a/src/proto_alpha/lib_protocol/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/operation_repr.ml @@ -73,6 +73,8 @@ module Kind = struct type tx_rollup_origination = Tx_rollup_origination_kind + type tx_rollup_submit_batch = Tx_rollup_submit_batch_kind + type sc_rollup_originate = Sc_rollup_originate_kind type 'a manager = @@ -83,6 +85,7 @@ module Kind = struct | Register_global_constant_manager_kind : register_global_constant manager | Set_deposits_limit_manager_kind : set_deposits_limit manager | Tx_rollup_origination_manager_kind : tx_rollup_origination manager + | Tx_rollup_submit_batch_manager_kind : tx_rollup_submit_batch manager | Sc_rollup_originate_manager_kind : sc_rollup_originate manager end @@ -241,7 +244,7 @@ and _ manager_operation = amount : Tez_repr.tez; parameters : Script_repr.lazy_expr; entrypoint : Entrypoint_repr.t; - destination : Contract_repr.contract; + destination : Destination_repr.t; } -> Kind.transaction manager_operation | Origination : { @@ -262,6 +265,11 @@ and _ manager_operation = Tez_repr.t option -> Kind.set_deposits_limit manager_operation | Tx_rollup_origination : Kind.tx_rollup_origination manager_operation + | Tx_rollup_submit_batch : { + tx_rollup : Tx_rollup_repr.t; + content : string; + } + -> Kind.tx_rollup_submit_batch manager_operation | Sc_rollup_originate : { kind : Sc_rollup_repr.Kind.t; boot_sector : Sc_rollup_repr.PVM.boot_sector; @@ -279,6 +287,7 @@ let manager_kind : type kind. kind manager_operation -> kind Kind.manager = | Register_global_constant _ -> Kind.Register_global_constant_manager_kind | Set_deposits_limit _ -> Kind.Set_deposits_limit_manager_kind | Tx_rollup_origination -> Kind.Tx_rollup_origination_manager_kind + | Tx_rollup_submit_batch _ -> Kind.Tx_rollup_submit_batch_manager_kind | Sc_rollup_originate _ -> Kind.Sc_rollup_originate_manager_kind type 'kind internal_operation = { @@ -384,7 +393,7 @@ module Encoding = struct encoding = obj3 (req "amount" Tez_repr.encoding) - (req "destination" Contract_repr.encoding) + (req "destination" Destination_repr.encoding) (opt "parameters" (obj2 @@ -495,6 +504,26 @@ module Encoding = struct inj = (fun () -> Tx_rollup_origination); } + let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + MCase + { + tag = tx_rollup_operation_tag_offset + 1; + name = "tx_rollup_submit_batch"; + encoding = + obj2 + (req "rollup" Tx_rollup_repr.encoding) + (req "content" Data_encoding.string); + select = + (function + | Manager (Tx_rollup_submit_batch _ as op) -> Some op | _ -> None); + proj = + (function + | Tx_rollup_submit_batch {tx_rollup; content} -> (tx_rollup, content)); + inj = + (fun (tx_rollup, content) -> + Tx_rollup_submit_batch {tx_rollup; content}); + } + let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = MCase { @@ -534,6 +563,7 @@ module Encoding = struct make register_global_constant_case; make set_deposits_limit_case; make tx_rollup_origination_case; + make tx_rollup_submit_batch_case; make sc_rollup_originate_case; ] end @@ -838,6 +868,11 @@ module Encoding = struct tx_rollup_operation_tag_offset Manager_operations.tx_rollup_origination_case + let tx_rollup_submit_batch_case = + make_manager_case + (tx_rollup_operation_tag_offset + 1) + Manager_operations.tx_rollup_submit_batch_case + let sc_rollup_originate_case = make_manager_case sc_rollup_operation_tag_offset @@ -872,6 +907,7 @@ module Encoding = struct make failing_noop_case; make register_global_constant_case; make tx_rollup_origination_case; + make tx_rollup_submit_batch_case; make sc_rollup_originate_case; ] @@ -1074,6 +1110,8 @@ let equal_manager_operation_kind : | (Set_deposits_limit _, _) -> None | (Tx_rollup_origination, Tx_rollup_origination) -> Some Eq | (Tx_rollup_origination, _) -> None + | (Tx_rollup_submit_batch _, Tx_rollup_submit_batch _) -> Some Eq + | (Tx_rollup_submit_batch _, _) -> None | (Sc_rollup_originate _, Sc_rollup_originate _) -> Some Eq | (Sc_rollup_originate _, _) -> None @@ -1151,7 +1189,7 @@ let internal_manager_operation_size (type a) (op : a manager_operation) = (script_lazy_expr_size parameters) (h4w +! int64_size +! Entrypoint_repr.in_memory_size entrypoint - +! Contract_repr.in_memory_size destination) + +! Destination_repr.in_memory_size destination) | Origination {delegate; script; credit = _; preorigination} -> ret_adding (script_repr_size script) @@ -1180,6 +1218,9 @@ let internal_manager_operation_size (type a) (op : a manager_operation) = | Tx_rollup_origination -> (* Tx_rollup_origination operation can’t occur as internal operations *) assert false + | Tx_rollup_submit_batch _ -> + (* Tx_rollup_submit_batch operation can’t occur as internal operations *) + assert false let packed_internal_operation_in_memory_size : packed_internal_operation -> nodes_and_size = function diff --git a/src/proto_alpha/lib_protocol/operation_repr.mli b/src/proto_alpha/lib_protocol/operation_repr.mli index dd279466c4d527949db9fa5587a453e01e1eda82..00bd6eef9f446f785dc3c806036a80bde367f8bc 100644 --- a/src/proto_alpha/lib_protocol/operation_repr.mli +++ b/src/proto_alpha/lib_protocol/operation_repr.mli @@ -98,6 +98,8 @@ module Kind : sig type tx_rollup_origination = Tx_rollup_origination_kind + type tx_rollup_submit_batch = Tx_rollup_submit_batch_kind + type sc_rollup_originate = Sc_rollup_originate_kind type 'a manager = @@ -108,6 +110,7 @@ module Kind : sig | Register_global_constant_manager_kind : register_global_constant manager | Set_deposits_limit_manager_kind : set_deposits_limit manager | Tx_rollup_origination_manager_kind : tx_rollup_origination manager + | Tx_rollup_submit_batch_manager_kind : tx_rollup_submit_batch manager | Sc_rollup_originate_manager_kind : sc_rollup_originate manager end @@ -219,7 +222,7 @@ and _ manager_operation = amount : Tez_repr.tez; parameters : Script_repr.lazy_expr; entrypoint : Entrypoint_repr.t; - destination : Contract_repr.contract; + destination : Destination_repr.t; } -> Kind.transaction manager_operation | Origination : { @@ -240,6 +243,11 @@ and _ manager_operation = Tez_repr.t option -> Kind.set_deposits_limit manager_operation | Tx_rollup_origination : Kind.tx_rollup_origination manager_operation + | Tx_rollup_submit_batch : { + tx_rollup : Tx_rollup_repr.t; + content : string; + } + -> Kind.tx_rollup_submit_batch manager_operation | Sc_rollup_originate : { kind : Sc_rollup_repr.Kind.t; boot_sector : Sc_rollup_repr.PVM.boot_sector; @@ -366,6 +374,9 @@ module Encoding : sig val tx_rollup_origination_case : Kind.tx_rollup_origination Kind.manager case + val tx_rollup_submit_batch_case : + Kind.tx_rollup_submit_batch Kind.manager case + val sc_rollup_originate_case : Kind.sc_rollup_originate Kind.manager case module Manager_operations : sig @@ -394,6 +405,8 @@ module Encoding : sig val tx_rollup_origination_case : Kind.tx_rollup_origination case + val tx_rollup_submit_batch_case : Kind.tx_rollup_submit_batch case + val sc_rollup_originate_case : Kind.sc_rollup_originate case end end diff --git a/src/proto_alpha/lib_protocol/raw_context.ml b/src/proto_alpha/lib_protocol/raw_context.ml index e4b318e6b5512e553538c6dfa8dc5b7094260cfe..bb5e2eb7c7d58e1f2ef8d1963a2701d7e6ceec5c 100644 --- a/src/proto_alpha/lib_protocol/raw_context.ml +++ b/src/proto_alpha/lib_protocol/raw_context.ml @@ -911,8 +911,14 @@ let prepare_first_block ~level ~timestamp ctxt = {numerator = 1; denominator = 2}; initial_seed = None; tx_rollup_enable = false; - (* TODO: https://gitlab.com/tezos/tezos/-/issues/2152 *) + (* TODO: https://gitlab.com/tezos/tezos/-/issues/2152 + Transaction rollups parameters need to be refined, + currently the following values are merely + placeholders. *) tx_rollup_origination_size = 60_000; + tx_rollup_hard_size_limit_per_batch = 5_000; + tx_rollup_hard_size_limit_per_inbox = 100_000; + tx_rollup_initial_inbox_cost_per_byte = c.cost_per_byte; sc_rollup_enable = false; (* The following value is chosen to prevent spam. *) sc_rollup_origination_size = 6_314; diff --git a/src/proto_alpha/lib_protocol/script_comparable.ml b/src/proto_alpha/lib_protocol/script_comparable.ml index 93c58db7b90fec5ebd219c442d0d030a832b916c..5e784aa478ce0434ec41a81a6ea8471c2ab96029 100644 --- a/src/proto_alpha/lib_protocol/script_comparable.ml +++ b/src/proto_alpha/lib_protocol/script_comparable.ml @@ -28,9 +28,14 @@ open Alpha_context open Script_typed_ir let compare_address (x, ex) (y, ey) = - let lres = Contract.compare x y in + let lres = Destination.compare x y in if Compare.Int.(lres = 0) then Entrypoint.compare ex ey else lres +let compare_tx_rollup_l2_address x y = + let x = Bls_signature.pk_to_bytes x in + let y = Bls_signature.pk_to_bytes y in + Bytes.compare x y + type compare_comparable_cont = | Compare_comparable : 'a comparable_ty * 'a * 'a * compare_comparable_cont @@ -57,6 +62,8 @@ let compare_comparable : type a. a comparable_ty -> a -> a -> int = | (Timestamp_key _, x, y) -> (apply [@tailcall]) (Script_timestamp.compare x y) k | (Address_key _, x, y) -> (apply [@tailcall]) (compare_address x y) k + | (Tx_rollup_l2_address_key _, x, y) -> + (apply [@tailcall]) (compare_tx_rollup_l2_address x y) k | (Bytes_key _, x, y) -> (apply [@tailcall]) (Compare.Bytes.compare x y) k | (Chain_id_key _, x, y) -> (apply [@tailcall]) (Chain_id.compare x y) k | (Pair_key ((tl, _), (tr, _), _), (lx, rx), (ly, ry)) -> diff --git a/src/proto_alpha/lib_protocol/script_comparable.mli b/src/proto_alpha/lib_protocol/script_comparable.mli index 8f489511625a709dca26feb925f75b0672bfc2c5..70c1f809d41f82e41df1b7582b235b30a2f43ed4 100644 --- a/src/proto_alpha/lib_protocol/script_comparable.mli +++ b/src/proto_alpha/lib_protocol/script_comparable.mli @@ -27,3 +27,8 @@ val compare_comparable : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> int val compare_address : Script_typed_ir.address -> Script_typed_ir.address -> int + +val compare_tx_rollup_l2_address : + Script_typed_ir.tx_rollup_l2_address -> + Script_typed_ir.tx_rollup_l2_address -> + int diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 4486c4705b4f727b7f1fdf8692f2e0588104a836..22701024602c0fe349b8506d7d429efe39c45a70 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -1015,14 +1015,15 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = (step [@ocaml.tailcall]) (ctxt, sc) gas k ks accu stack | IImplicit_account (_, k) -> let key = accu in - let contract = Contract.implicit_contract key in + let contract = + Destination.Contract (Contract.implicit_contract key) + in let res = (unit_t ~annot:None, (contract, Entrypoint.default)) in (step [@ocaml.tailcall]) g gas k ks res stack | IView (_, View_signature {name; input_ty; output_ty}, k) -> ( let input = accu in let ((c, _entrypoint_is_ignored), stack) = stack in let ctxt = update_context gas ctxt in - Contract.get_script ctxt c >>=? fun (ctxt, script_opt) -> let return_none ctxt = (step [@ocaml.tailcall]) (outdated ctxt, sc) @@ -1032,89 +1033,94 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = None stack in - match script_opt with - | None -> (return_none [@ocaml.tailcall]) ctxt - | Some script -> ( - parse_script - ~legacy:true - ~allow_forged_in_storage:true - ctxt - script - >>=? fun (Ex_script {storage; storage_type; views; _}, ctxt) -> - Gas.consume ctxt (Interp_costs.view_get name views) - >>?= fun ctxt -> - match SMap.find name views with + match c with + | Tx_rollup _ -> (return_none [@ocaml.tailcall]) ctxt + | Contract c -> ( + Contract.get_script ctxt c >>=? fun (ctxt, script_opt) -> + match script_opt with | None -> (return_none [@ocaml.tailcall]) ctxt - | Some view -> ( - let view_result = - Script_ir_translator.parse_view_returning - ctxt - ~legacy:true - storage_type - view - in - trace_eval - (fun () -> - Script_tc_errors.Ill_typed_contract - (Micheline.strip_locations view.view_code, [])) - view_result - >>=? fun (Ex_view f, ctxt) -> - match f with - | Lam - ( { - kloc; - kaft = Item_t (aft_ty, Bot_t); - kbef = Item_t (bef_ty, Bot_t); - kinstr; - }, - _script_view ) -> ( - pair_t - kloc - (input_ty, None, None) - (storage_type, None, None) - ~annot:None - >>?= fun pair_ty -> - let open Gas_monad in - let io_ty = - Script_ir_translator.merge_types - ~error_details:Fast + | Some script -> ( + parse_script + ~legacy:true + ~allow_forged_in_storage:true + ctxt + script + >>=? fun (Ex_script {storage; storage_type; views; _}, ctxt) + -> + Gas.consume ctxt (Interp_costs.view_get name views) + >>?= fun ctxt -> + match SMap.find name views with + | None -> (return_none [@ocaml.tailcall]) ctxt + | Some view -> ( + let view_result = + Script_ir_translator.parse_view_returning + ctxt ~legacy:true - kloc - aft_ty - output_ty - >>$ fun (out_eq, _ty) -> - merge_types - ~error_details:Fast - ~legacy:true - kloc - bef_ty - pair_ty - >|$ fun (in_eq, _ty) -> (out_eq, in_eq) + storage_type + view in - Gas_monad.run ctxt io_ty >>?= fun (eq, ctxt) -> - match eq with - | Error Inconsistent_types_fast -> - (return_none [@ocaml.tailcall]) ctxt - | Ok (Eq, Eq) -> ( - let kkinfo = kinfo_of_kinstr k in - match kkinfo.kstack_ty with - | Item_t (_, s) -> - let kstack_ty = Item_t (output_ty, s) in - let kkinfo = {kkinfo with kstack_ty} in - let ks = KCons (ICons_some (kkinfo, k), ks) in - (step [@ocaml.tailcall]) - ( outdated ctxt, - { - sc with - source = sc.self; - self = c; - amount = Tez.zero; - } ) - (update_local_gas_counter ctxt) - kinstr - (KView_exit (sc, KReturn (stack, ks))) - (input, storage) - (EmptyCell, EmptyCell)))))) + trace_eval + (fun () -> + Script_tc_errors.Ill_typed_contract + (Micheline.strip_locations view.view_code, [])) + view_result + >>=? fun (Ex_view f, ctxt) -> + match f with + | Lam + ( { + kloc; + kaft = Item_t (aft_ty, Bot_t); + kbef = Item_t (bef_ty, Bot_t); + kinstr; + }, + _script_view ) -> ( + pair_t + kloc + (input_ty, None, None) + (storage_type, None, None) + ~annot:None + >>?= fun pair_ty -> + let open Gas_monad in + let io_ty = + Script_ir_translator.merge_types + ~error_details:Fast + ~legacy:true + kloc + aft_ty + output_ty + >>$ fun (out_eq, _ty) -> + merge_types + ~error_details:Fast + ~legacy:true + kloc + bef_ty + pair_ty + >|$ fun (in_eq, _ty) -> (out_eq, in_eq) + in + Gas_monad.run ctxt io_ty >>?= fun (eq, ctxt) -> + match eq with + | Error Inconsistent_types_fast -> + (return_none [@ocaml.tailcall]) ctxt + | Ok (Eq, Eq) -> ( + let kkinfo = kinfo_of_kinstr k in + match kkinfo.kstack_ty with + | Item_t (_, s) -> + let kstack_ty = Item_t (output_ty, s) in + let kkinfo = {kkinfo with kstack_ty} in + let ks = KCons (ICons_some (kkinfo, k), ks) in + (step [@ocaml.tailcall]) + ( outdated ctxt, + { + sc with + source = sc.self; + self = c; + amount = Tez.zero; + } ) + (update_local_gas_counter ctxt) + kinstr + (KView_exit (sc, KReturn (stack, ks))) + (input, storage) + (EmptyCell, EmptyCell))))))) | ICreate_contract { storage_type; @@ -1140,7 +1146,9 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = credit init >>=? fun (res, contract, ctxt, gas) -> - let stack = ((contract, Entrypoint.default), stack) in + let stack = + ((Destination.Contract contract, Entrypoint.default), stack) + in (step [@ocaml.tailcall]) (ctxt, sc) gas k ks res stack | ISet_delegate (_, k) -> let delegate = accu in @@ -1185,16 +1193,16 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = let hash = Raw_hashes.sha512 bytes in (step [@ocaml.tailcall]) g gas k ks hash stack | ISource (_, k) -> - let res = (sc.payer, Entrypoint.default) in + let res = (Destination.Contract sc.payer, Entrypoint.default) in (step [@ocaml.tailcall]) g gas k ks res (accu, stack) | ISender (_, k) -> - let res = (sc.source, Entrypoint.default) in + let res = (Destination.Contract sc.source, Entrypoint.default) in (step [@ocaml.tailcall]) g gas k ks res (accu, stack) | ISelf (_, ty, entrypoint, k) -> - let res = (ty, (sc.self, entrypoint)) in + let res = (ty, (Destination.Contract sc.self, entrypoint)) in (step [@ocaml.tailcall]) g gas k ks res (accu, stack) | ISelf_address (_, k) -> - let res = (sc.self, Entrypoint.default) in + let res = (Destination.Contract sc.self, Entrypoint.default) in (step [@ocaml.tailcall]) g gas k ks res (accu, stack) | IAmount (_, k) -> let accu = sc.amount and stack = (accu, stack) in @@ -1421,7 +1429,10 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = | IRead_ticket (_, k) -> let {ticketer; contents; amount} = accu in let stack = (accu, stack) in - let accu = ((ticketer, Entrypoint.default), (contents, amount)) in + let accu = + ( (Destination.Contract ticketer, Entrypoint.default), + (contents, amount) ) + in (step [@ocaml.tailcall]) g gas k ks accu stack | ISplit_ticket (_, k) -> let ticket = accu and ((amount_a, amount_b), stack) = stack in diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index bcafd60fcf2caadc73a64cd2bfad6549bc2223e7..38afedbe792c4710dbdce366da2697a60a375747 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -512,6 +512,34 @@ let transfer (ctxt, sc) gas amount tp p destination entrypoint = ~temporary:true >>=? fun (p, lazy_storage_diff, ctxt) -> unparse_data ctxt Optimized tp p >>=? fun (p, ctxt) -> + (* The entrypoints of a transaction rollup are polymorphic wrt. the + tickets it can process. However, two Michelson values can have + the same Micheline representation, but different types. What + this means is that when we start the execution of a transaction + rollup, the type of its argument is lost if we just give it the + values provided by the Michelson script. + + To address this issue, we instrument a transfer to a transaction + rollup to inject the exact type of the entrypoint as used by + the smart contract. This allows the transaction rollup to extract + the type of the ticket. *) + (match (destination : Destination.t) with + | Contract _ -> ok (p, ctxt) + | Tx_rollup _ -> + let open Micheline in + (* The entrypoint type is [Pair (Ticket a) tx_rollup_l2_address]. + We are only interested in the ticket type. *) + let extract_ticket_type = function + | Prim (_, T_pair, [Prim (_, T_ticket, [ty], _); _], _) -> ty + | _ -> + (* the implementation of the [CONTRACT] instruction + enforces that this cannot happen *) + assert false + in + Script_ir_translator.unparse_ty ~loc:dummy_location ctxt tp + >|? fun (ty, ctxt) -> + (Seq (dummy_location, [p; extract_ticket_type ty]), ctxt)) + >>?= fun (p, ctxt) -> Gas.consume ctxt (Script.strip_locations_cost p) >>?= fun ctxt -> let operation = Transaction diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 655d8db2d99fcd1c0c6de5db909b43f13b4617d0..433c25842b7d0e31705278f22a27eb6967a5db60 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -170,6 +170,7 @@ let rec ty_of_comparable_ty : type a. a comparable_ty -> a ty = function | Key_key tname -> Key_t tname | Timestamp_key tname -> Timestamp_t tname | Address_key tname -> Address_t tname + | Tx_rollup_l2_address_key tname -> Tx_rollup_l2_address_t tname | Chain_id_key tname -> Chain_id_t tname | Pair_key ((l, al), (r, ar), tname) -> Pair_t @@ -205,6 +206,8 @@ let rec unparse_comparable_ty_uncarbonated : | Timestamp_key meta -> Prim (loc, T_timestamp, [], unparse_type_annot meta.annot) | Address_key meta -> Prim (loc, T_address, [], unparse_type_annot meta.annot) + | Tx_rollup_l2_address_key meta -> + Prim (loc, T_tx_rollup_l2_address, [], unparse_type_annot meta.annot) | Chain_id_key meta -> Prim (loc, T_chain_id, [], unparse_type_annot meta.annot) | Pair_key ((l, al), (r, ar), meta) -> ( @@ -257,6 +260,8 @@ let rec unparse_ty_uncarbonated : | Key_t meta -> prim (T_key, [], unparse_type_annot meta.annot) | Timestamp_t meta -> prim (T_timestamp, [], unparse_type_annot meta.annot) | Address_t meta -> prim (T_address, [], unparse_type_annot meta.annot) + | Tx_rollup_l2_address_t meta -> + prim (T_tx_rollup_l2_address, [], unparse_type_annot meta.annot) | Operation_t meta -> prim (T_operation, [], unparse_type_annot meta.annot) | Chain_id_t meta -> prim (T_chain_id, [], unparse_type_annot meta.annot) | Never_t meta -> prim (T_never, [], unparse_type_annot meta.annot) @@ -374,6 +379,7 @@ let[@coq_axiom_with_reason "gadt"] rec comparable_ty_of_ty : | Key_t tname -> ok (Key_key tname, ctxt) | Timestamp_t tname -> ok (Timestamp_key tname, ctxt) | Address_t tname -> ok (Address_key tname, ctxt) + | Tx_rollup_l2_address_t tname -> ok (Tx_rollup_l2_address_key tname, ctxt) | Chain_id_t tname -> ok (Chain_id_key tname, ctxt) | Pair_t ((l, al, _), (r, ar, _), pname) -> comparable_ty_of_ty ctxt loc l >>? fun (lty, ctxt) -> @@ -418,6 +424,7 @@ let name_of_ty : type a. a ty -> type_annot option = function | Key_t meta -> meta.annot | Timestamp_t meta -> meta.annot | Address_t meta -> meta.annot + | Tx_rollup_l2_address_t meta -> meta.annot | Signature_t meta -> meta.annot | Operation_t meta -> meta.annot | Chain_id_t meta -> meta.annot @@ -470,16 +477,35 @@ let unparse_address ~loc ctxt mode (c, entrypoint) = | Optimized | Optimized_legacy -> let bytes = Data_encoding.Binary.to_bytes_exn - Data_encoding.(tup2 Contract.encoding Entrypoint.value_encoding) + Data_encoding.(tup2 Destination.encoding Entrypoint.value_encoding) (c, entrypoint) in (Bytes (loc, bytes), ctxt) | Readable -> let notation = - Contract.to_b58check c ^ Entrypoint.to_address_suffix entrypoint + Destination.to_b58check c ^ Entrypoint.to_address_suffix entrypoint in (String (loc, notation), ctxt) +let unparse_tx_rollup_l2_address ~loc ctxt mode tx_address = + Gas.consume ctxt Unparse_costs.contract >|? fun ctxt -> + match mode with + | Optimized | Optimized_legacy -> + let bytes = + Data_encoding.Binary.to_bytes_exn + Tx_rollup_l2_address.encoding + tx_address + in + (Bytes (loc, bytes), ctxt) + | Readable -> + (* TODO: Use the b58 encoding when it is available *) + let bytes = + Data_encoding.Binary.to_bytes_exn + Tx_rollup_l2_address.encoding + tx_address + in + (Bytes (loc, bytes), ctxt) + let unparse_contract ~loc ctxt mode (_, address) = unparse_address ~loc ctxt mode address @@ -650,6 +676,8 @@ let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : | (Timestamp_key _, t) -> Lwt.return @@ unparse_timestamp ~loc ctxt mode t | (Address_key _, address) -> Lwt.return @@ unparse_address ~loc ctxt mode address + | (Tx_rollup_l2_address_key _, address) -> + Lwt.return @@ unparse_tx_rollup_l2_address ~loc ctxt mode address | (Signature_key _, s) -> Lwt.return @@ unparse_signature ~loc ctxt mode s | (Mutez_key _, v) -> Lwt.return @@ unparse_mutez ~loc ctxt v | (Key_key _, k) -> Lwt.return @@ unparse_key ~loc ctxt mode k @@ -702,8 +730,8 @@ let hash_comparable_data ctxt typ data = let check_dupable_comparable_ty : type a. a comparable_ty -> unit = function | Unit_key _ | Never_key _ | Int_key _ | Nat_key _ | Signature_key _ | String_key _ | Bytes_key _ | Mutez_key _ | Bool_key _ | Key_hash_key _ - | Key_key _ | Timestamp_key _ | Chain_id_key _ | Address_key _ | Pair_key _ - | Union_key _ | Option_key _ -> + | Key_key _ | Timestamp_key _ | Chain_id_key _ | Address_key _ + | Tx_rollup_l2_address_key _ | Pair_key _ | Union_key _ | Option_key _ -> () let rec check_dupable_ty : @@ -722,6 +750,7 @@ let rec check_dupable_ty : | Key_t _ -> ok ctxt | Timestamp_t _ -> ok ctxt | Address_t _ -> ok ctxt + | Tx_rollup_l2_address_t _ -> ok ctxt | Bool_t _ -> ok ctxt | Contract_t (_, _) -> ok ctxt | Operation_t _ -> ok ctxt @@ -856,6 +885,8 @@ let rec merge_comparable_types : return (fun annot -> Chain_id_key annot) Eq annot_a annot_b | (Address_key annot_a, Address_key annot_b) -> return (fun annot -> Address_key annot) Eq annot_a annot_b + | (Tx_rollup_l2_address_key annot_a, Tx_rollup_l2_address_key annot_b) -> + return (fun annot -> Tx_rollup_l2_address_key annot) Eq annot_a annot_b | ( Pair_key ((left_a, annot_left_a), (right_a, annot_right_a), annot_a), Pair_key ((left_b, annot_left_b), (right_b, annot_right_b), annot_b) ) -> @@ -990,6 +1021,8 @@ let merge_types : return (fun tname -> Timestamp_t tname) Eq tn1 tn2 | (Address_t tn1, Address_t tn2) -> return (fun tname -> Address_t tname) Eq tn1 tn2 + | (Tx_rollup_l2_address_t tn1, Tx_rollup_l2_address_t tn2) -> + return (fun tname -> Tx_rollup_l2_address_t tname) Eq tn1 tn2 | (Bool_t tn1, Bool_t tn2) -> return (fun tname -> Bool_t tname) Eq tn1 tn2 | (Chain_id_t tn1, Chain_id_t tn2) -> @@ -1260,6 +1293,9 @@ let[@coq_struct "ty"] rec parse_comparable_ty : | Prim (loc, T_address, [], annot) -> parse_type_annot loc annot >|? fun annot -> (Ex_comparable_ty (address_key ~annot), ctxt) + | Prim (loc, T_tx_rollup_l2_address, [], annot) -> + parse_type_annot loc annot >|? fun annot -> + (Ex_comparable_ty (tx_rollup_l2_address_key ~annot), ctxt) | Prim ( loc, (( T_unit | T_never | T_int | T_nat | T_string | T_bytes | T_mutez @@ -1501,6 +1537,9 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : | Prim (loc, T_address, [], annot) -> parse_type_annot loc annot >>? fun annot -> ok (Ex_ty (address_t ~annot), ctxt) + | Prim (loc, T_tx_rollup_l2_address, [], annot) -> + parse_type_annot loc annot >>? fun annot -> + ok (Ex_ty (tx_rollup_l2_address_t ~annot), ctxt) | Prim (loc, T_signature, [], annot) -> parse_type_annot loc annot >>? fun annot -> ok (Ex_ty (signature_t ~annot), ctxt) @@ -1675,8 +1714,9 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : | Prim ( loc, (( T_unit | T_signature | T_int | T_nat | T_string | T_bytes | T_mutez - | T_bool | T_key | T_key_hash | T_timestamp | T_address | T_chain_id - | T_operation | T_never ) as prim), + | T_bool | T_key | T_key_hash | T_timestamp | T_address + | T_tx_rollup_l2_address | T_chain_id | T_operation | T_never ) as + prim), l, _ ) -> error (Invalid_arity (loc, prim, 0, List.length l)) @@ -1721,6 +1761,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : T_bls12_381_g2; T_bls12_381_fr; T_ticket; + T_tx_rollup_l2_address; ] and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_ty @@ -1819,6 +1860,7 @@ let check_packable ~legacy loc root = | Key_t _ -> Result.return_unit | Timestamp_t _ -> Result.return_unit | Address_t _ -> Result.return_unit + | Tx_rollup_l2_address_t _ -> Result.return_unit | Bool_t _ -> Result.return_unit | Chain_id_t _ -> Result.return_unit | Never_t _ -> Result.return_unit @@ -2249,7 +2291,7 @@ let parse_address ctxt : Script.node -> (address * context) tzresult = function Gas.consume ctxt Typecheck_costs.contract >>? fun ctxt -> match Data_encoding.Binary.of_bytes_opt - Data_encoding.(tup2 Contract.encoding Entrypoint.value_encoding) + Data_encoding.(tup2 Destination.encoding Entrypoint.value_encoding) bytes with | Some addr -> Ok (addr, ctxt) @@ -2267,7 +2309,27 @@ let parse_address ctxt : Script.node -> (address * context) tzresult = function Entrypoint.of_string_strict ~loc name >|? fun entrypoint -> (String.sub s 0 pos, entrypoint)) >>? fun (addr, entrypoint) -> - Contract.of_b58check addr >|? fun c -> ((c, entrypoint), ctxt) + Destination.of_b58check addr >|? fun c -> ((c, entrypoint), ctxt) + | expr -> + error @@ Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr) + +let parse_tx_rollup_l2_address ctxt : + Script.node -> (tx_rollup_l2_address * context) tzresult = function + | Bytes (loc, bytes) as expr (* As unparsed with [Optimized]. *) -> ( + Gas.consume ctxt Typecheck_costs.tx_rollup_l2_address >>? fun ctxt -> + match + Data_encoding.Binary.of_bytes_opt Tx_rollup_l2_address.encoding bytes + with + | Some txa -> ok (txa, ctxt) + | None -> + error + @@ Invalid_syntactic_constant + ( loc, + strip_locations expr, + "a valid transaction rollup L2 address" )) + | (String (_, _) as expr) + (* As unparsed with [Readable]. *) + (* TODO: Use the b58 encoding when it is available *) | expr -> error @@ Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr) @@ -2386,6 +2448,8 @@ let[@coq_axiom_with_reason "gadt"] rec parse_comparable_data : Lwt.return @@ traced_no_lwt @@ parse_chain_id ctxt expr | (Address_key _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_address ctxt expr + | (Tx_rollup_l2_address_key _, expr) -> + Lwt.return @@ traced_no_lwt @@ parse_tx_rollup_l2_address ctxt expr | (Pair_key ((tl, _), (tr, _), _), expr) -> let r_witness = comparable_comb_witness1 tr in let parse_l ctxt v = parse_comparable_data ?type_logger ctxt tl v in @@ -2589,6 +2653,8 @@ let[@coq_axiom_with_reason "gadt"] rec parse_data : Lwt.return @@ traced_no_lwt @@ parse_chain_id ctxt expr | (Address_t _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_address ctxt expr + | (Tx_rollup_l2_address_t _, expr) -> + Lwt.return @@ traced_no_lwt @@ parse_tx_rollup_l2_address ctxt expr | (Contract_t (ty, _), expr) -> traced ( parse_address ctxt expr >>?= fun ((c, entrypoint), ctxt) -> @@ -2657,8 +2723,10 @@ let[@coq_axiom_with_reason "gadt"] rec parse_data : if allow_forged then opened_ticket_type (location expr) t >>?= fun ty -> parse_comparable_data ?type_logger ctxt ty expr - >|=? fun (((ticketer, _entrypoint), (contents, amount)), ctxt) -> - ({ticketer; contents; amount}, ctxt) + >>=? fun (((ticketer, _entrypoint), (contents, amount)), ctxt) -> + match ticketer with + | Tx_rollup _ -> fail (Unexpected_ticket_owner ticketer) + | Contract ticketer -> return ({ticketer; contents; amount}, ctxt) else traced_fail (Unexpected_forged_value (location expr)) (* Sets *) | (Set_t (t, _ty_name), (Seq (loc, vs) as expr)) -> @@ -5204,59 +5272,69 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contra context -> Script.location -> arg ty -> - Contract.t -> + Destination.t -> entrypoint:Entrypoint.t -> (context * arg typed_contract) tzresult Lwt.t = - fun ~stack_depth ~legacy ctxt loc arg contract ~entrypoint -> - match Contract.is_implicit contract with - | Some _ -> - if Entrypoint.is_default entrypoint then - (* An implicit account on the "default" entrypoint always exists and has type unit. *) - Lwt.return - ( ty_eq ~legacy:true ctxt loc arg (unit_t ~annot:None) - >|? fun (Eq, ctxt) -> - let contract : arg typed_contract = (arg, (contract, entrypoint)) in - (ctxt, contract) ) - else fail (No_such_entrypoint entrypoint) - | None -> ( - (* Originated account *) - trace (Invalid_contract (loc, contract)) - @@ Contract.get_script_code ctxt contract - >>=? fun (ctxt, code) -> - match code with - | None -> fail (Invalid_contract (loc, contract)) - | Some code -> - Lwt.return - ( Script.force_decode_in_context - ~consume_deserialization_gas:When_needed - ctxt - code - >>? fun (code, ctxt) -> - (* can only fail because of gas *) - parse_toplevel ctxt ~legacy:true code - >>? fun ({arg_type; root_name; _}, ctxt) -> - parse_parameter_ty - ctxt - ~stack_depth:(stack_depth + 1) - ~legacy:true - arg_type - >>? fun (Ex_ty targ, ctxt) -> - (* we don't check targ size here because it's a legacy contract code *) - Gas_monad.run ctxt - @@ find_entrypoint_for_type - ~legacy - ~error_details:Informative - ~full:targ - ~expected:arg - ~root_name - entrypoint - loc - >>? fun (entrypoint_arg, ctxt) -> - entrypoint_arg >|? fun (entrypoint, arg) -> - let contract : arg typed_contract = - (arg, (contract, entrypoint)) - in - (ctxt, contract) )) + fun ~stack_depth ~legacy ctxt loc arg dest ~entrypoint -> + match dest with + | Tx_rollup tx_rollup -> ( + match arg with + | Pair_t ((Ticket_t (_, _), _, _), (Tx_rollup_l2_address_t _, _, _), _) + when Entrypoint.( + entrypoint = Alpha_context.Tx_rollup.deposit_entrypoint) -> + Tx_rollup.get_state ctxt tx_rollup >>=? fun _ -> + return (ctxt, (arg, (dest, entrypoint))) + | _ -> fail (No_such_entrypoint entrypoint)) + | Contract contract -> ( + match Contract.is_implicit contract with + | Some _ -> + if Entrypoint.is_default entrypoint then + (* An implicit account on the "default" entrypoint always exists and has type unit. *) + Lwt.return + ( ty_eq ~legacy:true ctxt loc arg (unit_t ~annot:None) + >|? fun (Eq, ctxt) -> + let contract : arg typed_contract = (arg, (dest, entrypoint)) in + (ctxt, contract) ) + else fail (No_such_entrypoint entrypoint) + | None -> ( + (* Originated account *) + trace (Invalid_contract (loc, contract)) + @@ Contract.get_script_code ctxt contract + >>=? fun (ctxt, code) -> + match code with + | None -> fail (Invalid_contract (loc, contract)) + | Some code -> + Lwt.return + ( Script.force_decode_in_context + ~consume_deserialization_gas:When_needed + ctxt + code + >>? fun (code, ctxt) -> + (* can only fail because of gas *) + parse_toplevel ctxt ~legacy:true code + >>? fun ({arg_type; root_name; _}, ctxt) -> + parse_parameter_ty + ctxt + ~stack_depth:(stack_depth + 1) + ~legacy:true + arg_type + >>? fun (Ex_ty targ, ctxt) -> + (* we don't check targ size here because it's a legacy contract code *) + Gas_monad.run ctxt + @@ find_entrypoint_for_type + ~legacy + ~error_details:Informative + ~full:targ + ~expected:arg + ~root_name + entrypoint + loc + >>? fun (entrypoint_arg, ctxt) -> + entrypoint_arg >|? fun (entrypoint, arg) -> + let contract : arg typed_contract = + (arg, (dest, entrypoint)) + in + (ctxt, contract) ))) and parse_view_name ctxt : Script.node -> (Script_string.t * context) tzresult = function @@ -5384,76 +5462,92 @@ let parse_contract_for_script : context -> Script.location -> arg ty -> - Contract.t -> + Destination.t -> entrypoint:Entrypoint.t -> (context * arg typed_contract option) tzresult Lwt.t = - fun ctxt loc arg contract ~entrypoint -> - match Contract.is_implicit contract with - | Some _ -> - if Entrypoint.is_default entrypoint then - (* An implicit account on the "default" entrypoint always exists and has type unit. *) - Lwt.return - ( Gas_monad.run ctxt - @@ merge_types - ~legacy:true - ~error_details:Fast - loc - arg - (unit_t ~annot:None) - >|? fun (eq_ty, ctxt) -> - match eq_ty with - | Ok (Eq, _ty) -> - let contract : arg typed_contract = - (arg, (contract, entrypoint)) - in - (ctxt, Some contract) - | Error Inconsistent_types_fast -> (ctxt, None) ) - else - Lwt.return - ( Gas.consume ctxt Typecheck_costs.parse_instr_cycle >|? fun ctxt -> - (* An implicit account on any other entrypoint is not a valid contract. *) - (ctxt, None) ) - | None -> ( - (* Originated account *) - trace (Invalid_contract (loc, contract)) - @@ Contract.get_script_code ctxt contract - >>=? fun (ctxt, code) -> - match code with - | None -> return (ctxt, None) - | Some code -> - Lwt.return - ( Script.force_decode_in_context - ~consume_deserialization_gas:When_needed - ctxt - code - >>? fun (code, ctxt) -> - (* can only fail because of gas *) - match parse_toplevel ctxt ~legacy:true code with - | Error _ -> error (Invalid_contract (loc, contract)) - | Ok ({arg_type; root_name; _}, ctxt) -> ( - match - parse_parameter_ty ctxt ~stack_depth:0 ~legacy:true arg_type - with + fun ctxt loc arg dest ~entrypoint -> + match dest with + | Tx_rollup tx_rollup -> ( + match arg with + | Pair_t ((Ticket_t (_, _), _, _), (Tx_rollup_l2_address_t _, _, _), _) + when Entrypoint.( + entrypoint = Alpha_context.Tx_rollup.deposit_entrypoint) -> ( + Tx_rollup.get_state_opt ctxt tx_rollup >|=? function + | Some _ -> (ctxt, Some (arg, (dest, entrypoint))) + | None -> (ctxt, None)) + | _ -> return (ctxt, None)) + | Contract contract -> ( + match Contract.is_implicit contract with + | Some _ -> + if Entrypoint.is_default entrypoint then + (* An implicit account on the "default" entrypoint always exists and has type unit. *) + Lwt.return + ( Gas_monad.run ctxt + @@ merge_types + ~legacy:true + ~error_details:Fast + loc + arg + (unit_t ~annot:None) + >|? fun (eq_ty, ctxt) -> + match eq_ty with + | Ok (Eq, _ty) -> + let contract : arg typed_contract = + (arg, (dest, entrypoint)) + in + (ctxt, Some contract) + | Error Inconsistent_types_fast -> (ctxt, None) ) + else + Lwt.return + ( Gas.consume ctxt Typecheck_costs.parse_instr_cycle + >|? fun ctxt -> + (* An implicit account on any other entrypoint is not a valid contract. *) + (ctxt, None) ) + | None -> ( + (* Originated account *) + trace (Invalid_contract (loc, contract)) + @@ Contract.get_script_code ctxt contract + >>=? fun (ctxt, code) -> + match code with + | None -> return (ctxt, None) + | Some code -> + Lwt.return + ( Script.force_decode_in_context + ~consume_deserialization_gas:When_needed + ctxt + code + >>? fun (code, ctxt) -> + (* can only fail because of gas *) + match parse_toplevel ctxt ~legacy:true code with | Error _ -> error (Invalid_contract (loc, contract)) - | Ok (Ex_ty targ, ctxt) -> ( - (* we don't check targ size here because it's a legacy contract code *) - Gas_monad.run ctxt - @@ find_entrypoint_for_type - ~legacy:false - ~error_details:Fast - ~full:targ - ~expected:arg - ~root_name - entrypoint - loc - >|? fun (entrypoint_arg, ctxt) -> - match entrypoint_arg with - | Ok (entrypoint, arg) -> - let contract : arg typed_contract = - (arg, (contract, entrypoint)) - in - (ctxt, Some contract) - | Error Inconsistent_types_fast -> (ctxt, None))) )) + | Ok ({arg_type; root_name; _}, ctxt) -> ( + match + parse_parameter_ty + ctxt + ~stack_depth:0 + ~legacy:true + arg_type + with + | Error _ -> error (Invalid_contract (loc, contract)) + | Ok (Ex_ty targ, ctxt) -> ( + (* we don't check targ size here because it's a legacy contract code *) + Gas_monad.run ctxt + @@ find_entrypoint_for_type + ~legacy:false + ~error_details:Fast + ~full:targ + ~expected:arg + ~root_name + entrypoint + loc + >|? fun (entrypoint_arg, ctxt) -> + match entrypoint_arg with + | Ok (entrypoint, arg) -> + let contract : arg typed_contract = + (arg, (dest, entrypoint)) + in + (ctxt, Some contract) + | Error Inconsistent_types_fast -> (ctxt, None))) ))) let parse_code : ?type_logger:type_logger -> @@ -5588,6 +5682,40 @@ let[@coq_axiom_with_reason "gadt"] parse_script : {code_size; code; arg_type; storage; storage_type; views; root_name}, ctxt ) +let parse_tx_rollup_deposit_parameters : + context -> + Script.expr -> + ((Script.node * Script.node * Script.node * int64 * Bls_signature.pk) + * context) + tzresult = + fun ctxt parameters -> + match root parameters with + | Seq + ( _, + [ + Prim + ( _, + D_Pair, + [ + Prim + ( _, + D_Pair, + [ticket; Prim (_, D_Pair, [contents; amount], _)], + _ ); + bls; + ], + _ ); + ty; + ] ) -> + parse_tx_rollup_l2_address ctxt bls >>? fun (bls_key, ctxt) -> + (match amount with + | Int (_, v) when Compare.Z.(v <= Z.of_int64 Int64.max_int) -> + ok @@ Z.to_int64 v + | Int (_, v) -> error @@ Invalid_tx_rollup_ticket_amount v + | expr -> error @@ Invalid_kind (location expr, [Int_kind], kind expr)) + >|? fun i_amount -> ((ticket, contents, ty, i_amount, bls_key), ctxt) + | expr -> error @@ Invalid_kind (location expr, [Prim_kind], kind expr) + let typecheck_code : legacy:bool -> show_types:bool -> @@ -5762,6 +5890,8 @@ let[@coq_axiom_with_reason "gadt"] rec unparse_data : | (Timestamp_t _, t) -> Lwt.return @@ unparse_timestamp ~loc ctxt mode t | (Address_t _, address) -> Lwt.return @@ unparse_address ~loc ctxt mode address + | (Tx_rollup_l2_address_t _, address) -> + Lwt.return @@ unparse_tx_rollup_l2_address ~loc ctxt mode address | (Contract_t _, contract) -> Lwt.return @@ unparse_contract ~loc ctxt mode contract | (Signature_t _, s) -> Lwt.return @@ unparse_signature ~loc ctxt mode s @@ -5804,7 +5934,7 @@ let[@coq_axiom_with_reason "gadt"] rec unparse_data : ~stack_depth mode t - ((ticketer, Entrypoint.default), (contents, amount)) + ((Contract ticketer, Entrypoint.default), (contents, amount)) | (Set_t (t, _), set) -> List.fold_left_es (fun (l, ctxt) item -> @@ -6237,6 +6367,7 @@ let rec has_lazy_storage : type t. t ty -> t has_lazy_storage = | Key_t _ -> False_f | Timestamp_t _ -> False_f | Address_t _ -> False_f + | Tx_rollup_l2_address_t _ -> False_f | Bool_t _ -> False_f | Lambda_t (_, _, _) -> False_f | Set_t (_, _) -> False_f diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli index 24c1d6ef4daaa36c9dfa18a1ad5b2079ce01dc6c..c18430d80f930acf9b16f7522926e5f26e48c542 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.mli +++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli @@ -31,7 +31,7 @@ This mli is organized into roughly three parts: Michelson is encoded in a GADT that preserves certain properties about its type system. If you haven't read about GADT's, check out the relevant section in the Tezos docs: -https://tezos.gitlab.io/developer/gadt.html#generalized-algebraic-data-types-gadts +https://tezos.gitlab.io/developer/gadt.html#generalized-algebraic-data-types-gadts The idea is that type representing a Michelson type, ['a ty], is parameterized by a type 'a. But that 'a can't be just _any_ type; it must be valid according @@ -42,9 +42,9 @@ careful not to accidentally quantify 'a universally, that is "for all 'a, it's scope. We do this by hiding 'a in an existential type. This is what ex_comparable_ty, ex_ty, ex_stack_ty, etc. do. -2. A set of functions dealing with high-level Michelson types: +2. A set of functions dealing with high-level Michelson types: This module also provides functions for interacting with the list, map, -set, and big_map Michelson types. +set, and big_map Michelson types. 3. A set of functions for parsing and typechecking Michelson. Finally, and what you likely came for, the module provides many functions prefixed @@ -392,7 +392,7 @@ val parse_contract : context -> Script.location -> 'a Script_typed_ir.ty -> - Contract.t -> + Destination.t -> entrypoint:Entrypoint.t -> (context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t @@ -400,10 +400,17 @@ val parse_contract_for_script : context -> Script.location -> 'a Script_typed_ir.ty -> - Contract.t -> + Destination.t -> entrypoint:Entrypoint.t -> (context * 'a Script_typed_ir.typed_contract option) tzresult Lwt.t +val parse_tx_rollup_deposit_parameters : + context -> + Script.expr -> + ((Script.node * Script.node * Script.node * int64 * Bls_signature.pk) + * context) + tzresult + val find_entrypoint : error_details:'error_trace error_details -> 't Script_typed_ir.ty -> diff --git a/src/proto_alpha/lib_protocol/script_tc_errors.ml b/src/proto_alpha/lib_protocol/script_tc_errors.ml index f75694fe81040f16dbbad81b947afa57bc3753a6..a7817f2159a18aa0e41e4784d8007cacf9f57a9a 100644 --- a/src/proto_alpha/lib_protocol/script_tc_errors.ml +++ b/src/proto_alpha/lib_protocol/script_tc_errors.ml @@ -68,6 +68,10 @@ type error += Duplicate_entrypoint of Entrypoint.t type error += Unreachable_entrypoint of prim list +type error += Entrypoint_name_too_long of string + +type error += Invalid_tx_rollup_ticket_amount of Z.t + (* Instruction typing errors *) type error += Fail_not_in_tail_position of Script.location @@ -194,6 +198,8 @@ type error += Unparsing_too_many_recursive_calls (* Ticket errors *) type error += Unexpected_ticket of Script.location +type error += Unexpected_ticket_owner of Destination.t + type error += Unexpected_forged_value of Script.location type error += Non_dupable_type of Script.location * Script.expr diff --git a/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml b/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml index fee39265d22477e298277cfb2c67dc86ff54940d..3e893e54e9d3835de788382bd725fa9b472a7e8c 100644 --- a/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml +++ b/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml @@ -791,6 +791,26 @@ let () = (obj1 (req "loc" location_encoding)) (function Unexpected_ticket loc -> Some loc | _ -> None) (fun loc -> Unexpected_ticket loc) ; + (* Unexpected ticket owner*) + register_error_kind + `Permanent + ~id:"michelson_v1.unexpected_ticket_owner" + ~title:"Unexpected ticket owner" + ~description:"Ticket can only be created by a smart contract" + (obj1 (req "ticketer" Destination.encoding)) + (function Unexpected_ticket_owner t -> Some t | _ -> None) + (fun t -> Unexpected_ticket_owner t) ; + (* Invalid tx rollup ticket amount *) + register_error_kind + `Permanent + ~id:"michelson_v1.invalid_tx_rollup_ticket_amount" + ~title:"Invalid ticket amount" + ~description: + "Ticket amount to be deposited in a transaction rollup should fit in a \ + 64bits integer" + (obj1 (req "requested_value" Data_encoding.z)) + (function Invalid_tx_rollup_ticket_amount z -> Some z | _ -> None) + (fun z -> Invalid_tx_rollup_ticket_amount z) ; (* Attempt to duplicate a non-dupable type *) register_error_kind `Permanent diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 1b795de98d01b707f0eeb91ddd5669ce95df9a5f..de4486af51ff0934ffc799581095e2a5656303c9 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -61,7 +61,9 @@ type step_constants = { type never = | -type address = Contract.t * Entrypoint.t +type address = Destination.t * Entrypoint.t + +type tx_rollup_l2_address = Tx_rollup_l2_address.t type ('a, 'b) pair = 'a * 'b @@ -181,6 +183,9 @@ type _ comparable_ty = -> Script_timestamp.t comparable_ty | Chain_id_key : Chain_id.t ty_metadata -> Chain_id.t comparable_ty | Address_key : address ty_metadata -> address comparable_ty + | Tx_rollup_l2_address_key : + tx_rollup_l2_address ty_metadata + -> tx_rollup_l2_address comparable_ty | Pair_key : ('a comparable_ty * field_annot option) * ('b comparable_ty * field_annot option) @@ -210,6 +215,7 @@ let comparable_ty_metadata : type a. a comparable_ty -> a ty_metadata = function | Timestamp_key meta -> meta | Chain_id_key meta -> meta | Address_key meta -> meta + | Tx_rollup_l2_address_key meta -> meta | Pair_key (_, _, meta) -> meta | Union_key (_, _, meta) -> meta | Option_key (_, meta) -> meta @@ -244,6 +250,9 @@ let chain_id_key ~annot = Chain_id_key {annot; size = Type_size.one} let address_key ~annot = Address_key {annot; size = Type_size.one} +let tx_rollup_l2_address_key ~annot = + Tx_rollup_l2_address_key {annot; size = Type_size.one} + let pair_key loc (l, fannot_l) (r, fannot_r) ~annot = Type_size.compound2 loc (comparable_ty_size l) (comparable_ty_size r) >|? fun size -> Pair_key ((l, fannot_l), (r, fannot_r), {annot; size}) @@ -1134,6 +1143,9 @@ and 'ty ty = | Key_t : public_key ty_metadata -> public_key ty | Timestamp_t : Script_timestamp.t ty_metadata -> Script_timestamp.t ty | Address_t : address ty_metadata -> address ty + | Tx_rollup_l2_address_t : + tx_rollup_l2_address ty_metadata + -> tx_rollup_l2_address ty | Bool_t : bool ty_metadata -> bool ty | Pair_t : ('a ty * field_annot option * var_annot option) @@ -1631,6 +1643,7 @@ let ty_metadata : type a. a ty -> a ty_metadata = function | Timestamp_t meta -> meta | Chain_id_t meta -> meta | Address_t meta -> meta + | Tx_rollup_l2_address_t meta -> meta | Pair_t (_, _, meta) -> meta | Union_t (_, _, meta) -> meta | Option_t (_, meta) -> meta @@ -1674,6 +1687,9 @@ let timestamp_t ~annot = Timestamp_t {annot; size = Type_size.one} let address_t ~annot = Address_t {annot; size = Type_size.one} +let tx_rollup_l2_address_t ~annot = + Tx_rollup_l2_address_t {annot; size = Type_size.one} + let bool_t ~annot = Bool_t {annot; size = Type_size.one} let pair_t loc (l, fannot_l, vannot_l) (r, fannot_r, vannot_r) ~annot = @@ -2027,7 +2043,8 @@ let (ty_traverse, comparable_ty_traverse) = match ty with | Unit_key _ | Int_key _ | Nat_key _ | Signature_key _ | String_key _ | Bytes_key _ | Mutez_key _ | Key_hash_key _ | Key_key _ | Timestamp_key _ - | Address_key _ | Bool_key _ | Chain_id_key _ | Never_key _ -> + | Address_key _ | Tx_rollup_l2_address_key _ | Bool_key _ | Chain_id_key _ + | Never_key _ -> (return [@ocaml.tailcall]) () | Pair_key ((ty1, _), (ty2, _), _) -> (next2 [@ocaml.tailcall]) ty1 ty2 | Union_key ((ty1, _), (ty2, _), _) -> (next2 [@ocaml.tailcall]) ty1 ty2 @@ -2040,7 +2057,7 @@ let (ty_traverse, comparable_ty_traverse) = match (ty : t ty) with | Unit_t _ | Int_t _ | Nat_t _ | Signature_t _ | String_t _ | Bytes_t _ | Mutez_t _ | Key_hash_t _ | Key_t _ | Timestamp_t _ | Address_t _ - | Bool_t _ + | Tx_rollup_l2_address_t _ | Bool_t _ | Sapling_transaction_t (_, _) | Sapling_state_t (_, _) | Operation_t _ | Chain_id_t _ | Never_t _ | Bls12_381_g1_t _ @@ -2123,7 +2140,7 @@ let value_traverse (type t) (ty : (t ty, t comparable_ty) union) (x : t) init f match ty with | Unit_t _ | Int_t _ | Nat_t _ | Signature_t _ | String_t _ | Bytes_t _ | Mutez_t _ | Key_hash_t _ | Key_t _ | Timestamp_t _ | Address_t _ - | Bool_t _ + | Tx_rollup_l2_address_t _ | Bool_t _ | Sapling_transaction_t (_, _) | Sapling_state_t (_, _) | Operation_t _ | Chain_id_t _ | Never_t _ | Bls12_381_g1_t _ @@ -2191,7 +2208,8 @@ let value_traverse (type t) (ty : (t ty, t comparable_ty) union) (x : t) init f match ty with | Unit_key _ | Int_key _ | Nat_key _ | Signature_key _ | String_key _ | Bytes_key _ | Mutez_key _ | Key_hash_key _ | Key_key _ | Timestamp_key _ - | Address_key _ | Bool_key _ | Chain_id_key _ | Never_key _ -> + | Address_key _ | Tx_rollup_l2_address_key _ | Bool_key _ | Chain_id_key _ + | Never_key _ -> (return [@ocaml.tailcall]) () | Pair_key ((ty1, _), (ty2, _), _) -> (next2 [@ocaml.tailcall]) ty1 ty2 (fst x) (snd x) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 7c586021b6324af0bc74023f863fffd7ebe40cfb..3d41a41bde611982bf3d5bea680bf05fecab4971 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -42,7 +42,9 @@ type step_constants = { type never = | -type address = Contract.t * Entrypoint.t +type address = Destination.t * Entrypoint.t + +type tx_rollup_l2_address = Tx_rollup_l2_address.t type ('a, 'b) pair = 'a * 'b @@ -87,6 +89,9 @@ type _ comparable_ty = -> Script_timestamp.t comparable_ty | Chain_id_key : Chain_id.t ty_metadata -> Chain_id.t comparable_ty | Address_key : address ty_metadata -> address comparable_ty + | Tx_rollup_l2_address_key : + tx_rollup_l2_address ty_metadata + -> tx_rollup_l2_address comparable_ty | Pair_key : ('a comparable_ty * field_annot option) * ('b comparable_ty * field_annot option) @@ -129,6 +134,9 @@ val chain_id_key : annot:type_annot option -> Chain_id.t comparable_ty val address_key : annot:type_annot option -> address comparable_ty +val tx_rollup_l2_address_key : + annot:type_annot option -> tx_rollup_l2_address comparable_ty + val pair_key : Script.location -> 'a comparable_ty * field_annot option -> @@ -1241,6 +1249,9 @@ and 'ty ty = | Key_t : public_key ty_metadata -> public_key ty | Timestamp_t : Script_timestamp.t ty_metadata -> Script_timestamp.t ty | Address_t : address ty_metadata -> address ty + | Tx_rollup_l2_address_t : + tx_rollup_l2_address ty_metadata + -> tx_rollup_l2_address ty | Bool_t : bool ty_metadata -> bool ty | Pair_t : ('a ty * field_annot option * var_annot option) @@ -1427,6 +1438,8 @@ val timestamp_t : annot:type_annot option -> Script_timestamp.t ty val address_t : annot:type_annot option -> address ty +val tx_rollup_l2_address_t : annot:type_annot option -> tx_rollup_l2_address ty + val bool_t : annot:type_annot option -> bool ty val pair_t : diff --git a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml index c9825ec644bab98a03ebb71257b315e5b9b3033a..0ef1c8bcc920447940f6fe8cf8f2654c8a53576f 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml @@ -49,6 +49,7 @@ let (comparable_ty_size, ty_size) = | Key_key a -> ret_succ_adding accu (base a) | Timestamp_key a -> ret_succ_adding accu (base a) | Address_key a -> ret_succ_adding accu (base a) + | Tx_rollup_l2_address_key a -> ret_succ_adding accu (base a) | Bool_key a -> ret_succ_adding accu (base a) | Chain_id_key a -> ret_succ_adding accu (base a) | Never_key a -> ret_succ_adding accu (base a) @@ -71,6 +72,7 @@ let (comparable_ty_size, ty_size) = | Key_t a -> ret_succ_adding accu @@ base a | Timestamp_t a -> ret_succ_adding accu @@ base a | Address_t a -> ret_succ_adding accu @@ base a + | Tx_rollup_l2_address_t a -> ret_succ_adding accu @@ base a | Bool_t a -> ret_succ_adding accu @@ base a | Operation_t a -> ret_succ_adding accu @@ base a | Chain_id_t a -> ret_succ_adding accu @@ base a @@ -135,10 +137,13 @@ let mutez_size = h2w let timestamp_size x = Script_timestamp.to_zint x |> z_size -let contract_size = Contract.in_memory_size +let destination_size = Destination.in_memory_size let address_size ((c, s) : address) = - h2w +! contract_size c +! Entrypoint.in_memory_size s + h2w +! destination_size c +! Entrypoint.in_memory_size s + +let tx_rollup_l2_address_size (tx : tx_rollup_l2_address) = + h2w +! Tx_rollup_l2_address.in_memory_size tx let view_signature_size (View_signature {name; input_ty; output_ty}) = ret_adding @@ -254,6 +259,8 @@ let rec value_size : | Key_t _ -> ret_succ_adding accu (public_key_size x) | Timestamp_t _ -> ret_succ_adding accu (timestamp_size x) | Address_t _ -> ret_succ_adding accu (address_size x) + | Tx_rollup_l2_address_t _ -> + ret_succ_adding accu (tx_rollup_l2_address_size x) | Bool_t _ -> ret_succ accu | Pair_t (_, _, _) -> ret_succ_adding accu h2w | Union_t (_, _, _) -> ret_succ_adding accu h1w @@ -315,6 +322,8 @@ let rec value_size : | Key_key _ -> ret_succ_adding accu (public_key_size x) | Timestamp_key _ -> ret_succ_adding accu (timestamp_size x) | Address_key _ -> ret_succ_adding accu (address_size x) + | Tx_rollup_l2_address_key _ -> + ret_succ_adding accu (tx_rollup_l2_address_size x) | Bool_key _ -> ret_succ accu | Pair_key (_, _, _) -> ret_succ_adding accu h2w | Union_key (_, _, _) -> ret_succ_adding accu h1w diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index 26e832f5c819c5ee5bad8b7693ceca99a52c91a6..0b229830a723d85036b6ded6466a50144327a86b 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -1622,23 +1622,55 @@ module Tx_rollup = struct let name = ["tx_rollup"] end) - module Indexed_context = + module State = + Make_indexed_data_storage + (Make_subcontext (Registered) (Raw_context) + (struct + let name = ["state"] + end)) + (Make_index (Tx_rollup_repr.Index)) + (Tx_rollup_state_repr) + + module Level_context = Make_indexed_subcontext (Make_subcontext (Registered) (Raw_context) (struct - let name = ["index"] + let name = ["level_index"] + end)) + (Make_index (Raw_level_repr.Index)) + + module Level_tx_rollup_context = + Make_indexed_subcontext + (Make_subcontext (Registered) (Level_context.Raw_context) + (struct + let name = ["tx_rollup_index"] end)) (Make_index (Tx_rollup_repr.Index)) - module State = - Indexed_context.Make_map + let fold ctxt level = + Level_tx_rollup_context.fold_keys (ctxt, level) ~order:`Undefined + + module Inbox_cumulated_size = + Level_tx_rollup_context.Make_map + (struct + let name = ["inbox_size"] + end) + (struct + type t = int + + let encoding = Data_encoding.int31 + end) + + module Inbox_rev_contents = + Level_tx_rollup_context.Make_carbonated_map (struct - let name = ["state"] + let name = ["inbox_contents"] end) (struct - type t = Tx_rollup_repr.state + type t = Tx_rollup_inbox_repr.message_hash list - let encoding = Tx_rollup_repr.state_encoding + let encoding = + Data_encoding.list Tx_rollup_inbox_repr.message_hash_encoding end) end diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index f5e3334e6d563136b6cc398c181968573e90a64b..94f5a00e58a7e05edcf5f7a7253978d1620b68e2 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -693,14 +693,51 @@ module Tenderbake : sig end module Tx_rollup : sig - (** Storage from this submodule must only be accessed through the - module `Tx_rollup_storage`. *) + (** The state of a transaction rollup at a given Tezos level. + This value is updated during the finalization of a Tezos block, + iff an inbox has been created for this rollup at this level. *) module State : Indexed_data_storage with type key = Tx_rollup_repr.t - and type value = Tx_rollup_repr.state + and type value = Tx_rollup_state_repr.t and type t := Raw_context.t + + (** The cumulated size (in bytes) of the message stored in each inbox. + + This value is used both to check the inbox does not grow beyond + the limit authorized by the + [tx_rollup_hard_size_limit_per_batch] protocol parameter (see + {!Constants_repr.parametric}), and during the finalization of a + Tezos block to update the [cost_per_byte] variable of a + transaction rollup. *) + module Inbox_cumulated_size : + Indexed_data_storage + with type t := Raw_context.t * Raw_level_repr.t + and type key = Tx_rollup_repr.t + and type value = int + + (** A carbonated storage to store the hashes of the messages + appended in an inbox, in reverse order. + + The actual content is stored in the corresponding block. *) + module Inbox_rev_contents : + Non_iterable_indexed_carbonated_data_storage + with type t := Raw_context.t * Raw_level_repr.t + and type key = Tx_rollup_repr.t + and type value = Tx_rollup_inbox_repr.message_hash list + + (** [fold (ctxt, level) ~order ~init ~f] traverses all rollups with + a nonempty inbox at [level]. + + No assurances whatsoever are provided regarding the order of + traversal. *) + val fold : + Raw_context.t -> + Raw_level_repr.t -> + init:'a -> + f:(Tx_rollup_repr.t -> 'a -> 'a Lwt.t) -> + 'a Lwt.t end (** Smart contract rollup *) diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index b90f6257088feaf4bb182e343b1fbd892e00f552..d6baf48c57e9677711fe3c2adb279c8bf54d5bb0 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -693,7 +693,8 @@ let bake_n_with_all_balance_updates ?(baking_mode = Application) ?policy match r with | Reveal_result _ | Delegation_result _ | Set_deposits_limit_result _ | Sc_rollup_originate_result _ - | Tx_rollup_origination_result _ -> + | Tx_rollup_origination_result _ | Tx_rollup_submit_batch_result _ + -> balance_updates_rev | Transaction_result {balance_updates; _} | Origination_result {balance_updates; _} @@ -722,6 +723,7 @@ let bake_n_with_origination_results ?(baking_mode = Application) ?policy n b = | Successful_manager_result (Register_global_constant_result _) | Successful_manager_result (Set_deposits_limit_result _) | Successful_manager_result (Tx_rollup_origination_result _) + | Successful_manager_result (Tx_rollup_submit_batch_result _) | Successful_manager_result (Sc_rollup_originate_result _) -> origination_results_rev | Successful_manager_result (Origination_result x) -> diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.ml b/src/proto_alpha/lib_protocol/test/helpers/context.ml index 8161dcb07b5252b8c88563015d132b6479519ba0..1030fff87500b02b67428c71936ef088ef935711 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/context.ml @@ -322,6 +322,8 @@ end module Tx_rollup = struct let state ctxt tx_rollup = Tx_rollup_services.state rpc_ctxt ctxt tx_rollup + + let inbox ctxt tx_rollup = Tx_rollup_services.inbox rpc_ctxt ctxt tx_rollup end let init ?rng_state ?commitments ?(initial_balances = []) ?consensus_threshold diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.mli b/src/proto_alpha/lib_protocol/test/helpers/context.mli index d005367c3192fd7178fa403ca308fe259e44cae3..f474e401d65827333fe8c0f1198ffc7f1366d9a4 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/context.mli @@ -163,7 +163,13 @@ module Delegate : sig end module Tx_rollup : sig - val state : t -> Tx_rollup.t -> Tx_rollup.state option tzresult Lwt.t + (** Return the state of a tx rollup, or an error if the rollup does not + exist. *) + val state : t -> Tx_rollup.t -> Tx_rollup_state.t tzresult Lwt.t + + (** Return the inbox of this transaction rollup at the current + level. Otherwise, return an error. *) + val inbox : t -> Tx_rollup.t -> Tx_rollup_inbox.t tzresult Lwt.t end (** [init n] : returns an initial block with [n] initialized accounts diff --git a/src/proto_alpha/lib_protocol/test/helpers/liquidity_baking_machine.ml b/src/proto_alpha/lib_protocol/test/helpers/liquidity_baking_machine.ml index 00561546aac273f342c3ca64bc8cd591d5301894..6a172921b20d07d05df802682f87f7d053b62347 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/liquidity_baking_machine.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/liquidity_baking_machine.ml @@ -737,7 +737,7 @@ module ConcreteBaseMachine : Lqt_fa12_repr.Storage.getBalance_opt (B blk) ~contract:env.tzbtc_contract - (contract, Entrypoint.default) + (Destination.Contract contract, Entrypoint.default) >>=? fun mamount -> pure (Option.value (Option.map Z.to_int mamount) ~default:0) @@ -745,7 +745,7 @@ module ConcreteBaseMachine : Lqt_fa12_repr.Storage.getBalance_opt (B blk) ~contract:env.liquidity_contract - (contract, Entrypoint.default) + (Destination.Contract contract, Entrypoint.default) >>=? fun mamount -> pure (Option.value (Option.map Z.to_int mamount) ~default:0) diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.ml b/src/proto_alpha/lib_protocol/test/helpers/op.ml index eac7739aedcf938bb43956c3600a24ec96552580..02daebb547de51e32ca84dbde0c71ac8fba5d5d7 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/op.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/op.ml @@ -357,7 +357,10 @@ let miss_signed_endorsement ?level ~endorsed_block ctxt = let transaction ?counter ?fee ?gas_limit ?storage_limit ?(parameters = Script.unit_parameter) ?(entrypoint = Entrypoint.default) ctxt (src : Contract.t) (dst : Contract.t) (amount : Tez.t) = - let top = Transaction {amount; parameters; destination = dst; entrypoint} in + let top = + Transaction + {amount; parameters; destination = Destination.contract dst; entrypoint} + in manager_operation ?counter ?fee ?gas_limit ?storage_limit ~source:src ctxt top >>=? fun sop -> Context.Contract.manager ctxt src >|=? fun account -> sign account.sk ctxt sop @@ -510,6 +513,20 @@ let tx_rollup_origination ?counter ?fee ?gas_limit ?storage_limit ctxt let op = sign account.sk ctxt to_sign_op in (op, originated_tx_rollup op |> snd) +let tx_rollup_submit_batch ?counter ?fee ?gas_limit ?storage_limit ctxt + (source : Contract.t) (tx_rollup : Tx_rollup.t) (content : string) = + manager_operation + ?counter + ?fee + ?gas_limit + ?storage_limit + ~source + ctxt + (Tx_rollup_submit_batch {tx_rollup; content}) + >>=? fun to_sign_op -> + Context.Contract.manager ctxt source >|=? fun account -> + sign account.sk ctxt to_sign_op + let sc_rollup_origination ?counter ?fee ?gas_limit ?storage_limit ctxt (src : Contract.t) kind boot_sector = manager_operation diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.mli b/src/proto_alpha/lib_protocol/test/helpers/op.mli index fc460753cf28814b3314da389d8383f14f770e74..debaa9b616124088346468c9ea34fcd0238a9e41 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/op.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/op.mli @@ -26,6 +26,17 @@ open Protocol open Alpha_context +val manager_operation : + ?counter:Z.t -> + ?fee:Tez.tez -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + ?public_key:public_key -> + source:Contract.t -> + Context.t -> + 'a manager_operation -> + Alpha_context.packed_contents_list tzresult Lwt.t + val endorsement : ?delegate:public_key_hash * Slot.t list -> ?slot:Slot.t -> @@ -203,6 +214,20 @@ val tx_rollup_origination : Contract.t -> (Operation.packed * Tx_rollup.t) tzresult Lwt.t +(** [tx_rollup_submit_batch ctxt source tx_rollup batch] submits + [batch], an array of bytes that is expected to be a batch of L2 + transactions, to be appended in the inbox of [tx_rollup]. *) +val tx_rollup_submit_batch : + ?counter:Z.t -> + ?fee:Tez.tez -> + ?gas_limit:Gas.Arith.integral -> + ?storage_limit:Z.t -> + Context.t -> + Contract.t -> + Tx_rollup.t -> + string -> + Operation.packed tzresult Lwt.t + (** [sc_rollup_origination ctxt source kind boot_sector] originates a new smart contract rollup of some given [kind] booting using [boot_sector]. The process is the same as in [tx_rollup_origination]. *) @@ -216,3 +241,10 @@ val sc_rollup_origination : Sc_rollup.Kind.t -> Sc_rollup.PVM.boot_sector -> packed_operation tzresult Lwt.t + +val sign : + ?watermark:Signature.watermark -> + Signature.secret_key -> + Context.t -> + Alpha_context.packed_contents_list -> + Alpha_context.packed_operation diff --git a/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_helpers.ml new file mode 100644 index 0000000000000000000000000000000000000000..b5dbb2608a18782622a412c95c564dedbf563ff9 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_helpers.ml @@ -0,0 +1,209 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Protocol +open Protocol.Alpha_context +open Protocol.Tx_rollup_l2_storage +open Protocol.Tx_rollup_l2_operation +module Map = Map.Make (Bytes) + +let l1_contract1 : Contract.t = + Contract.implicit_contract + (Signature.Public_key_hash.of_b58check_exn + "tz1Ke2h7sDdakHJQh8WX4Z372du1KChsksyU") + +let l1_contract2 : Contract.t = + Contract.implicit_contract + (Signature.Public_key_hash.of_b58check_exn + "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") + +let rng_state = Random.State.make_self_init () + +let gen_l2_account ?(rng = rng_state) () = + let seed = Bytes.init 32 (fun _ -> char_of_int @@ Random.State.int rng 255) in + let secret_key = Bls12_381.Signature.generate_sk seed in + let public_key = Bls12_381.Signature.derive_pk secret_key in + (secret_key, public_key) + +let unit_ticket_metadata = + let open Tezos_micheline.Micheline in + let open Protocol.Michelson_v1_primitives in + ( strip_locations @@ Prim (-1, D_Unit, [], []), + strip_locations @@ Prim (-1, T_unit, [], []) ) + +let hash_key_exn ctxt ~ticketer ~typ ~contents ~owner = + let ticketer = Micheline.root @@ Expr.from_string ticketer in + let typ = Micheline.root @@ Expr.from_string typ in + let contents = Micheline.root @@ Expr.from_string contents in + let owner = Micheline.root @@ Expr.from_string owner in + match Ticket_hash.make ctxt ~ticketer ~typ ~contents ~owner with + | Ok x -> x + | Error _ -> raise (Invalid_argument "hash_key_exn") + +(* FIXME: Use a rollup address for the [owner] *) +let make_key ctxt content = + hash_key_exn + ctxt + ~ticketer:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + ~typ:"string" + ~contents:(Printf.sprintf {|"%s"|} content) + ~owner:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|} + +let make_ticket str = + match + Lwt_main.run + ( Context.init 1 >>=? fun (blk, _) -> + Incremental.begin_construction blk >>=? fun incr -> + let ctxt = Incremental.alpha_ctxt incr in + let (ticket1, ctxt) = make_key ctxt str in + ignore ctxt ; + return ticket1 ) + with + | Ok x -> x + | Error err -> + Format.printf "%a\n" Error_monad.pp_print_trace err ; + raise (Invalid_argument "tickets") + +let (ticket1, ticket2) = + match + Lwt_main.run + ( Context.init 1 >>=? fun (blk, _) -> + Incremental.begin_construction blk >>=? fun incr -> + let ctxt = Incremental.alpha_ctxt incr in + let (ticket1, ctxt) = make_key ctxt "first ticket" in + let (ticket2, ctxt) = make_key ctxt "second ticket" in + ignore ctxt ; + return (ticket1, ticket2) ) + with + | Ok x -> x + | Error err -> + Format.printf "%a\n" Error_monad.pp_print_trace err ; + raise (Invalid_argument "tickets") + +module Sk_set = Set.Make (Bytes) + +let sign_ops : Bls12_381.Signature.sk list -> transaction -> signature list = + fun sks ops -> + let ops_nb = List.length ops in + assert (Compare.List_length_with.(sks = ops_nb)) ; + + let buf = Data_encoding.Binary.to_bytes_exn transaction_encoding ops in + + let seen = Sk_set.empty in + + let f (acc, seen) sk = + let key = Bls12_381.Signature.sk_to_bytes sk in + let keep = not @@ Sk_set.mem key seen in + if keep then + let acc = Bls12_381.Signature.Aug.sign sk buf :: acc in + let seen = Sk_set.add key seen in + (acc, seen) + else (acc, seen) + in + + let (unique_sks_rev, _) = List.fold_left f ([], seen) sks in + (* Note that unique_sks_rev is reversed, but we don't care about the order so + we just leave it.*) + unique_sks_rev + +let aggregate_signature_exn : signature list -> signature = + fun signatures -> + match Bls12_381.Signature.aggregate_signature_opt signatures with + | Some res -> res + | None -> raise (Invalid_argument "aggregate_signature_exn") + +let batch : transaction list -> signature list -> transactions_batch = + fun contents signatures -> + let aggregated_signatures = aggregate_signature_exn signatures in + {contents; aggregated_signatures} + +module type TEST_SUITE_CONTEXT = sig + include Tx_rollup_l2_context.CONTEXT + + val empty : t + + val to_lwt : (unit -> 'a m) -> unit -> ('a, 'b) result Lwt.t + + val storage_name : string +end + +module Map_storage : + STORAGE + with type t = bytes Map.t + and type 'a m = ('a, Environment.Error_monad.error) result = struct + type t = bytes Map.t + + type 'a m = ('a, Environment.Error_monad.error) result + + module Syntax = struct + let ( let+ ) x k = + match x with Ok x -> Ok (k x) | Error trace -> Error trace + + let ( let* ) x k = match x with Ok x -> k x | Error trace -> Error trace + + let fail : type a. Environment.Error_monad.error -> a m = + fun error -> Error error + + let catch m k h = match m with Ok x -> k x | Error err -> h err + + let return : type a. a -> a m = fun x -> Ok x + + let list_fold_left_m f = + let rec fold_left_m acc = function + | x :: rst -> ( + match f acc x with + | Ok acc -> fold_left_m acc rst + | Error err -> Error err) + | [] -> return acc + in + fold_left_m + end + + let get store key = Tzresult_syntax.return (Map.find key store) + + let set store key value = Tzresult_syntax.return (Map.add key value store) +end + +module Map_context : TEST_SUITE_CONTEXT with type t = bytes Map.t = struct + open Tx_rollup_l2_context + include Make (Map_storage) + + let empty = Map.empty + + let to_lwt : (unit -> 'a m) -> unit -> ('a, 'b) result Lwt.t = + fun test _ -> + match test () with + | Ok x -> Error_monad.return x + | Error error -> + Stdlib.failwith + (Format.asprintf + "test returned an error: %a" + Environment.Error_monad.pp + error) + + let storage_name = "map_storage" +end diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance_key.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance_key.ml index 22f1b05f4283e721f4dea3a368bcf550887cd967..d77759e30de2d05d80bbc72cbc9a8134f3681df4 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance_key.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance_key.ml @@ -72,8 +72,8 @@ let equal_script_hash ~loc msg key1 key2 = Script_expr_hash.equal msg Script_expr_hash.pp - (Ticket_balance.script_expr_hash_of_key_hash key1) - (Ticket_balance.script_expr_hash_of_key_hash key2) + (Ticket_hash.to_script_expr_hash key1) + (Ticket_hash.to_script_expr_hash key2) let not_equal_script_hash ~loc msg key1 key2 = Assert.not_equal @@ -81,8 +81,8 @@ let not_equal_script_hash ~loc msg key1 key2 = Script_expr_hash.equal msg Script_expr_hash.pp - (Ticket_balance.script_expr_hash_of_key_hash key1) - (Ticket_balance.script_expr_hash_of_key_hash key2) + (Ticket_hash.to_script_expr_hash key1) + (Ticket_hash.to_script_expr_hash key2) let assert_keys ~ticketer1 ~ticketer2 ~typ1 ~typ2 ~amount1 ~amount2 ~content1 ~content2 ~owner1 ~owner2 assert_condition = diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_storage.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_storage.ml index 557894b166a0903e72125b9e75b995d35c9b1b5e..3b45b3a31970c0e28f9b4ce6b3422a8da7a0dfa3 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_storage.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_storage.ml @@ -51,12 +51,7 @@ let hash_key ctxt ~ticketer ~typ ~contents ~owner = let owner = Micheline.root @@ Expr.from_string owner in wrap @@ Lwt.return - (Alpha_context.Ticket_balance.make_key_hash - ctxt - ~ticketer - ~typ - ~contents - ~owner) + (Alpha_context.Ticket_hash.make ctxt ~ticketer ~typ ~contents ~owner) let assert_balance ctxt ~loc key expected = let* (balance, _) = wrap @@ Ticket_balance.get_balance ctxt key in @@ -92,8 +87,8 @@ let assert_non_overlapping_keys ~loc ~ticketer1 ~ticketer2 ~contents1 ~contents2 ~contents:contents2 ~owner:owner2 in - let k1 = Ticket_balance.script_expr_hash_of_key_hash k1 in - let k2 = Ticket_balance.script_expr_hash_of_key_hash k2 in + let k1 = Ticket_hash.to_script_expr_hash k1 in + let k2 = Ticket_hash.to_script_expr_hash k2 in Assert.not_equal ~loc Script_expr_hash.equal diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml index 2a5e6d612a898b1454ac19cc24620421e7a809d9..24ab24c4b89e876130c86ee6da37b108df2a6033 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml @@ -682,7 +682,7 @@ let test_parse_address () = ctxt (address_t ~annot:None) (String (-1, "KT1FAKEFAKEFAKEFAKEFAKEFAKEFAKGGSE2x%")) - (kt1fake, Entrypoint.default) + (Destination.contract kt1fake, Entrypoint.default) >>=? fun ctxt -> (* tz1% (empty entrypoint) *) wrap_error_lwt @@ -693,7 +693,7 @@ let test_parse_address () = ctxt (address_t ~annot:None) (String (-1, "tz1fakefakefakefakefakefakefakcphLA5%")) - (tz1fake, Entrypoint.default) + (Destination.contract tz1fake, Entrypoint.default) >|=? fun _ctxt -> () let test_unparse_data loc ctxt ty x ~expected_readable ~expected_optimized = diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit.tz b/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit.tz new file mode 100644 index 0000000000000000000000000000000000000000..7f10911746bdfcdaf2d5077b11e0ffcd982ec6b0 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit.tz @@ -0,0 +1,33 @@ +parameter (pair address tx_rollup_l2_address); +storage (unit); +code { + # cast the address to contract type + CAR; + UNPAIR; + CONTRACT %deposit (pair (ticket unit) tx_rollup_l2_address); + + IF_SOME { + SWAP; + + # amount for transfering + PUSH mutez 0; + SWAP; + + # create a ticket + PUSH nat 10; + PUSH unit Unit; + TICKET; + + PAIR ; + + # deposit + TRANSFER_TOKENS; + + DIP { NIL operation }; + CONS; + + DIP { PUSH unit Unit }; + PAIR; + } + { FAIL ; } + } diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit_incorrect_entrypoint.tz b/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit_incorrect_entrypoint.tz new file mode 100644 index 0000000000000000000000000000000000000000..3ad04d1bc0183a01d0a4f85dfa9ed363e972a4d7 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit_incorrect_entrypoint.tz @@ -0,0 +1,33 @@ +parameter (pair address tx_rollup_l2_address); +storage (unit); +code { + # cast the address to contract type + CAR; + UNPAIR; + CONTRACT %default (pair (ticket unit) tx_rollup_l2_address); + + IF_SOME { + SWAP; + + # amount for transfering + PUSH mutez 0; + SWAP; + + # create a ticket + PUSH nat 10; + PUSH unit Unit; + TICKET; + + PAIR ; + + # deposit + TRANSFER_TOKENS; + + DIP { NIL operation }; + CONS; + + DIP { PUSH unit Unit }; + PAIR; + } + { FAIL ; } + } diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit_incorrect_param.tz b/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit_incorrect_param.tz new file mode 100644 index 0000000000000000000000000000000000000000..96590ef8a61e4673a6804c0a6498798cb8fe511b --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit_incorrect_param.tz @@ -0,0 +1,25 @@ +parameter (address); +storage (unit); +code { + # cast the address to contract type + CAR; + CONTRACT %deposit (nat); + + IF_SOME { + # amount for transfering + PUSH mutez 0; + + # create a ticket + PUSH nat 100; + + # deposit + TRANSFER_TOKENS; + + DIP { NIL operation }; + CONS; + + DIP { PUSH unit Unit }; + PAIR; + } + { FAIL ; } + } \ No newline at end of file diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit_one_mutez.tz b/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit_one_mutez.tz new file mode 100644 index 0000000000000000000000000000000000000000..58eb3095cdeab1616887a78946b8a769c50c4b19 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/integration/operations/contracts/tx_rollup_deposit_one_mutez.tz @@ -0,0 +1,33 @@ +parameter (pair address tx_rollup_l2_address); +storage (unit); +code { + # cast the address to contract type + CAR; + UNPAIR; + CONTRACT %deposit (pair (ticket unit) tx_rollup_l2_address); + + IF_SOME { + SWAP; + + # amount for transfering + PUSH mutez 1; + SWAP; + + # create a ticket + PUSH nat 10; + PUSH unit Unit; + TICKET; + + PAIR ; + + # deposit + TRANSFER_TOKENS; + + DIP { NIL operation }; + CONS; + + DIP { PUSH unit Unit }; + PAIR; + } + { FAIL ; } + } diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/dune b/src/proto_alpha/lib_protocol/test/integration/operations/dune index 60fcd15cc751507cc134ad43c57942043a21a255..13babc23c207937d8d0709cfe4baefd3f93b0b93 100644 --- a/src/proto_alpha/lib_protocol/test/integration/operations/dune +++ b/src/proto_alpha/lib_protocol/test/integration/operations/dune @@ -1,6 +1,7 @@ (test (name main) (package tezos-protocol-alpha-tests) + (deps (glob_files contracts/*)) (libraries alcotest-lwt tezos-base tezos-protocol-alpha @@ -8,5 +9,6 @@ tezos-alpha-test-helpers) (flags (:standard -open Tezos_base__TzPervasives -open Tezos_protocol_alpha + -open Tezos_client_alpha -open Tezos_alpha_test_helpers -open Tezos_base_test_helpers))) diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml index 3253992a03d2a0704291cd47a9c52c1303677e17..985d75427230e23883aa38de9cc078fe75098211 100644 --- a/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml +++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml @@ -3,6 +3,7 @@ (* Open Source License *) (* Copyright (c) 2021 Marigold *) (* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -27,21 +28,59 @@ (** Testing ------- Component: Rollup layer 1 logic - Invocation: dune exec \ - src/proto_alpha/lib_protocol/test/integration/operations/main.exe \ - -- test "^tx rollup$" + Invocation: cd src/proto_alpha/lib_protocol/test/integration/operations \ + && dune exec ./main.exe -- test "^tx rollup$" Subject: Test rollup *) +open Tx_rollup_helpers open Protocol open Alpha_context +open Tx_rollup_inbox +open Tx_rollup_l2_operation +open Tx_rollup_l2_apply open Test_tez +let message_hash_testable : Tx_rollup_inbox.message_hash Alcotest.testable = + Alcotest.testable Tx_rollup_inbox.message_hash_pp ( = ) + let check_tx_rollup_exists ctxt tx_rollup = - Context.Tx_rollup.state ctxt tx_rollup >|=? Option.is_some + Context.Tx_rollup.state ctxt tx_rollup >>=? fun _state -> return_unit + +(** [make_unit_ticket_key ctxt ticketer tx_rollup] computes the key hash of + the unit ticket crafted by [ticketer] and owned by [tx_rollup]. *) +let make_unit_ticket_key ctxt ticketer tx_rollup = + let open Tezos_micheline.Micheline in + let open Michelson_v1_primitives in + let ticketer = + Bytes (0, Data_encoding.Binary.to_bytes_exn Contract.encoding ticketer) + in + let ty = Prim (0, T_unit, [], []) in + let contents = Prim (0, D_Unit, [], []) in + match + Alpha_context.Tx_rollup.hash_ticket ctxt ~ticketer ~ty ~contents tx_rollup + with + | Ok (x, _) -> x + | Error _ -> raise (Invalid_argument "make_unit_ticket_key") + +(** [check_batch_in_inbox inbox n expected] checks that the [n]th + element of [inbox] is a batch equal to [expected]. *) +let check_batch_in_inbox : + Tx_rollup_inbox.t -> int -> string -> unit tzresult Lwt.t = + fun inbox n expected -> + match List.nth inbox.contents n with + | Some content -> + Alcotest.( + check + message_hash_testable + "Expected batch with a different content" + content + (Tx_rollup_inbox.hash_message (Batch expected))) ; + return_unit + | _ -> Alcotest.fail "Selected message in the inbox is not a batch" -(** [test_disable_feature_flag] try to originate a tx rollup with the feature - flag is deactivated and check it fails *) +(** [test_disable_feature_flag] tries to originate a tx rollup with + the feature flag is deactivated and checks that it fails *) let test_disable_feature_flag () = Context.init 1 >>=? fun (b, contracts) -> let contract = @@ -57,8 +96,8 @@ let test_disable_feature_flag () = in Incremental.add_operation ~expect_failure i op >>= fun _i -> return_unit -(** [test_origination] originate a tx rollup and check that it burns the - correct amount of the origination source contract. *) +(** [test_origination] originates a tx rollup and check that it burns + the correct amount of the origination source contract. *) let test_origination () = Context.init ~tx_rollup_enable:true 1 >>=? fun (b, contracts) -> let contract = @@ -70,21 +109,23 @@ let test_origination () = Incremental.begin_construction b >>=? fun i -> Op.tx_rollup_origination (I i) contract >>=? fun (op, tx_rollup) -> Incremental.add_operation i op >>=? fun i -> - check_tx_rollup_exists (I i) tx_rollup >>=? fun exists -> - if exists then - cost_per_byte *? Int64.of_int tx_rollup_origination_size - >>?= fun tx_rollup_origination_burn -> - Assert.balance_was_debited - ~loc:__LOC__ - (I i) - contract - balance - tx_rollup_origination_burn - else failwith "tx rollup was not correctly originated" + check_tx_rollup_exists (I i) tx_rollup >>=? fun () -> + cost_per_byte *? Int64.of_int tx_rollup_origination_size + >>?= fun tx_rollup_origination_burn -> + Assert.balance_was_debited + ~loc:__LOC__ + (I i) + contract + balance + tx_rollup_origination_burn -(** [test_two_origination] originate two tx rollups in the same operation and - check that each has a different address. *) -let test_two_origination () = +(** [test_two_originations] originates two tx rollups in the same + operation and check that each has a different address. *) +let test_two_originations () = + (* + TODO: https://gitlab.com/tezos/tezos/-/issues/2331 + This test can be generalized using a property-based approach. + *) Context.init ~tx_rollup_enable:true 1 >>=? fun (b, contracts) -> let contract = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 @@ -116,10 +157,1318 @@ let test_two_origination () = txo1 txo2 >>=? fun () -> - check_tx_rollup_exists (I i) txo1 >>=? fun txo1_exists -> - Assert.equal_bool ~loc:__LOC__ txo1_exists true >>=? fun () -> - check_tx_rollup_exists (I i) txo2 >>=? fun txo2_exists -> - Assert.equal_bool ~loc:__LOC__ txo2_exists true + check_tx_rollup_exists (I i) txo1 >>=? fun () -> + check_tx_rollup_exists (I i) txo2 >>=? fun () -> return_unit + +(** Check that the cost per byte per inbox rate is updated correctly *) +let test_cost_per_byte_update () = + let cost_per_byte = Tez.of_mutez_exn 250L in + let test ~tx_rollup_cost_per_byte ~final_size ~hard_limit ~result = + let result = Tez.of_mutez_exn result in + let tx_rollup_cost_per_byte = Tez.of_mutez_exn tx_rollup_cost_per_byte in + let new_cost_per_byte = + Alpha_context.Tx_rollup_state.Internal_for_tests.update_cost_per_byte + ~cost_per_byte + ~tx_rollup_cost_per_byte + ~final_size + ~hard_limit + in + Assert.equal_tez ~loc:__LOC__ result new_cost_per_byte + in + + (* Cost per byte should remain constant *) + test + ~tx_rollup_cost_per_byte:1_000L + ~final_size:1_000 + ~hard_limit:1_100 + ~result:1_000L + >>=? fun () -> + (* Cost per byte should increase *) + test + ~tx_rollup_cost_per_byte:1_000L + ~final_size:1_000 + ~hard_limit:1_000 + ~result:1_051L + >>=? fun () -> + (* Cost per byte should decrease *) + test + ~tx_rollup_cost_per_byte:1_000L + ~final_size:1_000 + ~hard_limit:1_500 + ~result:951L + >>=? fun () -> + (* Cost per byte never decreased under the [cost_per_byte] constant *) + test + ~tx_rollup_cost_per_byte:(cost_per_byte |> Tez.to_mutez) + ~final_size:1_000 + ~hard_limit:1_500 + ~result:(cost_per_byte |> Tez.to_mutez) + >>=? fun () -> return_unit + +(** [context_init n] initializes a context with no consensus rewards + to not interfere with balances prediction. It returns the created + context and n contracts *) +let context_init n = + Context.init + ~consensus_threshold:0 + ~tx_rollup_enable:true + ~endorsing_reward_per_slot:Tez.zero + ~baking_reward_bonus_per_slot:Tez.zero + ~baking_reward_fixed_portion:Tez.zero + n + +(** [originate b contract] originates a tx_rollup from the given contract, + and returns the new block and the the tx_rollup address *) +let originate b contract = + Op.tx_rollup_origination (B b) contract >>=? fun (operation, tx_rollup) -> + Block.bake ~operation b >>=? fun b -> return (b, tx_rollup) + +(** [test_add_batch] originates a tx rollup and fills one of its inbox + with an arbitrary batch of data. *) +let test_add_batch () = + context_init 1 >>=? fun (b, contracts) -> + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b contract >>=? fun (b, tx_rollup) -> + Context.Contract.balance (B b) contract >>=? fun balance -> + Context.Tx_rollup.state (B b) tx_rollup + >>=? fun {cost_per_byte = tx_rollup_cost_per_byte} -> + let contents_size = 5 in + let batch = String.make contents_size 'c' in + Op.tx_rollup_submit_batch (B b) contract tx_rollup batch >>=? fun operation -> + Block.bake ~operation b >>=? fun b -> + Context.Tx_rollup.inbox (B b) tx_rollup >>=? fun {contents; cumulated_size} -> + let length = List.length contents in + Alcotest.(check int "Expect an inbox with a single item" 1 length) ; + Alcotest.(check int "Expect cumulated size" contents_size cumulated_size) ; + Test_tez.(tx_rollup_cost_per_byte *? Int64.of_int contents_size) + >>?= fun cost -> + Assert.balance_was_debited ~loc:__LOC__ (B b) contract balance cost + +(** [test_add_two_batches] originates a tx rollup and adds two + arbitrary batches to one of its inboxes. Ensure that their order + is correct. *) +let test_add_two_batches () = + (* + TODO: https://gitlab.com/tezos/tezos/-/issues/2331 + This test can be generalized using a property-based approach. + *) + context_init 1 >>=? fun (b, contracts) -> + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b contract >>=? fun (b, tx_rollup) -> + Context.Tx_rollup.state (B b) tx_rollup + >>=? fun {cost_per_byte = tx_rollup_cost_per_byte} -> + Context.Contract.balance (B b) contract >>=? fun balance -> + let contents_size1 = 5 in + let contents1 = String.make contents_size1 'c' in + Op.tx_rollup_submit_batch (B b) contract tx_rollup contents1 >>=? fun op1 -> + Context.Contract.counter (B b) contract >>=? fun counter -> + let contents_size2 = 6 in + let contents2 = String.make contents_size2 'd' in + Op.tx_rollup_submit_batch + ~counter:Z.(add counter (of_int 1)) + (B b) + contract + tx_rollup + contents2 + >>=? fun op2 -> + Block.bake ~operations:[op1; op2] b >>=? fun b -> + Context.Tx_rollup.inbox (B b) tx_rollup >>=? fun inbox -> + let length = List.length inbox.contents in + let expected_cumulated_size = contents_size1 + contents_size2 in + + Alcotest.(check int "Expect an inbox with two items" 2 length) ; + Alcotest.( + check + int + "Expect cumulated size" + expected_cumulated_size + inbox.cumulated_size) ; + + Context.Tx_rollup.inbox (B b) tx_rollup >>=? fun {contents; _} -> + Alcotest.(check int "Expect an inbox with two items" 2 (List.length contents)) ; + + check_batch_in_inbox inbox 0 contents1 >>=? fun () -> + check_batch_in_inbox inbox 1 contents2 >>=? fun () -> + Test_tez.( + tx_rollup_cost_per_byte *? (Int64.of_int @@ expected_cumulated_size)) + >>?= fun cost -> + Assert.balance_was_debited ~loc:__LOC__ (B b) contract balance cost + >>=? fun () -> return () + +(** Try to add a batch too large in an inbox. *) +let test_batch_too_big () = + context_init 1 >>=? fun (b, contracts) -> + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b contract >>=? fun (b, tx_rollup) -> + Context.get_constants (B b) >>=? fun constant -> + let contents = + String.make constant.parametric.tx_rollup_hard_size_limit_per_batch 'd' + in + Incremental.begin_construction b >>=? fun i -> + Op.tx_rollup_submit_batch (I i) contract tx_rollup contents >>=? fun op -> + Incremental.add_operation i op ~expect_failure:(function + | Environment.Ecoproto_error Protocol.Apply.Tx_rollup_submit_too_big :: _ + -> + return_unit + | _ -> failwith "Expected [Tx_rollup_submit_too_big] error") + >>=? fun i -> + ignore i ; + return_unit + +(** Try to add enough batch to reach the size limit of an inbox. *) +let test_inbox_too_big () = + context_init 1 >>=? fun (b, contracts) -> + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b contract >>=? fun (b, tx_rollup) -> + Context.get_constants (B b) >>=? fun constant -> + let tx_rollup_inbox_limit = + constant.parametric.tx_rollup_hard_size_limit_per_inbox + in + let tx_rollup_batch_limit = + constant.parametric.tx_rollup_hard_size_limit_per_batch - 1 + in + let contents = String.make tx_rollup_batch_limit 'd' in + Context.Contract.counter (B b) contract >>=? fun counter -> + Incremental.begin_construction b >>=? fun i -> + let rec fill_inbox i inbox_size counter = + (* By default, the [gas_limit] is the maximum gas that can be + consumed by an operation. We set a lower (arbitrary) limit to + be able to reach the size limit of an operation. *) + Op.tx_rollup_submit_batch + ~gas_limit:(Saturation_repr.safe_int 100_000_000) + ~counter + (I i) + contract + tx_rollup + contents + >>=? fun op -> + let new_inbox_size = inbox_size + tx_rollup_batch_limit in + if new_inbox_size < tx_rollup_inbox_limit then + Incremental.add_operation i op >>=? fun i -> + fill_inbox i new_inbox_size (Z.succ counter) + else + Incremental.add_operation i op ~expect_failure:(function + | Environment.Ecoproto_error + (Protocol.Tx_rollup_storage.Tx_rollup_hard_size_limit_reached _) + :: _ -> + return_unit + | err -> + failwith + "Expected [Tx_rollup_hard_size_limit_reached] error, got %a" + Error_monad.pp_print_trace + err) + in + + fill_inbox i 0 counter >>=? fun i -> + ignore i ; + return_unit + +(** Test that block finalization changes gas rates *) +let test_finalization () = + context_init 1 >>=? fun (b, contracts) -> + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b contract >>=? fun (b, tx_rollup) -> + Context.get_constants (B b) + >>=? fun { + parametric = {cost_per_byte; tx_rollup_hard_size_limit_per_inbox; _}; + _; + } -> + Context.Contract.balance (B b) contract >>=? fun balance -> + Context.Tx_rollup.state (B b) tx_rollup + >>=? fun {cost_per_byte = tx_rollup_cost_per_byte} -> + Assert.equal_tez ~loc:__LOC__ cost_per_byte tx_rollup_cost_per_byte + >>=? fun () -> + let contents_size = 5 in + let batch = String.make contents_size 'c' in + Op.tx_rollup_submit_batch (B b) contract tx_rollup batch >>=? fun operation -> + Block.bake ~operation b >>=? fun b -> + Test_tez.(tx_rollup_cost_per_byte *? Int64.of_int contents_size) + >>?= fun cost -> + Assert.balance_was_debited ~loc:__LOC__ (B b) contract balance cost + >>=? fun () -> + Context.Tx_rollup.inbox (B b) tx_rollup >>=? fun {contents; cumulated_size} -> + let length = List.length contents in + (* Check the content of the inbox *) + Alcotest.(check int "Expect an inbox with a single item" 1 length) ; + Alcotest.(check int "Expect cumulated_size" contents_size cumulated_size) ; + (* Check the new cost_per_byte rate *) + Context.Tx_rollup.state (B b) tx_rollup + >>=? fun {cost_per_byte = new_tx_rollup_cost_per_byte} -> + Assert.equal_tez + ~loc:__LOC__ + (Alpha_context.Tx_rollup_state.Internal_for_tests.update_cost_per_byte + ~cost_per_byte + ~tx_rollup_cost_per_byte + ~final_size:cumulated_size + ~hard_limit:tx_rollup_hard_size_limit_per_inbox) + new_tx_rollup_cost_per_byte + +let rng_state = Random.State.make_self_init () + +let gen_l2_account () = + let seed = + Bytes.init 32 (fun _ -> char_of_int @@ Random.State.int rng_state 255) + in + let secret_key = Bls12_381.Signature.generate_sk seed in + let public_key = Bls12_381.Signature.derive_pk secret_key in + (secret_key, public_key) + +let is_implicit_exn x = + match Alpha_context.Contract.is_implicit x with + | Some x -> x + | None -> raise (Invalid_argument "is_implicit_exn") + +let hex_of_tx_rollup_l2_address address = + Data_encoding.Binary.to_bytes_exn Tx_rollup_l2_address.encoding address + |> Hex.of_bytes |> Hex.show + +(** [expression_from_string] parses a Michelson expression from a string. *) +let expression_from_string str = + let (ast, errs) = Michelson_v1_parser.parse_expression ~check:true str in + match errs with + | [] -> ast.expanded + | _ -> Stdlib.failwith ("parse expression: " ^ str) + +let print_deposit_arg tx_rollup account = + let open Alpha_context.Script in + Format.sprintf + "Pair \"%s\" 0x%s" + (match tx_rollup with + | `Typed pk -> Tx_rollup.to_b58check pk + | `Raw str -> str) + (match account with + | `Typed pk -> hex_of_tx_rollup_l2_address pk + | `Raw str -> str) + |> expression_from_string |> lazy_expr + +(** Test a smart contract can deposit tickets to a transaction rollup *) +let test_valid_deposit () = + let (_, pk) = gen_l2_account () in + + context_init 1 >>=? fun (b, contracts) -> + let account = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b account >>=? fun (b, tx_rollup) -> + Contract_helpers.originate_contract + "contracts/tx_rollup_deposit.tz" + "Unit" + account + b + (is_implicit_exn account) + >>=? fun (contract, b) -> + let parameters = print_deposit_arg (`Typed tx_rollup) (`Typed pk) in + let fee = Test_tez.of_int 10 in + Op.transaction + ~counter:(Z.of_int 2) + ~fee + (B b) + account + contract + Tez.zero + ~parameters + >>=? fun operation -> + Block.bake ~operation b >>=? fun b -> + Incremental.begin_construction b >|=? Incremental.alpha_ctxt >>=? fun ctxt -> + Context.Tx_rollup.inbox (B b) tx_rollup >>=? function + | {contents = [hash]; _} -> + let expected = + Tx_rollup_inbox.hash_message + (Deposit + { + destination = pk; + amount = 10L; + key_hash = make_unit_ticket_key ctxt contract tx_rollup; + }) + in + Alcotest.(check message_hash_testable "deposit" hash expected) ; + return_unit + | _ -> Alcotest.fail "The inbox has not the expected shape" + +(** Test a smart contract cannot deposit tickets to a transaction rollup that + does not exists. *) +let test_valid_deposit_inexistant_rollup () = + let (_, pk) = gen_l2_account () in + Context.init + ~consensus_threshold:0 + ~tx_rollup_enable: + true (* We don't want reward to interferes with balance computation *) + ~endorsing_reward_per_slot:Tez.zero + ~baking_reward_bonus_per_slot:Tez.zero + ~baking_reward_fixed_portion:Tez.zero + 1 + >>=? fun (b, contracts) -> + let account = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + Contract_helpers.originate_contract + "contracts/tx_rollup_deposit.tz" + "Unit" + account + b + (is_implicit_exn account) + >>=? fun (contract, b) -> + Incremental.begin_construction b >>=? fun i -> + let parameters = + print_deposit_arg (`Raw "tru1HdK6HiR31Xo1bSAr4mwwCek8ExgwuUeHm") (`Typed pk) + in + let fee = Test_tez.of_int 10 in + Op.transaction ~fee (I i) account contract Tez.zero ~parameters >>=? fun op -> + Incremental.add_operation i op ~expect_failure:(function + | Environment.Ecoproto_error + (Script_interpreter.Runtime_contract_error _ as e) + :: _ -> + Assert.test_error_encodings e ; + return_unit + | t -> failwith "Unexpected error: %a" Error_monad.pp_print_trace t) + >>=? fun _ -> return_unit + +(** Test a smart contract cannot deposit something that is not a ticket *) +let test_invalid_deposit_not_ticket () = + let (_, pk) = gen_l2_account () in + + context_init 1 >>=? fun (b, contracts) -> + let account = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b account >>=? fun (b, tx_rollup) -> + Contract_helpers.originate_contract + "contracts/tx_rollup_deposit_incorrect_param.tz" + "Unit" + account + b + (is_implicit_exn account) + >>=? fun (contract, b) -> + Incremental.begin_construction b >>=? fun i -> + let parameters = print_deposit_arg (`Typed tx_rollup) (`Typed pk) in + let fee = Test_tez.of_int 10 in + Op.transaction ~fee (I i) account contract Tez.zero ~parameters >>=? fun op -> + Incremental.add_operation i op ~expect_failure:(function + | Environment.Ecoproto_error + (Script_interpreter.Bad_contract_parameter _ as e) + :: _ -> + Assert.test_error_encodings e ; + return_unit + | t -> failwith "Unexpected error: %a" Error_monad.pp_print_trace t) + >>=? fun _ -> return_unit + +(** Test a smart contract cannot use an invalid entrypoint *) +let test_invalid_entrypoint () = + let (_, pk) = gen_l2_account () in + + context_init 1 >>=? fun (b, contracts) -> + let account = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b account >>=? fun (b, tx_rollup) -> + Contract_helpers.originate_contract + "contracts/tx_rollup_deposit_incorrect_param.tz" + "Unit" + account + b + (is_implicit_exn account) + >>=? fun (contract, b) -> + Incremental.begin_construction b >>=? fun i -> + let parameters = print_deposit_arg (`Typed tx_rollup) (`Typed pk) in + let fee = Test_tez.of_int 10 in + Op.transaction ~fee (I i) account contract Tez.zero ~parameters >>=? fun op -> + Incremental.add_operation i op ~expect_failure:(function + | Environment.Ecoproto_error + (Script_interpreter.Bad_contract_parameter _ as e) + :: _ -> + Assert.test_error_encodings e ; + return_unit + | t -> failwith "Unexpected error: %a" Error_monad.pp_print_trace t) + >>=? fun _ -> return_unit + +(** Test a smart contract cannot deposit to an invalid l2 account *) +let test_invalid_l2_account () = + context_init 1 >>=? fun (b, contracts) -> + let account = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b account >>=? fun (b, tx_rollup) -> + Contract_helpers.originate_contract + "contracts/tx_rollup_deposit.tz" + "Unit" + account + b + (is_implicit_exn account) + >>=? fun (contract, b) -> + Incremental.begin_construction b >>=? fun i -> + let parameters = + print_deposit_arg + (`Typed tx_rollup) + (`Raw ("invalid L2 address" |> Hex.of_string |> Hex.show)) + in + let fee = Test_tez.of_int 10 in + Op.transaction ~fee (I i) account contract Tez.zero ~parameters >>=? fun op -> + Incremental.add_operation i op ~expect_failure:(function + | Environment.Ecoproto_error + (Script_interpreter.Bad_contract_parameter _ as e) + :: _ -> + Assert.test_error_encodings e ; + return_unit + | t -> failwith "Unexpected error: %a" Error_monad.pp_print_trace t) + >>=? fun _ -> return_unit + +(** Test a smart contract cannot transfer tez to a rollup *) +let test_valid_deposit_invalid_amount () = + let (_, pk) = gen_l2_account () in + + context_init 1 >>=? fun (b, contracts) -> + let account = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b account >>=? fun (b, tx_rollup) -> + Contract_helpers.originate_contract + "contracts/tx_rollup_deposit_one_mutez.tz" + "Unit" + account + b + (is_implicit_exn account) + >>=? fun (contract, b) -> + Incremental.begin_construction b >>=? fun i -> + let parameters = print_deposit_arg (`Typed tx_rollup) (`Typed pk) in + let fee = Test_tez.of_int 10 in + Op.transaction ~fee (I i) account contract Tez.zero ~parameters >>=? fun op -> + Incremental.add_operation i op ~expect_failure:(function + | Environment.Ecoproto_error (Apply.Tx_rollup_non_null_transaction as e) + :: _ -> + Assert.test_error_encodings e ; + return_unit + | t -> failwith "Unexpected error: %a" Error_monad.pp_print_trace t) + >>=? fun _ -> return_unit + +(** Test deposit by non internal operation fails *) +let test_deposit_by_non_internal_operation () = + let fee = Test_tez.of_int 10 in + let invalid_transaction ctxt (src : Contract.t) (dst : Tx_rollup.t) = + let top = + Transaction + { + amount = Tez.zero; + parameters = Script.unit_parameter; + destination = Destination.Tx_rollup dst; + entrypoint = Alpha_context.Entrypoint.default; + } + in + Op.manager_operation ~fee ~source:src ctxt top >>=? fun sop -> + Context.Contract.manager ctxt src >|=? fun account -> + Op.sign account.sk ctxt sop + in + + context_init 1 >>=? fun (b, contracts) -> + let account = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + originate b account >>=? fun (b, tx_rollup) -> + invalid_transaction (B b) account tx_rollup >>=? fun operation -> + Incremental.begin_construction b >>=? fun i -> + Incremental.add_operation i operation ~expect_failure:(function + | Environment.Ecoproto_error + (Apply.Tx_rollup_non_internal_transaction as e) + :: _ -> + Assert.test_error_encodings e ; + return_unit + | _ -> failwith "It should not be possible to send a rollup_operation ") + >>=? fun _i -> return_unit + +module L2_test_suite (L2_context : TEST_SUITE_CONTEXT) = struct + open L2_context + module Apply = Tx_rollup_l2_apply.Make (L2_context) + + type account = Bls12_381.Signature.sk * Bls12_381.Signature.pk + + let nth_exn l n = + match List.nth l n with + | Some x -> x + | None -> raise (Invalid_argument "nth_exn") + + let check_counter ctxt name description account value = + let open Syntax in + let* res = Counter.get ctxt account in + Alcotest.( + check + int64 + (Format.sprintf "counter for %s (%s)" name description) + res + value) ; + return () + + let check_balance ctxt name_account name_ticket description account key_hash + value = + let open Syntax in + let* res = Ticket_ledger.get ctxt key_hash account in + Alcotest.( + check + int64 + (Format.sprintf + "balance for %s of %s (%s)" + name_account + name_ticket + description) + res + value) ; + return () + + let with_initial_setup balances k = + let open Syntax in + let storage = empty in + let* (storage, rev_accounts) = + list_fold_left_m + (fun (storage, rev_acc) balance -> + let (sk, pk) = gen_l2_account () in + let* (storage, rev_hashes) = + list_fold_left_m + (fun (storage, rev_acc) (hash, amount) -> + let* storage = Ticket_ledger.set storage hash pk amount in + return (storage, hash :: rev_acc)) + (storage, []) + balance + in + return (storage, (sk, pk, List.rev rev_hashes) :: rev_acc)) + (storage, []) + balances + in + k storage (List.rev rev_accounts) + + (** Test the various path of the storage *) + let test_tx_rollup_storage () = + let open Syntax in + let ctxt = empty in + let (_, account_pk) = gen_l2_account () in + let key_hash = ticket1 in + let amount = 100L in + (* 1. test [Counter] *) + let* () = check_counter ctxt "account_pk" "initial" account_pk 0L in + let* ctxt = Counter.set ctxt account_pk 1L in + let* () = check_counter ctxt "account_pk" "after set" account_pk 1L in + (* 2. test [Ticket_ledger] *) + let* ctxt = Ticket_ledger.set ctxt key_hash account_pk amount in + let* () = + check_balance + ctxt + "account_pk" + "ticket1" + "after set" + account_pk + key_hash + amount + in + + return () + + (** Check a valid deposit has the expected effect on the storage. *) + let test_tx_rollup_apply_deposit () = + let open Syntax in + with_initial_setup [[]] @@ fun ctxt accounts -> + let (_, pk1, _) = nth_exn accounts 0 in + let key_hash = ticket1 in + let deposit = {destination = pk1; key_hash; amount = 50L} in + let* ctxt = Apply.apply_deposit ctxt deposit in + + let* () = + check_balance ctxt "pk1" "ticket1" "after apply" pk1 key_hash 50L + in + + return () + + (** Check a valid transfer has the expected effect on the + storage. *) + let test_tx_rollup_apply_single_operation () = + let open Syntax in + with_initial_setup [[(ticket1, 100L)]; []] @@ fun ctxt accounts -> + let (_, account1_pk, hashes1) = nth_exn accounts 0 in + let (_, account2_pk, _) = nth_exn accounts 1 in + let ticket_hash = nth_exn hashes1 0 in + + let content1 : operation_content = + Transfer {destination = account2_pk; ticket_hash; amount = 32L} + in + let transfer1 : operation = + {signer = account1_pk; counter = 0L; content = content1} + in + + let* (status, ctxt) = + Apply.Internal_for_tests.apply_transaction ctxt [transfer1] + in + + assert (status = Success) ; + + let* () = + check_counter ctxt "account1_pk" "after operation" account1_pk 1L + in + + let* () = + check_balance + ctxt + "account1_pk" + "ticket1" + "after operation" + account1_pk + ticket_hash + 68L + in + + return () + + (** Check a transfer to self leaves the balance unchanged. *) + let test_tx_rollup_apply_self_transfer () = + let open Syntax in + with_initial_setup [[(ticket1, 100L)]] @@ fun ctxt accounts -> + let (_, account1_pk, hashes1) = nth_exn accounts 0 in + let ticket_hash = nth_exn hashes1 0 in + + let content1 : operation_content = + Transfer {destination = account1_pk; ticket_hash; amount = 30L} + in + let transfer1 : operation = + {signer = account1_pk; counter = 0L; content = content1} + in + + let* (status, ctxt) = + Apply.Internal_for_tests.apply_transaction ctxt [transfer1] + in + + assert (status = Success) ; + + let* () = + check_counter ctxt "account1_pk" "after operation" account1_pk 1L + in + + let* () = + check_balance + ctxt + "account1_pk" + "ticket1" + "after operation" + account1_pk + ticket_hash + 100L + in + + return () + + (** Check a transfer with a negative amount raises an error. *) + let test_tx_rollup_apply_negative_transfer () = + let open Syntax in + with_initial_setup [[(ticket1, 100L)]] @@ fun ctxt accounts -> + let (_, account1_pk, hashes1) = nth_exn accounts 0 in + let ticket_hash = nth_exn hashes1 0 in + + let content1 : operation_content = + Transfer {destination = account1_pk; ticket_hash; amount = -30L} + in + let transfer1 : operation = + {signer = account1_pk; counter = 0L; content = content1} + in + + let* (status, ctxt) = + Apply.Internal_for_tests.apply_transaction ctxt [transfer1] + in + + assert (status = Failure {index = 0; reason = Invalid_transfer}) ; + + let* () = + check_counter ctxt "account1_pk" "after operation" account1_pk 1L + in + + let* () = + check_balance + ctxt + "account1_pk" + "ticket1" + "after operation" + account1_pk + ticket_hash + 100L + in + + return () + + (** Check a transfer triggering an integer overflow raises an + error. *) + let test_tx_rollup_apply_overflow_transfer () = + let open Syntax in + with_initial_setup [[(ticket1, 1L)]; [(ticket1, Int64.max_int)]] + @@ fun ctxt accounts -> + let (_, account1_pk, hashes1) = nth_exn accounts 0 in + let (_, account2_pk, _) = nth_exn accounts 1 in + let ticket_hash = nth_exn hashes1 0 in + + let content1 : operation_content = + Transfer {destination = account2_pk; ticket_hash; amount = 1L} + in + let transfer1 : operation = + {signer = account1_pk; counter = 0L; content = content1} + in + + let* (status, ctxt) = + Apply.Internal_for_tests.apply_transaction ctxt [transfer1] + in + + assert ( + status + = Failure + { + index = 0; + reason = Balance_overflow {account = account2_pk; ticket_hash}; + }) ; + + let* () = + check_counter ctxt "account1_pk" "after operation" account1_pk 1L + in + + let* () = + check_balance + ctxt + "account1_pk" + "ticket1" + "after operation" + account1_pk + ticket_hash + 1L + in + + let* () = + check_balance + ctxt + "account1_pk" + "ticket1" + "after operation" + account2_pk + ticket_hash + Int64.max_int + in + + return () + + (** Check a deposit triggering an integer overflow raises an + error. *) + let test_tx_rollup_apply_overflow_deposit () = + let open Syntax in + with_initial_setup [[(ticket1, Int64.max_int)]] @@ fun ctxt accounts -> + let (_, account1_pk, hashes1) = nth_exn accounts 0 in + let key_hash = nth_exn hashes1 0 in + + catch + (Apply.apply_deposit + ctxt + {destination = account1_pk; key_hash; amount = 1L}) + (fun _ -> assert false) + (function Balance_overflow _ -> return () | _ -> assert false) + + (** Check a transaction with two valid transfers has the expected + effect on the storage. *) + let test_tx_rollup_apply_correct_trade () = + let open Syntax in + with_initial_setup [[(ticket1, 100L)]; [(ticket2, 50L)]] + @@ fun ctxt accounts -> + let (_, pk1, hashes1) = nth_exn accounts 0 in + let (_, pk2, hashes2) = nth_exn accounts 1 in + let hash1 = nth_exn hashes1 0 in + let hash2 = nth_exn hashes2 0 in + + let transfer1 : operation = + { + signer = pk1; + counter = 0L; + content = + Transfer {destination = pk2; ticket_hash = hash1; amount = 30L}; + } + in + let transfer2 : operation = + { + signer = pk2; + counter = 0L; + content = + Transfer {destination = pk1; ticket_hash = hash2; amount = 15L}; + } + in + + let* (status, ctxt) = + Apply.Internal_for_tests.apply_transaction ctxt [transfer1; transfer2] + in + + assert (status = Success) ; + + let* () = check_counter ctxt "pk1" "after operation" pk1 1L in + let* () = check_counter ctxt "pk2" "after operation" pk2 1L in + + let* () = + check_balance ctxt "pk1" "ticket1" "after operation" pk1 hash1 70L + in + let* () = + check_balance ctxt "pk1" "ticket2" "after operation" pk1 hash2 15L + in + let* () = + check_balance ctxt "pk2" "ticket1" "after operation" pk2 hash1 30L + in + let* () = + check_balance ctxt "pk2" "ticket2" "after operation" pk2 hash2 35L + in + + return () + + (** Check a transaction with a valid transfer and an invalid one has + the expected effect on the storage. The balances should be left + unchanged, but the counters of the related accounts are + incremented. *) + let test_tx_rollup_apply_wrong_counter () = + let open Syntax in + with_initial_setup [[(ticket1, 100L)]; [(ticket2, 50L)]] + @@ fun ctxt accounts -> + let (_, pk1, hashes1) = nth_exn accounts 0 in + let (_, pk2, hashes2) = nth_exn accounts 1 in + let hash1 = nth_exn hashes1 0 in + let hash2 = nth_exn hashes2 0 in + + let transfer1 : operation = + { + signer = pk1; + counter = 0L; + content = + Transfer {destination = pk2; ticket_hash = hash1; amount = 30L}; + } + in + let transfer2 : operation = + { + signer = pk2; + (* wrong counter *) + counter = 1L; + content = + Transfer {destination = pk1; ticket_hash = hash2; amount = 20L}; + } + in + + let* (status, ctxt) = + Apply.Internal_for_tests.apply_transaction ctxt [transfer1; transfer2] + in + + assert ( + status + = Failure + { + index = 1; + reason = + Counter_mismatch {account = pk2; requested = 1L; actual = 0L}; + }) ; + + let* () = + check_counter ctxt "pk1" "should be unchanged after operation" pk1 0L + in + let* () = + check_counter ctxt "pk2" "should be unchanged after operation" pk2 0L + in + + let* () = + check_balance + ctxt + "pk1" + "ticket1" + "should be unchanged after operation" + pk1 + hash1 + 100L + in + let* () = + check_balance + ctxt + "pk1" + "ticket2" + "should be unchanged after operation" + pk1 + hash2 + 0L + in + let* () = + check_balance + ctxt + "pk2" + "ticket1" + "should be unchanged after operation" + pk2 + hash1 + 0L + in + let* () = + check_balance + ctxt + "pk2" + "ticket2" + "should be unchanged after operation" + pk2 + hash2 + 50L + in + + return () + + (** Check a transfer with an amount too high raises an error. *) + let test_tx_rollup_apply_low_balance () = + let open Syntax in + with_initial_setup [[(ticket1, 100L)]; [(ticket2, 50L)]] + @@ fun ctxt accounts -> + let (_, pk1, hashes1) = nth_exn accounts 0 in + let (_, pk2, hashes2) = nth_exn accounts 1 in + let hash1 = nth_exn hashes1 0 in + let hash2 = nth_exn hashes2 0 in + + let transfer1 : operation = + { + signer = pk1; + counter = 0L; + content = + Transfer {destination = pk2; ticket_hash = hash1; amount = 30L}; + } + in + let transfer2 : operation = + { + signer = pk2; + counter = 0L; + content = + Transfer {destination = pk1; ticket_hash = hash2; amount = 55L}; + } + in + + let* (status, ctxt) = + Apply.Internal_for_tests.apply_transaction ctxt [transfer1; transfer2] + in + + assert ( + status + = Failure + { + index = 1; + reason = + Balance_too_low + { + account = pk2; + ticket_hash = hash2; + requested = 55L; + actual = 50L; + }; + }) ; + + let* () = check_counter ctxt "pk1" "after operation" pk1 1L in + let* () = check_counter ctxt "pk2" "after operation" pk2 1L in + + let* () = + check_balance + ctxt + "pk1" + "ticket1" + "should be unchanged after operation" + pk1 + hash1 + 100L + in + let* () = + check_balance + ctxt + "pk1" + "ticket2" + "should be unchanged after operation" + pk1 + hash2 + 0L + in + let* () = + check_balance + ctxt + "pk2" + "ticket1" + "should be unchanged after operation" + pk2 + hash1 + 0L + in + let* () = + check_balance + ctxt + "pk2" + "ticket2" + "should be unchanged after operation" + pk2 + hash2 + 50L + in + + return () + + (** Check a valid batch has the expected effects on the storage. *) + let test_tx_rollup_apply_correct_batch () = + let open Syntax in + with_initial_setup [[(ticket1, 100L)]; [(ticket2, 50L)]] + @@ fun ctxt accounts -> + let (sk1, pk1, hashes1) = nth_exn accounts 0 in + let (sk2, pk2, hashes2) = nth_exn accounts 1 in + let hash1 = nth_exn hashes1 0 in + let hash2 = nth_exn hashes2 0 in + + let transfer1 : operation = + { + signer = pk1; + counter = 0L; + content = + Transfer {destination = pk2; ticket_hash = hash1; amount = 30L}; + } + in + let transfer2 : operation = + { + signer = pk2; + counter = 0L; + content = + Transfer {destination = pk1; ticket_hash = hash2; amount = 20L}; + } + in + + let transaction = [transfer1; transfer2] in + let signature = sign_ops [sk1; sk2] transaction in + + let batch : transactions_batch = batch [transaction] signature in + + let* (_, ctxt) = Apply.apply_transactions_batch ctxt batch in + + let* () = check_counter ctxt "pk1" "after operation" pk1 1L in + let* () = check_counter ctxt "pk2" "after operation" pk2 1L in + + let* () = + check_balance ctxt "pk1" "ticket1" "after operation" pk1 hash1 70L + in + let* () = + check_balance ctxt "pk1" "ticket2" "after operation" pk1 hash2 20L + in + let* () = + check_balance ctxt "pk2" "ticket1" "after operation" pk2 hash1 30L + in + let* () = + check_balance ctxt "pk2" "ticket2" "after operation" pk2 hash2 30L + in + + return () + + (** Check a valid batch with several transactions has the expected + effects on the storage. *) + let test_tx_rollup_apply_correct_batch_with_several_transactions () = + let open Syntax in + with_initial_setup [[(ticket1, 100L)]; [(ticket2, 50L)]] + @@ fun ctxt accounts -> + let (sk1, pk1, hashes1) = nth_exn accounts 0 in + let (sk2, pk2, hashes2) = nth_exn accounts 1 in + let hash1 = nth_exn hashes1 0 in + let hash2 = nth_exn hashes2 0 in + + let transfer1 : operation = + { + signer = pk1; + counter = 0L; + content = + Transfer {destination = pk2; ticket_hash = hash1; amount = 30L}; + } + in + let ol1 = [transfer1] in + let signatures1 = sign_ops [sk1] ol1 in + + let transfer2 : operation = + { + signer = pk2; + counter = 0L; + content = + Transfer {destination = pk1; ticket_hash = hash2; amount = 20L}; + } + in + let ol2 = [transfer2] in + let signatures2 = sign_ops [sk2] ol2 in + + let batch : transactions_batch = + batch [ol1; ol2] (signatures1 @ signatures2) + in + + let* (status, ctxt) = Apply.apply_transactions_batch ctxt batch in + + (match status with [(_, Success); (_, Success)] -> () | _ -> assert false) ; + + let* () = check_counter ctxt "pk1" "after operation" pk1 1L in + let* () = check_counter ctxt "pk2" "after operation" pk2 1L in + + let* () = + check_balance ctxt "pk1" "ticket1" "after operation" pk1 hash1 70L + in + let* () = + check_balance ctxt "pk1" "ticket2" "after operation" pk1 hash2 20L + in + let* () = + check_balance ctxt "pk2" "ticket1" "after operation" pk2 hash1 30L + in + let* () = + check_balance ctxt "pk2" "ticket2" "after operation" pk2 hash2 30L + in + + return () + + (** Check a valid batch with several transactions from the same + accounts has the expected effects on the storage. In particular, + the counter should be updated only once per transaction. *) + let test_tx_rollup_apply_correct_batch_with_several_transactions_from_same_account + () = + let open Syntax in + with_initial_setup [[(ticket1, 100L)]; [(ticket2, 50L)]] + @@ fun ctxt accounts -> + let (sk1, pk1, hashes1) = nth_exn accounts 0 in + let (_sk2, pk2, _hashes2) = nth_exn accounts 1 in + let hash1 = nth_exn hashes1 0 in + + let transfer1 : operation = + { + signer = pk1; + counter = 0L; + content = + Transfer {destination = pk2; ticket_hash = hash1; amount = 30L}; + } + in + + let transfer2 : operation = + { + signer = pk1; + counter = 0L; + content = + Transfer {destination = pk2; ticket_hash = hash1; amount = 20L}; + } + in + let ol = [transfer1; transfer2] in + let signatures = sign_ops [sk1; sk1] ol in + + let batch : transactions_batch = batch [ol] signatures in + + let* (_, ctxt) = Apply.apply_transactions_batch ctxt batch in + + let* () = check_counter ctxt "pk1" "after operation" pk1 1L in + let* () = check_counter ctxt "pk2" "after operation" pk2 0L in + + let* () = + check_balance ctxt "pk1" "ticket1" "remaining balance" pk1 hash1 50L + in + let* () = + check_balance ctxt "pk2" "ticket1" "transfered balance" pk2 hash1 50L + in + + return () + + (** Check the submission of a batch with an invalid signature raises + an error. *) + let test_tx_rollup_apply_correct_batch_wrong_signature () = + let open Syntax in + with_initial_setup [[(ticket1, 100L)]; [(ticket2, 50L)]] + @@ fun ctxt accounts -> + let (sk1, pk1, hashes1) = nth_exn accounts 0 in + let (sk2, pk2, hashes2) = nth_exn accounts 1 in + let hash1 = nth_exn hashes1 0 in + let hash2 = nth_exn hashes2 0 in + + let transfer1 : operation = + { + signer = pk1; + counter = 0L; + content = + Transfer {destination = pk2; ticket_hash = hash1; amount = 30L}; + } + in + let ol1 = [transfer1] in + let signatures1 = sign_ops [sk1] ol1 in + + let transfer2 : operation = + { + signer = pk2; + counter = 0L; + content = + Transfer {destination = pk1; ticket_hash = hash2; amount = 20L}; + } + in + let ol2 = [transfer2] in + let signatures2 = sign_ops [sk2] ol2 in + + let batch : transactions_batch = + batch [ol1; ol2] (signatures1 @ signatures2) + in + + let* () = + catch + (Apply.apply_transactions_batch + ctxt + {batch with aggregated_signatures = Bytes.empty}) + (fun _ -> assert false) + (function Bad_aggregated_signature -> return () | _ -> assert false) + in + + return () + + let tests = + let open Tezos_base_test_helpers in + [ + Tztest.tztest (storage_name ^ ": basic storage tests") `Quick + @@ to_lwt test_tx_rollup_storage; + Tztest.tztest (storage_name ^ ": apply deposit") `Quick + @@ to_lwt test_tx_rollup_apply_deposit; + Tztest.tztest + (storage_name ^ ": test rollup apply single operation") + `Quick + @@ to_lwt test_tx_rollup_apply_single_operation; + Tztest.tztest (storage_name ^ ": test rollup apply self transfer") `Quick + @@ to_lwt test_tx_rollup_apply_self_transfer; + Tztest.tztest + (storage_name ^ ": test rollup apply negative transfer") + `Quick + @@ to_lwt test_tx_rollup_apply_negative_transfer; + Tztest.tztest + (storage_name ^ ": test rollup apply overflow transfer") + `Quick + @@ to_lwt test_tx_rollup_apply_overflow_transfer; + Tztest.tztest + (storage_name ^ ": test rollup apply overflow deposit") + `Quick + @@ to_lwt test_tx_rollup_apply_overflow_deposit; + Tztest.tztest (storage_name ^ ": test rollup apply correct trade") `Quick + @@ to_lwt test_tx_rollup_apply_correct_trade; + Tztest.tztest + (storage_name ^ ": test rollup apply with low balance") + `Quick + @@ to_lwt test_tx_rollup_apply_low_balance; + Tztest.tztest (storage_name ^ ": test rollup apply wrong counter") `Quick + @@ to_lwt test_tx_rollup_apply_wrong_counter; + Tztest.tztest (storage_name ^ ": test rollup apply correct batch") `Quick + @@ to_lwt test_tx_rollup_apply_correct_batch; + Tztest.tztest + (storage_name + ^ ": test rollup apply correct batch with several operations") + `Quick + @@ to_lwt test_tx_rollup_apply_correct_batch_with_several_transactions; + Tztest.tztest + (storage_name + ^ ": test rollup apply correct batch with several operations from the \ + same account") + `Quick + @@ to_lwt + test_tx_rollup_apply_correct_batch_with_several_transactions_from_same_account; + Tztest.tztest + (storage_name ^ ": test rollup apply batch with wrong signature") + `Quick + @@ to_lwt test_tx_rollup_apply_correct_batch_wrong_signature; + ] +end + +module Map_test_suite = L2_test_suite (Map_context) let tests = [ @@ -131,5 +1480,39 @@ let tests = Tztest.tztest "check two originated tx rollup in one operation have different address" `Quick - test_two_origination; + test_two_originations; + Tztest.tztest + "check the function that updates the cost per byte rate per inbox" + `Quick + test_cost_per_byte_update; + Tztest.tztest "add one batch to a rollup" `Quick test_add_batch; + Tztest.tztest "add two batches to a rollup" `Quick test_add_two_batches; + Tztest.tztest + "Try to add a batch larger than the limit" + `Quick + test_batch_too_big; + Tztest.tztest + "Try to add several batches to reach the inbox limit" + `Quick + test_inbox_too_big; + Tztest.tztest "Test finalization" `Quick test_finalization; + Tztest.tztest "Test deposit with valid contract" `Quick test_valid_deposit; + Tztest.tztest + "Test deposit with invalid parameter" + `Quick + test_invalid_deposit_not_ticket; + Tztest.tztest + "Test valid deposit to inexistant rollup" + `Quick + test_valid_deposit_inexistant_rollup; + Tztest.tztest "Test invalid entrypoint" `Quick test_invalid_entrypoint; + Tztest.tztest + "Test valid deposit to invalid L2 address" + `Quick + test_invalid_l2_account; + Tztest.tztest + "Test valid deposit with non-zero amount" + `Quick + test_valid_deposit_invalid_amount; ] + @ Map_test_suite.tests diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml b/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml index 640f7266f377f6941084483c582d1f2cce7437e9..5efb596b79cbb024b23eaf0493eca89e548f593a 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml @@ -64,6 +64,8 @@ let rec reference_compare_comparable : type a. a comparable_ty -> a -> a -> int | (Timestamp_key _, x, y) -> normalize_compare @@ Script_timestamp.compare x y | (Address_key _, x, y) -> normalize_compare @@ Script_comparable.compare_address x y + | (Tx_rollup_l2_address_key _, x, y) -> + normalize_compare @@ Script_comparable.compare_tx_rollup_l2_address x y | (Bytes_key _, x, y) -> normalize_compare @@ Compare.Bytes.compare x y | (Chain_id_key _, x, y) -> normalize_compare @@ Chain_id.compare x y | (Pair_key ((tl, _), (tr, _), _), (lx, rx), (ly, ry)) -> diff --git a/src/proto_alpha/lib_protocol/ticket_balance_key.ml b/src/proto_alpha/lib_protocol/ticket_balance_key.ml index 2a12426b0e298cba0b1670a314d32b2a80fb6f53..34a505442c9fa6b01d5ab1e2d97ff692ed4d2139 100644 --- a/src/proto_alpha/lib_protocol/ticket_balance_key.ml +++ b/src/proto_alpha/lib_protocol/ticket_balance_key.ml @@ -43,8 +43,8 @@ let ticket_balance_key ctxt ~owner Gas.consume ctxt (Script.strip_annotations_cost cont_ty_unstripped) >>?= fun ctxt -> let typ = Script.strip_annotations cont_ty_unstripped in - let ticketer_address = (ticketer, Entrypoint.default) in - let owner_address = (owner, Entrypoint.default) in + let ticketer_address = (Destination.Contract ticketer, Entrypoint.default) in + let owner_address = (Destination.Contract owner, Entrypoint.default) in let address_t = Script_typed_ir.address_t ~annot:None in Script_ir_translator.unparse_data ctxt @@ -65,4 +65,4 @@ let ticket_balance_key ctxt ~owner address_t owner_address >>=? fun (owner, ctxt) -> - Lwt.return (Ticket_balance.make_key_hash ctxt ~ticketer ~typ ~contents ~owner) + Lwt.return (Ticket_hash.make ctxt ~ticketer ~typ ~contents ~owner) diff --git a/src/proto_alpha/lib_protocol/ticket_balance_key.mli b/src/proto_alpha/lib_protocol/ticket_balance_key.mli index ab6b34dfbf00ebdacc1c5556caa347322432e6c5..1b0900673f4b26486bc15bb51eb659085eb32a59 100644 --- a/src/proto_alpha/lib_protocol/ticket_balance_key.mli +++ b/src/proto_alpha/lib_protocol/ticket_balance_key.mli @@ -34,4 +34,4 @@ val ticket_balance_key : Alpha_context.context -> owner:Alpha_context.Contract.t -> Ticket_token.ex_token -> - (Alpha_context.Ticket_balance.key_hash * Alpha_context.context) tzresult Lwt.t + (Alpha_context.Ticket_hash.t * Alpha_context.context) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/ticket_hash_repr.ml b/src/proto_alpha/lib_protocol/ticket_hash_repr.ml new file mode 100644 index 0000000000000000000000000000000000000000..2b9700d4c3e9a4d68d284b1558528abbbf0481eb --- /dev/null +++ b/src/proto_alpha/lib_protocol/ticket_hash_repr.ml @@ -0,0 +1,67 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Trili Tech, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type error += Failed_to_hash_node + +let () = + register_error_kind + `Branch + ~id:"Failed_to_hash_node" + ~title:"Failed to hash node" + ~description:"Failed to hash node for a key in the ticket-balance table" + ~pp:(fun ppf () -> + Format.fprintf + ppf + "Failed to hash node for a key in the ticket-balance table") + Data_encoding.empty + (function Failed_to_hash_node -> Some () | _ -> None) + (fun () -> Failed_to_hash_node) + +type t = Script_expr_hash.t + +let encoding = Script_expr_hash.encoding + +let to_script_expr_hash key_hash = key_hash + +let hash_bytes_cost bytes = + let module S = Saturation_repr in + let ( + ) = S.add in + let v0 = S.safe_int @@ Bytes.length bytes in + let ( lsr ) = S.shift_right in + S.safe_int 200 + (v0 + (v0 lsr 2)) |> Gas_limit_repr.atomic_step_cost + +let hash_of_node ctxt node = + Raw_context.consume_gas ctxt (Script_repr.strip_locations_cost node) + >>? fun ctxt -> + let node = Micheline.strip_locations node in + match Data_encoding.Binary.to_bytes_opt Script_repr.expr_encoding node with + | Some bytes -> + Raw_context.consume_gas ctxt (hash_bytes_cost bytes) >|? fun ctxt -> + (Script_expr_hash.hash_bytes [bytes], ctxt) + | None -> error Failed_to_hash_node + +let make ctxt ~ticketer ~typ ~contents ~owner = + hash_of_node ctxt + @@ Micheline.Seq (Micheline.dummy_location, [ticketer; typ; contents; owner]) diff --git a/src/proto_alpha/lib_protocol/ticket_hash_repr.mli b/src/proto_alpha/lib_protocol/ticket_hash_repr.mli new file mode 100644 index 0000000000000000000000000000000000000000..25db4a525d84122281515564d42a93f7f9f262d4 --- /dev/null +++ b/src/proto_alpha/lib_protocol/ticket_hash_repr.mli @@ -0,0 +1,50 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Trili Tech, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** A value of type [key_hash] is a hashed combination of: + - Ticketer + - Content type + - Content + - Owner *) +type t + +val encoding : t Data_encoding.t + +(** [to_script_expr_hash key_hash] returns a [Script_expr_hash.t] + value representation of the given [key_hash]. This is useful for + comparing and pretty-printing key-hash values. *) +val to_script_expr_hash : t -> Script_expr_hash.t + +(** [make ctxt ~ticketer ~typ ~contents ~owner] creates a hashed + representation of the given [ticketer], [typ], [contents] and + [owner]. +*) +val make : + Raw_context.t -> + ticketer:Script_repr.node -> + typ:Script_repr.node -> + contents:Script_repr.node -> + owner:Script_repr.node -> + (t * Raw_context.t) tzresult diff --git a/src/proto_alpha/lib_protocol/ticket_scanner.ml b/src/proto_alpha/lib_protocol/ticket_scanner.ml index ddccfb016cc7c7ecffc224976cc224973bf503d7..95d340afd13e73a6518af3b8f0071d2c734b2262 100644 --- a/src/proto_alpha/lib_protocol/ticket_scanner.ml +++ b/src/proto_alpha/lib_protocol/ticket_scanner.ml @@ -125,6 +125,7 @@ module Ticket_inspection = struct | Timestamp_key _ -> (k [@ocaml.tailcall]) False_ht | Chain_id_key _ -> (k [@ocaml.tailcall]) False_ht | Address_key _ -> (k [@ocaml.tailcall]) False_ht + | Tx_rollup_l2_address_key _ -> (k [@ocaml.tailcall]) False_ht | Pair_key ((_, _), (_, _), _) -> (k [@ocaml.tailcall]) False_ht | Union_key (_, (_, _), _) -> (k [@ocaml.tailcall]) False_ht | Option_key (_, _) -> (k [@ocaml.tailcall]) False_ht @@ -162,6 +163,7 @@ module Ticket_inspection = struct | Key_t _ -> (k [@ocaml.tailcall]) False_ht | Timestamp_t _ -> (k [@ocaml.tailcall]) False_ht | Address_t _ -> (k [@ocaml.tailcall]) False_ht + | Tx_rollup_l2_address_t _ -> (k [@ocaml.tailcall]) False_ht | Bool_t _ -> (k [@ocaml.tailcall]) False_ht | Pair_t ((ty1, _, _), (ty2, _, _), _) -> (has_tickets_of_pair [@ocaml.tailcall]) @@ -287,6 +289,7 @@ module Ticket_collection = struct | Timestamp_key _ -> (k [@ocaml.tailcall]) ctxt acc | Chain_id_key _ -> (k [@ocaml.tailcall]) ctxt acc | Address_key _ -> (k [@ocaml.tailcall]) ctxt acc + | Tx_rollup_l2_address_key _ -> (k [@ocaml.tailcall]) ctxt acc | Pair_key ((_, _), (_, _), _) -> (k [@ocaml.tailcall]) ctxt acc | Union_key ((_, _), (_, _), _) -> (k [@ocaml.tailcall]) ctxt acc | Option_key (_, _) -> (k [@ocaml.tailcall]) ctxt acc diff --git a/src/proto_alpha/lib_protocol/ticket_storage.ml b/src/proto_alpha/lib_protocol/ticket_storage.ml index 9e97567d1708147004e9111741bb082e8729909f..af4f1bd4836b616bf4d2f67134b7ad7e3c02b22f 100644 --- a/src/proto_alpha/lib_protocol/ticket_storage.ml +++ b/src/proto_alpha/lib_protocol/ticket_storage.ml @@ -23,34 +23,8 @@ (* *) (*****************************************************************************) -type key_hash = Script_expr_hash.t - type error += | Negative_ticket_balance of {key : Script_expr_hash.t; balance : Z.t} - | Failed_to_hash_node - -let script_expr_hash_of_key_hash key_hash = key_hash - -let hash_bytes_cost bytes = - let module S = Saturation_repr in - let ( + ) = S.add in - let v0 = S.safe_int @@ Bytes.length bytes in - let ( lsr ) = S.shift_right in - S.safe_int 200 + (v0 + (v0 lsr 2)) |> Gas_limit_repr.atomic_step_cost - -let hash_of_node ctxt node = - Raw_context.consume_gas ctxt (Script_repr.strip_locations_cost node) - >>? fun ctxt -> - let node = Micheline.strip_locations node in - match Data_encoding.Binary.to_bytes_opt Script_repr.expr_encoding node with - | Some bytes -> - Raw_context.consume_gas ctxt (hash_bytes_cost bytes) >|? fun ctxt -> - (Script_expr_hash.hash_bytes [bytes], ctxt) - | None -> error Failed_to_hash_node - -let make_key_hash ctxt ~ticketer ~typ ~contents ~owner = - hash_of_node ctxt - @@ Micheline.Seq (Micheline.dummy_location, [ticketer; typ; contents; owner]) let () = let open Data_encoding in @@ -71,24 +45,16 @@ let () = (function | Negative_ticket_balance {key; balance} -> Some (key, balance) | _ -> None) - (fun (key, balance) -> Negative_ticket_balance {key; balance}) ; - register_error_kind - `Branch - ~id:"Failed_to_hash_node" - ~title:"Failed to hash node" - ~description:"Failed to hash node for a key in the ticket-balance table" - ~pp:(fun ppf () -> - Format.fprintf - ppf - "Failed to hash node for a key in the ticket-balance table") - Data_encoding.empty - (function Failed_to_hash_node -> Some () | _ -> None) - (fun () -> Failed_to_hash_node) + (fun (key, balance) -> Negative_ticket_balance {key; balance}) let get_balance ctxt key = - Storage.Ticket_balance.Table.find ctxt key >|=? fun (ctxt, res) -> (res, ctxt) + Storage.Ticket_balance.Table.find + ctxt + (Ticket_hash_repr.to_script_expr_hash key) + >|=? fun (ctxt, res) -> (res, ctxt) let set_balance ctxt key balance = + let key = Ticket_hash_repr.to_script_expr_hash key in let cost_of_key = Z.of_int 65 in fail_when Compare.Z.(balance < Z.zero) diff --git a/src/proto_alpha/lib_protocol/ticket_storage.mli b/src/proto_alpha/lib_protocol/ticket_storage.mli index c116eb0521771792f4288605bf76a9f032da7a03..1930ce29a2f839aa2f9719fe9fa2b7e27cd4bdb5 100644 --- a/src/proto_alpha/lib_protocol/ticket_storage.mli +++ b/src/proto_alpha/lib_protocol/ticket_storage.mli @@ -23,37 +23,15 @@ (* *) (*****************************************************************************) -(** A value of type [key_hash] is a hashed combination of: - - Ticketer - - Content type - - Content - - Owner -*) -type key_hash - -(** [script_expr_hash_of_key_hash key_hash] returns a [Script_expr_hash.t] value - representation of the given [key_hash]. This is useful for comparing and - pretty-printing key-hash values. *) -val script_expr_hash_of_key_hash : key_hash -> Script_expr_hash.t - -(** [make_key_hash ctxt ~ticketer ~typ ~contents ~owner] creates a hashed - representation of the given [ticketer], [typ], [contents] and [owner]. -*) -val make_key_hash : - Raw_context.t -> - ticketer:Script_repr.node -> - typ:Script_repr.node -> - contents:Script_repr.node -> - owner:Script_repr.node -> - (key_hash * Raw_context.t) tzresult - (** [get_balance ctxt key] receives the ticket balance for the given [key] in the context [ctxt]. The [key] represents a ticket content and a ticket creator pair. In case there exists no value for the given [key], [None] is returned. *) val get_balance : - Raw_context.t -> key_hash -> (Z.t option * Raw_context.t) tzresult Lwt.t + Raw_context.t -> + Ticket_hash_repr.t -> + (Z.t option * Raw_context.t) tzresult Lwt.t (** [adjust_balance ctxt key ~delta] adjusts the balance of the given key (representing a ticket content, creator and owner pair) @@ -68,4 +46,7 @@ val get_balance : in case the resulting balance is negative. *) val adjust_balance : - Raw_context.t -> key_hash -> delta:Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t + Raw_context.t -> + Ticket_hash_repr.t -> + delta:Z.t -> + (Z.t * Raw_context.t) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/tx_rollup_inbox_repr.ml b/src/proto_alpha/lib_protocol/tx_rollup_inbox_repr.ml new file mode 100644 index 0000000000000000000000000000000000000000..1fb608b71364bd387e1d5bf20e74ec79af5cad9c --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_inbox_repr.ml @@ -0,0 +1,121 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type deposit = { + destination : Tx_rollup_l2_address_repr.t; + key_hash : Ticket_hash_repr.t; + amount : int64; +} + +let deposit_encoding = + let open Data_encoding in + conv + (fun {destination; key_hash; amount} -> (destination, key_hash, amount)) + (fun (destination, key_hash, amount) -> {destination; key_hash; amount}) + @@ obj3 + (req "destination" Tx_rollup_l2_address_repr.encoding) + (req "key_hash" Ticket_hash_repr.encoding) + (req "amount" int64) + +type message = Batch of string | Deposit of deposit + +let message_encoding = + let open Data_encoding in + union + ~tag_size:`Uint8 + [ + case + (Tag 0) + ~title:"Batch" + (obj1 (req "batch" string)) + (function Batch batch -> Some batch | _ -> None) + (fun batch -> Batch batch); + case + (Tag 1) + ~title:"Deposit" + (obj1 (req "deposit" deposit_encoding)) + (function Deposit deposit -> Some deposit | _ -> None) + (fun deposit -> Deposit deposit); + ] + +let message_size = function + | Batch batch -> String.length batch + | Deposit {destination = _; key_hash = _; amount = _} -> + (* Size of a BLS public key, that is the underlying type of a + l2 address. See [Tx_rollup_l2_address] *) + let destination_size = 48 in + (* Size of a a script expr hash, that is the underlying type + of key hash. See [Ticket_repr] and [Script_expr_hash] *) + let key_hash_size = 32 in + (* [int64] *) + let amount_size = 8 in + destination_size + key_hash_size + amount_size + +let hash_size = 32 + +module Message_hash = + Blake2B.Make + (Base58) + (struct + let name = "Tx_rollup_inbox_message_hash" + + let title = "The hash of a a transaction rollup inbox’s message" + + let b58check_prefix = "\001\014\133" (* h2(52) *) + + let size = Some hash_size + end) + +let () = Base58.check_encoded_prefix Message_hash.b58check_encoding "h2" 52 + +type message_hash = Message_hash.t + +let message_hash_pp = Message_hash.pp + +let message_hash_encoding = Message_hash.encoding + +let hash_message msg = + Message_hash.hash_bytes + [Data_encoding.Binary.to_bytes_exn message_encoding msg] + +type t = {contents : message_hash list; cumulated_size : int} + +let pp fmt {contents; cumulated_size} = + Format.fprintf + fmt + "tx rollup inbox: %d messages using %d bytes" + (List.length contents) + cumulated_size + +let encoding = + let open Data_encoding in + conv + (fun {contents; cumulated_size} -> (contents, cumulated_size)) + (fun (contents, cumulated_size) -> {contents; cumulated_size}) + (obj2 + (req "contents" @@ list message_hash_encoding) + (req "cumulated_size" int31)) diff --git a/src/proto_alpha/lib_protocol/tx_rollup_inbox_repr.mli b/src/proto_alpha/lib_protocol/tx_rollup_inbox_repr.mli new file mode 100644 index 0000000000000000000000000000000000000000..2e8dab8bf57e253fda317412a99f5ff7e12482e4 --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_inbox_repr.mli @@ -0,0 +1,72 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Smart contract on the layer-1 can “deposit” tickets into a + transaction rollup, for the benefit of a so-called l2 address. *) +type deposit = { + destination : Tx_rollup_l2_address_repr.t; + key_hash : Ticket_hash_repr.t; + amount : int64; +} + +(** A [message] is a piece of data submitted though the layer-1 to be + interpreted by the layer-2. + + {ul {li A raw array of bytes that supposedly contains a sequence + of L2 operations.} + {li A deposit order for a L1 ticket.}} *) +type message = Batch of string | Deposit of deposit + +(** [message_size msg] returns the number of bytes allocated in an + inbox by [msg]. *) +val message_size : message -> int + +val message_encoding : message Data_encoding.t + +type message_hash + +val message_hash_encoding : message_hash Data_encoding.t + +val message_hash_pp : Format.formatter -> message_hash -> unit + +val hash_message : message -> message_hash + +(** An inbox gathers, for a given Tezos level, messages crafted by the + layer-1 for the layer-2 to interpret. + + The structure comprises two fields: (1) [contents] is the list of + message hashes, and (2) [cumulated_size] is the quantity of bytes + allocated by the related messages. + + We recall that a transaction rollup can have up to one inbox per + Tezos level, starting from its origination. See + {!Storage.Tx_rollup} for more information. *) +type t = {contents : message_hash list; cumulated_size : int} + +val pp : Format.formatter -> t -> unit + +val encoding : t Data_encoding.t diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_address_repr.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_address_repr.ml new file mode 100644 index 0000000000000000000000000000000000000000..84395e363c49b4949d6d3d637a39cf96cc462721 --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_address_repr.ml @@ -0,0 +1,45 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = Bls_signature.pk + +let encoding = + Data_encoding.( + conv + Bls_signature.pk_to_bytes + (fun b -> + match Bls_signature.pk_of_bytes_opt b with + | Some b -> b + | _ -> raise (Invalid_argument "bls public key encoding")) + bytes) + +let compare x y = + Bytes.compare (Bls_signature.pk_to_bytes x) (Bls_signature.pk_to_bytes y) + +let in_memory_size : t -> Cache_memory_helpers.sint = + fun pk -> + Bls_signature.pk_to_bytes pk |> Bytes.length |> Saturation_repr.safe_int diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_address_repr.mli b/src/proto_alpha/lib_protocol/tx_rollup_l2_address_repr.mli new file mode 100644 index 0000000000000000000000000000000000000000..3a22c0e65756cac0252039fa20780c09fc452e98 --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_address_repr.mli @@ -0,0 +1,34 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = Bls_signature.pk + +val encoding : t Data_encoding.t + +val compare : t -> t -> int + +val in_memory_size : t -> Cache_memory_helpers.sint diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml new file mode 100644 index 0000000000000000000000000000000000000000..f42f509fe2a767cd8819fb004621e8fbb6c99b77 --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml @@ -0,0 +1,309 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Tx_rollup_l2_context +open Tx_rollup_l2_operation + +type error += + | Balance_too_low of { + account : Tx_rollup_l2_address.t; + ticket_hash : Ticket_hash.t; + requested : int64; + actual : int64; + } + +type error += + | Balance_overflow of { + account : Tx_rollup_l2_address.t; + ticket_hash : Ticket_hash.t; + } + +type error += Invalid_deposit + +type error += Invalid_transfer + +type error += + | Counter_mismatch of { + account : Tx_rollup_l2_address.t; + requested : int64; + actual : int64; + } + +type error += Bad_aggregated_signature + +let () = + let open Data_encoding in + (* Balance too low *) + register_error_kind + `Permanent + ~id:"tx_rollup_balance_too_low" + ~title:"Balance too low" + ~description: + "Cannot transfer the requested amount of tickets because the current \ + balance is too low." + (obj4 + (req "account" Tx_rollup_l2_address.encoding) + (req "ticket_hash" Ticket_hash.encoding) + (req "requested" int64) + (req "actual" int64)) + (function + | Balance_too_low {account; ticket_hash; requested; actual} -> + Some (account, ticket_hash, requested, actual) + | _ -> None) + (fun (account, ticket_hash, requested, actual) -> + Balance_too_low {account; ticket_hash; requested; actual}) ; + (* Balance overflow *) + register_error_kind + `Permanent + ~id:"tx_rollup_balance_overflow" + ~title:"Balance overflow" + ~description: + "Cannot transfer the requested amount of tickets because the current \ + balance would overflow." + (obj2 + (req "account" Tx_rollup_l2_address.encoding) + (req "ticket_hash" Ticket_hash.encoding)) + (function + | Balance_overflow {account; ticket_hash} -> Some (account, ticket_hash) + | _ -> None) + (fun (account, ticket_hash) -> Balance_overflow {account; ticket_hash}) ; + (* Invalid deposit *) + register_error_kind + `Permanent + ~id:"tx_rollup_invalid_deposit" + ~title:"Invalid deposit" + ~description:"A deposit with erroneous arguments has been issued." + empty + (function Invalid_deposit -> Some () | _ -> None) + (fun () -> Invalid_deposit) ; + (* Invalid transfer *) + register_error_kind + `Permanent + ~id:"tx_rollup_invalid_transfer" + ~title:"Invalid transfer" + ~description:"A transfer with erroneous arguments has been issued." + empty + (function Invalid_transfer -> Some () | _ -> None) + (fun () -> Invalid_transfer) ; + (* Counter mismatch *) + register_error_kind + `Permanent + ~id:"tx_rollup_counter_mismatch" + ~title:"Conuter mismatch" + ~description: + "A transaction rollup has been submitted with an incorrect counter." + (obj3 + (req "account" Tx_rollup_l2_address.encoding) + (req "requested" int64) + (req "actual" int64)) + (function + | Counter_mismatch {account; requested; actual} -> + Some (account, requested, actual) + | _ -> None) + (fun (account, requested, actual) -> + Counter_mismatch {account; requested; actual}) ; + (* Bad aggregated signature *) + register_error_kind + `Permanent + ~id:"tx_rollup_bad_aggregated_signature" + ~title:"Bad aggregated signature" + ~description: + "An incorrect aggregated signature has been provided with a transactions \ + batch." + empty + (function Bad_aggregated_signature -> Some () | _ -> None) + (fun () -> Bad_aggregated_signature) + +type transaction_status = Success | Failure of {index : int; reason : error} + +module Account_set = Set.Make (Tx_rollup_l2_address) + +module Make (Context : CONTEXT) = struct + open Context + + let safe_balance_sub : + t -> Tx_rollup_l2_address.t -> Ticket_hash.t -> int64 -> t m = + fun ctxt source ticket_hash amount -> + let open Syntax in + let* src_balance = Ticket_ledger.get ctxt ticket_hash source in + let remainder = Int64.sub src_balance amount in + let* () = + fail_unless Compare.Int64.(0L <= remainder) + @@ Balance_too_low + { + account = source; + ticket_hash; + requested = amount; + actual = src_balance; + } + in + Ticket_ledger.set ctxt ticket_hash source remainder + + let safe_balance_add : + t -> Tx_rollup_l2_address.t -> Ticket_hash.t -> int64 -> t m = + fun ctxt destination ticket_hash amount -> + let open Syntax in + let* balance = Ticket_ledger.get ctxt ticket_hash destination in + let new_balance = Int64.add balance amount in + let* () = + fail_unless Compare.Int64.(balance <= new_balance) + @@ Balance_overflow {account = destination; ticket_hash} + in + Ticket_ledger.set ctxt ticket_hash destination new_balance + + let apply_transfer : + t -> + Tx_rollup_l2_address.t -> + Tx_rollup_l2_address.t -> + Ticket_hash.t -> + int64 -> + t m = + fun ctxt source destination ticket_hash amount -> + let open Syntax in + let* () = fail_unless Compare.Int64.(0L < amount) Invalid_transfer in + let* ctxt = safe_balance_sub ctxt source ticket_hash amount in + let* ctxt = safe_balance_add ctxt destination ticket_hash amount in + return ctxt + + let apply_operation : t -> int64 -> operation -> t m = + fun ctxt counter op -> + let open Syntax in + let* () = + fail_unless Compare.Int64.(counter = op.counter) + @@ Counter_mismatch + {account = op.signer; actual = counter; requested = op.counter} + in + match op.content with + | Transfer {destination; ticket_hash; amount} -> + apply_transfer ctxt op.signer destination ticket_hash amount + + let check_signatures : + transaction list -> Tx_rollup_l2_operation.signature -> bool m = + fun contents signatures -> + let to_bytes contents = + Data_encoding.Binary.to_bytes_exn transaction_encoding contents + in + + let transmitted = + List.concat_map + (fun transaction -> + let buf = to_bytes transaction in + let seen = Account_set.empty in + + let f (acc, seen) op = + let signer = op.signer in + let keep = not @@ Account_set.mem signer seen in + if keep then + let acc = Some (signer, buf) :: acc in + let seen = Account_set.add signer seen in + (acc, seen) + else (None :: acc, seen) + in + + let (unique_signatures_rev, _) = + List.fold_left f ([], seen) transaction + in + (* Note that unique_signatures_rev is reversed, but we don't + care about the order so we just leave it.*) + List.filter_map (fun t -> t) unique_signatures_rev) + contents + in + + bls_verify transmitted signatures + + let apply_transaction : t -> transaction -> (transaction_status * t) m = + fun initial_ctxt ops -> + let open Syntax in + let rec apply ctxt index = function + | op :: rst -> + let* counter = Counter.get ctxt op.signer in + let* (status, ctxt) = + catch + (apply_operation ctxt counter op) + (fun ctxt -> apply ctxt (index + 1) rst) + (fun error -> + return (Failure {index; reason = error}, initial_ctxt)) + in + return (status, ctxt) + | [] -> return (Success, ctxt) + in + + let* (status, ctxt) = apply initial_ctxt 0 ops in + match status with + | Failure {reason = Counter_mismatch _; _} -> return (status, ctxt) + | _ -> + (* We know the operations’ counters are correct, so we can use + them to increment the counter of the signer. We avoid to + due unnecessary writes by remembering which public keys we + have already treated. *) + let* (ctxt, _) = + list_fold_left_m + (fun (ctxt, acc) op -> + if Account_set.mem op.signer acc then return (ctxt, acc) + else + let* ctxt = + Counter.set ctxt op.signer (Int64.succ op.counter) + in + return (ctxt, Account_set.add op.signer acc)) + (ctxt, Account_set.empty) + ops + in + return (status, ctxt) + + let apply_transactions_batch : + t -> transactions_batch -> ((transaction * transaction_status) list * t) m + = + fun ctxt {contents; aggregated_signatures} -> + let open Syntax in + let* is_correct_signature = + check_signatures contents aggregated_signatures + in + let* () = fail_unless is_correct_signature Bad_aggregated_signature in + + let* (ctxt, rev_status) = + list_fold_left_m + (fun (ctxt, rev_status) ops -> + let* (status, ctxt) = apply_transaction ctxt ops in + return (ctxt, (ops, status) :: rev_status)) + (ctxt, []) + contents + in + return (List.rev rev_status, ctxt) + + let apply_deposit : t -> Tx_rollup_inbox.deposit -> t m = + fun ctxt {destination; key_hash; amount} -> + let open Syntax in + (* This should never happen if the layer-1 deposit implementation + is correct. *) + let* () = fail_unless Compare.Int64.(0L < amount) Invalid_deposit in + safe_balance_add ctxt destination key_hash amount + + module Internal_for_tests = struct + let apply_transaction = apply_transaction + end +end diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.mli b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.mli new file mode 100644 index 0000000000000000000000000000000000000000..63e6118ff17b09455169ebb85463d635add7e211 --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.mli @@ -0,0 +1,99 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Tx_rollup_l2_context +open Tx_rollup_l2_operation + +type transaction_status = Success | Failure of {index : int; reason : error} + +module Make (Context : CONTEXT) : sig + open Context + + (** [apply_transactions_batch ctxt batch] applies [batch] —a batch + of transactions— onto [ctxt]. + + It raises the [Bad_aggregated_signature] error iff the signature + provided with the batch is not correct. Batches are provided + with a aggregated BLS signature (using the [Augmented] scheme). + + In this case, the operations within the batch is treated as + no-operations, {i i.e.}, they are ignored, and the transactions + rollup context remains constant. As a consequences, they need to + be submitted again, with a proper signature this time. + + On the contrary, when it succeeds, this function computes: + + {ul {- A [transaction_status] result for each transaction of the batch} + {- The amount gas consumed to apply the batch} + {- A new context, modified according to the operation semantics}} *) + val apply_transactions_batch : + t -> transactions_batch -> ((transaction * transaction_status) list * t) m + + (** [apply_deposit ctxt deposit] applies the effect of [deposit] + onto [ctxt]. + + It can raise an [Invalid_deposit] error, if the [amount] field + of the [deposit] value is not strictly positive. If it happens, + it means there is a bug in the implementaiton of the deposit + operation in layer-1. It can also raise [Balance_overflow] if + applying the deposit would make the ledger overflow. *) + val apply_deposit : t -> Tx_rollup_inbox.deposit -> t m + + (** Re-export of private definitions used internally by this module. + They are provided to be used for testing purposes only. *) + module Internal_for_tests : sig + val apply_transaction : t -> transaction -> (transaction_status * t) m + end +end + +type error += + | Balance_too_low of { + account : Tx_rollup_l2_address.t; + ticket_hash : Ticket_hash.t; + requested : int64; + actual : int64; + } + +type error += + | Balance_overflow of { + account : Tx_rollup_l2_address.t; + ticket_hash : Ticket_hash.t; + } + +type error += + | Counter_mismatch of { + account : Tx_rollup_l2_address.t; + requested : int64; + actual : int64; + } + +type error += Invalid_deposit + +type error += Invalid_transfer + +type error += Bad_aggregated_signature diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml new file mode 100644 index 0000000000000000000000000000000000000000..2f9543ac1f72e70a9454a273e02b8eddc72773fd --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml @@ -0,0 +1,244 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Tx_rollup_l2_storage + +module type CONTEXT = sig + type t + + type 'a m + + module Syntax : sig + val ( let+ ) : 'a m -> ('a -> 'b) -> 'b m + + val ( let* ) : 'a m -> ('a -> 'b m) -> 'b m + + val fail : error -> 'a m + + val catch : 'a m -> ('a -> 'b m) -> (error -> 'b m) -> 'b m + + val return : 'a -> 'a m + + val list_fold_left_m : ('a -> 'b -> 'a m) -> 'a -> 'b list -> 'a m + + val fail_unless : bool -> error -> unit m + end + + val bls_verify : (Tx_rollup_l2_address.t * bytes) list -> bytes -> bool m + + module Counter : sig + val get : t -> Tx_rollup_l2_address.t -> int64 m + + val set : t -> Tx_rollup_l2_address.t -> int64 -> t m + end + + module Ticket_ledger : sig + val get : t -> Ticket_hash.t -> Tx_rollup_l2_address.t -> int64 m + + val set : t -> Ticket_hash.t -> Tx_rollup_l2_address.t -> int64 -> t m + end +end + +(** {1 Type-Safe Storage Access and Gas Accounting} *) + +(** A value of type ['a key] identifies a value of type ['a] in an + underlying, untyped storage. + + This GADT is used to enforce type-safety of the abstraction of + the transactions rollup context. For this abstraction to work, + it is necessary to ensure that the serialization of values ['a + key] and ['b key] cannot collide. To that end, we use + [Data_encoding] (see {!packed_key_encoding}). *) +type _ key = + | Counter : Tx_rollup_l2_address.t -> int64 key + | Ticket_ledger : Ticket_hash.t * Tx_rollup_l2_address.t -> int64 key + +(** A monomorphic version of {!Key}, used for serialization purposes. *) +type packed_key = Key : 'a key -> packed_key + +(** The encoding used to serialize keys to be used with an untyped storage. *) +let packed_key_encoding : packed_key Data_encoding.t = + Data_encoding.( + union + ~tag_size:`Uint8 + [ + case + (Tag 0) + ~title:"Counter" + Tx_rollup_l2_address.encoding + (function Key (Counter account) -> Some account | _ -> None) + (fun account -> Key (Counter account)); + case + (Tag 1) + ~title:"Ticket_ledger" + (tup2 Ticket_hash.encoding Tx_rollup_l2_address.encoding) + (function + | Key (Ticket_ledger (hash, account)) -> Some (hash, account) + | _ -> None) + (fun (hash, account) -> Key (Ticket_ledger (hash, account))); + ]) + +(** [value_encoding key value] returns the encoding to be used to + serialize and deserialize values associated to a [key] from and to + the underlying storage. *) +let value_encoding : type a. a key -> a Data_encoding.t = function + | Counter _ -> Data_encoding.int64 + | Ticket_ledger _ -> Data_encoding.int64 + +(** {1 Errors} *) + +type error += Key_cannot_be_serialized + +type error += Value_cannot_be_serialized + +type error += Value_cannot_be_unserialized + +let () = + let open Data_encoding in + (* Key cannot be serialized *) + register_error_kind + `Permanent + ~id:"tx_rollup_key_cannot_be_serialized" + ~title:"Key cannot be serialized" + ~description:"Tried to serialize an invalid key." + empty + (function Key_cannot_be_serialized -> Some () | _ -> None) + (fun () -> Key_cannot_be_serialized) ; + (* Value cannot be serialized *) + register_error_kind + `Permanent + ~id:"tx_rollup_value_cannot_be_serialized" + ~title:"Value cannot be serialized" + ~description:"Tried to serialize an invalid value." + empty + (function Value_cannot_be_serialized -> Some () | _ -> None) + (fun () -> Value_cannot_be_serialized) ; + (* Value cannot be unserialized *) + register_error_kind + `Permanent + ~id:"tx_rollup_value_cannot_be_unserialized" + ~title:"Value cannot be unserialized" + ~description: + "A value has been serialized in the Tx_rollup store, but cannot be \ + unserialized." + empty + (function Value_cannot_be_serialized -> Some () | _ -> None) + (fun () -> Value_cannot_be_serialized) ; + (* Not enough gas *) + register_error_kind + `Permanent + ~id:"tx_rollup_not_enough_gas" + ~title:"Not enough gas" + ~description: + "A transactions batch has been submitted with not enough allocated gas, \ + making its application imposible" + empty + (function Value_cannot_be_serialized -> Some () | _ -> None) + (fun () -> Value_cannot_be_serialized) + +(** {1 The Context Functor} *) + +module Make (S : STORAGE) : CONTEXT with type t = S.t and type 'a m = 'a S.m = +struct + type t = S.t + + type 'a m = 'a S.m + + module Syntax = struct + include S.Syntax + + let fail_unless cond error = + let open S.Syntax in + if cond then return () else fail error + end + + let bls_verify : (Tx_rollup_l2_address.t * bytes) list -> bytes -> bool m = + fun accounts aggregated_signature -> + let open Syntax in + return (Bls_signature.aggregate_verify accounts aggregated_signature) + + let unwrap_or : type a. a option -> error -> a S.m = + fun opt err -> + match opt with Some x -> S.Syntax.return x | None -> S.Syntax.fail err + + (** [get ctxt key] is a type-safe [get] function. *) + let get : type a. t -> a key -> a option m = + fun ctxt key -> + let open Syntax in + let value_encoding = value_encoding key in + let* key = + unwrap_or + (Data_encoding.Binary.to_bytes_opt packed_key_encoding (Key key)) + Key_cannot_be_serialized + in + let* value = S.get ctxt key in + match value with + | Some value -> + let* value = + unwrap_or + (Data_encoding.Binary.of_bytes_opt value_encoding value) + Value_cannot_be_unserialized + in + return (Some value) + | None -> return None + + (** [set ctxt key value] is a type-safe [set] function. *) + let set : type a. t -> a key -> a -> t m = + fun ctxt key value -> + let open Syntax in + let value_encoding = value_encoding key in + let* key = + unwrap_or + (Data_encoding.Binary.to_bytes_opt packed_key_encoding (Key key)) + Key_cannot_be_serialized + in + let* value = + unwrap_or + (Data_encoding.Binary.to_bytes_opt value_encoding value) + Value_cannot_be_serialized + in + S.set ctxt key value + + module Counter = struct + let get ctxt key = + let open Syntax in + let+ res = get ctxt (Counter key) in + Option.value res ~default:0L + + let set store key = set store (Counter key) + end + + module Ticket_ledger = struct + let get store hash account = + let open S.Syntax in + let+ res = get store (Ticket_ledger (hash, account)) in + Option.value res ~default:0L + + let set store hash account = set store (Ticket_ledger (hash, account)) + end +end diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_context.mli b/src/proto_alpha/lib_protocol/tx_rollup_l2_context.mli new file mode 100644 index 0000000000000000000000000000000000000000..521cade3199f2cffec2965379d1151b8faf69f8e --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_context.mli @@ -0,0 +1,125 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context +open Tx_rollup_l2_storage + +(** This module type describes the API of the [Tx_rollup] context, + which is used to implement the semantics of the L2 operations. *) +module type CONTEXT = sig + (** The state of the [Tx_rollup] context. + + The context provides a type-safe, functional API to interact + with the state of a transaction rollup. The functions of this + module, manipulating and creating values of type [t] are called + “context operations” afterwards. *) + type t + + (** The monad used by the context. + + {b Note:} It is likely to be the monad of the underlying + storage. In the case of the proof verifier, as it is expected to + be run into the L1, the monad will also be used to perform gas + accounting. This is why all the functions of this module type + needs to be inside the monad [m]. *) + type 'a m + + (** The necessary monadic operators the storage monad is required to + provide. *) + module Syntax : sig + val ( let+ ) : 'a m -> ('a -> 'b) -> 'b m + + val ( let* ) : 'a m -> ('a -> 'b m) -> 'b m + + (** [fail err] shortcuts the current computation by raising an + error. + + Said error can be handled with the [catch] combinator. *) + val fail : error -> 'a m + + (** [catch p k h] tries to executes the monadic computation [p]. + If [p] terminates without an error, then its result is passed + to the continuation [k]. On the contrary, if an error [err] is + raised, it is passed to the error handler [h]. *) + val catch : 'a m -> ('a -> 'b m) -> (error -> 'b m) -> 'b m + + (** [return x] is the simplest computation inside the monad [m] which simply + computes [x] and nothing else. *) + val return : 'a -> 'a m + + (** [list_fold_left_m f] is a monadic version of [List.fold_left + f], wherein [f] is not a pure computation, but a computation + in the monad [m]. *) + val list_fold_left_m : ('a -> 'b -> 'a m) -> 'a -> 'b list -> 'a m + + (** [fail_unless cond err] raises [err] iff [cond] is [false]. *) + val fail_unless : bool -> error -> unit m + end + + (** [bls_aggregate_verify] allows to verify the aggregated signature + of a batch. *) + val bls_verify : + (Tx_rollup_l2_address.t * bytes) list -> + Tx_rollup_l2_operation.signature -> + bool m + + (** A mapping from L2 account public keys to their counter. + + The counter is an counter-measure against replay attack. Each + operation is signed with an integer (its counter). The counter + is incremented when the operation is applied. This prevents the + operation to be applied once again, since its integer will not + be in sync with the counter of the account. + + The choice of [int64] for the type of the counter theoretically + the rollup to an integer overflow. However, it can only happen + if a single account makes more than [1.8446744e+19] + operations. If an account sends 1000 operations per seconds, it + would take them more than 5845420 centuries to achieve that. *) + module Counter : sig + val get : t -> Tx_rollup_l2_address.t -> int64 m + + val set : t -> Tx_rollup_l2_address.t -> int64 -> t m + end + + (** The ledger of the layer 2 where are registered the amount of a + given ticket a L2 [account] has. + + {b Warning:} The number of a given ticket a given account can + hold is bounded, due to the use of the [int64] type. This choice + is made so that the size of the proofs of the L2 [apply] + function is predictable. *) + module Ticket_ledger : sig + val get : t -> Ticket_hash.t -> Tx_rollup_l2_address.t -> int64 m + + val set : t -> Ticket_hash.t -> Tx_rollup_l2_address.t -> int64 -> t m + end +end + +(** Using this functor, it is possible to get a [CONTEXT] + implementation from a [STORAGE] implementation for free. *) +module Make (S : STORAGE) : CONTEXT with type t = S.t and type 'a m = 'a S.m diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_operation.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_operation.ml new file mode 100644 index 0000000000000000000000000000000000000000..322a0007b81910a578c2a0a0fd51b2211d56cf49 --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_operation.ml @@ -0,0 +1,89 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +type signature = bytes + +type operation_content = + | Transfer of { + destination : Tx_rollup_l2_address.t; + ticket_hash : Ticket_hash.t; + amount : int64; + } + +let operation_content_encoding = + let open Data_encoding in + union + [ + case + (Tag 0) + ~title:"Transfer" + (obj3 + (req "destination" Tx_rollup_l2_address.encoding) + (req "ticket_hash" Ticket_hash.encoding) + (req "amount" Data_encoding.int64)) + (function + | Transfer {destination; ticket_hash; amount} -> + Some (destination, ticket_hash, amount)) + (fun (destination, ticket_hash, amount) -> + Transfer {destination; ticket_hash; amount}); + ] + +type operation = { + signer : Tx_rollup_l2_address.t; + counter : int64; + content : operation_content; +} + +let operation_encoding = + let open Data_encoding in + conv + (function {signer; counter; content} -> (signer, counter, content)) + (function (signer, counter, content) -> {signer; counter; content}) + (obj3 + (req "signer" Tx_rollup_l2_address.encoding) + (req "counter" Data_encoding.int64) + (req "content" operation_content_encoding)) + +type transaction = operation list + +let transaction_encoding = Data_encoding.list operation_encoding + +type transactions_batch = { + contents : transaction list; + aggregated_signatures : signature; +} + +let transactions_batch_encoding = + let open Data_encoding in + conv + (function + | {contents; aggregated_signatures} -> (contents, aggregated_signatures)) + (function + | (contents, aggregated_signatures) -> {contents; aggregated_signatures}) + (obj2 (req "contents" @@ list transaction_encoding) (req "content" bytes)) diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_operation.mli b/src/proto_alpha/lib_protocol/tx_rollup_l2_operation.mli new file mode 100644 index 0000000000000000000000000000000000000000..e79d81f2df0746172c94abdd9352a548ac5a1bbd --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_operation.mli @@ -0,0 +1,70 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Alpha_context + +type signature = bytes + +(** A transactions rollup allows rollup users to exchange L1 tickets + off-chain. *) +type operation_content = + | Transfer of { + destination : Tx_rollup_l2_address.t; + ticket_hash : Ticket_hash.t; + amount : int64; + } + +val operation_content_encoding : operation_content Data_encoding.t + +type operation = { + signer : Tx_rollup_l2_address.t; + counter : int64; + content : operation_content; +} + +val operation_encoding : operation Data_encoding.t + +(** A [transaction] in a transactions rollup is a list of operations. + + The semantics of a [transaction] ensures that an operation of a + transaction [t] is successfully applied ({i i.e.}, is taken into + account) iff all the other operations of [t] are applied. In other + words, if the application of any operation of [t] fails, then all + operations of [t] are discarded. *) +type transaction = operation list + +val transaction_encoding : transaction Data_encoding.t + +(** A transactions batch gathers a list of transactions, and a BLS + aggregated signature that encompasses every operations of every + batches. *) +type transactions_batch = { + contents : transaction list; + aggregated_signatures : signature; +} + +val transactions_batch_encoding : transactions_batch Data_encoding.t diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_storage.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_storage.ml new file mode 100644 index 0000000000000000000000000000000000000000..3dd44d80d810c36b298b01a8e05a8de167d5e5f0 --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_storage.ml @@ -0,0 +1,50 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module type STORAGE = sig + type t + + type 'a m + + module Syntax : sig + val ( let+ ) : 'a m -> ('a -> 'b) -> 'b m + + val ( let* ) : 'a m -> ('a -> 'b m) -> 'b m + + val fail : error -> 'a m + + val catch : 'a m -> ('a -> 'b m) -> (error -> 'b m) -> 'b m + + val return : 'a -> 'a m + + val list_fold_left_m : ('a -> 'b -> 'a m) -> 'a -> 'b list -> 'a m + end + + val get : t -> bytes -> bytes option m + + val set : t -> bytes -> bytes -> t m +end diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_storage.mli b/src/proto_alpha/lib_protocol/tx_rollup_l2_storage.mli new file mode 100644 index 0000000000000000000000000000000000000000..85c28d677d14feeb11d9001300b6f1dd44a2e1e1 --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_storage.mli @@ -0,0 +1,86 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** This module type is the minimal API a storage backend has to + implement to be compatible with the [Tx_rollup] layer 2 + implementation. + + In a nutshell, the [Tx_rollup] only needs a simple key-value + store, where both keys and values are raw bytes buffers. We build + a type-safe abstraction on top of this simple (but potentially + unsafe) interface in [Tx_rollup_l2_context]. *) +module type STORAGE = sig + (** The state of the storage. + + The API adopts a functional paradigm, where the [set] function + returns a new state for the storage, and where it should be + possible to reuse a previous state. *) + type t + + (** The monad of the storage backend. *) + type 'a m + + (** The necessary monadic operators the monad of the storage backend + is required to provide. *) + module Syntax : sig + val ( let+ ) : 'a m -> ('a -> 'b) -> 'b m + + val ( let* ) : 'a m -> ('a -> 'b m) -> 'b m + + (** [fail err] shortcuts the current computation by raising an + error. + + Said error can be handled with the [catch] combinator. *) + val fail : error -> 'a m + + (** [catch p k h] tries to executes the monadic computation [p]. + If [p] terminates without an error, then its result is passed + to the continuation [k]. On the contrary, if an error [err] is + raised, it is passed to the error handler [h]. *) + val catch : 'a m -> ('a -> 'b m) -> (error -> 'b m) -> 'b m + + (** [return x] is the simplest computation inside the monad [m] which simply + computes [x] and nothing else. *) + val return : 'a -> 'a m + + (** [list_fold_left_m f] is a monadic version of [List.fold_left + f], wherein [f] is not a pure computation, but a computation + in the monad [m]. *) + val list_fold_left_m : ('a -> 'b -> 'a m) -> 'a -> 'b list -> 'a m + end + + (** [get storage key] returns the value stored in [storage] for + [key], if it exists. Returns [None] if it does not. *) + val get : t -> bytes -> bytes option m + + (** [set storage key] computes a new state for the storage wherein + the value associated to [key] is [value]. + + [storage] is expected to remain usable and consistent even after + the execution of [set]. *) + val set : t -> bytes -> bytes -> t m +end diff --git a/src/proto_alpha/lib_protocol/tx_rollup_repr.ml b/src/proto_alpha/lib_protocol/tx_rollup_repr.ml index 477171ca09e639f7eb41b454cf58d33da1907ac9..a6ef6956aff4f716335370da49bdeeb899ca199f 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_repr.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_repr.ml @@ -142,10 +142,8 @@ module Index = struct let compare = compare end -type state = unit +let in_memory_size = + let open Cache_memory_helpers in + header_size +! word_size +! blake2b_hash_size -let state_encoding = Data_encoding.(obj1 (req "state" Data_encoding.unit)) - -let empty_state = () - -let pp_state fmt _state = Format.fprintf fmt "state" +let deposit_entrypoint = Entrypoint_repr.of_string_strict_exn "deposit" diff --git a/src/proto_alpha/lib_protocol/tx_rollup_repr.mli b/src/proto_alpha/lib_protocol/tx_rollup_repr.mli index cf59e6910cd576f06703fded56128c3317eb57ff..aa64de842a1890366c7d77d156ebcfa655bacaab 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_repr.mli +++ b/src/proto_alpha/lib_protocol/tx_rollup_repr.mli @@ -56,16 +56,11 @@ val originated_tx_rollup : Origination_nonce.t -> t val rpc_arg : t RPC_arg.arg -module Index : Storage_description.INDEX with type t = t - -(** [state] is an empty type but will be changed in a future MR to represent the - state of a tx_rollup. *) -type state +val in_memory_size : Saturation_repr.may_saturate Saturation_repr.t -val state_encoding : state Data_encoding.t - -(** [empty_state] is the initial value at the origination of a - tx_rollup. It contains no inboxes. *) -val empty_state : state +module Index : Storage_description.INDEX with type t = t -val pp_state : Format.formatter -> state -> unit +(** [deposit_entrypoint] is the entrypoint a transaction rollup + exposes to allow layer-1 smart contracts to deposit Michelson + tickets. *) +val deposit_entrypoint : Entrypoint_repr.t diff --git a/src/proto_alpha/lib_protocol/tx_rollup_services.ml b/src/proto_alpha/lib_protocol/tx_rollup_services.ml index e1d69cd738a00291fa9512f5660ffa320ea6062e..5778cf4c940882eaf996ccb0a7e1b857ab184f8a 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_services.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_services.ml @@ -35,14 +35,31 @@ module S = struct RPC_service.get_service ~description:"Access the state of a rollup." ~query:RPC_query.empty - ~output:(Data_encoding.option Tx_rollup.state_encoding) + ~output:Tx_rollup_state.encoding RPC_path.(custom_root /: Tx_rollup.rpc_arg / "state") + + let inbox = + RPC_service.get_service + ~description:"Get the inbox of a transaction rollup" + ~query:RPC_query.empty + ~output:Tx_rollup_inbox.encoding + RPC_path.(custom_root /: Tx_rollup.rpc_arg / "inbox") end let register () = let open Services_registration in register1 ~chunked:false S.state (fun ctxt tx_rollup () () -> - Tx_rollup.state ctxt tx_rollup) + Tx_rollup.get_state_opt ctxt tx_rollup >|=? function + | Some x -> x + | None -> raise Not_found) ; + register1 ~chunked:false S.inbox (fun ctxt tx_rollup () () -> + let level = (Level.current ctxt).level in + Tx_rollup.inbox_opt ctxt tx_rollup ~level >|=? function + | (_, Some x) -> x + | (_, None) -> raise Not_found) let state ctxt block tx_rollup = RPC_context.make_call1 S.state ctxt block tx_rollup () () + +let inbox ctxt block tx_rollup = + RPC_context.make_call1 S.inbox ctxt block tx_rollup () () diff --git a/src/proto_alpha/lib_protocol/tx_rollup_services.mli b/src/proto_alpha/lib_protocol/tx_rollup_services.mli index b88896873c1cde1ea22d4df24d43bf2e8550fa42..7cbe72a34a61ac39a06cfd2b1635cb3a3fb3de24 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_services.mli +++ b/src/proto_alpha/lib_protocol/tx_rollup_services.mli @@ -26,10 +26,23 @@ open Alpha_context +(** Return the state for a tx rollup. Return [Not_found] if no such + rollup exists. *) val state : 'a #RPC_context.simple -> 'a -> Tx_rollup.t -> - Tx_rollup.state option shell_tzresult Lwt.t + Tx_rollup_state.t shell_tzresult Lwt.t + +(** Return the inbox for a tx rollup for current level. + + Return [Not_found] if the transaction rollup exists, but does not + have inbox at that level. Fail if the transaction rollup does not + exist. *) +val inbox : + 'a #RPC_context.simple -> + 'a -> + Tx_rollup.t -> + Tx_rollup_inbox.t shell_tzresult Lwt.t val register : unit -> unit diff --git a/src/proto_alpha/lib_protocol/tx_rollup_state_repr.ml b/src/proto_alpha/lib_protocol/tx_rollup_state_repr.ml new file mode 100644 index 0000000000000000000000000000000000000000..5d7a240bd9e359d12035b17952c712ef3a029e24 --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_state_repr.ml @@ -0,0 +1,64 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = {cost_per_byte : Tez_repr.t} + +let encoding = + let open Data_encoding in + conv + (fun {cost_per_byte} -> cost_per_byte) + (fun cost_per_byte -> {cost_per_byte}) + (obj1 (req "cost_per_byte" Tez_repr.encoding)) + +let pp fmt {cost_per_byte} = + Format.fprintf fmt "cost_per_byte: %a" Tez_repr.pp cost_per_byte + +let update_cost_per_byte : + cost_per_byte:Tez_repr.t -> + tx_rollup_cost_per_byte:Tez_repr.t -> + final_size:int -> + hard_limit:int -> + Tez_repr.t = + fun ~cost_per_byte ~tx_rollup_cost_per_byte ~final_size ~hard_limit -> + let computation = + let open Compare.Int in + (* This cannot overflow because [hard_limit] is small enough, and + [final_size] is lesser than [hard_limit]. *) + let percentage = final_size * 100 / hard_limit in + if 90 < percentage then + Tez_repr.( + tx_rollup_cost_per_byte *? 105L >>? fun x -> + x /? 100L >>? fun x -> x +? one_mutez) + else if 80 < percentage && percentage <= 90 then ok tx_rollup_cost_per_byte + else + Tez_repr.( + tx_rollup_cost_per_byte *? 95L >>? fun x -> + x /? 100L >>? fun x -> x +? one_mutez) + in + match computation with + | Ok x -> Tez_repr.max cost_per_byte x + | Error _ -> cost_per_byte diff --git a/src/proto_alpha/lib_protocol/tx_rollup_state_repr.mli b/src/proto_alpha/lib_protocol/tx_rollup_state_repr.mli new file mode 100644 index 0000000000000000000000000000000000000000..902b20fde1ad107c90b3fc3f32bf32a616f6fcd9 --- /dev/null +++ b/src/proto_alpha/lib_protocol/tx_rollup_state_repr.mli @@ -0,0 +1,63 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Marigold *) +(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** The state of a transaction rollup is a set of variables that are + expected to vary in time. More precisely, the state comprises + + {ul {li A [cost_per_byte] rate, that is expected to be at least as + expensive as the [cost_per_byte] constant of the protocol, + but can be increased if the transaction rollup is crowded.}} *) +type t = {cost_per_byte : Tez_repr.t} + +val encoding : t Data_encoding.t + +val pp : Format.formatter -> t -> unit + +(** [update_cost_per_byte ctxt ~cost_per_byte ~tx_rollup_cost_per_byte + ~final_size ~hard_limit] computes a new cost per byte based on the + ratio of the [hard_limit] maximum amount of byte an inbox can use + and the [final_size] amount of bytes it uses at the end of the + construction of a Tezos block. The [tx_rollup_cost_per_byte] value + computed by this function is always greater than the + [cost_per_byte] protocol constant. + + More precisely, [cost_per_byte] has to be equal to the protocol + parameter of the same name. + + In a nutshell, if the ratio is lesser than 80%, the cost per byte + is reduced. If the ratios is somewhere between 80% and 90%, the + cost per byte remains constant. If the ratio is greater than 90%, + then the cost per byte is increased. + + The rationale behind this mechanics is to reduce the activity of a + rollup in case it becomes too intense. *) +val update_cost_per_byte : + cost_per_byte:Tez_repr.t -> + tx_rollup_cost_per_byte:Tez_repr.t -> + final_size:int -> + hard_limit:int -> + Tez_repr.t diff --git a/src/proto_alpha/lib_protocol/tx_rollup_storage.ml b/src/proto_alpha/lib_protocol/tx_rollup_storage.ml index e59af53198ddaa3c060d4212a1f2d9559d8b2510..3e3aa223b1fe69693f9c202f26b4f8f365ea62b7 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_storage.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_storage.ml @@ -3,6 +3,7 @@ (* Open Source License *) (* Copyright (c) 2021 Marigold *) (* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -24,13 +25,240 @@ (* *) (*****************************************************************************) +open Tx_rollup_inbox_repr + +let init : Raw_context.t -> Tx_rollup_repr.t -> Raw_context.t tzresult Lwt.t = + fun ctxt rollup -> + let cost_per_byte = + (Raw_context.constants ctxt).tx_rollup_initial_inbox_cost_per_byte + in + Storage.Tx_rollup.State.init ctxt rollup {cost_per_byte} + +type error += Tx_rollup_does_not_exist of Tx_rollup_repr.t + +let () = + let open Data_encoding in + (* Tx_rollup_does_not_exist *) + register_error_kind + `Temporary + ~id:"tx_rollup_does_not_exist" + ~title:"Transaction rollup does not exist" + ~description:"An invalid transaction rollup address was submitted" + ~pp:(fun ppf addr -> + Format.fprintf + ppf + "Invalid transaction rollup address %a" + Tx_rollup_repr.pp + addr) + (obj1 (req "rollup_address" Tx_rollup_repr.encoding)) + (function Tx_rollup_does_not_exist rollup -> Some rollup | _ -> None) + (fun rollup -> Tx_rollup_does_not_exist rollup) + +let get_state : + Raw_context.t -> Tx_rollup_repr.t -> Tx_rollup_state_repr.t tzresult Lwt.t = + fun ctxt rollup -> + Storage.Tx_rollup.State.find ctxt rollup >>=? function + | Some res -> return res + | None -> fail (Tx_rollup_does_not_exist rollup) + +(** [assert_tx_rollup_exist ctxt tx_rollup] fails with + [Tx_rollup_does_not_exist] when [tx_rollup] is not a valid + transaction rollup address. *) +let assert_tx_rollup_exist : + Raw_context.t -> Tx_rollup_repr.t -> unit tzresult Lwt.t = + fun ctxt tx_rollup -> + Storage.Tx_rollup.State.mem ctxt tx_rollup >>= fun tx_rollup_exists -> + fail_unless tx_rollup_exists (Tx_rollup_does_not_exist tx_rollup) + +let get_state_opt : + Raw_context.t -> + Tx_rollup_repr.t -> + Tx_rollup_state_repr.t option tzresult Lwt.t = + Storage.Tx_rollup.State.find + +type error += + | (* `Permanent *) Tx_rollup_hard_size_limit_reached of Tx_rollup_repr.t + +type error += + | (* `Permanent *) Tx_rollup_inbox_does_not_exist of Tx_rollup_repr.t + +let () = + let open Data_encoding in + (* Tx_rollup_hard_size_limit_reached *) + register_error_kind + `Permanent + ~id:"tx_rollup_size_limit_reached" + ~title:"Size limit reached for rollup" + ~description: + "Adding this transaction would make the transaction rollup use too much \ + size in this block" + (obj1 (req "rollup_address" Tx_rollup_repr.encoding)) + (function + | Tx_rollup_hard_size_limit_reached rollup -> Some rollup | _ -> None) + (fun rollup -> Tx_rollup_hard_size_limit_reached rollup) ; + (* Tx_rollup_inbox_does_not_exist *) + register_error_kind + `Permanent + ~id:"Tx_rollup_inbox_does_not_exist" + ~title:"Transaction Rollup does not exist" + ~description:"The requested transaction rollup does not exist" + (obj1 (req "tx_rollup_address" Tx_rollup_repr.encoding)) + (function + | Tx_rollup_inbox_does_not_exist rollup -> Some rollup | _ -> None) + (fun rollup -> Tx_rollup_inbox_does_not_exist rollup) + +let append_message : + Raw_context.t -> + Tx_rollup_repr.t -> + Tx_rollup_inbox_repr.message -> + (int * Raw_context.t) tzresult Lwt.t = + fun ctxt rollup message -> + let level = (Raw_context.current_level ctxt).level in + let hard_size_limit = + Constants_storage.tx_rollup_hard_size_limit_per_inbox ctxt + in + Storage.Tx_rollup.Inbox_cumulated_size.find (ctxt, level) rollup + >>=? fun msize -> + let message_size = Tx_rollup_inbox_repr.message_size message in + let new_size = Option.value ~default:0 msize + message_size in + fail_when + Compare.Int.(new_size > hard_size_limit) + (Tx_rollup_hard_size_limit_reached rollup) + >>=? fun () -> + Storage.Tx_rollup.Inbox_rev_contents.find (ctxt, level) rollup + >>=? fun (ctxt, mcontents) -> + Storage.Tx_rollup.Inbox_rev_contents.add + (ctxt, level) + rollup + (Tx_rollup_inbox_repr.hash_message message + :: Option.value ~default:[] mcontents) + >>=? fun (ctxt, _, _) -> + Storage.Tx_rollup.Inbox_cumulated_size.add (ctxt, level) rollup new_size + >>= fun ctxt -> return (message_size, ctxt) + +let inbox_messages_opt : + Raw_context.t -> + ?level:Raw_level_repr.t -> + Tx_rollup_repr.t -> + (Raw_context.t * Tx_rollup_inbox_repr.message_hash list option) tzresult + Lwt.t = + fun ctxt ?(level = (Raw_context.current_level ctxt).level) tx_rollup -> + Storage.Tx_rollup.Inbox_rev_contents.find (ctxt, level) tx_rollup + >>=? function + | (ctxt, Some rev_contents) -> return (ctxt, Some (List.rev rev_contents)) + | (ctxt, None) -> + (* + Prior to returning [None], we check whether or not the + transaction rollup address is valid, to raise the appropriate + if need be. + *) + assert_tx_rollup_exist ctxt tx_rollup >>=? fun () -> return (ctxt, None) + +let inbox_messages : + Raw_context.t -> + ?level:Raw_level_repr.t -> + Tx_rollup_repr.t -> + (Raw_context.t * Tx_rollup_inbox_repr.message_hash list) tzresult Lwt.t = + fun ctxt ?(level = (Raw_context.current_level ctxt).level) tx_rollup -> + inbox_messages_opt ctxt ~level tx_rollup >>=? function + | (ctxt, Some messages) -> return (ctxt, messages) + | (_, None) -> fail (Tx_rollup_inbox_does_not_exist tx_rollup) + +let inbox_cumulated_size : + Raw_context.t -> + ?level:Raw_level_repr.t -> + Tx_rollup_repr.t -> + int tzresult Lwt.t = + fun ctxt ?(level = (Raw_context.current_level ctxt).level) tx_rollup -> + Storage.Tx_rollup.Inbox_cumulated_size.find (ctxt, level) tx_rollup + >>=? function + | Some cumulated_size -> return cumulated_size + | None -> + (* + Prior to raising an error related to the missing inbox, we + check whether or not the transaction rollup address is valid, + to raise the appropriate if need be. + *) + assert_tx_rollup_exist ctxt tx_rollup >>=? fun () -> + fail (Tx_rollup_inbox_does_not_exist tx_rollup) + +let inbox_opt : + Raw_context.t -> + ?level:Raw_level_repr.t -> + Tx_rollup_repr.t -> + (Raw_context.t * Tx_rollup_inbox_repr.t option) tzresult Lwt.t = + fun ctxt ?(level = (Raw_context.current_level ctxt).level) tx_rollup -> + (* + [inbox_messages_opt] checks whether or not [tx_rollup] is valid, so + we do not have to do it here. + *) + inbox_messages_opt ctxt ~level tx_rollup >>=? function + | (ctxt, Some contents) -> + inbox_cumulated_size ctxt ~level tx_rollup >>=? fun cumulated_size -> + return (ctxt, Some {cumulated_size; contents}) + | (ctxt, None) -> return (ctxt, None) + +let inbox : + Raw_context.t -> + ?level:Raw_level_repr.t -> + Tx_rollup_repr.t -> + (Raw_context.t * Tx_rollup_inbox_repr.t) tzresult Lwt.t = + fun ctxt ?(level = (Raw_context.current_level ctxt).level) tx_rollup -> + (* + [inbox_opt] checks whether or not [tx_rollup] is valid, so we + don’t have to do it here. + *) + inbox_opt ctxt ~level tx_rollup >>=? function + | (ctxt, Some res) -> return (ctxt, res) + | (_, None) -> fail (Tx_rollup_inbox_does_not_exist tx_rollup) + let fresh_tx_rollup_from_current_nonce ctxt = Raw_context.increment_origination_nonce ctxt >|? fun (ctxt, nonce) -> (ctxt, Tx_rollup_repr.originated_tx_rollup nonce) let originate ctxt = fresh_tx_rollup_from_current_nonce ctxt >>?= fun (ctxt, tx_rollup) -> - Storage.Tx_rollup.State.add ctxt tx_rollup Tx_rollup_repr.empty_state - >|= fun ctxt -> ok (ctxt, tx_rollup) + init ctxt tx_rollup >>=? fun ctxt -> return (ctxt, tx_rollup) + +let finalize_rollup : + Raw_context.t -> + Tx_rollup_repr.t -> + Tx_rollup_state_repr.t -> + Raw_context.t tzresult Lwt.t = + fun ctxt rollup state -> + inbox ctxt rollup >>=? fun (ctxt, inbox) -> + let hard_limit = Constants_storage.tx_rollup_hard_size_limit_per_inbox ctxt in + let cost_per_byte = Constants_storage.cost_per_byte ctxt in + let tx_rollup_cost_per_byte = + Tx_rollup_state_repr.update_cost_per_byte + ~cost_per_byte + ~tx_rollup_cost_per_byte:state.cost_per_byte + ~final_size:inbox.cumulated_size + ~hard_limit + in + Storage.Tx_rollup.State.add + ctxt + rollup + {cost_per_byte = tx_rollup_cost_per_byte} + >|= ok + +let update_tx_rollup_at_block_finalization : + Raw_context.t -> Raw_context.t tzresult Lwt.t = + fun ctxt -> + let level = (Raw_context.current_level ctxt).level in + Storage.Tx_rollup.fold ctxt level ~init:(ok ctxt) ~f:(fun tx_rollup ctxt -> + ctxt >>?= fun ctxt -> + Storage.Tx_rollup.State.get ctxt tx_rollup >>=? fun state -> + finalize_rollup ctxt tx_rollup state) -let state c tx_rollup = Storage.Tx_rollup.State.find c tx_rollup +let hash_ticket : + Raw_context.t -> + Tx_rollup_repr.t -> + contents:Script_repr.node -> + ticketer:Script_repr.node -> + ty:Script_repr.node -> + (Ticket_hash_repr.t * Raw_context.t) tzresult = + fun ctxt tx_rollup ~contents ~ticketer ~ty -> + let open Micheline in + let owner = String (dummy_location, Tx_rollup_repr.to_b58check tx_rollup) in + Ticket_hash_repr.make ctxt ~ticketer ~typ:ty ~contents ~owner diff --git a/src/proto_alpha/lib_protocol/tx_rollup_storage.mli b/src/proto_alpha/lib_protocol/tx_rollup_storage.mli index 715fd539f5552fa26879f082b752b1729a3db76b..1f00d47d0cdd2c6f486e94bbcc220c4af6a80b6b 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_storage.mli +++ b/src/proto_alpha/lib_protocol/tx_rollup_storage.mli @@ -3,6 +3,7 @@ (* Open Source License *) (* Copyright (c) 2021 Marigold *) (* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021 Oxhead Alpha *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -24,15 +25,149 @@ (* *) (*****************************************************************************) -(** [originate context] originates a new tx rollup and returns its hash - generated from the [origination_nonce] in context. It also increment the - [origination_nonce]. *) +(** This module introduces various functions to manipulate the storage related + to transaction rollups. *) + +(** {1 Errors} *) + +(** This error is raised when someone tries to interact with a + transaction rollup that does not exist. *) +type error += Tx_rollup_does_not_exist of Tx_rollup_repr.t + +(** This error is raised when someone tries to interact with an inbox + of a transaction rollup that does not exist. *) +type error += Tx_rollup_inbox_does_not_exist of Tx_rollup_repr.t + +(** This error is raised when the inbox is already using too much + storage space for a message to be appended. *) +type error += Tx_rollup_hard_size_limit_reached of Tx_rollup_repr.t + +(** {1 Origination} *) + +(** [originate ctxt] derives an address from [ctxt], and initializes + the new transaction rollup. *) val originate : Raw_context.t -> (Raw_context.t * Tx_rollup_repr.t) tzresult Lwt.t -(** [state context tx_rollup] is the current state of [tx_rollup] in the - context. *) -val state : +(** {2 State} *) + +(** [get_state ctxt tx_rollup] returns the current state of [tx_rollup]. + + Raises [Tx_rollup_does_not_exist] if [tx_rollup] is not a valid + transaction rollup. *) +val get_state : + Raw_context.t -> Tx_rollup_repr.t -> Tx_rollup_state_repr.t tzresult Lwt.t + +(** [get_opt ctxt tx_rollup] returns the current state of [tx_rollup], + or [None] if [tx_rollup] is not a valid transaction rollup. *) +val get_state_opt : + Raw_context.t -> + Tx_rollup_repr.t -> + Tx_rollup_state_repr.t option tzresult Lwt.t + +(** {1 Inboxes} *) + +(** [append_message ctxt tx_rollup message] tries to append message to + the inbox of [tx_rollup] at the current level. This function + returns the size of the appended message (in bytes), in order for + the appropriate fees to be taken from the message author. + + {b Note:} [tx_rollup] needs to be a valid transaction rollup, this + function does not check it. + + Raises [Tx_rollup_hard_size_limit_reached] if appending [message] + to the inbox would make it exceed the maximum size specified by + the [tx_rollup_hard_size_limit_per_inbox] protocol parameter. *) +val append_message : + Raw_context.t -> + Tx_rollup_repr.t -> + Tx_rollup_inbox_repr.message -> + (int * Raw_context.t) tzresult Lwt.t + +(** [inbox_messages ctxt ?level tx_rollup] returns the list of messages + stored in the inbox of [tx_rollup] at level [level]. + + If the [level] label is omitted, then it is inferred from [ctxt] + (namely, from the current level of the chain). + + Raises + + {ul {li [Tx_rollup_does_not_exist] if [tx_rollup] does not exist} + {li [Tx_rollup_inbox_does_not_exist] if [tx_rollup] exists, + but does not have an inbox at level [level]. }} *) +val inbox_messages : + Raw_context.t -> + ?level:Raw_level_repr.t -> + Tx_rollup_repr.t -> + (Raw_context.t * Tx_rollup_inbox_repr.message_hash list) tzresult Lwt.t + +(** [inbox_cumulated_size ctxt ?level tx_rollup] returns the cumulated + size (in bytes) of the messages stored in the inbox of [tx_rollup] + at level [level]. + + If the [level] label is omitted, then it is inferred from [ctxt] + (namely, from the current level of the chain). + + Raises + + {ul {li [Tx_rollup_does_not_exist] if [tx_rollup] does not exist} + {li [Tx_rollup_inbox_does_not_exist] if [tx_rollup] exists, + but does not have an inbox at level [level]. }} *) +val inbox_cumulated_size : + Raw_context.t -> + ?level:Raw_level_repr.t -> + Tx_rollup_repr.t -> + int tzresult Lwt.t + +(** [inbox ctxt ?offset tx_rollup] returns the inbox of [tx_rollup] at + level [level]. + + If the [level] label is omitted, then it is inferred from [ctxt] + (namely, from the current level of the chain). + + Raises + + {ul {li [Tx_rollup_does_not_exist] if [tx_rollup] does not exist} + {li [Tx_rollup_inbox_does_not_exist] if [tx_rollup] exists, + but does not have an inbox at level [level]. }} *) +val inbox : Raw_context.t -> + ?level:Raw_level_repr.t -> Tx_rollup_repr.t -> - Tx_rollup_repr.state option tzresult Lwt.t + (Raw_context.t * Tx_rollup_inbox_repr.t) tzresult Lwt.t + +(** [inbox_opt ctxt ?level tx_rollup] returns the inbox of + [tx_rollup] at level [level], or [None] if said inbox does not + exists. + + If the [level] label is omitted, then it is inferred from [ctxt] + (namely, from the current level of the chain). + + Raises [Tx_rollup_does_not_exist] if [tx_rollup] does not exist. *) +val inbox_opt : + Raw_context.t -> + ?level:Raw_level_repr.t -> + Tx_rollup_repr.t -> + (Raw_context.t * Tx_rollup_inbox_repr.t option) tzresult Lwt.t + +(** [hash_ticket ctxt tx_rollup ~contents ~ticketer ~ty] computes the + hash to be used both with the table of ticket and within the + layer-2 to identify a layer-1 ticket. *) +val hash_ticket : + Raw_context.t -> + Tx_rollup_repr.t -> + contents:Script_repr.node -> + ticketer:Script_repr.node -> + ty:Script_repr.node -> + (Ticket_hash_repr.t * Raw_context.t) tzresult + +(** {1 Block Finalization Routine} *) + +(** [update_tx_rollup_at_block_finalization ctxt] updates the state of + each transaction rollup which has had an inbox created during the + current block. + + {b Note:} As the name suggests, this function must be called at + block finalization time. *) +val update_tx_rollup_at_block_finalization : + Raw_context.t -> Raw_context.t tzresult Lwt.t diff --git a/tests_python/tests_alpha/test_mockup.py b/tests_python/tests_alpha/test_mockup.py index 42499f3722b35fce210554631139b0e498b3872d..18a199150ba76f357c19834315025dd92b8c4a34 100644 --- a/tests_python/tests_alpha/test_mockup.py +++ b/tests_python/tests_alpha/test_mockup.py @@ -652,7 +652,13 @@ def _test_create_mockup_init_show_roundtrip( "double_baking_punishment": "640000001", "tx_rollup_enable": False, # TODO: https://gitlab.com/tezos/tezos/-/issues/2152 + # Transaction rollups parameters need to be refined, + # currently the following values are merely + # placeholders. "tx_rollup_origination_size": 60_000, + "tx_rollup_hard_size_limit_per_batch": 5_000, + "tx_rollup_hard_size_limit_per_inbox": 100_000, + "tx_rollup_initial_inbox_cost_per_byte": "250", "sc_rollup_enable": False, "sc_rollup_origination_size": 6_314, } diff --git a/tezt/_regressions/rpc/alpha.client.mempool.out b/tezt/_regressions/rpc/alpha.client.mempool.out index a861ab0043248d91e4a20416d30929b57ce44d05..c6ec1f55e181caf466ca847f1d3b82ee96c7b9f9 100644 --- a/tezt/_regressions/rpc/alpha.client.mempool.out +++ b/tezt/_regressions/rpc/alpha.client.mempool.out @@ -685,11 +685,6 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, - "alpha.contract_id": { - "title": "A contract handle", - "description": "A contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash.", - "$ref": "#/definitions/unistring" - }, "alpha.entrypoint": { "title": "entrypoint", "description": "Named entrypoint to a Michelson smart contract", @@ -869,14 +864,14 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "False", "DUG", "DIG", - "chest_key", + "ticket", "BLAKE2B", "list", - "bls12_381_g1", + "never", "Pair", "INT", "nat", - "never", + "chain_id", "storage", "SIZE", "view", @@ -893,15 +888,15 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "operation", "MAP", "option", - "bls12_381_fr", + "bls12_381_g2", "ADD", "IMPLICIT_ACCOUNT", "SHA512", "int", "LSL", - "bls12_381_g2", - "ticket", - "sapling_transaction", + "bls12_381_g1", + "bls12_381_fr", + "tx_rollup_l2_address", "COMPARE", "SWAP", "STEPS_TO_QUOTA", @@ -909,6 +904,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "pair", "BALANCE", "CONCAT", + "constant", "MUL", "FAILWITH", "Elt", @@ -967,7 +963,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "PACK", "IF_CONS", "KECCAK", - "chest", + "chest_key", "UNIT", "EMPTY_SET", "NEQ", @@ -979,7 +975,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "contract", "LSR", "EMPTY_BIG_MAP", - "sapling_state", + "sapling_transaction", "JOIN_TICKETS", "LEVEL", "UNPAIR", @@ -987,8 +983,8 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "PUSH", "big_map", "GT", - "chain_id", - "constant", + "sapling_state", + "chest", "NOW", "IF_NONE", "PAIR", @@ -1358,7 +1354,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "$ref": "#/definitions/alpha.mutez" }, "destination": { - "$ref": "#/definitions/alpha.contract_id" + "$ref": "#/definitions/alpha.transaction_destination" }, "parameters": { "type": "object", @@ -1760,6 +1756,50 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, + { + "title": "Tx_rollup_submit_batch", + "type": "object", + "properties": { + "kind": { + "type": "string", + "enum": [ + "tx_rollup_submit_batch" + ] + }, + "source": { + "$ref": "#/definitions/Signature.Public_key_hash" + }, + "fee": { + "$ref": "#/definitions/alpha.mutez" + }, + "counter": { + "$ref": "#/definitions/positive_bignum" + }, + "gas_limit": { + "$ref": "#/definitions/positive_bignum" + }, + "storage_limit": { + "$ref": "#/definitions/positive_bignum" + }, + "rollup": { + "$ref": "#/definitions/alpha.tx_rollup_id" + }, + "content": { + "$ref": "#/definitions/unistring" + } + }, + "required": [ + "content", + "rollup", + "storage_limit", + "gas_limit", + "counter", + "fee", + "source", + "kind" + ], + "additionalProperties": false + }, { "title": "Sc_rollup_originate", "type": "object", @@ -1974,6 +2014,16 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, + "alpha.transaction_destination": { + "title": "A destination of a transaction", + "description": "A destination notation compatible with the contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash.", + "$ref": "#/definitions/unistring" + }, + "alpha.tx_rollup_id": { + "title": "A tx rollup handle", + "description": "A tx rollup notation as given to an RPC or inside scripts, is a base58 tx rollup hash", + "$ref": "#/definitions/unistring" + }, "bignum": { "title": "Big number", "description": "Decimal representation of a big number", @@ -2224,7 +2274,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' }, { "description": { - "title": "alpha.contract_id" + "title": "alpha.transaction_destination" }, "encoding": { "tag_size": "Uint8", @@ -2302,6 +2352,46 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' } ], "name": "Originated" + }, + { + "tag": 2, + "fields": [ + { + "name": "Tag", + "layout": { + "size": "Uint8", + "kind": "Int" + }, + "data_kind": { + "size": 1, + "kind": "Float" + }, + "kind": "named" + }, + { + "name": "Rollup_hash", + "layout": { + "kind": "Bytes" + }, + "data_kind": { + "size": 20, + "kind": "Float" + }, + "kind": "named" + }, + { + "name": "padding", + "layout": { + "kind": "Padding" + }, + "data_kind": { + "size": 1, + "kind": "Float" + }, + "kind": "named" + } + ], + "name": "Tx_rollup" } ] } @@ -3892,7 +3982,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' { "name": "destination", "layout": { - "name": "alpha.contract_id", + "name": "alpha.transaction_destination", "kind": "Ref" }, "data_kind": { @@ -4373,6 +4463,106 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "name": "Tx_rollup_origination" }, + { + "tag": 151, + "fields": [ + { + "name": "Tag", + "layout": { + "size": "Uint8", + "kind": "Int" + }, + "data_kind": { + "size": 1, + "kind": "Float" + }, + "kind": "named" + }, + { + "name": "source", + "layout": { + "name": "public_key_hash", + "kind": "Ref" + }, + "data_kind": { + "size": 21, + "kind": "Float" + }, + "kind": "named" + }, + { + "name": "fee", + "layout": { + "name": "N.t", + "kind": "Ref" + }, + "data_kind": { + "kind": "Dynamic" + }, + "kind": "named" + }, + { + "name": "counter", + "layout": { + "name": "N.t", + "kind": "Ref" + }, + "data_kind": { + "kind": "Dynamic" + }, + "kind": "named" + }, + { + "name": "gas_limit", + "layout": { + "name": "N.t", + "kind": "Ref" + }, + "data_kind": { + "kind": "Dynamic" + }, + "kind": "named" + }, + { + "name": "storage_limit", + "layout": { + "name": "N.t", + "kind": "Ref" + }, + "data_kind": { + "kind": "Dynamic" + }, + "kind": "named" + }, + { + "name": "rollup", + "layout": { + "kind": "Bytes" + }, + "data_kind": { + "size": 20, + "kind": "Float" + }, + "kind": "named" + }, + { + "kind": "dyn", + "num_fields": 1, + "size": "Uint30" + }, + { + "name": "content", + "layout": { + "kind": "String" + }, + "data_kind": { + "kind": "Variable" + }, + "kind": "named" + } + ], + "name": "Tx_rollup_submit_batch" + }, { "tag": 200, "fields": [ @@ -5232,11 +5422,6 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, - "alpha.contract_id": { - "title": "A contract handle", - "description": "A contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash.", - "$ref": "#/definitions/unistring" - }, "alpha.entrypoint": { "title": "entrypoint", "description": "Named entrypoint to a Michelson smart contract", @@ -5416,14 +5601,14 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "False", "DUG", "DIG", - "chest_key", + "ticket", "BLAKE2B", "list", - "bls12_381_g1", + "never", "Pair", "INT", "nat", - "never", + "chain_id", "storage", "SIZE", "view", @@ -5440,15 +5625,15 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "operation", "MAP", "option", - "bls12_381_fr", + "bls12_381_g2", "ADD", "IMPLICIT_ACCOUNT", "SHA512", "int", "LSL", - "bls12_381_g2", - "ticket", - "sapling_transaction", + "bls12_381_g1", + "bls12_381_fr", + "tx_rollup_l2_address", "COMPARE", "SWAP", "STEPS_TO_QUOTA", @@ -5456,6 +5641,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "pair", "BALANCE", "CONCAT", + "constant", "MUL", "FAILWITH", "Elt", @@ -5514,7 +5700,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "PACK", "IF_CONS", "KECCAK", - "chest", + "chest_key", "UNIT", "EMPTY_SET", "NEQ", @@ -5526,7 +5712,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "contract", "LSR", "EMPTY_BIG_MAP", - "sapling_state", + "sapling_transaction", "JOIN_TICKETS", "LEVEL", "UNPAIR", @@ -5534,8 +5720,8 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "PUSH", "big_map", "GT", - "chain_id", - "constant", + "sapling_state", + "chest", "NOW", "IF_NONE", "PAIR", @@ -5905,7 +6091,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "$ref": "#/definitions/alpha.mutez" }, "destination": { - "$ref": "#/definitions/alpha.contract_id" + "$ref": "#/definitions/alpha.transaction_destination" }, "parameters": { "type": "object", @@ -6307,6 +6493,50 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, + { + "title": "Tx_rollup_submit_batch", + "type": "object", + "properties": { + "kind": { + "type": "string", + "enum": [ + "tx_rollup_submit_batch" + ] + }, + "source": { + "$ref": "#/definitions/Signature.Public_key_hash" + }, + "fee": { + "$ref": "#/definitions/alpha.mutez" + }, + "counter": { + "$ref": "#/definitions/positive_bignum" + }, + "gas_limit": { + "$ref": "#/definitions/positive_bignum" + }, + "storage_limit": { + "$ref": "#/definitions/positive_bignum" + }, + "rollup": { + "$ref": "#/definitions/alpha.tx_rollup_id" + }, + "content": { + "$ref": "#/definitions/unistring" + } + }, + "required": [ + "content", + "rollup", + "storage_limit", + "gas_limit", + "counter", + "fee", + "source", + "kind" + ], + "additionalProperties": false + }, { "title": "Sc_rollup_originate", "type": "object", @@ -6521,6 +6751,16 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, + "alpha.transaction_destination": { + "title": "A destination of a transaction", + "description": "A destination notation compatible with the contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash.", + "$ref": "#/definitions/unistring" + }, + "alpha.tx_rollup_id": { + "title": "A tx rollup handle", + "description": "A tx rollup notation as given to an RPC or inside scripts, is a base58 tx rollup hash", + "$ref": "#/definitions/unistring" + }, "bignum": { "title": "Big number", "description": "Decimal representation of a big number", diff --git a/tezt/_regressions/rpc/alpha.client.others.out b/tezt/_regressions/rpc/alpha.client.others.out index 919134333d72aa298df2219ffbecd387cbbab569..7464af507689b2320a713d939f2669571ab54151 100644 --- a/tezt/_regressions/rpc/alpha.client.others.out +++ b/tezt/_regressions/rpc/alpha.client.others.out @@ -29,7 +29,10 @@ tezt/_regressions/rpc/alpha.client.others.out "double_baking_punishment": "640000000", "ratio_of_frozen_deposits_slashed_per_double_endorsement": { "numerator": 1, "denominator": 2 }, "tx_rollup_enable": false, - "tx_rollup_origination_size": 60000, "sc_rollup_enable": false, + "tx_rollup_origination_size": 60000, + "tx_rollup_hard_size_limit_per_batch": 5000, + "tx_rollup_hard_size_limit_per_inbox": 100000, + "tx_rollup_initial_inbox_cost_per_byte": "250", "sc_rollup_enable": false, "sc_rollup_origination_size": 6314 } ./tezos-client rpc get /chains/main/blocks/head/helpers/baking_rights diff --git a/tezt/_regressions/rpc/alpha.light.others.out b/tezt/_regressions/rpc/alpha.light.others.out index 8ec3ed2ed9c1da3af15420a10580be5d6a666bff..489b0549fab1c7cd5f3e7fc48f7568f9b2957a8a 100644 --- a/tezt/_regressions/rpc/alpha.light.others.out +++ b/tezt/_regressions/rpc/alpha.light.others.out @@ -30,7 +30,10 @@ protocol of light mode unspecified, using the node's protocol: ProtoGenesisGenes "double_baking_punishment": "640000000", "ratio_of_frozen_deposits_slashed_per_double_endorsement": { "numerator": 1, "denominator": 2 }, "tx_rollup_enable": false, - "tx_rollup_origination_size": 60000, "sc_rollup_enable": false, + "tx_rollup_origination_size": 60000, + "tx_rollup_hard_size_limit_per_batch": 5000, + "tx_rollup_hard_size_limit_per_inbox": 100000, + "tx_rollup_initial_inbox_cost_per_byte": "250", "sc_rollup_enable": false, "sc_rollup_origination_size": 6314 } ./tezos-client --mode light rpc get /chains/main/blocks/head/helpers/baking_rights diff --git a/tezt/_regressions/rpc/alpha.proxy.mempool.out b/tezt/_regressions/rpc/alpha.proxy.mempool.out index b7fd93ad5e8b04f916a96bb76ab738f7acbd0e52..3fe48c207057e8091ec9ad3b8caeb4dd5053ed9e 100644 --- a/tezt/_regressions/rpc/alpha.proxy.mempool.out +++ b/tezt/_regressions/rpc/alpha.proxy.mempool.out @@ -701,11 +701,6 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, - "alpha.contract_id": { - "title": "A contract handle", - "description": "A contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash.", - "$ref": "#/definitions/unistring" - }, "alpha.entrypoint": { "title": "entrypoint", "description": "Named entrypoint to a Michelson smart contract", @@ -885,14 +880,14 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "False", "DUG", "DIG", - "chest_key", + "ticket", "BLAKE2B", "list", - "bls12_381_g1", + "never", "Pair", "INT", "nat", - "never", + "chain_id", "storage", "SIZE", "view", @@ -909,15 +904,15 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "operation", "MAP", "option", - "bls12_381_fr", + "bls12_381_g2", "ADD", "IMPLICIT_ACCOUNT", "SHA512", "int", "LSL", - "bls12_381_g2", - "ticket", - "sapling_transaction", + "bls12_381_g1", + "bls12_381_fr", + "tx_rollup_l2_address", "COMPARE", "SWAP", "STEPS_TO_QUOTA", @@ -925,6 +920,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "pair", "BALANCE", "CONCAT", + "constant", "MUL", "FAILWITH", "Elt", @@ -983,7 +979,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "PACK", "IF_CONS", "KECCAK", - "chest", + "chest_key", "UNIT", "EMPTY_SET", "NEQ", @@ -995,7 +991,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "contract", "LSR", "EMPTY_BIG_MAP", - "sapling_state", + "sapling_transaction", "JOIN_TICKETS", "LEVEL", "UNPAIR", @@ -1003,8 +999,8 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "PUSH", "big_map", "GT", - "chain_id", - "constant", + "sapling_state", + "chest", "NOW", "IF_NONE", "PAIR", @@ -1374,7 +1370,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "$ref": "#/definitions/alpha.mutez" }, "destination": { - "$ref": "#/definitions/alpha.contract_id" + "$ref": "#/definitions/alpha.transaction_destination" }, "parameters": { "type": "object", @@ -1776,6 +1772,50 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, + { + "title": "Tx_rollup_submit_batch", + "type": "object", + "properties": { + "kind": { + "type": "string", + "enum": [ + "tx_rollup_submit_batch" + ] + }, + "source": { + "$ref": "#/definitions/Signature.Public_key_hash" + }, + "fee": { + "$ref": "#/definitions/alpha.mutez" + }, + "counter": { + "$ref": "#/definitions/positive_bignum" + }, + "gas_limit": { + "$ref": "#/definitions/positive_bignum" + }, + "storage_limit": { + "$ref": "#/definitions/positive_bignum" + }, + "rollup": { + "$ref": "#/definitions/alpha.tx_rollup_id" + }, + "content": { + "$ref": "#/definitions/unistring" + } + }, + "required": [ + "content", + "rollup", + "storage_limit", + "gas_limit", + "counter", + "fee", + "source", + "kind" + ], + "additionalProperties": false + }, { "title": "Sc_rollup_originate", "type": "object", @@ -1990,6 +2030,16 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, + "alpha.transaction_destination": { + "title": "A destination of a transaction", + "description": "A destination notation compatible with the contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash.", + "$ref": "#/definitions/unistring" + }, + "alpha.tx_rollup_id": { + "title": "A tx rollup handle", + "description": "A tx rollup notation as given to an RPC or inside scripts, is a base58 tx rollup hash", + "$ref": "#/definitions/unistring" + }, "bignum": { "title": "Big number", "description": "Decimal representation of a big number", @@ -2240,7 +2290,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' }, { "description": { - "title": "alpha.contract_id" + "title": "alpha.transaction_destination" }, "encoding": { "tag_size": "Uint8", @@ -2318,6 +2368,46 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' } ], "name": "Originated" + }, + { + "tag": 2, + "fields": [ + { + "name": "Tag", + "layout": { + "size": "Uint8", + "kind": "Int" + }, + "data_kind": { + "size": 1, + "kind": "Float" + }, + "kind": "named" + }, + { + "name": "Rollup_hash", + "layout": { + "kind": "Bytes" + }, + "data_kind": { + "size": 20, + "kind": "Float" + }, + "kind": "named" + }, + { + "name": "padding", + "layout": { + "kind": "Padding" + }, + "data_kind": { + "size": 1, + "kind": "Float" + }, + "kind": "named" + } + ], + "name": "Tx_rollup" } ] } @@ -3908,7 +3998,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' { "name": "destination", "layout": { - "name": "alpha.contract_id", + "name": "alpha.transaction_destination", "kind": "Ref" }, "data_kind": { @@ -4389,6 +4479,106 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "name": "Tx_rollup_origination" }, + { + "tag": 151, + "fields": [ + { + "name": "Tag", + "layout": { + "size": "Uint8", + "kind": "Int" + }, + "data_kind": { + "size": 1, + "kind": "Float" + }, + "kind": "named" + }, + { + "name": "source", + "layout": { + "name": "public_key_hash", + "kind": "Ref" + }, + "data_kind": { + "size": 21, + "kind": "Float" + }, + "kind": "named" + }, + { + "name": "fee", + "layout": { + "name": "N.t", + "kind": "Ref" + }, + "data_kind": { + "kind": "Dynamic" + }, + "kind": "named" + }, + { + "name": "counter", + "layout": { + "name": "N.t", + "kind": "Ref" + }, + "data_kind": { + "kind": "Dynamic" + }, + "kind": "named" + }, + { + "name": "gas_limit", + "layout": { + "name": "N.t", + "kind": "Ref" + }, + "data_kind": { + "kind": "Dynamic" + }, + "kind": "named" + }, + { + "name": "storage_limit", + "layout": { + "name": "N.t", + "kind": "Ref" + }, + "data_kind": { + "kind": "Dynamic" + }, + "kind": "named" + }, + { + "name": "rollup", + "layout": { + "kind": "Bytes" + }, + "data_kind": { + "size": 20, + "kind": "Float" + }, + "kind": "named" + }, + { + "kind": "dyn", + "num_fields": 1, + "size": "Uint30" + }, + { + "name": "content", + "layout": { + "kind": "String" + }, + "data_kind": { + "kind": "Variable" + }, + "kind": "named" + } + ], + "name": "Tx_rollup_submit_batch" + }, { "tag": 200, "fields": [ @@ -5248,11 +5438,6 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, - "alpha.contract_id": { - "title": "A contract handle", - "description": "A contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash.", - "$ref": "#/definitions/unistring" - }, "alpha.entrypoint": { "title": "entrypoint", "description": "Named entrypoint to a Michelson smart contract", @@ -5432,14 +5617,14 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "False", "DUG", "DIG", - "chest_key", + "ticket", "BLAKE2B", "list", - "bls12_381_g1", + "never", "Pair", "INT", "nat", - "never", + "chain_id", "storage", "SIZE", "view", @@ -5456,15 +5641,15 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "operation", "MAP", "option", - "bls12_381_fr", + "bls12_381_g2", "ADD", "IMPLICIT_ACCOUNT", "SHA512", "int", "LSL", - "bls12_381_g2", - "ticket", - "sapling_transaction", + "bls12_381_g1", + "bls12_381_fr", + "tx_rollup_l2_address", "COMPARE", "SWAP", "STEPS_TO_QUOTA", @@ -5472,6 +5657,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "pair", "BALANCE", "CONCAT", + "constant", "MUL", "FAILWITH", "Elt", @@ -5530,7 +5716,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "PACK", "IF_CONS", "KECCAK", - "chest", + "chest_key", "UNIT", "EMPTY_SET", "NEQ", @@ -5542,7 +5728,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "contract", "LSR", "EMPTY_BIG_MAP", - "sapling_state", + "sapling_transaction", "JOIN_TICKETS", "LEVEL", "UNPAIR", @@ -5550,8 +5736,8 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "PUSH", "big_map", "GT", - "chain_id", - "constant", + "sapling_state", + "chest", "NOW", "IF_NONE", "PAIR", @@ -5921,7 +6107,7 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' "$ref": "#/definitions/alpha.mutez" }, "destination": { - "$ref": "#/definitions/alpha.contract_id" + "$ref": "#/definitions/alpha.transaction_destination" }, "parameters": { "type": "object", @@ -6323,6 +6509,50 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, + { + "title": "Tx_rollup_submit_batch", + "type": "object", + "properties": { + "kind": { + "type": "string", + "enum": [ + "tx_rollup_submit_batch" + ] + }, + "source": { + "$ref": "#/definitions/Signature.Public_key_hash" + }, + "fee": { + "$ref": "#/definitions/alpha.mutez" + }, + "counter": { + "$ref": "#/definitions/positive_bignum" + }, + "gas_limit": { + "$ref": "#/definitions/positive_bignum" + }, + "storage_limit": { + "$ref": "#/definitions/positive_bignum" + }, + "rollup": { + "$ref": "#/definitions/alpha.tx_rollup_id" + }, + "content": { + "$ref": "#/definitions/unistring" + } + }, + "required": [ + "content", + "rollup", + "storage_limit", + "gas_limit", + "counter", + "fee", + "source", + "kind" + ], + "additionalProperties": false + }, { "title": "Sc_rollup_originate", "type": "object", @@ -6537,6 +6767,16 @@ curl -s 'http://localhost:16385/describe/chains/main/mempool?recurse=yes' ], "additionalProperties": false }, + "alpha.transaction_destination": { + "title": "A destination of a transaction", + "description": "A destination notation compatible with the contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash.", + "$ref": "#/definitions/unistring" + }, + "alpha.tx_rollup_id": { + "title": "A tx rollup handle", + "description": "A tx rollup notation as given to an RPC or inside scripts, is a base58 tx rollup hash", + "$ref": "#/definitions/unistring" + }, "bignum": { "title": "Big number", "description": "Decimal representation of a big number", diff --git a/tezt/_regressions/rpc/alpha.proxy.others.out b/tezt/_regressions/rpc/alpha.proxy.others.out index 28ea8f4fc8389939289dceadcc5db0ae2da4bcbe..f9fb7ea6ba18f23d23b99ea06bc706f2a423437e 100644 --- a/tezt/_regressions/rpc/alpha.proxy.others.out +++ b/tezt/_regressions/rpc/alpha.proxy.others.out @@ -30,7 +30,10 @@ protocol of proxy unspecified, using the node's protocol: ProtoGenesisGenesisGen "double_baking_punishment": "640000000", "ratio_of_frozen_deposits_slashed_per_double_endorsement": { "numerator": 1, "denominator": 2 }, "tx_rollup_enable": false, - "tx_rollup_origination_size": 60000, "sc_rollup_enable": false, + "tx_rollup_origination_size": 60000, + "tx_rollup_hard_size_limit_per_batch": 5000, + "tx_rollup_hard_size_limit_per_inbox": 100000, + "tx_rollup_initial_inbox_cost_per_byte": "250", "sc_rollup_enable": false, "sc_rollup_origination_size": 6314 } ./tezos-client --mode proxy rpc get /chains/main/blocks/head/helpers/baking_rights diff --git a/tezt/_regressions/rpc/alpha.proxy_server.others.out b/tezt/_regressions/rpc/alpha.proxy_server.others.out index f1ae83d6ba67fea519c25f4fafea0f5492843f80..8e22049159b0647fb095634bc6206db954fae5c9 100644 --- a/tezt/_regressions/rpc/alpha.proxy_server.others.out +++ b/tezt/_regressions/rpc/alpha.proxy_server.others.out @@ -29,7 +29,10 @@ tezt/_regressions/rpc/alpha.proxy_server.others.out "double_baking_punishment": "640000000", "ratio_of_frozen_deposits_slashed_per_double_endorsement": { "numerator": 1, "denominator": 2 }, "tx_rollup_enable": false, - "tx_rollup_origination_size": 60000, "sc_rollup_enable": false, + "tx_rollup_origination_size": 60000, + "tx_rollup_hard_size_limit_per_batch": 5000, + "tx_rollup_hard_size_limit_per_inbox": 100000, + "tx_rollup_initial_inbox_cost_per_byte": "250", "sc_rollup_enable": false, "sc_rollup_origination_size": 6314 } ./tezos-client rpc get /chains/main/blocks/head/helpers/baking_rights diff --git a/tezt/lib_tezos/RPC.ml b/tezt/lib_tezos/RPC.ml index 26948d303fce310446ee170501573fc04e813876..e11440440f7049186d046ac8a030a561722d7870 100644 --- a/tezt/lib_tezos/RPC.ml +++ b/tezt/lib_tezos/RPC.ml @@ -628,21 +628,22 @@ module Script_cache = struct end module Tx_rollup = struct - let sub_path ~chain ~block ~tx_rollup_hash sub = - [ - "chains"; - chain; - "blocks"; - block; - "context"; - "tx_rollup"; - tx_rollup_hash; - sub; - ] + let sub_path ~chain ~block ~tx_rollup sub = + ["chains"; chain; "blocks"; block; "context"; "tx_rollup"; tx_rollup; sub] - let get_state ?endpoint ?hooks ?(chain = "main") ?(block = "head") - ~tx_rollup_hash client = - let path = sub_path ~chain ~block ~tx_rollup_hash "state" in + let get_state ?endpoint ?hooks ?(chain = "main") ?(block = "head") ~tx_rollup + client = + let path = sub_path ~chain ~block ~tx_rollup "state" in + Client.rpc ?endpoint ?hooks GET path client + + let spawn_get_inbox ?endpoint ?hooks ?(chain = "main") ?(block = "head") + ~tx_rollup client = + let path = sub_path ~chain ~block ~tx_rollup "inbox" in + Client.spawn_rpc ?endpoint ?hooks GET path client + + let get_inbox ?endpoint ?hooks ?(chain = "main") ?(block = "head") ~tx_rollup + client = + let path = sub_path ~chain ~block ~tx_rollup "inbox" in Client.rpc ?endpoint ?hooks GET path client end diff --git a/tezt/lib_tezos/RPC.mli b/tezt/lib_tezos/RPC.mli index c7192d9382004c1242a1cac2dcfadfa0f8ce746b..6dc3153884caae2bad80d42fd00cc94ca7b550f5 100644 --- a/tezt/lib_tezos/RPC.mli +++ b/tezt/lib_tezos/RPC.mli @@ -964,15 +964,35 @@ module Script_cache : sig end module Tx_rollup : sig - (** Call RPC /chain/[chain]/blocks/[block]/context/[rollup_hash]/state *) + (** Call RPC /chain/[chain]/blocks/[block]/context/tx_rollup/[tx_rollup_id]/state *) val get_state : ?endpoint:Client.endpoint -> ?hooks:Process.hooks -> ?chain:string -> ?block:string -> - tx_rollup_hash:string -> + tx_rollup:string -> Client.t -> JSON.t Lwt.t + + (** Call RPC /chain/[chain]/blocks/[block]/context/tx_rollup/[tx_rollup_id]/inbox *) + val get_inbox : + ?endpoint:Client.endpoint -> + ?hooks:Process.hooks -> + ?chain:string -> + ?block:string -> + tx_rollup:string -> + Client.t -> + JSON.t Lwt.t + + (** Same as [get_inbox], but do not wait for the process to exit. *) + val spawn_get_inbox : + ?endpoint:Client.endpoint -> + ?hooks:Process.hooks -> + ?chain:string -> + ?block:string -> + tx_rollup:string -> + Client.t -> + Process.t end module Curl : sig diff --git a/tezt/lib_tezos/client.ml b/tezt/lib_tezos/client.ml index b7548c1faacdac2c9c31c42e1c3416f764989bdb..738faf92b31c62060fcbbace353789c6407c1e7f 100644 --- a/tezt/lib_tezos/client.ml +++ b/tezt/lib_tezos/client.ml @@ -1070,6 +1070,43 @@ let originate_tx_rollup ?wait ?burn_cap ?storage_limit ~src client = =~* rex "Originated tx rollup: ?(\\w*)" |> mandatory "tx rollup hash" |> Lwt.return +let spawn_submit_tx_rollup_batch ?(wait = "none") ?burn_cap ?storage_limit + ~content ~tx_rollup ~src client = + spawn_command + client + (["--wait"; wait] + @ [ + "submit"; + "tx"; + "rollup"; + "batch"; + ("0x" ^ Hex.(of_bytes content |> show)); + "to"; + tx_rollup; + "from"; + src; + ] + @ Option.fold + ~none:[] + ~some:(fun burn_cap -> ["--burn-cap"; Tez.to_string burn_cap]) + burn_cap + @ Option.fold + ~none:[] + ~some:(fun s -> ["--storage-limit"; string_of_int s]) + storage_limit) + +let submit_tx_rollup_batch ?wait ?burn_cap ?storage_limit ~content ~tx_rollup + ~src client = + spawn_submit_tx_rollup_batch + ?wait + ?burn_cap + ?storage_limit + ~content + ~tx_rollup + ~src + client + |> Process.check + let spawn_show_voting_period ?endpoint client = spawn_command ?endpoint client (mode_arg client @ ["show"; "voting"; "period"]) diff --git a/tezt/lib_tezos/client.mli b/tezt/lib_tezos/client.mli index f96916d27d7f28f716fcf1ede50d62b8d08e9881..64011037a4c50819517ac1417c279bcfba3486d5 100644 --- a/tezt/lib_tezos/client.mli +++ b/tezt/lib_tezos/client.mli @@ -802,6 +802,28 @@ val spawn_originate_tx_rollup : t -> Process.t +(** Run [tezos-client submit tx rollup batch to from ]. *) +val submit_tx_rollup_batch : + ?wait:string -> + ?burn_cap:Tez.t -> + ?storage_limit:int -> + content:bytes -> + tx_rollup:string -> + src:string -> + t -> + unit Lwt.t + +(** Same as [submit_tx_rollup_batch], but do not wait for the process to exit. *) +val spawn_submit_tx_rollup_batch : + ?wait:string -> + ?burn_cap:Tez.t -> + ?storage_limit:int -> + content:bytes -> + tx_rollup:string -> + src:string -> + t -> + Process.t + (** Run [tezos-client show voting period] and return the period name. *) val show_voting_period : ?endpoint:endpoint -> t -> string Lwt.t diff --git a/tezt/tests/RPC_test.ml b/tezt/tests/RPC_test.ml index e2e2610a69053541786c2681e0eb48b8b708bec5..a0f2005cd0d60f6ec0c42fb4559c0eda48272e8f 100644 --- a/tezt/tests/RPC_test.ml +++ b/tezt/tests/RPC_test.ml @@ -617,7 +617,7 @@ let test_votes ?endpoint client = let test_tx_rollup ?endpoint client = let client_bake_for = make_client_bake_for () in - let* tx_rollup_hash = + let* tx_rollup = Client.originate_tx_rollup ~burn_cap:Tez.(of_int 9999999) ~storage_limit:60_000 @@ -625,7 +625,29 @@ let test_tx_rollup ?endpoint client = client in let* () = client_bake_for client in - let* _ = RPC.Tx_rollup.get_state ?endpoint ~tx_rollup_hash client in + let* _ = RPC.Tx_rollup.get_state ?endpoint ~tx_rollup client in + + let* () = + RPC.Tx_rollup.spawn_get_inbox ~tx_rollup client + |> Process.check_error + ~exit_code:1 + ~msg:(rex "No service found at this URL") + in + + (* Put a transaction on the rollup *) + let* () = + Client.submit_tx_rollup_batch + ~content:(Bytes.of_string "tezos") + ~tx_rollup + ~src:Constant.bootstrap1.public_key_hash + client + in + let* () = client_bake_for client in + (* Without that, the test is flaky for some reason *) + let* () = Lwt_unix.sleep 1.0 in + + (* Now this succeeds *) + let* _inbox = RPC.Tx_rollup.get_inbox ?endpoint ~tx_rollup client in unit (* Test the various other RPCs. *) diff --git a/tezt/tests/contracts/proto_alpha/tx_rollup_deposit.tz b/tezt/tests/contracts/proto_alpha/tx_rollup_deposit.tz new file mode 100644 index 0000000000000000000000000000000000000000..7f10911746bdfcdaf2d5077b11e0ffcd982ec6b0 --- /dev/null +++ b/tezt/tests/contracts/proto_alpha/tx_rollup_deposit.tz @@ -0,0 +1,33 @@ +parameter (pair address tx_rollup_l2_address); +storage (unit); +code { + # cast the address to contract type + CAR; + UNPAIR; + CONTRACT %deposit (pair (ticket unit) tx_rollup_l2_address); + + IF_SOME { + SWAP; + + # amount for transfering + PUSH mutez 0; + SWAP; + + # create a ticket + PUSH nat 10; + PUSH unit Unit; + TICKET; + + PAIR ; + + # deposit + TRANSFER_TOKENS; + + DIP { NIL operation }; + CONS; + + DIP { PUSH unit Unit }; + PAIR; + } + { FAIL ; } + } diff --git a/tezt/tests/tx_rollup.ml b/tezt/tests/tx_rollup.ml index 6da1e5601ea780dc99b4914ddd6eb72a22fdbbec..879f18513986543f16d71ce5db813cc89e91ee1e 100644 --- a/tezt/tests/tx_rollup.ml +++ b/tezt/tests/tx_rollup.ml @@ -25,12 +25,29 @@ (* utils *) -let get_state tx_rollup_hash client = - let* json = RPC.Tx_rollup.get_state ~tx_rollup_hash client in - JSON.(json |-> "state" |> as_opt |> Option.map (fun _ -> ())) |> Lwt.return +let l2_account1 = + "0x00000030b378a36ade25a9d23b684d35e4b969b11cc391858091c2393edf6fc1624cc26b21742955cc26e45c9c247a90b33182a5" + +let get_cost_per_byte tx_rollup client = + let* json = RPC.Tx_rollup.get_state ~tx_rollup client in + JSON.(json |-> "cost_per_byte" |> as_int |> Tez.of_mutez_int |> Lwt.return) + +type inbox = {content : JSON.t list; cumulated_size : int} + +let parse_inbox : JSON.t -> inbox = + fun inbox_obj -> + let content = JSON.(inbox_obj |-> "contents" |> as_list) in + let cumulated_size = JSON.(inbox_obj |-> "cumulated_size" |> as_int) in + {content; cumulated_size} + +let get_inbox tx_rollup client = + let* json = RPC.Tx_rollup.get_inbox ~tx_rollup client in + return (parse_inbox json) (* test *) +(** [test_simple_use_case] originates a transaction rollup and asserts no inbox + has been created by default for it. *) let test_simple_use_case = let open Tezt_tezos in Protocol.register_test ~__FILE__ ~title:"Simple use case" ~tags:["rollup"] @@ -43,7 +60,7 @@ let test_simple_use_case = let* (_node, client) = Client.init_with_protocol ~parameter_file `Client ~protocol () in - let* tx_rollup_hash = + let* tx_rollup = Client.originate_tx_rollup ~burn_cap:Tez.(of_int 9999999) ~storage_limit:60_000 @@ -51,13 +68,74 @@ let test_simple_use_case = client in let* () = Client.bake_for client in - let* state = get_state tx_rollup_hash client in - match state with - | Some _ -> unit - | None -> - Test.fail - "The tx rollups was not correctly originated and no state exists for \ - %s." - tx_rollup_hash - -let register ~protocols = test_simple_use_case ~protocols + (* Check the transaction rollup exists by trying to fetch its current + [cost_per_byte] state variable. *) + let* _rate = get_cost_per_byte tx_rollup client in + RPC.Tx_rollup.spawn_get_inbox ~tx_rollup client + |> Process.check_error ~exit_code:1 ~msg:(rex "No service found at this URL") + +(** [test_deposit] originates a transaction rollup, and a smart + contract that it uses to perform a ticket deposit to this + rollup. *) +let test_deposit = + let open Tezt_tezos in + Protocol.register_test + ~__FILE__ + ~title:"Alpha: Deposit a ticket" + ~tags:["rollup"] + @@ fun protocol -> + let* parameter_file = + Protocol.write_parameter_file + ~base:(Either.right (protocol, None)) + [(["tx_rollup_enable"], Some "true")] + in + let* (node, client) = + Client.init_with_protocol ~parameter_file `Client ~protocol () + in + + let* tx_rollup_contract = + Client.originate_contract + ~alias:"tx_rollup_deposit" + ~amount:Tez.zero + ~src:"bootstrap1" + ~prg:"file:./tezt/tests/contracts/proto_alpha/tx_rollup_deposit.tz" + ~init:"Unit" + ~burn_cap:Tez.(of_int 3) + client + in + let* tx_rollup = + Client.originate_tx_rollup + ~burn_cap:Tez.(of_int 9999999) + ~storage_limit:60_000 + ~src:Constant.bootstrap2.public_key_hash + client + in + + let* () = Client.bake_for client in + let* _ = Node.wait_for_level node 2 in + + let* (`OpHash _) = + Operation.inject_contract_call + ~amount:0 + ~source:Constant.bootstrap1 + ~dest:tx_rollup_contract + ~entrypoint:"default" + ~arg:(`Michelson (Format.sprintf "Pair \"%s\" %s" tx_rollup l2_account1)) + client + in + + let* () = Client.bake_for client in + let* _ = Node.wait_for_level node 3 in + + let* inbox = get_inbox tx_rollup client in + + Check.( + (List.length inbox.content = 1) + int + ~error_msg:"The inbox should contain one message") ; + + unit + +let register ~protocols = + test_simple_use_case ~protocols ; + test_deposit ~protocols diff --git a/vendors/flextesa-lib/tezos_protocol.ml b/vendors/flextesa-lib/tezos_protocol.ml index 7ff502680d8827f85ef6f5c4718d4881674c8005..009d94b1c3781fcd7f330ce24c18cf923a9502ab 100644 --- a/vendors/flextesa-lib/tezos_protocol.ml +++ b/vendors/flextesa-lib/tezos_protocol.ml @@ -169,8 +169,13 @@ let protocol_parameters_json t : Ezjsonm.t = , dict [("numerator", int 1); ("denominator", int 2)] ) ; ("double_baking_punishment", string "640000000") ; ("tx_rollup_enable", bool false) - ; (* TODO: https://gitlab.com/tezos/tezos/-/issues/2152 *) - ("tx_rollup_origination_size", int 60_000) + ; (* TODO: https://gitlab.com/tezos/tezos/-/issues/2152 + Transaction rollups parameters need to be refined, + currently the following values are merely + placeholders. *) ("tx_rollup_origination_size", int 60_000) + ; ("tx_rollup_hard_size_limit_per_batch", int 5_000) + ; ("tx_rollup_hard_size_limit_per_inbox", int 100_000) + ; ("tx_rollup_initial_inbox_cost_per_byte", string (Int.to_string 250)) ; ("sc_rollup_enable", bool false) ; ("sc_rollup_origination_size", int 6_314) ] | `Granada | `Hangzhou -> []