(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2022 Marigold <contact@marigold.dev>                        *)
(* Copyright (c) 2022 Nomadic Labs <contact@nomadic-labs.com>                *)
(* Copyright (c) 2022 Oxhead Alpha <info@oxhead-alpha.com>                   *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Tx_rollup_errors_repr

type range =
  | Interval of {
      oldest : Tx_rollup_level_repr.t;
      newest : Tx_rollup_level_repr.t;
    }
  | Empty of {next : Tx_rollup_level_repr.t}

let range_newest = function Interval {newest; _} -> Some newest | _ -> None

let range_oldest = function Interval {oldest; _} -> Some oldest | _ -> None

let extend = function
  | Empty {next} -> (Interval {oldest = next; newest = next}, next)
  | Interval {oldest; newest} ->
      let newest = Tx_rollup_level_repr.succ newest in
      (Interval {oldest; newest}, newest)

let shrink = function
  | Empty _ -> error (Internal_error "cannot shrink range")
  | Interval {oldest; newest} when Tx_rollup_level_repr.(oldest < newest) ->
      ok (Interval {oldest = Tx_rollup_level_repr.succ oldest; newest})
  | Interval {newest; oldest = _} ->
      ok (Empty {next = Tx_rollup_level_repr.succ newest})

let belongs_to range level =
  match range with
  | Empty _ -> false
  | Interval {oldest; newest} ->
      Tx_rollup_level_repr.(oldest <= level && level <= newest)

let right_cut range level =
  match Tx_rollup_level_repr.pred level with
  | None -> ok (Empty {next = Tx_rollup_level_repr.root})
  | Some predecessor -> (
      match range with
      | Interval {oldest; newest = _} when belongs_to range level ->
          if Tx_rollup_level_repr.(oldest <= predecessor) then
            ok (Interval {oldest; newest = predecessor})
          else ok (Empty {next = level})
      | _ -> error (Internal_error "cannot cut range"))

let left_extend range level =
  match range with
  | Interval {oldest = _; newest} -> ok (Interval {oldest = level; newest})
  | Empty {next} ->
      let newest =
        Option.value ~default:level (Tx_rollup_level_repr.pred next)
      in
      ok (Interval {oldest = level; newest})

let range_count = function
  | Empty _ -> 0
  | Interval {oldest; newest} ->
      Int32.(succ @@ Tx_rollup_level_repr.diff newest oldest |> to_int)

let range_encoding : range Data_encoding.t =
  Data_encoding.(
    union
      [
        case
          (Tag 0)
          ~title:"empty"
          (obj1 (req "next" Tx_rollup_level_repr.encoding))
          (function Empty {next} -> Some next | _ -> None)
          (fun next -> Empty {next});
        case
          (Tag 1)
          ~title:"interval"
          (obj2
             (req "newest" Tx_rollup_level_repr.encoding)
             (req "oldest" Tx_rollup_level_repr.encoding))
          (function
            | Interval {newest; oldest} -> Some (newest, oldest) | _ -> None)
          (fun (newest, oldest) -> Interval {newest; oldest});
      ])

let pp_range fmt = function
  | Empty {next} -> Format.(fprintf fmt "next: %a" Tx_rollup_level_repr.pp next)
  | Interval {oldest; newest} ->
      Format.(
        fprintf
          fmt
          "oldest: %a newest: %a"
          Tx_rollup_level_repr.pp
          oldest
          Tx_rollup_level_repr.pp
          newest)

type watermark = Tx_rollup_level_repr.t option

let is_above_watermark watermark level =
  match watermark with
  | Some watermark -> Tx_rollup_level_repr.(watermark < level)
  | None -> true

let make_watermark level = Some level

(** The state of a transaction rollup is composed of [burn_per_byte]
    and [inbox_ema] fields. [initial_state] introduces their initial
    values. Both values are updated by [update_burn_per_byte] as the
    rollup progresses.

    [burn_per_byte] state the cost of burn per byte to be paid for
    each byte submitted to a transaction rollup inbox. [inbox_ema]
    is a key factor to impact the update of [burn_per_byte].

    [inbox_ema] is the N-block EMA to react to recent N-inbox size
    changes. N-block EMA is an exponential moving average (EMA), that
    is a type of moving average that places a greater weight and
    significance on the most N data points. The purpose of [inbox_ema]
    is to get lessened volatility of burn, that is more resistant to
    spurious spikes of [burn_per_byte].

   The state of the transaction rollup also keeps track of four pointers
   to four different rollup levels.

    - The [commitment_oldest_level] is the level of the oldest
      finalized commitment still stored in the layer-1 storage.

    - The [commitment_newest_level] is the level of the most recent
      unfinalized commitment in the layer-1 storage.

    - The [oldest_inbox_level] is the level of the oldest inbox still stored
      in the layer-1 storage.

    - The [newest_level] is the level of the most recent inbox in the
      layer-1 storage.
*)
type t = {
  last_removed_commitment_hashes :
    (Tx_rollup_message_result_hash_repr.t * Tx_rollup_commitment_repr.Hash.t)
    option;
  finalized_commitments : range;
  unfinalized_commitments : range;
  uncommitted_inboxes : range;
  commitment_newest_hash : Tx_rollup_commitment_repr.Hash.t option;
  tezos_head_level : Raw_level_repr.t option;
  burn_per_byte : Tez_repr.t;
  inbox_ema : int;
  allocated_storage : Z.t;
  occupied_storage : Z.t;
  commitments_watermark : watermark;
}

(*

   The main use of a transaction rollup state is to keep track of four
   pointers to four different rollup levels (see above).

   When the rollup is created, these four pointers are initialized with
   the [None] value, because no inboxes or commitments have been created
   yet. Because inboxes and commitments can be removed from the layer-1
   context under certain circumstances, they can be reset to [None].

   The state allows us to keep track of three intervals: the finalized
   commitments (whose inboxes have been removed from the layer-1
   storage), the unfinalized commitments (whose inboxes are still in
   the layer-1 storage), and uncommitted inboxes (that is, inboxes
   which are still waiting for a commitment).

     finalized     uncommitted
       ^^^^^^        ^^^^^^^^
       [------------]            commitments
             [--------------]    inboxes
             ^^^^^^^^
            unfinalized

    Note that this layout is not the only one that we can witness in
    the layer-1 storage, even if it is the more common. It is possible
    for instance that there is no unfinalized commitments at a given
    time.

     finalized
       ^^^^^^
       [----]                    commitments
             [--------------]    inboxes
             ^^^^^^^^^^^^^^^^
                uncommitted

     Or that we have no more inboxes, but only finalized commitments.

     finalized
       ^^^^^^
      CT
       [-----]              commitments
                            inboxes

 *)

let initial_state ~pre_allocated_storage =
  {
    last_removed_commitment_hashes = None;
    finalized_commitments = Empty {next = Tx_rollup_level_repr.root};
    unfinalized_commitments = Empty {next = Tx_rollup_level_repr.root};
    uncommitted_inboxes = Empty {next = Tx_rollup_level_repr.root};
    commitment_newest_hash = None;
    tezos_head_level = None;
    burn_per_byte = Tez_repr.zero;
    inbox_ema = 0;
    allocated_storage = pre_allocated_storage;
    occupied_storage = Z.zero;
    commitments_watermark = None;
  }

let encoding : t Data_encoding.t =
  let open Data_encoding in
  conv
    (fun {
           last_removed_commitment_hashes;
           finalized_commitments;
           unfinalized_commitments;
           uncommitted_inboxes;
           commitment_newest_hash;
           tezos_head_level;
           burn_per_byte;
           allocated_storage;
           occupied_storage;
           inbox_ema;
           commitments_watermark;
         } ->
      ( ( last_removed_commitment_hashes,
          finalized_commitments,
          unfinalized_commitments,
          uncommitted_inboxes,
          commitment_newest_hash,
          tezos_head_level,
          burn_per_byte,
          allocated_storage,
          occupied_storage,
          inbox_ema ),
        commitments_watermark ))
    (fun ( ( last_removed_commitment_hashes,
             finalized_commitments,
             unfinalized_commitments,
             uncommitted_inboxes,
             commitment_newest_hash,
             tezos_head_level,
             burn_per_byte,
             allocated_storage,
             occupied_storage,
             inbox_ema ),
           commitments_watermark ) ->
      {
        last_removed_commitment_hashes;
        finalized_commitments;
        unfinalized_commitments;
        uncommitted_inboxes;
        commitment_newest_hash;
        tezos_head_level;
        burn_per_byte;
        allocated_storage;
        occupied_storage;
        inbox_ema;
        commitments_watermark;
      })
    (merge_objs
       (obj10
          (req
             "last_removed_commitment_hashes"
             (option
             @@ obj2
                  (req
                     "last_message_hash"
                     Tx_rollup_message_result_hash_repr.encoding)
                  (req
                     "commitment_hash"
                     Tx_rollup_commitment_repr.Hash.encoding)))
          (req "finalized_commitments" range_encoding)
          (req "unfinalized_commitments" range_encoding)
          (req "uncommitted_inboxes" range_encoding)
          (req
             "commitment_newest_hash"
             (option Tx_rollup_commitment_repr.Hash.encoding))
          (req "tezos_head_level" (option Raw_level_repr.encoding))
          (req "burn_per_byte" Tez_repr.encoding)
          (req "allocated_storage" n)
          (req "occupied_storage" n)
          (req "inbox_ema" int31))
       (obj1
          (req "commitments_watermark" @@ option Tx_rollup_level_repr.encoding)))

let pp fmt
    {
      last_removed_commitment_hashes;
      finalized_commitments;
      unfinalized_commitments;
      uncommitted_inboxes;
      commitment_newest_hash;
      tezos_head_level;
      burn_per_byte;
      allocated_storage;
      occupied_storage;
      inbox_ema;
      commitments_watermark;
    } =
  Format.(
    fprintf
      fmt
      "cost_per_byte: %a inbox_ema: %d finalized_commitments: %a \
       unfinalized_commitments: %a uncommitted_inboxes: %a \
       commitment_newest_hash: %a tezos_head_level: %a \
       last_removed_commitment_hashes: %a allocated_storage: %a \
       occupied_storage: %a commitments_watermark: %a"
      Tez_repr.pp
      burn_per_byte
      inbox_ema
      pp_range
      finalized_commitments
      pp_range
      unfinalized_commitments
      pp_range
      uncommitted_inboxes
      (pp_print_option Tx_rollup_commitment_repr.Hash.pp)
      commitment_newest_hash
      (pp_print_option Raw_level_repr.pp)
      tezos_head_level
      (pp_print_option (fun fmt (m, c) ->
           fprintf
             fmt
             "(message result: %a, commitment: %a)"
             Tx_rollup_message_result_hash_repr.pp
             m
             Tx_rollup_commitment_repr.Hash.pp
             c))
      last_removed_commitment_hashes
      Z.pp_print
      allocated_storage
      Z.pp_print
      occupied_storage
      (pp_print_option Tx_rollup_level_repr.pp)
      commitments_watermark)

let adjust_storage_allocation : t -> delta:Z.t -> (t * Z.t) tzresult =
 fun state ~delta ->
  if Z.(equal zero delta) then ok (state, Z.zero)
  else
    let occupied_storage' = Z.add state.occupied_storage delta in
    if Compare.Z.(occupied_storage' < Z.zero) then
      (* returns [Internal_error] if [delta < 0] and [| delta | > state.occupied_storage].
         This error should never happen. *)
      error
      @@ Internal_error
           "Storage size should be positive after occupied space is freed."
    else
      let diff = Z.sub occupied_storage' state.allocated_storage in
      if Compare.Z.(diff > Z.zero) then
        let state =
          {
            state with
            occupied_storage = occupied_storage';
            allocated_storage = occupied_storage';
          }
        in
        ok (state, diff)
      else
        let state = {state with occupied_storage = occupied_storage'} in
        ok (state, Z.zero)

let update_burn_per_byte_helper :
    t -> factor:int -> final_size:int -> hard_limit:int -> t =
 fun ({burn_per_byte; inbox_ema; _} as state) ~factor ~final_size ~hard_limit ->
  let threshold_increase = 90 in
  let threshold_decrease = 80 in
  let variation_factor = 5L in
  let smoothing = 2 in
  (* The formula of the multiplier of EMA :

       smoothing / (1 + N)

     Suppose the period we want to observe is given by the
     [factor]. The common choice of smoothing is 2.
  *)
  let inbox_ema =
    inbox_ema + ((final_size - inbox_ema) * smoothing / (1 + factor))
  in
  let percentage = inbox_ema * 100 / hard_limit in
  let computation =
    let open Compare.Int in
    if threshold_decrease < percentage && percentage <= threshold_increase then
      (* constant case *)
      ok burn_per_byte
    else
      Tez_repr.(burn_per_byte *? variation_factor >>? fun x -> x /? 100L)
      >>? fun variation ->
      let variation =
        if Tez_repr.(variation = zero) then Tez_repr.one_mutez else variation
      in
      (* increase case *)
      if threshold_increase < percentage then
        Tez_repr.(burn_per_byte +? variation)
      else if percentage < threshold_decrease && Tez_repr.(zero < burn_per_byte)
      then
        (* decrease case, and strictly positive burn *)
        Tez_repr.(burn_per_byte -? variation)
      else (* decrease case, and burn equals zero *)
        ok burn_per_byte
  in
  match computation with
  | Ok burn_per_byte -> {state with burn_per_byte; inbox_ema}
  (* In the (very unlikely) event of an overflow, we force the burn to
     be the maximum amount. *)
  | Error _ -> {state with burn_per_byte = Tez_repr.max_mutez; inbox_ema}

let rec update_burn_per_byte :
    t -> elapsed:int -> factor:int -> final_size:int -> hard_limit:int -> t =
 fun state ~elapsed ~factor ~final_size ~hard_limit ->
  (* factor is expected to be a low number ~ 100 *)
  if Compare.Int.(elapsed > factor) then
    (* We do not need to compute precisely the new state. *)
    {state with burn_per_byte = Tez_repr.zero; inbox_ema = 0}
  else if Compare.Int.(elapsed <= 0) then
    (* Base case, we take into a account the [final_size] once. *)
    update_burn_per_byte_helper state ~factor ~final_size ~hard_limit
  else
    (* For all the blocks that do not contain inboxes, we act as if
       the inbox size was [0]. *)
    let state' =
      update_burn_per_byte_helper state ~factor ~final_size:0 ~hard_limit
    in
    let elapsed = elapsed - 1 in
    update_burn_per_byte state' ~elapsed ~factor ~final_size ~hard_limit

let has_valid_commitment_at {finalized_commitments; unfinalized_commitments; _}
    level =
  belongs_to finalized_commitments level
  || belongs_to unfinalized_commitments level

let inboxes_count {unfinalized_commitments; uncommitted_inboxes; _} =
  range_count unfinalized_commitments + range_count uncommitted_inboxes

let uncommitted_inboxes_count {uncommitted_inboxes; _} =
  range_count uncommitted_inboxes

let commitments_count {finalized_commitments; unfinalized_commitments; _} =
  range_count unfinalized_commitments + range_count finalized_commitments

let record_inbox_creation t level =
  (match t.tezos_head_level with
  | Some tezos_lvl ->
      error_when
        Raw_level_repr.(level <= tezos_lvl)
        (Internal_error "Trying to create an inbox in the past")
  | None -> ok ())
  >>? fun () ->
  let (uncommitted_inboxes, new_level) = extend t.uncommitted_inboxes in
  adjust_storage_allocation t ~delta:Tx_rollup_inbox_repr.size
  >>? fun (t, diff) ->
  ok
    ( {t with tezos_head_level = Some level; uncommitted_inboxes},
      new_level,
      diff )

let next_commitment_predecessor state = state.commitment_newest_hash

let finalized_commitment_oldest_level state =
  range_oldest state.finalized_commitments

let next_commitment_level state current_level =
  match
    ( range_oldest state.uncommitted_inboxes,
      range_newest state.uncommitted_inboxes )
  with
  | (Some oldest_level, Some newest_level) -> (
      if
        (* We want to return an error if there is only one inbox in the
           storage, and this inbox has been created in the current
           block. *)
        Tx_rollup_level_repr.(oldest_level < newest_level)
      then
        (* If [oldest_level < newest_level], we know we are not in
           this setup, and we can safely return [oldest_level]. *)
        ok oldest_level
      else
        (* Otherwise, we know that [oldest_level = newest_level], and we
           need to check at which Tezos level is has been created. *)
        match state.tezos_head_level with
        | Some newest_inbox_creation ->
            error_when
              Raw_level_repr.(current_level <= newest_inbox_creation)
              No_uncommitted_inbox
            >>? fun () -> ok oldest_level
        | None -> error (Internal_error "tezos_head_level was not properly set")
      )
  | (None, None) -> error No_uncommitted_inbox
  | (Some _, None) | (None, Some _) ->
      error (Internal_error "rollup state is inconsistent")

let next_commitment_to_finalize state =
  range_oldest state.unfinalized_commitments

let next_commitment_to_remove state = range_oldest state.finalized_commitments

let record_inbox_deletion state candidate =
  match range_oldest state.unfinalized_commitments with
  | Some level when Tx_rollup_level_repr.(candidate = level) ->
      shrink state.unfinalized_commitments >>? fun unfinalized_commitments ->
      let (finalized_commitments, _) = extend state.finalized_commitments in
      ok {state with unfinalized_commitments; finalized_commitments}
  | _ -> error (Internal_error "Trying to delete the wrong inbox")

let record_commitment_creation state level hash =
  match range_oldest state.uncommitted_inboxes with
  | Some oldest ->
      error_unless
        Tx_rollup_level_repr.(level = oldest)
        (Internal_error "Trying to create the wrong commitment")
      >>? fun () ->
      shrink state.uncommitted_inboxes >>? fun uncommitted_inboxes ->
      let (unfinalized_commitments, _) = extend state.unfinalized_commitments in
      let state =
        {
          state with
          uncommitted_inboxes;
          unfinalized_commitments;
          commitment_newest_hash = Some hash;
        }
      in
      if is_above_watermark state.commitments_watermark level then
        (* See {{Note inbox}} in [Tx_rollup_commitment_storage] for
           why it is safe to “free” the inbox storage when it is
           committed too. *)
        adjust_storage_allocation state ~delta:(Z.neg Tx_rollup_inbox_repr.size)
        >>? fun (state, _) ->
        ok {state with commitments_watermark = make_watermark level}
      else ok state
  | None ->
      error (Internal_error "Cannot create a commitment due to lack of inbox")

let record_commitment_rejection state level predecessor_hash =
  let unwrap_option msg = function
    | Some x -> ok x
    | _ -> error (Internal_error msg)
  in
  let check_none msg = function
    | None -> ok ()
    | Some _ -> error (Internal_error msg)
  in
  left_extend state.uncommitted_inboxes level >>? fun uncommitted_inboxes ->
  let state = {state with uncommitted_inboxes} in
  right_cut state.unfinalized_commitments level
  >>? fun unfinalized_commitments ->
  match Tx_rollup_level_repr.pred level with
  | Some pred_level
    when belongs_to state.unfinalized_commitments pred_level
         || belongs_to state.finalized_commitments pred_level ->
      (* Case 1. Predecessor level of the rejected commitments has a commitment in the storage *)
      unwrap_option "Missing predecessor commitment" predecessor_hash
      >>? fun predecessor_hash ->
      ok
        {
          state with
          unfinalized_commitments;
          commitment_newest_hash = Some predecessor_hash;
        }
  | Some _ ->
      (* Case 2. Predecessor level of the rejected commitments has its
         commitment removed from the storage *)
      check_none "Unexpected predecessor hash" predecessor_hash >>? fun () ->
      unwrap_option
        "Missing commitment hash"
        state.last_removed_commitment_hashes
      >>? fun (_, pred_hash) ->
      ok
        {
          state with
          unfinalized_commitments;
          commitment_newest_hash = Some pred_hash;
        }
  | None ->
      (* Case 3. The rejected commitment is the commitment of the root level *)
      ok {state with unfinalized_commitments; commitment_newest_hash = None}

let record_commitment_deletion state level hash message_hash =
  match range_oldest state.finalized_commitments with
  | Some oldest when Tx_rollup_level_repr.(level = oldest) ->
      shrink state.finalized_commitments >>? fun finalized_commitments ->
      ok
        {
          state with
          finalized_commitments;
          last_removed_commitment_hashes = Some (message_hash, hash);
        }
  | _ -> error (Internal_error "Trying to remove an incorrect commitment")

let burn_cost ~limit state size =
  Tez_repr.(state.burn_per_byte *? Int64.of_int size) >>? fun burn ->
  match limit with
  | Some limit when Tez_repr.(limit >= burn) ->
      error (Submit_batch_burn_exceeded {burn; limit})
  | _ -> ok burn

let finalized_commitments_range state =
  match
    ( range_oldest state.finalized_commitments,
      range_newest state.finalized_commitments )
  with
  | (Some oldest, Some newest) -> Some (oldest, newest)
  | _ -> None

let check_level_can_be_rejected state level =
  match
    ( range_oldest state.unfinalized_commitments,
      range_newest state.unfinalized_commitments )
  with
  | (Some oldest, Some newest) ->
      error_unless Tx_rollup_level_repr.(oldest <= level && level <= newest)
      @@ Cannot_reject_level
           {provided = level; accepted_range = Some (oldest, newest)}
  | _ -> error @@ Cannot_reject_level {provided = level; accepted_range = None}

let last_removed_commitment_hashes state = state.last_removed_commitment_hashes

let head_levels state =
  match (state.uncommitted_inboxes, state.tezos_head_level) with
  | (Empty {next = l}, Some tz_level) ->
      Option.map (fun l -> (l, tz_level)) (Tx_rollup_level_repr.pred l)
  | (Interval {newest; _}, Some tz_level) -> Some (newest, tz_level)
  | _ -> None

module Internal_for_tests = struct
  let make :
      ?burn_per_byte:Tez_repr.t ->
      ?inbox_ema:int ->
      ?last_removed_commitment_hashes:
        Tx_rollup_message_result_hash_repr.t * Tx_rollup_commitment_repr.Hash.t ->
      ?finalized_commitments:Tx_rollup_level_repr.t * Tx_rollup_level_repr.t ->
      ?unfinalized_commitments:Tx_rollup_level_repr.t * Tx_rollup_level_repr.t ->
      ?uncommitted_inboxes:Tx_rollup_level_repr.t * Tx_rollup_level_repr.t ->
      ?commitment_newest_hash:Tx_rollup_commitment_repr.Hash.t ->
      ?tezos_head_level:Raw_level_repr.t ->
      ?occupied_storage:Z.t ->
      ?commitments_watermark:Tx_rollup_level_repr.t ->
      allocated_storage:Z.t ->
      unit ->
      t =
   fun ?(burn_per_byte = Tez_repr.zero)
       ?(inbox_ema = 0)
       ?last_removed_commitment_hashes
       ?finalized_commitments
       ?unfinalized_commitments
       ?uncommitted_inboxes
       ?commitment_newest_hash
       ?tezos_head_level
       ?(occupied_storage = Z.zero)
       ?commitments_watermark
       ~allocated_storage
       () ->
    let to_range = function
      | Some (oldest, newest) ->
          assert (Tx_rollup_level_repr.(oldest <= newest)) ;
          Interval {oldest; newest}
      | _ -> Empty {next = Tx_rollup_level_repr.root}
    in

    let unfinalized_commitments = to_range unfinalized_commitments in
    let finalized_commitments = to_range finalized_commitments in
    let uncommitted_inboxes = to_range uncommitted_inboxes in

    {
      last_removed_commitment_hashes;
      burn_per_byte;
      occupied_storage;
      allocated_storage;
      inbox_ema;
      finalized_commitments;
      unfinalized_commitments;
      uncommitted_inboxes;
      commitment_newest_hash;
      tezos_head_level;
      commitments_watermark;
    }

  let get_inbox_ema : t -> int = fun {inbox_ema; _} -> inbox_ema

  let get_occupied_storage : t -> Z.t =
   fun {occupied_storage; _} -> occupied_storage

  let set_occupied_storage : Z.t -> t -> t =
   fun occupied_storage st -> {st with occupied_storage}

  let get_allocated_storage : t -> Z.t =
   fun {allocated_storage; _} -> allocated_storage

  let set_allocated_storage : Z.t -> t -> t =
   fun allocated_storage st -> {st with allocated_storage}

  let reset_commitments_watermark : t -> t =
   fun st -> {st with commitments_watermark = None}

  let get_commitments_watermark : t -> Tx_rollup_level_repr.t option =
   fun st -> st.commitments_watermark
end