Source file sc_rollup_inbox_merkelized_payload_hashes_repr.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2022 Nomadic Labs <contact@nomadic-labs.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.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error += (* `Permanent *) Merkelized_payload_hashes_proof_error of string

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"internal.smart_rollup_merklized_payload_hashes_proof"
    ~title:
      "Internal error: error occurred during proof production or validation"
    ~description:"A merkelized payload hashes proof error."
    ~pp:(fun ppf e -> Format.fprintf ppf "Proof error: %s" e)
    (obj1 (req "error" (string Plain)))
    (function Merkelized_payload_hashes_proof_error e -> Some e | _ -> None)
    (fun e -> Merkelized_payload_hashes_proof_error e)

module Skip_list_parameters = struct
  let basis = 4
end

module Skip_list = Skip_list_repr.Make (Skip_list_parameters)

(* 32 *)
let hash_prefix = "\003\255\138\145\140" (* srib2(55) *)

module Hash = struct
  let prefix = "srib2"

  let encoded_size = 55

  module H =
    Blake2B.Make
      (Base58)
      (struct
        let name = "Smart_rollup_merkelized_payload_hashes_hash"

        let title =
          "The merkelized payload hashes' hash of the smart rollup inbox"

        let b58check_prefix = hash_prefix

        (* defaults to 32 *)
        let size = None
      end)

  include H

  let () = Base58.check_encoded_prefix b58check_encoding prefix encoded_size
end

type t = (Sc_rollup_inbox_message_repr.Hash.t, Hash.t) Skip_list.cell

let equal = Skip_list.equal Hash.equal Sc_rollup_inbox_message_repr.Hash.equal

let hash merkelized =
  let payload_hash = Skip_list.content merkelized in
  let back_pointers_hashes = Skip_list.back_pointers merkelized in
  Sc_rollup_inbox_message_repr.Hash.to_bytes payload_hash
  :: List.map Hash.to_bytes back_pointers_hashes
  |> Hash.hash_bytes

let pp =
  Skip_list.pp ~pp_content:Sc_rollup_inbox_message_repr.Hash.pp ~pp_ptr:Hash.pp

let encoding =
  Skip_list.encoding Hash.encoding Sc_rollup_inbox_message_repr.Hash.encoding

type merkelized_and_payload = {
  merkelized : t;
  payload : Sc_rollup_inbox_message_repr.serialized;
}

let equal_merkelized_and_payload {merkelized; payload} mp2 =
  equal merkelized mp2.merkelized
  && String.equal (payload :> string) (mp2.payload :> string)

let pp_merkelized_and_payload fmt {merkelized; payload} =
  Format.fprintf
    fmt
    "@[<hv 2>merkelized:@,%a@,payload: %a@]"
    pp
    merkelized
    Format.pp_print_string
    (payload :> string)

let merkelized_and_payload_encoding =
  let open Data_encoding in
  conv
    (fun {merkelized; payload} -> (merkelized, (payload :> string)))
    (fun (merkelized, payload) ->
      {
        merkelized;
        payload = Sc_rollup_inbox_message_repr.unsafe_of_string payload;
      })
    (merge_objs encoding (obj1 (req "payload" (string Hex))))

module History = struct
  include
    Bounded_history_repr.Make
      (struct
        let name = "Smart_rollup_level_inbox_history"
      end)
      (Hash)
      (struct
        type nonrec t = merkelized_and_payload

        let pp = pp_merkelized_and_payload

        let equal = equal_merkelized_and_payload

        let encoding = merkelized_and_payload_encoding
      end)

  let no_history = empty ~capacity:0L
end

let remember history merkelized payload =
  let prev_cell_ptr = hash merkelized in
  History.remember prev_cell_ptr {merkelized; payload} history

let genesis history payload =
  let open Result_syntax in
  let payload_hash =
    Sc_rollup_inbox_message_repr.hash_serialized_message payload
  in
  let merkelized = Skip_list.genesis payload_hash in
  let+ history = remember history merkelized payload in
  (history, merkelized)

let add_payload history prev_merkelized payload =
  let open Result_syntax in
  let prev_merkelized_ptr = hash prev_merkelized in
  let merkelized =
    Skip_list.next
      ~prev_cell:prev_merkelized
      ~prev_cell_ptr:prev_merkelized_ptr
      (Sc_rollup_inbox_message_repr.hash_serialized_message payload)
  in
  let* history = remember history merkelized payload in
  return (history, merkelized)

let get_payload_hash = Skip_list.content

let get_index = Skip_list.index

type proof = t list

let pp_proof = Format.pp_print_list pp

let proof_encoding = Data_encoding.list encoding

let produce_proof history ~index merkelized =
  let open Option_syntax in
  let deref ptr =
    let* {merkelized; payload = _} = History.find ptr history in
    return merkelized
  in
  let current_ptr = hash merkelized in
  let lift_ptr =
    let rec aux acc = function
      | [] -> None
      | [last_ptr] ->
          let+ ({merkelized; _} as merkelized_and_payload) =
            History.find last_ptr history
          in
          (merkelized_and_payload, List.rev (merkelized :: acc))
      | ptr :: rest ->
          let* merkelized = deref ptr in
          aux (merkelized :: acc) rest
    in
    aux []
  in
  let* ptr_path =
    Skip_list.back_path ~deref ~cell_ptr:current_ptr ~target_index:index
  in
  lift_ptr ptr_path

let verify_proof inclusion_proof =
  let open Result_syntax in
  let* cell =
    match inclusion_proof with
    | cell :: _ -> ok cell
    | [] ->
        error (Merkelized_payload_hashes_proof_error "inclusion proof is empty")
  in
  let rec aux (hash_map, ptr_list) = function
    | [] ->
        error (Merkelized_payload_hashes_proof_error "inclusion proof is empty")
    | [target] ->
        let target_ptr = hash target in
        let hash_map = Hash.Map.add target_ptr target hash_map in
        let ptr_list = List.rev (target_ptr :: ptr_list) in
        ok (hash_map, ptr_list, target, target_ptr)
    | merkelized :: tail ->
        let ptr = hash merkelized in
        aux (Hash.Map.add ptr merkelized hash_map, ptr :: ptr_list) tail
  in
  let* hash_map, ptr_list, target, target_ptr =
    aux (Hash.Map.empty, []) inclusion_proof
  in
  let deref ptr = Hash.Map.find ptr hash_map in
  let cell_ptr = hash cell in
  let* () =
    error_unless
      (Skip_list.valid_back_path
         ~equal_ptr:Hash.equal
         ~deref
         ~cell_ptr
         ~target_ptr
         ptr_list)
      (Merkelized_payload_hashes_proof_error "invalid inclusion proof")
  in
  return (target, cell)

module Internal_for_tests = struct
  let find_predecessor_payload payloads_history ~index payloads =
    let open Option_syntax in
    let deref ptr =
      let* {merkelized; _} = History.find ptr payloads_history in
      return merkelized
    in
    let cell_ptr = hash payloads in
    Skip_list.find ~deref ~cell_ptr ~target_index:index

  let make_proof proof = proof
end