From 247cf3ff2b6859fcc5f4b8d6517951ac58cf0085 Mon Sep 17 00:00:00 2001
From: David Turner <novalis@novalis.org>
Date: Wed, 6 Apr 2022 10:06:17 -0400
Subject: [PATCH 1/7] Use helper to DRY up tests

---
 .../integration/operations/test_tx_rollup.ml  | 114 ++++--------------
 1 file changed, 25 insertions(+), 89 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml
index 7843633c3095..29f2e137cc10 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
@@ -601,6 +601,11 @@ let message_result_hash_and_path (commitment : Tx_rollup_commitment.Full.t)
   ( message_result_hash_in_commitment commitment ~message_position,
     compute_message_result_path commitment ~message_position )
 
+let single_message_path message_hash =
+  match Tx_rollup_inbox.Merkle.compute_path [message_hash] 0 with
+  | Ok message_path -> message_path
+  | _ -> raise (Invalid_argument "Single_message_inbox.message_path")
+
 (** ---- TESTS -------------------------------------------------------------- *)
 
 (** [test_origination] originates a transaction rollup and checks that
@@ -2273,7 +2278,7 @@ module Rejection = struct
   let get_tree_from_store store =
     let open L2_Context.Syntax in
     let* tree_opt = C.find_tree store [] in
-    match tree_opt with Some x -> return x | None -> assert false
+    return @@ assert_some tree_opt
 
   let hash_tree_from_store store =
     let open L2_Context.Syntax in
@@ -2380,11 +2385,7 @@ module Rejection = struct
     make_deposit b tx_rollup account addr
     >>=? fun (b, (deposit, _), ticket_hash) ->
     let deposit_hash = Tx_rollup_message_hash.hash_uncarbonated deposit in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [deposit_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path deposit_hash in
     Incremental.begin_construction b >>=? fun i ->
     make_valid_commitment_for_messages
       (I i)
@@ -2499,11 +2500,7 @@ module Rejection = struct
         [(bls_pk pk, None, [(addr2, ticket_hash, 1L)])]
     in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated message in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     Op.tx_rollup_submit_batch (B b) account tx_rollup batch_bytes
     >>=? fun operation ->
     Block.bake ~operation b >>=? fun b ->
@@ -2561,11 +2558,7 @@ module Rejection = struct
         [(bls_pk pk, None, [(addr2, ticket_hash, 1L)])]
     in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated message in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     Op.tx_rollup_submit_batch (B b) account tx_rollup batch_bytes
     >>=? fun operation ->
     Block.bake ~operation b >>=? fun b ->
@@ -2646,9 +2639,7 @@ module Rejection = struct
     l2_parameters (B b) >>=? fun l2_parameters ->
     let (message, _) = Tx_rollup_message.make_batch "fake" in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated message in
-    let message_path =
-      assert_ok @@ Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0)
-    in
+    let message_path = single_message_path message_hash in
     hash_tree_from_store store >>= fun l2_context_hash ->
     let make_invalid_commitment i level h =
       (* Make some invalid commitments for the submitted messages *)
@@ -2722,10 +2713,8 @@ module Rejection = struct
     let message_hash =
       Tx_rollup_message_hash.hash_uncarbonated deposit_message
     in
-    let message_path =
-      assert_ok @@ Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0)
-    in
     let message_position = 0 in
+    let message_path = single_message_path message_hash in
     let (message_result_hash, message_result_path) =
       message_result_hash_and_path commitment0 ~message_position
     in
@@ -2766,11 +2755,7 @@ module Rejection = struct
     hash_tree_from_store store >>= fun l2_context_hash ->
     let (message, batch_bytes) = make_bad_message sk pk addr ticket_hash in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated message in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     Op.tx_rollup_submit_batch (B b) account tx_rollup batch_bytes
     >>=? fun operation ->
     Block.bake ~operation b >>=? fun b ->
@@ -2864,11 +2849,7 @@ module Rejection = struct
     >>=? fun (i, contract, tx_rollup, level, message, commitment) ->
     let (msg, _) = Tx_rollup_message.make_batch message in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated msg in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     l2_parameters (I i) >>=? fun l2_parameters ->
     valid_empty_proof l2_parameters >>= fun proof ->
     let message_position = 0 in
@@ -2897,11 +2878,7 @@ module Rejection = struct
     >>=? fun (i, contract, tx_rollup, level, message, commitment) ->
     let (msg, _) = Tx_rollup_message.make_batch message in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated msg in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     let message_position = 0 in
     let (message_result_hash, message_result_path) =
       message_result_hash_and_path commitment ~message_position
@@ -2942,11 +2919,7 @@ module Rejection = struct
       }
     in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated msg in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     let message_position = 0 in
     let (message_result_hash, message_result_path) =
       message_result_hash_and_path commitment ~message_position
@@ -2998,11 +2971,7 @@ module Rejection = struct
     let level = Tx_rollup_level.root in
     let (message, _size) = Tx_rollup_message.make_batch message in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated message in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     l2_parameters (I i) >>=? fun l2_parameters ->
     valid_empty_proof l2_parameters >>= fun proof ->
     Op.tx_rollup_reject
@@ -3048,11 +3017,7 @@ module Rejection = struct
     Incremental.add_operation i op >>=? fun i ->
     let (message, _size) = Tx_rollup_message.make_batch message in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated message in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     l2_parameters (I i) >>=? fun l2_parameters ->
     valid_empty_proof l2_parameters >>= fun proof ->
     let message_position = 0 in
@@ -3096,11 +3061,7 @@ module Rejection = struct
     in
     let (message, _size) = Tx_rollup_message.make_batch "wrong message" in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated message in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     l2_parameters (I i) >>=? fun l2_parameters ->
     valid_empty_proof l2_parameters >>= fun proof ->
     let message_position = 0 in
@@ -3136,11 +3097,7 @@ module Rejection = struct
     >>=? fun (i, contract1, tx_rollup, level, message, _commitment) ->
     let (message, _size) = Tx_rollup_message.make_batch message in
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated message in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     l2_parameters (I i) >>=? fun l2_parameters ->
     valid_empty_proof l2_parameters >>= fun proof ->
     Op.tx_rollup_reject
@@ -3175,11 +3132,7 @@ module Rejection = struct
     originate b account >>=? fun (b, tx_rollup) ->
     make_deposit b tx_rollup account addr >>=? fun (b, (deposit, _), _) ->
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated deposit in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     Incremental.begin_construction b >>=? fun i ->
     make_incomplete_commitment_for_batch (I i) Tx_rollup_level.root tx_rollup []
     >>=? fun (commitment, _) ->
@@ -3247,11 +3200,7 @@ module Rejection = struct
     originate b account >>=? fun (b, tx_rollup) ->
     make_deposit b tx_rollup account addr >>=? fun (b, (deposit, _), _) ->
     let deposit_hash = Tx_rollup_message_hash.hash_uncarbonated deposit in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [deposit_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path deposit_hash in
     Incremental.begin_construction b >>=? fun i ->
     make_valid_commitment_for_messages
       (I i)
@@ -3320,11 +3269,7 @@ module Rejection = struct
     originate b account >>=? fun (b, tx_rollup) ->
     make_deposit b tx_rollup account addr >>=? fun (b, (deposit, _), _) ->
     let deposit_hash = Tx_rollup_message_hash.hash_uncarbonated deposit in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [deposit_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path deposit_hash in
     Incremental.begin_construction b >>=? fun i ->
     let level = Tx_rollup_level.root in
     make_valid_commitment_for_messages (I i) ~level ~store ~tx_rollup [deposit]
@@ -3400,11 +3345,7 @@ module Rejection = struct
     in
 
     let message_hash = Tx_rollup_message_hash.hash_uncarbonated message in
-    let message_path =
-      match Tx_rollup_inbox.Merkle.(compute_path [message_hash] 0) with
-      | Error _ -> assert false
-      | Ok path -> path
-    in
+    let message_path = single_message_path message_hash in
     (* 2. Submit and commit the batch. *)
     Op.tx_rollup_submit_batch (B b) account tx_rollup batch_bytes
     >>=? fun operation ->
@@ -3558,10 +3499,7 @@ module Single_message_inbox = struct
 
   let message_hash = Tx_rollup_message_hash.hash_uncarbonated message
 
-  let message_path =
-    match Tx_rollup_inbox.Merkle.compute_path [message_hash] 0 with
-    | Ok message_path -> message_path
-    | _ -> raise (Invalid_argument "Single_message_inbox.message_path")
+  let message_path = single_message_path message_hash
 
   let inbox_hash = Tx_rollup_inbox.Merkle.merklize_list [message_hash]
 
@@ -5027,9 +4965,7 @@ module Withdraw = struct
     Incremental.begin_construction b >>=? fun i ->
     let message_position = 0 in
     let message_path =
-      assert_ok
-        Tx_rollup_inbox.Merkle.(
-          compute_path [Tx_rollup_message_hash.hash_uncarbonated message] 0)
+      single_message_path @@ Tx_rollup_message_hash.hash_uncarbonated message
     in
     let message_result_path =
       compute_message_result_path commitment ~message_position
-- 
GitLab


From d13103a4a26a40fe7f84094bf408a6e4e4cdf533 Mon Sep 17 00:00:00 2001
From: David Turner <novalis@novalis.org>
Date: Wed, 30 Mar 2022 16:51:18 -0400
Subject: [PATCH 2/7] Proto,Tx_rollup: remove some weird phrasing from tests

---
 .../test/integration/operations/test_tx_rollup.ml    | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml
index 29f2e137cc10..caf88fe8569f 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
@@ -274,8 +274,8 @@ let originate b contract =
     Returns the first contract and its balance, the originated tx_rollup,
     the state with the tx_rollup, and the baked block with the batch submitted.
 *)
-let init_originate_and_submit ?(batch = String.make 5 'c')
-    ?tx_rollup_origination_size () =
+let init_originate_and_submit ?(batch = "batch") ?tx_rollup_origination_size ()
+    =
   context_init1 ?tx_rollup_origination_size () >>=? fun (b, contract) ->
   originate b contract >>=? fun (b, tx_rollup) ->
   Context.Contract.balance (B b) contract >>=? fun balance ->
@@ -829,7 +829,7 @@ let test_add_batch_with_limit () =
   (* From an empty context the burn will be [Tez.zero], we set the hard limit to
      [Tez.zero], so [cost] >= [limit] *)
   let burn_limit = Tez.zero in
-  let contents = String.make 5 'd' in
+  let contents = "batch" in
   context_init1 () >>=? fun (b, contract) ->
   originate b contract >>=? fun (b, tx_rollup) ->
   Incremental.begin_construction b >>=? fun i ->
@@ -852,14 +852,12 @@ let test_add_two_batches () =
     TODO: https://gitlab.com/tezos/tezos/-/issues/2331
     This test can be generalized using a property-based approach.
    *)
-  let contents_size1 = 5 in
-  let contents1 = String.make contents_size1 'c' in
+  let contents1 = "batch" in
   init_originate_and_submit ~batch:contents1 ()
   >>=? fun ((contract, balance), state, tx_rollup, b) ->
   Op.tx_rollup_submit_batch (B b) contract tx_rollup contents1 >>=? fun op1 ->
   Context.Contract.counter (B b) contract >>=? fun counter ->
-  let contents_size2 = 6 in
-  let contents2 = String.make contents_size2 'd' in
+  let contents2 = "batch2" in
   Op.tx_rollup_submit_batch
     ~counter:Z.(add counter (of_int 1))
     (B b)
-- 
GitLab


From 0cb2f43f5ec19bd13f6410bc973192e7df83ac8c Mon Sep 17 00:00:00 2001
From: David Turner <novalis@novalis.org>
Date: Wed, 30 Mar 2022 16:51:34 -0400
Subject: [PATCH 3/7] DRY up more tests

---
 .../integration/operations/test_tx_rollup.ml  | 38 +++++++------------
 1 file changed, 13 insertions(+), 25 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml
index caf88fe8569f..c2d8ff956c85 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
@@ -606,6 +606,14 @@ let single_message_path message_hash =
   | Ok message_path -> message_path
   | _ -> raise (Invalid_argument "Single_message_inbox.message_path")
 
+let message_result context_hash withdraws =
+  Tx_rollup_message_result.
+    {
+      context_hash;
+      withdraw_list_hash =
+        Tx_rollup_withdraw_list_hash.hash_uncarbonated withdraws;
+    }
+
 (** ---- TESTS -------------------------------------------------------------- *)
 
 (** [test_origination] originates a transaction rollup and checks that
@@ -2528,11 +2536,7 @@ module Rejection = struct
       ~message_result_hash
       ~message_result_path
       ~proof
-      ~previous_message_result:
-        {
-          context_hash = l2_context_hash;
-          withdraw_list_hash = Tx_rollup_withdraw_list_hash.empty;
-        }
+      ~previous_message_result:(message_result l2_context_hash [])
       ~previous_message_result_path:Tx_rollup_commitment.Merkle.dummy_path
     >>=? fun op ->
     Incremental.add_operation i op >>=? fun _ -> return_unit
@@ -2586,11 +2590,7 @@ module Rejection = struct
       ~message_result_hash
       ~message_result_path
       ~proof
-      ~previous_message_result:
-        {
-          context_hash = l2_context_hash;
-          withdraw_list_hash = Tx_rollup_withdraw_list_hash.empty;
-        }
+      ~previous_message_result:(message_result l2_context_hash [])
       ~previous_message_result_path:Tx_rollup_commitment.Merkle.dummy_path
     >>=? fun op ->
     Incremental.add_operation
@@ -2688,11 +2688,7 @@ module Rejection = struct
       ~message_result_hash
       ~message_result_path
       ~proof
-      ~previous_message_result:
-        {
-          context_hash = l2_context_hash;
-          withdraw_list_hash = Tx_rollup_withdraw_list_hash.empty;
-        }
+      ~previous_message_result:(message_result l2_context_hash [])
       ~previous_message_result_path:Tx_rollup_commitment.Merkle.dummy_path
     >>=? fun op ->
     Incremental.add_operation i op >>=? fun i ->
@@ -2727,11 +2723,7 @@ module Rejection = struct
       ~message_result_hash
       ~message_result_path
       ~proof
-      ~previous_message_result:
-        {
-          context_hash = l2_context_hash;
-          withdraw_list_hash = Tx_rollup_withdraw_list_hash.empty;
-        }
+      ~previous_message_result:(message_result l2_context_hash [])
       ~previous_message_result_path:Tx_rollup_commitment.Merkle.dummy_path
     >>=? fun op ->
     Incremental.add_operation i op >>=? fun i ->
@@ -2783,11 +2775,7 @@ module Rejection = struct
       ~message_result_hash
       ~message_result_path
       ~proof
-      ~previous_message_result:
-        {
-          context_hash = l2_context_hash;
-          withdraw_list_hash = Tx_rollup_withdraw_list_hash.empty;
-        }
+      ~previous_message_result:(message_result l2_context_hash [])
       ~previous_message_result_path:Tx_rollup_commitment.Merkle.dummy_path
     >>=? fun op ->
     Incremental.add_operation i op >>=? fun i ->
-- 
GitLab


From d5d78bdeed6d751b24d3c7740c0e4075951114ac Mon Sep 17 00:00:00 2001
From: David Turner <novalis@novalis.org>
Date: Wed, 30 Mar 2022 17:35:42 -0400
Subject: [PATCH 4/7] Proto,Tx_rollup: Remove some unneccessary uses of
 Incremental in tests

---
 .../integration/operations/test_tx_rollup.ml  | 32 ++++++-------------
 1 file changed, 9 insertions(+), 23 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml
index c2d8ff956c85..89ec4df1b8a5 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
@@ -323,8 +323,7 @@ let gen_l2_account () =
     owned by [tx_rollup]. *)
 let make_ticket_key ctxt ~ty ~contents ~ticketer tx_rollup =
   (match ctxt with
-  | Context.B block ->
-      Incremental.begin_construction block >>=? fun incr -> return incr
+  | Context.B block -> Incremental.begin_construction block
   | Context.I incr -> return incr)
   >>=? fun incr ->
   let ctxt = Incremental.alpha_ctxt incr in
@@ -878,7 +877,6 @@ let test_add_two_batches () =
      its successor. *)
   Context.Tx_rollup.inbox (B b) tx_rollup Tx_rollup_level.(succ root)
   >>=? fun inbox ->
-  Incremental.begin_construction b >>=? fun _incr ->
   let contents1_hash =
     Tx_rollup_message_hash.hash_uncarbonated
       (Tx_rollup_message.make_batch contents1 |> fst)
@@ -3751,9 +3749,7 @@ let test_state_with_deleted () =
   Block.bake b ~operations:[] >>=? fun b ->
   Block.bake b ~operations:[] >>=? fun b ->
   Op.tx_rollup_remove_commitment (B b) account1 tx_rollup >>=? fun operation ->
-  Incremental.begin_construction b >>=? fun i ->
-  Incremental.add_operation i operation >>=? fun i ->
-  Incremental.finalize_block i >>=? fun b ->
+  Block.bake ~operation b >>=? fun b ->
   (* Reject level 1, it works *)
   reject b tx_rollup account1 commit1.level commit1 >>=? fun b ->
   ignore b ;
@@ -4052,10 +4048,7 @@ module Withdraw = struct
       context_hash
       [ticket_info1; ticket_info2]
     >>=? fun operation ->
-    Incremental.begin_construction block >>=? fun i ->
-    Incremental.add_operation i operation >>=? fun i ->
-    Incremental.finalize_block i >>=? fun block ->
-    (* Block.bake ~operation block >>=? fun block -> *)
+    Block.bake ~operation block >>=? fun block ->
     (* Now the Tx_rollup should own no tickets and the two implicit contract half before
        calling withdraw.*)
     assert_ticket_balance
@@ -4875,13 +4868,12 @@ module Withdraw = struct
       committed_level
       false
     >>=? fun () ->
-    (* Exexute with withdrawal *)
-    Incremental.begin_construction b >>=? fun incr ->
+    (* Execute with withdrawal *)
     let message_result_path =
       compute_message_result_path commitment ~message_position
     in
     Op.tx_rollup_dispatch_tickets
-      (I incr)
+      (B b)
       ~source:account1
       ~message_index:message_position
       ~message_result_path
@@ -4890,9 +4882,7 @@ module Withdraw = struct
       context_hash
       [ticket_info]
     >>=? fun operation ->
-    Incremental.begin_construction b >>=? fun i ->
-    Incremental.add_operation i operation >>=? fun i ->
-    Incremental.finalize_block i >>=? fun b ->
+    Block.bake ~operation b >>=? fun b ->
     assert_consumed
       b
       ~msg:"should be consumed after withdrawal"
@@ -4902,9 +4892,7 @@ module Withdraw = struct
     (* Remove the commitment *)
     Op.tx_rollup_remove_commitment (B b) account1 tx_rollup
     >>=? fun operation ->
-    Incremental.begin_construction b >>=? fun i ->
-    Incremental.add_operation i operation >>=? fun i ->
-    Incremental.finalize_block i >>=? fun b ->
+    Block.bake ~operation b >>=? fun b ->
     assert_consumed
       b
       committed_level
@@ -5008,7 +4996,6 @@ module Withdraw = struct
       ~amount:(Tx_rollup_l2_qty.of_int64_exn max)
       tx_rollup
     >>=? fun (withdraw, _) ->
-    Incremental.begin_construction b >>=? fun i ->
     Nat_ticket.ticket_hash (B b) ~ticketer:deposit_contract ~tx_rollup
     >>=? fun ticket_hash ->
     let (deposit1, _) =
@@ -5021,7 +5008,7 @@ module Withdraw = struct
     Rejection.init_l2_store () >>= fun store ->
     (* For the first deposit, we have no withdraws *)
     make_and_check_correct_commitment
-      (I i)
+      (B b)
       tx_rollup
       account1
       store
@@ -5081,7 +5068,6 @@ module Withdraw = struct
     in
     deposit b pkh1 >>=? fun b ->
     deposit b pkh2 >>=? fun b ->
-    Incremental.begin_construction b >>=? fun i ->
     Nat_ticket.ticket_hash (B b) ~ticketer:deposit_contract ~tx_rollup
     >>=? fun ticket_hash ->
     let make_deposit pkh =
@@ -5096,7 +5082,7 @@ module Withdraw = struct
     Rejection.init_l2_store () >>= fun store ->
     (* For the first deposit, we have no withdraws *)
     make_and_check_correct_commitment
-      (I i)
+      (B b)
       tx_rollup
       account1
       store
-- 
GitLab


From 48b015eb8a2ad6256798657000cf16c07671f41a Mon Sep 17 00:00:00 2001
From: David Turner <novalis@novalis.org>
Date: Thu, 31 Mar 2022 15:12:56 -0400
Subject: [PATCH 5/7] Proto,Tx_rollup: Remove duplicated code

While we're in there, clean up a parameter name
---
 .../test/helpers/tx_rollup_l2_helpers.ml      |  8 ++---
 .../test/unit/test_tx_rollup_l2.ml            | 30 ++-----------------
 2 files changed, 6 insertions(+), 32 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_l2_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_l2_helpers.ml
index 6fe05f06e1a0..c3869585dac8 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_l2_helpers.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/tx_rollup_l2_helpers.ml
@@ -106,9 +106,9 @@ let gen_l2_address () =
   let public_key = Bls12_381.Signature.MinPk.derive_pk secret_key in
   (secret_key, public_key, Tx_rollup_l2_address.of_bls_pk public_key)
 
-(** [make_unit_ticket_key ctxt ticketer tx_rollup] computes the key hash of
-    the unit ticket crafted by [ticketer] and owned by [tx_rollup]. *)
-let make_unit_ticket_key ticketer tx_rollup =
+(** [make_unit_ticket_key ctxt ticketer l2_address] computes the key hash of
+    the unit ticket crafted by [ticketer] and owned by [l2_address]. *)
+let make_unit_ticket_key ticketer l2_address =
   let open Tezos_micheline.Micheline in
   let open Michelson_v1_primitives in
   let ticketer =
@@ -121,7 +121,7 @@ let make_unit_ticket_key ticketer tx_rollup =
   let ty = Prim (0, T_unit, [], []) in
   let contents = Prim (0, D_Unit, [], []) in
   let owner =
-    String (dummy_location, Tx_rollup_l2_address.to_b58check tx_rollup)
+    String (dummy_location, Tx_rollup_l2_address.to_b58check l2_address)
   in
   Alpha_context.Ticket_hash.Internal_for_tests.make_uncarbonated
     ~ticketer
diff --git a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml
index b5d9787447e1..47936ca354a0 100644
--- a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml
+++ b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml
@@ -317,30 +317,6 @@ module Test_Address_index = Test_index (struct
   let too_many = Too_many_l2_addresses
 end)
 
-(** [make_unit_ticket_key ctxt ticketer tx_rollup] computes the key hash of
-    the unit ticket crafted by [ticketer] and owned by [tx_rollup].
-
-    TODO: extracted from https://gitlab.com/tezos/tezos/-/merge_requests/4017,
-    is there a more convenient way to forge a ticket?
-*)
-let make_unit_ticket_key ctxt ticketer address =
-  let open Tezos_micheline.Micheline in
-  let open Michelson_v1_primitives in
-  let ticketer =
-    Bytes
-      ( 0,
-        Data_encoding.Binary.to_bytes_exn
-          Alpha_context.Contract.encoding
-          ticketer )
-  in
-  let ty = Prim (0, T_unit, [], []) in
-  let contents = Prim (0, D_Unit, [], []) in
-  let owner =
-    String (dummy_location, Tx_rollup_l2_address.to_b58check address)
-  in
-  match Alpha_context.Ticket_hash.make ctxt ~ticketer ~ty ~contents ~owner with
-  | Ok (x, _) -> x
-  | Error _ -> raise (Invalid_argument "make_unit_ticket_key")
 
 (** [gen_n_ticket_hash n] generates [n]  {!Alpha_context.Ticket_hash.t} based on
     {!gen_n_address} and {!make_unit_ticket_key}.
@@ -351,15 +327,13 @@ let make_unit_ticket_key ctxt ticketer address =
 let gen_n_ticket_hash n =
   let x =
     Lwt_main.run
-      ( Context.init n >>=? fun (b, contracts) ->
-        Incremental.begin_construction b >|=? Incremental.alpha_ctxt
-        >>=? fun ctxt ->
+      ( Context.init n >>=? fun (_b, contracts) ->
         let addressess = gen_n_address n in
         let tickets =
           List.map2
             ~when_different_lengths:[]
             (fun contract (_, _, address) ->
-              make_unit_ticket_key ctxt contract address)
+              Tx_rollup_l2_helpers.make_unit_ticket_key contract address)
             contracts
             addressess
         in
-- 
GitLab


From a7f43501f61d6d3779534942e5359e5ce15b04ae Mon Sep 17 00:00:00 2001
From: David Turner <novalis@novalis.org>
Date: Thu, 31 Mar 2022 15:36:55 -0400
Subject: [PATCH 6/7] Proto,tx_rollup: dedicated error

---
 src/proto_alpha/lib_protocol/alpha_context.mli       |  1 +
 .../test/integration/operations/test_tx_rollup.ml    | 12 +++++++++++-
 .../lib_protocol/test/unit/test_tx_rollup_l2.ml      |  1 -
 .../test/unit/test_tx_rollup_l2_apply.ml             |  3 ++-
 .../lib_protocol/tx_rollup_commitment_storage.ml     |  3 +--
 .../lib_protocol/tx_rollup_errors_repr.ml            | 10 ++++++++++
 .../_regressions/tx_rollup_rpc_commitment_remove.out |  6 ++++--
 tezt/tests/tx_rollup.ml                              |  2 +-
 8 files changed, 30 insertions(+), 8 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 8c6ab9988f3d..7bf2ff240166 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2065,6 +2065,7 @@ module Tx_rollup_errors : sig
     | No_commitment_to_finalize
     | No_commitment_to_remove
     | Invalid_committer
+    | Remove_commitment_too_early
     | Commitment_does_not_exist of Tx_rollup_level.t
     | Wrong_predecessor_hash of {
         provided : Tx_rollup_commitment_hash.t option;
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 89ec4df1b8a5..5d509d6e3dbd 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
@@ -213,7 +213,7 @@ let context_init ?(tx_rollup_max_inboxes_count = 2100)
       tx_rollup_enable = true;
       tx_rollup_sunset_level = Int32.max_int;
       tx_rollup_finality_period;
-      tx_rollup_withdraw_period = 1;
+      tx_rollup_withdraw_period = 2;
       tx_rollup_max_commitments_count = 3;
       tx_rollup_origination_size;
       tx_rollup_rejection_max_proof_size;
@@ -3743,6 +3743,15 @@ let test_state_with_deleted () =
   (* Finalize *)
   Op.tx_rollup_finalize (B b) account1 tx_rollup >>=? fun operation ->
   Block.bake b ~operation >>=? fun b ->
+  (* fail to remove too early *)
+  Incremental.begin_construction b >>=? fun i ->
+  Op.tx_rollup_remove_commitment (I i) account1 tx_rollup >>=? fun operation ->
+  Incremental.add_operation
+    i
+    operation
+    ~expect_failure:
+      (check_proto_error Tx_rollup_errors.Remove_commitment_too_early)
+  >>=? fun _ ->
   (* Wait for some blocks, then remove *)
   Block.bake b ~operations:[] >>=? fun b ->
   Block.bake b ~operations:[] >>=? fun b ->
@@ -4794,6 +4803,7 @@ module Withdraw = struct
       WithExceptions.Option.get ~loc:__LOC__
       @@ List.nth context_hash_list message_index
     in
+    Block.bake block >>=? fun block ->
     (* Remove the commitment *)
     Op.tx_rollup_remove_commitment (B block) account1 tx_rollup
     >>=? fun operation ->
diff --git a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml
index 47936ca354a0..ea0e34c2c93e 100644
--- a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml
+++ b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2.ml
@@ -317,7 +317,6 @@ module Test_Address_index = Test_index (struct
   let too_many = Too_many_l2_addresses
 end)
 
-
 (** [gen_n_ticket_hash n] generates [n]  {!Alpha_context.Ticket_hash.t} based on
     {!gen_n_address} and {!make_unit_ticket_key}.
 
diff --git a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml
index 36e8346f513f..8b704e6dcd61 100644
--- a/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml
+++ b/src/proto_alpha/lib_protocol/test/unit/test_tx_rollup_l2_apply.ml
@@ -1628,7 +1628,8 @@ let test_transfer_to_self () =
       Transaction_failure
         {index = 0; reason = Tx_rollup_l2_apply.Invalid_self_transfer} ) ->
       return_unit
-  | (_, _) -> fail_msg "The transaction should faild with [Invalid_destination]"
+  | (_, _) ->
+      fail_msg "The transaction should have failed with [Invalid_destination]"
 
 module Indexes = struct
   (** The context should be dropped during an invalid deposit, as the
diff --git a/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml b/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml
index 641b33cb61bb..e20675c07641 100644
--- a/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml
+++ b/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml
@@ -315,8 +315,7 @@ let remove_commitment ctxt rollup state =
           let current_level = (Raw_context.current_level ctxt).level in
           fail_when
             Raw_level_repr.(current_level < add finalized_at withdraw_period)
-            (* FIXME dedicated error *)
-            No_commitment_to_remove
+            Remove_commitment_too_early
       | None ->
           (* unreachable code if the implementation is correct *)
           fail (Internal_error "Missing finalized_at field"))
diff --git a/src/proto_alpha/lib_protocol/tx_rollup_errors_repr.ml b/src/proto_alpha/lib_protocol/tx_rollup_errors_repr.ml
index 274c7924180d..a79f10792ef9 100644
--- a/src/proto_alpha/lib_protocol/tx_rollup_errors_repr.ml
+++ b/src/proto_alpha/lib_protocol/tx_rollup_errors_repr.ml
@@ -48,6 +48,7 @@ type error +=
   | Bond_in_use of Signature.public_key_hash
   | No_commitment_to_finalize
   | No_commitment_to_remove
+  | Remove_commitment_too_early
   | Commitment_does_not_exist of Tx_rollup_level_repr.t
   | Wrong_predecessor_hash of {
       provided : Tx_rollup_commitment_repr.Hash.t option;
@@ -300,6 +301,15 @@ let () =
     empty
     (function No_commitment_to_remove -> Some () | _ -> None)
     (fun () -> No_commitment_to_remove) ;
+  (* Remove_commitment_too_early *)
+  register_error_kind
+    `Temporary
+    ~id:"tx_rollup_remove_commitment_too_early"
+    ~title:"It's too early to try to remove a commitment"
+    ~description:"It's too early to try to remove the oldest final commitment"
+    empty
+    (function Remove_commitment_too_early -> Some () | _ -> None)
+    (fun () -> Remove_commitment_too_early) ;
   (* Commitment_does_not_exist *)
   register_error_kind
     `Temporary
diff --git a/tezt/_regressions/tx_rollup_rpc_commitment_remove.out b/tezt/_regressions/tx_rollup_rpc_commitment_remove.out
index 9dfbc809f5d0..61bcc09315dc 100644
--- a/tezt/_regressions/tx_rollup_rpc_commitment_remove.out
+++ b/tezt/_regressions/tx_rollup_rpc_commitment_remove.out
@@ -169,8 +169,10 @@ This simulation failed:
       This operation FAILED.
 
 Error:
-  { "id": "proto.alpha.tx_rollup_no_commitment_to_remove",
-  "description": "There is no commitment to remove", "data": {} }
+  { "id": "proto.alpha.tx_rollup_remove_commitment_too_early",
+  "description":
+    "It's too early to try to remove the oldest final commitment",
+  "data": {} }
 
 ./tezos-client rpc get '/chains/main/blocks/head/context/tx_rollup/[TX_ROLLUP_HASH]/state'
 { "last_removed_commitment_hashes": null,
diff --git a/tezt/tests/tx_rollup.ml b/tezt/tests/tx_rollup.ml
index ef62686b6392..3a89122881ed 100644
--- a/tezt/tests/tx_rollup.ml
+++ b/tezt/tests/tx_rollup.ml
@@ -352,7 +352,7 @@ module Regressions = struct
         submit_remove_commitment ~src:Constant.bootstrap2.public_key_hash state
       in
       let* () =
-        Process.check_error ~msg:(rex "tx_rollup_no_commitment_to_remove") p
+        Process.check_error ~msg:(rex "tx_rollup_remove_commitment_too_early") p
       in
 
       Log.info "Step 8. Last_removed_commitments_hashes is None before removing" ;
-- 
GitLab


From 61994a8df878fdf77a7f5cd9b44e13cf5a1d22fa Mon Sep 17 00:00:00 2001
From: David Turner <novalis@novalis.org>
Date: Thu, 31 Mar 2022 15:38:48 -0400
Subject: [PATCH 7/7] Proto,tx_rollup: remove bogus comment

The code in question calls `find`, which does more than just call
`find` in storage: it also checks various levels so that rejected
commitments (and their successors) don't get returned.
---
 src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml b/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml
index e20675c07641..7276ef13939e 100644
--- a/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml
+++ b/src/proto_alpha/lib_protocol/tx_rollup_commitment_storage.ml
@@ -136,7 +136,6 @@ let get :
  fun ctxt tx_rollup state level ->
   find ctxt tx_rollup state level >>=? fun (ctxt, commitment) ->
   match commitment with
-  (* TODO: why not use directly `.get` and get the default error for a missing key ? *)
   | None -> fail @@ Tx_rollup_errors_repr.Commitment_does_not_exist level
   | Some commitment -> return (ctxt, commitment)
 
-- 
GitLab