From a13d6a4f45bf212769c32ba28ae3a752745688c5 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 13 Apr 2022 11:17:45 +0200
Subject: [PATCH 01/13] Proto/Apply: convert internal operations only if
 necessary

---
 src/proto_alpha/lib_protocol/apply.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 052f177cd8da..d2e04ccdeea6 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1786,8 +1786,8 @@ let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops =
     | [] -> Lwt.return (Success ctxt, List.rev applied)
     | Script_typed_ir.Internal_operation ({source; operation; nonce} as op)
       :: rest -> (
-        let op_res = Apply_results.contents_of_internal_operation op in
         (if internal_nonce_already_recorded ctxt nonce then
+         let op_res = Apply_results.contents_of_internal_operation op in
          fail (Internal_operation_replay (Internal_contents op_res))
         else
           let ctxt = record_internal_nonce ctxt nonce in
-- 
GitLab


From 244a6b87bc79b58fdf780f78c66113733b353f8e Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 13 Apr 2022 11:33:19 +0200
Subject: [PATCH 02/13] Proto: unparsed_parameters does not need to be lazy

---
 src/proto_alpha/lib_plugin/plugin.ml                   | 10 +++++-----
 src/proto_alpha/lib_protocol/apply_results.ml          |  7 ++++++-
 .../lib_protocol/script_interpreter_defs.ml            |  4 +---
 src/proto_alpha/lib_protocol/script_typed_ir.ml        |  2 +-
 src/proto_alpha/lib_protocol/script_typed_ir.mli       |  2 +-
 .../integration/michelson/test_ticket_accounting.ml    |  3 +--
 .../michelson/test_ticket_operations_diff.ml           |  6 ++----
 src/proto_alpha/lib_protocol/tx_rollup_ticket.ml       |  4 +---
 8 files changed, 18 insertions(+), 20 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index 101c62bf67fa..f5a117ad3f1f 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2576,11 +2576,11 @@ module RPC = struct
                        ticket_diffs = _;
                      },
                      _ctxt ) ->
-          View_helpers.extract_parameter_from_operations
-            entrypoint
-            operations
-            viewer_contract
-          >>?= fun parameter -> Lwt.return (Script_repr.force_decode parameter)) ;
+          Lwt.return
+            (View_helpers.extract_parameter_from_operations
+               entrypoint
+               operations
+               viewer_contract)) ;
       Registration.register0
         ~chunked:true
         S.run_script_view
diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml
index a2146f53b400..7d62ffe12727 100644
--- a/src/proto_alpha/lib_protocol/apply_results.ml
+++ b/src/proto_alpha/lib_protocol/apply_results.ml
@@ -89,7 +89,12 @@ let contents_of_internal_operation (type kind)
     match operation with
     | Transaction {destination; amount; entrypoint; unparsed_parameters; _} ->
         Transaction
-          {destination; amount; entrypoint; parameters = unparsed_parameters}
+          {
+            destination;
+            amount;
+            entrypoint;
+            parameters = Script.lazy_expr unparsed_parameters;
+          }
     | Origination {origination; _} -> Origination origination
     | Delegation delegate -> Delegation delegate
   in
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index d434ba18bfb0..9a0c1e33d51e 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -562,9 +562,7 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
   >>?= fun (unparsed_parameters, ctxt) ->
   Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
   >>?= fun ctxt ->
-  let unparsed_parameters =
-    Script.lazy_expr (Micheline.strip_locations unparsed_parameters)
-  in
+  let unparsed_parameters = Micheline.strip_locations unparsed_parameters in
   let operation =
     Transaction
       {
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index b1d02fdaea88..ee1e167da4a8 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -1374,7 +1374,7 @@ and 'kind manager_operation =
       location : Script.location;
       parameters_ty : ('a, _) ty;
       parameters : 'a;
-      unparsed_parameters : Script.lazy_expr;
+      unparsed_parameters : Script.expr;
     }
       -> Kind.transaction manager_operation
   | Origination : {
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 547886e26bb6..3dc475984e88 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -1507,7 +1507,7 @@ and 'kind manager_operation =
       location : Script.location;
       parameters_ty : ('a, _) ty;
       parameters : 'a;
-      unparsed_parameters : Script.lazy_expr;
+      unparsed_parameters : Script.expr;
     }
       -> Kind.transaction manager_operation
   | Origination : {
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
index 88c72683af3b..470a82a0434f 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
@@ -388,8 +388,7 @@ let transfer_operation ctxt ~src ~destination ~arg_type ~arg =
             Transaction
               {
                 amount = Tez.zero;
-                unparsed_parameters =
-                  Script.lazy_expr @@ Micheline.strip_locations params_node;
+                unparsed_parameters = Micheline.strip_locations params_node;
                 entrypoint = Entrypoint.default;
                 destination = Destination.Contract destination;
                 location = Micheline.dummy_location;
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
index 2d7a6be06fdc..77bc739e0bae 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
@@ -295,8 +295,7 @@ let transfer_operation ~incr ~src ~destination ~parameters_ty ~parameters =
             Transaction
               {
                 amount = Tez.zero;
-                unparsed_parameters =
-                  Script.lazy_expr @@ Micheline.strip_locations params_node;
+                unparsed_parameters = Micheline.strip_locations params_node;
                 entrypoint = Entrypoint.default;
                 destination = Destination.Contract destination;
                 location = Micheline.dummy_location;
@@ -328,8 +327,7 @@ let transfer_operation_to_tx_rollup ~incr ~src ~parameters_ty ~parameters
             Transaction
               {
                 amount = Tez.zero;
-                unparsed_parameters =
-                  Script.lazy_expr @@ Micheline.strip_locations params_node;
+                unparsed_parameters = Micheline.strip_locations params_node;
                 entrypoint = Tx_rollup.deposit_entrypoint;
                 destination = Destination.Tx_rollup tx_rollup;
                 location = Micheline.dummy_location;
diff --git a/src/proto_alpha/lib_protocol/tx_rollup_ticket.ml b/src/proto_alpha/lib_protocol/tx_rollup_ticket.ml
index 1813562a765a..43be3d6da249 100644
--- a/src/proto_alpha/lib_protocol/tx_rollup_ticket.ml
+++ b/src/proto_alpha/lib_protocol/tx_rollup_ticket.ml
@@ -70,9 +70,7 @@ let parse_ticket_and_operation ~consume_deserialization_gas ~ticketer ~contents
   >>=? fun (parameters_expr, ctxt) ->
   Gas.consume ctxt (Script.strip_locations_cost parameters_expr)
   >>?= fun ctxt ->
-  let unparsed_parameters =
-    Script.lazy_expr (Micheline.strip_locations parameters_expr)
-  in
+  let unparsed_parameters = Micheline.strip_locations parameters_expr in
   fresh_internal_nonce ctxt >>?= fun (ctxt, nonce) ->
   let op =
     Script_typed_ir.Internal_operation
-- 
GitLab


From 76d639c686025c48f00e627f55bc68b4195dbce0 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 13 Apr 2022 11:49:53 +0200
Subject: [PATCH 03/13] Proto/Michelson: build operation in each branch

---
 .../lib_protocol/script_interpreter_defs.ml   | 75 ++++++++++++-------
 1 file changed, 48 insertions(+), 27 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 9a0c1e33d51e..857b383999e5 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -504,18 +504,34 @@ let apply ctxt gas capture_ty capture lam =
    instantiated with argument [parameters] of type [parameters_ty]. *)
 let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
     entrypoint =
-  (* [craft_transfer_parameters ctxt tp p] reorganizes, if need be, the
+  (* [craft_transfer_operation ctxt tp p] reorganizes, if need be, the
      parameters submitted by the interpreter to prepare them for the
-     [Transaction] operation. *)
-  let craft_transfer_parameters :
+     [Transaction] operation and build the operation. *)
+  let craft_transfer_operation :
       type a ac.
       context ->
       (a, ac) ty ->
       (location, prim) Micheline.node ->
       Destination.t ->
-      ((location, prim) Micheline.node * context) tzresult =
-   fun ctxt tp p -> function
-    | Contract _ -> ok (p, ctxt)
+      (Kind.transaction manager_operation * context) tzresult =
+   fun ctxt tp unparsed_parameters -> function
+    | Contract _ ->
+        Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
+        >|? fun ctxt ->
+        let unparsed_parameters =
+          Micheline.strip_locations unparsed_parameters
+        in
+        ( Transaction
+            {
+              destination;
+              amount;
+              entrypoint;
+              location;
+              parameters_ty;
+              parameters;
+              unparsed_parameters;
+            },
+          ctxt )
     (* The entrypoints of a transaction rollup are polymorphic wrt. the
        tickets it can process. However, two Michelson values can have
        the same Micheline representation, but different types. What
@@ -528,11 +544,32 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
        the smart contract. This allows the transaction rollup to extract
        the type of the ticket. *)
     | Tx_rollup _ -> (
-        let open Micheline in
         match tp with
         | Pair_t (Ticket_t (tp, _), _, _, _) ->
-            Script_ir_translator.unparse_ty ~loc:dummy_location ctxt tp
-            >|? fun (ty, ctxt) -> (Seq (dummy_location, [p; ty]), ctxt)
+            Script_ir_translator.unparse_ty
+              ~loc:Micheline.dummy_location
+              ctxt
+              tp
+            >>? fun (ty, ctxt) ->
+            let unparsed_parameters =
+              Micheline.Seq (Micheline.dummy_location, [unparsed_parameters; ty])
+            in
+            Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
+            >|? fun ctxt ->
+            let unparsed_parameters =
+              Micheline.strip_locations unparsed_parameters
+            in
+            ( Transaction
+                {
+                  destination;
+                  amount;
+                  entrypoint;
+                  location;
+                  parameters_ty;
+                  parameters;
+                  unparsed_parameters;
+                },
+              ctxt )
         | _ ->
             (* TODO: https://gitlab.com/tezos/tezos/-/issues/2455
                Refute this branch thanks to the type system.
@@ -542,7 +579,6 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
                refactoring away to reach it. *)
             assert false)
   in
-
   let ctxt = update_context gas ctxt in
   collect_lazy_storage ctxt parameters_ty parameters
   >>?= fun (to_duplicate, ctxt) ->
@@ -558,23 +594,8 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
   >>=? fun (parameters, lazy_storage_diff, ctxt) ->
   unparse_data ctxt Optimized parameters_ty parameters
   >>=? fun (unparsed_parameters, ctxt) ->
-  craft_transfer_parameters ctxt parameters_ty unparsed_parameters destination
-  >>?= fun (unparsed_parameters, ctxt) ->
-  Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
-  >>?= fun ctxt ->
-  let unparsed_parameters = Micheline.strip_locations unparsed_parameters in
-  let operation =
-    Transaction
-      {
-        destination;
-        amount;
-        entrypoint;
-        location;
-        parameters_ty;
-        parameters;
-        unparsed_parameters;
-      }
-  in
+  craft_transfer_operation ctxt parameters_ty unparsed_parameters destination
+  >>?= fun (operation, ctxt) ->
   fresh_internal_nonce ctxt >>?= fun (ctxt, nonce) ->
   let iop = {source = sc.self; operation; nonce} in
   let res = {piop = Internal_operation iop; lazy_storage_diff} in
-- 
GitLab


From f2fd28e10c5da95d63a0ac4f5e9770f538fcc50f Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 13 Apr 2022 11:59:08 +0200
Subject: [PATCH 04/13] Proto: split internal Transaction

---
 src/proto_alpha/lib_plugin/plugin.ml            |  4 ++--
 src/proto_alpha/lib_protocol/apply.ml           | 14 +++++++-------
 src/proto_alpha/lib_protocol/apply_results.ml   | 14 ++++++++++++--
 .../lib_protocol/script_interpreter_defs.ml     |  8 ++++----
 src/proto_alpha/lib_protocol/script_typed_ir.ml | 17 ++++++++++++++---
 .../lib_protocol/script_typed_ir.mli            | 14 ++++++++++++--
 .../michelson/test_ticket_accounting.ml         |  4 ++--
 .../michelson/test_ticket_operations_diff.ml    |  8 ++++----
 .../lib_protocol/ticket_operations_diff.ml      | 10 +++++-----
 .../lib_protocol/tx_rollup_ticket.ml            |  2 +-
 .../lib_protocol/tx_rollup_ticket.mli           |  2 +-
 11 files changed, 64 insertions(+), 33 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index f5a117ad3f1f..8bef53c4780a 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -1496,9 +1496,9 @@ module View_helpers = struct
      Script_typed_ir.Internal_operation
        {
          operation =
-           Transaction
+           Transaction_to_contract
              {
-               destination = Contract destination;
+               destination;
                unparsed_parameters;
                entrypoint = _;
                amount = _;
diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index d2e04ccdeea6..b3d2caf87b2b 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1179,11 +1179,11 @@ let apply_internal_manager_operation_content :
     ~gas_consumed_in_precheck
   >>=? fun (ctxt, before_operation, consume_deserialization_gas) ->
   match operation with
-  | Transaction
+  | Transaction_to_contract
       {
+        destination;
         amount;
         unparsed_parameters = _;
-        destination = Contract contract;
         entrypoint;
         location;
         parameters_ty;
@@ -1193,7 +1193,7 @@ let apply_internal_manager_operation_content :
         ~ctxt
         ~parameter:(Typed_arg (location, parameters_ty, typed_parameters))
         ~source
-        ~contract
+        ~contract:destination
         ~amount
         ~entrypoint
         ~before_operation
@@ -1205,10 +1205,10 @@ let apply_internal_manager_operation_content :
       ( ctxt,
         (manager_result : kind successful_manager_operation_result),
         operations )
-  | Transaction
+  | Transaction_to_tx_rollup
       {
+        destination;
         amount;
-        destination = Tx_rollup dst;
         entrypoint;
         unparsed_parameters = _;
         location = _;
@@ -1222,7 +1222,7 @@ let apply_internal_manager_operation_content :
         ~amount
         ~entrypoint
         ~payer
-        ~dst_rollup:dst
+        ~dst_rollup:destination
         ~since:before_operation
   | Origination
       {
@@ -1406,7 +1406,7 @@ let apply_external_manager_operation_content :
         ~contents
         ~ty
         ~source:source_contract
-        ~destination:(Contract destination)
+        ~destination
         ~entrypoint
         ~amount
         ctxt
diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml
index 7d62ffe12727..b6e140906892 100644
--- a/src/proto_alpha/lib_protocol/apply_results.ml
+++ b/src/proto_alpha/lib_protocol/apply_results.ml
@@ -87,10 +87,20 @@ let contents_of_internal_operation (type kind)
     kind internal_contents =
   let operation : kind internal_manager_operation =
     match operation with
-    | Transaction {destination; amount; entrypoint; unparsed_parameters; _} ->
+    | Transaction_to_contract
+        {destination; amount; entrypoint; unparsed_parameters; _} ->
         Transaction
           {
-            destination;
+            destination = Contract destination;
+            amount;
+            entrypoint;
+            parameters = Script.lazy_expr unparsed_parameters;
+          }
+    | Transaction_to_tx_rollup
+        {destination; amount; entrypoint; unparsed_parameters; _} ->
+        Transaction
+          {
+            destination = Tx_rollup destination;
             amount;
             entrypoint;
             parameters = Script.lazy_expr unparsed_parameters;
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 857b383999e5..6ce32841bf09 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -515,13 +515,13 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
       Destination.t ->
       (Kind.transaction manager_operation * context) tzresult =
    fun ctxt tp unparsed_parameters -> function
-    | Contract _ ->
+    | Contract destination ->
         Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
         >|? fun ctxt ->
         let unparsed_parameters =
           Micheline.strip_locations unparsed_parameters
         in
-        ( Transaction
+        ( Transaction_to_contract
             {
               destination;
               amount;
@@ -543,7 +543,7 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
        rollup to inject the exact type of the entrypoint as used by
        the smart contract. This allows the transaction rollup to extract
        the type of the ticket. *)
-    | Tx_rollup _ -> (
+    | Tx_rollup destination -> (
         match tp with
         | Pair_t (Ticket_t (tp, _), _, _, _) ->
             Script_ir_translator.unparse_ty
@@ -559,7 +559,7 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
             let unparsed_parameters =
               Micheline.strip_locations unparsed_parameters
             in
-            ( Transaction
+            ( Transaction_to_tx_rollup
                 {
                   destination;
                   amount;
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index ee1e167da4a8..3353fa03dcbf 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -1367,8 +1367,18 @@ and ('input, 'output) view_signature =
       -> ('input, 'output) view_signature
 
 and 'kind manager_operation =
-  | Transaction : {
-      destination : Destination.t;
+  | Transaction_to_contract : {
+      destination : Contract.t;
+      amount : Tez.tez;
+      entrypoint : Entrypoint.t;
+      location : Script.location;
+      parameters_ty : ('a, _) ty;
+      parameters : 'a;
+      unparsed_parameters : Script.expr;
+    }
+      -> Kind.transaction manager_operation
+  | Transaction_to_tx_rollup : {
+      destination : Tx_rollup.t;
       amount : Tez.tez;
       entrypoint : Entrypoint.t;
       location : Script.location;
@@ -1409,7 +1419,8 @@ type packed_manager_operation =
 
 let manager_kind : type kind. kind manager_operation -> kind Kind.manager =
   function
-  | Transaction _ -> Kind.Transaction_manager_kind
+  | Transaction_to_contract _ -> Kind.Transaction_manager_kind
+  | Transaction_to_tx_rollup _ -> Kind.Transaction_manager_kind
   | Origination _ -> Kind.Origination_manager_kind
   | Delegation _ -> Kind.Delegation_manager_kind
 
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 3dc475984e88..e0f7a0443bd2 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -1495,13 +1495,23 @@ and ('input, 'output) view_signature =
       -> ('input, 'output) view_signature
 
 and 'kind manager_operation =
-  | Transaction : {
+  | Transaction_to_contract : {
       (* The [unparsed_parameters] field may seem useless since we have
          access to a typed version of the field (with [parameters_ty] and
          [parameters]), but we keep it so that we do not have to unparse the
          typed version in order to produce the receipt
          ([Apply_results.internal_manager_operation]). *)
-      destination : Destination.t;
+      destination : Contract.t;
+      amount : Tez.tez;
+      entrypoint : Entrypoint.t;
+      location : Script.location;
+      parameters_ty : ('a, _) ty;
+      parameters : 'a;
+      unparsed_parameters : Script.expr;
+    }
+      -> Kind.transaction manager_operation
+  | Transaction_to_tx_rollup : {
+      destination : Tx_rollup.t;
       amount : Tez.tez;
       entrypoint : Entrypoint.t;
       location : Script.location;
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
index 470a82a0434f..97b0db9465a8 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
@@ -385,12 +385,12 @@ let transfer_operation ctxt ~src ~destination ~arg_type ~arg =
         {
           source = src;
           operation =
-            Transaction
+            Transaction_to_contract
               {
                 amount = Tez.zero;
                 unparsed_parameters = Micheline.strip_locations params_node;
                 entrypoint = Entrypoint.default;
-                destination = Destination.Contract destination;
+                destination;
                 location = Micheline.dummy_location;
                 parameters_ty = arg_type;
                 parameters = arg;
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
index 77bc739e0bae..af6bdbafb250 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
@@ -292,12 +292,12 @@ let transfer_operation ~incr ~src ~destination ~parameters_ty ~parameters =
         {
           source = src;
           operation =
-            Transaction
+            Transaction_to_contract
               {
                 amount = Tez.zero;
                 unparsed_parameters = Micheline.strip_locations params_node;
                 entrypoint = Entrypoint.default;
-                destination = Destination.Contract destination;
+                destination;
                 location = Micheline.dummy_location;
                 parameters_ty;
                 parameters;
@@ -324,12 +324,12 @@ let transfer_operation_to_tx_rollup ~incr ~src ~parameters_ty ~parameters
         {
           source = src;
           operation =
-            Transaction
+            Transaction_to_tx_rollup
               {
                 amount = Tez.zero;
                 unparsed_parameters = Micheline.strip_locations params_node;
                 entrypoint = Tx_rollup.deposit_entrypoint;
-                destination = Destination.Tx_rollup tx_rollup;
+                destination = tx_rollup;
                 location = Micheline.dummy_location;
                 parameters_ty;
                 parameters;
diff --git a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
index 5d0038750cea..c60f5f149149 100644
--- a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
@@ -238,12 +238,12 @@ let tickets_of_origination ctxt ~preorigination ~storage_type ~storage =
 let tickets_of_operation ctxt
     (Script_typed_ir.Internal_operation {source = _; operation; nonce = _}) =
   match operation with
-  | Transaction
+  | Transaction_to_contract
       {
         amount = _;
         unparsed_parameters = _;
         entrypoint;
-        destination = Destination.Contract destination;
+        destination;
         location;
         parameters_ty;
         parameters;
@@ -255,9 +255,9 @@ let tickets_of_operation ctxt
         ~location
         ~parameters_ty
         ~parameters
-  | Transaction
+  | Transaction_to_tx_rollup
       {
-        destination = Destination.Tx_rollup tx_rollup_dest;
+        destination;
         unparsed_parameters = _;
         entrypoint;
         amount = _;
@@ -271,7 +271,7 @@ let tickets_of_operation ctxt
         return
           ( Some
               {
-                destination = Destination.Tx_rollup tx_rollup_dest;
+                destination = Destination.Tx_rollup destination;
                 tickets = [ex_ticket];
               },
             ctxt )
diff --git a/src/proto_alpha/lib_protocol/tx_rollup_ticket.ml b/src/proto_alpha/lib_protocol/tx_rollup_ticket.ml
index 43be3d6da249..d4549894b9f7 100644
--- a/src/proto_alpha/lib_protocol/tx_rollup_ticket.ml
+++ b/src/proto_alpha/lib_protocol/tx_rollup_ticket.ml
@@ -78,7 +78,7 @@ let parse_ticket_and_operation ~consume_deserialization_gas ~ticketer ~contents
         source;
         nonce;
         operation =
-          Transaction
+          Transaction_to_contract
             {
               amount = Tez.zero;
               unparsed_parameters;
diff --git a/src/proto_alpha/lib_protocol/tx_rollup_ticket.mli b/src/proto_alpha/lib_protocol/tx_rollup_ticket.mli
index b8f6474347e6..281fb79289e6 100644
--- a/src/proto_alpha/lib_protocol/tx_rollup_ticket.mli
+++ b/src/proto_alpha/lib_protocol/tx_rollup_ticket.mli
@@ -48,7 +48,7 @@ val parse_ticket_and_operation :
   contents:Script.lazy_expr ->
   ty:Script.lazy_expr ->
   source:Contract.t ->
-  destination:Destination.t ->
+  destination:Contract.t ->
   entrypoint:Entrypoint.t ->
   amount:Z.t ->
   context ->
-- 
GitLab


From 126557faf9e12d097e1b3c5add4c8adee77abf10 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 14 Apr 2022 10:55:37 +0200
Subject: [PATCH 05/13] Proto/Michelson: move unparse_data to each branch

---
 .../lib_protocol/script_interpreter_defs.ml   | 103 ++++++++++--------
 1 file changed, 55 insertions(+), 48 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 6ce32841bf09..7a9e57237ee4 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -511,27 +511,30 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
       type a ac.
       context ->
       (a, ac) ty ->
-      (location, prim) Micheline.node ->
+      a ->
       Destination.t ->
-      (Kind.transaction manager_operation * context) tzresult =
-   fun ctxt tp unparsed_parameters -> function
+      (Kind.transaction manager_operation * context) tzresult Lwt.t =
+   fun ctxt parameters_ty parameters -> function
     | Contract destination ->
-        Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
-        >|? fun ctxt ->
-        let unparsed_parameters =
-          Micheline.strip_locations unparsed_parameters
-        in
-        ( Transaction_to_contract
-            {
-              destination;
-              amount;
-              entrypoint;
-              location;
-              parameters_ty;
-              parameters;
-              unparsed_parameters;
-            },
-          ctxt )
+        unparse_data ctxt Optimized parameters_ty parameters
+        >>=? fun (unparsed_parameters, ctxt) ->
+        Lwt.return
+          ( Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
+          >|? fun ctxt ->
+            let unparsed_parameters =
+              Micheline.strip_locations unparsed_parameters
+            in
+            ( Transaction_to_contract
+                {
+                  destination;
+                  amount;
+                  entrypoint;
+                  location;
+                  parameters_ty;
+                  parameters;
+                  unparsed_parameters;
+                },
+              ctxt ) )
     (* The entrypoints of a transaction rollup are polymorphic wrt. the
        tickets it can process. However, two Michelson values can have
        the same Micheline representation, but different types. What
@@ -544,32 +547,38 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
        the smart contract. This allows the transaction rollup to extract
        the type of the ticket. *)
     | Tx_rollup destination -> (
-        match tp with
+        match parameters_ty with
         | Pair_t (Ticket_t (tp, _), _, _, _) ->
-            Script_ir_translator.unparse_ty
-              ~loc:Micheline.dummy_location
-              ctxt
-              tp
-            >>? fun (ty, ctxt) ->
-            let unparsed_parameters =
-              Micheline.Seq (Micheline.dummy_location, [unparsed_parameters; ty])
-            in
-            Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
-            >|? fun ctxt ->
-            let unparsed_parameters =
-              Micheline.strip_locations unparsed_parameters
-            in
-            ( Transaction_to_tx_rollup
-                {
-                  destination;
-                  amount;
-                  entrypoint;
-                  location;
-                  parameters_ty;
-                  parameters;
-                  unparsed_parameters;
-                },
-              ctxt )
+            unparse_data ctxt Optimized parameters_ty parameters
+            >>=? fun (unparsed_parameters, ctxt) ->
+            Lwt.return
+              ( Script_ir_translator.unparse_ty
+                  ~loc:Micheline.dummy_location
+                  ctxt
+                  tp
+              >>? fun (ty, ctxt) ->
+                let unparsed_parameters =
+                  Micheline.Seq
+                    (Micheline.dummy_location, [unparsed_parameters; ty])
+                in
+                Gas.consume
+                  ctxt
+                  (Script.strip_locations_cost unparsed_parameters)
+                >|? fun ctxt ->
+                let unparsed_parameters =
+                  Micheline.strip_locations unparsed_parameters
+                in
+                ( Transaction_to_tx_rollup
+                    {
+                      destination;
+                      amount;
+                      entrypoint;
+                      location;
+                      parameters_ty;
+                      parameters;
+                      unparsed_parameters;
+                    },
+                  ctxt ) )
         | _ ->
             (* TODO: https://gitlab.com/tezos/tezos/-/issues/2455
                Refute this branch thanks to the type system.
@@ -592,10 +601,8 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
     ~to_update
     ~temporary:true
   >>=? fun (parameters, lazy_storage_diff, ctxt) ->
-  unparse_data ctxt Optimized parameters_ty parameters
-  >>=? fun (unparsed_parameters, ctxt) ->
-  craft_transfer_operation ctxt parameters_ty unparsed_parameters destination
-  >>?= fun (operation, ctxt) ->
+  craft_transfer_operation ctxt parameters_ty parameters destination
+  >>=? fun (operation, ctxt) ->
   fresh_internal_nonce ctxt >>?= fun (ctxt, nonce) ->
   let iop = {source = sc.self; operation; nonce} in
   let res = {piop = Internal_operation iop; lazy_storage_diff} in
-- 
GitLab


From b4e14448115d7b99d5b9dc53555cb1dfa3be0a50 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 14 Apr 2022 11:02:53 +0200
Subject: [PATCH 06/13] Proto/Michelson: extract make_transaction_to_contract

---
 .../lib_protocol/script_interpreter_defs.ml   | 47 +++++++++++--------
 1 file changed, 28 insertions(+), 19 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 7a9e57237ee4..9605538adb08 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -498,6 +498,26 @@ let apply ctxt gas capture_ty capture lam =
       let (gas, ctxt) = local_gas_counter_and_outdated_context ctxt in
       return (lam', ctxt, gas)
 
+let make_transaction_to_contract ctxt ~destination ~amount ~entrypoint ~location
+    ~parameters_ty ~parameters =
+  unparse_data ctxt Optimized parameters_ty parameters
+  >>=? fun (unparsed_parameters, ctxt) ->
+  Lwt.return
+    ( Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
+    >|? fun ctxt ->
+      let unparsed_parameters = Micheline.strip_locations unparsed_parameters in
+      ( Transaction_to_contract
+          {
+            destination;
+            amount;
+            entrypoint;
+            location;
+            parameters_ty;
+            parameters;
+            unparsed_parameters;
+          },
+        ctxt ) )
+
 (* [transfer (ctxt, sc) gas tez parameters_ty parameters destination entrypoint]
    creates an operation that transfers an amount of [tez] to
    a contract determined by [(destination, entrypoint)]
@@ -516,25 +536,14 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
       (Kind.transaction manager_operation * context) tzresult Lwt.t =
    fun ctxt parameters_ty parameters -> function
     | Contract destination ->
-        unparse_data ctxt Optimized parameters_ty parameters
-        >>=? fun (unparsed_parameters, ctxt) ->
-        Lwt.return
-          ( Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
-          >|? fun ctxt ->
-            let unparsed_parameters =
-              Micheline.strip_locations unparsed_parameters
-            in
-            ( Transaction_to_contract
-                {
-                  destination;
-                  amount;
-                  entrypoint;
-                  location;
-                  parameters_ty;
-                  parameters;
-                  unparsed_parameters;
-                },
-              ctxt ) )
+        make_transaction_to_contract
+          ctxt
+          ~destination
+          ~amount
+          ~entrypoint
+          ~location
+          ~parameters_ty
+          ~parameters
     (* The entrypoints of a transaction rollup are polymorphic wrt. the
        tickets it can process. However, two Michelson values can have
        the same Micheline representation, but different types. What
-- 
GitLab


From 288ea82ad00014476aa5fb5f546e658ef0031dcd Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 14 Apr 2022 11:02:53 +0200
Subject: [PATCH 07/13] Proto/Michelson: extract make_transaction_to_tx_rollup

---
 .../lib_protocol/script_interpreter_defs.ml   | 109 +++++++++---------
 1 file changed, 57 insertions(+), 52 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 9605538adb08..97381198903b 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -518,6 +518,54 @@ let make_transaction_to_contract ctxt ~destination ~amount ~entrypoint ~location
           },
         ctxt ) )
 
+let make_transaction_to_tx_rollup (type t tc) ctxt ~destination ~amount
+    ~entrypoint ~location ~(parameters_ty : (t, tc) ty) ~parameters =
+  (* The entrypoints of a transaction rollup are polymorphic wrt. the
+     tickets it can process. However, two Michelson values can have
+     the same Micheline representation, but different types. What
+     this means is that when we start the execution of a transaction
+     rollup, the type of its argument is lost if we just give it the
+     values provided by the Michelson script.
+
+     To address this issue, we instrument a transfer to a transaction
+     rollup to inject the exact type of the entrypoint as used by
+     the smart contract. This allows the transaction rollup to extract
+     the type of the ticket. *)
+  match parameters_ty with
+  | Pair_t (Ticket_t (tp, _), _, _, _) ->
+      unparse_data ctxt Optimized parameters_ty parameters
+      >>=? fun (unparsed_parameters, ctxt) ->
+      Lwt.return
+        ( Script_ir_translator.unparse_ty ~loc:Micheline.dummy_location ctxt tp
+        >>? fun (ty, ctxt) ->
+          let unparsed_parameters =
+            Micheline.Seq (Micheline.dummy_location, [unparsed_parameters; ty])
+          in
+          Gas.consume ctxt (Script.strip_locations_cost unparsed_parameters)
+          >|? fun ctxt ->
+          let unparsed_parameters =
+            Micheline.strip_locations unparsed_parameters
+          in
+          ( Transaction_to_tx_rollup
+              {
+                destination;
+                amount;
+                entrypoint;
+                location;
+                parameters_ty;
+                parameters;
+                unparsed_parameters;
+              },
+            ctxt ) )
+  | _ ->
+      (* TODO: https://gitlab.com/tezos/tezos/-/issues/2455
+         Refute this branch thanks to the type system.
+         Thanks to the implementation of the [CONTRACT]
+         instruction, this branch is unreachable. But this is
+         not enforced by the type system, which means we are one
+         refactoring away to reach it. *)
+      assert false
+
 (* [transfer (ctxt, sc) gas tez parameters_ty parameters destination entrypoint]
    creates an operation that transfers an amount of [tez] to
    a contract determined by [(destination, entrypoint)]
@@ -544,58 +592,15 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
           ~location
           ~parameters_ty
           ~parameters
-    (* The entrypoints of a transaction rollup are polymorphic wrt. the
-       tickets it can process. However, two Michelson values can have
-       the same Micheline representation, but different types. What
-       this means is that when we start the execution of a transaction
-       rollup, the type of its argument is lost if we just give it the
-       values provided by the Michelson script.
-
-       To address this issue, we instrument a transfer to a transaction
-       rollup to inject the exact type of the entrypoint as used by
-       the smart contract. This allows the transaction rollup to extract
-       the type of the ticket. *)
-    | Tx_rollup destination -> (
-        match parameters_ty with
-        | Pair_t (Ticket_t (tp, _), _, _, _) ->
-            unparse_data ctxt Optimized parameters_ty parameters
-            >>=? fun (unparsed_parameters, ctxt) ->
-            Lwt.return
-              ( Script_ir_translator.unparse_ty
-                  ~loc:Micheline.dummy_location
-                  ctxt
-                  tp
-              >>? fun (ty, ctxt) ->
-                let unparsed_parameters =
-                  Micheline.Seq
-                    (Micheline.dummy_location, [unparsed_parameters; ty])
-                in
-                Gas.consume
-                  ctxt
-                  (Script.strip_locations_cost unparsed_parameters)
-                >|? fun ctxt ->
-                let unparsed_parameters =
-                  Micheline.strip_locations unparsed_parameters
-                in
-                ( Transaction_to_tx_rollup
-                    {
-                      destination;
-                      amount;
-                      entrypoint;
-                      location;
-                      parameters_ty;
-                      parameters;
-                      unparsed_parameters;
-                    },
-                  ctxt ) )
-        | _ ->
-            (* TODO: https://gitlab.com/tezos/tezos/-/issues/2455
-               Refute this branch thanks to the type system.
-               Thanks to the implementation of the [CONTRACT]
-               instruction, this branch is unreachable. But this is
-               not enforced by the type system, which means we are one
-               refactoring away to reach it. *)
-            assert false)
+    | Tx_rollup destination ->
+        make_transaction_to_tx_rollup
+          ctxt
+          ~destination
+          ~amount
+          ~entrypoint
+          ~location
+          ~parameters_ty
+          ~parameters
   in
   let ctxt = update_context gas ctxt in
   collect_lazy_storage ctxt parameters_ty parameters
-- 
GitLab


From c992cfc23563ad7a95b65dde8cc4d9d52e668a70 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 13 Apr 2022 11:44:03 +0200
Subject: [PATCH 08/13] Proto/Michelson: inline craft_transfer_operation

---
 .../lib_protocol/script_interpreter_defs.ml   | 54 ++++++++-----------
 1 file changed, 21 insertions(+), 33 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 97381198903b..677f86fb71da 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -570,38 +570,8 @@ let make_transaction_to_tx_rollup (type t tc) ctxt ~destination ~amount
    creates an operation that transfers an amount of [tez] to
    a contract determined by [(destination, entrypoint)]
    instantiated with argument [parameters] of type [parameters_ty]. *)
-let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
-    entrypoint =
-  (* [craft_transfer_operation ctxt tp p] reorganizes, if need be, the
-     parameters submitted by the interpreter to prepare them for the
-     [Transaction] operation and build the operation. *)
-  let craft_transfer_operation :
-      type a ac.
-      context ->
-      (a, ac) ty ->
-      a ->
-      Destination.t ->
-      (Kind.transaction manager_operation * context) tzresult Lwt.t =
-   fun ctxt parameters_ty parameters -> function
-    | Contract destination ->
-        make_transaction_to_contract
-          ctxt
-          ~destination
-          ~amount
-          ~entrypoint
-          ~location
-          ~parameters_ty
-          ~parameters
-    | Tx_rollup destination ->
-        make_transaction_to_tx_rollup
-          ctxt
-          ~destination
-          ~amount
-          ~entrypoint
-          ~location
-          ~parameters_ty
-          ~parameters
-  in
+let transfer (ctxt, sc) gas amount location parameters_ty parameters
+    (destination : Destination.t) entrypoint =
   let ctxt = update_context gas ctxt in
   collect_lazy_storage ctxt parameters_ty parameters
   >>?= fun (to_duplicate, ctxt) ->
@@ -615,7 +585,25 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
     ~to_update
     ~temporary:true
   >>=? fun (parameters, lazy_storage_diff, ctxt) ->
-  craft_transfer_operation ctxt parameters_ty parameters destination
+  (match destination with
+  | Contract destination ->
+      make_transaction_to_contract
+        ctxt
+        ~destination
+        ~amount
+        ~entrypoint
+        ~location
+        ~parameters_ty
+        ~parameters
+  | Tx_rollup destination ->
+      make_transaction_to_tx_rollup
+        ctxt
+        ~destination
+        ~amount
+        ~entrypoint
+        ~location
+        ~parameters_ty
+        ~parameters)
   >>=? fun (operation, ctxt) ->
   fresh_internal_nonce ctxt >>?= fun (ctxt, nonce) ->
   let iop = {source = sc.self; operation; nonce} in
-- 
GitLab


From aed5ef4298534e7bab6e88d3ed9ccf88832f97de Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 14 Apr 2022 10:45:05 +0200
Subject: [PATCH 09/13] Proto: remove location field of
 Transaction_to_tx_rollup

---
 src/proto_alpha/lib_protocol/apply.ml                         | 1 -
 src/proto_alpha/lib_protocol/script_interpreter_defs.ml       | 4 +---
 src/proto_alpha/lib_protocol/script_typed_ir.ml               | 1 -
 src/proto_alpha/lib_protocol/script_typed_ir.mli              | 1 -
 .../test/integration/michelson/test_ticket_operations_diff.ml | 1 -
 src/proto_alpha/lib_protocol/ticket_operations_diff.ml        | 1 -
 6 files changed, 1 insertion(+), 8 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index b3d2caf87b2b..6960c3ab8c62 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1211,7 +1211,6 @@ let apply_internal_manager_operation_content :
         amount;
         entrypoint;
         unparsed_parameters = _;
-        location = _;
         parameters_ty;
         parameters;
       } ->
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 677f86fb71da..c03103c0492e 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -519,7 +519,7 @@ let make_transaction_to_contract ctxt ~destination ~amount ~entrypoint ~location
         ctxt ) )
 
 let make_transaction_to_tx_rollup (type t tc) ctxt ~destination ~amount
-    ~entrypoint ~location ~(parameters_ty : (t, tc) ty) ~parameters =
+    ~entrypoint ~(parameters_ty : (t, tc) ty) ~parameters =
   (* The entrypoints of a transaction rollup are polymorphic wrt. the
      tickets it can process. However, two Michelson values can have
      the same Micheline representation, but different types. What
@@ -551,7 +551,6 @@ let make_transaction_to_tx_rollup (type t tc) ctxt ~destination ~amount
                 destination;
                 amount;
                 entrypoint;
-                location;
                 parameters_ty;
                 parameters;
                 unparsed_parameters;
@@ -601,7 +600,6 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters
         ~destination
         ~amount
         ~entrypoint
-        ~location
         ~parameters_ty
         ~parameters)
   >>=? fun (operation, ctxt) ->
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 3353fa03dcbf..bdd2bc589c82 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -1381,7 +1381,6 @@ and 'kind manager_operation =
       destination : Tx_rollup.t;
       amount : Tez.tez;
       entrypoint : Entrypoint.t;
-      location : Script.location;
       parameters_ty : ('a, _) ty;
       parameters : 'a;
       unparsed_parameters : Script.expr;
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index e0f7a0443bd2..f8890abecd77 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -1514,7 +1514,6 @@ and 'kind manager_operation =
       destination : Tx_rollup.t;
       amount : Tez.tez;
       entrypoint : Entrypoint.t;
-      location : Script.location;
       parameters_ty : ('a, _) ty;
       parameters : 'a;
       unparsed_parameters : Script.expr;
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
index af6bdbafb250..403a63f1bdcc 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
@@ -330,7 +330,6 @@ let transfer_operation_to_tx_rollup ~incr ~src ~parameters_ty ~parameters
                 unparsed_parameters = Micheline.strip_locations params_node;
                 entrypoint = Tx_rollup.deposit_entrypoint;
                 destination = tx_rollup;
-                location = Micheline.dummy_location;
                 parameters_ty;
                 parameters;
               };
diff --git a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
index c60f5f149149..a1160796ec60 100644
--- a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
@@ -261,7 +261,6 @@ let tickets_of_operation ctxt
         unparsed_parameters = _;
         entrypoint;
         amount = _;
-        location = _;
         parameters_ty;
         parameters;
       } ->
-- 
GitLab


From cd967fda5a8d4d951f19af9b7bca1e6bc23013ba Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 13 Apr 2022 16:06:59 +0200
Subject: [PATCH 10/13] Proto: split
 Tx_rollup_invalid_transaction_ticket_amount

---
 src/proto_alpha/lib_protocol/apply.ml         | 27 ++++++++++---------
 src/proto_alpha/lib_protocol/apply.mli        |  2 +-
 .../lib_protocol/script_interpreter_defs.ml   | 19 +++++++++++++
 .../integration/operations/test_tx_rollup.ml  |  5 ++--
 4 files changed, 37 insertions(+), 16 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 6960c3ab8c62..ac5e452505f2 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -95,7 +95,7 @@ type error +=
   | Set_deposits_limit_too_high of {limit : Tez.t; max_limit : Tez.t}
   | Empty_transaction of Contract.t
   | Tx_rollup_feature_disabled
-  | Tx_rollup_invalid_transaction_amount
+  | Tx_rollup_invalid_transaction_ticket_amount
   | Tx_rollup_non_internal_transaction
   | Cannot_transfer_ticket_to_implicit
   | Sc_rollup_feature_disabled
@@ -502,19 +502,17 @@ let () =
 
   register_error_kind
     `Permanent
-    ~id:"operation.tx_rollup_invalid_transaction_amount"
-    ~title:"Transaction amount to a transaction rollup must be zero"
+    ~id:"operation.tx_rollup_invalid_transaction_ticket_amount"
+    ~title:"Amount of transferred ticket is too high"
     ~description:
-      "Because transaction rollups are outside of the delegation mechanism of \
-       Tezos, they cannot own Tez, and therefore transactions targeting a \
-       transaction rollup must have its amount field set to zero."
+      "The ticket amount of a rollup transaction must fit in a signed 64-bit \
+       integer."
     ~pp:(fun ppf () ->
-      Format.fprintf
-        ppf
-        "Transaction amount to a transaction rollup must be zero.")
+      Format.fprintf ppf "Amount of transferred ticket is too high.")
     Data_encoding.unit
-    (function Tx_rollup_invalid_transaction_amount -> Some () | _ -> None)
-    (fun () -> Tx_rollup_invalid_transaction_amount) ;
+    (function
+      | Tx_rollup_invalid_transaction_ticket_amount -> Some () | _ -> None)
+    (fun () -> Tx_rollup_invalid_transaction_ticket_amount) ;
 
   register_error_kind
     `Permanent
@@ -1013,7 +1011,9 @@ let ex_ticket_size :
 let apply_transaction_to_tx_rollup ~ctxt ~parameters_ty ~parameters ~amount
     ~entrypoint ~payer ~dst_rollup ~since =
   assert_tx_rollup_feature_enabled ctxt >>=? fun () ->
-  fail_unless Tez.(amount = zero) Tx_rollup_invalid_transaction_amount
+  fail_unless
+    Tez.(amount = zero)
+    Script_interpreter_defs.Tx_rollup_invalid_transaction_amount
   >>=? fun () ->
   if Entrypoint.(entrypoint = Tx_rollup.deposit_entrypoint) then
     (* If the ticket deposit fails on L2 for some reason
@@ -1038,7 +1038,8 @@ let apply_transaction_to_tx_rollup ~ctxt ~parameters_ty ~parameters ~amount
     Ticket_balance_key.of_ex_token ctxt ~owner:(Tx_rollup dst_rollup) ex_token
     >>=? fun (ticket_hash, ctxt) ->
     Option.value_e
-      ~error:(Error_monad.trace_of_error Tx_rollup_invalid_transaction_amount)
+      ~error:
+        (Error_monad.trace_of_error Tx_rollup_invalid_transaction_ticket_amount)
       (Option.bind
          (Script_int.to_int64 ticket_amount)
          Tx_rollup_l2_qty.of_int64)
diff --git a/src/proto_alpha/lib_protocol/apply.mli b/src/proto_alpha/lib_protocol/apply.mli
index cc6d8139ccf8..616e11196922 100644
--- a/src/proto_alpha/lib_protocol/apply.mli
+++ b/src/proto_alpha/lib_protocol/apply.mli
@@ -40,7 +40,7 @@ type error +=
   | Internal_operation_replay of packed_internal_contents
   | Gas_quota_exceeded_init_deserialize
   | Tx_rollup_feature_disabled
-  | Tx_rollup_invalid_transaction_amount
+  | Tx_rollup_invalid_transaction_ticket_amount
   | Tx_rollup_non_internal_transaction
   | Sc_rollup_feature_disabled
   | Inconsistent_counters
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index c03103c0492e..08aa4fefd6d2 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -38,6 +38,25 @@ open Script_typed_ir
 open Script_ir_translator
 open Local_gas_counter
 
+type error += Tx_rollup_invalid_transaction_amount
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"operation.tx_rollup_invalid_transaction_amount"
+    ~title:"Transaction amount to a transaction rollup must be zero"
+    ~description:
+      "Because transaction rollups are outside of the delegation mechanism of \
+       Tezos, they cannot own Tez, and therefore transactions targeting a \
+       transaction rollup must have its amount field set to zero."
+    ~pp:(fun ppf () ->
+      Format.pp_print_string
+        ppf
+        "Transaction amount to a transaction rollup must be zero.")
+    Data_encoding.unit
+    (function Tx_rollup_invalid_transaction_amount -> Some () | _ -> None)
+    (fun () -> Tx_rollup_invalid_transaction_amount)
+
 (*
 
    Computing the cost of Michelson instructions
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 f95619700510..0c907b1a85e0 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
@@ -1398,7 +1398,8 @@ let test_valid_deposit_invalid_amount () =
     i
     op
     ~expect_failure:
-      (check_proto_error Apply.Tx_rollup_invalid_transaction_amount)
+      (check_proto_error
+         Script_interpreter_defs.Tx_rollup_invalid_transaction_amount)
   >>=? fun _ -> return_unit
 
 (** [test_deposit_too_many_tickets] checks that a deposit of
@@ -1420,7 +1421,7 @@ let test_deposit_too_many_tickets () =
     i
     operation
     ~expect_failure:
-      (check_proto_error Apply.Tx_rollup_invalid_transaction_amount)
+      (check_proto_error Apply.Tx_rollup_invalid_transaction_ticket_amount)
   >>=? fun i ->
   ignore i ;
   return_unit
-- 
GitLab


From 9d300efe01abae296650cdaf5d36c72bc638c428 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 14 Apr 2022 10:43:35 +0200
Subject: [PATCH 11/13] Proto: remove amount field of Transaction_to_tx_rollup

---
 src/proto_alpha/lib_protocol/apply.ml                | 10 ++--------
 src/proto_alpha/lib_protocol/apply_results.ml        |  7 ++++---
 .../lib_protocol/script_interpreter_defs.ml          |  3 ++-
 src/proto_alpha/lib_protocol/script_typed_ir.ml      |  1 -
 src/proto_alpha/lib_protocol/script_typed_ir.mli     |  1 -
 .../michelson/test_ticket_operations_diff.ml         |  1 -
 .../test/integration/operations/test_tx_rollup.ml    | 12 +++++++++++-
 .../lib_protocol/ticket_operations_diff.ml           |  1 -
 8 files changed, 19 insertions(+), 17 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index ac5e452505f2..819f72161aa9 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1008,13 +1008,9 @@ let ex_ticket_size :
   (* gas *)
   return (ctxt, ty_size + val_size)
 
-let apply_transaction_to_tx_rollup ~ctxt ~parameters_ty ~parameters ~amount
-    ~entrypoint ~payer ~dst_rollup ~since =
+let apply_transaction_to_tx_rollup ~ctxt ~parameters_ty ~parameters ~entrypoint
+    ~payer ~dst_rollup ~since =
   assert_tx_rollup_feature_enabled ctxt >>=? fun () ->
-  fail_unless
-    Tez.(amount = zero)
-    Script_interpreter_defs.Tx_rollup_invalid_transaction_amount
-  >>=? fun () ->
   if Entrypoint.(entrypoint = Tx_rollup.deposit_entrypoint) then
     (* If the ticket deposit fails on L2 for some reason
        (e.g. [Balance_overflow] in the recipient), then it is
@@ -1209,7 +1205,6 @@ let apply_internal_manager_operation_content :
   | Transaction_to_tx_rollup
       {
         destination;
-        amount;
         entrypoint;
         unparsed_parameters = _;
         parameters_ty;
@@ -1219,7 +1214,6 @@ let apply_internal_manager_operation_content :
         ~ctxt
         ~parameters_ty
         ~parameters
-        ~amount
         ~entrypoint
         ~payer
         ~dst_rollup:destination
diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml
index b6e140906892..a3fd7251fe53 100644
--- a/src/proto_alpha/lib_protocol/apply_results.ml
+++ b/src/proto_alpha/lib_protocol/apply_results.ml
@@ -96,12 +96,13 @@ let contents_of_internal_operation (type kind)
             entrypoint;
             parameters = Script.lazy_expr unparsed_parameters;
           }
-    | Transaction_to_tx_rollup
-        {destination; amount; entrypoint; unparsed_parameters; _} ->
+    | Transaction_to_tx_rollup {destination; entrypoint; unparsed_parameters; _}
+      ->
         Transaction
           {
             destination = Tx_rollup destination;
-            amount;
+            (* Dummy amount used for the external untyped view of internal transactions *)
+            amount = Tez.zero;
             entrypoint;
             parameters = Script.lazy_expr unparsed_parameters;
           }
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 08aa4fefd6d2..2bd7564ba76b 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -550,6 +550,8 @@ let make_transaction_to_tx_rollup (type t tc) ctxt ~destination ~amount
      rollup to inject the exact type of the entrypoint as used by
      the smart contract. This allows the transaction rollup to extract
      the type of the ticket. *)
+  error_unless Tez.(amount = zero) Tx_rollup_invalid_transaction_amount
+  >>?= fun () ->
   match parameters_ty with
   | Pair_t (Ticket_t (tp, _), _, _, _) ->
       unparse_data ctxt Optimized parameters_ty parameters
@@ -568,7 +570,6 @@ let make_transaction_to_tx_rollup (type t tc) ctxt ~destination ~amount
           ( Transaction_to_tx_rollup
               {
                 destination;
-                amount;
                 entrypoint;
                 parameters_ty;
                 parameters;
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index bdd2bc589c82..184634b3d8c0 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -1379,7 +1379,6 @@ and 'kind manager_operation =
       -> Kind.transaction manager_operation
   | Transaction_to_tx_rollup : {
       destination : Tx_rollup.t;
-      amount : Tez.tez;
       entrypoint : Entrypoint.t;
       parameters_ty : ('a, _) ty;
       parameters : 'a;
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index f8890abecd77..67bb0c5f5c35 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -1512,7 +1512,6 @@ and 'kind manager_operation =
       -> Kind.transaction manager_operation
   | Transaction_to_tx_rollup : {
       destination : Tx_rollup.t;
-      amount : Tez.tez;
       entrypoint : Entrypoint.t;
       parameters_ty : ('a, _) ty;
       parameters : 'a;
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
index 403a63f1bdcc..f28333e701c0 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
@@ -326,7 +326,6 @@ let transfer_operation_to_tx_rollup ~incr ~src ~parameters_ty ~parameters
           operation =
             Transaction_to_tx_rollup
               {
-                amount = Tez.zero;
                 unparsed_parameters = Micheline.strip_locations params_node;
                 entrypoint = Tx_rollup.deposit_entrypoint;
                 destination = tx_rollup;
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 0c907b1a85e0..e5b8eb330795 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
@@ -56,6 +56,16 @@ let check_proto_error_f f t =
     equals [e]. *)
 let check_proto_error e t = check_proto_error_f (( = ) e) t
 
+(** [check_runtime_error e t] checks that the first error of [t] is the
+    Michelson runtime error and the second one equals [e]. *)
+let check_runtime_error e = function
+  | Environment.Ecoproto_error (Script_interpreter.Runtime_contract_error _)
+    :: Environment.Ecoproto_error second :: _
+    when second = e ->
+      Assert.test_error_encodings e ;
+      return_unit
+  | t -> failwith "Expected runtime error, got: %a" Error_monad.pp_print_trace t
+
 (** [test_disable_feature_flag] try to originate a tx rollup with the feature
     flag is deactivated and check it fails *)
 let test_disable_feature_flag () =
@@ -1398,7 +1408,7 @@ let test_valid_deposit_invalid_amount () =
     i
     op
     ~expect_failure:
-      (check_proto_error
+      (check_runtime_error
          Script_interpreter_defs.Tx_rollup_invalid_transaction_amount)
   >>=? fun _ -> return_unit
 
diff --git a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
index a1160796ec60..9e876748a938 100644
--- a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
@@ -260,7 +260,6 @@ let tickets_of_operation ctxt
         destination;
         unparsed_parameters = _;
         entrypoint;
-        amount = _;
         parameters_ty;
         parameters;
       } ->
-- 
GitLab


From 70d77dd25a6e9a3c1a60f41a1698da1d8f9247fa Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 14 Apr 2022 11:28:17 +0200
Subject: [PATCH 12/13] Proto: remove entrypoint field of
 Transaction_to_tx_rollup

---
 src/proto_alpha/lib_protocol/apply.ml         | 127 ++++++++----------
 src/proto_alpha/lib_protocol/apply_results.ml |   5 +-
 .../lib_protocol/script_interpreter_defs.ml   |  12 +-
 .../lib_protocol/script_typed_ir.ml           |   1 -
 .../lib_protocol/script_typed_ir.mli          |   1 -
 .../michelson/test_ticket_operations_diff.ml  |   1 -
 .../lib_protocol/ticket_operations_diff.ml    |  28 ++--
 7 files changed, 75 insertions(+), 100 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 819f72161aa9..115afe06eda1 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1008,68 +1008,64 @@ let ex_ticket_size :
   (* gas *)
   return (ctxt, ty_size + val_size)
 
-let apply_transaction_to_tx_rollup ~ctxt ~parameters_ty ~parameters ~entrypoint
-    ~payer ~dst_rollup ~since =
+let apply_transaction_to_tx_rollup ~ctxt ~parameters_ty ~parameters ~payer
+    ~dst_rollup ~since =
   assert_tx_rollup_feature_enabled ctxt >>=? fun () ->
-  if Entrypoint.(entrypoint = Tx_rollup.deposit_entrypoint) then
-    (* If the ticket deposit fails on L2 for some reason
-       (e.g. [Balance_overflow] in the recipient), then it is
-       returned to [payer]. As [payer] is implicit, it cannot own
-       tickets directly. Therefore, erroneous deposits are
-       returned using the L2 withdrawal mechanism: a failing
-       deposit emits a withdrawal that can be executed by
-       [payer]. *)
-    Tx_rollup_parameters.get_deposit_parameters parameters_ty parameters
-    >>?= fun {ex_ticket; l2_destination} ->
-    ex_ticket_size ctxt ex_ticket >>=? fun (ctxt, ticket_size) ->
-    let limit = Constants.tx_rollup_max_ticket_payload_size ctxt in
-    fail_when
-      Compare.Int.(ticket_size > limit)
-      (Tx_rollup_errors_repr.Ticket_payload_size_limit_exceeded
-         {payload_size = ticket_size; limit})
-    >>=? fun () ->
-    let (ex_token, ticket_amount) =
-      Ticket_token.token_and_amount_of_ex_ticket ex_ticket
-    in
-    Ticket_balance_key.of_ex_token ctxt ~owner:(Tx_rollup dst_rollup) ex_token
-    >>=? fun (ticket_hash, ctxt) ->
-    Option.value_e
-      ~error:
-        (Error_monad.trace_of_error Tx_rollup_invalid_transaction_ticket_amount)
-      (Option.bind
-         (Script_int.to_int64 ticket_amount)
-         Tx_rollup_l2_qty.of_int64)
-    >>?= fun ticket_amount ->
-    error_when
-      Tx_rollup_l2_qty.(ticket_amount <= zero)
-      Forbidden_zero_ticket_quantity
-    >>?= fun () ->
-    let (deposit, message_size) =
-      Tx_rollup_message.make_deposit
-        payer
-        l2_destination
-        ticket_hash
-        ticket_amount
-    in
-    Tx_rollup_state.get ctxt dst_rollup >>=? fun (ctxt, state) ->
-    Tx_rollup_state.burn_cost ~limit:None state message_size >>?= fun cost ->
-    Token.transfer ctxt (`Contract (Contract.Implicit payer)) `Burned cost
-    >>=? fun (ctxt, balance_updates) ->
-    Tx_rollup_inbox.append_message ctxt dst_rollup state deposit
-    >>=? fun (ctxt, state, paid_storage_size_diff) ->
-    Tx_rollup_state.update ctxt dst_rollup state >>=? fun ctxt ->
-    let result =
-      Transaction_result
-        (Transaction_to_tx_rollup_result
-           {
-             balance_updates;
-             consumed_gas = Gas.consumed ~since ~until:ctxt;
-             ticket_hash;
-             paid_storage_size_diff;
-           })
-    in
-    return (ctxt, result, [])
-  else fail (Script_tc_errors.No_such_entrypoint entrypoint)
+  (* If the ticket deposit fails on L2 for some reason
+     (e.g. [Balance_overflow] in the recipient), then it is
+     returned to [payer]. As [payer] is implicit, it cannot own
+     tickets directly. Therefore, erroneous deposits are
+     returned using the L2 withdrawal mechanism: a failing
+     deposit emits a withdrawal that can be executed by
+     [payer]. *)
+  Tx_rollup_parameters.get_deposit_parameters parameters_ty parameters
+  >>?= fun {ex_ticket; l2_destination} ->
+  ex_ticket_size ctxt ex_ticket >>=? fun (ctxt, ticket_size) ->
+  let limit = Constants.tx_rollup_max_ticket_payload_size ctxt in
+  fail_when
+    Compare.Int.(ticket_size > limit)
+    (Tx_rollup_errors_repr.Ticket_payload_size_limit_exceeded
+       {payload_size = ticket_size; limit})
+  >>=? fun () ->
+  let (ex_token, ticket_amount) =
+    Ticket_token.token_and_amount_of_ex_ticket ex_ticket
+  in
+  Ticket_balance_key.of_ex_token ctxt ~owner:(Tx_rollup dst_rollup) ex_token
+  >>=? fun (ticket_hash, ctxt) ->
+  Option.value_e
+    ~error:
+      (Error_monad.trace_of_error Tx_rollup_invalid_transaction_ticket_amount)
+    (Option.bind (Script_int.to_int64 ticket_amount) Tx_rollup_l2_qty.of_int64)
+  >>?= fun ticket_amount ->
+  error_when
+    Tx_rollup_l2_qty.(ticket_amount <= zero)
+    Forbidden_zero_ticket_quantity
+  >>?= fun () ->
+  let (deposit, message_size) =
+    Tx_rollup_message.make_deposit
+      payer
+      l2_destination
+      ticket_hash
+      ticket_amount
+  in
+  Tx_rollup_state.get ctxt dst_rollup >>=? fun (ctxt, state) ->
+  Tx_rollup_state.burn_cost ~limit:None state message_size >>?= fun cost ->
+  Token.transfer ctxt (`Contract (Contract.Implicit payer)) `Burned cost
+  >>=? fun (ctxt, balance_updates) ->
+  Tx_rollup_inbox.append_message ctxt dst_rollup state deposit
+  >>=? fun (ctxt, state, paid_storage_size_diff) ->
+  Tx_rollup_state.update ctxt dst_rollup state >>=? fun ctxt ->
+  let result =
+    Transaction_result
+      (Transaction_to_tx_rollup_result
+         {
+           balance_updates;
+           consumed_gas = Gas.consumed ~since ~until:ctxt;
+           ticket_hash;
+           paid_storage_size_diff;
+         })
+  in
+  return (ctxt, result, [])
 
 let apply_origination ~ctxt ~storage_type ~storage ~unparsed_code ~contract
     ~delegate ~source ~credit ~before_operation =
@@ -1203,18 +1199,11 @@ let apply_internal_manager_operation_content :
         (manager_result : kind successful_manager_operation_result),
         operations )
   | Transaction_to_tx_rollup
-      {
-        destination;
-        entrypoint;
-        unparsed_parameters = _;
-        parameters_ty;
-        parameters;
-      } ->
+      {destination; unparsed_parameters = _; parameters_ty; parameters} ->
       apply_transaction_to_tx_rollup
         ~ctxt
         ~parameters_ty
         ~parameters
-        ~entrypoint
         ~payer
         ~dst_rollup:destination
         ~since:before_operation
diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml
index a3fd7251fe53..68a004b60014 100644
--- a/src/proto_alpha/lib_protocol/apply_results.ml
+++ b/src/proto_alpha/lib_protocol/apply_results.ml
@@ -96,14 +96,13 @@ let contents_of_internal_operation (type kind)
             entrypoint;
             parameters = Script.lazy_expr unparsed_parameters;
           }
-    | Transaction_to_tx_rollup {destination; entrypoint; unparsed_parameters; _}
-      ->
+    | Transaction_to_tx_rollup {destination; unparsed_parameters; _} ->
         Transaction
           {
             destination = Tx_rollup destination;
             (* Dummy amount used for the external untyped view of internal transactions *)
             amount = Tez.zero;
-            entrypoint;
+            entrypoint = Tx_rollup.deposit_entrypoint;
             parameters = Script.lazy_expr unparsed_parameters;
           }
     | Origination {origination; _} -> Origination origination
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 2bd7564ba76b..fb8ee79c9945 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -552,6 +552,10 @@ let make_transaction_to_tx_rollup (type t tc) ctxt ~destination ~amount
      the type of the ticket. *)
   error_unless Tez.(amount = zero) Tx_rollup_invalid_transaction_amount
   >>?= fun () ->
+  error_unless
+    Entrypoint.(entrypoint = Tx_rollup.deposit_entrypoint)
+    (Script_tc_errors.No_such_entrypoint entrypoint)
+  >>?= fun () ->
   match parameters_ty with
   | Pair_t (Ticket_t (tp, _), _, _, _) ->
       unparse_data ctxt Optimized parameters_ty parameters
@@ -568,13 +572,7 @@ let make_transaction_to_tx_rollup (type t tc) ctxt ~destination ~amount
             Micheline.strip_locations unparsed_parameters
           in
           ( Transaction_to_tx_rollup
-              {
-                destination;
-                entrypoint;
-                parameters_ty;
-                parameters;
-                unparsed_parameters;
-              },
+              {destination; parameters_ty; parameters; unparsed_parameters},
             ctxt ) )
   | _ ->
       (* TODO: https://gitlab.com/tezos/tezos/-/issues/2455
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 184634b3d8c0..5e6b8a25d58f 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -1379,7 +1379,6 @@ and 'kind manager_operation =
       -> Kind.transaction manager_operation
   | Transaction_to_tx_rollup : {
       destination : Tx_rollup.t;
-      entrypoint : Entrypoint.t;
       parameters_ty : ('a, _) ty;
       parameters : 'a;
       unparsed_parameters : Script.expr;
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 67bb0c5f5c35..0a89fdab7d0d 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -1512,7 +1512,6 @@ and 'kind manager_operation =
       -> Kind.transaction manager_operation
   | Transaction_to_tx_rollup : {
       destination : Tx_rollup.t;
-      entrypoint : Entrypoint.t;
       parameters_ty : ('a, _) ty;
       parameters : 'a;
       unparsed_parameters : Script.expr;
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
index f28333e701c0..1c1cbc5f5399 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
@@ -327,7 +327,6 @@ let transfer_operation_to_tx_rollup ~incr ~src ~parameters_ty ~parameters
             Transaction_to_tx_rollup
               {
                 unparsed_parameters = Micheline.strip_locations params_node;
-                entrypoint = Tx_rollup.deposit_entrypoint;
                 destination = tx_rollup;
                 parameters_ty;
                 parameters;
diff --git a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
index 9e876748a938..b3584e951cb2 100644
--- a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
@@ -256,24 +256,16 @@ let tickets_of_operation ctxt
         ~parameters_ty
         ~parameters
   | Transaction_to_tx_rollup
-      {
-        destination;
-        unparsed_parameters = _;
-        entrypoint;
-        parameters_ty;
-        parameters;
-      } ->
-      if Entrypoint.(entrypoint = Tx_rollup.deposit_entrypoint) then
-        Tx_rollup_parameters.get_deposit_parameters parameters_ty parameters
-        >>?= fun {ex_ticket; l2_destination = _} ->
-        return
-          ( Some
-              {
-                destination = Destination.Tx_rollup destination;
-                tickets = [ex_ticket];
-              },
-            ctxt )
-      else return (None, ctxt)
+      {destination; unparsed_parameters = _; parameters_ty; parameters} ->
+      Tx_rollup_parameters.get_deposit_parameters parameters_ty parameters
+      >>?= fun {ex_ticket; l2_destination = _} ->
+      return
+        ( Some
+            {
+              destination = Destination.Tx_rollup destination;
+              tickets = [ex_ticket];
+            },
+          ctxt )
   | Origination
       {
         origination = {delegate = _; script = _; credit = _};
-- 
GitLab


From 8a121f5319c9cf9bd1c54aa95c71fc4ba8bbba28 Mon Sep 17 00:00:00 2001
From: Joel Bjornson <joel.bjornson@trili.tech>
Date: Thu, 5 May 2022 14:23:13 +0200
Subject: [PATCH 13/13] Proto/Michelson: fix comment

---
 src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index fb8ee79c9945..1fe15e6e01cd 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -584,9 +584,9 @@ let make_transaction_to_tx_rollup (type t tc) ctxt ~destination ~amount
       assert false
 
 (* [transfer (ctxt, sc) gas tez parameters_ty parameters destination entrypoint]
-   creates an operation that transfers an amount of [tez] to
-   a contract determined by [(destination, entrypoint)]
-   instantiated with argument [parameters] of type [parameters_ty]. *)
+   creates an operation that transfers an amount of [tez] to a destination and
+   an entrypoint instantiated with argument [parameters] of type
+   [parameters_ty]. *)
 let transfer (ctxt, sc) gas amount location parameters_ty parameters
     (destination : Destination.t) entrypoint =
   let ctxt = update_context gas ctxt in
-- 
GitLab