From 19d0696b330fe1988707598aced5a726034dd6a2 Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Wed, 23 Feb 2022 14:37:58 +0100 Subject: [PATCH 01/10] Tx_rollup: add let*? to the syntax of the context functor --- src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml | 3 +++ src/proto_alpha/lib_protocol/tx_rollup_l2_context_sig.ml | 4 ++++ 2 files changed, 7 insertions(+) diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml index 34c3e65dfc28..4cb5dce5e025 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml @@ -273,6 +273,9 @@ struct module Syntax = struct include S.Syntax + let ( let*? ) res f = + match res with Result.Ok v -> f v | Result.Error error -> fail error + let fail_unless cond error = let open S.Syntax in if cond then return () else fail error diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_context_sig.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_context_sig.ml index cb878008d209..407a71d06d87 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_context_sig.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_context_sig.ml @@ -100,6 +100,10 @@ module type CONTEXT = sig val ( let* ) : 'a m -> ('a -> 'b m) -> 'b m + (** [let*?] is for binding the value from Result-only + expressions into the storage monad. *) + val ( let*? ) : ('a, error) result -> ('a -> 'b m) -> 'b m + (** [fail err] shortcuts the current computation by raising an error. -- GitLab From b8bf540cd86b53698d4c4bac749c1f0907332d39 Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Wed, 23 Feb 2022 14:38:31 +0100 Subject: [PATCH 02/10] Tx_rollup: add partial function `is_value_e` from indexables to wrapped value --- src/proto_alpha/lib_protocol/indexable.ml | 4 ++++ src/proto_alpha/lib_protocol/indexable.mli | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/src/proto_alpha/lib_protocol/indexable.ml b/src/proto_alpha/lib_protocol/indexable.ml index 61b54769e5b7..22bdfe1e2041 100644 --- a/src/proto_alpha/lib_protocol/indexable.ml +++ b/src/proto_alpha/lib_protocol/indexable.ml @@ -97,6 +97,10 @@ let to_int32 = function Index x -> x let to_value = function Value x -> x +let is_value_e : error:'trace -> ('state, 'a) t -> ('a, 'trace) result = + fun ~error v -> + match destruct v with Left _ -> Result.error error | Right v -> Result.ok v + let compact val_encoding = Data_encoding.Compact.( conv diff --git a/src/proto_alpha/lib_protocol/indexable.mli b/src/proto_alpha/lib_protocol/indexable.mli index 9c4f4d80a55a..fa631ae1f10c 100644 --- a/src/proto_alpha/lib_protocol/indexable.mli +++ b/src/proto_alpha/lib_protocol/indexable.mli @@ -115,6 +115,10 @@ val to_int32 : 'a index -> int32 (** [to_value x] unwraps and returns the value behind [x]. *) val to_value : 'a value -> 'a +(** [is_value_e err x] unwraps and returns the value behind [x], and + throws an [err] if [x] is an index. *) +val is_value_e : error:'trace -> ('state, 'a) t -> ('a, 'trace) result + (** [in_memory_size a] returns the number of bytes allocated in RAM for [a]. *) val in_memory_size : ('a -> Cache_memory_helpers.sint) -> -- GitLab From eff9c2c9edefbac52067e2ba9ac520ab32ecaec3 Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Fri, 25 Feb 2022 15:39:44 +0100 Subject: [PATCH 03/10] Tx_rollup: deduplicate tx_rollup_l2_context errors They were defined twice. Here we put them in tx_rollup_l2_context_sig.ml which seems like the natural place. --- .../test/unit/test_tx_rollup_l2.ml | 2 +- .../test/unit/test_tx_rollup_l2_apply.ml | 2 +- .../lib_protocol/tx_rollup_l2_context.ml | 94 ------------------- .../lib_protocol/tx_rollup_l2_context_sig.ml | 84 +++++++++++++++++ 4 files changed, 86 insertions(+), 96 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml index add9172682b8..52010db90c77 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml @@ -36,7 +36,7 @@ open Tztest open Tx_rollup_l2_helpers open Protocol -open Tx_rollup_l2_context +open Tx_rollup_l2_context_sig (** {1. Storage and context tests. } *) diff --git a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml index f4e3e675bd05..93754b669087 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml @@ -682,7 +682,7 @@ let test_invalid_transaction () = let* () = expect_error_status ~msg:"an invalid transaction must fail" - Tx_rollup_l2_context.Balance_too_low + Tx_rollup_l2_context_sig.Balance_too_low status (let* () = check_balance diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml index 4cb5dce5e025..4d346cb09529 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_context.ml @@ -46,100 +46,6 @@ let metadata_encoding = (fun (counter, public_key) -> {counter; public_key}) (obj2 (req "counter" int64) (req "public_key" pk_encoding))) -type error += - | Unknown_address_index of address_index - | Balance_too_low - | Balance_overflow - | Invalid_quantity - | Metadata_already_initialized of address_index - | Too_many_l2_addresses - | Too_many_l2_tickets - | Counter_overflow - -let () = - let open Data_encoding in - (* Unknown address index *) - register_error_kind - `Temporary - ~id:"tx_rollup_unknown_address_index" - ~title:"Unknown address index" - ~description:"Tried to increment the counter of an unknown address index" - (obj1 (req "index" Tx_rollup_l2_address.Indexable.index_encoding)) - (function Unknown_address_index x -> Some x | _ -> None) - (fun x -> Unknown_address_index x) ; - (* Balance too low *) - register_error_kind - `Temporary - ~id:"tx_rollup_balance_too_low" - ~title:"Balance too low" - ~description: - "Tried to spend a ticket index from an index without the required balance" - empty - (function Balance_too_low -> Some () | _ -> None) - (fun () -> Balance_too_low) ; - (* Balance overflow *) - register_error_kind - `Temporary - ~id:"tx_rollup_balance_overflow" - ~title:"Balance overflow" - ~description: - "Tried to credit a ticket index to an index to a new balance greater \ - than the integer 32 limit" - empty - (function Balance_overflow -> Some () | _ -> None) - (fun () -> Balance_overflow) ; - (* Invalid_quantity *) - register_error_kind - `Permanent - ~id:"tx_rollup_invalid_quantity" - ~title:"Invalid quantity" - ~description: - "Tried to credit a ticket index to an index with a quantity non-strictly \ - positive" - empty - (function Invalid_quantity -> Some () | _ -> None) - (fun () -> Invalid_quantity) ; - (* Metadata already initialized *) - register_error_kind - `Branch - ~id:"tx_rollup_metadata_already_initialized" - ~title:"Metadata already initiliazed" - ~description: - "Tried to initialize a metadata for an index which was already \ - initiliazed" - (obj1 (req "index" Tx_rollup_l2_address.Indexable.index_encoding)) - (function Metadata_already_initialized x -> Some x | _ -> None) - (fun x -> Metadata_already_initialized x) ; - (* Too many l2 addresses associated *) - register_error_kind - `Branch - ~id:"tx_rollup_too_many_l2_addresses" - ~title:"Too many l2 addresses" - ~description:"The number of l2 addresses has reached the integer 32 limit" - empty - (function Too_many_l2_addresses -> Some () | _ -> None) - (fun () -> Too_many_l2_addresses) ; - (* Too many l2 tickets associated *) - register_error_kind - `Branch - ~id:"tx_rollup_too_many_l2_tickets" - ~title:"Too many l2 tickets" - ~description:"The number of l2 tickets has reached the integer 32 limit" - empty - (function Too_many_l2_tickets -> Some () | _ -> None) - (fun () -> Too_many_l2_tickets) ; - (* Counter overflow *) - register_error_kind - `Branch - ~id:"tx_rollup_counter_overflow" - ~title:"Counter overflow" - ~description: - "Tried to increment the counter of an address and reached the integer 64 \ - limit" - empty - (function Counter_overflow -> Some () | _ -> None) - (fun () -> Counter_overflow) - (** {1 Type-Safe Storage Access and Gas Accounting} *) (** A value of type ['a key] identifies a value of type ['a] in an diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_context_sig.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_context_sig.ml index 407a71d06d87..078de5140136 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_context_sig.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_context_sig.ml @@ -73,6 +73,90 @@ type error += | Too_many_l2_tickets | Counter_overflow +let () = + let open Data_encoding in + (* Unknown address index *) + register_error_kind + `Temporary + ~id:"tx_rollup_unknown_address_index" + ~title:"Unknown address index" + ~description:"Tried to increment the counter of an unknown address index" + (obj1 (req "index" Tx_rollup_l2_address.Indexable.index_encoding)) + (function Unknown_address_index x -> Some x | _ -> None) + (fun x -> Unknown_address_index x) ; + (* Balance too low *) + register_error_kind + `Temporary + ~id:"tx_rollup_balance_too_low" + ~title:"Balance too low" + ~description: + "Tried to spend a ticket index from an index without the required balance" + empty + (function Balance_too_low -> Some () | _ -> None) + (fun () -> Balance_too_low) ; + (* Balance overflow *) + register_error_kind + `Temporary + ~id:"tx_rollup_balance_overflow" + ~title:"Balance overflow" + ~description: + "Tried to credit a ticket index to an index to a new balance greater \ + than the integer 32 limit" + empty + (function Balance_overflow -> Some () | _ -> None) + (fun () -> Balance_overflow) ; + (* Invalid_quantity *) + register_error_kind + `Permanent + ~id:"tx_rollup_invalid_quantity" + ~title:"Invalid quantity" + ~description: + "Tried to credit a ticket index to an index with a quantity non-strictly \ + positive" + empty + (function Invalid_quantity -> Some () | _ -> None) + (fun () -> Invalid_quantity) ; + (* Metadata already initialized *) + register_error_kind + `Branch + ~id:"tx_rollup_metadata_already_initialized" + ~title:"Metadata already initiliazed" + ~description: + "Tried to initialize a metadata for an index which was already \ + initiliazed" + (obj1 (req "index" Tx_rollup_l2_address.Indexable.index_encoding)) + (function Metadata_already_initialized x -> Some x | _ -> None) + (fun x -> Metadata_already_initialized x) ; + (* Too many l2 addresses associated *) + register_error_kind + `Branch + ~id:"tx_rollup_too_many_l2_addresses" + ~title:"Too many l2 addresses" + ~description:"The number of l2 addresses has reached the integer 32 limit" + empty + (function Too_many_l2_addresses -> Some () | _ -> None) + (fun () -> Too_many_l2_addresses) ; + (* Too many l2 tickets associated *) + register_error_kind + `Branch + ~id:"tx_rollup_too_many_l2_tickets" + ~title:"Too many l2 tickets" + ~description:"The number of l2 tickets has reached the integer 32 limit" + empty + (function Too_many_l2_tickets -> Some () | _ -> None) + (fun () -> Too_many_l2_tickets) ; + (* Counter overflow *) + register_error_kind + `Branch + ~id:"tx_rollup_counter_overflow" + ~title:"Counter overflow" + ~description: + "Tried to increment the counter of an address and reached the integer 64 \ + limit" + empty + (function Counter_overflow -> Some () | _ -> None) + (fun () -> Counter_overflow) + (** 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 -- GitLab From 803d51f7026e9d531f6b86b0cf2fef9a0c04cda7 Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Mon, 21 Feb 2022 15:05:00 +0100 Subject: [PATCH 04/10] Tx_rollup: layer2 implementation of layer2-to-layer1 withdrawal --- src/proto_alpha/lib_protocol/alpha_context.ml | 4 +- .../lib_protocol/alpha_context.mli | 2 + src/proto_alpha/lib_protocol/apply.ml | 18 +- .../lib_protocol/tx_rollup_l2_apply.ml | 154 +++++++++++++----- .../lib_protocol/tx_rollup_l2_apply.mli | 39 ++++- .../lib_protocol/tx_rollup_message_repr.ml | 26 ++- .../lib_protocol/tx_rollup_message_repr.mli | 6 +- 7 files changed, 191 insertions(+), 58 deletions(-) diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index d577d1f3a1ae..63c91dfa74c9 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -265,8 +265,8 @@ module Tx_rollup_message = struct let make_batch string = make_message @@ Batch string - let make_deposit destination ticket_hash amount = - make_message @@ Deposit {destination; ticket_hash; amount} + let make_deposit sender destination ticket_hash amount = + make_message @@ Deposit {sender; destination; ticket_hash; amount} end module Tx_rollup_inbox = struct diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 864643975637..068b3b82d245 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2053,6 +2053,7 @@ end (** This module re-exports definitions from {!Tx_rollup_message_repr}. *) module Tx_rollup_message : sig type deposit = { + sender : public_key_hash; destination : Tx_rollup_l2_address.Indexable.value; ticket_hash : Ticket_hash.t; amount : Tx_rollup_l2_qty.t; @@ -2070,6 +2071,7 @@ module Tx_rollup_message : sig along with its size in bytes. See {!Tx_rollup_message_repr.size}. *) val make_deposit : + public_key_hash -> Tx_rollup_l2_address.t Indexable.value -> Ticket_hash.t -> Tx_rollup_l2_qty.t -> diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 082901a353bd..1eeeb3ce3348 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1063,8 +1063,24 @@ let apply_manager_operation_content : -> Tx_rollup.hash_ticket ctxt dst ~contents ~ticketer ~ty >>?= fun (ticket_hash, ctxt) -> + (* The deposit is returned to the [payer] as a withdrawal + if it fails due to a Balance_overflow in the + recipient. The recipient of withdrawals are always + implicit. We set the withdrawal recipient to [payer]: + the protocol ensures that [payer] is implicit, yet we + must do this conversion. *) + Option.value_e + ~error: + (Error_monad.trace_of_error + Tx_rollup_operation_with_non_implicit_contract) + (Contract.is_implicit payer) + >>?= fun payer_implicit -> let (deposit, message_size) = - Tx_rollup_message.make_deposit destination ticket_hash amount + Tx_rollup_message.make_deposit + payer_implicit + destination + ticket_hash + amount in Tx_rollup_state.get ctxt dst >>=? fun (ctxt, state) -> Tx_rollup_state.burn ~limit:None state message_size >>?= fun cost -> diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml index a265af2b0bd0..4ebb8740ff3d 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml @@ -41,6 +41,8 @@ type error += | Invalid_transaction_encoding | Invalid_batch_encoding | Invalid_operation_destination + | Unexpectedly_indexed_ticket + | Missing_ticket let () = let open Data_encoding in @@ -119,7 +121,27 @@ let () = ~description:"The withdraw operation is not implemented yet" empty (function Invalid_operation_destination -> Some () | _ -> None) - (function () -> Invalid_operation_destination) + (function () -> Invalid_operation_destination) ; + (* Unexpectedly indexed ticket *) + register_error_kind + `Permanent + ~id:"tx_rollup_unexpectedly_indexed_ticket" + ~title:"Unexpected indexed ticket in deposit or transfer" + ~description: + "Tickets in layer2-to-layer1 transfers must be referenced by value." + empty + (function Unexpectedly_indexed_ticket -> Some () | _ -> None) + (function () -> Unexpectedly_indexed_ticket) ; + (* Missing ticket *) + register_error_kind + `Permanent + ~id:"tx_rollup_missing_ticket" + ~title:"Attempted to withdraw from a ticket missing in the rollup" + ~description: + "A withdrawal must reference a ticket that already exists in the rollup." + empty + (function Missing_ticket -> Some () | _ -> None) + (function () -> Missing_ticket) module Address_indexes = Map.Make (Tx_rollup_l2_address) module Ticket_indexes = Map.Make (Ticket_hash) @@ -134,6 +156,12 @@ type indexes = { } module Message_result = struct + type withdrawal = { + destination : Signature.Public_key_hash.t; + ticket_hash : Ticket_hash.t; + amount : Tx_rollup_l2_qty.t; + } + type transaction_result = | Transaction_success | Transaction_failure of {index : int; reason : error} @@ -151,7 +179,11 @@ module Message_result = struct } end - type t = Deposit_result of deposit_result | Batch_V1_result of Batch_V1.t + type message_result = + | Deposit_result of deposit_result + | Batch_V1_result of Batch_V1.t + + type t = message_result * withdrawal list end module Make (Context : CONTEXT) = struct @@ -419,23 +451,41 @@ module Make (Context : CONTEXT) = struct on the [ctxt]. The validity of the transfer is checked in the context itself, e.g. for an invalid balance. - It also returns the potential created indexes: + It returns the potential created indexes: {ul {li The destination address index.} {li The ticket exchanged index.}} + + If the transfer is layer2-to-layer1, then it also returns + the resulting withdrawal. *) let apply_operation_content : ctxt -> indexes -> Signer_indexable.index -> 'content operation_content -> - (ctxt * indexes) m = + (ctxt * indexes * withdrawal option) m = fun ctxt indexes source_idx {destination; ticket_hash; qty} -> match destination with - | Layer1 _ -> - (* FIXME/TORU: https://gitlab.com/tezos/tezos/-/issues/2259 - Implement the withdraw. *) - fail Invalid_operation_destination + | Layer1 l1_dest -> + (* To withdraw, the ticket must be given in the form of a + value. Furthermore, the ticket must already exist in the + rollup and be indexed (the ticket must have already been + assigned an index in the content: otherwise the ticket has + not been seen before and we can't withdraw from + it). Therefore, we do not create any new associations in + the ticket index. *) + let*? ticket_hash = + Indexable.is_value_e ~error:Unexpectedly_indexed_ticket ticket_hash + in + let* tidx_opt = Ticket_index.get ctxt ticket_hash in + let*? tidx = Option.value_e ~error:Missing_ticket tidx_opt in + let source_idx = address_of_signer_index source_idx in + (* spend the ticket -- this is responsible for checking that + the source has the required balance *) + let* ctxt = Ticket_ledger.spend ctxt tidx source_idx qty in + let withdrawal = {destination = l1_dest; ticket_hash; amount = qty} in + return (ctxt, indexes, Some withdrawal) | Layer2 l2_dest -> let* (ctxt, created_addr, dest_idx) = address_index ctxt l2_dest in let* (ctxt, created_ticket, tidx) = ticket_index ctxt ticket_hash in @@ -444,7 +494,7 @@ module Make (Context : CONTEXT) = struct let indexes = add_indexes indexes (created_addr, dest_idx) (created_ticket, tidx) in - return (ctxt, indexes) + return (ctxt, indexes, None) (** [check_counter ctxt signer counter] asserts that the provided [counter] is equal to the expected one associated to the [signer] in the [ctxt]. *) @@ -467,15 +517,21 @@ module Make (Context : CONTEXT) = struct ctxt -> indexes -> (Indexable.index_only, Indexable.unknown) operation -> - (ctxt * indexes) m = + (ctxt * indexes * withdrawal list) m = fun ctxt indexes {signer; counter; contents} -> (* Before applying any operation, we check the counter *) let* () = check_counter ctxt signer counter in - list_fold_left_m - (fun (ctxt, indexes) content -> - apply_operation_content ctxt indexes signer content) - (ctxt, indexes) - contents + let* (ctxt, indexes, withdrawals) = + list_fold_left_m + (fun (ctxt, indexes, withdrawals) content -> + let* (ctxt, indexes, withdrawal_opt) = + apply_operation_content ctxt indexes signer content + in + return (ctxt, indexes, Option.to_list withdrawal_opt @ withdrawals)) + (ctxt, indexes, []) + contents + in + return (ctxt, indexes, withdrawals |> List.rev) (** [apply_transaction ctxt indexes transaction] applies each operation in the [transaction]. It returns a {!transaction_result}, i.e. either @@ -487,25 +543,30 @@ module Make (Context : CONTEXT) = struct ctxt -> indexes -> (Indexable.index_only, Indexable.unknown) transaction -> - (ctxt * indexes * transaction_result) m = + (ctxt * indexes * transaction_result * withdrawal list) m = fun initial_ctxt initial_indexes transaction -> - let rec fold (ctxt, prev_indexes) index ops = + let rec fold (ctxt, prev_indexes, withdrawals) index ops = match ops with - | [] -> return (ctxt, prev_indexes, Transaction_success) + | [] -> return (ctxt, prev_indexes, Transaction_success, withdrawals) | op :: rst -> - let* (ctxt, indexes, status) = + let* (ctxt, indexes, status, withdrawals) = catch (apply_operation ctxt prev_indexes op) - (fun (ctxt, indexes) -> fold (ctxt, indexes) (index + 1) rst) + (fun (ctxt, indexes, op_withdrawals) -> + fold + (ctxt, indexes, withdrawals @ op_withdrawals) + (index + 1) + rst) (fun reason -> return ( initial_ctxt, initial_indexes, - Transaction_failure {index; reason} )) + Transaction_failure {index; reason}, + [] )) in - return (ctxt, indexes, status) + return (ctxt, indexes, status, withdrawals) in - fold (initial_ctxt, initial_indexes) 0 transaction + fold (initial_ctxt, initial_indexes, []) 0 transaction (** [update_counters ctxt status transaction] updates the counters for the signers of operations in [transaction]. If the [transaction] @@ -526,28 +587,37 @@ module Make (Context : CONTEXT) = struct let apply_batch : ctxt -> (Indexable.unknown, Indexable.unknown) t -> - (ctxt * Message_result.Batch_V1.t) m = + (ctxt * Message_result.Batch_V1.t * withdrawal list) m = fun ctxt batch -> let* (ctxt, indexes, batch) = check_signature ctxt batch in let {contents; _} = batch in - let* (ctxt, indexes, rev_results) = + let* (ctxt, indexes, rev_results, withdrawals) = list_fold_left_m - (fun (prev_ctxt, prev_indexes, results) transaction -> - let* (new_ctxt, new_indexes, status) = + (fun (prev_ctxt, prev_indexes, results, withdrawals) transaction -> + let* (new_ctxt, new_indexes, status, transactions_withdrawals) = apply_transaction prev_ctxt prev_indexes transaction in let* new_ctxt = update_counters new_ctxt status transaction in - return (new_ctxt, new_indexes, (transaction, status) :: results)) - (ctxt, indexes, []) + return + ( new_ctxt, + new_indexes, + (transaction, status) :: results, + withdrawals @ transactions_withdrawals )) + (ctxt, indexes, [], []) contents in let results = List.rev rev_results in - return (ctxt, Message_result.Batch_V1.Batch_result {results; indexes}) + return + ( ctxt, + Message_result.Batch_V1.Batch_result {results; indexes}, + withdrawals ) end let apply_deposit : - ctxt -> Tx_rollup_message.deposit -> (ctxt * deposit_result) m = - fun initial_ctxt Tx_rollup_message.{destination; ticket_hash; amount} -> + ctxt -> + Tx_rollup_message.deposit -> + (ctxt * deposit_result * withdrawal option) m = + fun initial_ctxt Tx_rollup_message.{sender; destination; ticket_hash; amount} -> let apply_deposit () = let* (ctxt, created_addr, aidx) = address_index initial_ctxt destination @@ -563,8 +633,14 @@ module Make (Context : CONTEXT) = struct in catch (apply_deposit ()) - (fun (ctxt, indexes) -> return (ctxt, Deposit_success indexes)) - (fun reason -> return (initial_ctxt, Deposit_failure reason)) + (fun (ctxt, indexes) -> return (ctxt, Deposit_success indexes, None)) + (function + | reason -> + (* Should there an error during the deposit, then return + the full [amount] to [sender] in the form of a + withdrawal. *) + let withdrawal = {destination = sender; ticket_hash; amount} in + return (initial_ctxt, Deposit_failure reason, Some withdrawal)) let apply_message : ctxt -> Tx_rollup_message.t -> (ctxt * Message_result.t) m = @@ -572,15 +648,17 @@ module Make (Context : CONTEXT) = struct let open Tx_rollup_message in match msg with | Deposit deposit -> - let* (ctxt, result) = apply_deposit ctxt deposit in - return (ctxt, Deposit_result result) + let* (ctxt, result, withdrawl_opt) = apply_deposit ctxt deposit in + return (ctxt, (Deposit_result result, Option.to_list withdrawl_opt)) | Batch str -> ( let batch = Data_encoding.Binary.of_string_opt Tx_rollup_l2_batch.encoding str in match batch with | Some (V1 batch) -> - let* (ctxt, result) = Batch_V1.apply_batch ctxt batch in - return (ctxt, Batch_V1_result result) + let* (ctxt, result, withdrawals) = + Batch_V1.apply_batch ctxt batch + in + return (ctxt, (Batch_V1_result result, withdrawals)) | None -> fail Invalid_batch_encoding) 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 index de23b8569e81..2c5da71defbd 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.mli +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.mli @@ -60,6 +60,8 @@ type error += | Invalid_transaction_encoding | Invalid_batch_encoding | Invalid_operation_destination + | Unexpectedly_indexed_ticket + | Missing_ticket module Address_indexes : Map.S with type key = Tx_rollup_l2_address.t @@ -79,7 +81,14 @@ type indexes = { } module Message_result : sig + type withdrawal = { + destination : Signature.Public_key_hash.t; + ticket_hash : Ticket_hash.t; + amount : Tx_rollup_l2_qty.t; + } + (** A transaction inside a batch can either be a success or a failure. + In the case of a failure, we store the operation's index which failed with the reason it failed. *) type transaction_result = @@ -105,7 +114,14 @@ module Message_result : sig } end - type t = Deposit_result of deposit_result | Batch_V1_result of Batch_V1.t + type message_result = + | Deposit_result of deposit_result + | Batch_V1_result of Batch_V1.t + + (* In addition to [message_result] the result contains the list of + withdrawals that result from failing deposits and layer2-to-layer1 + transfers. *) + type t = message_result * withdrawal list end module Make (Context : CONTEXT) : sig @@ -119,7 +135,7 @@ module Make (Context : CONTEXT) : sig module Batch_V1 : sig open Tx_rollup_l2_batch.V1 - (** [apply_batch ctxt batch] interpets the batch {Tx_rollup_l2_batch.V1.t}. + (** [apply_batch ctxt batch] interprets the batch {Tx_rollup_l2_batch.V1.t}. By construction, a failing transaction will not affect the [ctxt] and other transactions will still be interpreted. @@ -131,11 +147,14 @@ module Make (Context : CONTEXT) : sig that is correctly signed and whose every operations have the expected counter. In particular, the result of the application is not important (i.e. the counters are updated even if the transaction failed). + + In addition, the list of withdrawals resulting from each + layer2-to-layer1 transfer message in the batch is returned. *) val apply_batch : ctxt -> (Indexable.unknown, Indexable.unknown) t -> - (ctxt * Message_result.Batch_V1.t) m + (ctxt * Message_result.Batch_V1.t * Message_result.withdrawal list) m (** [check_signature ctxt batch] asserts that [batch] is correctly signed. @@ -174,13 +193,16 @@ module Make (Context : CONTEXT) : sig (** [apply_deposit ctxt deposit] credits a quantity of tickets to a layer2 address in [ctxt]. - This function can fail if the [deposit.amount] is not strictly-positive - or if the [deposit.quantity] caused an overflow in the context. + This function can fail if the [deposit.amount] is not strictly-positive. + + If the [deposit.quantity] caused an overflow in the account of the + recipient, then a withdrawal returning the funds to the deposit's sender + is returned. *) val apply_deposit : ctxt -> Tx_rollup_message.deposit -> - (ctxt * Message_result.deposit_result) m + (ctxt * Message_result.deposit_result * Message_result.withdrawal option) m (** [apply_message ctxt message] interpets the [message] in the [ctxt]. @@ -190,11 +212,14 @@ module Make (Context : CONTEXT) : sig {li Decodes the batch and interprets it for the correct batch version. }} - The function can fail with {!Invalid_batch_encoding} if its not able + The function can fail with {!Invalid_batch_encoding} if it's not able to decode the batch. The function can also return errors from subsequent functions, see {!apply_deposit} and batch interpretations for various versions. + + The list of withdrawals in the message result followed the ordering + of the contents in the message. *) val apply_message : ctxt -> Tx_rollup_message.t -> (ctxt * Message_result.t) m end diff --git a/src/proto_alpha/lib_protocol/tx_rollup_message_repr.ml b/src/proto_alpha/lib_protocol/tx_rollup_message_repr.ml index 473dc5cee089..b912b2cde0db 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_message_repr.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_message_repr.ml @@ -26,6 +26,7 @@ (*****************************************************************************) type deposit = { + sender : Signature.Public_key_hash.t; destination : Tx_rollup_l2_address.Indexable.value; ticket_hash : Ticket_hash_repr.t; amount : Tx_rollup_l2_qty.t; @@ -34,11 +35,12 @@ type deposit = { let deposit_encoding = let open Data_encoding in conv - (fun {destination; ticket_hash; amount} -> - (destination, ticket_hash, amount)) - (fun (destination, ticket_hash, amount) -> - {destination; ticket_hash; amount}) - @@ obj3 + (fun {sender; destination; ticket_hash; amount} -> + (sender, destination, ticket_hash, amount)) + (fun (sender, destination, ticket_hash, amount) -> + {sender; destination; ticket_hash; amount}) + @@ obj4 + (req "sender" Signature.Public_key_hash.encoding) (req "destination" Tx_rollup_l2_address.Indexable.value_encoding) (req "ticket_hash" Ticket_hash_repr.encoding) (req "amount" Tx_rollup_l2_qty.encoding) @@ -80,10 +82,13 @@ let pp fmt = "@[Batch:@ %s%s@]" (Hex.of_string str |> Hex.show) ellipsis - | Deposit {destination; ticket_hash; amount} -> + | Deposit {sender; destination; ticket_hash; amount} -> fprintf fmt - "@[Deposit:@ destination=%a,@ ticket_hash=%a,@ amount:%a@]" + "@[Deposit:@ sender=%a,@ destination=%a,@ ticket_hash=%a,@ \ + amount:%a@]" + Signature.Public_key_hash.pp + sender Tx_rollup_l2_address.Indexable.pp destination Ticket_hash_repr.pp @@ -93,7 +98,10 @@ let pp fmt = let size = function | Batch batch -> String.length batch - | Deposit {destination = d; ticket_hash = _; amount = _} -> + | Deposit {sender = _; destination = d; ticket_hash = _; amount = _} -> + (* Size of a BLS public key, that is the underlying type of a + l2 address. See [Tx_rollup_l2_address] *) + let sender_size = Signature.Public_key_hash.size in (* Size of a BLS public key, that is the underlying type of a l2 address. See [Tx_rollup_l2_address] *) let destination_size = Tx_rollup_l2_address.Indexable.size d in @@ -102,7 +110,7 @@ let size = function let key_hash_size = 32 in (* [int64] *) let amount_size = 8 in - destination_size + key_hash_size + amount_size + sender_size + destination_size + key_hash_size + amount_size let hash_size = 32 diff --git a/src/proto_alpha/lib_protocol/tx_rollup_message_repr.mli b/src/proto_alpha/lib_protocol/tx_rollup_message_repr.mli index 495759df131c..560e25fb72a5 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_message_repr.mli +++ b/src/proto_alpha/lib_protocol/tx_rollup_message_repr.mli @@ -33,8 +33,12 @@ inboxes (see {!Tx_rollup_repr_storage.append_message}). *) (** Smart contract on the layer-1 can deposit tickets into a - transaction rollup, for the benefit of a {!Tx_rollup_l2_address.t}. *) + transaction rollup, for the benefit of a {!Tx_rollup_l2_address.t}. + The [sender] is an implicit account that will receive the deposit if + it fails due to a [Balance_overflow] in the [destination]'s account. + *) type deposit = { + sender : Signature.Public_key_hash.t; destination : Tx_rollup_l2_address.Indexable.value; ticket_hash : Ticket_hash_repr.t; amount : Tx_rollup_l2_qty.t; -- GitLab From a85a32d5f825886702f5ac04176744d4030d47a0 Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Wed, 23 Feb 2022 15:54:56 +0100 Subject: [PATCH 05/10] Tx_rollup: no en/decoding operation_cont w/ dest=l1 & type(tkt) = idx --- .../test/pbt/test_tx_rollup_l2_encoding.ml | 77 +++++++- .../test/unit/test_tx_rollup_l2.ml | 177 +++++++++++++----- .../lib_protocol/tx_rollup_l2_batch.ml | 28 +++ .../lib_protocol/tx_rollup_l2_batch.mli | 9 +- 4 files changed, 240 insertions(+), 51 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_tx_rollup_l2_encoding.ml b/src/proto_alpha/lib_protocol/test/pbt/test_tx_rollup_l2_encoding.ml index 35566bdb2cc8..a9e33f120570 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_tx_rollup_l2_encoding.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_tx_rollup_l2_encoding.ml @@ -50,9 +50,11 @@ let bls_pk_gen = let signer_gen : Signer_indexable.either QCheck2.Gen.t = let open QCheck2.Gen in - let* choice = bool in - if choice then (fun pk -> from_value pk) <$> bls_pk_gen - else (fun x -> from_index_exn x) <$> ui32 + frequency + [ + (1, (fun pk -> from_value pk) <$> bls_pk_gen); + (9, (fun x -> from_index_exn x) <$> ui32); + ] let l2_address_gen = let open QCheck2.Gen in @@ -71,10 +73,62 @@ let destination_gen = if choice then (fun x -> Layer2 (from_index_exn x)) <$> ui32 else (fun x -> Layer2 (from_value x)) <$> l2_address_gen -let ticket_hash_gen = +(* Creating ticket hashes *) + +let hash_ticket tx_rollup ~contents ~ticketer ~ty = + let open Protocol in + let hash_of_node node = + let node = Micheline.strip_locations node in + let bytes = + Data_encoding.Binary.to_bytes_exn Script_repr.expr_encoding node + in + Alpha_context.Ticket_hash.of_script_expr_hash + @@ Script_expr_hash.hash_bytes [bytes] + in + let make_ticket_hash ~ticketer ~ty ~contents ~owner = + hash_of_node + @@ Micheline.(Seq (dummy_location, [ticketer; ty; contents; owner])) + in + let owner = + Micheline.( + String (dummy_location, Tx_rollup_l2_address.to_b58check tx_rollup)) + in + make_ticket_hash ~ticketer ~ty ~contents ~owner + +(** [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 ticketer tx_rollup = + let open Protocol in + let open Alpha_context in + 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 + hash_ticket ~ticketer ~ty ~contents tx_rollup + +let ticket_hash_idx_gen = let open QCheck2.Gen in from_index_exn <$> ui32 +(* TODO: we introduce a bit more randomness here *) +let ticket_hash_value_gen = + let open QCheck2.Gen in + let ticketer_b58 = "tz1Ke2h7sDdakHJQh8WX4Z372du1KChsksyU" in + let ticketer_pkh = Signature.Public_key_hash.of_b58check_exn ticketer_b58 in + let ticketer = + Protocol.Alpha_context.Contract.implicit_contract ticketer_pkh + in + let* tx_rollup = l2_address_gen in + let ticket_hash = make_unit_ticket_key ticketer tx_rollup in + return (from_value ticket_hash) + +let ticket_hash_gen = + let open QCheck2.Gen in + oneof [ticket_hash_idx_gen; ticket_hash_value_gen] + let qty_gen = let open QCheck2.Gen in Protocol.Tx_rollup_l2_qty.of_int64_exn @@ -82,10 +136,17 @@ let qty_gen = let v1_operation_content_gen = let open QCheck2.Gen in - let+ destination = destination_gen - and+ ticket_hash = ticket_hash_gen - and+ qty = qty_gen in - V1.{destination; ticket_hash; qty} + (* in valid [operation_content]s, the ticket_hash is a value when the + destination is layer1 *) + let* destination = destination_gen in + match destination with + | Layer1 _ -> + let+ ticket_hash = ticket_hash_value_gen and+ qty = qty_gen in + V1.{destination; ticket_hash; qty} + | Layer2 _ -> + (* here ticket hash value *) + let+ ticket_hash = ticket_hash_gen and+ qty = qty_gen in + V1.{destination; ticket_hash; qty} let v1_operation_gen = let open QCheck2.Gen in diff --git a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml index 52010db90c77..20939fe0c67c 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml @@ -492,63 +492,156 @@ end (* ------ L2 Batch encodings ------------------------------------------------ *) -let test_l2_operation_size () = - let open Protocol.Tx_rollup_l2_batch.V1 in - let open Data_encoding in +module Test_batch_encodings = struct + open Lwt_result_syntax + open Protocol.Tx_rollup_l2_batch.V1 + open Data_encoding + (* Encoding from compact encoding *) - let operation_content_encoding = Compact.make compact_operation_content in - let operation_encoding = Compact.make compact_operation in - let transaction_encoding = Compact.make compact_transaction in + let operation_content_encoding = Compact.make compact_operation_content + + let operation_encoding = Compact.make compact_operation + + let transaction_encoding = Compact.make compact_transaction + (* Helper functions to encode and decode *) - let encode_content op = Binary.to_bytes_exn operation_content_encoding op in + let encode_content op = Binary.to_bytes_exn operation_content_encoding op + let decode_content buffer = Data_encoding.Binary.of_bytes_exn operation_content_encoding buffer - in - let encode_operation op = Binary.to_bytes_exn operation_encoding op in - let decode_operation buffer = Binary.of_bytes_exn operation_encoding buffer in - let encode_transaction t = Binary.to_bytes_exn transaction_encoding t in + + let encode_operation op = Binary.to_bytes_exn operation_encoding op + + let decode_operation buffer = Binary.of_bytes_exn operation_encoding buffer + + let encode_transaction t = Binary.to_bytes_exn transaction_encoding t + let decode_transaction buffer = Binary.of_bytes_exn transaction_encoding buffer - in - (* Assert the smallest operation_content size is 4 *) - let opc = - { - destination = Layer2 (Indexable.from_index_exn 0l); - ticket_hash = Indexable.from_index_exn 1l; - qty = Tx_rollup_l2_qty.of_int64_exn 12L; - } - in - let buffer = encode_content opc in - let opc' = decode_content buffer in + let destination_pp fmt = + let open Protocol.Tx_rollup_l2_batch in + function + | Layer1 pkh -> Signature.Public_key_hash.pp fmt pkh + | Layer2 l2 -> Tx_rollup_l2_address.Indexable.pp fmt l2 + + let operation_content_pp fmt = function + | {destination; ticket_hash; qty} -> + Format.fprintf + fmt + "@[Operation:@ destination=%a,@ ticket_hash=%a,@ qty:%a@]" + destination_pp + destination + Tx_rollup_l2_context_sig.Ticket_indexable.pp + ticket_hash + Tx_rollup_l2_qty.pp + qty + + let test_l2_operation_size () = + (* Assert the smallest operation_content size is 4 *) + let opc = + { + destination = Layer2 (Indexable.from_index_exn 0l); + ticket_hash = Indexable.from_index_exn 1l; + qty = Tx_rollup_l2_qty.of_int64_exn 12L; + } + in + let buffer = encode_content opc in + let opc' = decode_content buffer in - Alcotest.(check int "smallest transfer content" 4 (Bytes.length buffer)) ; - assert (opc = opc') ; + Alcotest.(check int "smallest transfer content" 4 (Bytes.length buffer)) ; + assert (opc = opc') ; - (* Assert the smallest operation size is 7 *) - let op = - {signer = Indexable.from_index_exn 2l; counter = 0L; contents = [opc]} - in - let buffer = encode_operation op in - let op' = decode_operation buffer in + (* Assert the smallest operation size is 7 *) + let op = + {signer = Indexable.from_index_exn 2l; counter = 0L; contents = [opc]} + in + let buffer = encode_operation op in + let op' = decode_operation buffer in - Alcotest.(check int "smallest transfer" 7 (Bytes.length buffer)) ; - assert (op = op') ; + Alcotest.(check int "smallest transfer" 7 (Bytes.length buffer)) ; + assert (op = op') ; - (* Assert the smallest transaction size is 8 *) - let t = [op] in - let buffer = encode_transaction t in - let t' = decode_transaction buffer in + (* Assert the smallest transaction size is 8 *) + let t = [op] in + let buffer = encode_transaction t in + let t' = decode_transaction buffer in - Alcotest.(check int "smallest transaction" 8 (Bytes.length buffer)) ; - assert (t = t') ; + Alcotest.(check int "smallest transaction" 8 (Bytes.length buffer)) ; + assert (t = t') ; - return_unit + return_unit + + let test_l2_operation_encode_guard () = + let invalid_indexed_l2_to_l1_op = + { + destination = Layer1 Signature.Public_key_hash.zero; + ticket_hash = Indexable.from_index_exn 1l; + qty = Tx_rollup_l2_qty.of_int64_exn 12L; + } + in + let* _ = + try + let buffer = encode_content invalid_indexed_l2_to_l1_op in + Alcotest.failf + "Expected encoding of layer2-to-layer1 operation_content with \ + indexed ticket to fail. Binary output: %s" + Hex.(of_bytes buffer |> show) + with + | Data_encoding.Binary.Write_error + (Exception_raised_in_user_function + "(Invalid_argument\n\ + \ \"Attempted to decode layer2 operation containing ticket \ + index.\")") + -> + return_unit + in + return_unit + + let test_l2_operation_decode_guard () = + let invalid_indexed_l2_to_l1_op_serialized = + Hex.( + `Hex "00000000000000000000000000000000000000000000010c" |> to_bytes + |> Stdlib.Option.get) + in + let* _ = + try + let invalid_indexed_l2_to_l1_op = + decode_content invalid_indexed_l2_to_l1_op_serialized + in + Alcotest.failf + "Expected decoding of layer2-to-layer1 operation_content with \ + indexed ticket to fail. Got operation: %a" + operation_content_pp + invalid_indexed_l2_to_l1_op + with + | Data_encoding.Binary.Read_error + (Exception_raised_in_user_function + "(Invalid_argument\n\ + \ \"Attempted to decode layer2 operation containing ticket \ + index.\")") -> + return_unit + | e -> + Alcotest.failf "Got unexpected exception: %s" (Printexc.to_string e) + in + return_unit + + let tests = + [ + tztest "test layer-2 operation encoding size" `Quick test_l2_operation_size; + tztest + "test layer-2 operation encoding guard" + `Quick + test_l2_operation_encode_guard; + tztest + "test layer-2 operation decoding guard" + `Quick + test_l2_operation_decode_guard; + ] +end let tests = [tztest "test irmin storage" `Quick @@ wrap_test test_irmin_storage] @ Test_Address_index.tests @ Test_Ticket_index.tests @ Test_Address_medata.tests @ Test_Ticket_ledger.tests - @ [ - tztest "test layer-2 operation encoding size" `Quick test_l2_operation_size; - ] + @ Test_batch_encodings.tests diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_batch.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_batch.ml index 6b7d4557b8b1..2c4af5ef4d72 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_batch.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_batch.ml @@ -39,6 +39,21 @@ let signer_encoding = | None -> Error "not a BLS public key") (Fixed.bytes Bls_signature.pk_size_in_bytes) +(* A version of Data_encoding.Compact.conv that can check an invariant + at encoding and decoding. + + It is used at runtime to enforce the invariant that transfers to L1 + accounts should reference tickets by value. + + TODO: does this makes sense? Wouldn't it be easier to have the + type of operation_content enforce this invariant? +*) +let with_coding_guard guard encoding = + let guard_conv x = + match guard x with Ok () -> x | Error s -> raise (Invalid_argument s) + in + Data_encoding.Compact.conv guard_conv guard_conv encoding + module Signer_indexable = Indexable.Make (struct type t = Bls_signature.pk @@ -106,6 +121,19 @@ module V1 = struct (req "ticket_hash" Ticket_indexable.compact) (req "qty" Tx_rollup_l2_qty.compact_encoding)) + let compact_operation_content = + with_coding_guard + (function + | {destination; ticket_hash; _} -> ( + match (destination, Indexable.destruct ticket_hash) with + | (Layer1 _, Left _) -> + (* Layer2-to-layer1 transfers must include the value of the ticket_hash *) + Result.error + "Attempted to decode layer2 operation containing ticket \ + index." + | _ -> Result.ok ())) + compact_operation_content + let operation_content_encoding = Data_encoding.Compact.make ~tag_size compact_operation_content diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_batch.mli b/src/proto_alpha/lib_protocol/tx_rollup_l2_batch.mli index 3fc4f355c796..fc82d4d12e1b 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_batch.mli +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_batch.mli @@ -198,7 +198,14 @@ module V1 : sig {ul {li [00] means an integer fitting on 1 byte.} {li [01] means an integer fitting on 2 bytes.} {li [10] means an integer fitting on 4 bytes.} - {li [11] means an integer fitting on 8 bytes.} *) + {li [11] means an integer fitting on 8 bytes.} + + + TODO: better exception type. + + Raises an [Invalid_argument] exception if the [destination] is a layer-1 + address and the ticket_hash is an index, which is not allowed by the + layer-2 protocol. *) val compact_operation_content : Indexable.unknown operation_content Data_encoding.Compact.t end -- GitLab From 6178b21e287a86db50440566ab9e370ab59db2f0 Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Tue, 22 Feb 2022 12:05:56 +0100 Subject: [PATCH 06/10] Tx_rollup: adapt tests for withdrawals --- .../integration/operations/test_tx_rollup.ml | 1 + .../test/unit/test_tx_rollup_l2_apply.ml | 81 ++++++++++++------- 2 files changed, 53 insertions(+), 29 deletions(-) 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 f333c83aa74c..376a0b97ed28 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 @@ -584,6 +584,7 @@ let test_valid_deposit () = let ticket_hash = make_unit_ticket_key ctxt contract tx_rollup in let (message, _size) = Tx_rollup_message.make_deposit + (is_implicit_exn account) (Tx_rollup_l2_address.Indexable.value pkh) ticket_hash (Tx_rollup_l2_qty.of_int64_exn 10L) diff --git a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml index 93754b669087..a9e36f8105e7 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml @@ -48,6 +48,8 @@ open Indexable (** {3. Various helpers to facilitate the tests. } *) +let pkh = Signature.Public_key_hash.zero + let ((_, pk1, addr1) as l2_addr1) = gen_l2_address () let ((_, pk2, addr2) as l2_addr2) = gen_l2_address () @@ -288,12 +290,14 @@ let test_simple_deposit () = let ctxt = empty_context in let amount = Tx_rollup_l2_qty.of_int64_exn 50L in - let deposit = {destination = value addr1; ticket_hash = ticket1; amount} in - let* (ctxt, result) = apply_deposit ctxt deposit in + let deposit = + {sender = pkh; destination = value addr1; ticket_hash = ticket1; amount} + in + let* (ctxt, result, withdrawal_opt) = apply_deposit ctxt deposit in (* Applying the deposit should create an idx for both [addr1] and [ticket]. *) - match result with - | Deposit_success indexes -> + match (result, withdrawal_opt) with + | (Deposit_success indexes, None) -> let* () = check_indexes [(addr1, index_exn 0l)] [(ticket1, index_exn 0l)] indexes in @@ -321,16 +325,17 @@ let test_deposit_with_existing_indexes () = let deposit = { + sender = pkh; destination = value addr1; ticket_hash = ticket1; amount = Tx_rollup_l2_qty.of_int64_exn 1L; } in - let* (ctxt, result) = apply_deposit ctxt deposit in + let* (ctxt, result, withdrawal_opt) = apply_deposit ctxt deposit in (* The indexes should not be considered as created *) - match result with - | Deposit_success indexes -> + match (result, withdrawal_opt) with + | (Deposit_success indexes, None) -> assert (indexes.address_indexes = Address_indexes.empty) ; assert (indexes.ticket_indexes = Ticket_indexes.empty) ; @@ -357,16 +362,17 @@ let test_indexes_creation () = transfered between the other addresses. *) let deposit = { + sender = pkh; destination = value addr1; ticket_hash = ticket1; amount = Tx_rollup_l2_qty.of_int64_exn 100L; } in - let* (ctxt, result) = apply_deposit ctxt deposit in + let* (ctxt, result, withdrawal_opt) = apply_deposit ctxt deposit in let* () = - match result with - | Deposit_success indexes -> + match (result, withdrawal_opt) with + | (Deposit_success indexes, None) -> check_indexes [(addr1, index_exn 0l)] [(ticket1, index_exn 0l)] indexes | _ -> unexpected_result in @@ -392,7 +398,9 @@ let test_indexes_creation () = [transaction1; transaction2; transaction3] in - let* (_ctxt, Batch_result {indexes; _}) = Batch_V1.apply_batch ctxt batch in + let* (_ctxt, Batch_result {indexes; _}, _withdrawals) = + Batch_V1.apply_batch ctxt batch + in let* () = check_indexes @@ -414,12 +422,13 @@ let test_indexes_creation_bad () = let deposit = { + sender = pkh; destination = value addr1; ticket_hash = ticket1; amount = Tx_rollup_l2_qty.of_int64_exn 20L; } in - let* (ctxt, _) = apply_deposit ctxt deposit in + let* (ctxt, _, _withdrawal_opt) = apply_deposit ctxt deposit in let transaction1 = (* This transaction will fail because the number of tickets required is @@ -437,7 +446,7 @@ let test_indexes_creation_bad () = batch (List.concat [signature1; signature2]) [transaction1; transaction2] in - let* (ctxt, Batch_result {results; indexes}) = + let* (ctxt, Batch_result {results; indexes}, _withdrawals) = Batch_V1.apply_batch ctxt batch in @@ -482,12 +491,14 @@ let test_simple_transaction () = in let batch = create_batch_v1 [transaction] [[sk1; sk2]] in - let* (ctxt, Batch_result {results; _}) = Batch_V1.apply_batch ctxt batch in + let* (ctxt, Batch_result {results; _}, _withdrawals) = + Batch_V1.apply_batch ctxt batch + in let status = nth_exn results 0 |> snd in - match status with - | Transaction_success -> + match (status, _withdrawals) with + | (Transaction_success, []) -> (* Check the balance after the transaction has been applied, we ommit the check the indexes to not pollute this test. *) let* () = @@ -532,7 +543,8 @@ let test_simple_transaction () = 20L in return_unit - | Transaction_failure _ -> fail_msg "The transaction should be a success" + | (Transaction_success, _) -> fail_msg "Did not expect any withdrawals" + | (Transaction_failure _, _) -> fail_msg "The transaction should be a success" (** Thest that a valid transaction containing both indexes and values is a success. *) @@ -600,12 +612,14 @@ let test_transaction_with_unknown_indexable () = let signatures = sign_transaction [sk1; sk2] transaction in let batch = batch signatures [transaction] in - let* (ctxt, Batch_result {results; _}) = Batch_V1.apply_batch ctxt batch in + let* (ctxt, Batch_result {results; _}, withdrawals) = + Batch_V1.apply_batch ctxt batch + in let status = nth_exn results 0 |> snd in - match status with - | Transaction_success -> + match (status, withdrawals) with + | (Transaction_success, []) -> (* Check the balance after the transaction has been applied, we ommit the check the indexes to not pollute this test. *) let* () = @@ -650,7 +664,8 @@ let test_transaction_with_unknown_indexable () = 20L in return_unit - | Transaction_failure _ -> fail_msg "The transaction should be a success" + | (Transaction_success, _) -> fail_msg "Did not expect any withdrawals" + | (Transaction_failure _, _) -> fail_msg "The transaction should be a success" (** Test that a transaction containing at least one invalid operation fails and does not change the context. It is similar to @@ -675,7 +690,9 @@ let test_invalid_transaction () = in let batch = create_batch_v1 [transaction] [[sk1; sk2]] in - let* (ctxt, Batch_result {results; _}) = Batch_V1.apply_batch ctxt batch in + let* (ctxt, Batch_result {results; _}, _withdrawals) = + Batch_V1.apply_batch ctxt batch + in let status = nth_exn results 0 |> snd in @@ -720,7 +737,9 @@ let test_invalid_counter () = let transaction = transfers [(pk1, addr2, ticket1, 10L, Some counter)] in let batch = create_batch_v1 [transaction] [[sk1]] in - let* (_ctxt, Batch_result {results; _}) = Batch_V1.apply_batch ctxt batch in + let* (_ctxt, Batch_result {results; _}, _withdrawals) = + Batch_V1.apply_batch ctxt batch + in let status = nth_exn results 0 |> snd in @@ -758,13 +777,16 @@ let test_update_counter () = create_batch_v1 transactions [[sk1]; [sk1]; [sk1]; [sk1]; [sk1]] in - let* (ctxt, Batch_result {results; _}) = Batch_V1.apply_batch ctxt batch in + let* (ctxt, Batch_result {results; _}, withdrawals) = + Batch_V1.apply_batch ctxt batch + in let status = nth_exn results 0 |> snd in - match status with - | Transaction_failure - {reason = Tx_rollup_l2_apply.Incorrect_aggregated_signature; _} -> + match (status, withdrawals) with + | ( Transaction_failure + {reason = Tx_rollup_l2_apply.Incorrect_aggregated_signature; _}, + _ ) -> fail_msg "This test should not raise [Incorrect_aggregated_signature]" | _ -> let* () = @@ -851,7 +873,7 @@ let test_apply_message_batch () = let* (_ctxt, result) = apply_message ctxt msg in match result with - | Message_result.Batch_V1_result _ -> + | (Message_result.Batch_V1_result _, []) -> (* We do not check the result inside as we consider it is covered by other tests. *) return_unit @@ -864,6 +886,7 @@ let test_apply_message_deposit () = let (msg, _) = Tx_rollup_message.make_deposit + pkh (value addr1) ticket1 (Tx_rollup_l2_qty.of_int64_exn amount) @@ -872,7 +895,7 @@ let test_apply_message_deposit () = let* (_ctxt, result) = apply_message ctxt msg in match result with - | Message_result.Deposit_result _ -> + | (Message_result.Deposit_result _, []) -> (* We do not check the result inside as we consider it is covered by other tests. *) return_unit -- GitLab From f726185e24ba243690c11e75616376cf34d460ad Mon Sep 17 00:00:00 2001 From: Arvid Jakobsson Date: Thu, 24 Feb 2022 17:42:26 +0100 Subject: [PATCH 07/10] Tx_rollup: add unit tests for withdrawals --- .../lib_protocol/test/helpers/context.ml | 8 +- .../lib_protocol/test/helpers/context.mli | 4 + .../test/helpers/tx_rollup_l2_helpers.ml | 2 + .../integration/operations/test_tx_rollup.ml | 12 + .../test/unit/test_tx_rollup_l2_apply.ml | 684 ++++++++++++++++-- 5 files changed, 663 insertions(+), 47 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.ml b/src/proto_alpha/lib_protocol/test/helpers/context.ml index 8fe76af112a8..7a24808a6c50 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/context.ml @@ -377,7 +377,7 @@ let init1 ?rng_state ?commitments ?(initial_balances = []) ?consensus_threshold ?min_proposal_quorum ?level ?cost_per_byte ?liquidity_baking_subsidy ?endorsing_reward_per_slot ?baking_reward_bonus_per_slot ?baking_reward_fixed_portion ?origination_size ?blocks_per_cycle - ?cycles_per_voting_period () = + ?cycles_per_voting_period ?tx_rollup_enable ?sc_rollup_enable () = init ?rng_state ?commitments @@ -393,6 +393,8 @@ let init1 ?rng_state ?commitments ?(initial_balances = []) ?consensus_threshold ?origination_size ?blocks_per_cycle ?cycles_per_voting_period + ?tx_rollup_enable + ?sc_rollup_enable 1 >|=? function | (_, []) -> assert false @@ -402,7 +404,7 @@ let init2 ?rng_state ?commitments ?(initial_balances = []) ?consensus_threshold ?min_proposal_quorum ?level ?cost_per_byte ?liquidity_baking_subsidy ?endorsing_reward_per_slot ?baking_reward_bonus_per_slot ?baking_reward_fixed_portion ?origination_size ?blocks_per_cycle - ?cycles_per_voting_period () = + ?cycles_per_voting_period ?tx_rollup_enable ?sc_rollup_enable () = init ?rng_state ?commitments @@ -418,6 +420,8 @@ let init2 ?rng_state ?commitments ?(initial_balances = []) ?consensus_threshold ?origination_size ?blocks_per_cycle ?cycles_per_voting_period + ?tx_rollup_enable + ?sc_rollup_enable 2 >|=? function | (_, []) | (_, [_]) -> assert false diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.mli b/src/proto_alpha/lib_protocol/test/helpers/context.mli index 22b42a176d11..574e2c5b4635 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/context.mli @@ -221,6 +221,8 @@ val init1 : ?origination_size:int -> ?blocks_per_cycle:int32 -> ?cycles_per_voting_period:int32 -> + ?tx_rollup_enable:bool -> + ?sc_rollup_enable:bool -> unit -> (Block.t * Alpha_context.Contract.t) tzresult Lwt.t @@ -241,6 +243,8 @@ val init2 : ?origination_size:int -> ?blocks_per_cycle:int32 -> ?cycles_per_voting_period:int32 -> + ?tx_rollup_enable:bool -> + ?sc_rollup_enable:bool -> unit -> (Block.t * Alpha_context.Contract.t * Alpha_context.Contract.t) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_l2_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_l2_helpers.ml index 817c383896a5..163c983edb20 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_l2_helpers.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_l2_helpers.ml @@ -90,6 +90,8 @@ let empty_context : Context_l2.t = empty_storage let rng_state = Random.State.make_self_init () +let gen_l1_address ?seed () = Signature.generate_key ~algo:Ed25519 ?seed () + let gen_l2_address () = let seed = Bytes.init 32 (fun _ -> char_of_int @@ Random.State.int rng_state 255) 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 376a0b97ed28..b063bc019332 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 @@ -114,6 +114,18 @@ let context_init n = ~baking_reward_fixed_portion:Tez.zero n +(** [context_init1] initializes a context with no consensus rewards + to not interfere with balances prediction. It returns the created + context and 1 contract. *) +let context_init1 () = + Context.init1 + ~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 + () + (** [originate b contract] originates a tx_rollup from [contract], and returns the new block and the tx_rollup address. *) let originate b contract = diff --git a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml index a9e36f8105e7..945aa28953ab 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml @@ -108,9 +108,10 @@ let signer_of_address_index : let eq_qty = Alcotest.of_pp Tx_rollup_l2_qty.pp -let check_balance ctxt name_account name_ticket description tidx aidx value = +let check_balance ctxt name_account name_ticket description tidx aidx + expected_value = let open Syntax in - let value = Tx_rollup_l2_qty.of_int64_exn value in + let expected_value = Tx_rollup_l2_qty.of_int64_exn expected_value in let* res = Ticket_ledger.get ctxt tidx aidx in Alcotest.( check @@ -120,8 +121,8 @@ let check_balance ctxt name_account name_ticket description tidx aidx value = name_account name_ticket description) - res - value) ; + expected_value + res) ; return () let pp_metadata fmt Tx_rollup_l2_context_sig.{counter; public_key} = @@ -156,6 +157,20 @@ let eq_addr_indexable = Alcotest.of_pp (Indexable.pp (fun _ _ -> ())) let eq_ticket_indexable = Alcotest.of_pp (Indexable.pp (fun _ _ -> ())) +let pp_withdrawal fmt = function + | Message_result.{destination; ticket_hash; amount} -> + Format.fprintf + fmt + "{destination=%a; ticket_hash=%a; amount=%a}" + Signature.Public_key_hash.pp + destination + Ticket_hash.pp + ticket_hash + Tx_rollup_l2_qty.pp + amount + +let eq_withdrawal = Alcotest.of_pp pp_withdrawal + let check_indexes addr_indexes ticket_indexes expected = let open Syntax in (* This is dirty but it orders the list by their indexes. *) @@ -219,6 +234,7 @@ let with_initial_setup tickets contracts = let* (ctxt, rev_contracts) = list_fold_left_m (fun (ctxt, rev_contracts) balances -> + let (pkh, _, _) = gen_l1_address () in let (sk, pk, addr) = gen_l2_address () in let* (ctxt, _, idx) = Address_index.get_or_associate_index ctxt addr in @@ -234,7 +250,7 @@ let with_initial_setup tickets contracts = balances in - return (ctxt, (sk, pk, addr, idx) :: rev_contracts)) + return (ctxt, (sk, pk, addr, idx, pkh) :: rev_contracts)) (ctxt, []) contracts in @@ -245,15 +261,13 @@ let with_initial_setup tickets contracts = let transfer ?(counter = 0L) ~signer ~dest ~ticket qty = let open Tx_rollup_l2_batch.V1 in let qty = Tx_rollup_l2_qty.of_int64_exn qty in - let content = - { - destination = Layer2 (from_value dest); - ticket_hash = from_value ticket; - qty; - } - in + let content = {destination = dest; ticket_hash = from_value ticket; qty} in {signer = from_value signer; counter; contents = [content]} +let l1addr pkh = Tx_rollup_l2_batch.Layer1 pkh + +let l2addr addr = Tx_rollup_l2_batch.Layer2 (from_value addr) + let transfers = List.map (fun (pk_source, dest, ticket, amount, counter) -> transfer ~signer:pk_source ~dest ~ticket ?counter amount) @@ -346,6 +360,48 @@ let test_deposit_with_existing_indexes () = return_unit | _ -> fail_msg "Unexpected operation result" +(** Test that deposit overflow withdraws the amount setn. *) +let test_returned_deposit () = + let open Context_l2.Syntax in + let* (ctxt, tidxs, accounts) = + with_initial_setup [ticket1] [[(ticket1, Int64.max_int)]] + in + let tidx1 = nth_exn tidxs 0 in + let (_sk1, _pk1, addr1, idx1, pkh) = nth_exn accounts 0 in + + (* my cup runneth over *) + let amount = Tx_rollup_l2_qty.one in + let deposit = + {sender = pkh; destination = value addr1; ticket_hash = ticket1; amount} + in + let* (ctxt, result, withdrawal_opt) = apply_deposit ctxt deposit in + + (* Applying the deposit will result in a Deposit_failure, an + unchanged context and a withdrawal of the deposit *) + match (result, withdrawal_opt) with + | (Deposit_failure Tx_rollup_l2_context_sig.Balance_overflow, Some withdrawal) + -> + (* balance is unchanged *) + let* amount' = Context_l2.Ticket_ledger.get ctxt tidx1 idx1 in + assert (Tx_rollup_l2_qty.of_int64_exn Int64.max_int = amount') ; + Alcotest.( + check + eq_withdrawal + "Resulting withdrawal from overflowing L1->L2 deposit" + withdrawal + {destination = pkh; ticket_hash = ticket1; amount}) ; + return_unit + | (Deposit_failure reason, _) -> + let msg = + Format.asprintf + "Unexpected failure for overflowing deposit: %a" + Environment.Error_monad.pp + reason + in + fail_msg msg + | (Deposit_success _result, _) -> + fail_msg "Did not expect overflowing deposit to be succesful" + (** Test that all values used in a transaction creates indexes and they are packed in the final indexes. *) let test_indexes_creation () = @@ -380,16 +436,16 @@ let test_indexes_creation () = (* We create a transaction for each transfer, it makes the test of each transaction result easier. *) let transaction1 = - [transfer ~counter:0L ~signer:pk1 ~dest:addr2 ~ticket:ticket1 10L] + [transfer ~counter:0L ~signer:pk1 ~dest:(l2addr addr2) ~ticket:ticket1 10L] in let signature1 = sign_transaction [sk1] transaction1 in let transaction2 = - [transfer ~counter:1L ~signer:pk1 ~dest:addr3 ~ticket:ticket1 20L] + [transfer ~counter:1L ~signer:pk1 ~dest:(l2addr addr3) ~ticket:ticket1 20L] in let signature2 = sign_transaction [sk1] transaction2 in let transaction3 = - [transfer ~counter:2L ~signer:pk1 ~dest:addr4 ~ticket:ticket1 30L] + [transfer ~counter:2L ~signer:pk1 ~dest:(l2addr addr4) ~ticket:ticket1 30L] in let signature3 = sign_transaction [sk1] transaction3 in let batch = @@ -433,12 +489,19 @@ let test_indexes_creation_bad () = let transaction1 = (* This transaction will fail because the number of tickets required is more than its own. *) - [transfer ~counter:0L ~signer:pk1 ~dest:addr2 ~ticket:ticket1 10000L] + [ + transfer + ~counter:0L + ~signer:pk1 + ~dest:(l2addr addr2) + ~ticket:ticket1 + 10000L; + ] in let signature1 = sign_transaction [sk1] transaction1 in let transaction2 = (* This is ok *) - [transfer ~counter:1L ~signer:pk1 ~dest:addr3 ~ticket:ticket1 1L] + [transfer ~counter:1L ~signer:pk1 ~dest:(l2addr addr3) ~ticket:ticket1 1L] in let signature2 = sign_transaction [sk1] transaction2 in @@ -471,7 +534,7 @@ let test_indexes_creation_bad () = (** The test consists of [addr1] sending [ticket1] to [addr2]. In exchange [addr2] will send [ticket2] to [addr1]. We check both the transaction's status and the balances afterwards. *) -let test_simple_transaction () = +let test_simple_l2_transaction () = let open Context_l2.Syntax in let* (ctxt, tidxs, accounts) = with_initial_setup [ticket1; ticket2] [[(ticket1, 10L)]; [(ticket2, 20L)]] @@ -480,14 +543,17 @@ let test_simple_transaction () = let tidx1 = nth_exn tidxs 0 in let tidx2 = nth_exn tidxs 1 in - let (sk1, pk1, addr1, idx1) = nth_exn accounts 0 in - let (sk2, pk2, addr2, idx2) = nth_exn accounts 1 in + let (sk1, pk1, addr1, idx1, _) = nth_exn accounts 0 in + let (sk2, pk2, addr2, idx2, _) = nth_exn accounts 1 in (* Then, we build a transaction with: [addr1] -> [addr2] & [addr2] -> [addr1]. *) let transaction = transfers - [(pk1, addr2, ticket1, 10L, None); (pk2, addr1, ticket2, 20L, None)] + [ + (pk1, l2addr addr2, ticket1, 10L, None); + (pk2, l2addr addr1, ticket2, 20L, None); + ] in let batch = create_batch_v1 [transaction] [[sk1; sk2]] in @@ -499,7 +565,7 @@ let test_simple_transaction () = match (status, _withdrawals) with | (Transaction_success, []) -> - (* Check the balance after the transaction has been applied, we ommit + (* Check the balance after the transaction has been applied, we omit the check the indexes to not pollute this test. *) let* () = check_balance @@ -546,7 +612,383 @@ let test_simple_transaction () = | (Transaction_success, _) -> fail_msg "Did not expect any withdrawals" | (Transaction_failure _, _) -> fail_msg "The transaction should be a success" -(** Thest that a valid transaction containing both indexes and values is a +(** The test consists of [addr1] sending [ticket1] to [addr2]. + In exchange [addr2] will send [ticket2] to [addr1]. We check both + the transaction's status and the balances afterwards. *) +let test_simple_l1_transaction () = + let open Context_l2.Syntax in + let* (ctxt, tidxs, accounts) = + with_initial_setup [ticket1; ticket2] [[(ticket1, 10L)]; [(ticket2, 20L)]] + in + + let tidx1 = nth_exn tidxs 0 in + + (* let tidx2 = nth_exn tidxs 1 in *) + let (sk1, pk1, _addr1, idx1, _pkh1) = nth_exn accounts 0 in + let (_sk2, _pk2, _addr2, _idx2, pkh2) = nth_exn accounts 1 in + + (* Then, we build a transaction with: + [addr1] -> [pkh2] *) + let transaction = transfers [(pk1, l1addr pkh2, ticket1, 10L, None)] in + let batch = create_batch_v1 [transaction] [[sk1]] in + + let* (ctxt, Batch_result {results; _}, withdrawals) = + Batch_V1.apply_batch ctxt batch + in + + let status = nth_exn results 0 |> snd in + + match (status, withdrawals) with + | (Transaction_success, [withdrawal]) -> + (* Check the balance after the transaction has been applied, we omit + the check the indexes to not pollute this test. *) + let* () = + check_balance + ctxt + "addr1" + "ticket1" + "addr1.ticket1 should be emptied" + tidx1 + idx1 + 0L + in + Alcotest.( + check + eq_withdrawal + "Resulting withdrawal from L2->L1 transfer" + withdrawal + { + destination = pkh2; + ticket_hash = ticket1; + amount = Tx_rollup_l2_qty.of_int64_exn 10L; + }) ; + return_unit + | (Transaction_success, _) -> fail_msg "Expected exactly one withdrawal" + | (Transaction_failure _, _) -> fail_msg "The transaction should be a success" + +(* test what happens if the ticket_hash does not exist *) +let test_l1_transaction_inexistant_ticket () = + let open Context_l2.Syntax in + (* empty context *) + let* (ctxt, _tidxs, accounts) = with_initial_setup [] [[]; []] in + + (* let _tidx1 = nth_exn tidxs 0 in *) + + (* let tidx2 = nth_exn tidxs 1 in *) + let (sk1, pk1, _addr1, _idx1, _pkh1) = nth_exn accounts 0 in + let (_sk2, _pk2, _addr2, _idx2, pkh2) = nth_exn accounts 1 in + + (* Then, we build an invalid transaction with: + [addr1] -> [pkh2] *) + let transaction = transfers [(pk1, l1addr pkh2, ticket1, 10L, None)] in + let batch = create_batch_v1 [transaction] [[sk1]] in + + let* (_ctxt, Batch_result {results; _}, withdrawals) = + Batch_V1.apply_batch ctxt batch + in + + (* Expect no withdrawals *) + Alcotest.( + check + (list eq_withdrawal) + "Resulting withdrawal from L2->L1 transfer" + withdrawals + []) ; + + (* Expect error returned *) + let status = nth_exn results 0 |> snd in + expect_error_status + ~msg:"an invalid transaction must fail" + Tx_rollup_l2_apply.Missing_ticket + status + return_unit + +(* If the signer of a L2->L1 transaction does not exist, then batch application fails with + Balance_too_low. *) +let test_l1_transaction_inexistant_signer () = + let open Context_l2.Syntax in + (* empty context *) + let* (ctxt, _tidxs, accounts) = + with_initial_setup [ticket1; ticket2] [[(ticket1, 10L)]; [(ticket2, 20L)]] + in + + let (_sk1, _pk1, _addr1, _idx1, _pkh1) = nth_exn accounts 0 in + let (_sk2, _pk2, _addr2, _idx2, pkh2) = nth_exn accounts 1 in + let (sk_unknown, pk_unknown, _) = gen_l2_address () in + + (* Then, we build an invalid transaction with: + [addr1] -> [pkh2] *) + let transaction = transfers [(pk_unknown, l1addr pkh2, ticket1, 10L, None)] in + let batch = create_batch_v1 [transaction] [[sk_unknown]] in + + let* (_ctxt, Batch_result {results; _}, withdrawals) = + Batch_V1.apply_batch ctxt batch + in + + (* Expect no withdrawals *) + Alcotest.( + check + (list eq_withdrawal) + "Resulting withdrawal from L2->L1 transfer" + withdrawals + []) ; + + (* Expect error returned *) + let status = nth_exn results 0 |> snd in + expect_error_status + ~msg:"an invalid transaction must fail" + Tx_rollup_l2_context_sig.Balance_too_low + status + return_unit + +(* test what happens if the amount is too much, zero, or negative, or not just the full amount does not exist *) +let test_l1_transaction_overdraft () = + let open Context_l2.Syntax in + (* empty context *) + let initial_balances = [[(ticket1, 10L)]; [(ticket2, 20L)]] in + let* (ctxt, tidxs, accounts) = + with_initial_setup [ticket1; ticket2] initial_balances + in + + let (sk1, pk1, _addr1, idx1, _pkh1) = nth_exn accounts 0 in + let (_sk2, _pk2, _addr2, idx2, pkh2) = nth_exn accounts 1 in + + let tidx1 = nth_exn tidxs 0 in + let tidx2 = nth_exn tidxs 1 in + + (* Then, we build an transaction with: [addr1] -> [pkh2] where addr1 attempts to spend too much*) + let transaction = transfers [(pk1, l1addr pkh2, ticket1, 30L, None)] in + let batch = create_batch_v1 [transaction] [[sk1]] in + + let* (ctxt, Batch_result {results; _}, withdrawals) = + Batch_V1.apply_batch ctxt batch + in + + (* Expect no withdrawals *) + Alcotest.( + check + (list eq_withdrawal) + "Resulting withdrawal from L2->L1 transfer" + withdrawals + []) ; + + (* Expect error returned *) + let status = nth_exn results 0 |> snd in + expect_error_status + ~msg:"an invalid transaction must fail" + Tx_rollup_l2_context_sig.Balance_too_low + status + (let* () = + check_balance + ctxt + "addr1" + "ticket1" + "addr1.ticket1 should be unchanged" + tidx1 + idx1 + 10L + in + let* () = + check_balance + ctxt + "addr2" + "ticket1" + "addr2.ticket1 should be unchanged" + tidx2 + idx2 + 20L + in + + let* () = + check_balance + ctxt + "addr2" + "ticket2" + "addr1.ticket2 should be unchanged (empty)" + tidx2 + idx1 + 0L + in + let* () = + check_balance + ctxt + "addr1" + "ticket2" + "addr2.ticket1 should be unchanged (empty)" + tidx1 + idx2 + 0L + in + return_unit) + +(* zero-withdrawals are possible *) +let test_l1_transaction_zero () = + let open Context_l2.Syntax in + (* empty context *) + let initial_balances = [[(ticket1, 10L)]; [(ticket2, 20L)]] in + let* (ctxt, tidxs, accounts) = + with_initial_setup [ticket1; ticket2] initial_balances + in + + let (sk1, pk1, _addr1, idx1, _pkh1) = nth_exn accounts 0 in + let (_sk2, _pk2, _addr2, idx2, pkh2) = nth_exn accounts 1 in + + let tidx1 = nth_exn tidxs 0 in + let tidx2 = nth_exn tidxs 1 in + + (* Then, we build an transaction with: [addr1] -> [pkh2] , addr1 spending the ticket partially *) + let transaction = transfers [(pk1, l1addr pkh2, ticket1, 0L, None)] in + let batch = create_batch_v1 [transaction] [[sk1]] in + + let* (ctxt, Batch_result {results; _}, withdrawals) = + Batch_V1.apply_batch ctxt batch + in + + (* Expect one zero-withdrawals *) + Alcotest.( + check + (list eq_withdrawal) + "Resulting withdrawal from L2->L1 transfer" + withdrawals + [ + { + destination = pkh2; + ticket_hash = ticket1; + amount = Tx_rollup_l2_qty.zero; + }; + ]) ; + + match results with + | [([_], Transaction_success)] -> + let* () = + check_balance + ctxt + "addr1" + "ticket1" + "addr1.ticket1 should be unchanged" + tidx1 + idx1 + 10L + in + let* () = + check_balance + ctxt + "addr2" + "ticket1" + "addr2.ticket2 should be unchanged" + tidx2 + idx2 + 20L + in + + let* () = + check_balance + ctxt + "addr2" + "ticket2" + "addr1.ticket2 should be unchanged (empty)" + tidx2 + idx1 + 0L + in + let* () = + check_balance + ctxt + "addr1" + "ticket2" + "addr2.ticket1 should be unchanged (empty)" + tidx1 + idx2 + 0L + in + return_unit + | _ -> fail_msg "Zero-transactions should be successful" + +(* test partal transaction *) +let test_l1_transaction_partial () = + let open Context_l2.Syntax in + (* empty context *) + let* (ctxt, tidxs, accounts) = + with_initial_setup [ticket1; ticket2] [[(ticket1, 10L)]; [(ticket2, 20L)]] + in + + let (sk1, pk1, _addr1, idx1, _pkh1) = nth_exn accounts 0 in + let (_sk2, _pk2, _addr2, idx2, pkh2) = nth_exn accounts 1 in + + let tidx1 = nth_exn tidxs 0 in + let tidx2 = nth_exn tidxs 1 in + + (* Then, we build an transaction with: [addr1] -> [pkh2] , addr1 spending the ticket partially *) + let transaction = transfers [(pk1, l1addr pkh2, ticket1, 5L, None)] in + let batch = create_batch_v1 [transaction] [[sk1]] in + + let* (ctxt, Batch_result {results; _}, withdrawals) = + Batch_V1.apply_batch ctxt batch + in + + (* Expect one zero-withdrawals *) + Alcotest.( + check + (list eq_withdrawal) + "Resulting withdrawal from L2->L1 transfer" + withdrawals + [ + { + destination = pkh2; + ticket_hash = ticket1; + amount = Tx_rollup_l2_qty.of_int64_exn 5L; + }; + ]) ; + + match results with + | [([_], Transaction_success)] -> + let* () = + check_balance + ctxt + "addr1" + "ticket1" + "addr1.ticket1 should be debited" + tidx1 + idx1 + 5L + in + let* () = + check_balance + ctxt + "addr2" + "ticket1" + "addr2.ticket2 should be unchanged" + tidx2 + idx2 + 20L + in + + let* () = + check_balance + ctxt + "addr2" + "ticket2" + "addr1.ticket2 should be unchanged (empty)" + tidx2 + idx1 + 0L + in + let* () = + check_balance + ctxt + "addr1" + "ticket2" + "addr2.ticket1 should be unchanged (empty)" + tidx1 + idx2 + 0L + in + return_unit + | _ -> fail_msg "Zero-transactions should be successful" + +(* todo: test that withdrawals are combined correctly, test that their order *) + +(** Test that a valid transaction containing both indexes and values is a success. *) let test_transaction_with_unknown_indexable () = let open Context_l2.Syntax in @@ -558,8 +1000,8 @@ let test_transaction_with_unknown_indexable () = let tidx1 = nth_exn tidxs 0 in let tidx2 = nth_exn tidxs 1 in - let (sk1, pk1, addr1, aidx1) = nth_exn accounts 0 in - let (sk2, pk2, addr2, aidx2) = nth_exn accounts 1 in + let (sk1, pk1, addr1, aidx1, _) = nth_exn accounts 0 in + let (sk2, pk2, addr2, aidx2, _) = nth_exn accounts 1 in (* Note that {!with_initial_setup} does not initialize metadatas for the public keys. If it was the case, we could not use this function @@ -620,7 +1062,7 @@ let test_transaction_with_unknown_indexable () = match (status, withdrawals) with | (Transaction_success, []) -> - (* Check the balance after the transaction has been applied, we ommit + (* Check the balance after the transaction has been applied, we omit the check the indexes to not pollute this test. *) let* () = check_balance @@ -669,7 +1111,7 @@ let test_transaction_with_unknown_indexable () = (** Test that a transaction containing at least one invalid operation fails and does not change the context. It is similar to - {!test_simple_transaction} but the second addr does not + {!test_simple_l2_transaction} but the second addr does not possess the tickets. *) let test_invalid_transaction () = let open Context_l2.Syntax in @@ -679,14 +1121,17 @@ let test_invalid_transaction () = let tidx1 = nth_exn tidxs 0 in - let (sk1, pk1, addr1, idx1) = nth_exn accounts 0 in - let (sk2, pk2, addr2, idx2) = nth_exn accounts 1 in + let (sk1, pk1, addr1, idx1, _) = nth_exn accounts 0 in + let (sk2, pk2, addr2, idx2, _) = nth_exn accounts 1 in (* Then, we build a transaction with: [addr1] -> [addr2] & [addr2] -> [addr1]. *) let transaction = transfers - [(pk1, addr2, ticket1, 10L, None); (pk2, addr1, ticket2, 20L, None)] + [ + (pk1, l2addr addr2, ticket1, 10L, None); + (pk2, l2addr addr1, ticket2, 20L, None); + ] in let batch = create_batch_v1 [transaction] [[sk1; sk2]] in @@ -731,10 +1176,12 @@ let test_invalid_counter () = let open Context_l2.Syntax in let* (ctxt, _, accounts) = with_initial_setup [ticket1] [[]] in - let (sk1, pk1, addr1, _idx1) = nth_exn accounts 0 in + let (sk1, pk1, addr1, _idx1, _) = nth_exn accounts 0 in let counter = 10L in - let transaction = transfers [(pk1, addr2, ticket1, 10L, Some counter)] in + let transaction = + transfers [(pk1, l2addr addr2, ticket1, 10L, Some counter)] + in let batch = create_batch_v1 [transaction] [[sk1]] in let* (_ctxt, Batch_result {results; _}, _withdrawals) = @@ -759,16 +1206,16 @@ let test_update_counter () = let open Context_l2.Syntax in let* (ctxt, _, accounts) = with_initial_setup [ticket1] [[]] in - let (sk1, pk1, _addr1, _idx1) = nth_exn accounts 0 in + let (sk1, pk1, _addr1, _idx1, _) = nth_exn accounts 0 in let transactions = transfers [ - (pk1, addr2, ticket1, 10L, Some 0L); - (pk1, addr2, ticket1, 20L, Some 1L); - (pk1, addr2, ticket1, 30L, Some 2L); - (pk1, addr2, ticket1, 40L, Some 3L); - (pk1, addr2, ticket1, 50L, Some 4L); + (pk1, l2addr addr2, ticket1, 10L, Some 0L); + (pk1, l2addr addr2, ticket1, 20L, Some 1L); + (pk1, l2addr addr2, ticket1, 30L, Some 2L); + (pk1, l2addr addr2, ticket1, 40L, Some 3L); + (pk1, l2addr addr2, ticket1, 50L, Some 4L); ] |> List.map (fun x -> [x]) in @@ -805,12 +1252,15 @@ let test_pre_apply_batch () = with_initial_setup [ticket1; ticket2] [[(ticket1, 10L)]; [(ticket2, 20L)]] in - let (sk1, pk1, addr1, _idx1) = nth_exn accounts 0 in - let (sk2, pk2, addr2, _idx2) = nth_exn accounts 1 in + let (sk1, pk1, addr1, _idx1, _) = nth_exn accounts 0 in + let (sk2, pk2, addr2, _idx2, _) = nth_exn accounts 1 in let transaction = transfers - [(pk1, addr2, ticket1, 10L, None); (pk2, addr1, ticket2, 20L, None)] + [ + (pk1, l2addr addr2, ticket1, 10L, None); + (pk2, l2addr addr1, ticket2, 20L, None); + ] in let batch1 = create_batch_v1 [transaction] [[sk1; sk2]] in let* (ctxt, _indexes, _) = Batch_V1.check_signature ctxt batch1 in @@ -853,14 +1303,17 @@ let test_apply_message_batch () = with_initial_setup [ticket1; ticket2] [[(ticket1, 10L)]; [(ticket2, 20L)]] in - let (sk1, pk1, addr1, _) = nth_exn accounts 0 in - let (sk2, pk2, addr2, _) = nth_exn accounts 1 in + let (sk1, pk1, addr1, _, _) = nth_exn accounts 0 in + let (sk2, pk2, addr2, _, _) = nth_exn accounts 1 in (* Then, we build a transaction with: [addr1] -> [addr2] & [addr2] -> [addr1]. *) let transaction = transfers - [(pk1, addr2, ticket1, 10L, None); (pk2, addr1, ticket2, 20L, None)] + [ + (pk1, l2addr addr2, ticket1, 10L, None); + (pk2, l2addr addr1, ticket2, 20L, None); + ] in let batch = create_batch_v1 [transaction] [[sk1; sk2]] in let (msg, _) = @@ -879,6 +1332,136 @@ let test_apply_message_batch () = return_unit | _ -> fail_msg "Invalid apply message result" +let test_apply_message_batch_withdrawals () = + let open Context_l2.Syntax in + let* (ctxt, tidxs, accounts) = + with_initial_setup [ticket1; ticket2] [[(ticket1, 10L)]; [(ticket2, 20L)]] + in + + let (sk1, pk1, addr1, idx1, pkh1) = nth_exn accounts 0 in + let (sk2, pk2, addr2, idx2, pkh2) = nth_exn accounts 1 in + + let tidx1 = nth_exn tidxs 0 in + let tidx2 = nth_exn tidxs 1 in + + (* Then, we build a transaction with: + [addr1] -> [addr2] & [addr2] -> [addr1]. *) + let transactions = + [ + transfers [(pk1, l2addr addr2, ticket1, 5L, Some 0L)]; + transfers [(pk1, l1addr pkh2, ticket1, 5L, Some 1L)]; + transfers [(pk2, l2addr addr1, ticket2, 10L, Some 0L)]; + transfers [(pk2, l1addr pkh1, ticket2, 10L, Some 1L)]; + ] + in + let batch = create_batch_v1 transactions [[sk1]; [sk1]; [sk2]; [sk2]] in + let (msg, _) = + Tx_rollup_message.make_batch + (Data_encoding.Binary.to_string_exn + Tx_rollup_l2_batch.encoding + (V1 batch)) + in + + let* (ctxt, result) = apply_message ctxt msg in + + match result with + | ( Message_result.Batch_V1_result + (Message_result.Batch_V1.Batch_result + { + results = + [ + (_, Transaction_success); + (_, Transaction_success); + (_, Transaction_success); + (_, Transaction_success); + ]; + _; + }), + withdrawals ) -> + Alcotest.( + check + (list eq_withdrawal) + "Resulting withdrawal from L2->L1 batch" + withdrawals + [ + { + destination = pkh2; + ticket_hash = ticket1; + amount = Tx_rollup_l2_qty.of_int64_exn 5L; + }; + { + destination = pkh1; + ticket_hash = ticket2; + amount = Tx_rollup_l2_qty.of_int64_exn 10L; + }; + ]) ; + let* () = + check_balance + ctxt + "addr1" + "ticket1" + "addr1.ticket1 should be spent" + tidx1 + idx1 + 0L + in + let* () = + check_balance + ctxt + "addr2" + "ticket1" + "addr2.ticket1 should be credited" + tidx1 + idx2 + 5L + in + + let* () = + check_balance + ctxt + "addr2" + "ticket2" + "addr1.ticket2 should be credited" + tidx2 + idx1 + 10L + in + let* () = + check_balance + ctxt + "addr1" + "ticket2" + "addr2.ticket2 should be spent" + tidx2 + idx2 + 0L + in + return_unit + | ( Message_result.Batch_V1_result + (Message_result.Batch_V1.Batch_result {results; _}), + _ ) -> + let* () = + if List.length results <> 4 then + fail_msg + ("Expected 4 results, got " ^ string_of_int @@ List.length results) + else return_unit + in + List.iter_es + (fun res -> + match res with + | (_, Message_result.Transaction_success) -> return_unit + | (_, Transaction_failure {index; reason}) -> + let msg = + Format.asprintf + "Result at position %d unexpectedly failed: %a" + index + Environment.Error_monad.pp + reason + in + fail_msg msg) + results + | _ -> fail_msg "Unexpected apply message result" + let test_apply_message_deposit () = let open Context_l2.Syntax in let ctxt = empty_context in @@ -905,8 +1488,17 @@ let tests = wrap_tztest_tests [ ("simple transaction", test_simple_deposit); + ("returned transaction", test_returned_deposit); ("deposit with existing indexes", test_deposit_with_existing_indexes); - ("test simple transaction", test_simple_transaction); + ("test simple l1 transaction", test_simple_l1_transaction); + ( "test simple l1 transaction: inexistant ticket", + test_l1_transaction_inexistant_ticket ); + ( "test simple l1 transaction: inexistant signer", + test_l1_transaction_inexistant_signer ); + ("test simple l1 transaction: overdraft", test_l1_transaction_overdraft); + ("test simple l1 transaction: zero", test_l1_transaction_zero); + ("test simple l1 transaction: partial", test_l1_transaction_partial); + ("test simple l2 transaction", test_simple_l2_transaction); ( "test simple transaction with indexes and values", test_transaction_with_unknown_indexable ); ("invalid transaction", test_invalid_transaction); @@ -916,5 +1508,7 @@ let tests = ("update counter", test_update_counter); ("pre apply batch", test_pre_apply_batch); ("apply batch from message", test_apply_message_batch); + ( "apply batch from message with withdrawals", + test_apply_message_batch_withdrawals ); ("apply deposit from message", test_apply_message_deposit); ] -- GitLab From f6fc0e7a06067c6063daaf7ff246d6a4a1a354cb Mon Sep 17 00:00:00 2001 From: Valentin Chaboche Date: Wed, 2 Mar 2022 10:14:57 +0000 Subject: [PATCH 08/10] Apply 2 suggestion(s) to 2 file(s) --- .../lib_protocol/test/unit/test_tx_rollup_l2_apply.ml | 2 +- src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml index 945aa28953ab..b58a396ef860 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml @@ -360,7 +360,7 @@ let test_deposit_with_existing_indexes () = return_unit | _ -> fail_msg "Unexpected operation result" -(** Test that deposit overflow withdraws the amount setn. *) +(** Test that deposit overflow withdraws the amount sent. *) let test_returned_deposit () = let open Context_l2.Syntax in let* (ctxt, tidxs, accounts) = diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml index 4ebb8740ff3d..a02c44c5e3df 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml @@ -634,8 +634,7 @@ module Make (Context : CONTEXT) = struct catch (apply_deposit ()) (fun (ctxt, indexes) -> return (ctxt, Deposit_success indexes, None)) - (function - | reason -> + (fun reason -> (* Should there an error during the deposit, then return the full [amount] to [sender] in the form of a withdrawal. *) -- GitLab From 503d83fa1f403dc17237d8f7bd42d15468ca80ff Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Mon, 28 Feb 2022 15:37:10 +0100 Subject: [PATCH 09/10] env: expose `Blake2b.Make_merkle_tree` --- src/lib_protocol_environment/sigs/v5/blake2B.mli | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/lib_protocol_environment/sigs/v5/blake2B.mli b/src/lib_protocol_environment/sigs/v5/blake2B.mli index 29dcaab0e819..43e8765bbc40 100644 --- a/src/lib_protocol_environment/sigs/v5/blake2B.mli +++ b/src/lib_protocol_environment/sigs/v5/blake2B.mli @@ -56,3 +56,18 @@ module type Register = sig end module Make (Register : Register) (Name : PrefixedName) : S.HASH + +module Make_merkle_tree (R : sig + val register_encoding : + prefix:string -> + length:int -> + to_raw:('a -> string) -> + of_raw:(string -> 'a option) -> + wrap:('a -> Base58.data) -> + 'a Base58.encoding +end) +(K : PrefixedName) (Contents : sig + type t + + val to_bytes : t -> Bytes.t +end) : S.MERKLE_TREE with type elt = Contents.t -- GitLab From 6946365be405cfb4d10c0d5022e5c9f3d83d806b Mon Sep 17 00:00:00 2001 From: Sylvain Ribstein Date: Mon, 28 Feb 2022 15:37:28 +0100 Subject: [PATCH 10/10] proto: adds withdraw list to the ctxt hash Add two new hashes `Withdraw_hash` and `Withdraw_hash_list_hash`. Where `Withdraw_hash_list_hash` is a merkle tree This commit also replace `commitment_batch` to `message_result_hash` which is the hash of the context hash and the witdraw_hash_list_hash root --- .../lib_client/client_proto_context.ml | 3 +- .../lib_protocol/alpha_context.mli | 8 +- .../lib_protocol/tx_rollup_commitment_repr.ml | 99 +++++++++++++------ .../tx_rollup_commitment_repr.mli | 8 +- .../lib_protocol/tx_rollup_l2_apply.ml | 38 ++++++- .../lib_protocol/tx_rollup_l2_apply.mli | 3 + .../lib_protocol/tx_rollup_message_repr.mli | 2 + 7 files changed, 118 insertions(+), 43 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 9d0560598274..71683528b072 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -866,7 +866,8 @@ let submit_tx_rollup_commitment (cctxt : #full) ~chain ~block ?confirmations List.map_es (fun root -> match Hex.to_bytes (`Hex root) with - | Some content -> return Tx_rollup_commitment.{root = content} + | Some content -> + return @@ Tx_rollup_l2_apply.Message_result.hash content [] | None -> failwith "%s is not a valid binary text encoded using the hexadecimal \ diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 068b3b82d245..bcfbd9311d80 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -2198,13 +2198,15 @@ module Tx_rollup_commitment : sig include S.HASH end - type batch_commitment = {root : bytes} + module Withdraw_hash : S.HASH - val batch_commitment_equal : batch_commitment -> batch_commitment -> bool + module Withdraw_hash_list_hash : S.MERKLE_TREE with type elt = Withdraw_hash.t + + module Message_result_hash : S.HASH type t = { level : Raw_level.t; - batches : batch_commitment list; + batches : Message_result_hash.t list; predecessor : Commitment_hash.t option; inbox_hash : Tx_rollup_inbox.hash; } diff --git a/src/proto_alpha/lib_protocol/tx_rollup_commitment_repr.ml b/src/proto_alpha/lib_protocol/tx_rollup_commitment_repr.ml index 3a7b47d0b10c..9b46e9e858a3 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_commitment_repr.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_commitment_repr.ml @@ -142,6 +142,70 @@ let () = (function Bond_in_use contract -> Some contract | _ -> None) (fun contract -> Bond_in_use contract) +module Withdraw_hash = struct + let withdraw_hash = "\001\095\015" (* tw(52) *) + + module H = + Blake2B.Make + (Base58) + (struct + let name = "Withdraw_hash" + + let title = "A withdraw id" + + let b58check_prefix = withdraw_hash + + let size = None + end) + + include H + include Path_encoding.Make_hex (H) + + let () = Base58.check_encoded_prefix b58check_encoding "tw" 52 +end + +module Withdraw_hash_list_hash = struct + let withdraw_hash_list_hash = "\079\139\113" (* twL(53) *) + + include + Blake2B.Make_merkle_tree + (Base58) + (struct + let name = "Withdraw_hash_list_hash" + + let title = "A list of withdraw_hash" + + let b58check_prefix = withdraw_hash_list_hash + + let size = None + end) + (Withdraw_hash) + + let () = Base58.check_encoded_prefix b58check_encoding "twL" 53 +end + +module Message_result_hash = struct + let message_result_hash = "\079\149\030" (* txm(53) *) + + module H = + Blake2B.Make + (Base58) + (struct + let name = "Message_result_hash" + + let title = "A commitment ID" + + let b58check_prefix = message_result_hash + + let size = None + end) + + include H + include Path_encoding.Make_hex (H) + + let () = Base58.check_encoded_prefix b58check_encoding "txm" 53 +end + module Commitment_hash = struct let commitment_hash = "\017\249\195\013" (* toc1(54) *) @@ -178,36 +242,9 @@ module Commitment_hash = struct () end -type batch_commitment = { - (* TODO: add effects and replace bytes with Irmin: - https://gitlab.com/tezos/tezos/-/issues/2444 - *) - root : bytes; -} - -module Batch = struct - type t = batch_commitment - - let encoding = - Data_encoding.( - conv (fun {root} -> root) (fun root -> {root}) (obj1 (req "root" bytes))) - - let pp : Format.formatter -> t -> unit = - fun fmt {root} -> Hex.pp fmt (Hex.of_bytes root) - - include Compare.Make (struct - type nonrec t = t - - let compare {root = root1} {root = root2} = Bytes.compare root1 root2 - end) -end - -let batch_commitment_equal : batch_commitment -> batch_commitment -> bool = - Batch.equal - type t = { level : Raw_level_repr.t; - batches : batch_commitment list; + batches : Message_result_hash.t list; predecessor : Commitment_hash.t option; inbox_hash : Tx_rollup_inbox_repr.hash; } @@ -217,7 +254,7 @@ let compare_or cmp c1 c2 f = match cmp c1 c2 with 0 -> f () | diff -> diff include Compare.Make (struct type nonrec t = t - module Compare_root_list = Compare.List (Batch) + module Compare_root_list = Compare.List (Message_result_hash) let compare r1 r2 = compare_or Raw_level_repr.compare r1.level r2.level (fun () -> @@ -237,7 +274,7 @@ let pp : Format.formatter -> t -> unit = "commitment %a : batches = %a predecessor %a for inbox %a" Raw_level_repr.pp t.level - (Format.pp_print_list Batch.pp) + (Format.pp_print_list Message_result_hash.pp) t.batches (Format.pp_print_option Commitment_hash.pp) t.predecessor @@ -256,7 +293,7 @@ let encoding = {level; batches; predecessor; inbox_hash}) (obj4 (req "level" Raw_level_repr.encoding) - (req "batches" (list Batch.encoding)) + (req "batches" (list Message_result_hash.encoding)) (req "predecessor" (option Commitment_hash.encoding)) (req "inbox_hash" Tx_rollup_inbox_repr.hash_encoding)) diff --git a/src/proto_alpha/lib_protocol/tx_rollup_commitment_repr.mli b/src/proto_alpha/lib_protocol/tx_rollup_commitment_repr.mli index a73a7d707fd6..fafeb4f19dc3 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_commitment_repr.mli +++ b/src/proto_alpha/lib_protocol/tx_rollup_commitment_repr.mli @@ -56,9 +56,11 @@ module Commitment_hash : sig include S.HASH end -type batch_commitment = {root : bytes} +module Withdraw_hash : S.HASH -val batch_commitment_equal : batch_commitment -> batch_commitment -> bool +module Withdraw_hash_list_hash : S.MERKLE_TREE with type elt = Withdraw_hash.t + +module Message_result_hash : S.HASH (** A commitment describes the interpretation of the messages stored in the inbox of a particular [level], on top of a particular layer-2 context. @@ -72,7 +74,7 @@ val batch_commitment_equal : batch_commitment -> batch_commitment -> bool empty tree. *) type t = { level : Raw_level_repr.t; - batches : batch_commitment list; + batches : Message_result_hash.t list; predecessor : Commitment_hash.t option; inbox_hash : Tx_rollup_inbox_repr.hash; } diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml index a02c44c5e3df..678167f15350 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.ml @@ -162,6 +162,18 @@ module Message_result = struct amount : Tx_rollup_l2_qty.t; } + let withdrawal_encoding : withdrawal Data_encoding.t = + let open Data_encoding in + conv + (fun {destination; ticket_hash; amount} -> + (destination, ticket_hash, amount)) + (fun (destination, ticket_hash, amount) -> + {destination; ticket_hash; amount}) + (obj3 + (req "destination" Signature.Public_key_hash.encoding) + (req "ticket_hash" Ticket_hash.encoding) + (req "amount" Tx_rollup_l2_qty.encoding)) + type transaction_result = | Transaction_success | Transaction_failure of {index : int; reason : error} @@ -184,6 +196,22 @@ module Message_result = struct | Batch_V1_result of Batch_V1.t type t = message_result * withdrawal list + + let hash ctxt_root withdraw_list = + let withdraw_list_hash_bytes = + List.map + (fun withdraw -> + Tx_rollup_commitment.Withdraw_hash.hash_bytes + @@ [Data_encoding.Binary.to_bytes_exn withdrawal_encoding withdraw]) + withdraw_list + |> Tx_rollup_commitment.Withdraw_hash_list_hash.compute + |> Data_encoding.Binary.to_bytes_exn + Tx_rollup_commitment.Withdraw_hash_list_hash.encoding + in + (* TODO/TORU: this needs to change with we use irmin *) + let ctxt_root_bytes = ctxt_root in + Tx_rollup_commitment.Message_result_hash.hash_bytes + [ctxt_root_bytes; withdraw_list_hash_bytes] end module Make (Context : CONTEXT) = struct @@ -635,11 +663,11 @@ module Make (Context : CONTEXT) = struct (apply_deposit ()) (fun (ctxt, indexes) -> return (ctxt, Deposit_success indexes, None)) (fun reason -> - (* Should there an error during the deposit, then return - the full [amount] to [sender] in the form of a - withdrawal. *) - let withdrawal = {destination = sender; ticket_hash; amount} in - return (initial_ctxt, Deposit_failure reason, Some withdrawal)) + (* Should there an error during the deposit, then return + the full [amount] to [sender] in the form of a + withdrawal. *) + let withdrawal = {destination = sender; ticket_hash; amount} in + return (initial_ctxt, Deposit_failure reason, Some withdrawal)) let apply_message : ctxt -> Tx_rollup_message.t -> (ctxt * Message_result.t) m = diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.mli b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.mli index 2c5da71defbd..c5c0bde4180c 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.mli +++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_apply.mli @@ -122,6 +122,9 @@ module Message_result : sig withdrawals that result from failing deposits and layer2-to-layer1 transfers. *) type t = message_result * withdrawal list + + val hash : + bytes -> withdrawal list -> Tx_rollup_commitment.Message_result_hash.t end module Make (Context : CONTEXT) : sig diff --git a/src/proto_alpha/lib_protocol/tx_rollup_message_repr.mli b/src/proto_alpha/lib_protocol/tx_rollup_message_repr.mli index 560e25fb72a5..fdcdf9654565 100644 --- a/src/proto_alpha/lib_protocol/tx_rollup_message_repr.mli +++ b/src/proto_alpha/lib_protocol/tx_rollup_message_repr.mli @@ -59,6 +59,8 @@ type t = Batch of string | Deposit of deposit inbox by [msg]. *) val size : t -> int +val deposit_encoding : deposit Data_encoding.t + val encoding : t Data_encoding.t val pp : Format.formatter -> t -> unit -- GitLab