(*****************************************************************************)
(* *)
(* 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. *)
(* *)
(*****************************************************************************)
(* module Constants will be shadowed by Alpha_context.Constansts
once we open Alpha_context, hence we we alias it to Rollup_node_constants
*)
open Protocol
open Alpha_context
let lift promise = Lwt.map Environment.wrap_tzresult promise
let get_messages Node_context.{l1_ctxt; _} head =
let open Lwt_result_syntax in
let* block = Layer1.fetch_tezos_block l1_ctxt head in
let apply (type kind) accu ~source:_ (operation : kind manager_operation)
_result =
let open Result_syntax in
let+ accu in
match operation with
| Sc_rollup_add_messages {messages} ->
let messages =
List.map
(fun message -> Sc_rollup.Inbox_message.External message)
messages
in
List.rev_append messages accu
| _ -> accu
in
let apply_internal (type kind) accu ~source
(operation : kind Apply_internal_results.internal_operation)
(result :
kind Apply_internal_results.successful_internal_operation_result) =
let open Result_syntax in
let* accu in
match (operation, result) with
| ( {
operation = Transaction {destination = Sc_rollup rollup; parameters; _};
source = Contract (Originated sender);
_;
},
ITransaction_result (Transaction_to_sc_rollup_result _) ) ->
let+ payload =
Environment.wrap_tzresult @@ Script_repr.force_decode parameters
in
let message =
Sc_rollup.Inbox_message.Transfer
{destination = rollup; payload; sender; source}
in
Sc_rollup.Inbox_message.Internal message :: accu
| _ -> return accu
in
let*? rev_messages =
Layer1_services.(
process_applied_manager_operations
(Ok [])
block.operations
{apply; apply_internal})
in
let ({predecessor; _} : Block_header.shell_header) = block.header.shell in
let* {
timestamp = predecessor_timestamp;
proto_level = predecessor_proto_level;
_;
} =
Layer1.fetch_tezos_shell_header l1_ctxt predecessor
in
let is_migration_block =
block.header.shell.proto_level <> predecessor_proto_level
in
return
( is_migration_block,
List.rev rev_messages,
predecessor_timestamp,
predecessor )
let same_inbox_as_layer_1 node_ctxt head_hash inbox =
let open Lwt_result_syntax in
let head_block = `Hash (head_hash, 0) in
let Node_context.{cctxt; _} = node_ctxt in
let* layer1_inbox =
Plugin.RPC.Sc_rollup.inbox cctxt (cctxt#chain, head_block)
in
fail_unless
(Sc_rollup.Inbox.equal layer1_inbox inbox)
(Sc_rollup_node_errors.Inconsistent_inbox {layer1_inbox; inbox})
let add_messages ~is_migration_block ~predecessor_timestamp ~predecessor inbox
messages =
let open Lwt_result_syntax in
let no_history = Sc_rollup.Inbox.History.empty ~capacity:0L in
lift
@@ let*? ( messages_history,
_no_history,
inbox,
witness,
messages_with_protocol_internal_messages ) =
Sc_rollup.Inbox.add_all_messages
~first_block:is_migration_block
~predecessor_timestamp
~predecessor
no_history
inbox
messages
in
let witness_hash =
Sc_rollup.Inbox_merkelized_payload_hashes.hash witness
in
return
( messages_history,
witness_hash,
inbox,
messages_with_protocol_internal_messages )
let process_head (node_ctxt : _ Node_context.t)
Layer1.({level; hash = head_hash} as head) =
let open Lwt_result_syntax in
let first_inbox_level =
Raw_level.to_int32 node_ctxt.genesis_info.level |> Int32.succ
in
if level >= first_inbox_level then (
(*
We compute the inbox of this block using the inbox of its
predecessor. That way, the computation of inboxes is robust
to chain reorganization.
*)
let* predecessor = Layer1.get_predecessor node_ctxt.l1_ctxt head in
let* inbox = Node_context.inbox_of_head node_ctxt predecessor in
let inbox_metrics = Metrics.Inbox.metrics in
Prometheus.Gauge.set inbox_metrics.head_inbox_level @@ Int32.to_float level ;
let*? level = Environment.wrap_tzresult @@ Raw_level.of_int32 level in
let* ctxt =
if Raw_level.(level <= node_ctxt.Node_context.genesis_info.level) then
(* This is before we have interpreted the boot sector, so we start
with an empty context in genesis *)
return (Context.empty node_ctxt.context)
else Node_context.checkout_context node_ctxt predecessor.hash
in
let* ( is_migration_block,
collected_messages,
predecessor_timestamp,
predecessor_hash ) =
get_messages node_ctxt head_hash
in
let*! () =
Inbox_event.get_messages
head_hash
(Raw_level.to_int32 level)
(List.length collected_messages)
in
let* ( _messages_history,
witness_hash,
inbox,
messages_with_protocol_internal_messages ) =
add_messages
~is_migration_block
~predecessor_timestamp
~predecessor:predecessor_hash
inbox
collected_messages
in
Metrics.Inbox.Stats.head_messages_list :=
messages_with_protocol_internal_messages ;
let* () =
Node_context.save_messages
node_ctxt
witness_hash
{
is_migration_block;
predecessor = predecessor_hash;
predecessor_timestamp;
messages = collected_messages;
}
in
let* () = same_inbox_as_layer_1 node_ctxt head_hash inbox in
let* inbox_hash = Node_context.save_inbox node_ctxt inbox in
return
( inbox_hash,
inbox,
witness_hash,
messages_with_protocol_internal_messages,
ctxt ))
else
let* inbox = Node_context.genesis_inbox node_ctxt in
return
( Sc_rollup.Inbox.hash inbox,
inbox,
Sc_rollup.Inbox.current_witness inbox,
[],
Context.empty node_ctxt.context )
let start () = Inbox_event.starting ()
let payloads_history_of_messages ~is_migration_block ~predecessor
~predecessor_timestamp messages =
let open Result_syntax in
let dummy_inbox =
(* The inbox is not necessary to compute the payloads *)
Sc_rollup.Inbox.genesis ~predecessor_timestamp ~predecessor Raw_level.root
in
let+ ( payloads_history,
_history,
_inbox,
_witness,
_messages_with_protocol_internal_messages ) =
(* TODO: https://gitlab.com/tezos/tezos/-/issues/4918 Inject
[Protocol_migration (Proto_017)] when migrating to proto_alpha
(N after next snapshot). *)
Environment.wrap_tzresult
@@ Sc_rollup.Inbox.add_all_messages
~first_block:is_migration_block
~predecessor_timestamp
~predecessor
(Sc_rollup.Inbox.History.empty ~capacity:0L)
dummy_inbox
messages
in
payloads_history