From f5de0c3549b6e3e6e2f514794f9aaf1801e38347 Mon Sep 17 00:00:00 2001
From: Joel Bjornson <joel.bjornson@trili.tech>
Date: Wed, 15 Jun 2022 17:56:39 +0100
Subject: [PATCH 1/7] Proto: expose missing constants

---
 src/proto_alpha/lib_protocol/alpha_context.mli | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 6c6b84859fc5..c76b8e2c5d59 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -988,6 +988,10 @@ module Constants : sig
 
   val sc_rollup_max_lookahead_in_blocks : Raw_context.t -> int32
 
+  val sc_rollup_max_active_outbox_levels : context -> int32
+
+  val sc_rollup_max_outbox_messages_per_level : context -> int
+
   (** All constants: fixed and parametric *)
   type t = private {fixed : fixed; parametric : Parametric.t}
 
-- 
GitLab


From e0a4e32b56ad500820e8fa6a7438539598a99322 Mon Sep 17 00:00:00 2001
From: Joel Bjornson <joel.bjornson@trili.tech>
Date: Tue, 14 Jun 2022 17:46:30 +0100
Subject: [PATCH 2/7] Proto: remove unused fields

---
 .../lib_client/client_proto_context.ml        | 13 ++----
 .../lib_client/client_proto_context.mli       |  5 +--
 .../lib_client/operation_result.ml            | 20 ++-------
 .../client_proto_context_commands.ml          | 32 +++-----------
 .../lib_protocol/alpha_context.mli            |  5 +--
 src/proto_alpha/lib_protocol/apply.ml         | 16 ++-----
 .../lib_protocol/operation_repr.ml            | 44 +++----------------
 .../lib_protocol/operation_repr.mli           | 11 ++---
 .../lib_protocol/sc_rollup_operations.ml      |  3 +-
 .../lib_protocol/sc_rollup_operations.mli     |  5 +--
 .../lib_protocol/test/helpers/op.ml           | 11 +----
 .../lib_protocol/test/helpers/op.mli          |  5 +--
 .../integration/operations/test_sc_rollup.ml  |  5 +--
 .../precheck/manager_operation_helpers.ml     |  5 +--
 14 files changed, 35 insertions(+), 145 deletions(-)

diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml
index 0506cba88828..a914b3f76dd2 100644
--- a/src/proto_alpha/lib_client/client_proto_context.ml
+++ b/src/proto_alpha/lib_client/client_proto_context.ml
@@ -1270,8 +1270,8 @@ let sc_rollup_publish (cctxt : #full) ~chain ~block ?confirmations ?dry_run
 
 let sc_rollup_execute_outbox_message (cctxt : #full) ~chain ~block
     ?confirmations ?dry_run ?verbose_signing ?simulation ?fee ?gas_limit
-    ?storage_limit ?counter ~source ~rollup ~cemented_commitment ~outbox_level
-    ~message_index ~inclusion_proof ~message ~src_pk ~src_sk ~fee_parameter () =
+    ?storage_limit ?counter ~source ~rollup ~cemented_commitment ~output_proof
+    ~src_pk ~src_sk ~fee_parameter () =
   let op =
     Annotated_manager_operation.Single_manager
       (Injection.prepare_manager_operation
@@ -1279,14 +1279,7 @@ let sc_rollup_execute_outbox_message (cctxt : #full) ~chain ~block
          ~gas_limit:(Limit.of_option gas_limit)
          ~storage_limit:(Limit.of_option storage_limit)
          (Sc_rollup_execute_outbox_message
-            {
-              rollup;
-              cemented_commitment;
-              outbox_level;
-              message_index;
-              inclusion_proof;
-              message;
-            }))
+            {rollup; cemented_commitment; output_proof}))
   in
   Injection.inject_manager_operation
     cctxt
diff --git a/src/proto_alpha/lib_client/client_proto_context.mli b/src/proto_alpha/lib_client/client_proto_context.mli
index 10f5274df616..4ed6a612bb33 100644
--- a/src/proto_alpha/lib_client/client_proto_context.mli
+++ b/src/proto_alpha/lib_client/client_proto_context.mli
@@ -781,10 +781,7 @@ val sc_rollup_execute_outbox_message :
   source:public_key_hash ->
   rollup:Sc_rollup.t ->
   cemented_commitment:Sc_rollup.Commitment.Hash.t ->
-  outbox_level:Raw_level.t ->
-  message_index:int ->
-  inclusion_proof:string ->
-  message:string ->
+  output_proof:string ->
   src_pk:public_key ->
   src_sk:Client_keys.sk_uri ->
   fee_parameter:Injection.fee_parameter ->
diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml
index cfaf5c7c4da6..b46390cce1f8 100644
--- a/src/proto_alpha/lib_client/operation_result.ml
+++ b/src/proto_alpha/lib_client/operation_result.ml
@@ -307,15 +307,8 @@ let pp_manager_operation_content (type kind) source ppf
         bob
         Sc_rollup.Address.pp
         rollup
-  | Sc_rollup_execute_outbox_message
-      {
-        rollup;
-        cemented_commitment;
-        outbox_level;
-        message_index;
-        inclusion_proof;
-        message;
-      } ->
+  | Sc_rollup_execute_outbox_message {rollup; cemented_commitment; output_proof}
+    ->
       (* TODO #3125
          Improve pretty-printing of this content and sc operations above.
          Should avoid printing on a single line and use indentation.
@@ -323,17 +316,12 @@ let pp_manager_operation_content (type kind) source ppf
       Format.fprintf
         ppf
         "Execute the outbox message of the smart contract rollup at address \
-         %a, with cemented commit %a, outbox level %a, message index %d, \
-         inclusion proof %s and message %s"
+         %a, with cemented commit %a and output proof %s"
         Sc_rollup.Address.pp
         rollup
         Sc_rollup.Commitment.Hash.pp
         cemented_commitment
-        Raw_level.pp
-        outbox_level
-        message_index
-        inclusion_proof
-        message
+        output_proof
   | Sc_rollup_recover_bond {sc_rollup} ->
       Format.fprintf
         ppf
diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
index 2cd9e2f8ba62..da6a9c4f9680 100644
--- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
+++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
@@ -2841,25 +2841,11 @@ let commands_rw () =
            ~name:"cemented commitment"
            ~desc:"The hash of the cemented commitment of the rollup."
            Sc_rollup_params.commitment_hash_parameter
-      @@ prefixes ["for"; "the"; "outbox"; "level"]
+      @@ prefixes ["and"; "output"; "proof"]
       @@ param
-           ~name:"outbox level"
-           ~desc:"The level of the rollup's outbox."
-           raw_level_parameter
-      @@ prefixes ["for"; "the"; "message"; "at"; "index"]
-      @@ param
-           ~name:"message index"
-           ~desc:"The index of the rollup's outbox containing the message."
-           non_negative_parameter
-      @@ prefixes ["and"; "inclusion"; "proof"]
-      @@ param
-           ~name:"inclusion proof"
-           ~desc:"The inclusion proof for the message."
-           Sc_rollup_params.unchecked_payload_parameter
-      @@ prefixes ["and"; "message"]
-      @@ param
-           ~name:"message"
-           ~desc:"The message to be executed."
+           ~name:"output proof"
+           ~desc:
+             "The output proof containing the outbox level, index and message."
            Sc_rollup_params.unchecked_payload_parameter
       @@ stop)
       (fun ( fee,
@@ -2872,10 +2858,7 @@ let commands_rw () =
            rollup
            source
            cemented_commitment
-           outbox_level
-           message_index
-           inclusion_proof
-           message
+           output_proof
            cctxt ->
         (match source with
         | Originated _ ->
@@ -2899,10 +2882,7 @@ let commands_rw () =
           ~source
           ~rollup
           ~cemented_commitment
-          ~outbox_level
-          ~message_index
-          ~inclusion_proof
-          ~message
+          ~output_proof
           ~src_pk
           ~src_sk
           ~fee_parameter
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index c76b8e2c5d59..cd88fc05fc92 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -3802,10 +3802,7 @@ and _ manager_operation =
   | Sc_rollup_execute_outbox_message : {
       rollup : Sc_rollup.t;
       cemented_commitment : Sc_rollup.Commitment.Hash.t;
-      outbox_level : Raw_level.t;
-      message_index : int;
-      inclusion_proof : string;
-      message : string;
+      output_proof : string;
     }
       -> Kind.sc_rollup_execute_outbox_message manager_operation
   | Sc_rollup_recover_bond : {
diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 8fbaf8d330cc..06f0a324562e 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1843,23 +1843,13 @@ let apply_external_manager_operation_content :
         Sc_rollup_timeout_result {status; consumed_gas; balance_updates}
       in
       return (ctxt, result, [])
-  | Sc_rollup_execute_outbox_message
-      {
-        rollup;
-        cemented_commitment;
-        outbox_level;
-        message_index;
-        inclusion_proof;
-        message;
-      } ->
+  | Sc_rollup_execute_outbox_message {rollup; cemented_commitment; output_proof}
+    ->
       Sc_rollup_operations.execute_outbox_message
         ctxt
         rollup
         cemented_commitment
-        ~outbox_level
-        ~message_index
-        ~inclusion_proof
-        ~message
+        ~output_proof
       >>=? fun _ctxt ->
       failwith
         "Sc_rollup_execute_outbox_message operation is not yet supported."
diff --git a/src/proto_alpha/lib_protocol/operation_repr.ml b/src/proto_alpha/lib_protocol/operation_repr.ml
index 73dfe3d17d86..6e1d211ae0c7 100644
--- a/src/proto_alpha/lib_protocol/operation_repr.ml
+++ b/src/proto_alpha/lib_protocol/operation_repr.ml
@@ -434,10 +434,7 @@ and _ manager_operation =
   | Sc_rollup_execute_outbox_message : {
       rollup : Sc_rollup_repr.t;
       cemented_commitment : Sc_rollup_commitment_repr.Hash.t;
-      outbox_level : Raw_level_repr.t;
-      message_index : int;
-      inclusion_proof : string;
-      message : string;
+      output_proof : string;
     }
       -> Kind.sc_rollup_execute_outbox_message manager_operation
   | Sc_rollup_recover_bond : {
@@ -1119,15 +1116,12 @@ module Encoding = struct
           tag = sc_rollup_execute_outbox_message_tag;
           name = "sc_rollup_execute_outbox_message";
           encoding =
-            obj6
+            obj3
               (req "rollup" Sc_rollup_repr.encoding)
               (req
                  "cemented_commitment"
                  Sc_rollup_commitment_repr.Hash.encoding)
-              (req "outbox_level" Raw_level_repr.encoding)
-              (req "message_index" Data_encoding.int31)
-              (req "inclusion proof" Data_encoding.string)
-              (req "message" Data_encoding.string);
+              (req "output_proof" Data_encoding.string);
           select =
             (function
             | Manager (Sc_rollup_execute_outbox_message _ as op) -> Some op
@@ -1135,36 +1129,12 @@ module Encoding = struct
           proj =
             (function
             | Sc_rollup_execute_outbox_message
-                {
-                  rollup;
-                  cemented_commitment;
-                  outbox_level;
-                  message_index;
-                  inclusion_proof;
-                  message;
-                } ->
-                ( rollup,
-                  cemented_commitment,
-                  outbox_level,
-                  message_index,
-                  inclusion_proof,
-                  message ));
+                {rollup; cemented_commitment; output_proof} ->
+                (rollup, cemented_commitment, output_proof));
           inj =
-            (fun ( rollup,
-                   cemented_commitment,
-                   outbox_level,
-                   message_index,
-                   inclusion_proof,
-                   message ) ->
+            (fun (rollup, cemented_commitment, output_proof) ->
               Sc_rollup_execute_outbox_message
-                {
-                  rollup;
-                  cemented_commitment;
-                  outbox_level;
-                  message_index;
-                  inclusion_proof;
-                  message;
-                });
+                {rollup; cemented_commitment; output_proof});
         }
 
     let[@coq_axiom_with_reason "gadt"] sc_rollup_recover_bond_case =
diff --git a/src/proto_alpha/lib_protocol/operation_repr.mli b/src/proto_alpha/lib_protocol/operation_repr.mli
index 422f7a5596f6..b6a429197737 100644
--- a/src/proto_alpha/lib_protocol/operation_repr.mli
+++ b/src/proto_alpha/lib_protocol/operation_repr.mli
@@ -503,14 +503,9 @@ and _ manager_operation =
       rollup : Sc_rollup_repr.t;  (** The smart-contract rollup. *)
       cemented_commitment : Sc_rollup_commitment_repr.Hash.t;
           (** The hash of the last cemented commitment that the proof refers to. *)
-      outbox_level : Raw_level_repr.t;
-          (** The level of the outbox containing transaction batch message. *)
-      message_index : int;
-          (** The index of the message in the outbox at that level. *)
-      inclusion_proof : string;
-          (** A proof that the message is included in the outbox. *)
-      message : string;
-          (** The bytes corresponding to a serialized batch of transactions. *)
+      output_proof : string;
+          (** A message along with a proof that it is included in the outbox
+              at a given outbox level and message index.*)
     }
       -> Kind.sc_rollup_execute_outbox_message manager_operation
   | Sc_rollup_recover_bond : {
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
index 74d469570a15..a8ddd809fdca 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
@@ -155,8 +155,7 @@ let originate ctxt ~kind ~boot_sector ~parameters_ty =
   in
   ({address; size}, ctxt)
 
-let execute_outbox_message _ctx _rollup _last_cemented_commitment
-    ~outbox_level:_ ~message_index:_ ~inclusion_proof:_ ~message:_ =
+let execute_outbox_message _ctx _rollup _cemented_commitment ~output_proof:_ =
   (* TODO: 3106
      Implement business logic.
      Involves validate inclusion proofs, transferring tickets  and outputting
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.mli b/src/proto_alpha/lib_protocol/sc_rollup_operations.mli
index 52ba55d8d162..885da1e0fe90 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_operations.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.mli
@@ -45,8 +45,5 @@ val execute_outbox_message :
   context ->
   Sc_rollup.t ->
   Sc_rollup.Commitment.Hash.t ->
-  outbox_level:Raw_level.t ->
-  message_index:int ->
-  inclusion_proof:string ->
-  message:string ->
+  output_proof:string ->
   context tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.ml b/src/proto_alpha/lib_protocol/test/helpers/op.ml
index b0a4f357151b..1d80225e91e0 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/op.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/op.ml
@@ -810,7 +810,7 @@ let sc_rollup_cement ?force_reveal ?counter ?fee ?gas_limit ?storage_limit ctxt
 
 let sc_rollup_execute_outbox_message ?counter ?fee ?gas_limit ?storage_limit
     ?force_reveal ctxt (src : Contract.t) rollup cemented_commitment
-    ~outbox_level ~message_index ~inclusion_proof ~message =
+    ~output_proof =
   manager_operation
     ?force_reveal
     ?counter
@@ -820,14 +820,7 @@ let sc_rollup_execute_outbox_message ?counter ?fee ?gas_limit ?storage_limit
     ~source:src
     ctxt
     (Sc_rollup_execute_outbox_message
-       {
-         rollup;
-         cemented_commitment;
-         outbox_level;
-         message_index;
-         inclusion_proof;
-         message;
-       })
+       {rollup; cemented_commitment; output_proof})
   >>=? fun to_sign_op ->
   Context.Contract.manager ctxt src >|=? fun account ->
   sign account.sk ctxt to_sign_op
diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.mli b/src/proto_alpha/lib_protocol/test/helpers/op.mli
index d7e61c96028c..cfe438b5fdd8 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/op.mli
+++ b/src/proto_alpha/lib_protocol/test/helpers/op.mli
@@ -566,10 +566,7 @@ val sc_rollup_execute_outbox_message :
   Contract.t ->
   Sc_rollup.t ->
   Sc_rollup.Commitment.Hash.t ->
-  outbox_level:Raw_level.t ->
-  message_index:int ->
-  inclusion_proof:string ->
-  message:string ->
+  output_proof:string ->
   (packed_operation, tztrace) result Lwt.t
 
 (** [sc_rollup_recover_bond ctxt source sc_rollup] returns a commitment bond. *)
diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml
index 2d4e228a9ce5..6d2f064c7df4 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml
@@ -492,10 +492,7 @@ let test_atomic_batch_fails () =
       contract
       rollup
       hash
-      ~outbox_level:(Raw_level.of_int32_exn 0l)
-      ~message_index:0
-      ~inclusion_proof:"xyz"
-      ~message:"xyz"
+      ~output_proof:"xyz"
   in
   let expect_apply_failure = function
     | Environment.Ecoproto_error
diff --git a/src/proto_alpha/lib_protocol/test/integration/precheck/manager_operation_helpers.ml b/src/proto_alpha/lib_protocol/test/integration/precheck/manager_operation_helpers.ml
index 12fd3916ef60..2e8f8b4bf0f6 100644
--- a/src/proto_alpha/lib_protocol/test/integration/precheck/manager_operation_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/precheck/manager_operation_helpers.ml
@@ -611,10 +611,7 @@ let mk_sc_rollup_execute_outbox_message ?counter ?fee ?gas_limit ?storage_limit
     source
     infos.sc_rollup
     (Sc_rollup.Commitment.hash sc_dummy_commitment)
-    ~outbox_level:Raw_level.root
-    ~message_index:0
-    ~inclusion_proof:""
-    ~message:""
+    ~output_proof:""
 
 let mk_sc_rollup_return_bond ?counter ?fee ?gas_limit ?storage_limit
     ?force_reveal ~source (infos : infos) =
-- 
GitLab


From 5b43c5e092f4508fd682847d52081bcd6ea86729 Mon Sep 17 00:00:00 2001
From: Joel Bjornson <joel.bjornson@trili.tech>
Date: Sun, 12 Jun 2022 19:08:38 +0100
Subject: [PATCH 3/7] Proto: outbox-of-repr

---
 .../sc_rollup_management_protocol.ml             | 10 ++--------
 .../sc_rollup_management_protocol.mli            | 16 ++++++++++------
 .../unit/test_sc_rollup_management_protocol.ml   |  7 ++++++-
 3 files changed, 18 insertions(+), 15 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml
index 6d00024d1fc8..47d64f42d46a 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.ml
@@ -120,15 +120,9 @@ let transactions_batch_of_internal ctxt transactions =
   in
   ({transactions}, ctxt)
 
-(** TODO: #2951
-    Carbonate [of_bytes] step.
-    Gas for decoding the binary values should be be accounted for.
-  *)
-let outbox_message_of_bytes ctxt bytes =
+let outbox_message_of_outbox_message_repr ctxt
+    (Sc_rollup.Outbox.Message.Atomic_transaction_batch {transactions}) =
   let open Lwt_tzresult_syntax in
-  let*? (Sc_rollup.Outbox.Message.Atomic_transaction_batch {transactions}) =
-    Sc_rollup.Outbox.Message.of_bytes bytes
-  in
   let+ ts, ctxt = transactions_batch_of_internal ctxt transactions in
   (Atomic_transaction_batch ts, ctxt)
 
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.mli b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.mli
index e5aa5a6d10ea..71f63d5db286 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_management_protocol.mli
@@ -56,7 +56,7 @@ type transaction = private
 (** A type representing a batch of Layer 2 to Layer 1 transactions. *)
 type atomic_transaction_batch = private {transactions : transaction list}
 
-(** A type representing messages from Layer 2 to Layer 1. *)
+(** A typed representation of {!Sc_rollup.Outbox.Message.t}. *)
 type outbox_message = private
   | Atomic_transaction_batch of atomic_transaction_batch
 
@@ -71,11 +71,15 @@ val make_internal_inbox_message :
   source:public_key_hash ->
   (Sc_rollup.Inbox.Message.t * context) tzresult Lwt.t
 
-(** [outbox_message_of_bytes ctxt bs] decodes an outbox message value from the
-    given bytes [bs]. The function involves parsing Micheline expressions to
-    typed values. *)
-val outbox_message_of_bytes :
-  context -> string -> (outbox_message * context) tzresult Lwt.t
+(** [outbox_message_of_outbox_message_repr ctxt msg] returns a typed version of
+    of the given outbox message [msg].
+
+    Fails with an [Sc_rollup_invalid_destination] error in case the parameters
+    don't match the type of the entrypoint and destination. *)
+val outbox_message_of_outbox_message_repr :
+  context ->
+  Sc_rollup.Outbox.Message.t ->
+  (outbox_message * context) tzresult Lwt.t
 
 (** Function for constructing and encoding {!inbox_message} and
     {!outbox_message} values. Since Layer 1 only ever consumes {!outbox_message}
diff --git a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_management_protocol.ml b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_management_protocol.ml
index 323090cbac1c..cb65d912c203 100644
--- a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_management_protocol.ml
+++ b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_management_protocol.ml
@@ -57,7 +57,12 @@ let check_encode_decode_outbox_message ctxt message =
     Environment.wrap_tzresult
     @@ Internal_for_tests.bytes_of_outbox_message message
   in
-  let* message', _ctxt = wrap @@ outbox_message_of_bytes ctxt bytes in
+  let* message', _ctxt =
+    let*? message_repr =
+      Environment.wrap_tzresult @@ Sc_rollup.Outbox.Message.of_bytes bytes
+    in
+    wrap @@ outbox_message_of_outbox_message_repr ctxt message_repr
+  in
   let*? bytes' =
     Environment.wrap_tzresult
     @@ Internal_for_tests.bytes_of_outbox_message message'
-- 
GitLab


From 8a0acfebf9b7f07013a736ce9a44026d7c08ed55 Mon Sep 17 00:00:00 2001
From: Joel Bjornson <joel.bjornson@trili.tech>
Date: Mon, 13 Jun 2022 22:29:52 +0100
Subject: [PATCH 4/7] Proto: rename cost function

---
 src/proto_alpha/lib_protocol/sc_rollup_costs.ml  | 15 ++++++++-------
 src/proto_alpha/lib_protocol/sc_rollup_costs.mli |  8 ++++----
 2 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/sc_rollup_costs.ml b/src/proto_alpha/lib_protocol/sc_rollup_costs.ml
index 88d2f3facd5d..0feafa9e7a8f 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_costs.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_costs.ml
@@ -85,11 +85,12 @@ let cost_serialize_internal_inbox_message
     expr_cost + Constants.cost_decoding_contract_optimized
     + Constants.cost_decoding_key_hash_optimized)
 
-(** We assume that the cost of deserializing an expression of [bytes_len] is
-    greater by a notch to the real cost here.
-
-    TODO: checks if the estimated cost is close to the more precise cost: To
-    check the real cost we could traverse the list of expression in the
-    deserialized output message. *)
-let cost_deserialize_outbox_message ~bytes_len =
+(** TODO: #3212
+    Confirm gas cost model.
+    We here assume that the cost of deserializing an expression of [bytes_len]
+    is proportional to deserializing a script expression of size [bytes_len].
+    This may not be the case and in particular, the cost depends on the specific
+    structure used for the PVM. We may thus need to split the cost function.
+  *)
+let cost_deserialize_output_proof ~bytes_len =
   Script_repr.deserialization_cost_estimated_from_bytes bytes_len
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_costs.mli b/src/proto_alpha/lib_protocol/sc_rollup_costs.mli
index 72d850c0d640..c5352abe0f60 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_costs.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_costs.mli
@@ -60,7 +60,7 @@ val cost_add_serialized_messages :
 val cost_serialize_internal_inbox_message :
   Sc_rollup_inbox_message_repr.internal_inbox_message -> Gas_limit_repr.cost
 
-(** [cost_deserialize_outbox_message ~bytes_len] is the cost of the
-    deserialization of an outbox message. It's equal to the cost of
-    deserializing script expression of size [bytes_len]. *)
-val cost_deserialize_outbox_message : bytes_len:int -> Gas_limit_repr.cost
+(** [cost_deserialize_output_proof ~bytes_len] is the cost of the
+    deserialization of an output proof. It's equal to the cost of deserializing
+    a script expression of size [bytes_len]. *)
+val cost_deserialize_output_proof : bytes_len:int -> Gas_limit_repr.cost
-- 
GitLab


From 38c534fcf9f10f429978b09d91510818b1e45bc1 Mon Sep 17 00:00:00 2001
From: Joel Bjornson <joel.bjornson@trili.tech>
Date: Tue, 31 May 2022 20:29:06 +0100
Subject: [PATCH 5/7] Proto: execute outbox message

---
 src/proto_alpha/lib_protocol/apply.ml         |  14 +-
 .../lib_protocol/sc_rollup_operations.ml      | 304 ++++++++++++++++--
 .../lib_protocol/sc_rollup_operations.mli     |  39 ++-
 3 files changed, 327 insertions(+), 30 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 06f0a324562e..5f4a7d5531d1 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1848,11 +1848,17 @@ let apply_external_manager_operation_content :
       Sc_rollup_operations.execute_outbox_message
         ctxt
         rollup
-        cemented_commitment
+        ~cemented_commitment
+        ~source
         ~output_proof
-      >>=? fun _ctxt ->
-      failwith
-        "Sc_rollup_execute_outbox_message operation is not yet supported."
+      >|=? fun ({Sc_rollup_operations.paid_storage_size_diff; operations}, ctxt)
+        ->
+      let consumed_gas = Gas.consumed ~since:ctxt_before_op ~until:ctxt in
+      let result =
+        Sc_rollup_execute_outbox_message_result
+          {paid_storage_size_diff; balance_updates = []; consumed_gas}
+      in
+      (ctxt, result, operations)
   | Sc_rollup_recover_bond {sc_rollup} ->
       Sc_rollup.Stake_storage.withdraw_stake ctxt sc_rollup source
       >>=? fun (ctxt, balance_updates) ->
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
index a8ddd809fdca..de7166c30e17 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
@@ -28,7 +28,14 @@ open Alpha_context
 
 type error +=
   | (* Permanent *) Sc_rollup_invalid_parameters_type
-  | (* Permanent *) Sc_rollup_invalid_atomic_batch
+  | (* Permanent *) Sc_rollup_invalid_last_cemented_commitment
+  | (* Permanent *) Sc_rollup_invalid_output_proof
+  | (* Permanent *) Sc_rollup_invalid_outbox_level
+
+type execute_outbox_message_result = {
+  paid_storage_size_diff : Z.t;
+  operations : Script_typed_ir.packed_internal_operation list;
+}
 
 let () =
   let description = "Invalid parameters type for rollup" in
@@ -41,18 +48,37 @@ let () =
     Data_encoding.unit
     (function Sc_rollup_invalid_parameters_type -> Some () | _ -> None)
     (fun () -> Sc_rollup_invalid_parameters_type) ;
-  let description =
-    "Smart-contract rollup atomic batch operation is not yet supported"
-  in
+  let description = "Invalid last-cemented-commitment" in
+  register_error_kind
+    `Permanent
+    ~id:"Sc_rollup_invalid_last_cemented_commitment"
+    ~title:description
+    ~description
+    ~pp:(fun ppf () -> Format.fprintf ppf "%s" description)
+    Data_encoding.empty
+    (function
+      | Sc_rollup_invalid_last_cemented_commitment -> Some () | _ -> None)
+    (fun () -> Sc_rollup_invalid_last_cemented_commitment) ;
+  let description = "Invalid output proof" in
+  register_error_kind
+    `Permanent
+    ~id:"Sc_rollup_invalid_output_proof"
+    ~title:description
+    ~description
+    ~pp:(fun ppf () -> Format.fprintf ppf "%s" description)
+    Data_encoding.empty
+    (function Sc_rollup_invalid_output_proof -> Some () | _ -> None)
+    (fun () -> Sc_rollup_invalid_output_proof) ;
+  let description = "Invalid outbox level" in
   register_error_kind
     `Permanent
-    ~id:"Sc_rollup_invalid_atomic_batch"
+    ~id:"Sc_rollup_invalid_outbox_level"
     ~title:description
     ~description
     ~pp:(fun ppf () -> Format.fprintf ppf "%s" description)
     Data_encoding.empty
-    (function Sc_rollup_invalid_atomic_batch -> Some () | _ -> None)
-    (fun () -> Sc_rollup_invalid_atomic_batch)
+    (function Sc_rollup_invalid_outbox_level -> Some () | _ -> None)
+    (fun () -> Sc_rollup_invalid_outbox_level)
 
 type origination_result = {address : Sc_rollup.Address.t; size : Z.t}
 
@@ -117,6 +143,17 @@ and validate_two_tys :
       (validate_ty [@ocaml.tailcall]) ty2 k)
 
 let validate_parameters_ty ctxt parameters_ty =
+  let open Tzresult_syntax in
+  let* ctxt =
+    Gas.consume
+      ctxt
+      (Sc_rollup_costs.is_valid_parameters_ty_cost
+         ~ty_size:Script_typed_ir.(ty_size parameters_ty |> Type_size.to_int))
+  in
+  let+ () = validate_ty parameters_ty ok in
+  ctxt
+
+let validate_untyped_parameters_ty ctxt parameters_ty =
   let open Tzresult_syntax in
   (* Parse the type and check that the entrypoints are well-formed. Using
      [parse_parameter_ty_and_entrypoints] restricts to [passable] types
@@ -129,14 +166,7 @@ let validate_parameters_ty ctxt parameters_ty =
       (Micheline.root parameters_ty)
   in
   (* Check that the type is valid for rollups. *)
-  let* ctxt =
-    Gas.consume
-      ctxt
-      (Sc_rollup_costs.is_valid_parameters_ty_cost
-         ~ty_size:Script_typed_ir.(ty_size arg_type |> Type_size.to_int))
-  in
-  let+ () = validate_ty arg_type ok in
-  ctxt
+  validate_parameters_ty ctxt arg_type
 
 let originate ctxt ~kind ~boot_sector ~parameters_ty =
   let open Lwt_tzresult_syntax in
@@ -148,17 +178,247 @@ let originate ctxt ~kind ~boot_sector ~parameters_ty =
         ctxt
         parameters_ty
     in
-    validate_parameters_ty ctxt parameters_ty
+    validate_untyped_parameters_ty ctxt parameters_ty
   in
   let+ address, size, ctxt =
     Sc_rollup.originate ctxt ~kind ~boot_sector ~parameters_ty
   in
   ({address; size}, ctxt)
 
-let execute_outbox_message _ctx _rollup _cemented_commitment ~output_proof:_ =
-  (* TODO: 3106
-     Implement business logic.
-     Involves validate inclusion proofs, transferring tickets  and outputting
-     operations etc.
+let to_transaction_operation ctxt ~source
+    (Sc_rollup_management_protocol.Transaction
+      {destination; entrypoint; parameters_ty; parameters; unparsed_parameters})
+    =
+  let open Tzresult_syntax in
+  let* ctxt, nonce = fresh_internal_nonce ctxt in
+  (* Validate the type of the parameters. Only types that can be transferred
+     from Layer 1 to Layer 2 are permitted.
+
+     In principal we could allow different types to be passed to the rollup and
+     from the rollup. In order to avoid confusion, and given that we don't
+     have any use case where they differ, we keep these sets identical.
+  *)
+  let* ctxt = validate_parameters_ty ctxt parameters_ty in
+  let operation =
+    Script_typed_ir.Transaction_to_contract
+      {
+        destination = Contract.Originated destination;
+        amount = Tez.zero;
+        entrypoint;
+        location = Micheline.dummy_location;
+        parameters_ty;
+        parameters;
+        unparsed_parameters;
+      }
+  in
+  return
+    ( Script_typed_ir.Internal_operation
+        {source = Contract.Implicit source; operation; nonce},
+      ctxt )
+
+(* Transfer some ticket-tokens from [source_destination] to [target_destination].
+   This operation fails in case the [source_destination]'s balance is lower than
+   amount. *)
+let transfer_ticket_token ctxt ~source_destination ~target_destination ~amount
+    ticket_token =
+  let open Lwt_tzresult_syntax in
+  let* source_key_hash, ctxt =
+    Ticket_balance_key.of_ex_token ctxt ~owner:source_destination ticket_token
+  in
+  let* target_key_hash, ctxt =
+    Ticket_balance_key.of_ex_token ctxt ~owner:target_destination ticket_token
+  in
+  let* source_storage_diff, ctxt =
+    Ticket_balance.adjust_balance ctxt source_key_hash ~delta:(Z.neg amount)
+  in
+  let* target_storage_diff, ctxt =
+    Ticket_balance.adjust_balance ctxt target_key_hash ~delta:amount
+  in
+  (* Adjust the recorded paid-for storage space for the ticket-table. *)
+  let* storage_diff_to_pay, ctxt =
+    Ticket_balance.adjust_storage_space
+      ctxt
+      ~storage_diff:(Z.add source_storage_diff target_storage_diff)
+  in
+  return (storage_diff_to_pay, ctxt)
+
+let transfer_ticket_tokens ctxt ~source_destination ~acc_storage_diff
+    {Ticket_operations_diff.ticket_token; total_amount = _; destinations} =
+  let open Lwt_tzresult_syntax in
+  List.fold_left_es
+    (fun (acc_storage_diff, ctxt) (target_destination, amount) ->
+      let* storage_diff, ctxt =
+        transfer_ticket_token
+          ctxt
+          ~source_destination
+          ~target_destination
+          ~amount:(Script_int.to_zint amount)
+          ticket_token
+      in
+      return (Z.(add acc_storage_diff storage_diff), ctxt))
+    (acc_storage_diff, ctxt)
+    destinations
+
+let validate_and_decode_output_proof ctxt ~cemented_commitment rollup
+    ~output_proof =
+  let open Lwt_tzresult_syntax in
+  (* Lookup the PVM of the rollup. *)
+  let* (module PVM : Sc_rollup.PVM.S) =
+    let* kind = Sc_rollup.kind ctxt rollup in
+    match kind with
+    | Some kind -> return (Sc_rollup.Kind.pvm_of kind)
+    | None -> fail (Sc_rollup.Errors.Sc_rollup_does_not_exist rollup)
+  in
+  let*? ctxt =
+    Gas.consume
+      ctxt
+      (Sc_rollup_costs.cost_deserialize_output_proof
+         ~bytes_len:(String.length output_proof))
+  in
+  let*? output_proof =
+    match
+      Data_encoding.Binary.of_string_opt PVM.output_proof_encoding output_proof
+    with
+    | Some x -> ok x
+    | None -> error Sc_rollup_invalid_output_proof
+  in
+  let output = PVM.output_of_output_proof output_proof in
+  (* Verify that the states match. *)
+  let* {Sc_rollup.Commitment.compressed_state; _}, ctxt =
+    Sc_rollup.Commitment.get_commitment ctxt rollup cemented_commitment
+  in
+  let* () =
+    let output_proof_state = PVM.state_of_output_proof output_proof in
+    fail_unless
+      Sc_rollup.State_hash.(output_proof_state = compressed_state)
+      Sc_rollup_invalid_output_proof
+  in
+  (* Verify that the proof is valid. *)
+  let* () =
+    let*! proof_is_valid = PVM.verify_output_proof output_proof in
+    fail_unless proof_is_valid Sc_rollup_invalid_output_proof
+  in
+  return (output, ctxt)
+
+let validate_outbox_level ctxt ~outbox_level ~lcc_level =
+  (* Check that outbox level is within the bounds of:
+       [min_level < outbox_level <= lcc_level]
+     Where
+       [min_level = lcc_level - max_active_levels]
+
+      This prevents the rollup from putting messages at a level that is greater
+      than its corresponding inbox-level. It also prevents execution
+      of messages that are older than the maximum number of active levels.
+  *)
+  let max_active_levels =
+    Int32.to_int (Constants.sc_rollup_max_active_outbox_levels ctxt)
+  in
+  let outbox_level_is_active =
+    let min_allowed_level =
+      Int32.sub (Raw_level.to_int32 lcc_level) (Int32.of_int max_active_levels)
+    in
+    Compare.Int32.(min_allowed_level < Raw_level.to_int32 outbox_level)
+  in
+  fail_unless
+    (Raw_level.(outbox_level <= lcc_level) && outbox_level_is_active)
+    Sc_rollup_invalid_outbox_level
+
+let execute_outbox_message ctxt ~validate_and_decode_output_proof rollup
+    ~cemented_commitment ~source ~output_proof =
+  let open Lwt_tzresult_syntax in
+  (* TODO: #3211
+     Allow older cemented commits as well.
+     This has the benefits of eliminating any race condition where new commits
+     are cemented and makes inclusion proofs obsolete. *)
+  let* lcc_hash, lcc_level, ctxt =
+    Sc_rollup.Commitment.last_cemented_commitment_hash_with_level ctxt rollup
+  in
+  (* Check that the last-cemented-commitment matches the one for the given
+     rollup. This is important in order to guarantee that the inclusion-proof
+     is for the correct state-hash. *)
+  let* () =
+    fail_unless
+      Sc_rollup.Commitment.Hash.(lcc_hash = cemented_commitment)
+      Sc_rollup_invalid_last_cemented_commitment
+  in
+  (* Validate and decode the output proofs. *)
+  let* Sc_rollup.{outbox_level; message_index; message}, ctxt =
+    validate_and_decode_output_proof
+      ctxt
+      ~cemented_commitment:lcc_hash
+      rollup
+      ~output_proof
+  in
+  (* Validate that the outbox level is within valid bounds. *)
+  let* () = validate_outbox_level ctxt ~outbox_level ~lcc_level in
+  let* ( Sc_rollup_management_protocol.Atomic_transaction_batch {transactions},
+         ctxt ) =
+    Sc_rollup_management_protocol.outbox_message_of_outbox_message_repr
+      ctxt
+      message
+  in
+  (* Turn the transaction batch into a list of operations. *)
+  let*? ctxt, operations =
+    List.fold_left_map_e
+      (fun ctxt transaction ->
+        let open Tzresult_syntax in
+        let+ op, ctxt = to_transaction_operation ctxt ~source transaction in
+        (ctxt, op))
+      ctxt
+      transactions
+  in
+  (* Record that the message for the given level has been applied. This fails
+     in case a message for the rollup, outbox-level and message index has
+     already been executed. The storage diff returned may be negative.
+  *)
+  let* applied_msg_size_diff, ctxt =
+    Sc_rollup.Outbox.record_applied_message
+      ctxt
+      rollup
+      outbox_level
+      ~message_index:(Z.to_int message_index)
+  in
+  (* TODO: #3121
+     Implement a more refined model. For instance a water-mark based one.
+     For now we only charge for positive contributions. It means that over time
+     we are overcharging for storage space.
+  *)
+  let paid_storage_size_diff = Z.max Z.zero applied_msg_size_diff in
+  (* Extract the ticket-token diffs from the operations. We here make sure that
+     there are no tickets with amount zero. Zero-amount tickets are not allowed
+     as they cannot be tracked by the ticket-balance table.
+  *)
+  let* ticket_token_diffs, ctxt =
+    Ticket_operations_diff.ticket_diffs_of_operations
+      ctxt
+      ~allow_zero_amount_tickets:false
+      operations
+  in
+  (* Update the ticket-balance table by transferring ticket-tokens to new
+     destinations for each transaction. This fails in case the rollup does not
+     hold a sufficient amount of any of the ticket-tokens transferred.
+
+     The updates must happen before any of the operations are executed to avoid
+     a case where ticket-transfers are funded as a result of prior operations
+     depositing new tickets to the rollup.
   *)
-  fail Sc_rollup_invalid_atomic_batch
+  let* paid_storage_size_diff, ctxt =
+    let source_destination = Destination.Sc_rollup rollup in
+    List.fold_left_es
+      (fun (acc_storage_diff, ctxt) ticket_token_diff ->
+        transfer_ticket_tokens
+          ctxt
+          ~source_destination
+          ~acc_storage_diff
+          ticket_token_diff)
+      (paid_storage_size_diff, ctxt)
+      ticket_token_diffs
+  in
+  return ({paid_storage_size_diff; operations}, ctxt)
+
+module Internal_for_tests = struct
+  let execute_outbox_message = execute_outbox_message
+end
+
+let execute_outbox_message ctxt =
+  execute_outbox_message ctxt ~validate_and_decode_output_proof
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.mli b/src/proto_alpha/lib_protocol/sc_rollup_operations.mli
index 885da1e0fe90..189ecc7268df 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_operations.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.mli
@@ -28,9 +28,17 @@ open Alpha_context
 
 type error +=
   | (* Permanent *) Sc_rollup_invalid_parameters_type
-  | (* Permanent *) Sc_rollup_invalid_atomic_batch
+  | (* Permanent *) Sc_rollup_invalid_last_cemented_commitment
+  | (* Permanent *) Sc_rollup_invalid_output_proof
+  | (* Permanent *) Sc_rollup_invalid_outbox_level
 
-type origination_result = private {address : Sc_rollup.Address.t; size : Z.t}
+(** Result of calling the {!execute_outbox_message} function. *)
+type execute_outbox_message_result = {
+  paid_storage_size_diff : Z.t;
+  operations : Script_typed_ir.packed_internal_operation list;
+}
+
+type origination_result = {address : Sc_rollup.Address.t; size : Z.t}
 
 (** [originate context ~kind ~boot_sector] adds a new rollup running in a
     given [kind] initialized with a [boot_sector]. *)
@@ -41,9 +49,32 @@ val originate :
   parameters_ty:Script_repr.lazy_expr ->
   (origination_result * context) tzresult Lwt.t
 
+(** [execute_outbox_message ctxt rollup ~cemented_commitment ~source
+      ~output_proof] validates the given outbox message and prepares a set of
+      resulting operations. *)
 val execute_outbox_message :
   context ->
   Sc_rollup.t ->
-  Sc_rollup.Commitment.Hash.t ->
+  cemented_commitment:Sc_rollup.Commitment.Hash.t ->
+  source:public_key_hash ->
   output_proof:string ->
-  context tzresult Lwt.t
+  (execute_outbox_message_result * context) tzresult Lwt.t
+
+(** A module used for testing purposes only. *)
+module Internal_for_tests : sig
+  (** Same as {!execute_outbox_message} but allows overriding the extraction
+      and validation of output proofs. *)
+  val execute_outbox_message :
+    context ->
+    validate_and_decode_output_proof:
+      (context ->
+      cemented_commitment:Sc_rollup.Commitment.Hash.t ->
+      Sc_rollup.t ->
+      output_proof:string ->
+      (Sc_rollup.output * context) tzresult Lwt.t) ->
+    Sc_rollup.t ->
+    cemented_commitment:Sc_rollup.Commitment.Hash.t ->
+    source:public_key_hash ->
+    output_proof:string ->
+    (execute_outbox_message_result * context) tzresult Lwt.t
+end
-- 
GitLab


From e0639c3b807889065549ce884509740c7774f274 Mon Sep 17 00:00:00 2001
From: Joel Bjornson <joel.bjornson@trili.tech>
Date: Thu, 16 Jun 2022 10:50:44 +0100
Subject: [PATCH 6/7] Test: execute outbox message tests

---
 .../integration/operations/test_sc_rollup.ml  | 930 +++++++++++++++++-
 1 file changed, 898 insertions(+), 32 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml
index 6d2f064c7df4..c0dec561d1e9 100644
--- a/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_sc_rollup.ml
@@ -53,6 +53,17 @@ let assert_fails ~loc ?error m =
       | Environment.Ecoproto_error err' :: _, Some err when err = err' ->
           (* Matched exact error. *)
           return_unit
+      | Environment.Ecoproto_error err' :: _, Some err ->
+          let msg =
+            Format.asprintf
+              "Expected error [%a] but got [%a] at location %s"
+              Environment.Error_monad.pp
+              err'
+              Environment.Error_monad.pp
+              err
+              loc
+          in
+          Stdlib.failwith msg
       | _, Some _ ->
           (* Expected a different error. *)
           let msg =
@@ -63,6 +74,9 @@ let assert_fails ~loc ?error m =
           (* Any error is ok. *)
           return ())
 
+let assert_equal_z ~loc x y =
+  Assert.equal ~loc Z.equal "Compare Z.t" Z.pp_print x y
+
 (** [context_init tup] initializes a context for testing in which the
   [sc_rollup_enable] constant is set to true. It returns the created
   context and contracts. *)
@@ -163,7 +177,6 @@ let dummy_commitment ctxt rollup =
       Constants_storage.sc_rollup_commitment_period_in_blocks
         (Alpha_context.Internal_for_tests.to_raw ctxt)
     in
-
     Raw_level.of_int32_exn
       (Int32.add (Raw_level.to_int32 root_level) (Int32.of_int commitment_freq))
   in
@@ -177,6 +190,323 @@ let dummy_commitment ctxt rollup =
         compressed_state = Sc_rollup.State_hash.zero;
       }
 
+(* Verify that parameters and unparsed parameters match. *)
+let verify_params ctxt ~parameters_ty ~parameters ~unparsed_parameters =
+  let show_stripped exp =
+    Expr.to_string @@ Environment.Micheline.strip_locations exp
+  in
+  let unparse ctxt parameters =
+    wrap
+      (Script_ir_translator.unparse_data
+         ctxt
+         Script_ir_translator.Optimized
+         parameters_ty
+         parameters)
+  in
+  let* unparsed_parameters, ctxt =
+    (* Make sure we can parse the unparsed-parameters with the given parameters
+       type. *)
+    let* parsed_unparsed_parameters, ctxt =
+      wrap
+        (Script_ir_translator.parse_data
+           ctxt
+           ~legacy:true
+           ~allow_forged:true
+           parameters_ty
+           (Environment.Micheline.root unparsed_parameters))
+    in
+    (* Un-parse again to get back to Micheline. *)
+    unparse ctxt parsed_unparsed_parameters
+  in
+  (* Un-parse the parsed parameters. *)
+  let* expected_unparsed_parameters, _ctxt = unparse ctxt parameters in
+  (* Verify that both version match. *)
+  Assert.equal_string
+    ~loc:__LOC__
+    (show_stripped unparsed_parameters)
+    (show_stripped expected_unparsed_parameters)
+
+(* Verify that the given list of transactions and transaction operations match.
+   Also checks each transaction operation for type mismatches etc. *)
+let verify_execute_outbox_message_operations incr ~loc ~source ~operations
+    ~expected_transactions =
+  let ctxt = Incremental.alpha_ctxt incr in
+  let validate_and_extract_operation_params ctxt op =
+    match op with
+    | Script_typed_ir.Internal_operation
+        {
+          source = op_source;
+          operation =
+            Transaction_to_contract
+              {
+                destination;
+                amount;
+                entrypoint;
+                location = _;
+                parameters_ty;
+                parameters;
+                unparsed_parameters;
+              };
+          nonce = _;
+        } ->
+        (* Check that the parameters match. *)
+        let* () =
+          verify_params ctxt ~parameters_ty ~parameters ~unparsed_parameters
+        in
+        let* () =
+          (* Check that the sources match. *)
+          Assert.equal_string
+            ~loc
+            (Contract.to_b58check (Contract.Implicit source))
+            (Contract.to_b58check op_source)
+        in
+        (* Assert that the amount is 0. *)
+        let* () = Assert.equal_tez ~loc amount Tez.zero in
+        (* Load the arg-type and entrypoints of the destination script. *)
+        let* ( Script_ir_translator.Ex_script (Script {arg_type; entrypoints; _}),
+               ctxt ) =
+          let* contract_hash =
+            match destination with
+            | Contract.Originated ch -> return ch
+            | _ -> failwith "Expected originated contract at %s" loc
+          in
+          let* ctxt, _cache_key, cached =
+            wrap @@ Script_cache.find ctxt contract_hash
+          in
+          match cached with
+          | Some (_script, ex_script) -> return (ex_script, ctxt)
+          | None -> failwith "Could not load script at %s" loc
+        in
+        (* Find the script parameters ty of the script. *)
+        let*? entrypoint_res, ctxt =
+          Environment.wrap_tzresult
+            (Gas_monad.run
+               ctxt
+               (Script_ir_translator.find_entrypoint
+                  ~error_details:(Informative ())
+                  arg_type
+                  entrypoints
+                  entrypoint))
+        in
+        let*? (Ex_ty_cstr {ty = script_parameters_ty; _}) =
+          Environment.wrap_tzresult entrypoint_res
+        in
+        (* Check that the script parameters type matches the one from the
+           transaction. *)
+        let*? ctxt =
+          Environment.wrap_tzresult
+            (let open Result_syntax in
+            let* eq, ctxt =
+              Gas_monad.run
+                ctxt
+                (Script_ir_translator.ty_eq
+                   ~error_details:(Informative (-1))
+                   script_parameters_ty
+                   parameters_ty)
+            in
+            let+ Eq = eq in
+            ctxt)
+        in
+        return (ctxt, (destination, entrypoint, unparsed_parameters))
+    | _ ->
+        failwith
+          "Expected an internal transaction operation, called from %s"
+          loc
+  in
+  let* _ctxt, operations_data =
+    List.fold_left_map_es validate_and_extract_operation_params ctxt operations
+  in
+  let compare_data (d1, e1, p1) (d2, e2, p2) =
+    Contract.equal d1 d2
+    && Entrypoint_repr.(e1 = e2)
+    && String.equal (Expr.to_string p1) (Expr.to_string p2)
+  in
+  let pp_data fmt (d, e, p) =
+    Format.fprintf
+      fmt
+      "(%a, %a, %s)"
+      Contract.pp
+      d
+      Entrypoint_repr.pp
+      e
+      (Expr.to_string p)
+  in
+  let transactions_data =
+    let data_of_transaction (ty, entrypoint, params) =
+      let params = Expr.from_string params in
+      (ty, entrypoint, params)
+    in
+    List.map data_of_transaction expected_transactions
+  in
+  Assert.assert_equal_list
+    ~loc
+    compare_data
+    "Compare operations data"
+    pp_data
+    operations_data
+    transactions_data
+
+(* Helper function to create output used for executing outbox messages. *)
+let make_output ~outbox_level ~message_index transactions =
+  let transactions =
+    List.map
+      (fun (destination, entrypoint, parameters) ->
+        let destination =
+          match destination with
+          | Contract.Originated ch -> ch
+          | Contract.Implicit _ ->
+              Stdlib.failwith "Expected an originated contract."
+        in
+        let unparsed_parameters = Expr.from_string parameters in
+        {Sc_rollup.Outbox.Message.unparsed_parameters; destination; entrypoint})
+      transactions
+  in
+  let message =
+    Sc_rollup.Outbox.Message.Atomic_transaction_batch {transactions}
+  in
+  let outbox_level = Raw_level.of_int32_exn (Int32.of_int outbox_level) in
+  let message_index = Z.of_int message_index in
+  Sc_rollup.{outbox_level; message_index; message}
+
+let string_ticket_token ticketer content =
+  let open Lwt_result_syntax in
+  let contents =
+    Result.value_f ~default:(fun _ -> assert false)
+    @@ Script_string.of_string content
+  in
+  let*? ticketer = Environment.wrap_tzresult @@ Contract.of_b58check ticketer in
+  return
+    (Ticket_token.Ex_token
+       {ticketer; contents_type = Script_typed_ir.string_t; contents})
+
+let originate_contract incr ~script ~baker ~storage ~source_contract =
+  let* block = Incremental.finalize_block incr in
+  let* contract, _, block =
+    Contract_helpers.originate_contract_from_string
+      ~script
+      ~storage
+      ~source_contract
+      ~baker
+      block
+  in
+  let* incr = Incremental.begin_construction block in
+  return (contract, incr)
+
+let publish_and_cement_commitment incr ~baker ~originator rollup commitment =
+  let* operation = Op.sc_rollup_publish (I incr) originator rollup commitment in
+  let* incr = Incremental.add_operation incr operation in
+  let* block = Incremental.finalize_block incr in
+  let* constants = Context.get_constants (B block) in
+  let* block =
+    Block.bake_n constants.parametric.sc_rollup.challenge_window_in_blocks block
+  in
+  let hash = Sc_rollup.Commitment.hash commitment in
+  let* incr =
+    Incremental.begin_construction ~policy:Block.(By_account baker) block
+  in
+  let* cement_op = Op.sc_rollup_cement (I incr) originator rollup hash in
+  let* incr = Incremental.add_operation incr cement_op in
+  let* block = Incremental.finalize_block incr in
+  let* incr =
+    Incremental.begin_construction ~policy:Block.(By_account baker) block
+  in
+  return (hash, incr)
+
+let publish_and_cement_dummy_commitment incr ~baker ~originator rollup =
+  let* commitment = dummy_commitment incr rollup in
+  publish_and_cement_commitment incr ~baker ~originator rollup commitment
+
+(* Publishes repeated cemented commitments until a commitment with
+   [inbox_level >= min_inbox_level] is found (such a commitment
+   is also published and cemented). *)
+let publish_commitments_until_min_inbox_level incr rollup ~baker ~originator
+    ~min_inbox_level ~cemented_commitment_hash ~cemented_commitment =
+  let commitment_freq =
+    Constants_storage.sc_rollup_commitment_period_in_blocks
+      (Alpha_context.Internal_for_tests.to_raw @@ Incremental.alpha_ctxt incr)
+  in
+  let rec aux incr hash ({Sc_rollup.Commitment.inbox_level; _} as commitment) =
+    let level = Int32.to_int @@ Raw_level.to_int32 inbox_level in
+    if level >= min_inbox_level then return (hash, incr)
+    else
+      let next_inbox_level =
+        Raw_level.of_int32_exn
+          (Int32.add
+             (Raw_level.to_int32 inbox_level)
+             (Int32.of_int commitment_freq))
+      in
+      let commitment =
+        {commitment with predecessor = hash; inbox_level = next_inbox_level}
+      in
+      let* hash, incr =
+        publish_and_cement_commitment incr ~baker ~originator rollup commitment
+      in
+      aux incr hash commitment
+  in
+  aux incr cemented_commitment_hash cemented_commitment
+
+let deposit_ticket_token incr rollup ticket_token delta =
+  wrap
+    (let ctxt = Incremental.alpha_ctxt incr in
+     let* rollup_red_token_hash, ctxt =
+       Ticket_balance_key.of_ex_token
+         ctxt
+         ~owner:(Destination.Sc_rollup rollup)
+         ticket_token
+     in
+     let* _, ctxt =
+       Ticket_balance.adjust_balance ctxt rollup_red_token_hash ~delta
+     in
+     let incr = Incremental.set_alpha_ctxt incr ctxt in
+     return incr)
+
+(** A version of execute outbox message that output ignores proof validation. *)
+let execute_outbox_message_without_proof_validation incr rollup
+    ~cemented_commitment ~source outbox_message =
+  let* res, ctxt =
+    wrap
+      (Sc_rollup_operations.Internal_for_tests.execute_outbox_message
+         (Incremental.alpha_ctxt incr)
+         ~validate_and_decode_output_proof:
+           (fun ctxt ~cemented_commitment:_ _rollup ~output_proof:_ ->
+           return (outbox_message, ctxt))
+         rollup
+         ~cemented_commitment
+         ~source
+         ~output_proof:"Not used")
+  in
+  return (res, Incremental.set_alpha_ctxt incr ctxt)
+
+let execute_outbox_message incr ~originator rollup ~output_proof
+    ~commitment_hash =
+  let* batch_op =
+    Op.sc_rollup_execute_outbox_message
+      (I incr)
+      originator
+      rollup
+      commitment_hash
+      ~output_proof
+  in
+  let* incr = Incremental.add_operation incr batch_op in
+  let* block = Incremental.finalize_block incr in
+  Incremental.begin_construction block
+
+let get_balance ctxt ~token ~owner =
+  let* key_hash, ctxt =
+    wrap @@ Ticket_balance_key.of_ex_token ctxt ~owner token
+  in
+  wrap (Ticket_balance.get_balance ctxt key_hash)
+
+let assert_ticket_token_balance ~loc incr token owner expected =
+  let ctxt = Incremental.alpha_ctxt incr in
+  let* balance, _ = get_balance ctxt ~token ~owner in
+  match (balance, expected) with
+  | Some b, Some e -> Assert.equal_int ~loc (Z.to_int b) e
+  | Some b, None ->
+      failwith "%s: Expected no balance but got some %d" loc (Z.to_int b)
+  | None, Some b -> failwith "%s: Expected balance %d but got none" loc b
+  | None, None -> return ()
+
 (** Assert that the computation fails with the given message. *)
 let assert_fails_with ~__LOC__ k expected_err =
   let*! res = k in
@@ -470,42 +800,548 @@ let test_originating_with_valid_type () =
   ]
   |> List.iter_es assert_parameters_ty
 
-let test_atomic_batch_fails () =
-  let* ctxt, contracts, rollup = init_and_originate Context.T2 "unit" in
-  let _, contract = contracts in
-  let* i = Incremental.begin_construction ctxt in
-  let* c = dummy_commitment i rollup in
-  let* operation = Op.sc_rollup_publish (B ctxt) contract rollup c in
-  let* i = Incremental.add_operation i operation in
-  let* b = Incremental.finalize_block i in
-  let* constants = Context.get_constants (B b) in
-  let* b =
-    Block.bake_n constants.parametric.sc_rollup.challenge_window_in_blocks b
+(* A contract that receives a pair of nat and a ticket and stores the ticket
+   with previously stored tickets. *)
+let ticket_receiver =
+  {|
+      { parameter (pair nat (ticket string));
+        storage (list (ticket string));
+        code { UNPAIR;          # [(nat, ticket) ; list]
+               CDR;             # [ticket ; list]
+               CONS;            # [ticket :: list]
+               NIL operation ;  # [[] ;  ticket :: list]
+               PAIR;            # [([], ticket :: list)]
+              }
+      }
+    |}
+
+(* A contract that receives a string. *)
+let string_receiver =
+  {|
+      { parameter string;
+        storage string;
+        code { CDR ; NIL operation; PAIR } }
+  |}
+
+(* A contract that receives a mutez. *)
+let mutez_receiver =
+  {|
+      { parameter mutez;
+        storage mutez;
+        code { CDR ; NIL operation; PAIR } }
+  |}
+
+let test_single_transaction_batch () =
+  let* block, (baker, originator) = context_init Context.T2 in
+  let source = Context.Contract.pkh originator in
+  let baker = Context.Contract.pkh baker in
+  (* Originate a rollup that accepts a list of string tickets as input. *)
+  let* block, rollup = sc_originate block originator "list (ticket string)" in
+  let* incr = Incremental.begin_construction block in
+  (* Originate a contract that accepts a pair of nat and ticket string input.  *)
+  let* ticket_receiver, incr =
+    originate_contract
+      incr
+      ~script:ticket_receiver
+      ~storage:"{}"
+      ~source_contract:originator
+      ~baker
   in
-  let* i = Incremental.begin_construction b in
-  let hash = Sc_rollup.Commitment.hash c in
-  let* cement_op = Op.sc_rollup_cement (I i) contract rollup hash in
-  let* _ = Incremental.add_operation i cement_op in
-  let* batch_op =
-    Op.sc_rollup_execute_outbox_message
-      (I i)
-      contract
+  (* Ticket-token with content "red". *)
+  let* red_token =
+    string_ticket_token "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red"
+  in
+  (* Publish and cement a commitment. *)
+  let* cemented_commitment, incr =
+    publish_and_cement_dummy_commitment incr ~baker ~originator rollup
+  in
+  (* Create an atomic batch message. *)
+  let transactions =
+    [
+      ( ticket_receiver,
+        Entrypoint.default,
+        {|Pair 42 (Pair "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red" 1)|} );
+    ]
+  in
+  let output = make_output ~outbox_level:0 ~message_index:0 transactions in
+  (* Set up the balance so that the self contract owns one ticket. *)
+  let* incr = deposit_ticket_token incr rollup red_token Z.one in
+  let* Sc_rollup_operations.{operations; _}, incr =
+    execute_outbox_message_without_proof_validation
+      incr
       rollup
-      hash
-      ~output_proof:"xyz"
+      ~cemented_commitment
+      ~source
+      output
   in
-  let expect_apply_failure = function
-    | Environment.Ecoproto_error
-        (Sc_rollup_operations.Sc_rollup_invalid_atomic_batch as e)
-      :: _ ->
-        Assert.test_error_encodings e ;
-        return_unit
-    | _ -> failwith "For some reason in did not fail with the right error"
+  (* Confirm that each transaction maps to one operation. *)
+  let* () =
+    verify_execute_outbox_message_operations
+      ~loc:__LOC__
+      incr
+      ~source
+      ~operations
+      ~expected_transactions:transactions
+  in
+  (* Verify that the balance has moved to ticket-receiver. *)
+  let* () =
+    assert_ticket_token_balance
+      ~loc:__LOC__
+      incr
+      red_token
+      (Destination.Sc_rollup rollup)
+      None
+  in
+  assert_ticket_token_balance
+    ~loc:__LOC__
+    incr
+    red_token
+    (Destination.Contract ticket_receiver)
+    (Some 1)
+
+let test_multi_transaction_batch () =
+  let* block, (baker, originator) = context_init Context.T2 in
+  let baker = Context.Contract.pkh baker in
+  let source = Context.Contract.pkh originator in
+  (* Originate a rollup that accepts a list of string tickets as input. *)
+  let* block, rollup = sc_originate block originator "list (ticket string)" in
+  let* incr = Incremental.begin_construction block in
+  (* Originate a contract that accepts a pair of nat and ticket string input. *)
+  let* ticket_receiver, incr =
+    originate_contract
+      incr
+      ~script:ticket_receiver
+      ~storage:"{}"
+      ~source_contract:originator
+      ~baker
+  in
+  (* Originate a contract that accepts a string as input. *)
+  let* string_receiver, incr =
+    originate_contract
+      incr
+      ~script:string_receiver
+      ~storage:{|""|}
+      ~source_contract:originator
+      ~baker
+  in
+  (* Publish and cement a commitment. *)
+  let* cemented_commitment, incr =
+    publish_and_cement_dummy_commitment incr ~baker ~originator rollup
+  in
+  (* Ticket-token with content "red". *)
+  let* red_token =
+    string_ticket_token "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red"
+  in
+  let transactions =
+    [
+      (* A transaction to the ticket-receiver contract. *)
+      ( ticket_receiver,
+        Entrypoint.default,
+        {|Pair 1 (Pair "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red" 4)|} );
+      (* Another transaction to the ticket-receiver contract. *)
+      ( ticket_receiver,
+        Entrypoint.default,
+        {|Pair 2 (Pair "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red" 6)|} );
+      (* A transaction to the string-receiver contract. *)
+      (string_receiver, Entrypoint.default, {|"Hello"|});
+      (* Another transaction to the string-receiver contract. *)
+      (string_receiver, Entrypoint.default, {|"Hello again"|});
+    ]
+  in
+  (* Create an atomic batch message. *)
+  let output = make_output ~outbox_level:0 ~message_index:0 transactions in
+  (* Set up the balance so that the rollup owns 10 units of red tokens. *)
+  let* incr = deposit_ticket_token incr rollup red_token (Z.of_int 10) in
+  let* Sc_rollup_operations.{operations; _}, incr =
+    execute_outbox_message_without_proof_validation
+      incr
+      rollup
+      ~cemented_commitment
+      ~source
+      output
+  in
+  (* Confirm that each transaction maps to one operation. *)
+  let* () =
+    verify_execute_outbox_message_operations
+      ~loc:__LOC__
+      incr
+      ~source
+      ~operations
+      ~expected_transactions:transactions
+  in
+  (* Verify that the balance has moved to ticket-receiver. *)
+  let* () =
+    assert_ticket_token_balance
+      ~loc:__LOC__
+      incr
+      red_token
+      (Destination.Sc_rollup rollup)
+      None
+  in
+  assert_ticket_token_balance
+    ~loc:__LOC__
+    incr
+    red_token
+    (Destination.Contract ticket_receiver)
+    (Some 10)
+
+(** Test that executing an L2 to L1 transaction that involves an invalid
+    parameter (mutez) fails. *)
+let test_transaction_with_invalid_type () =
+  let* block, (baker, originator) = context_init Context.T2 in
+  let baker = Context.Contract.pkh baker in
+  let source = Context.Contract.pkh originator in
+  let* block, rollup = sc_originate block originator "list (ticket string)" in
+  let* incr = Incremental.begin_construction block in
+  let* mutez_receiver, incr =
+    originate_contract
+      incr
+      ~script:mutez_receiver
+      ~storage:"0"
+      ~source_contract:originator
+      ~baker
+  in
+  (* Publish and cement a commitment. *)
+  let* cemented_commitment, incr =
+    publish_and_cement_dummy_commitment incr ~baker ~originator rollup
+  in
+  let transactions = [(mutez_receiver, Entrypoint.default, "12")] in
+  (* Create an atomic batch message. *)
+  let output = make_output ~outbox_level:0 ~message_index:1 transactions in
+  assert_fails
+    ~loc:__LOC__
+    ~error:Sc_rollup_operations.Sc_rollup_invalid_parameters_type
+    (execute_outbox_message_without_proof_validation
+       incr
+       rollup
+       ~cemented_commitment
+       ~source
+       output)
+
+(** Test that executing the same outbox message for the same twice fails. *)
+let test_execute_message_twice () =
+  let* block, (baker, originator) = context_init Context.T2 in
+  let baker = Context.Contract.pkh baker in
+  let source = Context.Contract.pkh originator in
+  (* Originate a rollup that accepts a list of string tickets as input. *)
+  let* block, rollup = sc_originate block originator "list (ticket string)" in
+  let* incr = Incremental.begin_construction block in
+  (* Originate a contract that accepts a pair of nat and ticket string input.  *)
+  let* string_receiver, incr =
+    originate_contract
+      incr
+      ~script:string_receiver
+      ~storage:{|""|}
+      ~source_contract:originator
+      ~baker
+  in
+  (* Publish and cement a commitment. *)
+  let* cemented_commitment, incr =
+    publish_and_cement_dummy_commitment incr ~baker ~originator rollup
+  in
+  (* Create an atomic batch message. *)
+  let transactions = [(string_receiver, Entrypoint.default, {|"Hello"|})] in
+  let output = make_output ~outbox_level:0 ~message_index:1 transactions in
+  (* Execute the message once - should succeed. *)
+  let* Sc_rollup_operations.{operations; _}, incr =
+    execute_outbox_message_without_proof_validation
+      incr
+      rollup
+      ~cemented_commitment
+      ~source
+      output
+  in
+  (* Confirm that each transaction maps to one operation. *)
+  let* () =
+    verify_execute_outbox_message_operations
+      ~loc:__LOC__
+      incr
+      ~source
+      ~operations
+      ~expected_transactions:transactions
   in
-  let* _ = Incremental.add_operation ~expect_apply_failure i batch_op in
+  (* Execute the same message again should fail. *)
+  assert_fails
+    ~loc:__LOC__
+    ~error:Sc_rollup_errors.Sc_rollup_outbox_message_already_applied
+    (execute_outbox_message_without_proof_validation
+       incr
+       rollup
+       ~cemented_commitment
+       ~source
+       output)
 
+let test_zero_amount_ticket () =
+  let* block, (baker, originator) = context_init Context.T2 in
+  let baker = Context.Contract.pkh baker in
+  let source = Context.Contract.pkh originator in
+  (* Originate a rollup that accepts a list of string tickets as input. *)
+  let* block, rollup = sc_originate block originator "list (ticket string)" in
+  let* incr = Incremental.begin_construction block in
+  (* Originate a contract that accepts a pair of nat and ticket string input. *)
+  let* ticket_receiver, incr =
+    originate_contract
+      incr
+      ~script:ticket_receiver
+      ~storage:"{}"
+      ~source_contract:originator
+      ~baker
+  in
+  (* Publish and cement a commitment. *)
+  let* cemented_commitment, incr =
+    publish_and_cement_dummy_commitment incr ~baker ~originator rollup
+  in
+  (* Create an atomic batch message. *)
+  let transactions =
+    [
+      ( ticket_receiver,
+        Entrypoint.default,
+        {|Pair 42 (Pair "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red" 0)|} );
+    ]
+  in
+  let output = make_output ~outbox_level:0 ~message_index:0 transactions in
+  assert_fails
+    ~loc:__LOC__
+    ~error:Ticket_scanner.Forbidden_zero_ticket_quantity
+    (execute_outbox_message_without_proof_validation
+       incr
+       rollup
+       ~cemented_commitment
+       ~source
+       output)
+
+(* Check that executing an outbox message fails when the inclusion proof in
+   invalid. *)
+let test_invalid_output_proof () =
+  let* block, (baker, originator) = context_init Context.T2 in
+  let baker = Context.Contract.pkh baker in
+  (* Originate a rollup that accepts a list of string tickets as input. *)
+  let* block, rollup = sc_originate block originator "list (ticket string)" in
+  let* incr = Incremental.begin_construction block in
+  (* Publish and cement a commitment. *)
+  let* cemented_commitment, incr =
+    publish_and_cement_dummy_commitment incr ~baker ~originator rollup
+  in
+  assert_fails
+    ~loc:__LOC__
+    ~error:Sc_rollup_operations.Sc_rollup_invalid_output_proof
+    (execute_outbox_message
+       incr
+       rollup
+       ~originator
+       ~output_proof:"No good"
+       ~commitment_hash:cemented_commitment)
+
+let test_execute_message_override_applied_messages_slot () =
+  let* block, (baker, originator) = context_init Context.T2 in
+  let baker = Context.Contract.pkh baker in
+  let source = Context.Contract.pkh originator in
+  (* Originate a rollup that accepts a list of string tickets as input. *)
+  let* block, rollup = sc_originate block originator "list (ticket string)" in
+  let* incr = Incremental.begin_construction block in
+  (* Originate a contract that accepts a pair of nat and ticket string input.  *)
+  let* string_receiver, incr =
+    originate_contract
+      incr
+      ~script:string_receiver
+      ~storage:{|""|}
+      ~source_contract:originator
+      ~baker
+  in
+  let max_active_levels =
+    Int32.to_int
+      (Constants_storage.sc_rollup_max_active_outbox_levels
+         (Alpha_context.Internal_for_tests.to_raw @@ Incremental.alpha_ctxt incr))
+  in
+  let execute_message incr ~outbox_level ~message_index
+      ~cemented_commitment_hash =
+    let transactions = [(string_receiver, Entrypoint.default, {|"Hello"|})] in
+    let output = make_output ~outbox_level ~message_index transactions in
+    let* Sc_rollup_operations.{operations = _; paid_storage_size_diff}, incr =
+      execute_outbox_message_without_proof_validation
+        incr
+        rollup
+        ~cemented_commitment:cemented_commitment_hash
+        ~source
+        output
+    in
+    return (paid_storage_size_diff, incr)
+  in
+  let* cemented_commitment = dummy_commitment incr rollup in
+  let* cemented_commitment_hash, incr =
+    publish_and_cement_commitment
+      incr
+      rollup
+      ~baker
+      ~originator
+      cemented_commitment
+  in
+  (* Execute a message. *)
+  let* _, incr =
+    execute_message
+      incr
+      ~outbox_level:0
+      ~message_index:0
+      ~cemented_commitment_hash
+  in
+  (* Publish a bunch of commitments until the inbox level of the lcc is greater
+     than [max_active_levels]. *)
+  let* cemented_commitment_hash, incr =
+    publish_commitments_until_min_inbox_level
+      incr
+      rollup
+      ~baker
+      ~originator
+      ~min_inbox_level:(max_active_levels + 10)
+      ~cemented_commitment_hash
+      ~cemented_commitment
+  in
+  (* Execute the message again but at [max_active_levels] outbox-level. *)
+  let* paid_storage_size_diff, incr =
+    execute_message
+      incr
+      ~outbox_level:max_active_levels
+      ~message_index:1
+      ~cemented_commitment_hash
+  in
+  (* Since bitset has already been created for the slot, there should be no
+     extra storage space. *)
+  let* () = assert_equal_z ~loc:__LOC__ paid_storage_size_diff Z.zero in
+  (* Execute a message at index 99. *)
+  let* paid_storage_size_diff, incr =
+    execute_message
+      incr
+      ~outbox_level:max_active_levels
+      ~message_index:99
+      ~cemented_commitment_hash
+  in
+  (* A message at slot 99 is now recorded which expands the size of the bitset.
+     We therefore see an increase in size.
+  *)
+  let* () = assert_equal_z ~loc:__LOC__ paid_storage_size_diff (Z.of_int 14) in
+  (* Execute at index 98. *)
+  let* paid_storage_size_diff, incr =
+    execute_message
+      incr
+      ~outbox_level:max_active_levels
+      ~message_index:98
+      ~cemented_commitment_hash
+  in
+  (* The bitset is not expanded so we don't pay anything. *)
+  let* () = assert_equal_z ~loc:__LOC__ paid_storage_size_diff Z.zero in
+  (* If we now try to record a message at level 0 it should fail since it
+     expired. *)
+  let* () =
+    assert_fails
+      ~loc:__LOC__
+      ~error:Sc_rollup_operations.Sc_rollup_invalid_outbox_level
+      (execute_message
+         incr
+         ~outbox_level:0
+         ~message_index:0
+         ~cemented_commitment_hash)
+  in
+  let* _paid_storage_size_diff, _incr =
+    execute_message
+      incr
+      ~outbox_level:(max_active_levels + 5)
+      ~message_index:0
+      ~cemented_commitment_hash
+  in
+  (* This should fail even if no message exists for the corresponding slot.
+     The reason is that outbox-level is smaller than the minimum level:
+     [last-cemented-commitment-level - max-active-levels].
+  *)
+  let* () =
+    assert_fails
+      ~loc:__LOC__
+      ~error:Sc_rollup_operations.Sc_rollup_invalid_outbox_level
+      (execute_message
+         incr
+         ~outbox_level:1
+         ~message_index:0
+         ~cemented_commitment_hash)
+  in
   return_unit
 
+(** Test that a transaction fails if it attempts to transfer more tickets than
+    allowed. *)
+let test_insufficient_ticket_balances () =
+  let* block, (baker, originator) = context_init Context.T2 in
+  let baker = Context.Contract.pkh baker in
+  let source = Context.Contract.pkh originator in
+  (* Originate a rollup that accepts a list of string tickets as input. *)
+  let* block, rollup = sc_originate block originator "list (ticket string)" in
+  let* incr = Incremental.begin_construction block in
+  (* Originate a contract that accepts a pair of nat and ticket string input. *)
+  let* ticket_receiver, incr =
+    originate_contract
+      incr
+      ~script:ticket_receiver
+      ~storage:"{}"
+      ~source_contract:originator
+      ~baker
+  in
+  (* Originate a contract that accepts a string as input. *)
+  let* string_receiver, incr =
+    originate_contract
+      incr
+      ~script:string_receiver
+      ~storage:{|""|}
+      ~source_contract:originator
+      ~baker
+  in
+  (* Publish and cement a commitment. *)
+  let* cemented_commitment, incr =
+    publish_and_cement_dummy_commitment incr ~baker ~originator rollup
+  in
+  (* Ticket-token with content "red". *)
+  let* red_token =
+    string_ticket_token "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red"
+  in
+  let transactions =
+    [
+      (* A transaction to the ticket-receiver contract. *)
+      ( ticket_receiver,
+        Entrypoint.default,
+        {|Pair 1 (Pair "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red" 4)|} );
+      (* Another transaction to the ticket-receiver contract. *)
+      ( ticket_receiver,
+        Entrypoint.default,
+        {|Pair 2 (Pair "KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq" "red" 6)|} );
+      (* A transaction to the string-receiver contract. *)
+      (string_receiver, Entrypoint.default, {|"Hello"|});
+      (* Another transaction to the string-receiver contract. *)
+      (string_receiver, Entrypoint.default, {|"Hello again"|});
+    ]
+  in
+  (* Create an atomic batch message. *)
+  let output = make_output ~outbox_level:0 ~message_index:0 transactions in
+  (* Set up the balance so that the rollup owns 7 units of red tokens.
+     This is insufficient wrt the set of transactions above.
+  *)
+  let* incr = deposit_ticket_token incr rollup red_token (Z.of_int 7) in
+  let* key, ctxt =
+    wrap
+      (Ticket_balance_key.of_ex_token
+         (Incremental.alpha_ctxt incr)
+         ~owner:(Destination.Sc_rollup rollup)
+         red_token)
+  in
+  let incr = Incremental.set_alpha_ctxt incr ctxt in
+  (* Executing the batch fails because the rollup only has 7 units of tickets
+     but attempts to transfer 10 units. *)
+  assert_fails
+    ~loc:__LOC__
+    ~error:
+      (Ticket_balance.Negative_ticket_balance {key; balance = Z.of_int (-3)})
+    (execute_outbox_message_without_proof_validation
+       incr
+       rollup
+       ~cemented_commitment
+       ~source
+       output)
+
 let tests =
   [
     Tztest.tztest
@@ -541,7 +1377,37 @@ let tests =
       `Quick
       test_originating_with_valid_type;
     Tztest.tztest
-      "the atomic batch test will fail for now"
+      "originating with invalid types"
+      `Quick
+      test_originating_with_invalid_types;
+    Tztest.tztest
+      "originating with valid type"
+      `Quick
+      test_originating_with_valid_type;
+    Tztest.tztest
+      "single transaction atomic batch"
+      `Quick
+      test_single_transaction_batch;
+    Tztest.tztest
+      "multi-transaction atomic batch"
+      `Quick
+      test_multi_transaction_batch;
+    Tztest.tztest
+      "transaction with invalid type"
+      `Quick
+      test_transaction_with_invalid_type;
+    Tztest.tztest "execute same message twice" `Quick test_execute_message_twice;
+    Tztest.tztest
+      "transaction with zero amount ticket"
+      `Quick
+      test_zero_amount_ticket;
+    Tztest.tztest "invalid output proof" `Quick test_invalid_output_proof;
+    Tztest.tztest
+      "outbox message that overrides an old slot"
+      `Quick
+      test_execute_message_override_applied_messages_slot;
+    Tztest.tztest
+      "insufficient ticket balances"
       `Quick
-      test_atomic_batch_fails;
+      test_insufficient_ticket_balances;
   ]
-- 
GitLab


From 067b79bb866388f463302a3da59e8b38cb3ed53a Mon Sep 17 00:00:00 2001
From: Joel Bjornson <joel.bjornson@trili.tech>
Date: Wed, 22 Jun 2022 15:49:54 +0100
Subject: [PATCH 7/7] Proto: refactor pvm kind function

---
 src/proto_alpha/lib_plugin/RPC.ml                        | 2 +-
 src/proto_alpha/lib_protocol/alpha_context.mli           | 2 +-
 src/proto_alpha/lib_protocol/sc_rollup_operations.ml     | 6 ++----
 src/proto_alpha/lib_protocol/sc_rollup_storage.ml        | 7 ++++++-
 src/proto_alpha/lib_protocol/sc_rollup_storage.mli       | 9 ++++-----
 .../lib_protocol/test/unit/test_sc_rollup_storage.ml     | 5 ++---
 6 files changed, 16 insertions(+), 15 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml
index 50a023ed56fa..e4643ff77ea1 100644
--- a/src/proto_alpha/lib_plugin/RPC.ml
+++ b/src/proto_alpha/lib_plugin/RPC.ml
@@ -1904,7 +1904,7 @@ module Sc_rollup = struct
 
   let register_kind () =
     Registration.opt_register1 ~chunked:true S.kind @@ fun ctxt address () () ->
-    Alpha_context.Sc_rollup.kind ctxt address
+    Alpha_context.Sc_rollup.kind ctxt address >|=? Option.some
 
   (* TODO: https://gitlab.com/tezos/tezos/-/issues/2688 *)
   let register_initial_level () =
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index cd88fc05fc92..a0fa43b6fef5 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -3150,7 +3150,7 @@ module Sc_rollup : sig
   val parameters_type :
     context -> t -> (Script.lazy_expr option * context) tzresult Lwt.t
 
-  val kind : context -> t -> Kind.t option tzresult Lwt.t
+  val kind : context -> t -> Kind.t tzresult Lwt.t
 
   module Errors : sig
     type error += Sc_rollup_does_not_exist of t
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
index de7166c30e17..378b2891d3fa 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml
@@ -264,10 +264,8 @@ let validate_and_decode_output_proof ctxt ~cemented_commitment rollup
   let open Lwt_tzresult_syntax in
   (* Lookup the PVM of the rollup. *)
   let* (module PVM : Sc_rollup.PVM.S) =
-    let* kind = Sc_rollup.kind ctxt rollup in
-    match kind with
-    | Some kind -> return (Sc_rollup.Kind.pvm_of kind)
-    | None -> fail (Sc_rollup.Errors.Sc_rollup_does_not_exist rollup)
+    let+ kind = Sc_rollup.kind ctxt rollup in
+    Sc_rollup.Kind.pvm_of kind
   in
   let*? ctxt =
     Gas.consume
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_storage.ml b/src/proto_alpha/lib_protocol/sc_rollup_storage.ml
index accc5a20cb4e..dc9df98ed8ac 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_storage.ml
+++ b/src/proto_alpha/lib_protocol/sc_rollup_storage.ml
@@ -57,7 +57,12 @@ let originate ctxt ~kind ~boot_sector ~parameters_ty =
   in
   return (address, size, ctxt)
 
-let kind ctxt address = Store.PVM_kind.find ctxt address
+let kind ctxt address =
+  let open Lwt_tzresult_syntax in
+  let* kind_opt = Store.PVM_kind.find ctxt address in
+  match kind_opt with
+  | Some k -> return k
+  | None -> fail (Sc_rollup_errors.Sc_rollup_does_not_exist address)
 
 let list ctxt = Store.PVM_kind.keys ctxt >|= Result.return
 
diff --git a/src/proto_alpha/lib_protocol/sc_rollup_storage.mli b/src/proto_alpha/lib_protocol/sc_rollup_storage.mli
index 14ad0e66eec4..63632eae8502 100644
--- a/src/proto_alpha/lib_protocol/sc_rollup_storage.mli
+++ b/src/proto_alpha/lib_protocol/sc_rollup_storage.mli
@@ -38,11 +38,10 @@ val originate :
   parameters_ty:Script_repr.lazy_expr ->
   (Sc_rollup_repr.Address.t * Z.t * Raw_context.t) tzresult Lwt.t
 
-(** [kind context address] returns [Some kind] iff [address] is an
-    existing rollup of some [kind]. Returns [None] if [address] is
-    not the address of an existing rollup. *)
-val kind :
-  Raw_context.t -> Sc_rollup_repr.t -> Sc_rollups.Kind.t option tzresult Lwt.t
+(** [kind context address] returns the kind of the given rollup [address] iff
+    [address] is an existing rollup. Fails with an [Sc_rollup_does_not_exist]
+    error in case the rollup does not exist. *)
+val kind : Raw_context.t -> Sc_rollup_repr.t -> Sc_rollups.Kind.t tzresult Lwt.t
 
 val list : Raw_context.t -> Sc_rollup_repr.t list tzresult Lwt.t
 
diff --git a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml
index 6855cfac1d01..53c3d82d2777 100644
--- a/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml
+++ b/src/proto_alpha/lib_protocol/test/unit/test_sc_rollup_storage.ml
@@ -2085,10 +2085,9 @@ let test_staker_cannot_change_branch () =
     Sc_rollup_errors.Sc_rollup_staker_backtracked
 
 let test_kind_of_missing_rollup () =
-  let* ctxt = new_context () in
   let rollup = Sc_rollup_repr.Address.hash_bytes [] in
-  let* kind = lift @@ Sc_rollup_storage.kind ctxt rollup in
-  assert_kinds_are_equal ~loc:__LOC__ Option.None kind
+  assert_fails_with_missing_rollup ~loc:__LOC__ (fun ctxt _ ->
+      Sc_rollup_storage.kind ctxt rollup)
 
 let test_add_messages_from_missing_rollup () =
   assert_fails_with_missing_rollup ~loc:__LOC__ (fun ctxt rollup ->
-- 
GitLab