diff --git a/src/proto_alpha/lib_benchmarks_proto/tx_rollup_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/tx_rollup_benchmarks.ml
index 7feab0c50d2feda6b7ad2d4d8571ce12307998ce..21b6a275e9828fe109ba87744c38b813644e9d41 100644
--- a/src/proto_alpha/lib_benchmarks_proto/tx_rollup_benchmarks.ml
+++ b/src/proto_alpha/lib_benchmarks_proto/tx_rollup_benchmarks.ml
@@ -180,6 +180,467 @@ module Commitment_full_compact_bench : Benchmark.S = struct
     Generator.Plain {workload; closure}
 end
 
+module Irmin_context = Tezos_context_memory.Context_binary
+
+exception Error of Protocol.Environment.Error_monad.error
+
+module Prover_storage :
+  Tx_rollup_l2_storage_sig.STORAGE
+    with type t = Irmin_context.tree
+     and type 'a m = 'a Lwt.t = struct
+  type t = Irmin_context.tree
+
+  type 'a m = 'a Lwt.t
+
+  module Syntax = struct
+    include Lwt.Syntax
+
+    let return = Lwt.return
+
+    let fail e = Lwt.fail (Error e)
+
+    let catch (m : 'a m) k h =
+      Lwt.catch
+        (fun () -> m >>= k)
+        (function Error e -> h e | e -> Lwt.fail e)
+
+    let list_fold_left_m = Lwt_list.fold_left_s
+  end
+
+  let path k = [Bytes.to_string k]
+
+  let get store key = Irmin_context.Tree.find store (path key)
+
+  let set store key value = Irmin_context.Tree.add store (path key) value
+
+  let remove store key = Irmin_context.Tree.remove store (path key)
+end
+
+module Prover_context = Tx_rollup_l2_context.Make (Prover_storage)
+module Prover_apply = Tx_rollup_l2_apply.Make (Prover_context)
+
+type address = {
+  sk : Bls12_381.Signature.sk;
+  pk : Bls12_381.Signature.MinPk.pk;
+  addr : Tx_rollup_l2_address.t;
+  index : Tx_rollup_l2_context_sig.address_index;
+  mutable counter : int;
+}
+
+type ticket = {
+  hash : Alpha_context.Ticket_hash.t;
+  index : Tx_rollup_l2_context_sig.ticket_index;
+}
+
+type couple = {addr1 : address; addr2 : address; common_tickets : ticket list}
+
+let address sk pk addr i =
+  {sk; pk; addr; index = Indexable.index_exn i; counter = 1}
+
+let ticket hash i = {hash; index = Indexable.index_exn i}
+
+let couple a b l = {addr1 = a; addr2 = b; common_tickets = l}
+
+let unique_ticket_id =
+  let x = ref 0 in
+  fun () ->
+    let ticket = Printf.sprintf "ticket%d" !x in
+    let () = incr x in
+    ticket
+
+let gen_l2_account rng_state =
+  let seed = Base_samplers.uniform_bytes ~nbytes:32 rng_state in
+  let secret_key = Bls12_381.Signature.generate_sk seed in
+  let public_key = Bls12_381.Signature.MinPk.derive_pk secret_key in
+  (secret_key, public_key)
+
+let hash_key_exn ctxt ~ticketer ~typ ~contents ~owner =
+  let ticketer = Micheline.root @@ Expr.from_string ticketer in
+  let ty = Micheline.root @@ Expr.from_string typ in
+  let contents = Micheline.root @@ Expr.from_string contents in
+  let owner = Micheline.root @@ Expr.from_string owner in
+  match Alpha_context.Ticket_hash.make ctxt ~ticketer ~ty ~contents ~owner with
+  | Ok x -> x
+  | Error _ -> raise (Invalid_argument "hash_key_exn")
+
+let make_key ctxt content =
+  hash_key_exn
+    ctxt
+    ~ticketer:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|}
+    ~typ:"string"
+    ~contents:
+      (Printf.sprintf {|"%s"|} content)
+      (* In practice, the owner is a rollup address, but this is important only
+         for the table of tickets *)
+    ~owner:{|"KT1ThEdxfUcWUwqsdergy3QnbCWGHSUHeHJq"|}
+
+let make_ticket str =
+  match
+    Lwt_main.run
+      ( Context.init1 () >>=? fun (blk, _) ->
+        Incremental.begin_construction blk >>=? fun incr ->
+        let ctxt = Incremental.alpha_ctxt incr in
+        let (ticket, _ctxt) = make_key ctxt str in
+        return ticket )
+  with
+  | Ok x -> x
+  | Error _ -> raise (Invalid_argument "make_ticket")
+
+let gen_ticket () =
+  let ticket = unique_ticket_id () in
+  make_ticket ticket
+
+(** [input ~rng_state nb_of_couple_addr nb_of_ticket_per_couple] creates
+    [nb_of_couple_addr] of {!couple} where each couple owns
+    [nb_of_ticket_per_couple] of {!ticket} in common. It can later on be used
+    to create transfers between addresses in the same couple of a ticket they
+    both own (that helps to create larger proofs). *)
+let input ~rng_state nb_of_couple_addr nb_of_ticket_per_couple =
+  (* Prevent an infinite loop, but 0 is semantically stupid as well. *)
+  assert (nb_of_couple_addr >= 0) ;
+  assert (nb_of_ticket_per_couple >= 0) ;
+  let idx_addr = ref 0 in
+  let idx_ticket = ref 0 in
+  let rec fold_ticket acc = function
+    | 0 -> acc
+    | n ->
+        let tidx = Int32.of_int !idx_ticket in
+        let () = incr idx_ticket in
+        let ticket = ticket (gen_ticket ()) tidx in
+        fold_ticket (ticket :: acc) (n - 1)
+  in
+  let rec fold_couple acc = function
+    | 0 -> acc
+    | n ->
+        (* Generate random identities *)
+        let (sk1, pk1) = gen_l2_account rng_state in
+        let (sk2, pk2) = gen_l2_account rng_state in
+        let addr1 = Tx_rollup_l2_address.of_bls_pk pk1 in
+        let addr2 = Tx_rollup_l2_address.of_bls_pk pk2 in
+        (* Pick indexes *)
+        let aidx = Int32.of_int !idx_addr in
+        let () = incr idx_addr in
+        let bidx = Int32.of_int !idx_addr in
+        let () = incr idx_addr in
+        (* Build addresses *)
+        let a = address sk1 pk1 addr1 aidx in
+        let b = address sk2 pk2 addr2 bidx in
+        (* Generate common tickets *)
+        let tickets = List.rev @@ fold_ticket [] nb_of_ticket_per_couple in
+        (* Build the couple *)
+        fold_couple (couple a b tickets :: acc) (n - 1)
+  in
+  fold_couple [] nb_of_couple_addr |> List.rev
+
+(** [init_ctxt input] initializes a real [Irmin_context.t] context with
+    the abstract data generated in {!input}. *)
+let init_ctxt input =
+  let open Prover_context in
+  let open Syntax in
+  let empty_store = Irmin_context.empty in
+  let empty_tree = Irmin_context.Tree.empty empty_store in
+  let qty = Tx_rollup_l2_qty.of_int64_exn 1_000_000L in
+  let* tree =
+    list_fold_left_m
+      (fun tree couple ->
+        let* (tree, _, idx1) =
+          Address_index.get_or_associate_index tree couple.addr1.addr
+        in
+        let* tree =
+          Address_metadata.init_with_public_key tree idx1 couple.addr1.pk
+        in
+        let* (tree, _, idx2) =
+          Address_index.get_or_associate_index tree couple.addr2.addr
+        in
+        let* tree =
+          Address_metadata.init_with_public_key tree idx2 couple.addr2.pk
+        in
+        let* tree =
+          list_fold_left_m
+            (fun tree ticket ->
+              let* (tree, _, tidx) =
+                Ticket_index.get_or_associate_index tree ticket.hash
+              in
+              let* tree = Ticket_ledger.credit tree tidx idx1 qty in
+              let* tree = Ticket_ledger.credit tree tidx idx2 qty in
+              return tree)
+            tree
+            couple.common_tickets
+        in
+        return tree)
+      empty_tree
+      input
+  in
+  let* store = Irmin_context.add_tree empty_store [] tree in
+  let* _ = Irmin_context.commit ~time:Time.Protocol.epoch store in
+  return store
+
+(** [create_operation ~rng_state input senders] creates an operation based
+    on [input].
+    The generated transfer is random in the sense that:
+    * A couple is randomly taken to be the source of the transfer.
+    * The values are randomly replaced by their indexes.
+    * The destination is randomly taken between:
+      * The source couple.
+      * Another address in the context.
+      * A new generated address.
+    * The transfered quantity is randomly generated and can be greater than
+      the source balance to make the transfer fail.
+*)
+let create_operation ~rng_state input senders =
+  let either a b = if Base_samplers.uniform_bool rng_state then a else b in
+  let index_or_value idx value =
+    let idx = Indexable.forget idx in
+    let value = Indexable.from_value value in
+    either idx value
+  in
+  let (couple, source) =
+    (* The source must be unique in the transfer. The l2 operation forbids
+       operation to have multiple transfers from the same source. *)
+    let rec pick_until_new () =
+      let couple =
+        Stdlib.List.nth
+          input
+          (Base_samplers.sample_in_interval
+             ~range:{min = 0; max = List.length input - 1}
+             rng_state)
+      in
+      let source = couple.addr1 in
+      if
+        List.mem
+          ~equal:(fun x y -> Tx_rollup_l2_address.( = ) x.addr y.addr)
+          source
+          senders
+      then pick_until_new ()
+      else (couple, source)
+    in
+    pick_until_new ()
+  in
+  let signer =
+    index_or_value
+      Indexable.(to_int32 source.index |> index_exn)
+      (Tx_rollup_l2_batch.Bls_pk source.pk)
+  in
+  let destination =
+    let x =
+      Base_samplers.sample_in_interval ~range:{min = 0; max = 99} rng_state
+    in
+    if x >= 0 && x < 40 then
+      (* couple.B, he has the ticket *)
+      index_or_value couple.addr2.index couple.addr2.addr
+    else if x >= 40 && x < 80 then
+      (* other couple, he does not have the ticket *)
+      let i =
+        Base_samplers.sample_in_interval
+          ~range:{min = 0; max = List.length input - 1}
+          rng_state
+      in
+      let couple = Stdlib.List.nth input i in
+      index_or_value couple.addr2.index couple.addr2.addr
+    else
+      (* create new address *)
+      gen_l2_account rng_state |> snd |> Tx_rollup_l2_address.of_bls_pk
+      |> Indexable.from_value
+  in
+  let qty =
+    let x =
+      Base_samplers.sample_in_interval ~range:{min = 0; max = 99} rng_state
+    in
+    (* Low probably to take more than the balance and make the operation fail. *)
+    if x <= 2 then Tx_rollup_l2_qty.of_int64_exn 1_000_001L
+    else Tx_rollup_l2_qty.one
+  in
+  let {hash = ticket_hash; index = ticket_index} =
+    let n = List.length couple.common_tickets in
+    let x =
+      Base_samplers.sample_in_interval ~range:{min = 0; max = n - 1} rng_state
+    in
+    Stdlib.List.nth couple.common_tickets x
+  in
+  let counter = source.counter in
+  let () = source.counter <- counter + 1 in
+  let ticket_hash = index_or_value ticket_index ticket_hash in
+  ( Tx_rollup_l2_batch.V1.
+      {
+        signer;
+        counter = 1L;
+        contents = [Transfer {destination; ticket_hash; qty}];
+      },
+    source.sk,
+    source :: senders )
+
+let create_transaction ~rng_state input nb_op =
+  (* Prevent an infinite loop, but 0 is semantically stupid as well. *)
+  assert (nb_op >= 0) ;
+  let rec aux acc senders = function
+    | 0 -> acc
+    | n ->
+        let (op, signer, senders) = create_operation ~rng_state input senders in
+        let acc = (op, signer) :: acc in
+        aux acc senders (n - 1)
+  in
+  let acc = [] in
+  let senders = [] in
+  aux acc senders nb_op
+
+let make_msg ~rng_state input nb_op =
+  let (transaction, signers) =
+    create_transaction ~rng_state input nb_op |> List.split
+  in
+  let buf =
+    (Data_encoding.Binary.to_bytes_exn
+       Data_encoding.Compact.(
+         make ~tag_size:`Uint8 Tx_rollup_l2_batch.V1.compact_transaction))
+      transaction
+  in
+  let signatures =
+    List.map (fun sk -> Bls12_381.Signature.MinPk.Aug.sign sk buf) signers
+  in
+  let aggregated_signature =
+    match Bls12_381.Signature.MinPk.aggregate_signature_opt signatures with
+    | Some res -> res
+    | None -> assert false
+  in
+  let batch =
+    Tx_rollup_l2_batch.V1.{contents = [transaction]; aggregated_signature}
+  in
+  let batch_string =
+    Data_encoding.Binary.to_string_exn
+      Tx_rollup_l2_batch.encoding
+      Tx_rollup_l2_batch.(V1 batch)
+  in
+  Alpha_context.Tx_rollup_message.make_batch batch_string |> fst
+
+let get_tree_from_store store =
+  let open Prover_context.Syntax in
+  let* tree_opt = Irmin_context.find_tree store [] in
+  match tree_opt with Some x -> return x | None -> assert false
+
+let hash_tree_from_store store =
+  let open Prover_context.Syntax in
+  let+ tree = get_tree_from_store store in
+  Irmin_context.Tree.hash tree
+
+let create_proof store max_withdrawals msg =
+  let open Prover_context.Syntax in
+  let index = Irmin_context.index store in
+  let* hash = hash_tree_from_store store in
+  let* (proof, _) =
+    Irmin_context.produce_stream_proof index (`Node hash) (fun tree ->
+        Prover_apply.(
+          catch
+            (apply_message
+               tree
+               Tx_rollup_l2_apply.
+                 {tx_rollup_max_withdrawals_per_batch = max_withdrawals}
+               msg)
+            (fun (tree, _) -> return (tree, ()))
+            (fun _error ->
+              (* With the context and message generation we should not reach
+                 this case. *)
+              assert false)))
+  in
+  return proof
+
+module Verify_proof_compute_bench : Benchmark.S = struct
+  let name = "Tx_rollup_verify_proof"
+
+  let info = "Benchmark for Tx_rollup.verify_proof"
+
+  let tags = ["tx_rollup"; "merkle"; "verify"; "proof"]
+
+  type config = {max_withdrawals : int}
+
+  let default_config = {max_withdrawals = 255}
+
+  let config_encoding =
+    let open Data_encoding in
+    conv
+      (fun {max_withdrawals} -> max_withdrawals)
+      (fun max_withdrawals -> {max_withdrawals})
+      (obj1 (req "max_withdrawals" int31))
+
+  type workload = {proof_size : int; message_size : int}
+
+  let workload_encoding =
+    let open Data_encoding in
+    conv
+      (fun {proof_size; message_size} -> (proof_size, message_size))
+      (fun (proof_size, message_size) -> {proof_size; message_size})
+      (obj2 (req "proof_size" int31) (req "message_size" int31))
+
+  let workload_to_vector {proof_size; message_size} =
+    Sparse_vec.String.of_list
+      [
+        ("proof_size", float_of_int proof_size);
+        ("message_size", float_of_int message_size);
+      ]
+
+  let models =
+    let conv {proof_size; message_size} = (proof_size, (message_size, ())) in
+    [
+      ( "tx_rollup",
+        Model.make
+          ~conv
+          ~model:
+            (Model.bilinear
+               ~coeff1:(Free_variable.of_string "proof_size_coeff")
+               ~coeff2:(Free_variable.of_string "message_size_coeff")) );
+    ]
+
+  let proof_size proof =
+    Data_encoding.Binary.length Tx_rollup_l2_proof.encoding proof
+
+  let message_size message =
+    Data_encoding.Binary.length Alpha_context.Tx_rollup_message.encoding message
+
+  let bench_verify_proof rng_state {max_withdrawals} () =
+    let n_couple_addr =
+      Base_samplers.sample_in_interval rng_state ~range:{min = 100; max = 1_000}
+    in
+    let n_ticket_per_couple =
+      Base_samplers.sample_in_interval rng_state ~range:{min = 1; max = 6}
+    in
+    let n_ops =
+      Base_samplers.sample_in_interval rng_state ~range:{min = 5; max = 30}
+    in
+    let input = input ~rng_state n_couple_addr n_ticket_per_couple in
+    let message = make_msg ~rng_state input n_ops in
+    let proof =
+      Lwt_main.run
+      @@
+      let open Lwt_syntax in
+      let* store = init_ctxt input in
+      create_proof store max_withdrawals message
+    in
+    let closure () =
+      Lwt_main.run
+      @@
+      let open Prover_context.Syntax in
+      (* Account the time it takes to calculate the length of the proof and
+         message done during the proof verification. *)
+      let (_ : int) = proof_size proof in
+      let (_ : int) = message_size message in
+      (* Account the time it takes to verify the proof *)
+      let _ =
+        Tx_rollup_l2_verifier.Internal_for_tests.verify_l2_proof
+          proof
+          Tx_rollup_l2_apply.
+            {tx_rollup_max_withdrawals_per_batch = max_withdrawals}
+          message
+      in
+      return ()
+    in
+    let proof_size = proof_size proof in
+    let message_size = message_size message in
+    Generator.Plain {workload = {proof_size; message_size}; closure}
+
+  let create_benchmarks ~rng_state ~bench_num config =
+    List.repeat bench_num (bench_verify_proof rng_state config)
+end
+
 let () = Registration_helpers.register (module Inbox_add_message)
 
 let () = Registration_helpers.register (module Commitment_full_compact_bench)
+
+let () = Registration_helpers.register (module Verify_proof_compute_bench)
diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.ml b/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.ml
index 75a465b2e647050c04cbbe137205e5944fbc2240..18aba02d2b14e5e687e9d1cd3243c0f426fd9cb0 100644
--- a/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.ml
+++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.ml
@@ -32,9 +32,6 @@ open Alpha_context
    on top of [Alpha_context], while [Tx_rollup_gas] is defined on top
    of [Raw_context]. *)
 
-(** TODO: https://gitlab.com/tezos/tezos/-/issues/2773
-    Merge the benchmark used to compute this model into master and
-    reference it here. *)
 let verify_proof_model message_size proof_size =
   let open Saturation_repr in
   (* The cost of verifiying the proof depends bilinearly on the size
@@ -115,6 +112,12 @@ let hash_message_result ctxt after withdraw =
 let after_hash_when_proof_failed ctxt before =
   hash_message_result ctxt before Tx_rollup_withdraw_list_hash.empty
 
+let verify_l2_proof proof parameters message =
+  Context.verify_stream_proof proof (fun tree ->
+      Verifier_apply.apply_message tree parameters message >>= function
+      | Ok (tree, (_, withdrawals)) -> Lwt.return (tree, withdrawals)
+      | Error _ -> Lwt.return (tree, []))
+
 (** [compute_proof_after_hash ~max_proof_size agreed proof message] computes the
     after hash expected while verifying [proof] on [message] starting from
     [agreed].
@@ -150,11 +153,7 @@ let compute_proof_after_hash ~max_proof_size ctxt parameters agreed proof
     ~message_size:message_length
     ~proof_size:proof_length
   >>?= fun ctxt ->
-  Context.verify_stream_proof proof (fun tree ->
-      Verifier_apply.apply_message tree parameters message >>= function
-      | Ok (tree, (_, withdrawals)) -> Lwt.return (tree, withdrawals)
-      | Error _ -> Lwt.return (tree, []))
-  >>= fun res ->
+  verify_l2_proof proof parameters message >>= fun res ->
   match res with
   | (Ok _ | Error (`Stream_too_short _)) when proof_is_too_long ->
       (* If the proof is larger than [max_proof_size] we care about 2 cases:
@@ -194,3 +193,7 @@ let verify_proof ctxt parameters message proof
   if Alpha_context.Tx_rollup_message_result_hash.(computed_result <> rejected)
   then return ctxt
   else fail Proof_produced_rejected_state
+
+module Internal_for_tests = struct
+  let verify_l2_proof = verify_l2_proof
+end
diff --git a/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.mli b/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.mli
index 9742ce00efdb86cc757c8728ee4c5d50a38cdd2b..3285b5ed4529245e34479569bc22e9f51906e18b 100644
--- a/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.mli
+++ b/src/proto_alpha/lib_protocol/tx_rollup_l2_verifier.mli
@@ -55,3 +55,18 @@ val verify_proof :
   rejected:Tx_rollup_message_result_hash.t ->
   max_proof_size:int ->
   Alpha_context.t tzresult Lwt.t
+
+(**/**)
+
+module Internal_for_tests : sig
+  val verify_l2_proof :
+    Context.Proof.stream Context.Proof.t ->
+    Tx_rollup_l2_apply.parameters ->
+    Tx_rollup_message.t ->
+    ( Context.tree * Tx_rollup_withdraw.order list,
+      [ `Proof_mismatch of string
+      | `Stream_too_long of string
+      | `Stream_too_short of string ] )
+    result
+    Lwt.t
+end