diff --git a/src/proto_alpha/bin_sc_rollup_node/interpreter_event.mli b/src/proto_alpha/bin_sc_rollup_node/fuel.ml similarity index 57% rename from src/proto_alpha/bin_sc_rollup_node/interpreter_event.mli rename to src/proto_alpha/bin_sc_rollup_node/fuel.ml index bfff5931bf2d49b37820990d0eaeed55aaf7fa76..dd662dac1d1eed30688ca01badbf0d7a5cc426b2 100644 --- a/src/proto_alpha/bin_sc_rollup_node/interpreter_event.mli +++ b/src/proto_alpha/bin_sc_rollup_node/fuel.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs *) +(* Copyright (c) 2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -23,27 +23,65 @@ (* *) (*****************************************************************************) -(** This module defines functions that emit the events used when running a PVM - transition (see {!Interpreter}). *) - -module Make (PVM : Pvm.S) : sig - (** [transition_pvm inbox_level hash n] emits the event that a PVM - transition is leading to the state of the given [hash] by - processing [n] messages. *) - val transitioned_pvm : - Protocol.Alpha_context.Raw_level.t -> PVM.state -> Z.t -> unit Lwt.t - - (** [intended_failure level message_index message_tick internal] emits - the event that an intended failure has been injected at some given - [level], during the processing of a given [message_index] and at - tick [message_tick] during this message processing. [internal] is - [true] if the failure is injected in a PVM internal - step. [internal] is [false] if the failure is injected in the input - to the PVM. *) - val intended_failure : - level:int -> - message_index:int -> - message_tick:int64 -> - internal:bool -> - unit Lwt.t +module type S = sig + type t + + (** [consume consumption fuel] consumes the [consumption] amount from the + original [fuel] + It returns + None when the [consumption] is greater than the original [fuel] or + Some remaining fuel + *) + val consume : t -> t -> t option + + (** The amount of fuel required to run one PVM tick. + + one_tick_consumption = of_ticks 1L + *) + val one_tick_consumption : t + + (** [of_ticks ticks] gives the amount of fuel required to execute the amount of [ticks] + *) + val of_ticks : int64 -> t + + val is_empty : t -> bool + + (** The maximum number of ticks that can be executed with the given amount of fuel + + max_ticks . of_ticks = id + of_ticks . max_ticks = id + *) + val max_ticks : t -> int64 +end + +module Free : S = struct + type t = Free + + let one_tick_consumption = Free + + let of_ticks _ = Free + + let consume _ tank = Some tank + + let is_empty _ = false + + let max_ticks _ = Int64.max_int +end + +module Accounted : S = struct + type t = int64 + + let of_ticks i = + assert (Int64.compare i 0L > 0) ; + i + + let one_tick_consumption = 1L + + let consume consumption fuel = + if Int64.compare fuel consumption > 0 then Some (Int64.sub fuel consumption) + else None + + let is_empty fuel = Int64.compare fuel 0L <= 0 + + let max_ticks fuel_left = Int64.max 0L fuel_left end diff --git a/src/proto_alpha/bin_sc_rollup_node/fueled_pvm.ml b/src/proto_alpha/bin_sc_rollup_node/fueled_pvm.ml new file mode 100644 index 0000000000000000000000000000000000000000..755474cc2f194063135e848242b82f7844815ee4 --- /dev/null +++ b/src/proto_alpha/bin_sc_rollup_node/fueled_pvm.ml @@ -0,0 +1,260 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Nomadic Labs, *) +(* *) +(* 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 Protocol +open Alpha_context +module Inbox = Sc_rollup.Inbox +open Protocol +open Alpha_context + +module type S = sig + type state + + type fuel + + val eval_block_inbox : + metadata:Sc_rollup.Metadata.t -> + dal_endorsement_lag:int -> + fuel:fuel -> + Node_context.t -> + Block_hash.t -> + state -> + (state * Z.t * Raw_level.t * fuel, tztrace) result Lwt.t +end + +module Make + (PVM : Pvm.S) + (Interpreter_event : Interpreter_event.S with type state := PVM.state) + (F : Fuel.S) : S with type state = PVM.state and type fuel = F.t = struct + type state = PVM.state + + type fuel = F.t + + let continue_with_fuel consumption initial_fuel state f = + let open Lwt_result_syntax in + match F.consume consumption initial_fuel with + | None -> return (state, 0L) + | Some fuel_left -> f fuel_left state + + (** [eval_until_input ~metadata level message_index ~fuel start_tick + failing_ticks state] advances a PVM [state] until it wants more + inputs or there are no more [fuel] (if [Some fuel] is + specified). The evaluation is running under the processing of + some [message_index] at a given [level] and this is the + [start_tick] of this message processing. If some [failing_ticks] + are planned by the loser mode, they will be made. *) + let eval_until_input ~metadata ~dal_endorsement_lag data_dir store level + message_index ~fuel start_tick failing_ticks state = + let open Lwt_result_syntax in + let eval_tick fuel tick failing_ticks state = + let max_steps = F.max_ticks fuel in + let normal_eval state = + let*! state, executed_ticks = PVM.eval_many ~max_steps state in + return (state, executed_ticks, failing_ticks) + in + let failure_insertion_eval state failing_ticks' = + let*! () = + Interpreter_event.intended_failure + ~level + ~message_index + ~message_tick:tick + ~internal:true + in + let*! state = PVM.Internal_for_tests.insert_failure state in + return (state, 1L, failing_ticks') + in + match failing_ticks with + | xtick :: failing_ticks' when xtick = tick -> + failure_insertion_eval state failing_ticks' + | _ -> normal_eval state + in + let rec go (fuel : fuel) current_tick failing_ticks state = + let*! input_request = PVM.is_input_state state in + if F.is_empty fuel then return (state, fuel, current_tick, failing_ticks) + else + match input_request with + | No_input_required -> + let* next_state, executed_ticks, failing_ticks = + eval_tick fuel current_tick failing_ticks state + in + + go + fuel + (Int64.add current_tick executed_ticks) + failing_ticks + next_state + | Needs_reveal (Reveal_raw_data hash) -> ( + match Reveals.get ~data_dir ~pvm_name:PVM.name ~hash with + | None -> tzfail (Sc_rollup_node_errors.Cannot_retrieve_reveal hash) + | Some data -> ( + let*! next_state = + PVM.set_input (Reveal (Raw_data data)) state + in + match F.consume F.one_tick_consumption fuel with + | None -> return (state, fuel, current_tick, failing_ticks) + | Some fuel -> + go fuel (Int64.succ current_tick) failing_ticks next_state)) + | Needs_reveal Reveal_metadata -> ( + let*! next_state = + PVM.set_input (Reveal (Metadata metadata)) state + in + match F.consume F.one_tick_consumption fuel with + | None -> return (state, fuel, current_tick, failing_ticks) + | Some fuel -> + go fuel (Int64.succ current_tick) failing_ticks next_state) + | Needs_reveal (Request_dal_page page_id) -> ( + let* content_opt = + Dal_pages_request.page_content ~dal_endorsement_lag store page_id + in + let*! next_state = + PVM.set_input (Reveal (Dal_page content_opt)) state + in + match F.consume F.one_tick_consumption fuel with + | None -> return (state, fuel, current_tick, failing_ticks) + | Some fuel -> + go fuel (Int64.succ current_tick) failing_ticks next_state) + | Initial | First_after _ -> + return (state, fuel, current_tick, failing_ticks) + in + go fuel start_tick failing_ticks state + + (** [mutate input] corrupts the payload of [input] for testing purposes. *) + let mutate input = + let payload = Sc_rollup.Inbox_message.unsafe_of_string "0xC4C4" in + {input with Sc_rollup.payload} + + (** [feed_input ~metadata level message_index ~fuel ~failing_ticks state + input] feeds [input] (that has a given [message_index] in inbox + of [level]) to the PVM in order to advance [state] to the next + step that requires an input. This function is controlled by + some [fuel] and may introduce intended failures at some given + [failing_ticks]. *) + let feed_input ~metadata ~dal_endorsement_lag data_dir store level + message_index ~fuel ~failing_ticks state input = + let open Lwt_result_syntax in + let* state, fuel, tick, failing_ticks = + eval_until_input + ~metadata + ~dal_endorsement_lag + data_dir + store + level + message_index + ~fuel + 0L + failing_ticks + state + in + let consumption = F.of_ticks tick in + continue_with_fuel consumption fuel state @@ fun fuel state -> + let* input, failing_ticks = + match failing_ticks with + | xtick :: failing_ticks' -> + if xtick = tick then + let*! () = + Interpreter_event.intended_failure + ~level + ~message_index + ~message_tick:tick + ~internal:false + in + return (mutate input, failing_ticks') + else return (input, failing_ticks) + | _ -> return (input, failing_ticks) + in + let*! state = PVM.set_input (Inbox_message input) state in + let* state, _fuel, tick, _failing_ticks = + eval_until_input + ~metadata + ~dal_endorsement_lag + data_dir + store + level + message_index + ~fuel + tick + failing_ticks + state + in + return (state, tick) + + let eval_block_inbox ~metadata ~dal_endorsement_lag ~fuel + Node_context.{data_dir; store; loser_mode; _} hash (state : state) : + (state * Z.t * Raw_level.t * fuel, tztrace) result Lwt.t = + let open Lwt_result_syntax in + (* Obtain inbox and its messages for this block. *) + let*! inbox = Store.Inboxes.find store hash in + match inbox with + | None -> + (* A level with no messages for use. Skip it. *) + let* level = State.level_of_hash store hash in + return (state, Z.zero, Raw_level.of_int32_exn level, fuel) + | Some inbox -> + let inbox_level = Inbox.inbox_level inbox in + let*! messages = Store.Messages.get store hash in + (* TODO: #2717 + The length of messages here can potentially overflow the [int] returned from [List.length]. + *) + let num_messages = List.length messages |> Z.of_int in + + let feed_message (message_counter : int) (state, fuel) + (message : Sc_rollup.Inbox_message.t) = + let*? payload = + Sc_rollup.Inbox_message.( + message |> serialize |> Environment.wrap_tzresult) + in + let input = + Sc_rollup. + {inbox_level; message_counter = Z.of_int message_counter; payload} + in + let level = Raw_level.to_int32 inbox_level |> Int32.to_int in + + let failing_ticks = + Loser_mode.is_failure + loser_mode + ~level + ~message_index:message_counter + in + let* state, executed_ticks = + feed_input + ~metadata + ~dal_endorsement_lag + data_dir + store + level + message_counter + ~fuel + ~failing_ticks + state + input + in + return (state, F.of_ticks executed_ticks) + in + (* Iterate the PVM state with all the messages for this level. *) + let* state, fuel = + List.fold_left_i_es feed_message (state, fuel) messages + in + return (state, num_messages, inbox_level, fuel) +end diff --git a/src/proto_alpha/bin_sc_rollup_node/interpreter.ml b/src/proto_alpha/bin_sc_rollup_node/interpreter.ml index 2680c606856f2cfe0c88a20656bd604be6a6a3f0..cfc4187c10eac60a67041dd832d4ed27f86edd7f 100644 --- a/src/proto_alpha/bin_sc_rollup_node/interpreter.ml +++ b/src/proto_alpha/bin_sc_rollup_node/interpreter.ml @@ -25,7 +25,6 @@ open Protocol open Alpha_context -module Inbox = Sc_rollup.Inbox module type S = sig module PVM : Pvm.S @@ -50,7 +49,13 @@ end module Make (PVM : Pvm.S) : S with module PVM = PVM = struct module PVM = PVM - module Interpreter_event = Interpreter_event.Make (PVM) + + module Interpreter_event : Interpreter_event.S with type state := PVM.state = + Interpreter_event.Make (PVM) + + module Accounted_pvm = + Fueled_pvm.Make (PVM) (Interpreter_event) (Fuel.Accounted) + module Free_pvm = Fueled_pvm.Make (PVM) (Interpreter_event) (Fuel.Free) (** [metadata node_ctxt] creates a {Sc_rollup.Metadata.t} using the information stored in [node_ctxt]. *) @@ -59,225 +64,6 @@ module Make (PVM : Pvm.S) : S with module PVM = PVM = struct let origination_level = node_ctxt.genesis_info.Sc_rollup.Commitment.level in Sc_rollup.Metadata.{address; origination_level} - let consume_fuel consumption = - Option.map (fun fuel -> Int64.sub fuel consumption) - - let continue_with_fuel consumption fuel state f = - let open Lwt_result_syntax in - match fuel with - | Some 0L -> return (state, fuel) - | _ -> f (consume_fuel consumption fuel) state - - (** [eval_until_input ~metadata level message_index ~fuel start_tick - failing_ticks state] advances a PVM [state] until it wants more - inputs or there are no more [fuel] (if [Some fuel] is - specified). The evaluation is running under the processing of - some [message_index] at a given [level] and this is the - [start_tick] of this message processing. If some [failing_ticks] - are planned by the loser mode, they will be made. *) - let eval_until_input ~metadata ~dal_endorsement_lag data_dir store level - message_index ~fuel start_tick failing_ticks state = - let open Lwt_result_syntax in - let eval_tick fuel_left tick failing_ticks state = - let max_steps = - match fuel_left with None -> Int64.max_int | Some v -> Int64.max 0L v - in - let normal_eval state = - let*! state, executed_ticks = PVM.eval_many ~max_steps state in - return (state, executed_ticks, failing_ticks) - in - let failure_insertion_eval state failing_ticks' = - let*! () = - Interpreter_event.intended_failure - ~level - ~message_index - ~message_tick:tick - ~internal:true - in - let*! state = PVM.Internal_for_tests.insert_failure state in - return (state, 1L, failing_ticks') - in - match failing_ticks with - | xtick :: failing_ticks' when xtick = tick -> - failure_insertion_eval state failing_ticks' - | _ -> normal_eval state - in - let rec go fuel_left current_tick failing_ticks state = - let*! input_request = PVM.is_input_state state in - match fuel_left with - | Some 0L -> return (state, fuel_left, current_tick, failing_ticks) - | None | Some _ -> ( - match input_request with - | No_input_required -> - let* next_state, executed_ticks, failing_ticks = - eval_tick fuel_left current_tick failing_ticks state - in - go - (consume_fuel executed_ticks fuel_left) - (Int64.add current_tick executed_ticks) - failing_ticks - next_state - | Needs_reveal (Reveal_raw_data hash) -> ( - match Reveals.get ~data_dir ~pvm_name:PVM.name ~hash with - | None -> - tzfail (Sc_rollup_node_errors.Cannot_retrieve_reveal hash) - | Some data -> - let*! next_state = - PVM.set_input (Reveal (Raw_data data)) state - in - go - (consume_fuel 1L fuel_left) - (Int64.succ current_tick) - failing_ticks - next_state) - | Needs_reveal Reveal_metadata -> - let*! next_state = - PVM.set_input (Reveal (Metadata metadata)) state - in - go - (consume_fuel 1L fuel_left) - (Int64.succ current_tick) - failing_ticks - next_state - | Needs_reveal (Request_dal_page page_id) -> - let* content_opt = - Dal_pages_request.page_content - ~dal_endorsement_lag - store - page_id - in - let*! next_state = - PVM.set_input (Reveal (Dal_page content_opt)) state - in - go - (consume_fuel 1L fuel) - (Int64.succ current_tick) - failing_ticks - next_state - | Initial | First_after _ -> - return (state, fuel, current_tick, failing_ticks)) - in - go fuel start_tick failing_ticks state - - (** [mutate input] corrupts the payload of [input] for testing purposes. *) - let mutate input = - let payload = Sc_rollup.Inbox_message.unsafe_of_string "0xC4C4" in - {input with Sc_rollup.payload} - - (** [feed_input ~metadata level message_index ~fuel ~failing_ticks state - input] feeds [input] (that has a given [message_index] in inbox - of [level]) to the PVM in order to advance [state] to the next - step that requires an input. This function is controlled by - some [fuel] and may introduce intended failures at some given - [failing_ticks]. *) - let feed_input ~metadata ~dal_endorsement_lag data_dir store level - message_index ~fuel ~failing_ticks state input = - let open Lwt_result_syntax in - let* state, fuel, tick, failing_ticks = - eval_until_input - ~metadata - ~dal_endorsement_lag - data_dir - store - level - message_index - ~fuel - 0L - failing_ticks - state - in - continue_with_fuel tick fuel state @@ fun fuel state -> - let* input, failing_ticks = - match failing_ticks with - | xtick :: failing_ticks' -> - if xtick = tick then - let*! () = - Interpreter_event.intended_failure - ~level - ~message_index - ~message_tick:tick - ~internal:false - in - return (mutate input, failing_ticks') - else return (input, failing_ticks) - | _ -> return (input, failing_ticks) - in - let*! state = PVM.set_input (Inbox_message input) state in - let* state, fuel, _tick, _failing_ticks = - eval_until_input - ~metadata - ~dal_endorsement_lag - data_dir - store - level - message_index - ~fuel - tick - failing_ticks - state - in - return (state, fuel) - - let eval_block_inbox ~metadata ~dal_endorsement_lag ?fuel - Node_context.{data_dir; store; loser_mode; _} hash state = - let open Lwt_result_syntax in - (* Obtain inbox and its messages for this block. *) - let*! inbox = Store.Inboxes.find store hash in - match inbox with - | None -> - (* A level with no messages for use. Skip it. *) - let* level = State.level_of_hash store hash in - return (state, Z.zero, Raw_level.of_int32_exn level, fuel) - | Some inbox -> - let inbox_level = Inbox.inbox_level inbox in - let*! messages = Store.Messages.get store hash in - (* TODO: #2717 - The length of messages here can potentially overflow the [int] returned from [List.length]. - *) - let num_messages = List.length messages |> Z.of_int in - (* Iterate the PVM state with all the messages for this level. *) - let* state, fuel = - List.fold_left_i_es - (fun message_counter (state, fuel) message -> - let*? payload = - Sc_rollup.Inbox_message.( - message |> serialize |> Environment.wrap_tzresult) - in - let input = - Sc_rollup. - { - inbox_level; - message_counter = Z.of_int message_counter; - payload; - } - in - let level = Raw_level.to_int32 inbox_level |> Int32.to_int in - - let failing_ticks = - Loser_mode.is_failure - loser_mode - ~level - ~message_index:message_counter - in - let* state, fuel = - feed_input - ~metadata - ~dal_endorsement_lag - data_dir - store - level - message_counter - ~fuel - ~failing_ticks - state - input - in - return (state, fuel)) - (state, fuel) - messages - in - return (state, num_messages, inbox_level, fuel) - let genesis_state block_hash node_ctxt ctxt = let open Node_context in let open Lwt_result_syntax in @@ -316,9 +102,10 @@ module Make (PVM : Pvm.S) : S with module PVM = PVM = struct node_ctxt.protocol_constants.parametric.dal.endorsement_lag in let* state, num_messages, inbox_level, _fuel = - eval_block_inbox + Free_pvm.eval_block_inbox ~metadata ~dal_endorsement_lag + ~fuel:(Fuel.Free.of_ticks 0L) node_ctxt hash predecessor_state @@ -415,10 +202,10 @@ module Make (PVM : Pvm.S) : S with module PVM = PVM = struct node_ctxt.protocol_constants.parametric.dal.endorsement_lag in let* state, _counter, _level, _fuel = - eval_block_inbox + Accounted_pvm.eval_block_inbox ~metadata ~dal_endorsement_lag - ~fuel:tick_distance + ~fuel:(Fuel.Accounted.of_ticks tick_distance) node_ctxt hash state diff --git a/src/proto_alpha/bin_sc_rollup_node/interpreter_event.ml b/src/proto_alpha/bin_sc_rollup_node/interpreter_event.ml index a6e1d99fa6e29299d029788202f38a29beeca137..4ebe754da6a30e523692e3558d23edf32fb049a6 100644 --- a/src/proto_alpha/bin_sc_rollup_node/interpreter_event.ml +++ b/src/proto_alpha/bin_sc_rollup_node/interpreter_event.ml @@ -25,7 +25,31 @@ open Protocol.Alpha_context.Sc_rollup -module Make (PVM : Pvm.S) = struct +module type S = sig + type state + + (** [transition_pvm inbox_level hash n] emits the event that a PVM + transition is leading to the state of the given [hash] by + processing [n] messages. *) + val transitioned_pvm : + Protocol.Alpha_context.Raw_level.t -> state -> Z.t -> unit Lwt.t + + (** [intended_failure level message_index message_tick internal] emits + the event that an intended failure has been injected at some given + [level], during the processing of a given [message_index] and at + tick [message_tick] during this message processing. [internal] is + [true] if the failure is injected in a PVM internal + step. [internal] is [false] if the failure is injected in the input + to the PVM. *) + val intended_failure : + level:int -> + message_index:int -> + message_tick:int64 -> + internal:bool -> + unit Lwt.t +end + +module Make (PVM : Pvm.S) : S with type state := PVM.state = struct module Simple = struct include Internal_event.Simple