diff --git a/etherlink/CHANGES_NODE.md b/etherlink/CHANGES_NODE.md index 1287b3511d8ffd818e0959fbfc2ab0c6297f6c9c..303d4233d7d176e3b20f8aab94b4677f52629eb8 100644 --- a/etherlink/CHANGES_NODE.md +++ b/etherlink/CHANGES_NODE.md @@ -4,6 +4,9 @@ ### Features +- Deprecate the `--devmode` CLI flag. The EVM node aims to be compatible with + three versions of the kernel: the latest one, the one deployed on Ghostnet + and the one deployed on Mainnet. (!13522) - Support daily log files for the observer mode (!13101). - The RPC `eth_getBalance`, `eth_getCode`, `eth_getTransactionCount` and `eth_getStorageAt` support the default block parameter diff --git a/etherlink/bin_node/config/configuration.ml b/etherlink/bin_node/config/configuration.ml index 496d39c3de154a071d08e252511c9b4da94cce89..3f190fbf1a35d8e9c2c03f348ed3bcc78bc5ad5f 100644 --- a/etherlink/bin_node/config/configuration.ml +++ b/etherlink/bin_node/config/configuration.ml @@ -67,7 +67,6 @@ type fee_history = {max_count : int option; max_past : int option} type t = { rpc_addr : string; rpc_port : int; - devmode : bool; cors_origins : string list; cors_headers : string list; log_filter : log_filter_config; @@ -115,8 +114,6 @@ let default_rpc_port = 8545 let default_sequencer_sidecar_endpoint = Uri.of_string "127.0.0.1:5303" -let default_devmode = false - let default_keep_alive = false let default_cors_origins = [] @@ -507,7 +504,6 @@ let encoding data_dir : t Data_encoding.t = (fun { rpc_addr; rpc_port; - devmode; cors_origins; cors_headers; log_filter; @@ -527,7 +523,8 @@ let encoding data_dir : t Data_encoding.t = } -> ( ( rpc_addr, rpc_port, - devmode, + None + (* devmode is still part of the encoding for compatibiltiy reasons. *), cors_origins, cors_headers, log_filter, @@ -546,7 +543,7 @@ let encoding data_dir : t Data_encoding.t = fee_history ) )) (fun ( ( rpc_addr, rpc_port, - devmode, + _devmode, cors_origins, cors_headers, log_filter, @@ -566,7 +563,6 @@ let encoding data_dir : t Data_encoding.t = { rpc_addr; rpc_port; - devmode; cors_origins; cors_headers; log_filter; @@ -588,7 +584,7 @@ let encoding data_dir : t Data_encoding.t = (obj10 (dft "rpc-addr" ~description:"RPC address" string default_rpc_addr) (dft "rpc-port" ~description:"RPC port" uint16 default_rpc_port) - (dft "devmode" bool default_devmode) + (opt ~description:"DEPRECATED" "devmode" bool) (dft "cors_origins" (list string) default_cors_origins) (dft "cors_headers" (list string) default_cors_headers) (dft @@ -669,7 +665,7 @@ let observer_config_exn {observer; _} = Option.to_result ~none:(error_missing_config ~name:"observer") observer module Cli = struct - let create ~data_dir ~devmode ?rpc_addr ?rpc_port ?cors_origins ?cors_headers + let create ~data_dir ?rpc_addr ?rpc_port ?cors_origins ?cors_headers ?tx_pool_timeout_limit ?tx_pool_addr_limit ?tx_pool_tx_per_addr_limit ~keep_alive ~rollup_node_endpoint ~verbose ?preimages ?preimages_endpoint ?time_between_blocks ?max_number_of_chunks ?private_rpc_port @@ -738,7 +734,6 @@ module Cli = struct { rpc_addr = Option.value ~default:default_rpc_addr rpc_addr; rpc_port = Option.value ~default:default_rpc_port rpc_port; - devmode; cors_origins = Option.value ~default:default_cors_origins cors_origins; cors_headers = Option.value ~default:default_cors_headers cors_headers; log_filter; @@ -764,8 +759,8 @@ module Cli = struct fee_history = default_fee_history; } - let patch_configuration_from_args ~data_dir ~devmode ?rpc_addr ?rpc_port - ?cors_origins ?cors_headers ?tx_pool_timeout_limit ?tx_pool_addr_limit + let patch_configuration_from_args ~data_dir ?rpc_addr ?rpc_port ?cors_origins + ?cors_headers ?tx_pool_timeout_limit ?tx_pool_addr_limit ?tx_pool_tx_per_addr_limit ~keep_alive ?rollup_node_endpoint ~verbose ?preimages ?preimages_endpoint ?time_between_blocks ?max_number_of_chunks ?private_rpc_port ?sequencer_key ?evm_node_endpoint @@ -983,7 +978,6 @@ module Cli = struct { rpc_addr = Option.value ~default:configuration.rpc_addr rpc_addr; rpc_port = Option.value ~default:configuration.rpc_port rpc_port; - devmode = devmode || configuration.devmode; cors_origins = Option.value ~default:configuration.cors_origins cors_origins; cors_headers = @@ -1016,7 +1010,7 @@ module Cli = struct fee_history = configuration.fee_history; } - let create_or_read_config ~data_dir ~devmode ?rpc_addr ?rpc_port ?cors_origins + let create_or_read_config ~data_dir ?rpc_addr ?rpc_port ?cors_origins ?cors_headers ?tx_pool_timeout_limit ?tx_pool_addr_limit ?tx_pool_tx_per_addr_limit ~keep_alive ?rollup_node_endpoint ~verbose ?preimages ?preimages_endpoint ?time_between_blocks ?max_number_of_chunks @@ -1048,7 +1042,6 @@ module Cli = struct let configuration = patch_configuration_from_args ~data_dir - ~devmode ?rpc_addr ?rpc_port ?cors_origins @@ -1087,7 +1080,6 @@ module Cli = struct let config = create ~data_dir - ~devmode ?rpc_addr ?rpc_port ?cors_origins diff --git a/etherlink/bin_node/config/configuration.mli b/etherlink/bin_node/config/configuration.mli index acf35c3c7f1362395a623a1dbda1fd53752d039e..1431fe2da608930175ce0ec9bf13e8aeeadb38fb 100644 --- a/etherlink/bin_node/config/configuration.mli +++ b/etherlink/bin_node/config/configuration.mli @@ -102,7 +102,6 @@ type fee_history = {max_count : int option; max_past : int option} type t = { rpc_addr : string; rpc_port : int; - devmode : bool; cors_origins : string list; cors_headers : string list; log_filter : log_filter_config; @@ -200,7 +199,6 @@ val observer_config_dft : module Cli : sig val create : data_dir:string -> - devmode:bool -> ?rpc_addr:string -> ?rpc_port:int -> ?cors_origins:string list -> @@ -232,7 +230,6 @@ module Cli : sig val create_or_read_config : data_dir:string -> - devmode:bool -> ?rpc_addr:string -> ?rpc_port:int -> ?cors_origins:string list -> diff --git a/etherlink/bin_node/dune b/etherlink/bin_node/dune index cb3a1c0306886e21d3cb3bcd28e891dbb1cbeb84..47f9a2e4a7fc8f2a05a2ad6e2a61957b59c0b808 100644 --- a/etherlink/bin_node/dune +++ b/etherlink/bin_node/dune @@ -16,7 +16,6 @@ octez-version.value octez-shell-libs.client-base octez-shell-libs.client-base-unix - octez-evm-node-libs.evm_node_lib_prod octez-evm-node-libs.evm_node_lib_dev octez-evm-node-libs.evm_node_config) (link_flags diff --git a/etherlink/bin_node/index.mld b/etherlink/bin_node/index.mld index 4cbb6eee5cf65259872b07cdb04a3baba42f6af9..58b24e8533b2255bdb967efed9359e0266e35efb 100644 --- a/etherlink/bin_node/index.mld +++ b/etherlink/bin_node/index.mld @@ -7,7 +7,5 @@ It contains the following libraries: - {{!module-Evm_node_config}Evm_node_config}: Configuration for the EVM node - {{!module-Evm_node_lib_dev}Evm_node_lib_dev}: An implementation of a subset of Ethereum JSON-RPC API for the EVM rollup [dev version] - {{!module-Evm_node_lib_dev_encoding}Evm_node_lib_dev_encoding}: EVM encodings for the EVM node and plugin for the WASM Debugger [dev version] -- {{!module-Evm_node_lib_prod}Evm_node_lib_prod}: An implementation of a subset of Ethereum JSON-RPC API for the EVM rollup [prod version] -- {{!module-Evm_node_lib_prod_encoding}Evm_node_lib_prod_encoding}: EVM encodings for the EVM node and plugin for the WASM Debugger [prod version] - {{!module-Evm_node_migrations}Evm_node_migrations}: SQL migrations for the EVM node store - {{!module-Evm_node_sequencer_protobuf}Evm_node_sequencer_protobuf}: gRPC libraries for interacting with a consensus node, generated from protobuf definitions diff --git a/etherlink/bin_node/lib_dev/kernel_config.ml b/etherlink/bin_node/lib_dev/kernel_config.ml index 5ea51368d0f0f9e39446aa634024dbfe34f38576..bcaa3649b5db2aa96f1b75c3ed34bac78ac603c7 100644 --- a/etherlink/bin_node/lib_dev/kernel_config.ml +++ b/etherlink/bin_node/lib_dev/kernel_config.ml @@ -18,8 +18,8 @@ let parse_z_to_padded_32_le_int_bytes s = let z = Z.of_string s in padded_32_le_int_bytes z -let make ~boostrap_balance ?bootstrap_accounts ?kernel_root_hash ?chain_id - ?sequencer ?delayed_bridge ?ticketer ?admin ?sequencer_governance +let make ~mainnet_compat ~boostrap_balance ?bootstrap_accounts ?kernel_root_hash + ?chain_id ?sequencer ?delayed_bridge ?ticketer ?admin ?sequencer_governance ?kernel_governance ?kernel_security_governance ?minimum_base_fee_per_gas ?da_fee_per_byte ?delayed_inbox_timeout ?delayed_inbox_min_levels ?sequencer_pool_address ?maximum_allowed_ticks ?maximum_gas_per_transaction @@ -43,13 +43,15 @@ let make ~boostrap_balance ?bootstrap_accounts ?kernel_root_hash ?chain_id String.of_bytes b in let instrs = - make_instr - ~convert:(fun s -> Hex.to_bytes_exn (`Hex s) |> Bytes.to_string) - kernel_root_hash + (if mainnet_compat then make_instr ~path_prefix:"/evm/" ticketer + else + (* For compatibility reason for Mainnet and Ghostnet *) + make_instr ~path_prefix:"/evm/world_state/" ticketer) + @ make_instr + ~convert:(fun s -> Hex.to_bytes_exn (`Hex s) |> Bytes.to_string) + kernel_root_hash @ make_instr ~convert:parse_z_to_padded_32_le_int_bytes chain_id - @ make_instr sequencer @ make_instr delayed_bridge - @ make_instr ~path_prefix:"/evm/world_state/" ticketer - @ make_instr admin + @ make_instr sequencer @ make_instr delayed_bridge @ make_instr admin @ make_instr sequencer_governance @ make_instr kernel_governance @ make_instr kernel_security_governance diff --git a/etherlink/bin_node/lib_dev/kernel_config.mli b/etherlink/bin_node/lib_dev/kernel_config.mli index d146d4a9fb4e561b6d8e13056d59981513dc48b6..4320a6e4a0aca417686b4aca7871958fe74d2cf2 100644 --- a/etherlink/bin_node/lib_dev/kernel_config.mli +++ b/etherlink/bin_node/lib_dev/kernel_config.mli @@ -9,6 +9,7 @@ generates a configuration file located at [output], where [bootstrap_accounts] are provisioned with [bootstrap_balance]. *) val make : + mainnet_compat:bool -> boostrap_balance:Ethereum_types.NonceMap.key -> ?bootstrap_accounts:string list -> ?kernel_root_hash:string * string -> diff --git a/etherlink/bin_node/lib_dev/metrics.ml b/etherlink/bin_node/lib_dev/metrics.ml index e19ae966bcd8becb84f068f67e293afec0a6ed1c..518bc07b55c47d3b7cfaeb5485b37b86ffb7ab73 100644 --- a/etherlink/bin_node/lib_dev/metrics.ml +++ b/etherlink/bin_node/lib_dev/metrics.ml @@ -67,7 +67,7 @@ module Chain = struct end module Info = struct - let init ~devmode ~mode = + let init ~mode = let commit_hash = Tezos_version_value.Current_git_info.abbreviated_commit_hash in @@ -78,13 +78,10 @@ module Info = struct ~help:"Information" ~namespace ~subsystem - ~label_names:["commit_hash"; "commit_date"; "devmode"; "mode"] + ~label_names:["commit_hash"; "commit_date"; "mode"] "info" in - ignore - (Gauge.labels - metric - [commit_hash; commit_date; string_of_bool devmode; mode]) + ignore (Gauge.labels metric [commit_hash; commit_date; mode]) end module Block = struct diff --git a/etherlink/bin_node/lib_dev/observer.ml b/etherlink/bin_node/lib_dev/observer.ml index 96d83d2751aab55a88ac1c65c1d3c855bdf24e38..a152805c53a942ca6c24aad60a757bbeb3f8fc9e 100644 --- a/etherlink/bin_node/lib_dev/observer.ml +++ b/etherlink/bin_node/lib_dev/observer.ml @@ -284,7 +284,7 @@ and[@tailrec] stream_loop ~time_between_blocks ~evm_node_endpoint let main ?kernel_path ~data_dir ~(config : Configuration.t) () = let open Lwt_result_syntax in - Metrics.Info.init ~devmode:config.devmode ~mode:"observer" ; + Metrics.Info.init ~mode:"observer" ; let rollup_node_endpoint = config.rollup_node_endpoint in let*? { evm_node_endpoint; diff --git a/etherlink/bin_node/lib_dev/sequencer.ml b/etherlink/bin_node/lib_dev/sequencer.ml index 865472a1ecfbf829b591d31f42cc1f0de381e723..1328267cdfae4222858b6588c7b6d81b760c57b7 100644 --- a/etherlink/bin_node/lib_dev/sequencer.ml +++ b/etherlink/bin_node/lib_dev/sequencer.ml @@ -199,7 +199,7 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt ~(configuration : Configuration.t) ?kernel () = let open Lwt_result_syntax in let open Configuration in - Metrics.Info.init ~devmode:configuration.devmode ~mode:"sequencer" ; + Metrics.Info.init ~mode:"sequencer" ; let {rollup_node_endpoint; keep_alive; _} = configuration in let* smart_rollup_address = Rollup_services.smart_rollup_address diff --git a/etherlink/bin_node/lib_prod/block_producer.ml b/etherlink/bin_node/lib_prod/block_producer.ml deleted file mode 100644 index 7f84cb7f81f16d1a71b5460f4846c0b6f758064c..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/block_producer.ml +++ /dev/null @@ -1,285 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type parameters = { - cctxt : Client_context.wallet; - smart_rollup_address : string; - sequencer_key : Client_keys.sk_uri; - maximum_number_of_chunks : int; -} - -(* The size of a delayed transaction is overapproximated to the maximum size - of an inbox message, as chunks are not supported in the delayed bridge. *) -let maximum_delayed_transaction_size = 4096 - -(* - The legacy transactions are as follows: - ----------------------------- - | Nonce | Up to 32 bytes | - ----------------------------- - | GasPrice | Up to 32 bytes | - ----------------------------- - | GasLimit | Up to 32 bytes | - ----------------------------- - | To | 20 bytes addr | - ----------------------------- - | Value | Up to 32 bytes | - ----------------------------- - | Data | 0 - unlimited | - ----------------------------- - | V | 1 (usually) | - ----------------------------- - | R | 32 bytes | - ----------------------------- - | S | 32 bytes | - ----------------------------- - - where `up to` start at 0, and encoded as the empty byte for the 0 value - according to RLP specification. -*) -let minimum_ethereum_transaction_size = - Rlp.( - List - [ - Value Bytes.empty; - Value Bytes.empty; - Value Bytes.empty; - Value (Bytes.make 20 '\000'); - Value Bytes.empty; - Value Bytes.empty; - Value Bytes.empty; - Value (Bytes.make 32 '\000'); - Value (Bytes.make 32 '\000'); - ] - |> encode |> Bytes.length) - -module Types = struct - type nonrec parameters = parameters - - type state = parameters -end - -module Name = struct - type t = unit - - let encoding = Data_encoding.unit - - let base = ["evm_node"; "prod"; "block"; "producer"; "worker"] - - let pp _ _ = () - - let equal () () = true -end - -module Request = struct - type ('a, 'b) t = - | Produce_block : (Time.Protocol.t * bool) -> (int, tztrace) t - - type view = View : _ t -> view - - let view (req : _ t) = View req - - let encoding = - let open Data_encoding in - union - [ - case - (Tag 0) - ~title:"Produce_block" - (obj3 - (req "request" (constant "produce_block")) - (req "timestamp" Time.Protocol.encoding) - (req "force" bool)) - (function - | View (Produce_block (timestamp, force)) -> - Some ((), timestamp, force)) - (fun ((), timestamp, force) -> - View (Produce_block (timestamp, force))); - ] - - let pp _ppf (View _) = () -end - -module Worker = Worker.MakeSingle (Name) (Request) (Types) - -type worker = Worker.infinite Worker.queue Worker.t - -let get_hashes ~transactions ~delayed_transactions = - let open Result_syntax in - let hashes = - List.map - (fun transaction -> - let tx_hash_str = Ethereum_types.hash_raw_tx transaction in - Ethereum_types.( - Hash Hex.(of_string tx_hash_str |> show |> hex_of_string))) - transactions - in - return (delayed_transactions @ hashes) - -let take_delayed_transactions maximum_number_of_chunks = - let open Lwt_result_syntax in - let maximum_cumulative_size = - Sequencer_blueprint.maximum_usable_space_in_blueprint - maximum_number_of_chunks - in - let maximum_delayed_transactions = - maximum_cumulative_size / maximum_delayed_transaction_size - in - let* delayed_transactions = Evm_context.delayed_inbox_hashes () in - let delayed_transactions = - List.take_n maximum_delayed_transactions delayed_transactions - in - let remaining_cumulative_size = - maximum_cumulative_size - (List.length delayed_transactions * 4096) - in - return (delayed_transactions, remaining_cumulative_size) - -let produce_block ~cctxt ~smart_rollup_address ~sequencer_key ~force ~timestamp - ~maximum_number_of_chunks = - let open Lwt_result_syntax in - let* is_locked = Tx_pool.is_locked () in - if is_locked then - let*! () = Block_producer_events.production_locked () in - return 0 - else - let* delayed_transactions, remaining_cumulative_size = - take_delayed_transactions maximum_number_of_chunks - in - let* transactions = - (* Low key optimization to avoid even checking the txpool if there is not - enough space for the smallest transaction. *) - if remaining_cumulative_size <= minimum_ethereum_transaction_size then - return [] - else - Tx_pool.pop_transactions - ~maximum_cumulative_size:remaining_cumulative_size - in - let n = List.length transactions + List.length delayed_transactions in - if force || n > 0 then - let*! head_info = Evm_context.head_info () in - Helpers.with_timing - (Blueprint_events.blueprint_production head_info.next_blueprint_number) - @@ fun () -> - let*? hashes = get_hashes ~transactions ~delayed_transactions in - let* blueprint = - Helpers.with_timing - (Blueprint_events.blueprint_proposal head_info.next_blueprint_number) - @@ fun () -> - Sequencer_blueprint.create - ~sequencer_key - ~cctxt - ~timestamp - ~smart_rollup_address - ~transactions - ~delayed_transactions - ~parent_hash:head_info.current_block_hash - ~number:head_info.next_blueprint_number - in - let* () = - Evm_context.apply_blueprint timestamp blueprint delayed_transactions - in - let (Qty number) = head_info.next_blueprint_number in - let* () = Blueprints_publisher.publish number blueprint in - let*! () = - List.iter_p - (fun hash -> Block_producer_events.transaction_selected ~hash) - hashes - in - return n - else return 0 - -module Handlers = struct - type self = worker - - let on_request : - type r request_error. - worker -> (r, request_error) Request.t -> (r, request_error) result Lwt.t - = - fun w request -> - let state = Worker.state w in - match request with - | Request.Produce_block (timestamp, force) -> - protect @@ fun () -> - let { - cctxt; - smart_rollup_address; - sequencer_key; - maximum_number_of_chunks; - } = - state - in - produce_block - ~cctxt - ~smart_rollup_address - ~sequencer_key - ~force - ~timestamp - ~maximum_number_of_chunks - - type launch_error = error trace - - let on_launch _w () (parameters : Types.parameters) = - Lwt_result_syntax.return parameters - - let on_error (type a b) _w _st (_r : (a, b) Request.t) (_errs : b) : - unit tzresult Lwt.t = - Lwt_result_syntax.return_unit - - let on_completion _ _ _ _ = Lwt.return_unit - - let on_no_request _ = Lwt.return_unit - - let on_close _ = Lwt.return_unit -end - -let table = Worker.create_table Queue - -let worker_promise, worker_waker = Lwt.task () - -type error += No_block_producer - -type error += Block_producer_terminated - -let worker = - lazy - (match Lwt.state worker_promise with - | Lwt.Return worker -> Ok worker - | Lwt.Fail e -> Error (TzTrace.make @@ error_of_exn e) - | Lwt.Sleep -> Error (TzTrace.make No_block_producer)) - -let handle_request_error rq = - let open Lwt_syntax in - let* rq in - match rq with - | Ok res -> return_ok res - | Error (Worker.Request_error errs) -> Lwt.return_error errs - | Error (Closed None) -> Lwt.return_error [Block_producer_terminated] - | Error (Closed (Some errs)) -> Lwt.return_error errs - | Error (Any exn) -> Lwt.return_error [Exn exn] - -let start parameters = - let open Lwt_result_syntax in - let*! () = Block_producer_events.started () in - let+ worker = Worker.launch table () parameters (module Handlers) in - Lwt.wakeup worker_waker worker - -let shutdown () = - let open Lwt_syntax in - let w = Lazy.force worker in - match w with - | Error _ -> Lwt.return_unit - | Ok w -> - let* () = Block_producer_events.shutdown () in - Worker.shutdown w - -let produce_block ~force ~timestamp = - let open Lwt_result_syntax in - let*? worker = Lazy.force worker in - Worker.Queue.push_request_and_wait - worker - (Request.Produce_block (timestamp, force)) - |> handle_request_error diff --git a/etherlink/bin_node/lib_prod/block_producer.mli b/etherlink/bin_node/lib_prod/block_producer.mli deleted file mode 100644 index 457eaf7add09c664acfe25a80fe6c699594fb99b..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/block_producer.mli +++ /dev/null @@ -1,26 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type parameters = { - cctxt : Client_context.wallet; - smart_rollup_address : string; - sequencer_key : Client_keys.sk_uri; - maximum_number_of_chunks : int; -} - -(** [start parameters] starts the events follower. *) -val start : parameters -> unit tzresult Lwt.t - -(** [shutdown ()] stops the events follower. *) -val shutdown : unit -> unit Lwt.t - -(** [produce_block ~force ~timestamp] takes the transactions - in the tx pool and produces a block from it, returns the number of - transaction in the block. The block is not produced if the list of - transactions is empty and [force] is set to [false]. *) -val produce_block : - force:bool -> timestamp:Time.Protocol.t -> int tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/block_producer_events.ml b/etherlink/bin_node/lib_prod/block_producer_events.ml deleted file mode 100644 index cc1e7c02f2524f78d44932949bddd0751876a1c1..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/block_producer_events.ml +++ /dev/null @@ -1,56 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -module Event = struct - open Internal_event.Simple - - let section = Events.section - - let transaction_selected = - declare_1 - ~section - ~name:"block_producer_transaction_injected" - ~msg:"Transaction {transaction} has been selected for a block" - ~level:Info - ("transaction", Ethereum_types.hash_encoding) - ~pp1:Ethereum_types.pp_hash - - let started = - declare_0 - ~section - ~name:"block_producer_started" - ~msg:"Block producer has been started" - ~level:Notice - () - - let shutdown = - declare_0 - ~section - ~name:"shutting_down_block_producer" - ~msg:"Stopping the block producer follower" - ~level:Notice - () - - let production_locked = - declare_0 - ~section - ~name:"block_producer_locked" - ~msg: - "Transaction pool is locked, block production as well. The sequencer \ - is progressing too far in advance in comparison to the rollup node." - ~level:Error - () -end - -let transaction_selected ~hash = - Internal_event.Simple.emit Event.transaction_selected hash - -let started () = Internal_event.Simple.emit Event.started () - -let shutdown () = Internal_event.Simple.emit Event.shutdown () - -let production_locked () = Internal_event.Simple.emit Event.production_locked () diff --git a/etherlink/bin_node/lib_prod/blueprint_events.ml b/etherlink/bin_node/lib_prod/blueprint_events.ml deleted file mode 100644 index cc55d432803e9f1cdffa8f51ef0efc293d8f7a98..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/blueprint_events.ml +++ /dev/null @@ -1,124 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -include Internal_event.Simple - -let section = Events.section - -let publisher_ready = - declare_0 - ~section - ~name:"blueprint_publisher_is_ready" - ~msg:"Blueprint publisher is ready" - ~level:Info - () - -let publisher_shutdown = - declare_0 - ~section - ~name:"blueprint_publisher_shutdown" - ~msg:"Blueprint publishing is shutting down" - ~level:Info - () - -let blueprint_application = - declare_2 - ~name:"blueprint_application" - ~section - ~msg: - "Applied a blueprint for level {level} leading to creating block \ - {block_hash}" - ~level:Notice - ("level", Data_encoding.n) - ("block_hash", Ethereum_types.block_hash_encoding) - -let blueprint_injection = - declare_1 - ~section - ~name:"blueprint_injection" - ~msg:"Injecting a blueprint for level {level}" - ~level:Info - ("level", Data_encoding.n) - -let blueprint_injection_failure = - declare_1 - ~section - ~name:"blueprint_injection_failure" - ~msg:"Injecting a blueprint for level {level} failed" - ~level:Error - ("level", Data_encoding.n) - -let blueprint_catchup = - declare_2 - ~section - ~name:"blueprint_catchup" - ~msg:"Catching-up from level {min} to {max}" - ~level:Notice - ("min", Data_encoding.n) - ("max", Data_encoding.n) - -let blueprint_proposal = - declare_2 - ~section - ~name:"blueprint_proposal" - ~msg:"Crafted a blueprint proposal for level {level} in {process_time}" - ~level:Debug - ~pp2:Ptime.Span.pp - ("level", Data_encoding.n) - ("process_time", Time.System.Span.encoding) - -let blueprint_production = - declare_2 - ~section - ~name:"blueprint_production" - ~msg:"Produced a blueprint for level {level} in {process_time}" - ~level:Info - ~pp2:Ptime.Span.pp - ("level", Data_encoding.n) - ("process_time", Time.System.Span.encoding) - -let invalid_blueprint = - declare_1 - ~section - ~name:"blueprint_invalid" - ~msg:"Produced an invalid blueprint at level {level}" - ~level:Error - ("level", Data_encoding.n) - -let missing_blueprints = - declare_3 - ~section - ~name:"missing_blueprints" - ~msg:"Store is missing {count} blueprints in the range [{from}; {to_}]" - ~level:Error - ("count", Data_encoding.int31) - ("from", Data_encoding.n) - ("to_", Data_encoding.n) - -let publisher_is_ready () = emit publisher_ready () - -let publisher_shutdown () = emit publisher_shutdown () - -let blueprint_injected level = emit blueprint_injection level - -let blueprint_injection_failed level = emit blueprint_injection_failure level - -let blueprint_applied (level, hash) = emit blueprint_application (level, hash) - -let invalid_blueprint_produced level = emit invalid_blueprint level - -let catching_up min max = emit blueprint_catchup (min, max) - -let missing_blueprints count Ethereum_types.(Qty from) Ethereum_types.(Qty to_) - = - emit missing_blueprints (count, from, to_) - -let blueprint_proposal Ethereum_types.(Qty level) time = - emit blueprint_proposal (level, time) - -let blueprint_production Ethereum_types.(Qty level) time = - emit blueprint_production (level, time) diff --git a/etherlink/bin_node/lib_prod/blueprint_events.mli b/etherlink/bin_node/lib_prod/blueprint_events.mli deleted file mode 100644 index d5b73e82df800fcd923948af99dd179ddce583f9..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/blueprint_events.mli +++ /dev/null @@ -1,55 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(** Events related to the publication of blueprints. *) - -val section : string list - -(** [publisher_is_ready ()] advertises that the worker is ready to accept - requests. *) -val publisher_is_ready : unit -> unit Lwt.t - -(** [publisher_shutdown ()] advertises that the worker has been shutdown and - will not accept requests anymore. *) -val publisher_shutdown : unit -> unit Lwt.t - -(** [blueprint_applied (level, hash)] advertizes that a blueprint for - level [level] has been applied onto the local state. *) -val blueprint_applied : Z.t * Ethereum_types.block_hash -> unit Lwt.t - -(** [blueprint_injected level] advertizes that a blueprint for level - [level] has been forwarded to a rollup node *) -val blueprint_injected : Z.t -> unit Lwt.t - -(** [blueprint_injection_failed level] advertizes that a blueprint could not be - injected for level [level]. *) -val blueprint_injection_failed : Z.t -> unit Lwt.t - -(** [invalid_blueprint_produced level] advertizes that the sequencer has tried - to produce a blueprint which does not result in the publication of a new - Ethereum block. *) -val invalid_blueprint_produced : Z.t -> unit Lwt.t - -(** [missing_blueprints count from to_] advertizes that a sequencer has detect - it is missing [count] blueprints in the provided range. This means the - sequencer store is inconsistent. *) -val missing_blueprints : - int -> Ethereum_types.quantity -> Ethereum_types.quantity -> unit Lwt.t - -(** [catching_up min max] advertizes that the sequencer is reinjecting - blueprints from level [min] to [max] because the rollup node is lagging. *) -val catching_up : Z.t -> Z.t -> unit Lwt.t - -(** [blueprint_proposal level duration] advertizes the sequencer has crafted a - blueprint for [level] in [duration] time. *) -val blueprint_proposal : - Ethereum_types.quantity -> Time.System.Span.t -> unit Lwt.t - -(** [blueprint_production level duration] advertizes the sequencer has fully - produced a blueprint for [level] in [duration] time. *) -val blueprint_production : - Ethereum_types.quantity -> Time.System.Span.t -> unit Lwt.t diff --git a/etherlink/bin_node/lib_prod/blueprint_types.ml b/etherlink/bin_node/lib_prod/blueprint_types.ml deleted file mode 100644 index c38dee573a98c9a0eb645f6ebd35dc17d4ded498..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/blueprint_types.ml +++ /dev/null @@ -1,48 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type payload = [`External of string] list - -type t = { - number : Ethereum_types.quantity; - timestamp : Time.Protocol.t; - payload : payload; -} - -type with_events = { - delayed_transactions : Ethereum_types.Delayed_transaction.t list; - blueprint : t; -} - -let payload_encoding = - let open Data_encoding in - list - (conv - (function `External str -> str) - (fun str -> `External str) - (string' Hex)) - -let encoding = - let open Data_encoding in - conv - (fun {number = Qty n; timestamp; payload} -> (n, timestamp, payload)) - (fun (n, timestamp, payload) -> {number = Qty n; timestamp; payload}) - (obj3 - (req "number" n) - (req "timestamp" Time.Protocol.encoding) - (req "payload" payload_encoding)) - -let with_events_encoding = - let open Data_encoding in - conv - (fun {delayed_transactions; blueprint} -> (delayed_transactions, blueprint)) - (fun (delayed_transactions, blueprint) -> {delayed_transactions; blueprint}) - (obj2 - (req - "delayed_transactions" - (list Ethereum_types.Delayed_transaction.encoding)) - (req "blueprint" encoding)) diff --git a/etherlink/bin_node/lib_prod/blueprint_types.mli b/etherlink/bin_node/lib_prod/blueprint_types.mli deleted file mode 100644 index 0500e328a4228aa94be2a938779174c4345924f8..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/blueprint_types.mli +++ /dev/null @@ -1,28 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(** A chunked blueprint, ready to be executed localy. *) -type payload = [`External of string] list - -type t = { - number : Ethereum_types.quantity; - timestamp : Time.Protocol.t; - payload : payload; -} - -(** Blueprint with events contains: *) -type with_events = { - delayed_transactions : Ethereum_types.Delayed_transaction.t list; - (** The delayed transactions to apply before applying the blueprint. *) - blueprint : t; (** The blueprint to execute. *) -} - -val encoding : t Data_encoding.t - -val payload_encoding : payload Data_encoding.t - -val with_events_encoding : with_events Data_encoding.t diff --git a/etherlink/bin_node/lib_prod/blueprints_publisher.ml b/etherlink/bin_node/lib_prod/blueprints_publisher.ml deleted file mode 100644 index d83d0d32635b39e28de319c4555e0b5a276bbe5e..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/blueprints_publisher.ml +++ /dev/null @@ -1,290 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type parameters = { - rollup_node_endpoint : Uri.t; - latest_level_seen : Z.t; - config : Configuration.blueprints_publisher_config; -} - -type state = { - rollup_node_endpoint : Uri.t; - max_blueprints_lag : Z.t; - max_blueprints_ahead : Z.t; - max_blueprints_catchup : Z.t; - catchup_cooldown : int; - mutable latest_level_confirmed : Z.t; - (** The current head of the EVM chain as seen by the rollup node *) - mutable latest_level_seen : Z.t; - (** The level of the latest blueprint the sequencer tried to inject back - to layer 1 *) - mutable cooldown : int; - (** Do not try to catch-up if [cooldown] is not equal to 0 *) -} - -module Types = struct - type nonrec state = state - - type nonrec parameters = parameters -end - -module Name = struct - type t = unit - - let encoding = Data_encoding.unit - - let base = Blueprint_events.section - - let pp _fmt () = () - - let equal () () = true -end - -module Worker = struct - include Worker.MakeSingle (Name) (Blueprints_publisher_types.Request) (Types) - - let rollup_node_endpoint worker = (state worker).rollup_node_endpoint - - let latest_level_seen worker = (state worker).latest_level_seen - - let latest_level_confirmed worker = (state worker).latest_level_confirmed - - let witness_level worker level = - (* [witness_level] is called in [publish], which is used both when - catching up and when publishing new blueprints. We only want to update - the field on the latter case. *) - if Z.Compare.(latest_level_seen worker < level) then - (state worker).latest_level_seen <- level - - let set_latest_level_confirmed worker level = - (state worker).latest_level_confirmed <- level - - let max_blueprints_lag worker = (state worker).max_blueprints_lag - - let max_level_ahead worker = (state worker).max_blueprints_ahead - - let max_blueprints_catchup worker = (state worker).max_blueprints_catchup - - type lag = No_lag | Needs_republish | Needs_lock - - let rollup_is_lagging_behind worker = - let missing_levels = - Z.sub (latest_level_seen worker) (latest_level_confirmed worker) - in - if Z.Compare.(missing_levels > max_level_ahead worker) then Needs_lock - else if Z.(Compare.(missing_levels > max_blueprints_lag worker)) then - Needs_republish - else No_lag - - let set_cooldown worker cooldown = (state worker).cooldown <- cooldown - - let catchup_cooldown worker = (state worker).catchup_cooldown - - let current_cooldown worker = (state worker).cooldown - - let on_cooldown worker = 0 < current_cooldown worker - - let decrement_cooldown worker = - let current = current_cooldown worker in - if on_cooldown worker then set_cooldown worker (current - 1) else () - - let publish self payload level = - let open Lwt_result_syntax in - let rollup_node_endpoint = rollup_node_endpoint self in - (* We do not check if we succeed or not: this will be done when new L2 - heads come from the rollup node. *) - witness_level self level ; - let*! res = - (* We do not check if we succeed or not: this will be done when new L2 - heads come from the rollup node. *) - Rollup_services.publish ~keep_alive:false ~rollup_node_endpoint payload - in - let*! () = - match res with - | Ok _ -> Blueprint_events.blueprint_injected level - | Error _ -> - (* We have failed to inject the blueprint. This is probably - the sign that the rollup node is down. It will be injected again - once the rollup node lag increases to [max_blueprints_lag]. *) - Blueprint_events.blueprint_injection_failed level - in - match rollup_is_lagging_behind self with - | No_lag | Needs_republish -> return_unit - | Needs_lock -> Tx_pool.lock_transactions () - - let catch_up worker = - let open Lwt_result_syntax in - let lower_bound = Z.succ (latest_level_confirmed worker) in - (* We limit the maximum number of blueprints we send at once *) - let upper_bound = - Z.( - min - (add (latest_level_confirmed worker) (max_blueprints_catchup worker)) - (latest_level_seen worker)) - in - - let*! () = Blueprint_events.catching_up lower_bound upper_bound in - - let* blueprints = - Evm_context.blueprints_range (Qty lower_bound) (Qty upper_bound) - in - - let expected_count = Z.(to_int (sub upper_bound lower_bound)) + 1 in - let actual_count = List.length blueprints in - let* () = - when_ (actual_count < expected_count) (fun () -> - let*! () = - Blueprint_events.missing_blueprints - (expected_count - actual_count) - (Qty lower_bound) - (Qty upper_bound) - in - return_unit) - in - - let* () = - List.iter_es - (fun (Ethereum_types.Qty current, payload) -> - publish worker payload current) - blueprints - in - - (* We give ourselves a cooldown window Tezos blocks to inject everything *) - set_cooldown worker (catchup_cooldown worker) ; - return_unit -end - -type worker = Worker.infinite Worker.queue Worker.t - -module Handlers = struct - open Blueprints_publisher_types - - type self = worker - - type launch_error = error trace - - let on_launch _self () - ({ - rollup_node_endpoint; - config = - { - max_blueprints_lag; - max_blueprints_ahead; - max_blueprints_catchup; - catchup_cooldown; - }; - latest_level_seen; - } : - Types.parameters) = - let open Lwt_result_syntax in - return - { - latest_level_confirmed = - (* Will be set at the correct value once the next L2 block is - received from the rollup node *) - Z.zero; - latest_level_seen; - cooldown = 0; - rollup_node_endpoint; - max_blueprints_lag = Z.of_int max_blueprints_lag; - max_blueprints_ahead = Z.of_int max_blueprints_ahead; - max_blueprints_catchup = Z.of_int max_blueprints_catchup; - catchup_cooldown; - } - - let on_request : - type r request_error. - self -> (r, request_error) Request.t -> (r, request_error) result Lwt.t = - fun self request -> - let open Lwt_result_syntax in - match request with - | Publish {level; payload} -> - let* () = Worker.publish self payload level in - return_unit - | New_l2_head {rollup_head} -> ( - Worker.set_latest_level_confirmed self rollup_head ; - match Worker.rollup_is_lagging_behind self with - | (Needs_republish | Needs_lock) when not (Worker.on_cooldown self) -> - (* The worker needs to republish, it's not in cooldown. *) - Worker.catch_up self - | Needs_lock -> - (* If the worker still needs to stop, we idle and wait for the cooldown .*) - Worker.decrement_cooldown self ; - return_unit - | No_lag | Needs_republish -> - Worker.decrement_cooldown self ; - (* If there is no lag or the worker just needs to republish we - unlock the transaction pool in case it was locked. *) - Tx_pool.unlock_transactions ()) - - let on_completion (type a err) _self (_r : (a, err) Request.t) (_res : a) _st - = - Lwt_syntax.return_unit - - let on_no_request _self = Lwt.return_unit - - let on_close _self = Lwt.return_unit - - let on_error (type a b) _self _st (_r : (a, b) Request.t) (_errs : b) : - unit tzresult Lwt.t = - Lwt_result_syntax.return_unit -end - -let table = Worker.create_table Queue - -let worker_promise, worker_waker = Lwt.task () - -let start ~rollup_node_endpoint ~config ~latest_level_seen () = - let open Lwt_result_syntax in - let* worker = - Worker.launch - table - () - {rollup_node_endpoint; config; latest_level_seen} - (module Handlers) - in - let*! () = Blueprint_events.publisher_is_ready () in - Lwt.wakeup worker_waker worker ; - return_unit - -type error += No_worker - -let worker = - lazy - (match Lwt.state worker_promise with - | Lwt.Return worker -> Ok worker - | Lwt.Fail e -> Result_syntax.tzfail (error_of_exn e) - | Lwt.Sleep -> Result_syntax.tzfail No_worker) - -let bind_worker f = - let open Lwt_result_syntax in - let res = Lazy.force worker in - match res with - | Error [No_worker] -> - (* There is no worker, nothing to do *) - return_unit - | Error errs -> fail errs - | Ok w -> f w - -let worker_add_request ~request = - let open Lwt_result_syntax in - bind_worker @@ fun w -> - let*! (_pushed : bool) = Worker.Queue.push_request w request in - return_unit - -let publish level payload = - worker_add_request ~request:(Publish {level; payload}) - -let new_l2_head rollup_head = - worker_add_request ~request:(New_l2_head {rollup_head}) - -let shutdown () = - let open Lwt_result_syntax in - bind_worker @@ fun w -> - let*! () = Blueprint_events.publisher_shutdown () in - let*! () = Worker.shutdown w in - return_unit diff --git a/etherlink/bin_node/lib_prod/blueprints_publisher.mli b/etherlink/bin_node/lib_prod/blueprints_publisher.mli deleted file mode 100644 index d8f21fcd2c76dcae67e967847c7f3a812d53a382..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/blueprints_publisher.mli +++ /dev/null @@ -1,24 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -val start : - rollup_node_endpoint:Uri.t -> - config:Configuration.blueprints_publisher_config -> - latest_level_seen:Z.t -> - unit -> - unit tzresult Lwt.t - -val shutdown : unit -> unit tzresult Lwt.t - -(** [publish level payload] sends a request to the publisher worker to - forward the chunked blueprint [payload] for level [level] to the - rollup node. *) -val publish : Z.t -> [`External of string] list -> unit tzresult Lwt.t - -(** [new_l2_head rollup_head] tells the worker that a new L2 head has been - published and that the rollup head is now [rollup_head]. *) -val new_l2_head : Z.t -> unit tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/blueprints_publisher_types.ml b/etherlink/bin_node/lib_prod/blueprints_publisher_types.ml deleted file mode 100644 index 51daccfe465642efc6a2356460f6009b84de9d13..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/blueprints_publisher_types.ml +++ /dev/null @@ -1,59 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -module Request = struct - type ('a, 'b) t = - | Publish : { - level : Z.t; - payload : [`External of string] list; - } - -> (unit, error trace) t - | New_l2_head : {rollup_head : Z.t} -> (unit, error trace) t - - type view = View : _ t -> view - - let view req = View req - - let encoding = - let open Data_encoding in - let external_encoding = - conv (function `External msg -> msg) (fun msg -> `External msg) string - in - union - [ - case - (Tag 0) - ~title:"Publish" - (obj3 - (req "request" (constant "publish")) - (req "level" n) - (req "payload" (list external_encoding))) - (function - | View (Publish {level; payload}) -> Some ((), level, payload) - | _ -> None) - (fun ((), level, payload) -> View (Publish {level; payload})); - case - (Tag 1) - ~title:"New_l2_head" - (obj2 (req "request" (constant "new_l2_head")) (req "rollup_head" n)) - (function - | View (New_l2_head {rollup_head}) -> Some ((), rollup_head) - | _ -> None) - (fun ((), rollup_head) -> View (New_l2_head {rollup_head})); - ] - - let pp ppf (View r) = - match r with - | Publish {level; payload = _} -> - Format.fprintf ppf "Publish { level = %a }" Z.pp_print level - | New_l2_head {rollup_head} -> - Format.fprintf - ppf - "New_l2_head { rollup_head = %a }" - Z.pp_print - rollup_head -end diff --git a/etherlink/bin_node/lib_prod/blueprints_publisher_types.mli b/etherlink/bin_node/lib_prod/blueprints_publisher_types.mli deleted file mode 100644 index e675eba6aa10a7515bc5a6c39ea579978d780bf9..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/blueprints_publisher_types.mli +++ /dev/null @@ -1,26 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -open Tezos_base - -module Request : sig - (** Type of requests accepted by the publisher worker. *) - type ('a, 'b) t = - | Publish : { - level : Z.t; - payload : [`External of string] list; - } - -> (unit, error trace) t (** Request to publish a blueprint. *) - | New_l2_head : {rollup_head : Z.t} -> (unit, error trace) t - - type view = View : _ t -> view - - include - Worker_intf.REQUEST - with type ('a, 'request_error) t := ('a, 'request_error) t - and type view := view -end diff --git a/etherlink/bin_node/lib_prod/dune b/etherlink/bin_node/lib_prod/dune deleted file mode 100644 index da47e9efc76591026a49e2dce24f0b5d985d668d..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/dune +++ /dev/null @@ -1,47 +0,0 @@ -; This file was automatically generated, do not edit. -; Edit file manifest/main.ml instead. - -(library - (name evm_node_lib_prod) - (public_name octez-evm-node-libs.evm_node_lib_prod) - (instrumentation (backend bisect_ppx)) - (libraries - octez-libs.base - octez-libs.rpc-http - octez-libs.rpc-http-server - octez-libs.tezos-workers - octez-libs.rpc-http-client-unix - octez-version.value - octez-libs.stdlib-unix - octez-evm-node-libs.evm_node_lib_prod_encoding - lwt-watcher - lwt-exit - caqti - caqti-lwt - caqti-lwt.unix - caqti-driver-sqlite3 - octez-shell-libs.client-base - octez-evm-node-libs.evm_node_config - octez-libs.context.sigs - octez-libs.tezos-context.disk - octez-libs.tezos-context.encoding - octez-l2-libs.scoru-wasm - octez-l2-libs.scoru-wasm-helpers - octez-smart-rollup-wasm-debugger-lib - octez-l2-libs.layer2_store - octez-l2-libs.smart-rollup - octez-evm-node-libs.evm_node_migrations - prometheus-app) - (flags - (:standard) - -open Tezos_base.TzPervasives - -open Tezos_rpc_http - -open Tezos_workers - -open Tezos_stdlib_unix - -open Evm_node_lib_prod_encoding - -open Tezos_client_base - -open Evm_node_config - -open Tezos_scoru_wasm_helpers - -open Octez_smart_rollup_wasm_debugger_lib - -open Tezos_layer2_store - -open Octez_smart_rollup)) diff --git a/etherlink/bin_node/lib_prod/durable_storage.ml b/etherlink/bin_node/lib_prod/durable_storage.ml deleted file mode 100644 index fe8d81c663095edc621cdcf6739fe51733d31875..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/durable_storage.ml +++ /dev/null @@ -1,231 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -open Ethereum_types - -module type READER = sig - val read : Durable_storage_path.path -> bytes option tzresult Lwt.t -end - -module Make (Reader : READER) = struct - let inspect_durable_and_decode_opt path decode = - let open Lwt_result_syntax in - let* bytes = Reader.read path in - match bytes with - | Some bytes -> return_some (decode bytes) - | None -> return_none - - let inspect_durable_and_decode path decode = - let open Lwt_result_syntax in - let* res_opt = inspect_durable_and_decode_opt path decode in - match res_opt with Some res -> return res | None -> failwith "null" - - let balance address = - let open Lwt_result_syntax in - let+ answer = Reader.read (Durable_storage_path.Accounts.balance address) in - match answer with - | Some bytes -> - Bytes.to_string bytes |> Z.of_bits |> Ethereum_types.quantity_of_z - | None -> Ethereum_types.Qty Z.zero - - let nonce address = - let open Lwt_result_syntax in - let+ answer = Reader.read (Durable_storage_path.Accounts.nonce address) in - answer - |> Option.map (fun bytes -> - bytes |> Bytes.to_string |> Z.of_bits |> Ethereum_types.quantity_of_z) - - let code address = - let open Lwt_result_syntax in - let+ answer = Reader.read (Durable_storage_path.Accounts.code address) in - match answer with - | Some bytes -> - bytes |> Hex.of_bytes |> Hex.show |> Ethereum_types.hex_of_string - | None -> Ethereum_types.Hex "" - - exception Invalid_block_structure of string - - exception Invalid_block_index of Z.t - - let block_number n = - let open Lwt_result_syntax in - match n with - (* This avoids an unecessary service call in case we ask a block's number - with an already expected/known block number [n]. *) - | Durable_storage_path.Block.Nth i -> return @@ Ethereum_types.Qty i - | Durable_storage_path.Block.Current -> ( - let+ answer = Reader.read Durable_storage_path.Block.current_number in - match answer with - | Some bytes -> Ethereum_types.Qty (Bytes.to_string bytes |> Z.of_bits) - | None -> - raise - @@ Invalid_block_structure - "Unexpected [None] value for [current_number]'s [answer]") - - let current_block_number () = block_number Durable_storage_path.Block.Current - - let un_qty (Qty z) = z - - let transaction_receipt tx_hash = - let open Lwt_result_syntax in - (* We use a mock block hash to decode the rest of the receipt, - so that we can get the number to query for the actual block - hash. *) - let mock_block_hash = Block_hash (Hex (String.make 64 'a')) in - let* opt_receipt = - inspect_durable_and_decode_opt - (Durable_storage_path.Transaction_receipt.receipt tx_hash) - (Ethereum_types.transaction_receipt_from_rlp mock_block_hash) - in - match opt_receipt with - | Some temp_receipt -> - let+ blockHash = - inspect_durable_and_decode - (Durable_storage_path.Indexes.block_by_number - (Nth (un_qty temp_receipt.blockNumber))) - decode_block_hash - in - let logs = - List.map - (fun (log : transaction_log) -> - {log with blockHash = Some blockHash}) - temp_receipt.logs - in - Some {temp_receipt with blockHash; logs} - | None -> return_none - - let transaction_object tx_hash = - let open Lwt_result_syntax in - (* We use a mock block hash to decode the rest of the receipt, - so that we can get the number to query for the actual block - hash. *) - let mock_block_hash = Block_hash (Hex (String.make 64 'a')) in - let* opt_object = - inspect_durable_and_decode_opt - (Durable_storage_path.Transaction_object.object_ tx_hash) - (Ethereum_types.transaction_object_from_rlp mock_block_hash) - in - match opt_object with - | Some temp_object -> - let+ blockHash = - inspect_durable_and_decode - (Durable_storage_path.Indexes.block_by_number - (Nth (un_qty temp_object.blockNumber))) - decode_block_hash - in - Some {temp_object with blockHash} - | None -> return_none - - let transaction_object_with_block_hash block_hash tx_hash = - inspect_durable_and_decode_opt - (Durable_storage_path.Transaction_object.object_ tx_hash) - (Ethereum_types.transaction_object_from_rlp block_hash) - - let full_transactions block_hash transactions = - let open Lwt_result_syntax in - match transactions with - | TxHash hashes -> - let+ objects = - List.filter_map_es - (transaction_object_with_block_hash block_hash) - hashes - in - TxFull objects - | TxFull _ -> return transactions - - let populate_tx_objects ~full_transaction_object block = - let open Lwt_result_syntax in - if full_transaction_object then - let* transactions = full_transactions block.hash block.transactions in - return {block with transactions} - else return block - - let blocks_by_number ~full_transaction_object ~number = - let open Lwt_result_syntax in - let* (Ethereum_types.Qty level) = block_number number in - let* block_hash_opt = - inspect_durable_and_decode_opt - (Durable_storage_path.Indexes.block_by_number (Nth level)) - decode_block_hash - in - match block_hash_opt with - | None -> raise @@ Invalid_block_index level - | Some block_hash -> ( - let* block_opt = - inspect_durable_and_decode_opt - (Durable_storage_path.Block.by_hash block_hash) - Ethereum_types.block_from_rlp - in - match block_opt with - | None -> raise @@ Invalid_block_structure "Couldn't decode bytes" - | Some block -> populate_tx_objects ~full_transaction_object block) - - let current_block ~full_transaction_object = - blocks_by_number - ~full_transaction_object - ~number:Durable_storage_path.Block.Current - - let nth_block ~full_transaction_object n = - blocks_by_number - ~full_transaction_object - ~number:Durable_storage_path.Block.(Nth n) - - let nth_block_hash n = - let number = Durable_storage_path.Block.(Nth n) in - inspect_durable_and_decode_opt - (Durable_storage_path.Indexes.block_by_number number) - decode_block_hash - - let block_by_hash ~full_transaction_object block_hash = - let open Lwt_result_syntax in - let* block_opt = - inspect_durable_and_decode_opt - (Durable_storage_path.Block.by_hash block_hash) - Ethereum_types.block_from_rlp - in - match block_opt with - | None -> raise @@ Invalid_block_structure "Couldn't decode bytes" - | Some block -> populate_tx_objects ~full_transaction_object block - - let chain_id () = - inspect_durable_and_decode Durable_storage_path.chain_id decode_number - - let base_fee_per_gas () = - inspect_durable_and_decode - Durable_storage_path.base_fee_per_gas - decode_number - - let kernel_version () = - inspect_durable_and_decode - Durable_storage_path.kernel_version - Bytes.to_string - - let kernel_root_hash () = - inspect_durable_and_decode_opt - Durable_storage_path.kernel_root_hash - Bytes.to_string - - let storage_at address (Qty pos) = - let open Lwt_result_syntax in - let pad32left0 s = - let open Ethereum_types in - (* Strip 0x *) - let (Hex s) = hex_of_string s in - let len = String.length s in - (* This is a Hex string of 32 bytes, therefore the length is 64 *) - String.make (64 - len) '0' ^ s - in - let index = Z.format "#x" pos |> pad32left0 in - let+ answer = - Reader.read (Durable_storage_path.Accounts.storage address index) - in - match answer with - | Some bytes -> - Bytes.to_string bytes |> Hex.of_string |> Hex.show - |> Ethereum_types.hex_of_string - | None -> Ethereum_types.Hex (pad32left0 "0") -end diff --git a/etherlink/bin_node/lib_prod/durable_storage_path.ml b/etherlink/bin_node/lib_prod/durable_storage_path.ml deleted file mode 100644 index 20d5bd6048dbafcce6afe0c46f36dbc9fdc9a2a6..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/durable_storage_path.ml +++ /dev/null @@ -1,117 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Marigold *) -(* Copyright (c) 2023 Functori *) -(* Copyright (c) 2023 Trilitech *) -(* *) -(*****************************************************************************) - -open Ethereum_types - -type path = string - -let evm_node_flag = "/__evm_node" - -module EVM = struct - let root = "/evm" - - let make s = root ^ s -end - -module World_state = struct - let root = "/world_state" - - let make s = EVM.make (root ^ s) -end - -let chain_id = EVM.make "/chain_id" - -let base_fee_per_gas = World_state.make "/fees/base_fee_per_gas" - -let kernel_version = EVM.make "/kernel_version" - -let kernel_root_hash = EVM.make "/kernel_root_hash" - -let kernel_upgrade = EVM.make "/kernel_upgrade" - -let sequencer_upgrade = EVM.make "/sequencer_upgrade" - -let delayed_inbox = EVM.make "/delayed-inbox" - -module Accounts = struct - let accounts = World_state.make "/eth_accounts" - - let balance = "/balance" - - let nonce = "/nonce" - - let code = "/code" - - let storage = "/storage" - - let account (Address (Hex s)) = accounts ^ "/" ^ s - - let balance address = account address ^ balance - - let nonce address = account address ^ nonce - - let code address = account address ^ code - - let storage address index = account address ^ storage ^ "/" ^ index -end - -module Block = struct - type number = Current | Nth of Z.t - - let blocks = World_state.make "/blocks" - - let number = "/number" - - let by_hash (Block_hash (Hex hash)) = blocks ^ "/" ^ hash - - let current_number = blocks ^ "/current" ^ number - - let current_hash = blocks ^ "/current/hash" -end - -module Indexes = struct - let indexes = World_state.make "/indexes" - - let blocks = "/blocks" - - let blocks = indexes ^ blocks - - let number_to_string = function - | Block.Current -> "current" - | Nth i -> Z.to_string i - - let block_by_number number = blocks ^ "/" ^ number_to_string number -end - -module Transaction_receipt = struct - let receipts = World_state.make "/transactions_receipts" - - let receipt (Hash (Hex tx_hash)) = receipts ^ "/" ^ tx_hash -end - -module Transaction_object = struct - let objects = World_state.make "/transactions_objects" - - let object_ (Hash (Hex tx_hash)) = objects ^ "/" ^ tx_hash -end - -module Delayed_transaction = struct - let hashes = EVM.make "/delayed-inbox" - - let transaction (Hash (Hex tx_hash)) = hashes ^ "/" ^ tx_hash ^ "/data" -end - -module Evm_events = struct - let events = EVM.make "/events" - - let length = events ^ "/" ^ "length" - - let nth_event i = events ^ "/" ^ string_of_int i -end diff --git a/etherlink/bin_node/lib_prod/durable_storage_path.mli b/etherlink/bin_node/lib_prod/durable_storage_path.mli deleted file mode 100644 index aa43e85e90cc4665dad14e73a392f0eeb9712987..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/durable_storage_path.mli +++ /dev/null @@ -1,93 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Marigold *) -(* Copyright (c) 2023 Functori *) -(* Copyright (c) 2023 Trilitech *) -(* *) -(*****************************************************************************) - -open Ethereum_types - -type path = string - -val evm_node_flag : path - -val chain_id : path - -val base_fee_per_gas : path - -val kernel_version : path - -val kernel_root_hash : path - -val kernel_upgrade : path - -val sequencer_upgrade : path - -val delayed_inbox : path - -(** Paths related to accounts. *) -module Accounts : sig - (** Path to the account's balance. *) - val balance : address -> path - - (** Path to the account's nonce. *) - val nonce : address -> path - - (** Path to the account's code. *) - val code : address -> path - - (** Path to the account's storage at a given index. *) - val storage : address -> path -> path -end - -(** Paths related to blocks. *) -module Block : sig - (** Block number is either the current head or a specific height. *) - type number = Current | Nth of Z.t - - (** Path to the given block. *) - val by_hash : block_hash -> path - - (** Path to the current block number. *) - val current_number : path - - (** Path to the current block hash. *) - val current_hash : path -end - -module Indexes : sig - (** Make the path to the indexed block hash. *) - val block_by_number : Block.number -> path -end - -module Transaction_receipt : sig - (** Path to the given transaction receipt. *) - val receipt : hash -> path -end - -module Transaction_object : sig - (** Path to the given transaction object. *) - val object_ : hash -> path -end - -module Delayed_transaction : sig - (** Path to the list of hashes of the delayed inbox. *) - val hashes : path - - (** Path to the delayed transaction. *) - val transaction : hash -> path -end - -module Evm_events : sig - (** Path to the list of events of the kernel. *) - val events : path - - (** Path to the length. *) - val length : path - - (** Path to the nth event of the kernel. *) - val nth_event : int -> path -end diff --git a/etherlink/bin_node/lib_prod/encodings/dune b/etherlink/bin_node/lib_prod/encodings/dune deleted file mode 100644 index 2c549ddd6c8d439f10fdd7fa6521cac61c8ebf7f..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/encodings/dune +++ /dev/null @@ -1,13 +0,0 @@ -; This file was automatically generated, do not edit. -; Edit file manifest/main.ml instead. - -(library - (name evm_node_lib_prod_encoding) - (public_name octez-evm-node-libs.evm_node_lib_prod_encoding) - (instrumentation (backend bisect_ppx)) - (libraries - octez-libs.base - octez-smart-rollup-wasm-debugger-plugin) - (flags - (:standard) - -open Tezos_base.TzPervasives)) diff --git a/etherlink/bin_node/lib_prod/encodings/ethereum_types.ml b/etherlink/bin_node/lib_prod/encodings/ethereum_types.ml deleted file mode 100644 index 02e25383da18d15e3834bc5c8e5e4665e8c61fc9..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/encodings/ethereum_types.ml +++ /dev/null @@ -1,1515 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Marigold *) -(* Copyright (c) 2024 Functori *) -(* *) -(* 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. *) -(* *) -(*****************************************************************************) - -(** Transaction hash size is 32 bytes. *) -let transaction_hash_size = 32 - -(** Translate an int in a binary string of two bytes (little endian). - Ints greater than 2 bytes are truncated. *) -let u16_to_bytes n = - let bytes = Bytes.make 2 'a' in - Bytes.set_uint16_le bytes 0 n ; - Bytes.to_string bytes - -(** Ethereum data, as Hex-encoded strings *) -type hex = Hex of string [@@ocaml.unboxed] - -(** Appends the [0x] prefix to a string. *) -let hex_to_string (Hex s) = "0x" ^ s - -(** Strips the [0x] prefix of a string. *) -let hex_of_string s = - if String.starts_with ~prefix:"0x" s then - let n = String.length s in - Hex (String.sub s 2 (n - 2)) - else Hex s - -(** [hex_to_bytes hex] transforms the [hex] to binary format. *) -let hex_to_bytes (Hex h) = Hex.to_bytes_exn (`Hex h) |> Bytes.to_string - -let hex_encoding = Data_encoding.(conv hex_to_string hex_of_string string) - -(** Ethereum address (20 bytes) *) -type address = Address of hex [@@ocaml.unboxed] - -let address_of_string s = Address (hex_of_string (String.lowercase_ascii s)) - -let address_to_string (Address a) = hex_to_string a - -let address_encoding = - Data_encoding.(conv address_to_string address_of_string string) - -(** [timestamp_to_bytes timestamp] transforms the timestamp to bytes - compatible with the kernel. *) -let timestamp_to_bytes timestamp = - let seconds = Time.Protocol.to_seconds timestamp in - let buffer = Bytes.make 8 '\000' in - Bytes.set_int64_le buffer 0 seconds ; - buffer - -let timestamp_of_bytes timestamp_bytes = - let timestamp_64 = Bytes.get_int64_le timestamp_bytes 0 in - Time.Protocol.of_seconds timestamp_64 - -(** Ethereum generic quantity, always encoded in hexadecimal. *) -type quantity = Qty of Z.t [@@ocaml.unboxed] - -let quantity_of_z z = Qty z - -let z_to_hexa = Z.format "#x" - -let quantity_encoding = - Data_encoding.conv - (fun (Qty q) -> z_to_hexa q) - (fun q -> Qty (Z.of_string q)) - Data_encoding.string - -let pp_quantity fmt (Qty q) = Z.pp_print fmt q - -(** Ethereum block params in RPCs. *) -type block_param = Hash_param of quantity | Earliest | Latest | Pending - -let block_param_encoding = - let open Data_encoding in - union - [ - (let tag = "hex" in - case - ~title:tag - (Tag 0) - quantity_encoding - (function Hash_param h -> Some h | _ -> None) - (fun h -> Hash_param h)); - (let tag = "earliest" in - case - ~title:tag - (Tag 1) - (constant tag) - (function Earliest -> Some () | _ -> None) - (fun () -> Earliest)); - (let tag = "latest" in - case - ~title:tag - (Tag 2) - (constant tag) - (function Latest -> Some () | _ -> None) - (fun () -> Latest)); - (let tag = "pending" in - case - ~title:tag - (Tag 3) - (constant tag) - (function Pending -> Some () | _ -> None) - (fun () -> Pending)); - ] - -(** Ethereum block hash (32 bytes) *) -type block_hash = Block_hash of hex [@@ocaml.unboxed] - -let block_hash_of_string s = Block_hash (hex_of_string s) - -let block_hash_encoding = - Data_encoding.( - conv (fun (Block_hash h) -> hex_to_string h) block_hash_of_string string) - -let block_hash_to_bytes (Block_hash h) = hex_to_bytes h - -let genesis_parent_hash = Block_hash (Hex (String.make 64 'f')) - -(** Ethereum hash, that would encoded with a 0x prefix. *) -type hash = Hash of hex [@@ocaml.unboxed] - -(** [hash_of_string s] takes a string [s] representing a hash in - hexadecimal format, e.g. [0xFFFFFFF]. Strips the prefix and keeps the - hash value, e.g. [FFFFFFF]. *) -let hash_of_string s = Hash (hex_of_string s) - -(** [hash_to_string h] constructs a valid hash encoded in hexadecimal format, - e.g. [0xFFFFFFF]. *) -let hash_to_string (Hash h) = hex_to_string h - -(** [hash_to_bytes hash] transforms the [hash] to binary format. *) -let hash_to_bytes (Hash h) = hex_to_bytes h - -let hash_encoding = Data_encoding.(conv hash_to_string hash_of_string string) - -let pp_hash fmt (Hash (Hex h)) = Format.pp_print_string fmt h - -let pp_block_hash fmt (Block_hash (Hex h)) = Format.pp_print_string fmt h - -let empty_hash = Hash (Hex "") - -let decode_hex bytes = Hex Hex.(of_bytes bytes |> show) - -let encode_hex (Hex hex) = Hex.to_bytes_exn (`Hex hex) - -let decode_block_hash bytes = Block_hash (decode_hex bytes) - -let encode_block_hash (Block_hash hash) = encode_hex hash - -let decode_address bytes = Address (decode_hex bytes) - -let encode_address (Address address) = encode_hex address - -let decode_number bytes = Bytes.to_string bytes |> Z.of_bits |> quantity_of_z - -let encode_number (Qty v) = Z.to_bits v |> Bytes.of_string - -let decode_hash bytes = Hash (decode_hex bytes) - -let pad_to_n_bytes_le bytes length = - let current_length = Bytes.length bytes in - if current_length >= length then bytes - else - let padding_length = length - current_length in - let padding = Bytes.make padding_length '\x00' in - Bytes.cat bytes padding - -let encode_u256_le (Qty n) = - let bits = Z.to_bits n |> Bytes.of_string in - pad_to_n_bytes_le bits 32 - -let encode_u16_le (Qty n) = - let bits = Z.to_bits n |> Bytes.of_string in - pad_to_n_bytes_le bits 2 - -type transaction_log = { - address : address; - topics : hash list; - data : hex; - blockNumber : quantity option; - transactionHash : hash option; - transactionIndex : quantity option; - blockHash : block_hash option; - logIndex : quantity option; - removed : bool option; -} - -let transaction_log_body_from_rlp = function - | Rlp.List [List [Value address; List topics; Value data]; Value index] -> - ( decode_address address, - List.map - (function - | Rlp.Value bytes -> decode_hash bytes - | _ -> raise (Invalid_argument "Expected hash representing topic")) - topics, - decode_hex data, - decode_number index ) - | _ -> - raise - (Invalid_argument - "Expected list of 2 elements representing an indexed log body") - -let transaction_log_encoding = - let open Data_encoding in - conv - (fun { - address; - topics; - data; - blockNumber; - transactionHash; - transactionIndex; - blockHash; - logIndex; - removed; - } -> - ( address, - topics, - data, - blockNumber, - transactionHash, - transactionIndex, - blockHash, - logIndex, - removed )) - (fun ( address, - topics, - data, - blockNumber, - transactionHash, - transactionIndex, - blockHash, - logIndex, - removed ) -> - { - address; - topics; - data; - blockNumber; - transactionHash; - transactionIndex; - blockHash; - logIndex; - removed; - }) - (obj9 - (req "address" address_encoding) - (req "topics" (list hash_encoding)) - (req "data" hex_encoding) - (req "blockNumber" (option quantity_encoding)) - (req "transactionHash" (option hash_encoding)) - (req "transactionIndex" (option quantity_encoding)) - (req "blockHash" (option block_hash_encoding)) - (req "logIndex" (option quantity_encoding)) - (req "removed" (option bool))) - -type transaction_receipt = { - transactionHash : hash; - transactionIndex : quantity; - blockHash : block_hash; - blockNumber : quantity; - from : address; - to_ : address option; - cumulativeGasUsed : quantity; - effectiveGasPrice : quantity; - gasUsed : quantity; - logs : transaction_log list; - logsBloom : hex; - type_ : quantity; - status : quantity; - contractAddress : address option; -} - -let transaction_receipt_from_rlp block_hash bytes = - match Rlp.decode bytes with - | Ok - (Rlp.List - [ - Value hash; - Value index; - Value block_number; - Value from; - Value to_; - Value cumulative_gas_used; - Value effective_gas_price; - Value gas_used; - Value contract_address; - List logs; - Value bloom; - Value type_; - Value status; - ]) -> - let hash = decode_hash hash in - let index = decode_number index in - let block_number = decode_number block_number in - let from = decode_address from in - let to_ = if to_ = Bytes.empty then None else Some (decode_address to_) in - let cumulative_gas_used = decode_number cumulative_gas_used in - let effective_gas_price = decode_number effective_gas_price in - let gas_used = decode_number gas_used in - let contract_address = - if contract_address = Bytes.empty then None - else Some (decode_address contract_address) - in - let logs_body = List.map transaction_log_body_from_rlp logs in - let logs_objects = - List.map - (fun (address, topics, data, logIndex) -> - { - address; - topics; - data; - blockHash = Some block_hash; - blockNumber = Some block_number; - transactionHash = Some hash; - transactionIndex = Some index; - logIndex = Some logIndex; - removed = Some false; - }) - logs_body - in - let bloom = decode_hex bloom in - let type_ = decode_number type_ in - let status = decode_number status in - { - transactionHash = hash; - transactionIndex = index; - blockHash = block_hash; - blockNumber = block_number; - from; - to_; - cumulativeGasUsed = cumulative_gas_used; - effectiveGasPrice = effective_gas_price; - gasUsed = gas_used; - logs = logs_objects; - logsBloom = bloom; - type_; - status; - contractAddress = contract_address; - } - | _ -> - raise - (Invalid_argument - "Expected a RlpList of 13 elements in transaction receipt") - -let transaction_receipt_encoding = - let open Data_encoding in - conv - (fun { - transactionHash; - transactionIndex; - blockHash; - blockNumber; - from; - to_; - cumulativeGasUsed; - effectiveGasPrice; - gasUsed; - logs; - logsBloom; - type_; - status; - contractAddress; - } -> - ( ( transactionHash, - transactionIndex, - blockHash, - blockNumber, - from, - to_, - cumulativeGasUsed, - effectiveGasPrice, - gasUsed, - logs ), - (logsBloom, type_, status, contractAddress) )) - (fun ( ( transactionHash, - transactionIndex, - blockHash, - blockNumber, - from, - to_, - cumulativeGasUsed, - effectiveGasPrice, - gasUsed, - logs ), - (logsBloom, type_, status, contractAddress) ) -> - { - transactionHash; - transactionIndex; - blockHash; - blockNumber; - from; - to_; - cumulativeGasUsed; - effectiveGasPrice; - gasUsed; - logs; - logsBloom; - type_; - status; - contractAddress; - }) - (merge_objs - (obj10 - (req "transactionHash" hash_encoding) - (req "transactionIndex" quantity_encoding) - (req "blockHash" block_hash_encoding) - (req "blockNumber" quantity_encoding) - (req "from" address_encoding) - (req "to" (option address_encoding)) - (req "cumulativeGasUsed" quantity_encoding) - (req "effectiveGasPrice" quantity_encoding) - (req "gasUsed" quantity_encoding) - (req "logs" (list transaction_log_encoding))) - (obj4 - (req "logsBloom" hex_encoding) - (req "type" quantity_encoding) - (req "status" quantity_encoding) - (req "contractAddress" (option address_encoding)))) - -type transaction_object = { - blockHash : block_hash; - blockNumber : quantity; - from : address; - gas : quantity; - gasPrice : quantity; - hash : hash; - input : hash; - nonce : quantity; - to_ : address option; - transactionIndex : quantity; - (* It can be null if it's in a pending block, but we don't have a notion of pending. *) - value : quantity; - v : quantity; - r : hash; - s : hash; -} - -let transaction_object_from_rlp block_hash bytes = - match Rlp.decode bytes with - | Ok - (Rlp.List - [ - Value block_number; - Value from; - Value gas_used; - Value gas_price; - Value hash; - Value input; - Value nonce; - Value to_; - Value index; - Value value; - Value v; - Value r; - Value s; - ]) -> - let block_number = decode_number block_number in - let from = decode_address from in - let gas = decode_number gas_used in - let gas_price = decode_number gas_price in - let hash = decode_hash hash in - let input = decode_hash input in - let nonce = decode_number nonce in - let to_ = if to_ = Bytes.empty then None else Some (decode_address to_) in - let index = decode_number index in - let value = decode_number value in - let v = decode_number v in - let r = decode_hash r in - let s = decode_hash s in - { - blockHash = block_hash; - blockNumber = block_number; - from; - gas; - gasPrice = gas_price; - hash; - input; - nonce; - to_; - transactionIndex = index; - value; - v; - r; - s; - } - | _ -> raise (Invalid_argument "Expected a List of 13 elements") - -let transaction_object_encoding = - let open Data_encoding in - conv - (fun { - blockHash; - blockNumber; - from; - gas; - gasPrice; - hash; - input; - nonce; - to_; - transactionIndex; - value; - v; - r; - s; - } -> - ( ( blockHash, - blockNumber, - from, - gas, - gasPrice, - hash, - input, - nonce, - to_, - transactionIndex ), - (value, v, r, s) )) - (fun ( ( blockHash, - blockNumber, - from, - gas, - gasPrice, - hash, - input, - nonce, - to_, - transactionIndex ), - (value, v, r, s) ) -> - { - blockHash; - blockNumber; - from; - gas; - gasPrice; - hash; - input; - nonce; - to_; - transactionIndex; - value; - v; - r; - s; - }) - (merge_objs - (obj10 - (req "blockHash" block_hash_encoding) - (req "blockNumber" quantity_encoding) - (req "from" address_encoding) - (req "gas" quantity_encoding) - (req "gasPrice" quantity_encoding) - (req "hash" hash_encoding) - (req "input" hash_encoding) - (req "nonce" quantity_encoding) - (req "to" (option address_encoding)) - (req "transactionIndex" quantity_encoding)) - (obj4 - (req "value" quantity_encoding) - (req "v" quantity_encoding) - (req "r" hash_encoding) - (req "s" hash_encoding))) - -type block_transactions = - | TxHash of hash list - | TxFull of transaction_object list - -let block_transactions_encoding = - let open Data_encoding in - union - [ - case - ~title:"hash" - (Tag 0) - (list hash_encoding) - (function TxHash hashes -> Some hashes | _ -> None) - (fun hashes -> TxHash hashes); - case - ~title:"full" - (Tag 1) - (list transaction_object_encoding) - (function TxFull txs -> Some txs | _ -> None) - (fun txs -> TxFull txs); - ] - -(** Ethereum block hash representation from RPCs. *) -type block = { - number : quantity; - hash : block_hash; - parent : block_hash; - nonce : hex; - sha3Uncles : hash; - logsBloom : hex; - transactionRoot : hash; - stateRoot : hash; - receiptRoot : hash; - miner : hex; - difficulty : quantity; - totalDifficulty : quantity; - extraData : hex; - size : quantity; - gasLimit : quantity; - gasUsed : quantity; - timestamp : quantity; - transactions : block_transactions; - uncles : hash list; -} - -let decode_list decoder list = - List.map - Rlp.( - function - | Value r -> decoder r - | List _ -> raise (Invalid_argument "Expected a list of atomic data")) - list - -let decode_option ~default decoder bytes = - (if bytes = Bytes.empty then None else Some (decoder bytes)) - |> Option.value ~default - -let block_from_rlp bytes = - match Rlp.decode bytes with - | Ok - (Rlp.List - [ - Value number; - Value hash; - Value parent_hash; - Value logsBloom; - Value transactionRoot; - Value stateRoot; - Value receiptRoot; - Value miner; - Value extraData; - Value gasLimit; - List transactions; - Value gasUsed; - Value timestamp; - ]) -> - let (Qty number) = decode_number number in - let hash = decode_block_hash hash in - let parent = decode_block_hash parent_hash in - let logsBloom = - decode_option ~default:(Hex (String.make 512 'a')) decode_hex logsBloom - in - (* Post merge: this field is now used for the "fee recipient". We don't - have that, potentially this could be the sequencer. *) - let miner = - decode_option - ~default:(Hex "0000000000000000000000000000000000000000") - decode_hex - miner - in - let transactionRoot = - decode_option - ~default:(Hash (Hex (String.make 64 'a'))) - decode_hash - transactionRoot - in - let stateRoot = - decode_option - ~default:(Hash (Hex (String.make 64 'a'))) - decode_hash - stateRoot - in - let receiptRoot = - decode_option - ~default:(Hash (Hex (String.make 64 'a'))) - decode_hash - receiptRoot - in - let extraData = decode_option ~default:(Hex "") decode_hex extraData in - let gasLimit = - decode_option ~default:(Qty Z.zero) decode_number gasLimit - in - let transactions = TxHash (decode_list decode_hash transactions) in - let gasUsed = decode_number gasUsed in - let timestamp = decode_number timestamp in - { - number = Qty number; - hash; - parent; - (* Post merge: always 0. *) - nonce = Hex "0000000000000000"; - (* Post merge: uncles are always empty, therefore this is the "empty" - hash of these uncles. *) - sha3Uncles = - Hash - (Hex - "1dcc4de8dec75d7aab85b567b6ccd41ad312451b948a7413f0a142fd40d49347"); - logsBloom; - transactionRoot; - stateRoot; - receiptRoot; - miner; - (* Post merge: always zero. *) - difficulty = Qty Z.zero; - (* Post merge: sum of difficulty will always be zero because difficulty - has and will always be zero. *) - totalDifficulty = Qty Z.zero; - extraData; - size = Qty (Z.of_int (Bytes.length bytes)); - gasLimit; - gasUsed; - timestamp; - transactions; - (* Post merge: always empty. *) - uncles = []; - } - | _ -> raise (Invalid_argument "Expected a List of 13 elements") - -let block_encoding = - let open Data_encoding in - conv - (fun { - number; - hash; - parent; - nonce; - sha3Uncles; - logsBloom; - transactionRoot; - stateRoot; - receiptRoot; - miner; - difficulty; - totalDifficulty; - extraData; - size; - gasLimit; - gasUsed; - timestamp; - transactions; - uncles; - } -> - ( ( number, - hash, - parent, - nonce, - sha3Uncles, - logsBloom, - transactionRoot, - stateRoot, - receiptRoot, - miner ), - ( difficulty, - totalDifficulty, - extraData, - size, - gasLimit, - gasUsed, - timestamp, - transactions, - uncles ) )) - (fun ( ( number, - hash, - parent, - nonce, - sha3Uncles, - logsBloom, - transactionRoot, - stateRoot, - receiptRoot, - miner ), - ( difficulty, - totalDifficulty, - extraData, - size, - gasLimit, - gasUsed, - timestamp, - transactions, - uncles ) ) -> - { - number; - hash; - parent; - nonce; - sha3Uncles; - logsBloom; - transactionRoot; - stateRoot; - receiptRoot; - miner; - difficulty; - totalDifficulty; - extraData; - size; - gasLimit; - gasUsed; - timestamp; - transactions; - uncles; - }) - (merge_objs - (obj10 - (req "number" quantity_encoding) - (req "hash" block_hash_encoding) - (req "parentHash" block_hash_encoding) - (req "nonce" hex_encoding) - (req "sha3Uncles" hash_encoding) - (req "logsBloom" hex_encoding) - (req "transactionsRoot" hash_encoding) - (req "stateRoot" hash_encoding) - (req "receiptsRoot" hash_encoding) - (req "miner" hex_encoding)) - (obj9 - (req "difficulty" quantity_encoding) - (req "totalDifficulty" quantity_encoding) - (req "extraData" hex_encoding) - (req "size" quantity_encoding) - (req "gasLimit" quantity_encoding) - (req "gasUsed" quantity_encoding) - (req "timestamp" quantity_encoding) - (req "transactions" block_transactions_encoding) - (req "uncles" (list hash_encoding)))) - -type transaction = { - from : address; - to_ : address; - gas : quantity; - gasPrice : quantity; - value : quantity option; - data : hash; - nonce : quantity option; -} - -let transaction_encoding = - let open Data_encoding in - conv - (fun {from; to_; gas; gasPrice; value; data; nonce} -> - (from, to_, gas, gasPrice, value, data, nonce)) - (fun (from, to_, gas, gasPrice, value, data, nonce) -> - {from; to_; gas; gasPrice; value; data; nonce}) - (obj7 - (req "from" address_encoding) - (req "to" address_encoding) - (req "gas" quantity_encoding) - (req "gasPrice" quantity_encoding) - (opt "value" quantity_encoding) - (req "data" hash_encoding) - (opt "nonce" quantity_encoding)) - -type call = { - from : address option; - to_ : address option; - gas : quantity option; - gasPrice : quantity option; - value : quantity option; - data : hash option; -} - -let call_extendable_encoding = - let open Data_encoding in - (* `merge_objs unit` allows the encoding to accept any number of - unspecified fields from JSON. *) - merge_objs - (conv_with_guard - (fun {from; to_; gas; gasPrice; value; data} -> - (from, Some to_, gas, gasPrice, value, data, None)) - (function - | from, to_, gas, gasPrice, value, data, None - | from, to_, gas, gasPrice, value, None, data -> - Ok {from; to_ = Option.join to_; gas; gasPrice; value; data} - | _, _, _, _, _, Some _, Some _ -> - Error "Cannot specify both data and input") - (obj7 - (opt "from" address_encoding) - (opt "to" (option address_encoding)) - (* `call` is also used for estimateGas, which allows all fields to be - empty, hence `to` can be `null` or absent. *) - (opt "gas" quantity_encoding) - (opt "gasPrice" quantity_encoding) - (opt "value" quantity_encoding) - (opt "input" hash_encoding) - (opt "data" hash_encoding))) - unit - -let call_encoding = - Data_encoding.conv - (fun call -> (call, ())) - (fun (call, ()) -> call) - call_extendable_encoding - -(** The txpool encoding can be found in - https://geth.ethereum.org/docs/interacting-with-geth/rpc/ns-txpool#txpool-content. - - Basically, `txpool_content` is a map associating addresses to counters and - transactions. In JSON, it is encoded as an object associating addresses as - fields to objects that contain counters as field and transaction objects as - values. I.e., the `txpool_` encodes it as: - - ``` - {@js[ - - { "address1" : - { "counter1" : , - "counter2" : , - ... - }, - "address2" : - { "counter1" : , - "counter2" : , - ... - }, - ... - } - ]} - ``` - - As such, the encoding uses Ezjsonm representation directly to encode and - decode the txpool. -*) -module MapMake (Key : sig - include Stdlib.Map.OrderedType - - val to_string : t -> string - - val of_string : string -> t -end) : sig - include Map.S with type key = Key.t - - val associative_array_encoding : 'a Data_encoding.t -> 'a t Data_encoding.t -end = struct - module Instance = Map.Make (Key) - - let associative_array_encoding value_encoding = - let open Data_encoding in - conv - (fun map -> - let bindings = Instance.bindings map in - let fields = - List.map - (fun (name, value) -> - (Key.to_string name, Json.construct value_encoding value)) - bindings - in - `O fields) - (function - | `O fields -> - let bindings = - List.filter_map - (fun (name, value) -> - try - Some (Key.of_string name, Json.destruct value_encoding value) - with _ -> None) - fields - |> List.to_seq - in - Instance.of_seq bindings - | _ -> Instance.empty) - Json.encoding - - include Instance -end - -module NonceMap = MapMake (Z) - -module Address = struct - type t = address - - let compare (Address (Hex h)) (Address (Hex h')) = String.compare h h' - - let to_string = address_to_string - - let of_string = address_of_string - - let encoding = address_encoding -end - -module AddressMap = MapMake (Address) - -type txpool = { - pending : transaction_object NonceMap.t AddressMap.t; - queued : transaction_object NonceMap.t AddressMap.t; -} - -let txpool_encoding = - let open Data_encoding in - let field_encoding = - AddressMap.associative_array_encoding - (NonceMap.associative_array_encoding transaction_object_encoding) - in - conv - (fun {pending; queued} -> (pending, queued)) - (fun (pending, queued) -> {pending; queued}) - (obj2 (req "pending" field_encoding) (req "queued" field_encoding)) - -let hash_raw_tx str = - str |> Bytes.of_string |> Tezos_crypto.Hacl.Hash.Keccak_256.digest - |> Bytes.to_string - -(** [transaction_nonce bytes] returns the nonce of a given raw transaction. *) -let transaction_nonce bytes = - let open Result_syntax in - if String.starts_with ~prefix:"01" bytes then - (* EIP-2930: https://github.com/ethereum/EIPs/blob/master/EIPS/eip-2930.md *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; Value nonce; _; _; _; _; _; _]) - | Ok (Rlp.List [_; Value nonce; _; _; _; _; _; _; _; _; _]) -> - let+ nonce = Rlp.decode_z nonce in - nonce - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 8 or 11 elements") - else if String.starts_with ~prefix:"02" bytes then - (* EIP-1559: https://github.com/ethereum/EIPs/blob/master/EIPS/eip-1559.md *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; Value nonce; _; _; _; _; _; _; _]) - | Ok (Rlp.List [_; Value nonce; _; _; _; _; _; _; _; _; _; _]) -> - let+ nonce = Rlp.decode_z nonce in - nonce - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 9 or 12 elements") - else - (* Legacy: https://eips.ethereum.org/EIPS/eip-2972 *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [Value nonce; _; _; _; _; _; _; _; _]) -> - let+ nonce = Rlp.decode_z nonce in - nonce - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 9 elements") - -(** [transaction_data bytes] returns the data of a given raw transaction. *) -let transaction_data bytes = - let open Result_syntax in - if String.starts_with ~prefix:"01" bytes then - (* EIP-2930: https://github.com/ethereum/EIPs/blob/master/EIPS/eip-2930.md *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; _; _; _; _; _; Value data; _]) - | Ok (Rlp.List [_; _; _; _; _; _; Value data; _; _; _; _]) -> - return data - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 8 or 11 elements") - else if String.starts_with ~prefix:"02" bytes then - (* EIP-1559: https://github.com/ethereum/EIPs/blob/master/EIPS/eip-1559.md *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; _; _; _; _; _; _; Value data; _]) - | Ok (Rlp.List [_; _; _; _; _; _; _; Value data; _; _; _; _]) -> - return data - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 9 or 12 elements") - else - (* Legacy: https://eips.ethereum.org/EIPS/eip-2972 *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; _; _; _; _; Value data; _; _; _]) -> return data - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 9 elements") - -(** [transaction_gas_limit bytes] returns the gas limit of a given raw transaction. *) -let transaction_gas_limit bytes = - let open Result_syntax in - if String.starts_with ~prefix:"01" bytes then - (* EIP-2930: https://github.com/ethereum/EIPs/blob/master/EIPS/eip-2930.md *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; _; _; Value gas_limit; _; _; _; _]) - | Ok (Rlp.List [_; _; _; Value gas_limit; _; _; _; _; _; _; _]) -> - let+ gas_limit = Rlp.decode_z gas_limit in - gas_limit - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 8 or 11 elements") - else if String.starts_with ~prefix:"02" bytes then - (* EIP-1559: https://github.com/ethereum/EIPs/blob/master/EIPS/eip-1559.md *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; _; _; _; Value gas_limit; _; _; _; _]) - | Ok (Rlp.List [_; _; _; _; Value gas_limit; _; _; _; _; _; _; _]) -> - let+ gas_limit = Rlp.decode_z gas_limit in - gas_limit - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 9 or 12 elements") - else - (* Legacy: https://eips.ethereum.org/EIPS/eip-2972 *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; _; Value gas_limit; _; _; _; _; _; _]) -> - let+ gas_limit = Rlp.decode_z gas_limit in - gas_limit - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 9 elements") - -(** [transaction_gas_price base_fee bytes] returns the maximum gas price the - user can pay for the tx. *) -let transaction_gas_price bytes = - let open Result_syntax in - if String.starts_with ~prefix:"01" bytes then - (* EIP-2930: https://github.com/ethereum/EIPs/blob/master/EIPS/eip-2930.md *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; _; Value gas_price; _; _; _; _; _]) - | Ok (Rlp.List [_; _; Value gas_price; _; _; _; _; _; _; _; _]) -> - let* gas_price = Rlp.decode_z gas_price in - return gas_price - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 8 or 11 elements") - else if String.starts_with ~prefix:"02" bytes then - (* EIP-1559: https://github.com/ethereum/EIPs/blob/master/EIPS/eip-1559.md *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; _; _; Value max_fee_per_gas; _; _; _; _; _]) - | Ok (Rlp.List [_; _; _; Value max_fee_per_gas; _; _; _; _; _; _; _; _]) -> - (* Normally, max_priority_fee_per_gas would also be a fee paid per gas in - addition to base fee per gas. - This would incentivise miners to include the transaction. - More details see here https://eips.ethereum.org/EIPS/eip-1559#abstract - - We choose to ignore this, however, as we actually do not implement EIP-1559 - mechanism exactly. The sequencer is compensated for L1 inclusion cost via - the data availability fee. *) - let* max_fee_per_gas = Rlp.decode_z max_fee_per_gas in - return max_fee_per_gas - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 9 or 12 elements") - else - (* Legacy: https://eips.ethereum.org/EIPS/eip-2972 *) - match bytes |> String.to_bytes |> Rlp.decode with - | Ok (Rlp.List [_; Value gas_price; _; _; _; _; _; _; _]) -> - let* gas_price = Rlp.decode_z gas_price in - return gas_price - | _ -> tzfail (Rlp.Rlp_decoding_error "Expected a list of 9") - -(* Event filter, see - https://ethereum.org/en/developers/docs/apis/json-rpc/#eth_getlogs *) -type filter_topic = One of hash | Or of hash list - -let filter_topic_encoding = - let open Data_encoding in - union - [ - case - ~title:"one" - (Tag 0) - hash_encoding - (function One hash -> Some hash | _ -> None) - (fun hash -> One hash); - case - ~title:"or" - (Tag 1) - (list hash_encoding) - (function Or l -> Some l | _ -> None) - (fun l -> Or l); - ] - -type filter_address = Single of address | Vec of address list - -let filter_address_encoding = - let open Data_encoding in - union - [ - case - ~title:"single" - (Tag 0) - address_encoding - (function Single address -> Some address | _ -> None) - (fun address -> Single address); - case - ~title:"vec" - (Tag 1) - (list address_encoding) - (function Vec l -> Some l | _ -> None) - (fun l -> Vec l); - ] - -type filter = { - from_block : block_param option; - to_block : block_param option; - address : filter_address option; - topics : filter_topic option list option; - block_hash : block_hash option; -} - -let filter_encoding = - let open Data_encoding in - conv - (fun {from_block; to_block; address; topics; block_hash} -> - (from_block, to_block, address, topics, block_hash)) - (fun (from_block, to_block, address, topics, block_hash) -> - {from_block; to_block; address; topics; block_hash}) - (obj5 - (opt "fromBlock" block_param_encoding) - (opt "toBlock" block_param_encoding) - (opt "address" filter_address_encoding) - (opt "topics" (list @@ option filter_topic_encoding)) - (opt "blockHash" block_hash_encoding)) - -type filter_changes = - | Block_filter of block_hash - | Pending_transaction_filter of hash - | Log of transaction_log - -let filter_changes_encoding = - let open Data_encoding in - union - [ - case - ~title:"block" - (Tag 0) - block_hash_encoding - (function Block_filter hash -> Some hash | _ -> None) - (fun hash -> Block_filter hash); - case - ~title:"pending_transaction" - (Tag 1) - hash_encoding - (function Pending_transaction_filter hash -> Some hash | _ -> None) - (fun hash -> Pending_transaction_filter hash); - case - ~title:"log" - (Tag 2) - transaction_log_encoding - (function Log f -> Some f | _ -> None) - (fun f -> Log f); - ] - -module Delayed_transaction = struct - type kind = Transaction | Deposit - - type t = { - kind : kind; - hash : hash; - raw : string; - (* Binary string, so that it integrates smoothly with the tx-pool. *) - } - - let hash t = t.hash - - let encoding_kind = - let open Data_encoding in - union - [ - case - (Tag 0) - ~title:"transaction" - (constant "transaction") - (function Transaction -> Some () | _ -> None) - (function () -> Transaction); - case - (Tag 1) - ~title:"deposit" - (constant "deposit") - (function Deposit -> Some () | _ -> None) - (function () -> Deposit); - ] - - let encoding : t Data_encoding.t = - let open Data_encoding in - conv - (fun {kind; hash; raw} -> (kind, hash, raw)) - (fun (kind, hash, raw) -> {kind; hash; raw}) - (tup3 encoding_kind hash_encoding (string' Hex)) - - let of_rlp_content ?(transaction_tag = "\x03") hash rlp_content = - match rlp_content with - | Rlp.(List [Value tag; content]) -> ( - match (Bytes.to_string tag, content) with - (* The new delayed transaction event actually contains the - TransactionContent, which is Ethereum|Deposit|DelayedTransaction. - Transaction cannot be in the delayed inbox by construction, therefore - we care only about Deposit and DelayedTransaction. - - However, we use this function to decode actual delayed inbox item - when we initialize from a rollup-node. They contain the same - payload but have a different tag for transaction. - *) - | tag, Rlp.Value raw_tx when tag = transaction_tag -> - let hash = - raw_tx |> Bytes.to_string |> hash_raw_tx |> Hex.of_string - |> Hex.show |> hash_of_string - in - Some {kind = Transaction; hash; raw = Bytes.to_string raw_tx} - | "\x02", deposit -> - let raw = Rlp.encode deposit |> Bytes.to_string in - Some {kind = Deposit; hash; raw} - | _ -> None) - | _ -> None - - let to_rlp {kind; raw; hash} = - let open Rlp in - let tag = - (match kind with Transaction -> "\x03" | Deposit -> "\x02") - |> Bytes.of_string - in - let hash = hash_to_bytes hash |> Bytes.of_string in - let content = - match kind with - | Transaction -> Value (Bytes.of_string raw) - | Deposit -> decode_exn (Bytes.of_string raw) - in - let rlp = List [Value hash; List [Value tag; content]] in - encode rlp - - let pp_kind fmt = function - | Transaction -> Format.pp_print_string fmt "Transaction" - | Deposit -> Format.pp_print_string fmt "Deposit" - - let pp fmt {raw; kind; _} = - Format.fprintf fmt "%a: %a" pp_kind kind Hex.pp (Hex.of_string raw) - - let pp_short fmt {kind; hash; _} = - Format.fprintf fmt "%a: %a" pp_kind kind pp_hash hash -end - -module Upgrade = struct - type t = {hash : hash; timestamp : Time.Protocol.t} - - let of_rlp = function - | Rlp.List [Value hash_bytes; Value timestamp] -> - let hash = - hash_bytes |> Bytes.to_string |> Hex.of_string |> Hex.show - |> hash_of_string - in - let timestamp = timestamp_of_bytes timestamp in - Some {hash; timestamp} - | _ -> None - - let of_bytes bytes = - match bytes |> Rlp.decode with Ok rlp -> of_rlp rlp | _ -> None - - let to_bytes {hash; timestamp} = - let hash = hash_to_bytes hash |> String.to_bytes in - let timestamp = timestamp_to_bytes timestamp in - Rlp.(encode (List [Value hash; Value timestamp])) - - let encoding = - let open Data_encoding in - conv - (fun {hash = Hash (Hex hash); timestamp} -> (hash, timestamp)) - (fun (hash, timestamp) -> {hash = Hash (Hex hash); timestamp}) - (tup2 string Time.Protocol.encoding) -end - -module Sequencer_upgrade = struct - type t = { - sequencer : Signature.public_key; - pool_address : address; - timestamp : Time.Protocol.t; - } - - let of_rlp = function - | Rlp.List [Value sequencer; Value pool_address; Value timestamp] -> - let sequencer = - Signature.Public_key.of_b58check_exn (String.of_bytes sequencer) - in - let timestamp = timestamp_of_bytes timestamp in - let pool_address = decode_address pool_address in - Some {sequencer; pool_address; timestamp} - | _ -> None - - let to_rlp {sequencer; pool_address; timestamp} = - let sequencer = - Signature.Public_key.to_b58check sequencer |> String.to_bytes - in - let timestamp = timestamp_to_bytes timestamp in - let pool_address = encode_address pool_address in - Rlp.List [Value sequencer; Value pool_address; Value timestamp] - - let of_bytes bytes = - match bytes |> Rlp.decode with Ok rlp -> of_rlp rlp | _ -> None - - let to_bytes sequencer_upgrade = Rlp.encode @@ to_rlp sequencer_upgrade - - let encoding = - let open Data_encoding in - conv - (fun {sequencer; pool_address = Address (Hex pool_address); timestamp} -> - (sequencer, pool_address, timestamp)) - (fun (sequencer, pool_address, timestamp) -> - {sequencer; pool_address = Address (Hex pool_address); timestamp}) - (tup3 Signature.Public_key.encoding string Time.Protocol.encoding) -end - -module Blueprint_applied = struct - type t = {number : quantity; hash : block_hash} - - let of_rlp = function - | Rlp.List [Value number; Value hash] -> - let number = decode_number number in - let hash = decode_block_hash hash in - Some {number; hash} - | _ -> None - - let of_bytes bytes = - match bytes |> Rlp.decode with Ok rlp -> of_rlp rlp | _ -> None - - let to_bytes {number; hash} = - let number = encode_number number in - let hash = encode_block_hash hash in - Rlp.(encode (List [Value number; Value hash])) - - let encoding = - let open Data_encoding in - conv - (fun {number = Qty number; hash = Block_hash (Hex hash)} -> - (number, hash)) - (fun (number, hash) -> - {number = Qty number; hash = Block_hash (Hex hash)}) - (tup2 z string) -end - -module Evm_events = struct - type t = - | Upgrade_event of Upgrade.t - | Sequencer_upgrade_event of Sequencer_upgrade.t - | Blueprint_applied of Blueprint_applied.t - | New_delayed_transaction of Delayed_transaction.t - - let of_bytes bytes = - match bytes |> Rlp.decode with - | Ok (Rlp.List [Value tag; rlp_content]) -> ( - match Bytes.to_string tag with - | "\x01" -> - let upgrade = Upgrade.of_rlp rlp_content in - Option.map (fun u -> Upgrade_event u) upgrade - | "\x02" -> - let sequencer_upgrade = Sequencer_upgrade.of_rlp rlp_content in - Option.map (fun u -> Sequencer_upgrade_event u) sequencer_upgrade - | "\x03" -> - let blueprint_applied = Blueprint_applied.of_rlp rlp_content in - Option.map (fun u -> Blueprint_applied u) blueprint_applied - | "\x04" -> ( - match rlp_content with - | List [Value hash; transaction_content] -> - let hash = decode_hash hash in - let transaction = - Delayed_transaction.of_rlp_content hash transaction_content - in - Option.map (fun u -> New_delayed_transaction u) transaction - | _ -> None) - | _ -> None) - | _ -> None - - let pp fmt = function - | Upgrade_event {hash; timestamp} -> - Format.fprintf - fmt - "Upgrade:@ hash %a,@ timestamp: %a" - pp_hash - hash - Time.Protocol.pp_hum - timestamp - | Sequencer_upgrade_event - {sequencer; pool_address = Address (Hex address); timestamp} -> - Format.fprintf - fmt - "Sequencer upgrade:@ sequencer:@ %a,pool_address %s,@ timestamp: %a" - Signature.Public_key.pp - sequencer - address - Time.Protocol.pp_hum - timestamp - | Blueprint_applied {number = Qty number; hash = Block_hash (Hex hash)} -> - Format.fprintf - fmt - "Blueprint applied:@,number:%a@ hash: %s" - Z.pp_print - number - hash - | New_delayed_transaction delayed_transaction -> - Format.fprintf - fmt - "New delayed transaction:@ %a" - Delayed_transaction.pp_short - delayed_transaction - - let encoding = - let open Data_encoding in - let case ~kind ~tag ~event_encoding ~proj ~inj = - case - ~title:kind - (Tag tag) - (obj2 (req "kind" string) (req "event" event_encoding)) - (fun x -> match proj x with None -> None | Some x -> Some (kind, x)) - (fun (_, x) -> inj x) - in - union - [ - case - ~kind:"kernel_upgrade" - ~tag:0 - ~event_encoding:Upgrade.encoding - ~proj:(function Upgrade_event upgrade -> Some upgrade | _ -> None) - ~inj:(fun upgrade -> Upgrade_event upgrade); - case - ~kind:"sequencer_upgrade" - ~tag:1 - ~event_encoding:Sequencer_upgrade.encoding - ~proj:(function - | Sequencer_upgrade_event upgrade -> Some upgrade | _ -> None) - ~inj:(fun upgrade -> Sequencer_upgrade_event upgrade); - case - ~kind:"blueprint_applied" - ~tag:2 - ~event_encoding:Blueprint_applied.encoding - ~proj:(function Blueprint_applied info -> Some info | _ -> None) - ~inj:(fun info -> Blueprint_applied info); - case - ~kind:"new_delayed_transaction" - ~tag:3 - ~event_encoding:Delayed_transaction.encoding - ~proj:(function - | New_delayed_transaction delayed_transaction -> - Some delayed_transaction - | _ -> None) - ~inj:(fun delayed_transaction -> - New_delayed_transaction delayed_transaction); - ] -end diff --git a/etherlink/bin_node/lib_prod/encodings/plugin.ml b/etherlink/bin_node/lib_prod/encodings/plugin.ml deleted file mode 100644 index 8b671081c0ae9fae216d4b968ce992933f76a7dd..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/encodings/plugin.ml +++ /dev/null @@ -1,16 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs, *) -(* *) -(*****************************************************************************) - -let block_to_string bytes = - let decoded = Ethereum_types.block_from_rlp bytes in - Data_encoding.Json.( - construct Ethereum_types.block_encoding decoded |> to_string) - -let () = - Octez_smart_rollup_wasm_debugger_plugin.Encodings.register - "evm.block" - block_to_string diff --git a/etherlink/bin_node/lib_prod/encodings/rlp.ml b/etherlink/bin_node/lib_prod/encodings/rlp.ml deleted file mode 100644 index 02dda42d831653c99d54a2b7c213f0fafa1f4339..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/encodings/rlp.ml +++ /dev/null @@ -1,270 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 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. *) -(* *) -(*****************************************************************************) - -type error += Rlp_decoding_error of string - -let () = - register_error_kind - ~id:"evm-node.prod.rlp-decoding-error" - ~title:"Unable to decode an RLP value" - ~description:"Unable to decode an RLP value" - ~pp:(fun ppf msg -> - Format.fprintf ppf "Unable to decode an RLP value: `%s`" msg) - `Permanent - Data_encoding.(obj1 (req "msg" string)) - (function Rlp_decoding_error msg -> Some msg | _ -> None) - (fun msg -> Rlp_decoding_error msg) - -type item = Value of bytes | List of item list - -let rec encode_int buffer i = - if i > 0 then ( - encode_int buffer (i lsr 8) ; - Buffer.add_char buffer (Char.chr (i land 0xff))) - -let rec encode_z buffer i = - let open Z in - if i > zero then ( - encode_z buffer (shift_right i 8) ; - let byte = logand i (of_int 0xff) |> to_int in - Buffer.add_char buffer (Char.chr byte)) - -let encode_value buffer bytes = - let len = Bytes.length bytes in - if len = 1 && Char.code (Bytes.get bytes 0) < 128 then - Buffer.add_char buffer (Bytes.get bytes 0) - else if len < 56 then ( - Buffer.add_char buffer (Char.chr (len + 0x80)) ; - Buffer.add_bytes buffer bytes) - else - let len_buf = Buffer.create 0 in - let () = encode_int len_buf len in - let prefix = 0xb7 + Buffer.length len_buf in - Buffer.add_char buffer (Char.chr prefix) ; - Buffer.add_buffer buffer len_buf ; - Buffer.add_bytes buffer bytes - -let rec encode_list buffer list = - let list_buffer = Buffer.create 0 in - List.iter (encode list_buffer) list ; - let len = Buffer.length list_buffer in - if len < 56 then ( - Buffer.add_char buffer (Char.chr (0xc0 + len)) ; - Buffer.add_buffer buffer list_buffer) - else - let len_buf = Buffer.create 0 in - let () = encode_int len_buf len in - let prefix = 0xf7 + Buffer.length len_buf in - Buffer.add_char buffer (Char.chr prefix) ; - Buffer.add_buffer buffer len_buf ; - Buffer.add_buffer buffer list_buffer - -and encode buffer = function - | Value b -> encode_value buffer b - | List l -> encode_list buffer l - -let encode_int i = - let buffer = Buffer.create 0 in - encode_int buffer i ; - Buffer.to_bytes buffer - -let encode_z i = - let buffer = Buffer.create 0 in - encode_z buffer i ; - Buffer.to_bytes buffer - -let encode item = - let buffer = Buffer.create 0 in - encode buffer item ; - Buffer.to_bytes buffer - -let decode_int bytes offset len = - let open Result_syntax in - let rec decode acc i = - if i >= len then acc - else - let byte = Bytes.get_uint8 bytes (offset + i) in - decode ((acc lsl 8) + byte) (i + 1) - in - (* Checks the length is not negative and the encoded integer does not starts - with leading zeros *) - if len < 0 then tzfail (Rlp_decoding_error "decode_int") - else if len > 0 && Bytes.get_uint8 bytes offset = 0 then - tzfail (Rlp_decoding_error "decode_int") - else return (decode 0 0) - -let decode_z bytes offset len = - let open Result_syntax in - let rec decode acc i = - if i >= len then acc - else - let byte = Char.code (Bytes.get bytes (offset + i)) |> Z.of_int in - decode Z.(shift_left acc 8 + byte) (i + 1) - in - (* Checks the length is not negative and the encoded integer does not starts - with leading zeros *) - if len < 0 then tzfail (Rlp_decoding_error "decode_z") - else if len > 0 && Bytes.get_uint8 bytes offset = 0 then - tzfail (Rlp_decoding_error "decode_z") - else return (decode Z.zero 0) - -(* Check the data/list length cannot actually be encoded in the previous - encoding, with the length encoding in the prefix. If that's the case, this - implies the encoding should have been smaller. *) -let check_length (lower_bound, upper_bound) len = - let open Result_syntax in - if len <= upper_bound - lower_bound then - tzfail (Rlp_decoding_error "check_length") - else return_unit - -(* If the value is a single byte whose value is less or equal than 0x7f, this - means it could have been encoded as a single byte. *) -let check_byte bytes = - let open Result_syntax in - if Bytes.length bytes = 1 then - if Char.code (Bytes.get bytes 0) < 128 then - tzfail (Rlp_decoding_error "check_byte") - else return_unit - else return_unit - -(* Bytes.sub, but returns an error. *) -let sub_bytes bytes offset length = - let open Result_syntax in - if Bytes.length bytes < offset + length then - tzfail (Rlp_decoding_error "Bytes.sub") - else return (Bytes.sub bytes offset length) - -let decode_value bytes ~prefix ~offset = - let open Result_syntax in - if prefix <= 0x7f then return (Value (Bytes.make 1 (Char.chr prefix)), offset) - (* Value of size < 56 case *) - else if prefix <= 0xb7 then - let length = prefix - 0x80 in - let* value = sub_bytes bytes offset length in - let* () = check_byte value in - return (Value value, offset + length) (* Rest of the value case *) - else if prefix <= 0xbf then - let string_length = prefix - 0xb7 in - let* length = decode_int bytes offset string_length in - let* () = check_length (0x80, 0xb7) length in - let value_offset = offset + string_length in - let* value = sub_bytes bytes value_offset length in - return (Value value, value_offset + length) - else tzfail (Rlp_decoding_error "decode_value") - -let rec decode bytes offset = - let open Result_syntax in - let* () = - if Bytes.length bytes <= offset || bytes = Bytes.empty then - tzfail (Rlp_decoding_error "decode") - else return_unit - in - let prefix = Char.code (Bytes.get bytes offset) in - if prefix <= 0xbf then decode_value bytes ~prefix ~offset:(offset + 1) - else decode_list bytes ~prefix ~offset:(offset + 1) - -and decode_list str ~prefix ~offset = - let open Result_syntax in - let rec decode_items acc offset closing_offset = - if offset = closing_offset then return (List (List.rev acc), offset) - else if offset > closing_offset then - tzfail (Rlp_decoding_error "decode_list") - else - let* item, next_offset = decode str offset in - decode_items (item :: acc) next_offset closing_offset - in - if prefix <= 0xf7 then - let length = prefix - 0xc0 in - decode_items [] offset (offset + length) - else - let list_length = prefix - 0xf7 in - let* length = decode_int str offset list_length in - let* () = check_length (0xc0, 0xf7) length in - let list_offset = offset + list_length in - decode_items [] list_offset (list_offset + length) - -let decode_int bytes = decode_int bytes 0 (Bytes.length bytes) - -let decode_z bytes = decode_z bytes 0 (Bytes.length bytes) - -let decode str = decode str 0 |> Result.map fst - -let decode_exn str = - match decode str with - | Ok v -> v - | Error _ -> raise (Invalid_argument "Decode failed") - -let rec pp ppf = function - | Value data -> Hex.pp ppf (Hex.of_bytes data) - | List items -> - Format.fprintf - ppf - "List [%a]" - (Format.pp_print_list - ~pp_sep:(fun ppf () -> Format.fprintf ppf "; ") - pp) - items - -(* Implements optional types decoding as in the RLP library from the - kernel's library. *) -let decode_option decode_value = - let open Result_syntax in - function - | List [] -> return_none - | List [v] -> - let* value = decode_value v in - return_some value - | _ -> tzfail (Rlp_decoding_error "Inconsistent encoding for optional type") - -let decode_result decode_value decode_error = - let open Result_syntax in - function - | List [Value tag; payload] -> ( - let* () = - if Bytes.length tag <> 1 then - tzfail - (Rlp_decoding_error - (Format.sprintf "Inconsistent tag size: %d" (Bytes.length tag))) - else return_unit - in - let tag = Bytes.get_uint8 tag 0 in - match tag with - | 1 -> - let* ok = decode_value payload in - return @@ Ok ok - | 2 -> - let* err = decode_error payload in - return @@ Error err - | t -> - tzfail - (Rlp_decoding_error - (Format.sprintf "Inconsistent tag [%d] for the result type" t))) - | rlp -> - tzfail - (Rlp_decoding_error - (Format.asprintf - "Inconsistent encoding for the result type: %a" - pp - rlp)) diff --git a/etherlink/bin_node/lib_prod/encodings/rlp.mli b/etherlink/bin_node/lib_prod/encodings/rlp.mli deleted file mode 100644 index c93f7522b2546d1e51419d65e94778cf07d0246f..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/encodings/rlp.mli +++ /dev/null @@ -1,75 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 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. *) -(* *) -(*****************************************************************************) - -(** A simple RLP encoding library, see - https://ethereum.org/en/developers/docs/data-structures-and-encoding/rlp/ - for the specification. *) - -type error += Rlp_decoding_error of string - -(** An RLP value is either a bytes value, or a list of RLP values. *) -type item = Value of bytes | List of item list - -(** [encode_int i] encodes an integer in big endian in its smallest representation. *) -val encode_int : int -> bytes - -(** [encode_z z] encodes a big integer in big endian in its smallest - representation. *) -val encode_z : Z.t -> bytes - -(** [encode item] takes an RLP [item] and returns its encoded form. *) -val encode : item -> bytes - -(** [decode_int bytes] decodes an integer encoded in big endian from the given - [bytes]. Returns an {!Rlp_decoding_error} if the bytes is not a valid RLP encoded - integer. *) -val decode_int : bytes -> int tzresult - -(** [decode_z bytes] decodes a big integer encoded in big endian from the given - [bytes]. Returns an {!Rlp_decoding_error} if the bytes is not a valid RLP encoded - big integer. *) -val decode_z : bytes -> Z.t tzresult - -(** [decode bytes] decodes an RLP value from the given [bytes]. Returns an - {!Rlp_decoding_error} if the bytes is not an RLP encoded value. *) -val decode : bytes -> item tzresult - -(** [decode_exn bytes] calls {!decode} and raises [Invalid_argument] if it - fails to decode. *) -val decode_exn : bytes -> item - -(** [decode_option decode_value optional_value] decodes the option following - Rust's RLP encoding. *) -val decode_option : (item -> 'a tzresult) -> item -> 'a option tzresult - -(** [decode_result decode_ok decode_error value] decodes an encoded result type. *) -val decode_result : - (item -> 'a tzresult) -> - (item -> 'b tzresult) -> - item -> - ('a, 'b) result tzresult - -(** [pp ppf item] pretty-prints an item. *) -val pp : Format.formatter -> item -> unit diff --git a/etherlink/bin_node/lib_prod/ethbloom.ml b/etherlink/bin_node/lib_prod/ethbloom.ml deleted file mode 100644 index 7cbca1ac2deb82070489073bbd8935f12419b631..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/ethbloom.ml +++ /dev/null @@ -1,53 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs, *) -(* *) -(*****************************************************************************) - -open Ethereum_types - -let keccak256 (Hex s) = - let bytes = Hex.to_bytes_exn (`Hex s) in - Tezos_crypto.Hacl.Hash.Keccak_256.digest bytes - -module Bits = struct - (* Sets to 1 the [position] in [bytes] *) - let set (bytes : bytes) position = - let byte_index = Int.div position 8 in - let bit_value = 1 lsl (7 - Int.rem position 8) in - let original_byte = Bytes.get_uint8 bytes byte_index in - let modified_byte = original_byte lor bit_value in - Bytes.set_uint8 bytes byte_index modified_byte - - let get (bytes : bytes) position = - let byte_index = Int.div position 8 in - let original_byte = Bytes.get_uint8 bytes byte_index in - original_byte land (1 lsl (7 - Int.rem position 8)) != 0 -end - -let positions input = - let hash = keccak256 input in - let pos_for_idx idx = - let hash_bytes = Bytes.sub hash idx 2 in - let bit_to_set = Int.logand (Bytes.get_uint16_be hash_bytes 0) 0x07FF in - 0x07FF - bit_to_set - in - List.map pos_for_idx [0; 2; 4] - -type t = bytes - -let make () = Bytes.make 256 '\000' - -let is_empty = Bytes.equal (make ()) - -let contains_input ~input filter = - List.for_all (Bits.get filter) (positions input) - -let contains_bloom f1 f2 = Bytes.(equal (logor f1 f2) f1) - -let accrue ~input filter = List.iter (Bits.set filter) (positions input) - -let accrue_bloom f1 f2 = - let union = Bytes.logor f1 f2 in - Bytes.blit union 0 f1 0 (Bytes.length union) diff --git a/etherlink/bin_node/lib_prod/ethbloom.mli b/etherlink/bin_node/lib_prod/ethbloom.mli deleted file mode 100644 index 6e6e322e0d3cbc4374c4b9bedc690dcd438efb3b..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/ethbloom.mli +++ /dev/null @@ -1,37 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs, *) -(* *) -(*****************************************************************************) - -open Ethereum_types - -(** Ethereum Bloom filters. - See Ethereum yellow paper, section 4.3.1 for reference. *) - -(** Type of Bloom filters, represented as a 256-byte string. - Note that values of this type are mutable. *) -type t = bytes - -(** [make ()] returns a new empty filter. *) -val make : unit -> t - -(** [is_empty filter] returns whether the [filter] is empty. *) -val is_empty : t -> bool - -(** [contains_input ~input filter] returns whether the - [filter] contains [input]. *) -val contains_input : input:hex -> t -> bool - -(** [contains_bloom filter1 filter2] returns whether - [filter1] contains [filter2]. *) -val contains_bloom : t -> t -> bool - -(** [accrue ~input filter] extends [filter] by adding - [input]. *) -val accrue : input:hex -> t -> unit - -(** [accrue_bloom filter1 filter2] extends [filter1] by adding - all of the elements from [filter2]. *) -val accrue_bloom : t -> t -> unit diff --git a/etherlink/bin_node/lib_prod/events.ml b/etherlink/bin_node/lib_prod/events.ml deleted file mode 100644 index e7f35bc5c9595b3edea191d58ffa0f9568795b89..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/events.ml +++ /dev/null @@ -1,195 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -include Internal_event.Simple - -let section = ["evm_node"; "prod"] - -let received_upgrade = - declare_1 - ~section - ~name:"received_upgrade" - ~msg:"Received an upgrade payload: {payload}" - ~level:Notice - ("payload", Data_encoding.string) - -let pending_upgrade = - declare_2 - ~section - ~name:"pending_upgrade" - ~msg: - "Pending upgrade to root hash {root_hash} expected to activate at \ - {timestamp}" - ~level:Notice - ("root_hash", Ethereum_types.hash_encoding) - ("timestamp", Time.Protocol.encoding) - -let applied_upgrade = - declare_2 - ~section - ~name:"applied_upgrade" - ~msg:"Kernel successfully upgraded to {root_hash} with blueprint {level}" - ~level:Notice - ("root_hash", Ethereum_types.hash_encoding) - ("level", Data_encoding.n) - -let failed_upgrade = - declare_2 - ~section - ~name:"failed_upgrade" - ~msg:"Kernel failed to upgrade to {root_hash} with blueprint {level}" - ~level:Warning - ("root_hash", Ethereum_types.hash_encoding) - ("level", Data_encoding.n) - -let ignored_kernel_arg = - declare_0 - ~section - ~name:"ignored_kernel_arg" - ~msg: - "Ignored the kernel command-line argument since the EVM state was \ - already initialized" - ~level:Warning - () - -let catching_up_evm_event = - Internal_event.Simple.declare_2 - ~section - ~name:"catching_up" - ~msg:"the EVM node is catching up on evm event from {from} to {to}" - ~level:Notice - ("from", Data_encoding.int32) - ("to", Data_encoding.int32) - -let event_is_ready = - Internal_event.Simple.declare_2 - ~section - ~name:"is_ready" - ~msg:"the EVM node is listening to {addr}:{port}" - ~level:Notice - ("addr", Data_encoding.string) - ("port", Data_encoding.uint16) - -let event_private_server_is_ready = - declare_2 - ~section - ~name:"private_server_is_ready" - ~msg:"the EVM node private RPC server is listening to {addr}:{port}" - ~level:Notice - ("addr", Data_encoding.string) - ("port", Data_encoding.uint16) - -let event_shutdown_node = - Internal_event.Simple.declare_1 - ~section - ~name:"shutting_down" - ~msg:"Stopping the EVM node with {exit_status}" - ~level:Notice - ("exit_status", Data_encoding.int8) - -let event_shutdown_rpc_server ~private_ = - let server = if private_ then "private" else "public" in - Internal_event.Simple.declare_0 - ~section - ~name:("shutting_down_" ^ server ^ "_rpc_server") - ~msg:("Stopping the" ^ server ^ " RPC server") - ~level:Notice - () - -let event_callback_log = - Internal_event.Simple.declare_3 - ~section - ~name:"callback_log" - ~msg:"Uri: {uri}\nMethod: {method}\nBody: {body}\n" - ~level:Debug - ("uri", Data_encoding.string) - ("method", Data_encoding.string) - ("body", Data_encoding.string) - -let event_retrying_connect = - Internal_event.Simple.declare_2 - ~section - ~name:"retrying_connect" - ~msg:"Cannot connect to {endpoint}, retrying in {delay} seconds." - ~level:Notice - ("endpoint", Data_encoding.string) - ("delay", Data_encoding.float) - -type kernel_log_kind = Application | Simulation - -type kernel_log_level = Debug | Info | Error | Fatal - -let kernel_log_kind_to_string = function - | Application -> "application" - | Simulation -> "simulation" - -let event_kernel_log kind level = - Internal_event.Simple.declare_1 - ~section:(section @ ["kernel"; kernel_log_kind_to_string kind]) - ~name: - (Format.sprintf "kernel_log_%s" (Internal_event.Level.to_string level)) - ~msg:"{msg}" - ~pp1:(fun fmt msg -> Format.pp_print_string fmt (String.trim msg)) - ~level - ("msg", Data_encoding.string) - -let event_kernel_log_application_debug = event_kernel_log Application Debug - -let event_kernel_log_simulation_debug = event_kernel_log Simulation Debug - -let event_kernel_log_application_info = event_kernel_log Application Notice - -let event_kernel_log_simulation_info = event_kernel_log Simulation Info - -let event_kernel_log_application_error = event_kernel_log Application Error - -let event_kernel_log_simulation_error = event_kernel_log Simulation Error - -let event_kernel_log_application_fatal = event_kernel_log Application Fatal - -let event_kernel_log_simulation_fatal = event_kernel_log Simulation Fatal - -let received_upgrade payload = emit received_upgrade payload - -let pending_upgrade (upgrade : Ethereum_types.Upgrade.t) = - emit pending_upgrade (upgrade.hash, upgrade.timestamp) - -let applied_upgrade root_hash Ethereum_types.(Qty level) = - emit applied_upgrade (root_hash, level) - -let failed_upgrade root_hash Ethereum_types.(Qty level) = - emit failed_upgrade (root_hash, level) - -let ignored_kernel_arg () = emit ignored_kernel_arg () - -let catching_up_evm_event ~from ~to_ = emit catching_up_evm_event (from, to_) - -let is_ready ~rpc_addr ~rpc_port = emit event_is_ready (rpc_addr, rpc_port) - -let private_server_is_ready ~rpc_addr ~rpc_port = - emit event_private_server_is_ready (rpc_addr, rpc_port) - -let shutdown_rpc_server ~private_ = - emit (event_shutdown_rpc_server ~private_) () - -let shutdown_node ~exit_status = emit event_shutdown_node exit_status - -let callback_log ~uri ~meth ~body = emit event_callback_log (uri, meth, body) - -let event_kernel_log ~level ~kind ~msg = - match (level, kind) with - | Debug, Application -> emit event_kernel_log_application_debug msg - | Debug, Simulation -> emit event_kernel_log_simulation_debug msg - | Info, Application -> emit event_kernel_log_application_info msg - | Info, Simulation -> emit event_kernel_log_simulation_info msg - | Error, Application -> emit event_kernel_log_application_error msg - | Error, Simulation -> emit event_kernel_log_simulation_error msg - | Fatal, Application -> emit event_kernel_log_application_fatal msg - | Fatal, Simulation -> emit event_kernel_log_simulation_fatal msg - -let retrying_connect ~endpoint ~delay = - emit event_retrying_connect (Uri.to_string endpoint, delay) diff --git a/etherlink/bin_node/lib_prod/events.mli b/etherlink/bin_node/lib_prod/events.mli deleted file mode 100644 index 6e3efad7a31cd17601d7b2e587df33a5c000b514..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/events.mli +++ /dev/null @@ -1,70 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(** General purposes events. *) - -(** Default section for events. *) -val section : string list - -(** [received_upgrade payload] advertises that the sequencer received an - upgrade of payload [payload]. *) -val received_upgrade : string -> unit Lwt.t - -(** [pending_upgrade upgrade] advertises that the EVM node is aware that an - upgrade is pending. *) -val pending_upgrade : Ethereum_types.Upgrade.t -> unit Lwt.t - -(** [applied_upgrade root_hash level] advertises that the kernel of the EVM - node successfully upgraded to [root_hash] with the [level]th blueprint. *) -val applied_upgrade : - Ethereum_types.hash -> Ethereum_types.quantity -> unit Lwt.t - -(** [failed_upgrade root_hash level] advertises that the kernel of the EVM - node failed to upgrade to [root_hash] with the [level]th blueprint. *) -val failed_upgrade : - Ethereum_types.hash -> Ethereum_types.quantity -> unit Lwt.t - -(** [ignored_kernel_arg ()] advertises that the EVM node has ignored - the path to the initial kernel given as a command-line argument - since its EVM state was already initialized. *) -val ignored_kernel_arg : unit -> unit Lwt.t - -(** [catching_up_evm_event ~from ~to_] advertises that the sequencer - is catching up on event produced by the evm kernel in the rollup - node from L1 level [from] to [to_]. *) -val catching_up_evm_event : from:int32 -> to_:int32 -> unit Lwt.t - -(** [is_ready ~rpc_addr ~rpc_port] advertises that the sequencer is - ready and listens to [rpc_addr]:[rpc_port]. *) -val is_ready : rpc_addr:string -> rpc_port:int -> unit Lwt.t - -(** [private_server_is_ready ~rpc_addr ~rpc_port] advertises that the - private rpc server is ready and listens to [rpc_addr]:[rpc_port]. *) -val private_server_is_ready : rpc_addr:string -> rpc_port:int -> unit Lwt.t - -(** [shutdown_rpc_server ~private_ ()] advertises that the RPC server - was shut down, [private_] tells whether it is the private server - or not. *) -val shutdown_rpc_server : private_:bool -> unit Lwt.t - -(** [shutdown_node ~exit_status] advertises that the sequencer was - shutdown, and exits with [exit_status]. *) -val shutdown_node : exit_status:int -> unit Lwt.t - -(** [callback_log ~uri ~meth ~body] is used as the debug event used as - callback for resto to logs the requests. *) -val callback_log : uri:string -> meth:string -> body:string -> unit Lwt.t - -type kernel_log_kind = Application | Simulation - -type kernel_log_level = Debug | Info | Error | Fatal - -(** Logs kernel log [Debug]. *) -val event_kernel_log : - level:kernel_log_level -> kind:kernel_log_kind -> msg:string -> unit Lwt.t - -val retrying_connect : endpoint:Uri.t -> delay:float -> unit Lwt.t diff --git a/etherlink/bin_node/lib_prod/evm_context.ml b/etherlink/bin_node/lib_prod/evm_context.ml deleted file mode 100644 index 9ca1df595126654f8e7dbfe34010248dd267472c..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_context.ml +++ /dev/null @@ -1,1116 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type init_status = Loaded | Created - -type head = { - current_block_hash : Ethereum_types.block_hash; - next_blueprint_number : Ethereum_types.quantity; - evm_state : Evm_state.t; -} - -type parameters = { - kernel_path : string option; - data_dir : string; - preimages : string; - preimages_endpoint : Uri.t option; - smart_rollup_address : string; - fail_on_missing_blueprint : bool; -} - -type session_state = { - mutable context : Irmin_context.rw; - mutable next_blueprint_number : Ethereum_types.quantity; - mutable current_block_hash : Ethereum_types.block_hash; - mutable pending_upgrade : Ethereum_types.Upgrade.t option; - mutable evm_state : Evm_state.t; -} - -type t = { - data_dir : string; - index : Irmin_context.rw_index; - preimages : string; - preimages_endpoint : Uri.t option; - smart_rollup_address : Tezos_crypto.Hashed.Smart_rollup_address.t; - store : Evm_store.t; - session : session_state; - fail_on_missing_blueprint : bool; -} - -let blueprint_watcher : Blueprint_types.with_events Lwt_watcher.input = - Lwt_watcher.create_input () - -let session_to_head_info session = - { - evm_state = session.evm_state; - next_blueprint_number = session.next_blueprint_number; - current_block_hash = session.current_block_hash; - } - -module Types = struct - type state = t - - type nonrec parameters = parameters -end - -module Name = struct - type t = unit - - let encoding = Data_encoding.unit - - let base = Evm_context_events.section @ ["worker"] - - let pp _fmt () = () - - let equal () () = true -end - -module Request = struct - type (_, _) t = - | Apply_evm_events : { - finalized_level : int32 option; - events : Ethereum_types.Evm_events.t list; - } - -> (unit, tztrace) t - | Apply_blueprint : { - timestamp : Time.Protocol.t; - payload : Blueprint_types.payload; - delayed_transactions : Ethereum_types.hash list; - } - -> (unit, tztrace) t - | Last_produce_blueprint : (Blueprint_types.t, tztrace) t - | Blueprint : { - level : Ethereum_types.quantity; - } - -> (Blueprint_types.with_events option, tztrace) t - | Blueprints_range : { - from : Ethereum_types.quantity; - to_ : Ethereum_types.quantity; - } - -> ((Ethereum_types.quantity * Blueprint_types.payload) list, tztrace) t - | Last_known_L1_level : (int32 option, tztrace) t - | New_last_known_L1_level : int32 -> (unit, tztrace) t - | Delayed_inbox_hashes : (Ethereum_types.hash list, tztrace) t - | Evm_state_after : { - number : Ethereum_types.quantity; - } - -> (Evm_state.t option, tztrace) t - - type view = View : _ t -> view - - let view req = View req - - let encoding = - let open Data_encoding in - union - [ - case - (Tag 0) - ~title:"Apply_evm_events" - (obj3 - (req "request" (constant "apply_evm_events")) - (opt "finalized_level" int32) - (req "events" (list Ethereum_types.Evm_events.encoding))) - (function - | View (Apply_evm_events {finalized_level; events}) -> - Some ((), finalized_level, events) - | _ -> None) - (fun ((), finalized_level, events) -> - View (Apply_evm_events {finalized_level; events})); - case - (Tag 1) - ~title:"Apply_blueprint" - (obj4 - (req "request" (constant "apply_blueprint")) - (req "timestamp" Time.Protocol.encoding) - (req "payload" Blueprint_types.payload_encoding) - (req "delayed_transactions" (list Ethereum_types.hash_encoding))) - (function - | View (Apply_blueprint {timestamp; payload; delayed_transactions}) - -> - Some ((), timestamp, payload, delayed_transactions) - | _ -> None) - (fun ((), timestamp, payload, delayed_transactions) -> - View (Apply_blueprint {timestamp; payload; delayed_transactions})); - case - (Tag 2) - ~title:"Last_produce_blueprint" - (obj1 (req "request" (constant "last_produce_blueprint"))) - (function View Last_produce_blueprint -> Some () | _ -> None) - (fun () -> View Last_produce_blueprint); - case - (Tag 4) - ~title:"Blueprint" - (obj2 - (req "request" (constant "blueprint")) - (req "level" Ethereum_types.quantity_encoding)) - (function View (Blueprint {level}) -> Some ((), level) | _ -> None) - (fun ((), level) -> View (Blueprint {level})); - case - (Tag 5) - ~title:"Blueprints_range" - (obj3 - (req "request" (constant "Blueprints_range")) - (req "from" Ethereum_types.quantity_encoding) - (req "to" Ethereum_types.quantity_encoding)) - (function - | View (Blueprints_range {from; to_}) -> Some ((), from, to_) - | _ -> None) - (fun ((), from, to_) -> View (Blueprints_range {from; to_})); - case - (Tag 6) - ~title:"Last_known_L1_level" - (obj1 (req "request" (constant "last_known_l1_level"))) - (function View Last_known_L1_level -> Some () | _ -> None) - (fun () -> View Last_known_L1_level); - case - (Tag 7) - ~title:"New_last_known_L1_level" - (obj2 - (req "request" (constant "new_last_known_l1_level")) - (req "value" int32)) - (function - | View (New_last_known_L1_level l) -> Some ((), l) | _ -> None) - (fun ((), l) -> View (New_last_known_L1_level l)); - case - (Tag 8) - ~title:"Delayed_inbox_hashes" - (obj1 (req "request" (constant "Delayed_inbox_hashes"))) - (function View Delayed_inbox_hashes -> Some () | _ -> None) - (fun () -> View Delayed_inbox_hashes); - case - (Tag 9) - ~title:"Evm_state_after" - (obj2 - (req "request" (constant "evm_state_after")) - (req "number" Ethereum_types.quantity_encoding)) - (function - | View (Evm_state_after {number}) -> Some ((), number) | _ -> None) - (fun ((), number) -> View (Evm_state_after {number})); - ] - - let pp ppf view = - Data_encoding.Json.pp ppf @@ Data_encoding.Json.construct encoding view -end - -let head_info, head_info_waker = Lwt.task () - -let init_status, init_status_waker = Lwt.task () - -let execution_config, execution_config_waker = Lwt.task () - -module State = struct - let with_store_transaction ctxt k = - Evm_store.with_transaction ctxt.store (fun txn_store -> - k {ctxt with store = txn_store}) - - let store_path ~data_dir = Filename.Infix.(data_dir // "store") - - let load ~data_dir index = - let open Lwt_result_syntax in - let* store = Evm_store.init ~data_dir in - let* latest = Evm_store.Context_hashes.find_latest store in - match latest with - | Some (Qty latest_blueprint_number, checkpoint) -> - let*! context = Irmin_context.checkout_exn index checkpoint in - let*! evm_state = Irmin_context.PVMState.get context in - let+ current_block_hash = Evm_state.current_block_hash evm_state in - ( store, - context, - Ethereum_types.Qty Z.(succ latest_blueprint_number), - current_block_hash, - Loaded ) - | None -> - let context = Irmin_context.empty index in - return - ( store, - context, - Ethereum_types.Qty Z.zero, - Ethereum_types.genesis_parent_hash, - Created ) - - let commit store context evm_state number = - let open Lwt_result_syntax in - let*! context = Irmin_context.PVMState.set context evm_state in - let*! checkpoint = Irmin_context.commit context in - let* () = Evm_store.Context_hashes.store store number checkpoint in - return context - - let commit_next_head (ctxt : t) evm_state = - commit - ctxt.store - ctxt.session.context - evm_state - ctxt.session.next_blueprint_number - - let replace_current_commit (ctxt : t) evm_state = - let (Qty next) = ctxt.session.next_blueprint_number in - commit ctxt.store ctxt.session.context evm_state (Qty Z.(pred next)) - - let on_modified_head ctxt evm_state context = - ctxt.session.evm_state <- evm_state ; - ctxt.session.context <- context - - let apply_evm_event_unsafe on_success ctxt evm_state event = - let open Lwt_result_syntax in - let open Ethereum_types in - let*! () = Evm_events_follower_events.new_event event in - match event with - | Evm_events.Upgrade_event upgrade -> - let on_success session = - session.pending_upgrade <- Some upgrade ; - on_success session - in - let payload = - Ethereum_types.Upgrade.to_bytes upgrade |> String.of_bytes - in - let*! evm_state = - Evm_state.modify - ~key:Durable_storage_path.kernel_upgrade - ~value:payload - evm_state - in - let* () = - Evm_store.Kernel_upgrades.store - ctxt.store - ctxt.session.next_blueprint_number - upgrade - in - let*! () = Events.pending_upgrade upgrade in - return (evm_state, on_success) - | Sequencer_upgrade_event sequencer_upgrade -> - let payload = - Sequencer_upgrade.to_bytes sequencer_upgrade |> String.of_bytes - in - let*! evm_state = - Evm_state.modify - ~key:Durable_storage_path.sequencer_upgrade - ~value:payload - evm_state - in - return (evm_state, on_success) - | Blueprint_applied {number = Qty number; hash = expected_block_hash} -> ( - Metrics.set_confirmed_level ~level:number ; - let* block_hash_opt = - let*! bytes = - Evm_state.inspect - evm_state - (Durable_storage_path.Indexes.block_by_number (Nth number)) - in - return (Option.map decode_block_hash bytes) - in - match block_hash_opt with - | Some found_block_hash -> - if found_block_hash = expected_block_hash then - let*! () = - Evm_events_follower_events.upstream_blueprint_applied - (number, expected_block_hash) - in - return (evm_state, on_success) - else - let*! () = - Evm_events_follower_events.diverged - (number, expected_block_hash, found_block_hash) - in - tzfail - (Node_error.Diverged - (number, expected_block_hash, Some found_block_hash)) - | None when ctxt.fail_on_missing_blueprint -> - let*! () = - Evm_events_follower_events.missing_blueprint - (number, expected_block_hash) - in - tzfail (Node_error.Diverged (number, expected_block_hash, None)) - | None -> - let*! () = - Evm_events_follower_events.rollup_node_ahead (Qty number) - in - return (evm_state, on_success)) - | New_delayed_transaction delayed_transaction -> - let*! data_dir, config = execution_config in - let* evm_state = - Evm_state.execute - ~data_dir - ~config - evm_state - [ - `Input - ("\254" - ^ Bytes.to_string - (Delayed_transaction.to_rlp delayed_transaction)); - ] - in - let* () = - Evm_store.Delayed_transactions.store - ctxt.store - ctxt.session.next_blueprint_number - delayed_transaction - in - return (evm_state, on_success) - - let current_blueprint_number ctxt = - let (Qty next_blueprint_number) = ctxt.session.next_blueprint_number in - Ethereum_types.Qty (Z.pred next_blueprint_number) - - let apply_evm_events ?finalized_level (ctxt : t) events = - let open Lwt_result_syntax in - let* context, evm_state, on_success = - with_store_transaction ctxt @@ fun ctxt -> - let* on_success, ctxt, evm_state = - List.fold_left_es - (fun (on_success, ctxt, evm_state) event -> - let* evm_state, on_success = - apply_evm_event_unsafe on_success ctxt evm_state event - in - return (on_success, ctxt, evm_state)) - (ignore, ctxt, ctxt.session.evm_state) - events - in - let* _ = - Option.map_es - (fun l1_level -> - let l2_level = current_blueprint_number ctxt in - Evm_store.L1_latest_known_level.store ctxt.store l2_level l1_level) - finalized_level - in - let* ctxt = replace_current_commit ctxt evm_state in - return (ctxt, evm_state, on_success) - in - on_modified_head ctxt evm_state context ; - on_success ctxt.session ; - return_unit - - type error += Cannot_apply_blueprint of {local_state_level : Z.t} - - let () = - register_error_kind - `Permanent - ~id:"evm_node_prod_cannot_apply_blueprint" - ~title:"Cannot apply a blueprint" - ~description: - "The EVM node could not apply a blueprint on top of its local EVM \ - state." - ~pp:(fun ppf local_state_level -> - Format.fprintf - ppf - "The EVM node could not apply a blueprint on top of its local EVM \ - state at level %a." - Z.pp_print - local_state_level) - Data_encoding.(obj1 (req "current_state_level" n)) - (function - | Cannot_apply_blueprint {local_state_level} -> Some local_state_level - | _ -> None) - (fun local_state_level -> Cannot_apply_blueprint {local_state_level}) - - let check_pending_upgrade ctxt timestamp = - match ctxt.session.pending_upgrade with - | None -> None - | Some upgrade -> - if Time.Protocol.(upgrade.timestamp <= timestamp) then Some upgrade.hash - else None - - let check_upgrade ctxt evm_state = - let open Lwt_result_syntax in - function - | Some root_hash -> - let* () = - Evm_store.Kernel_upgrades.record_apply - ctxt.store - ctxt.session.next_blueprint_number - in - - let*! bytes = - Evm_state.inspect evm_state Durable_storage_path.kernel_root_hash - in - let new_hash_candidate = - Option.map - (fun bytes -> - let (`Hex hex) = Hex.of_bytes bytes in - Ethereum_types.hash_of_string hex) - bytes - in - - let*! () = - match new_hash_candidate with - | Some current_root_hash when root_hash = current_root_hash -> - Events.applied_upgrade - root_hash - ctxt.session.next_blueprint_number - | _ -> - Events.failed_upgrade root_hash ctxt.session.next_blueprint_number - in - - return_true - | None -> return_false - - (** [apply_blueprint_store_unsafe ctxt payload delayed_transactions] applies - the blueprint [payload] on the head of [ctxt], and commit the resulting - state to Irmin and the node’s store. - - However, it does not modifies [ctxt] to make it aware of the new state. - This is because [apply_blueprint_store_unsafe] is expected to be called - within a SQL transaction to make sure the node’s store is not left in an - inconsistent state in case of error. *) - let apply_blueprint_store_unsafe ctxt timestamp payload delayed_transactions = - let open Lwt_result_syntax in - Evm_store.assert_in_transaction ctxt.store ; - let*! data_dir, config = execution_config in - let (Qty next) = ctxt.session.next_blueprint_number in - - let* try_apply = - Evm_state.apply_blueprint ~data_dir ~config ctxt.session.evm_state payload - in - - match try_apply with - | Apply_success (evm_state, Qty blueprint_number, current_block_hash) - when Z.equal blueprint_number next -> - let* () = - Evm_store.Blueprints.store - ctxt.store - {number = Qty blueprint_number; timestamp; payload} - in - - let root_hash_candidate = check_pending_upgrade ctxt timestamp in - let* applied_upgrade = - check_upgrade ctxt evm_state root_hash_candidate - in - - let* delayed_transactions = - List.map_es - (fun hash -> - let* delayed_transaction = - Evm_store.Delayed_transactions.at_hash ctxt.store hash - in - match delayed_transaction with - | None -> - failwith - "Delayed transaction %a is missing from store" - Ethereum_types.pp_hash - hash - | Some delayed_transaction -> return delayed_transaction) - delayed_transactions - in - let* context = commit_next_head ctxt evm_state in - return - ( evm_state, - context, - current_block_hash, - applied_upgrade, - delayed_transactions ) - | Apply_success _ (* Produced a block, but not of the expected height *) - | Apply_failure (* Did not produce a block *) -> - let*! () = Blueprint_events.invalid_blueprint_produced next in - tzfail (Cannot_apply_blueprint {local_state_level = Z.pred next}) - - let on_new_head ctxt ~applied_upgrade evm_state context block_hash - blueprint_with_events = - let open Lwt_syntax in - let (Qty level) = ctxt.session.next_blueprint_number in - ctxt.session.evm_state <- evm_state ; - ctxt.session.context <- context ; - ctxt.session.next_blueprint_number <- Qty (Z.succ level) ; - ctxt.session.current_block_hash <- block_hash ; - Lwt_watcher.notify blueprint_watcher blueprint_with_events ; - if applied_upgrade then ctxt.session.pending_upgrade <- None ; - let* head_info in - head_info := session_to_head_info ctxt.session ; - Metrics.set_level ~level ; - Blueprint_events.blueprint_applied (level, block_hash) - - let apply_blueprint ctxt timestamp payload delayed_transactions = - let open Lwt_result_syntax in - let* ( evm_state, - context, - current_block_hash, - applied_upgrade, - delayed_transactions ) = - with_store_transaction ctxt @@ fun ctxt -> - apply_blueprint_store_unsafe ctxt timestamp payload delayed_transactions - in - let*! () = - on_new_head - ctxt - ~applied_upgrade - evm_state - context - current_block_hash - { - delayed_transactions; - blueprint = - {number = ctxt.session.next_blueprint_number; timestamp; payload}; - } - in - return_unit - - let init ?kernel_path ~fail_on_missing_blueprint ~data_dir ~preimages - ~preimages_endpoint ~smart_rollup_address () = - let open Lwt_result_syntax in - let*! () = - Lwt_utils_unix.create_dir (Evm_state.kernel_logs_directory ~data_dir) - in - let*! () = Lwt_utils_unix.create_dir preimages in - let* index = - Irmin_context.load ~cache_size:100_000 Read_write (store_path ~data_dir) - in - let destination = - Tezos_crypto.Hashed.Smart_rollup_address.of_string_exn - smart_rollup_address - in - let* store, context, next_blueprint_number, current_block_hash, init_status - = - load ~data_dir index - in - let* pending_upgrade = - Evm_store.Kernel_upgrades.find_latest_pending store - in - - let* evm_state, context = - match kernel_path with - | Some kernel -> - if init_status = Loaded then - let*! () = Events.ignored_kernel_arg () in - let*! evm_state = Irmin_context.PVMState.get context in - return (evm_state, context) - else - let* evm_state = Evm_state.init ~kernel in - let (Qty next) = next_blueprint_number in - let* context = commit store context evm_state (Qty Z.(pred next)) in - return (evm_state, context) - | None -> - if init_status = Loaded then - let*! evm_state = Irmin_context.PVMState.get context in - return (evm_state, context) - else - failwith - "Cannot compute the initial EVM state without the path to the \ - initial kernel" - in - - let ctxt = - { - index; - data_dir; - preimages; - preimages_endpoint; - smart_rollup_address = destination; - session = - { - context; - next_blueprint_number; - current_block_hash; - pending_upgrade; - evm_state; - }; - store; - fail_on_missing_blueprint; - } - in - - let*! () = - Option.iter_s - (fun upgrade -> Events.pending_upgrade upgrade) - pending_upgrade - in - - return (ctxt, init_status) - - let reset ~data_dir ~l2_level = - let open Lwt_result_syntax in - let* store = Evm_store.init ~data_dir in - Evm_store.with_transaction store @@ fun store -> - Evm_store.reset store ~l2_level - - let last_produced_blueprint (ctxt : t) = - let open Lwt_result_syntax in - let (Qty next) = ctxt.session.next_blueprint_number in - let current = Ethereum_types.Qty Z.(pred next) in - let* blueprint = Evm_store.Blueprints.find ctxt.store current in - match blueprint with - | Some blueprint -> return blueprint - | None -> failwith "Could not fetch the last produced blueprint" - - let delayed_inbox_hashes evm_state = - let open Lwt_syntax in - let* keys = - Evm_state.subkeys - evm_state - Durable_storage_path.Delayed_transaction.hashes - in - let hashes = - (* Remove the empty, meta keys *) - List.filter_map - (fun key -> - if key = "" || key = "meta" then None - else Some (Ethereum_types.hash_of_string key)) - keys - in - return hashes - - let delayed_inbox_item evm_state hash = - let open Lwt_result_syntax in - let*! bytes = - Evm_state.inspect - evm_state - (Durable_storage_path.Delayed_transaction.transaction hash) - in - let*? bytes = - Option.to_result ~none:[error_of_fmt "missing delayed inbox item "] bytes - in - let*? rlp_item = Rlp.decode bytes in - match rlp_item with - | Rlp.(List (rlp_item :: _)) -> - let*? res = - Option.to_result - ~none:[error_of_fmt "cannot parse delayed inbox item "] - @@ Ethereum_types.Delayed_transaction.of_rlp_content - ~transaction_tag:"\x01" - hash - rlp_item - in - return res - | _ -> failwith "invalid delayed inbox item" - - let blueprint_with_events ctxt level = - let open Lwt_result_syntax in - let* blueprint = Evm_store.Blueprints.find ctxt.store level in - match blueprint with - | None -> return None - | Some blueprint -> - let* delayed_transactions = - Evm_store.Delayed_transactions.at_level ctxt.store level - in - return_some Blueprint_types.{delayed_transactions; blueprint} -end - -module Worker = Worker.MakeSingle (Name) (Request) (Types) - -type worker = Worker.infinite Worker.queue Worker.t - -module Handlers = struct - open Request - - type self = worker - - type launch_error = tztrace - - let on_launch _self () - { - kernel_path : string option; - data_dir : string; - preimages : string; - preimages_endpoint : Uri.t option; - smart_rollup_address : string; - fail_on_missing_blueprint; - } = - let open Lwt_result_syntax in - let* ctxt, status = - State.init - ?kernel_path - ~data_dir - ~preimages - ~preimages_endpoint - ~smart_rollup_address - ~fail_on_missing_blueprint - () - in - Lwt.wakeup execution_config_waker - @@ ( ctxt.data_dir, - Config.config - ~preimage_directory:ctxt.preimages - ?preimage_endpoint:ctxt.preimages_endpoint - ~kernel_debug:true - ~destination:ctxt.smart_rollup_address - () ) ; - Lwt.wakeup init_status_waker status ; - let first_head = ref (session_to_head_info ctxt.session) in - Lwt.wakeup head_info_waker first_head ; - return ctxt - - let on_request : - type r request_error. - self -> (r, request_error) Request.t -> (r, request_error) result Lwt.t = - fun self request -> - let open Lwt_result_syntax in - match request with - | Apply_evm_events {finalized_level; events} -> - let ctxt = Worker.state self in - State.apply_evm_events ?finalized_level ctxt events - | Apply_blueprint {timestamp; payload; delayed_transactions} -> - let ctxt = Worker.state self in - State.apply_blueprint ctxt timestamp payload delayed_transactions - | Last_produce_blueprint -> - let ctxt = Worker.state self in - State.last_produced_blueprint ctxt - | Blueprint {level} -> - let ctxt = Worker.state self in - State.blueprint_with_events ctxt level - | Blueprints_range {from; to_} -> - let ctxt = Worker.state self in - Evm_store.Blueprints.find_range ctxt.store ~from ~to_ - | Last_known_L1_level -> - let ctxt = Worker.state self in - let* level = Evm_store.L1_latest_known_level.find ctxt.store in - return @@ Option.map snd level - | New_last_known_L1_level l1_level -> - let ctxt = Worker.state self in - let l2_level = State.current_blueprint_number ctxt in - Evm_store.L1_latest_known_level.store ctxt.store l2_level l1_level - | Delayed_inbox_hashes -> - let ctxt = Worker.state self in - let*! hashes = State.delayed_inbox_hashes ctxt.session.evm_state in - return hashes - | Evm_state_after {number} -> ( - let ctxt = Worker.state self in - let* checkpoint = Evm_store.Context_hashes.find ctxt.store number in - match checkpoint with - | Some checkpoint -> - let*! context = Irmin_context.checkout_exn ctxt.index checkpoint in - let*! evm_state = Irmin_context.PVMState.get context in - return_some evm_state - | None -> return_none) - - let on_completion (type a err) _self (_r : (a, err) Request.t) (_res : a) _st - = - Lwt_syntax.return_unit - - let on_no_request _self = Lwt.return_unit - - let on_close _self = Lwt.return_unit - - let on_error (type a b) _self _st (req : (a, b) Request.t) (errs : b) : - unit tzresult Lwt.t = - let open Lwt_result_syntax in - match (req, errs) with - | Apply_evm_events _, [Node_error.Diverged _divergence] -> - Lwt_exit.exit_and_raise Node_error.exit_code_when_diverge - | _ -> return_unit -end - -let table = Worker.create_table Queue - -let worker_promise, worker_waker = Lwt.task () - -type error += No_worker - -let worker = - lazy - (match Lwt.state worker_promise with - | Lwt.Return worker -> Ok worker - | Lwt.Fail e -> Error (TzTrace.make @@ error_of_exn e) - | Lwt.Sleep -> Error (TzTrace.make No_worker)) - -let bind_worker f = - let open Lwt_result_syntax in - let res = Lazy.force worker in - match res with - | Error [No_worker] -> - (* There is no worker, nothing to do *) - return_unit - | Error errs -> fail errs - | Ok w -> f w - -let worker_add_request ~request = - let open Lwt_result_syntax in - bind_worker @@ fun w -> - let*! (_pushed : bool) = Worker.Queue.push_request w request in - return_unit - -let return_ : (_, _ Worker.message_error) result -> _ = - let open Lwt_result_syntax in - function - | Ok res -> return res - | Error (Closed (Some trace)) -> Lwt.return (Error trace) - | Error (Closed None) -> - failwith - "Cannot interact with the EVM context worker because it is closed" - | Error (Request_error err) -> Lwt.return (Error err) - | Error (Any exn) -> fail_with_exn exn - -let worker_wait_for_request req = - let open Lwt_result_syntax in - let*? w = Lazy.force worker in - let*! res = Worker.Queue.push_request_and_wait w req in - return_ res - -let start ?kernel_path ~data_dir ~preimages ~preimages_endpoint - ~smart_rollup_address ~fail_on_missing_blueprint () = - let open Lwt_result_syntax in - let* worker = - Worker.launch - table - () - { - kernel_path; - data_dir; - preimages; - preimages_endpoint; - smart_rollup_address; - fail_on_missing_blueprint; - } - (module Handlers) - in - let*! () = Blueprint_events.publisher_is_ready () in - Lwt.wakeup worker_waker worker ; - let*! init_status in - let*! () = Evm_context_events.ready () in - return init_status - -let init_context_from_rollup_node ~data_dir ~rollup_node_data_dir = - let open Lwt_result_syntax in - let open Rollup_node_storage in - let* last_finalized_level, levels_to_hashes, l2_blocks = - Rollup_node_storage.load ~rollup_node_data_dir () - in - let* final_level = Last_finalized_level.read last_finalized_level in - let*? final_level = - Option.to_result - ~none: - [error_of_fmt "Rollup node storage is missing the last finalized level"] - final_level - in - let* final_level_hash = Levels_to_hashes.find levels_to_hashes final_level in - let*? final_level_hash = - Option.to_result - ~none: - [ - error_of_fmt - "Rollup node has no block hash for the l1 level %ld" - final_level; - ] - final_level_hash - in - let* final_l2_block = L2_blocks.read l2_blocks final_level_hash in - let* checkpoint = - match final_l2_block with - | Some Sc_rollup_block.(_, {context; _}) -> - Irmin_context.hash_of_context_hash context |> return - | None -> - failwith - "Rollup node has no l2 blocks for the l1 block hash %a" - Block_hash.pp - final_level_hash - in - let rollup_node_context_dir = - Filename.Infix.(rollup_node_data_dir // "context") - in - let* rollup_node_index = - Irmin_context.load ~cache_size:100_000 Read_only rollup_node_context_dir - in - let evm_context_dir = State.store_path ~data_dir in - let*! () = Lwt_utils_unix.create_dir evm_context_dir in - let* () = - Irmin_context.export_snapshot - rollup_node_index - checkpoint - ~path:evm_context_dir - in - let* evm_node_index = - Irmin_context.load ~cache_size:100_000 Read_write evm_context_dir - in - let*! evm_node_context = - Irmin_context.checkout_exn evm_node_index checkpoint - in - let*! evm_state = Irmin_context.PVMState.get evm_node_context in - return (evm_node_context, evm_state, final_level) - -let init_store_from_rollup_node ~data_dir ~evm_state ~irmin_context = - let open Lwt_result_syntax in - (* Tell the kernel that it is executed by an EVM node *) - let*! evm_state = Evm_state.flag_local_exec evm_state in - (* We remove the delayed inbox from the EVM state. Its contents will be - retrieved by the sequencer by inspecting the evm events. *) - let*! evm_state = Evm_state.clear_delayed_inbox evm_state in - - (* For changes made to [evm_state] to take effect, we commit the result *) - let*! evm_node_context = Irmin_context.PVMState.set irmin_context evm_state in - let*! checkpoint = Irmin_context.commit evm_node_context in - - (* Assert we can read the current blueprint number *) - let* current_blueprint_number = - let*! current_blueprint_number_opt = - Evm_state.inspect evm_state Durable_storage_path.Block.current_number - in - match current_blueprint_number_opt with - | Some bytes -> return (Bytes.to_string bytes |> Z.of_bits) - | None -> failwith "The blueprint number was not found" - in - - (* Assert we can read the current block hash *) - let* () = - let*! current_block_hash_opt = - Evm_state.inspect evm_state Durable_storage_path.Block.current_hash - in - match current_block_hash_opt with - | Some _bytes -> return_unit - | None -> failwith "The block hash was not found" - in - (* Init the store *) - let* store = Evm_store.init ~data_dir in - let* () = - Evm_store.Context_hashes.store - store - (Qty current_blueprint_number) - checkpoint - in - return_unit - -let reset = State.reset - -let get_evm_events_from_rollup_node_state ~omit_delayed_tx_events evm_state = - let open Lwt_result_syntax in - let* kernel_upgrade = - let*! kernel_upgrade_payload = - Evm_state.inspect evm_state Durable_storage_path.kernel_upgrade - in - Option.bind kernel_upgrade_payload Ethereum_types.Upgrade.of_bytes - |> Option.map (fun e -> Ethereum_types.Evm_events.Upgrade_event e) - |> return - in - - let* sequencer_upgrade = - let*! sequencer_upgrade_payload = - Evm_state.inspect evm_state Durable_storage_path.sequencer_upgrade - in - Option.bind - sequencer_upgrade_payload - Ethereum_types.Sequencer_upgrade.of_bytes - |> Option.map (fun e -> Ethereum_types.Evm_events.Sequencer_upgrade_event e) - |> return - in - - let* new_delayed_transactions = - if omit_delayed_tx_events then return [] - else - let*! hashes = State.delayed_inbox_hashes evm_state in - let* events = - List.map_es - (fun hash -> - let* item = State.delayed_inbox_item evm_state hash in - return (Ethereum_types.Evm_events.New_delayed_transaction item)) - hashes - in - return events - in - - return - @@ Option.to_list kernel_upgrade - @ Option.to_list sequencer_upgrade - @ new_delayed_transactions - -let apply_evm_events ?finalized_level events = - worker_add_request ~request:(Apply_evm_events {finalized_level; events}) - -let init_from_rollup_node ~omit_delayed_tx_events ~data_dir - ~rollup_node_data_dir = - let open Lwt_result_syntax in - let* irmin_context, evm_state, finalized_level = - init_context_from_rollup_node ~data_dir ~rollup_node_data_dir - in - let* evm_events = - get_evm_events_from_rollup_node_state ~omit_delayed_tx_events evm_state - in - let* () = init_store_from_rollup_node ~data_dir ~evm_state ~irmin_context in - let* smart_rollup_address = - let* metadata = - Metadata.Versioned.read_metadata_file ~dir:rollup_node_data_dir - in - match metadata with - | None -> failwith "missing metadata in the rollup node data dir" - | Some (V0 {rollup_address; _}) | Some (V1 {rollup_address; _}) -> - return @@ Address.to_string rollup_address - in - let* _loaded = - start - ~data_dir - ~preimages:Filename.Infix.(rollup_node_data_dir // "wasm_2_0_0") - ~preimages_endpoint:None - ~smart_rollup_address - ~fail_on_missing_blueprint:false - () - in - apply_evm_events ~finalized_level evm_events - -let apply_blueprint timestamp payload delayed_transactions = - worker_wait_for_request - (Apply_blueprint {timestamp; payload; delayed_transactions}) - -let last_produced_blueprint () = worker_wait_for_request Last_produce_blueprint - -let head_info () = - let open Lwt_syntax in - let+ head_info in - !head_info - -let execute_and_inspect ?wasm_entrypoint input = - let open Lwt_result_syntax in - let*! {evm_state; _} = head_info () in - let*! data_dir, config = execution_config in - Evm_state.execute_and_inspect - ~data_dir - ?wasm_entrypoint - ~config - ~input - evm_state - -let inspect path = - let open Lwt_result_syntax in - let*! {evm_state; _} = head_info () in - let*! res = Evm_state.inspect evm_state path in - return res - -let blueprints_watcher () = Lwt_watcher.create_stream blueprint_watcher - -let blueprint level = worker_wait_for_request (Blueprint {level}) - -let get_blueprint level = - let open Lwt_result_syntax in - let* blueprint = blueprint level in - match blueprint with - | Some blueprint -> return blueprint - | None -> failwith "Missing blueprint %a" Ethereum_types.pp_quantity level - -let blueprints_range from to_ = - worker_wait_for_request (Blueprints_range {from; to_}) - -let last_known_l1_level () = worker_wait_for_request Last_known_L1_level - -let new_last_known_l1_level l = - worker_add_request ~request:(New_last_known_L1_level l) - -let delayed_inbox_hashes () = worker_wait_for_request Delayed_inbox_hashes - -let replay ?profile ?(alter_evm_state = Lwt_result_syntax.return) - (Ethereum_types.Qty number) = - let open Lwt_result_syntax in - let* evm_state = - worker_wait_for_request (Evm_state_after {number = Qty Z.(pred number)}) - in - match evm_state with - | Some evm_state -> - let* evm_state = alter_evm_state evm_state in - let*! data_dir, config = execution_config in - let* blueprint = get_blueprint (Qty number) in - Evm_state.apply_blueprint - ~log_file:"replay" - ?profile - ~data_dir - ~config - evm_state - blueprint.blueprint.payload - | None -> - failwith - "Cannot replay blueprint %a: missing context" - Ethereum_types.pp_quantity - (Qty number) - -let shutdown () = - let open Lwt_result_syntax in - bind_worker @@ fun w -> - let*! () = Evm_context_events.shutdown () in - let*! () = Worker.shutdown w in - return_unit diff --git a/etherlink/bin_node/lib_prod/evm_context.mli b/etherlink/bin_node/lib_prod/evm_context.mli deleted file mode 100644 index 1bdb8b441a5316d1fba7b6fafeef99659bd06683..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_context.mli +++ /dev/null @@ -1,124 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type init_status = Loaded | Created - -type head = { - current_block_hash : Ethereum_types.block_hash; - next_blueprint_number : Ethereum_types.quantity; - evm_state : Evm_state.t; -} - -(** [start ~data_dir ~preimages ~preimages_endpoint ~smart_rollup_address ()] - creates a new worker to manage a local EVM context where it initializes the - {!type-index}, and use a checkpoint mechanism to load the latest - {!type-store} if any. - - Returns a value telling if the context was loaded from disk - ([Loaded]) or was initialized from scratch ([Created]). *) -val start : - ?kernel_path:string -> - data_dir:string -> - preimages:string -> - preimages_endpoint:Uri.t option -> - smart_rollup_address:string -> - fail_on_missing_blueprint:bool -> - unit -> - init_status tzresult Lwt.t - -(** [init_from_rollup_node ~omit_delayed_tx_events ~data_dir - ~rollup_node_data_dir] initialises the irmin context and metadata - of the evm using the latest known evm state of the given rollup - node. if [omit_delayed_tx_events] dont populate the delayed tx - event from the state into the db. *) -val init_from_rollup_node : - omit_delayed_tx_events:bool -> - data_dir:string -> - rollup_node_data_dir:string -> - unit tzresult Lwt.t - -(** [reset ~data_dir ~l2_level] reset the sequencer storage to - [l2_level]. {b Warning: b} Data will be lost ! *) -val reset : - data_dir:string -> l2_level:Ethereum_types.quantity -> unit tzresult Lwt.t - -(** [apply_evm_events ~finalized_level events] applies all the - events [events] on the local context. The events are performed in a - transactional context. - - Stores [finalized_level] with {!new_last_known_l1_level} if provided. -*) -val apply_evm_events : - ?finalized_level:int32 -> - Ethereum_types.Evm_events.t list -> - unit tzresult Lwt.t - -(** [inspect ctxt path] returns the value stored in [path] of the freshest EVM - state, if it exists. *) -val inspect : string -> bytes option tzresult Lwt.t - -(** [execute_and_inspect ~input ctxt] executes [input] using the freshest EVM - state, and returns [input.insights_requests]. - - If [wasm_entrypoint] is omitted, the [kernel_run] function of the kernel is - executed. *) -val execute_and_inspect : - ?wasm_entrypoint:string -> - Simulation.Encodings.simulate_input -> - bytes option list tzresult Lwt.t - -(** [last_produced_blueprint ctxt] returns the blueprint used to - create the current head of the chain. *) -val last_produced_blueprint : unit -> Blueprint_types.t tzresult Lwt.t - -(** [apply_blueprint timestamp payload delayed_transactions] applies - [payload] in the freshest EVM state stored under [ctxt] at - timestamp [timestamp], forwards the {!Blueprint_types.with_events}. - It commits the result if the blueprint produces the expected block. *) -val apply_blueprint : - Time.Protocol.t -> - Blueprint_types.payload -> - Ethereum_types.hash list -> - unit tzresult Lwt.t - -val head_info : unit -> head Lwt.t - -val blueprints_watcher : - unit -> Blueprint_types.with_events Lwt_stream.t * Lwt_watcher.stopper - -val blueprint : - Ethereum_types.quantity -> Blueprint_types.with_events option tzresult Lwt.t - -val blueprints_range : - Ethereum_types.quantity -> - Ethereum_types.quantity -> - (Ethereum_types.quantity * Blueprint_types.payload) list tzresult Lwt.t - -val last_known_l1_level : unit -> int32 option tzresult Lwt.t - -val new_last_known_l1_level : int32 -> unit tzresult Lwt.t - -val shutdown : unit -> unit tzresult Lwt.t - -(** [delayed_inbox_hashes ctxt] returns the hashes in the delayed inbox. *) -val delayed_inbox_hashes : unit -> Ethereum_types.hash list tzresult Lwt.t - -(** [replay ?alter_evm_state level] replays the [level]th blueprint on top of - the expected context. - - The optional argument [alter_evm_state] allows to modify the EVM state - before replaying the blueprint. This can be useful to test how the - blueprint would have paned out under different circumstances like with a - different kernel for instance. - - Note: this function only goes through the worker to fetch the correct - context. *) -val replay : - ?profile:bool -> - ?alter_evm_state:(Evm_state.t -> Evm_state.t tzresult Lwt.t) -> - Ethereum_types.quantity -> - Evm_state.apply_result tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/evm_context_events.ml b/etherlink/bin_node/lib_prod/evm_context_events.ml deleted file mode 100644 index 270ba3d6badb6974fdd6c03d0616636224edee8f..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_context_events.ml +++ /dev/null @@ -1,30 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -include Internal_event.Simple - -let section = Events.section @ ["evm_context"] - -let ready = - declare_0 - ~section - ~name:"evm_context_is_ready" - ~msg:"EVM Context worker is ready" - ~level:Info - () - -let shutdown = - declare_0 - ~section - ~name:"evm_context_shutdown" - ~msg:"EVM Context worker is shutting down" - ~level:Info - () - -let ready () = emit ready () - -let shutdown () = emit shutdown () diff --git a/etherlink/bin_node/lib_prod/evm_events_follower.ml b/etherlink/bin_node/lib_prod/evm_events_follower.ml deleted file mode 100644 index 6c198ad0462408626850b07a9d11497821cb15fb..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_events_follower.ml +++ /dev/null @@ -1,236 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type parameters = { - rollup_node_endpoint : Uri.t; - filter_event : Ethereum_types.Evm_events.t -> bool; - keep_alive : bool; -} - -module StringSet = Set.Make (String) - -module Types = struct - type state = parameters - - type nonrec parameters = parameters -end - -module Name = struct - (* We only have a single events follower in the evm node *) - type t = unit - - let encoding = Data_encoding.unit - - let base = ["evm_node"; "prod"; "events_follower"; "worker"] - - let pp _ _ = () - - let equal () () = true -end - -module Request = struct - type ('a, 'b) t = New_rollup_node_block : Int32.t -> (unit, error trace) t - - type view = View : _ t -> view - - let view (req : _ t) = View req - - let encoding = - let open Data_encoding in - union - [ - case - (Tag 0) - ~title:"New_rollup_node_block" - (obj2 - (req "request" (constant "new_rollup_node_block")) - (req "rollup_head" int32)) - (function - | View (New_rollup_node_block rollup_head) -> Some ((), rollup_head)) - (fun ((), rollup_head) -> View (New_rollup_node_block rollup_head)); - ] - - let pp ppf (View r) = - match r with - | New_rollup_node_block rollup_head -> - Format.fprintf ppf "New_rollup_node_block (level %ld)" rollup_head -end - -module Worker = Worker.MakeSingle (Name) (Request) (Types) - -type worker = Worker.infinite Worker.queue Worker.t - -let read_from_rollup_node ~keep_alive path level rollup_node_endpoint = - let open Rollup_services in - call_service - ~keep_alive - ~base:rollup_node_endpoint - durable_state_value - ((), Block_id.Level level) - {key = path} - () - -let fetch_event ({rollup_node_endpoint; keep_alive; _} : Types.state) - rollup_block_lvl event_index = - let open Lwt_result_syntax in - let path = Durable_storage_path.Evm_events.nth_event event_index in - let* bytes_opt = - read_from_rollup_node ~keep_alive path rollup_block_lvl rollup_node_endpoint - in - let event_opt = Option.bind bytes_opt Ethereum_types.Evm_events.of_bytes in - let*! () = - if Option.is_none event_opt then - Evm_events_follower_events.unreadable_event (event_index, rollup_block_lvl) - else Lwt.return_unit - in - return event_opt - -let on_new_head - ({rollup_node_endpoint; keep_alive; filter_event} as state : Types.state) - rollup_block_lvl = - let open Lwt_result_syntax in - let* last_known_l1_block = Evm_context.last_known_l1_level () in - let needs_processing = - match last_known_l1_block with - | None -> `Process - | Some last_known_l1_block -> - let level_expected = Int32.succ last_known_l1_block in - if Int32.equal rollup_block_lvl level_expected then `Process - else if Compare.Int32.(rollup_block_lvl < level_expected) then `Ignore - else - `Exit - (Node_error.Out_of_sync - {level_received = rollup_block_lvl; level_expected}) - in - - match needs_processing with - | `Ignore -> return_unit - | `Process -> ( - let* nb_of_events_bytes = - read_from_rollup_node - ~keep_alive - Durable_storage_path.Evm_events.length - rollup_block_lvl - rollup_node_endpoint - in - match nb_of_events_bytes with - | None -> Evm_context.new_last_known_l1_level rollup_block_lvl - | Some nb_of_events_bytes -> - let (Qty nb_of_events) = - Ethereum_types.decode_number nb_of_events_bytes - in - let nb_of_events = Z.to_int nb_of_events in - let* events = - List.init_ep - ~when_negative_length: - (error_of_fmt - "Internal error: the rollup node advertised a negative \ - length for the events stream") - nb_of_events - (fetch_event state rollup_block_lvl) - in - let events = - List.filter_map - (function - | Some event when filter_event event -> Some event | _ -> None) - events - in - Evm_context.apply_evm_events ~finalized_level:rollup_block_lvl events) - | `Exit err -> fail [err] - -module Handlers = struct - type self = worker - - let on_request : - type r request_error. - worker -> (r, request_error) Request.t -> (r, request_error) result Lwt.t - = - fun worker request -> - let open Lwt_result_syntax in - match request with - | Request.New_rollup_node_block rollup_block_lvl -> - protect @@ fun () -> - let* () = on_new_head (Worker.state worker) rollup_block_lvl in - return_unit - - type launch_error = error trace - - let on_launch _w () (parameters : Types.parameters) = - let state = parameters in - Lwt_result_syntax.return state - - let on_error : - type r request_error. - worker -> - Tezos_base.Worker_types.request_status -> - (r, request_error) Request.t -> - request_error -> - unit tzresult Lwt.t = - fun _w _ req errs -> - let open Lwt_result_syntax in - match (req, errs) with - | ( Request.New_rollup_node_block _, - Node_error.Out_of_sync {level_expected; level_received} :: _ ) -> - let*! () = - Evm_events_follower_events.out_of_sync - ~expected:level_expected - ~received:level_received - in - Lwt_exit.exit_and_raise Node_error.exit_code_when_out_of_sync - | _ -> return_unit - - let on_completion _ _ _ _ = Lwt.return_unit - - let on_no_request _ = Lwt.return_unit - - let on_close _ = Lwt.return_unit -end - -let table = Worker.create_table Queue - -let worker_promise, worker_waker = Lwt.task () - -type error += No_worker - -let worker = - lazy - (match Lwt.state worker_promise with - | Lwt.Return worker -> Ok worker - | Lwt.Fail e -> Result_syntax.tzfail (error_of_exn e) - | Lwt.Sleep -> Result_syntax.tzfail No_worker) - -let bind_worker f = - let open Lwt_result_syntax in - let res = Lazy.force worker in - match res with - | Error [No_worker] -> - (* There is no worker, nothing to do *) - return_unit - | Error errs -> fail errs - | Ok w -> f w - -let start parameters = - let open Lwt_result_syntax in - let*! () = Evm_events_follower_events.started () in - let+ worker = Worker.launch table () parameters (module Handlers) in - Lwt.wakeup worker_waker worker - -let shutdown () = - let open Lwt_result_syntax in - bind_worker @@ fun w -> - let*! () = Evm_events_follower_events.shutdown () in - let*! () = Worker.shutdown w in - return_unit - -let worker_add_request ~request = - let open Lwt_result_syntax in - bind_worker @@ fun w -> - let*! (_pushed : bool) = Worker.Queue.push_request w request in - return_unit - -let new_rollup_block rollup_level = - worker_add_request ~request:(New_rollup_node_block rollup_level) diff --git a/etherlink/bin_node/lib_prod/evm_events_follower.mli b/etherlink/bin_node/lib_prod/evm_events_follower.mli deleted file mode 100644 index ab880e55adeb4dcc3bea77ca61fdf3c88afdab38..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_events_follower.mli +++ /dev/null @@ -1,25 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type parameters = { - rollup_node_endpoint : Uri.t; - (** Rollup node endpoint used to monitor kernel events. *) - filter_event : Ethereum_types.Evm_events.t -> bool; - (** Filter event the follower applies. *) - keep_alive : bool; -} - -(** [start parameters] starts the events follower. *) -val start : parameters -> unit tzresult Lwt.t - -(** [shutdown ()] stops the events follower. *) -val shutdown : unit -> unit tzresult Lwt.t - -(** [new_rollup_block rollup_level] tells the worker that a new L2 - head has been published and that the rollup head is now - [rollup_level]. *) -val new_rollup_block : Int32.t -> unit tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/evm_events_follower_events.ml b/etherlink/bin_node/lib_prod/evm_events_follower_events.ml deleted file mode 100644 index f734ab982acc478991ba46f32bf25d4deceb6515..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_events_follower_events.ml +++ /dev/null @@ -1,124 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -module Event = struct - open Internal_event.Simple - - let section = Events.section - - let started = - declare_0 - ~section - ~name:"evm_events_follower_started" - ~msg:"Evm events follower has been started" - ~level:Notice - () - - let unreadable_event = - declare_2 - ~section - ~name:"evm_events_unreadable_event" - ~msg:"Evm events follower could not parse event {index} of level {level}" - ~level:Error - ("index", Data_encoding.int31) - ("level", Data_encoding.int32) - - let new_event = - declare_1 - ~section - ~name:"evm_events_new_event" - ~msg:"Evm events follower: applying {event}" - ~level:Debug - ~pp1:Ethereum_types.Evm_events.pp - ("event", Ethereum_types.Evm_events.encoding) - - let pp_int32 fmt i = Format.fprintf fmt "%ld" i - - let shutdown = - declare_0 - ~section - ~name:"shutting_down_evm_events_follower" - ~msg:"Stopping the evm events follower" - ~level:Notice - () - - let diverged = - declare_3 - ~section - ~name:"evm_events_follower_diverged" - ~msg: - "The rollup diverged, blueprint {level} leaded to block hash \ - {expected_hash}, but locally has {found_hash}." - ~level:Error - ("level", Data_encoding.n) - ("expected_hash", Ethereum_types.block_hash_encoding) - ("found_hash", Ethereum_types.block_hash_encoding) - - let upstream_blueprint_applied = - declare_2 - ~section - ~name:"evm_events_follower_upstream_blueprint_applied" - ~msg: - "The rollup node kernel applied blueprint {level} leading to creating \ - block {hash}." - ~level:Notice - ("level", Data_encoding.n) - ("hash", Ethereum_types.block_hash_encoding) - - let missing_blueprint = - declare_2 - ~section - ~name:"evm_events_follower_missing_blueprint" - ~msg: - "The rollup diverged, blueprint {level} not found in local state \ - (block hash: {expected_hash})." - ~level:Error - ("level", Data_encoding.n) - ("expected_hash", Ethereum_types.block_hash_encoding) - - let rollup_node_ahead = - declare_1 - ~section - ~name:"evm_events_follower_rollup_node_ahead" - ~msg:"Blueprint {level} was confirmed before we received it." - ~level:Warning - ("level", Data_encoding.n) - - let out_of_sync = - declare_2 - ~section - ~name:"evm_events_follower_out_of_sync" - ~msg: - "Evm node sequencer received finalized level {received} but was \ - expected {expected}" - ~level:Error - ("received", Data_encoding.int32) - ("expected", Data_encoding.int32) -end - -let started = Internal_event.Simple.emit Event.started - -let shutdown = Internal_event.Simple.emit Event.shutdown - -let unreadable_event (index, level) = - Internal_event.Simple.emit Event.unreadable_event (index, level) - -let new_event event = Internal_event.Simple.emit Event.new_event event - -let diverged divergence = Internal_event.Simple.emit Event.diverged divergence - -let upstream_blueprint_applied level_hash = - Internal_event.Simple.emit Event.upstream_blueprint_applied level_hash - -let missing_blueprint divergence = - Internal_event.Simple.emit Event.missing_blueprint divergence - -let rollup_node_ahead Ethereum_types.(Qty level) = - Internal_event.Simple.emit Event.rollup_node_ahead level - -let out_of_sync ~received ~expected = - Internal_event.Simple.emit Event.out_of_sync (received, expected) diff --git a/etherlink/bin_node/lib_prod/evm_services.ml b/etherlink/bin_node/lib_prod/evm_services.ml deleted file mode 100644 index fa7daaff046ec5036f06d85aad59b09c29b67ae5..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_services.ml +++ /dev/null @@ -1,121 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -open Tezos_rpc - -let evm_services_root = Path.(root / "evm") - -let get_smart_rollup_address_service = - Service.get_service - ~description:"Get the address of the smart rollup hosting the chain" - ~query:Query.empty - ~output:Tezos_crypto.Hashed.Smart_rollup_address.encoding - Path.(evm_services_root / "smart_rollup_address") - -let get_blueprint_service = - Service.get_service - ~description:"Fetch the contents of a blueprint" - ~query:Query.empty - ~output:Blueprint_types.with_events_encoding - Path.(evm_services_root / "blueprint" /: Arg.uint63) - -let blueprint_watcher_service = - let level_query = - Query.(query Fun.id |+ field "from_level" Arg.uint63 0L Fun.id |> seal) - in - - Service.get_service - ~description:"Watch for new blueprints" - ~query:level_query - ~output:Blueprint_types.with_events_encoding - Path.(evm_services_root / "blueprints") - -let create_blueprint_watcher_service from_level = - let open Lwt_syntax in - let blueprint_stream, stopper = Evm_context.blueprints_watcher () in - let shutdown () = Lwt_watcher.shutdown stopper in - (* input source block creating a stream to observe the events *) - let* head_info = Evm_context.head_info () in - let (Qty next) = head_info.next_blueprint_number in - let* () = - if Z.(Compare.(next < of_int64 from_level)) then - Stdlib.failwith "Cannot start watching from a level too far in the future" - else return_unit - in - - (* generate the next asynchronous event *) - let next = - let next_level_requested = ref Z.(of_int64 from_level) in - fun () -> - if Z.Compare.(!next_level_requested < next) then ( - let current_request = !next_level_requested in - (next_level_requested := Z.(succ current_request)) ; - let* blueprint = Evm_context.blueprint (Qty current_request) in - match blueprint with - | Ok (Some blueprint) -> return_some blueprint - | Ok None -> return_none - | Error _ -> - Stdlib.failwith - "Something went wrong when trying to fetch a blueprint") - else Lwt_stream.get blueprint_stream - in - Tezos_rpc.Answer.return_stream {next; shutdown} - -let register_get_smart_rollup_address_service smart_rollup_address dir = - Directory.register0 dir get_smart_rollup_address_service (fun () () -> - let open Lwt_syntax in - return_ok smart_rollup_address) - -let register_get_blueprint_service dir = - Directory.opt_register1 dir get_blueprint_service (fun level () () -> - let open Lwt_result_syntax in - let number = Ethereum_types.Qty (Z.of_int64 level) in - let* blueprint = Evm_context.blueprint number in - return blueprint) - -let register_blueprint_watcher_service dir = - Directory.gen_register0 dir blueprint_watcher_service (fun level () -> - create_blueprint_watcher_service level) - -let register smart_rollup_address dir = - register_get_smart_rollup_address_service smart_rollup_address dir - |> register_get_blueprint_service |> register_blueprint_watcher_service - -let get_smart_rollup_address ~evm_node_endpoint = - Tezos_rpc_http_client_unix.RPC_client_unix.call_service - [Media_type.json] - ~base:evm_node_endpoint - get_smart_rollup_address_service - () - () - () - -let get_blueprint ~evm_node_endpoint Ethereum_types.(Qty level) = - Tezos_rpc_http_client_unix.RPC_client_unix.call_service - [Media_type.json] - ~base:evm_node_endpoint - get_blueprint_service - ((), Z.to_int64 level) - () - () - -let monitor_blueprints ~evm_node_endpoint Ethereum_types.(Qty level) = - let open Lwt_result_syntax in - let stream, push = Lwt_stream.create () in - let on_chunk v = push (Some v) and on_close () = push None in - let* _spill_all = - Tezos_rpc_http_client_unix.RPC_client_unix.call_streamed_service - [Media_type.json] - ~base:evm_node_endpoint - blueprint_watcher_service - ~on_chunk - ~on_close - () - (Z.to_int64 level) - () - in - return stream diff --git a/etherlink/bin_node/lib_prod/evm_services.mli b/etherlink/bin_node/lib_prod/evm_services.mli deleted file mode 100644 index 850deec7dd1a2a1dc82d20d49b58eb965ba58c91..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_services.mli +++ /dev/null @@ -1,27 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -open Tezos_rpc - -val get_smart_rollup_address : - evm_node_endpoint:Uri.t -> - Tezos_crypto.Hashed.Smart_rollup_address.t tzresult Lwt.t - -val get_blueprint : - evm_node_endpoint:Uri.t -> - Ethereum_types.quantity -> - Blueprint_types.with_events tzresult Lwt.t - -val register : - Tezos_crypto.Hashed.Smart_rollup_address.t -> - unit Directory.t -> - unit Directory.t - -val monitor_blueprints : - evm_node_endpoint:Uri.t -> - Ethereum_types.quantity -> - Blueprint_types.with_events Lwt_stream.t tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/evm_state.ml b/etherlink/bin_node/lib_prod/evm_state.ml deleted file mode 100644 index 9da6d29d12b2592858f7c88eef2bb756edf79425..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_state.ml +++ /dev/null @@ -1,247 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -open Ethereum_types - -module Bare_context = struct - module Tree = Irmin_context.Tree - - type t = Irmin_context.rw - - type index = Irmin_context.rw_index - - type nonrec tree = Irmin_context.tree - - let init ?patch_context:_ ?readonly:_ ?index_log_size:_ path = - let open Lwt_syntax in - let* res = Irmin_context.load ~cache_size:100_000 Read_write path in - match res with - | Ok res -> return res - | Error _ -> Lwt.fail_with "could not initialize the context" - - let empty index = Irmin_context.empty index -end - -type t = Irmin_context.PVMState.value - -module Wasm_utils = - Wasm_utils.Make (Tezos_tree_encoding.Encodings_util.Make (Bare_context)) -module Wasm = Wasm_debugger.Make (Wasm_utils) - -let kernel_logs_directory ~data_dir = Filename.concat data_dir "kernel_logs" - -let level_prefix = function - | Events.Debug -> "[Debug]" - | Info -> "[Info]" - | Error -> "[Error]" - | Fatal -> "[Fatal]" - -let event_kernel_log ~kind ~msg = - let is_level ~level msg = - let prefix = level_prefix level in - String.remove_prefix ~prefix msg |> Option.map (fun msg -> (level, msg)) - in - let level_and_msg = - Option.either_f (is_level ~level:Debug msg) @@ fun () -> - Option.either_f (is_level ~level:Info msg) @@ fun () -> - Option.either_f (is_level ~level:Error msg) @@ fun () -> - is_level ~level:Fatal msg - in - Option.iter_s - (fun (level, msg) -> Events.event_kernel_log ~level ~kind ~msg) - level_and_msg - -let execute ?(profile = false) ?(kind = Events.Application) ~data_dir - ?(log_file = "kernel_log") - ?(wasm_entrypoint = Tezos_scoru_wasm.Constants.wasm_entrypoint) ~config - evm_state inbox = - let open Lwt_result_syntax in - let path = Filename.concat (kernel_logs_directory ~data_dir) log_file in - let inbox = List.map (function `Input s -> s) inbox in - let inbox = List.to_seq [inbox] in - let messages = ref [] in - let write_debug = - Tezos_scoru_wasm.Builtins.Printer - (fun msg -> - messages := msg :: !messages ; - event_kernel_log ~kind ~msg) - in - let eval evm_state = - if profile then - let* evm_state, _, _ = - Wasm.Commands.profile - ~collapse:false - ~with_time:true - ~no_reboot:false - 0l - inbox - {config with flamecharts_directory = data_dir} - Custom_section.FuncMap.empty - evm_state - in - return evm_state - else - let* evm_state, _, _, _ = - Wasm.Commands.eval - ~write_debug - ~wasm_entrypoint - 0l - inbox - config - Inbox - evm_state - in - return evm_state - in - let* evm_state = eval evm_state in - (* The messages are accumulated during the execution and stored - atomatically at the end to preserve their order. *) - let*! () = - Lwt_io.with_file - ~flags:Unix.[O_WRONLY; O_CREAT; O_APPEND] - ~perm:0o644 - ~mode:Output - path - @@ fun chan -> - Lwt_io.atomic - (fun chan -> - let msgs = List.rev !messages in - let*! () = List.iter_s (Lwt_io.write chan) msgs in - Lwt_io.flush chan) - chan - in - return evm_state - -let modify ~key ~value evm_state = Wasm.set_durable_value evm_state key value - -let flag_local_exec evm_state = - modify evm_state ~key:Durable_storage_path.evm_node_flag ~value:"" - -let init ~kernel = - let open Lwt_result_syntax in - let evm_state = Irmin_context.PVMState.empty () in - let* evm_state = - Wasm.start ~tree:evm_state Tezos_scoru_wasm.Wasm_pvm_state.V3 kernel - in - let*! evm_state = flag_local_exec evm_state in - return evm_state - -let inspect evm_state key = - let open Lwt_syntax in - let key = Tezos_scoru_wasm.Durable.key_of_string_exn key in - let* value = Wasm.Commands.find_key_in_durable evm_state key in - Option.map_s Tezos_lazy_containers.Chunked_byte_vector.to_bytes value - -let subkeys evm_state key = - let open Lwt_syntax in - let key = Tezos_scoru_wasm.Durable.key_of_string_exn key in - let* durable = Wasm_utils.wrap_as_durable_storage evm_state in - let durable = Tezos_scoru_wasm.Durable.of_storage_exn durable in - Tezos_scoru_wasm.Durable.list durable key - -let current_block_height evm_state = - let open Lwt_syntax in - let* current_block_number = - inspect evm_state Durable_storage_path.Block.current_number - in - match current_block_number with - | None -> - (* No block has been created yet and we are waiting for genesis, - whose number will be [zero]. Since the semantics of [apply_blueprint] - is to verify the block height has been incremented once, we default to - [-1]. *) - return (Qty Z.(pred zero)) - | Some current_block_number -> - let (Qty current_block_number) = decode_number current_block_number in - return (Qty current_block_number) - -let current_block_hash evm_state = - let open Lwt_result_syntax in - let*! current_hash = - inspect evm_state Durable_storage_path.Block.current_hash - in - match current_hash with - | Some h -> return (decode_block_hash h) - | None -> return genesis_parent_hash - -let execute_and_inspect ~data_dir ?wasm_entrypoint ~config - ~input: - Simulation.Encodings. - {messages; insight_requests; log_kernel_debug_file; _} ctxt = - let open Lwt_result_syntax in - let keys = - List.map - (function - | Simulation.Encodings.Durable_storage_key l -> - "/" ^ String.concat "/" l - (* We use only `Durable_storage_key` in simulation. *) - | _ -> assert false) - insight_requests - in - (* Messages from simulation requests are already valid inputs. *) - let messages = List.map (fun s -> `Input s) messages in - let* evm_state = - execute - ~kind:Simulation - ?log_file:log_kernel_debug_file - ~data_dir - ?wasm_entrypoint - ~config - ctxt - messages - in - let*! values = List.map_p (fun key -> inspect evm_state key) keys in - return values - -type apply_result = Apply_success of t * quantity * block_hash | Apply_failure - -let apply_blueprint ?log_file ?profile ~data_dir ~config evm_state - (blueprint : Blueprint_types.payload) = - let open Lwt_result_syntax in - let exec_inputs = - List.map - (function `External payload -> `Input ("\001" ^ payload)) - blueprint - in - let*! (Qty before_height) = current_block_height evm_state in - let* evm_state = - execute - ?profile - ~data_dir - ~wasm_entrypoint:Tezos_scoru_wasm.Constants.wasm_entrypoint - ~config - ?log_file - evm_state - exec_inputs - in - let*! (Qty after_height) = current_block_height evm_state in - let* block_hash = current_block_hash evm_state in - if Z.(equal (succ before_height) after_height) then - return (Apply_success (evm_state, Qty after_height, block_hash)) - else return Apply_failure - -let clear_delayed_inbox evm_state = - let open Lwt_syntax in - let delayed_inbox_path = - Tezos_scoru_wasm.Durable.key_of_string_exn - Durable_storage_path.delayed_inbox - in - let* pvm_state = - Wasm_utils.Ctx.Tree_encoding_runner.decode - Tezos_scoru_wasm.Wasm_pvm.pvm_state_encoding - evm_state - in - let* durable = - Tezos_scoru_wasm.Durable.delete - ~kind:Directory - pvm_state.durable - delayed_inbox_path - in - Wasm_utils.Ctx.Tree_encoding_runner.encode - Tezos_scoru_wasm.Wasm_pvm.pvm_state_encoding - {pvm_state with durable} - evm_state diff --git a/etherlink/bin_node/lib_prod/evm_state.mli b/etherlink/bin_node/lib_prod/evm_state.mli deleted file mode 100644 index 6be85e848a507510453d4422034847d43b9fef7f..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_state.mli +++ /dev/null @@ -1,94 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type t = Irmin_context.PVMState.value - -(** Directory where the kernel logs are stored. The function {!execute} below - expect the directory to exist.*) -val kernel_logs_directory : data_dir:string -> string - -(** [execute ?simulation ~data_dir ?log_file ~wasm_entrypoint ~config - evm_state messages] executes the [wasm_entrypoint] function - (default to [kernel_run]) with [messages] within the inbox of - [evm_state]. - - Kernel logs are stored under the {!kernel_logs_directory} in [log_file]. - [simulation] adds a prefix to the event to differenciate the logs. -*) -val execute : - ?profile:bool -> - ?kind:Events.kernel_log_kind -> - data_dir:string -> - ?log_file:string -> - ?wasm_entrypoint:string -> - config:Config.config -> - t -> - [< `Input of string] list -> - t tzresult Lwt.t - -(** [init ~kernel] initializes the local [evm_state] with [kernel]. *) -val init : kernel:string -> t tzresult Lwt.t - -(** [modify ~key ~value evm_state] sets [value] at [key] in the local EVM - state. *) -val modify : key:string -> value:string -> t -> t Lwt.t - -(** [inspect evm_state key] returns the value stored under [key] in - [evm_state], if any. *) -val inspect : t -> string -> bytes option Lwt.t - -(** [subkeys evm_state key] returns the list of value stored under [key] in - [evm_state]. *) -val subkeys : t -> string -> string trace Lwt.t - -(** [execute_and_inspect ~data_dir ?wasm_entrypoint ~config ~input - evm_state] executes the [wasm_entrypoint] function (default to - [kernel_run]) with [input] within the inbox of [evm_state], and - returns [input.insights_requests]. *) -val execute_and_inspect : - data_dir:string -> - ?wasm_entrypoint:string -> - config:Config.config -> - input:Simulation.Encodings.simulate_input -> - t -> - bytes option list tzresult Lwt.t - -(** [current_block_height evm_state] returns the height of the latest block - produced by the kernel. *) -val current_block_height : t -> Ethereum_types.quantity Lwt.t - -(** Same as {!current_block_height} for the block hash. *) -val current_block_hash : t -> Ethereum_types.block_hash tzresult Lwt.t - -type apply_result = - | Apply_success of t * Ethereum_types.quantity * Ethereum_types.block_hash - | Apply_failure - -(** [apply_blueprint ~data-dir ~config state payload] applies the - blueprint [payload] on top of [evm_state]. If the payload produces - a block, the new updated EVM state is returned along with the new - block’s height. - - The [data-dir] is used to store the kernel logs in the - {!kernel_logs_directory}. -*) -val apply_blueprint : - ?log_file:string -> - ?profile:bool -> - data_dir:string -> - config:Config.config -> - t -> - Blueprint_types.payload -> - apply_result tzresult Lwt.t - -(** [flag_local_exec evm_state] adds a flag telling the kernel it is executed - by an EVM node, not a rollup node. *) -val flag_local_exec : t -> t Lwt.t - -(** [clear_delayed_inbox evm_state] removes the delayed inbox from the current - EVM state. *) -val clear_delayed_inbox : t -> t Lwt.t diff --git a/etherlink/bin_node/lib_prod/evm_store.ml b/etherlink/bin_node/lib_prod/evm_store.ml deleted file mode 100644 index 917735cd496ffb72a24aa6abc3ed2ee285acbe6a..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_store.ml +++ /dev/null @@ -1,489 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -open Filename.Infix - -type error += Caqti_error of string - -module Db = struct - let caqti (p : ('a, Caqti_error.t) result Lwt.t) : 'a tzresult Lwt.t = - let open Lwt_result_syntax in - let*! p in - match p with - | Ok p -> return p - | Error err -> fail [Caqti_error (Caqti_error.show err)] - - let start (module Db : Caqti_lwt.CONNECTION) = caqti @@ Db.start () - - let collect_list (module Db : Caqti_lwt.CONNECTION) req arg = - caqti @@ Db.collect_list req arg - - let commit (module Db : Caqti_lwt.CONNECTION) = caqti @@ Db.commit () - - let rollback (module Db : Caqti_lwt.CONNECTION) = caqti @@ Db.rollback () - - let exec (module Db : Caqti_lwt.CONNECTION) req arg = caqti @@ Db.exec req arg - - let find (module Db : Caqti_lwt.CONNECTION) req arg = caqti @@ Db.find req arg - - let find_opt (module Db : Caqti_lwt.CONNECTION) req arg = - caqti @@ Db.find_opt req arg -end - -type t = { - db_uri : Uri.t; - with_transaction : (module Caqti_lwt.CONNECTION) option; -} - -let assert_in_transaction store = assert (store.with_transaction <> None) - -module Q = struct - open Caqti_request.Infix - open Caqti_type.Std - open Ethereum_types - - let l1_level = int32 - - let level = - custom - ~encode:(fun (Qty x) -> Ok Z.(to_int x)) - ~decode:(fun x -> Ok (Qty Z.(of_int x))) - int - - let payload = - custom - ~encode:(fun payload -> - Ok - (Data_encoding.Binary.to_string_exn - Blueprint_types.payload_encoding - payload)) - ~decode:(fun bytes -> - Option.to_result ~none:"Not a valid blueprint payload" - @@ Data_encoding.Binary.of_string_opt - Blueprint_types.payload_encoding - bytes) - string - - let context_hash = - custom - ~encode:(fun hash -> - Ok - (hash |> Irmin_context.context_hash_of_hash - |> Smart_rollup_context_hash.to_context_hash - |> Context_hash.to_b58check)) - ~decode:(fun bytes -> - let open Result_syntax in - let+ hash = - Option.to_result ~none:"Not a valid b58check encoded hash" - @@ Context_hash.of_b58check_opt bytes - in - hash |> Smart_rollup_context_hash.of_context_hash - |> Irmin_context.hash_of_context_hash) - string - - let root_hash = - let open Ethereum_types in - custom - ~encode:(fun (Hash (Hex hash)) -> - Result.of_option ~error:"not a valid hash" @@ Hex.to_string (`Hex hash)) - ~decode:(fun hash -> - let (`Hex hash) = Hex.of_string hash in - Ok (Hash (Hex hash))) - string - - let timestamp = - custom - ~encode:(fun t -> Ok (Time.Protocol.to_seconds t)) - ~decode:(fun i -> - if i >= 0L then Ok (Time.Protocol.of_seconds i) - else Error "invalid negative timestamp") - int64 - - let upgrade = - custom - ~encode:(fun Ethereum_types.Upgrade.{hash; timestamp} -> - Ok (hash, timestamp)) - ~decode:(fun (hash, timestamp) -> - Ok Ethereum_types.Upgrade.{hash; timestamp}) - (t2 root_hash timestamp) - - let delayed_transaction = - custom - ~encode:(fun payload -> - Ok - (Data_encoding.Binary.to_string_exn - Ethereum_types.Delayed_transaction.encoding - payload)) - ~decode:(fun bytes -> - Option.to_result ~none:"Not a valid blueprint payload" - @@ Data_encoding.Binary.of_string_opt - Ethereum_types.Delayed_transaction.encoding - bytes) - string - - let table_exists = - (string ->! bool) - @@ {| - SELECT EXISTS ( - SELECT name FROM sqlite_master - WHERE type='table' - AND name=? - )|} - - module Migrations = struct - let create_table = - (unit ->. unit) - @@ {| - CREATE TABLE migrations ( - id SERIAL PRIMARY KEY, - name TEXT - )|} - - let current_migration = - (unit ->? int) @@ {|SELECT id FROM migrations ORDER BY id DESC LIMIT 1|} - - let register_migration = - (t2 int string ->. unit) - @@ {| - INSERT INTO migrations (id, name) VALUES (?, ?) - |} - - (* - To introduce a new migration - - - Create a .sql file led by the next migration number [N = version + 1] - (with leading 0s) followed by the name of the migration (e.g. - [005_create_blueprints_table.sql]) - - Run [etherlink/scripts/check_evm_store_migrations.sh promote] - - Increment [version] - *) - let version = 6 - - let all : Evm_node_migrations.migration list = - Evm_node_migrations.migrations version - end - - module Blueprints = struct - let insert = - (t3 level timestamp payload ->. unit) - @@ {eos|INSERT INTO blueprints (id, timestamp, payload) VALUES (?, ?, ?)|eos} - - let select = - (level ->? t2 payload timestamp) - @@ {eos|SELECT payload, timestamp FROM blueprints WHERE id = ?|eos} - - let select_range = - (t2 level level ->* t2 level payload) - @@ {|SELECT id, payload FROM blueprints - WHERE ? <= id AND id <= ? - ORDER BY id ASC|} - - let clear_after = - (level ->. unit) @@ {|DELETE FROM blueprints WHERE id > ?|} - end - - module Context_hashes = struct - let insert = - (t2 level context_hash ->. unit) - @@ {eos|REPLACE INTO context_hashes (id, context_hash) VALUES (?, ?)|eos} - - let select = - (level ->? context_hash) - @@ {eos|SELECT (context_hash) FROM context_hashes WHERE id = ?|eos} - - let get_latest = - (unit ->? t2 level context_hash) - @@ {eos|SELECT id, context_hash FROM context_hashes ORDER BY id DESC LIMIT 1|eos} - - let clear_after = - (level ->. unit) @@ {|DELETE FROM context_hashes WHERE id > ?|} - end - - module Kernel_upgrades = struct - let insert = - (t3 level root_hash timestamp ->. unit) - @@ {|REPLACE INTO kernel_upgrades (injected_before, root_hash, activation_timestamp) VALUES (?, ?, ?)|} - - let get_latest_unapplied = - (unit ->? upgrade) - @@ {|SELECT root_hash, activation_timestamp - FROM kernel_upgrades WHERE applied_before IS NULL - ORDER BY applied_before DESC - LIMIT 1 - |} - - let record_apply = - (level ->. unit) - @@ {| - UPDATE kernel_upgrades SET applied_before = ? WHERE applied_before = NULL - |} - - let clear_after = - (level ->. unit) - @@ {|DELETE FROM kernel_upgrades WHERE injected_before > ?|} - end - - module Delayed_transactions = struct - let insert = - (t3 level root_hash delayed_transaction ->. unit) - @@ {|INSERT INTO delayed_transactions (injected_before, hash, payload) VALUES (?, ?, ?)|} - - let select_at_level = - (level ->* delayed_transaction) - @@ {|SELECT payload FROM delayed_transactions WHERE ? = injected_before|} - - let select_at_hash = - (root_hash ->? delayed_transaction) - @@ {|SELECT payload FROM delayed_transactions WHERE ? = hash|} - - let clear_after = - (level ->. unit) - @@ {|DELETE FROM delayed_transactions WHERE injected_before > ?|} - end - - module L1_latest_level = struct - let insert = - (t2 level l1_level ->. unit) - @@ {|INSERT INTO l1_latest_level_with_l2_level (l2_level, l1_level) VALUES (?, ?)|} - - let get = - (unit ->! t2 level l1_level) - @@ {|SELECT l2_level, l1_level FROM l1_latest_level_with_l2_level ORDER BY l2_level DESC LIMIT 1|} - - let clear_after = - (level ->. unit) - @@ {|DELETE FROM l1_latest_level_with_l2_level WHERE l2_level > ?|} - end -end - -let with_connection store k = - let open Lwt_result_syntax in - match store.with_transaction with - | Some conn -> k conn - | None -> - Caqti_lwt_unix.System.Switch.run @@ fun sw -> - let* conn = Db.caqti (Caqti_lwt_unix.connect ~sw store.db_uri) in - k conn - -let with_transaction store k = - let open Lwt_result_syntax in - match store.with_transaction with - | None -> ( - with_connection store @@ fun conn -> - let* () = Db.start conn in - let*! res = - Lwt.catch - (fun () -> k {store with with_transaction = Some conn}) - (fun exn -> fail_with_exn exn) - in - - match res with - | Ok x -> - let* () = Db.commit conn in - return x - | Error err -> - let* () = Db.rollback conn in - fail err) - | Some _ -> - failwith "Internal error: attempting to perform a nested transaction" - -module Migrations = struct - let create_table store = - with_connection store @@ fun conn -> - Db.exec conn Q.Migrations.create_table () - - let table_exists store = - with_connection store @@ fun conn -> - Db.find conn Q.table_exists "migrations" - - let missing_migrations store = - let open Lwt_result_syntax in - let all_migrations = List.mapi (fun i m -> (i, m)) Q.Migrations.all in - let* current = - with_connection store @@ fun conn -> - Db.find_opt conn Q.Migrations.current_migration () - in - match current with - | Some current -> - let applied = current + 1 in - let known = List.length all_migrations in - if applied <= known then return (List.drop_n applied all_migrations) - else - let*! () = - Evm_store_events.migrations_from_the_future ~applied ~known - in - failwith - "Cannot use a store modified by a more up-to-date version of the \ - EVM node" - | None -> return all_migrations - - let apply_migration store id (module M : Evm_node_migrations.S) = - let open Lwt_result_syntax in - with_connection store @@ fun conn -> - let* () = List.iter_es (fun up -> Db.exec conn up ()) M.up in - Db.exec conn Q.Migrations.register_migration (id, M.name) -end - -let init ~data_dir = - let open Lwt_result_syntax in - let path = data_dir // "store.sqlite" in - let*! exists = Lwt_unix.file_exists path in - let uri = Uri.of_string Format.(sprintf "sqlite3:%s" path) in - let store = {db_uri = uri; with_transaction = None} in - let* () = - with_transaction store @@ fun store -> - let* () = - if not exists then - let* () = Migrations.create_table store in - let*! () = Evm_store_events.init_store () in - return_unit - else - let* table_exists = Migrations.table_exists store in - let* () = - when_ (not table_exists) (fun () -> - failwith "A store already exists, but its content is incorrect.") - in - return_unit - in - let* migrations = Migrations.missing_migrations store in - let* () = - List.iter_es - (fun (i, ((module M : Evm_node_migrations.S) as mig)) -> - let* () = Migrations.apply_migration store i mig in - let*! () = Evm_store_events.applied_migration M.name in - return_unit) - migrations - in - return_unit - in - return store - -module Blueprints = struct - let store store (blueprint : Blueprint_types.t) = - with_connection store @@ fun conn -> - Db.exec - conn - Q.Blueprints.insert - (blueprint.number, blueprint.timestamp, blueprint.payload) - - let find store number = - let open Lwt_result_syntax in - with_connection store @@ fun conn -> - let+ opt = Db.find_opt conn Q.Blueprints.select number in - match opt with - | Some (payload, timestamp) -> - Some Blueprint_types.{payload; timestamp; number} - | None -> None - - let find_range store ~from ~to_ = - with_connection store @@ fun conn -> - Db.collect_list conn Q.Blueprints.select_range (from, to_) - - let clear_after store l2_level = - with_connection store @@ fun conn -> - Db.exec conn Q.Blueprints.clear_after l2_level -end - -module Context_hashes = struct - let store store number hash = - with_connection store @@ fun conn -> - Db.exec conn Q.Context_hashes.insert (number, hash) - - let find store number = - with_connection store @@ fun conn -> - Db.find_opt conn Q.Context_hashes.select number - - let find_latest store = - with_connection store @@ fun conn -> - Db.find_opt conn Q.Context_hashes.get_latest () - - let clear_after store l2_level = - with_connection store @@ fun conn -> - Db.exec conn Q.Context_hashes.clear_after l2_level -end - -module Kernel_upgrades = struct - let store store next_blueprint_number (event : Ethereum_types.Upgrade.t) = - with_connection store @@ fun conn -> - Db.exec - conn - Q.Kernel_upgrades.insert - (next_blueprint_number, event.hash, event.timestamp) - - let find_latest_pending store = - with_connection store @@ fun conn -> - Db.find_opt conn Q.Kernel_upgrades.get_latest_unapplied () - - let record_apply store level = - with_connection store @@ fun conn -> - Db.exec conn Q.Kernel_upgrades.record_apply level - - let clear_after store l2_level = - with_connection store @@ fun conn -> - Db.exec conn Q.Kernel_upgrades.clear_after l2_level -end - -module Delayed_transactions = struct - let store store next_blueprint_number - (delayed_transaction : Ethereum_types.Delayed_transaction.t) = - with_connection store @@ fun conn -> - Db.exec - conn - Q.Delayed_transactions.insert - (next_blueprint_number, delayed_transaction.hash, delayed_transaction) - - let at_level store blueprint_number = - with_connection store @@ fun conn -> - Db.collect_list conn Q.Delayed_transactions.select_at_level blueprint_number - - let at_hash store hash = - with_connection store @@ fun conn -> - Db.find_opt conn Q.Delayed_transactions.select_at_hash hash - - let clear_after store l2_level = - with_connection store @@ fun conn -> - Db.exec conn Q.Delayed_transactions.clear_after l2_level -end - -module L1_latest_known_level = struct - let store store l1_level l2_level = - with_connection store @@ fun conn -> - Db.exec conn Q.L1_latest_level.insert (l1_level, l2_level) - - let find store = - with_connection store @@ fun conn -> - Db.find_opt conn Q.L1_latest_level.get () - - let clear_after store l2_level = - with_connection store @@ fun conn -> - Db.exec conn Q.L1_latest_level.clear_after l2_level -end - -let reset store ~l2_level = - let open Lwt_result_syntax in - let* () = Blueprints.clear_after store l2_level in - let* () = Context_hashes.clear_after store l2_level in - let* () = L1_latest_known_level.clear_after store l2_level in - let* () = Kernel_upgrades.clear_after store l2_level in - let* () = Delayed_transactions.clear_after store l2_level in - return_unit - -(* Error registration *) -let () = - register_error_kind - `Permanent - ~id:"evm_node_prod_caqti_error" - ~title:"Error raised by Caqti" - ~description:"Caqti raised an error while processing a SQL statement" - ~pp:(fun ppf msg -> - Format.fprintf - ppf - "Caqti raised an error while processing a SQL statement: %s" - msg) - Data_encoding.(obj1 (req "caqti_error" string)) - (function Caqti_error err -> Some err | _ -> None) - (fun err -> Caqti_error err) diff --git a/etherlink/bin_node/lib_prod/evm_store.mli b/etherlink/bin_node/lib_prod/evm_store.mli deleted file mode 100644 index f4e1110fa5f8a7e3aaa8bd56f160419f998fe56d..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_store.mli +++ /dev/null @@ -1,100 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type t - -(** [init ~data_dir] returns a handler to the EVM node store located under - [data_dir]. If no store is located in [data_dir], an empty store is - created. Also returns if the store was created ([true]) or was already - existing ([false]). *) -val init : data_dir:string -> t tzresult Lwt.t - -(** [with_transaction store k] wraps the accesses to [store] made in the - continuation [k] within {{:https://www.sqlite.org/lang_transaction.html}a - SQL transaction}. If [k] fails, the transaction is rollbacked. Otherwise, - the transaction is committed. *) -val with_transaction : t -> (t -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t - -(** [assert_in_transaction store] raises an exception if a transaction has not - been started with [store]. - - @raise Assert_failure *) -val assert_in_transaction : t -> unit - -module Blueprints : sig - val store : t -> Blueprint_types.t -> unit tzresult Lwt.t - - val find : - t -> Ethereum_types.quantity -> Blueprint_types.t option tzresult Lwt.t - - val find_range : - t -> - from:Ethereum_types.quantity -> - to_:Ethereum_types.quantity -> - (Ethereum_types.quantity * Blueprint_types.payload) list tzresult Lwt.t - - val clear_after : t -> Ethereum_types.quantity -> unit tzresult Lwt.t -end - -module Context_hashes : sig - val store : - t -> Ethereum_types.quantity -> Irmin_context.hash -> unit tzresult Lwt.t - - val find : - t -> Ethereum_types.quantity -> Irmin_context.hash option tzresult Lwt.t - - val find_latest : - t -> (Ethereum_types.quantity * Irmin_context.hash) option tzresult Lwt.t - - val clear_after : t -> Ethereum_types.quantity -> unit tzresult Lwt.t -end - -module Kernel_upgrades : sig - val store : - t -> - Ethereum_types.quantity -> - Ethereum_types.Upgrade.t -> - unit tzresult Lwt.t - - val find_latest_pending : t -> Ethereum_types.Upgrade.t option tzresult Lwt.t - - val record_apply : t -> Ethereum_types.quantity -> unit tzresult Lwt.t - - val clear_after : t -> Ethereum_types.quantity -> unit tzresult Lwt.t -end - -module Delayed_transactions : sig - val store : - t -> - Ethereum_types.quantity -> - Ethereum_types.Delayed_transaction.t -> - unit tzresult Lwt.t - - val at_level : - t -> - Ethereum_types.quantity -> - Ethereum_types.Delayed_transaction.t list tzresult Lwt.t - - val at_hash : - t -> - Ethereum_types.hash -> - Ethereum_types.Delayed_transaction.t option tzresult Lwt.t - - val clear_after : t -> Ethereum_types.quantity -> unit tzresult Lwt.t -end - -module L1_latest_known_level : sig - val store : t -> Ethereum_types.quantity -> int32 -> unit tzresult Lwt.t - - val find : t -> (Ethereum_types.quantity * int32) option tzresult Lwt.t - - val clear_after : t -> Ethereum_types.quantity -> unit tzresult Lwt.t -end - -(** [reset store ~l2_level] clear the table that has information - related to l2 level that after [l2_level] *) -val reset : t -> l2_level:Ethereum_types.quantity -> unit tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/evm_store_events.ml b/etherlink/bin_node/lib_prod/evm_store_events.ml deleted file mode 100644 index 94acf2cc96dbf30f1093caa20b5a988e97b36880..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_store_events.ml +++ /dev/null @@ -1,56 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -include Internal_event.Simple - -let section = Events.section - -let init_store = - declare_0 - ~section - ~name:"store_init" - ~msg:"Evm_store is being initialized for the first time" - ~level:Notice - () - -let applied_migration = - declare_1 - ~section - ~name:"store_applied_migration" - ~msg:"Applied migration {name} to the store" - ~level:Notice - ("name", Data_encoding.string) - -let migrations_from_the_future = - declare_2 - ~section - ~name:"migrations_from_the_future" - ~msg: - "Evm_store has {applied} migrations applied but the EVM node is only \ - aware of {known}" - ~level:Error - ("applied", Data_encoding.int31) - ("known", Data_encoding.int31) - -let no_l1_latest_level_to_catch_up = - declare_0 - ~section - ~name:"no_l1_latest_level" - ~msg: - "The store is missing the l1 latest level row in its table. We assume no \ - evm events catch up is needed." - ~level:Warning - () - -let init_store () = emit init_store () - -let applied_migration name = emit applied_migration name - -let migrations_from_the_future ~applied ~known = - emit migrations_from_the_future (applied, known) - -let no_l1_latest_level_to_catch_up () = emit no_l1_latest_level_to_catch_up () diff --git a/etherlink/bin_node/lib_prod/evm_store_events.mli b/etherlink/bin_node/lib_prod/evm_store_events.mli deleted file mode 100644 index 0aefe815fbfcf001816a997c381b0ec4f658d898..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/evm_store_events.mli +++ /dev/null @@ -1,24 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(** [init_store ()] advertizes that the store is being initialized for the - first time. *) -val init_store : unit -> unit Lwt.t - -(** [applied_migration name] advertizes that the migration [name] is applied - on a store that was previously missing it. *) -val applied_migration : string -> unit Lwt.t - -(** [migration_from_the_future ~applied ~known] advertizes that there is more - migrations applied to the store than known from the EVM node, which - suggests the EVM node is outdated. *) -val migrations_from_the_future : applied:int -> known:int -> unit Lwt.t - -(** [no_l1_latest_level_to_catch_up ()] advertizes that the EVM node - is missing l1 latest level in its store. This means the evm node - can't catch up on evm events and might misses some. *) -val no_l1_latest_level_to_catch_up : unit -> unit Lwt.t diff --git a/etherlink/bin_node/lib_prod/filter_helpers.ml b/etherlink/bin_node/lib_prod/filter_helpers.ml deleted file mode 100644 index bfad0897215d6d5118c7828afbdacb40233007f8..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/filter_helpers.ml +++ /dev/null @@ -1,347 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs, *) -(* *) -(*****************************************************************************) -open Ethereum_types - -(** - A bloom filter can be seen as a probabilistic set. As such, the order of - its elements is not important. - - Blocks contain a bloom filter with the union of all topics in their logs, - together with the address of the contract that produced them. - The [getLogs] RPC defines a filter (not to be confused with bloom filter) - which may contain a pattern of topics to be matched with a log. - - A pattern is defined as: [pattern := TOPIC | NULL | TOPIC list] - - Where [NULL] is a wildcard, and a list of topics matches against any of the - elements in the list ([Or]). - - To speed up the filtering, we compute a bloom filter corresponding to the - filter's pattern. The goal is to check if this bloom is contained in the - block's bloom, and only fetching the block in that case. - Therefore, our filter must always be included in filters corresponding - to blocks that have at least a log that matches with the pattern. - For this reason, we decide to ignore [Or] patterns in the bloom filter - "heuristic" (including all topics would break the previous property). - The same is done for addresses, as a filter can match against a list - of them. - If this becomes a serious bottleneck, we could keep a collection of bloom - filters to represent the disjunction. -*) - -(** Saner representation of an input filter: - [from_block] and [to_block] are defined by: - A filter's [from_block] and [to_block] if provided, or - a filter's [block_hash] if provided ([from_block = to_block = block_n]), or - [from_block = to_block = latest block's number]. - - A [bloom] filter is computed using the topics and address. -*) -type valid_filter = { - from_block : quantity; - to_block : quantity; - bloom : Ethbloom.t; - topics : filter_topic option list; - address : address list; -} - -type error += - | Incompatible_block_params - | Block_range_too_large of {limit : int} - | Topic_list_too_large - | Receipt_not_found of Ethereum_types.hash - | Too_many_logs of {limit : int} - -(** [height_from_param (module Rollup_node_rpc) from to_] returns the - block height for params [from] and [to_] as a tuple. -*) -let height_from_param (module Rollup_node_rpc : Services_backend_sig.S) from to_ - = - let open Lwt_result_syntax in - match (from, to_) with - | Hash_param h1, Hash_param h2 -> return (h1, h2) - | Hash_param h1, _ -> - let+ h2 = Rollup_node_rpc.current_block_number () in - (h1, h2) - | _, _ -> - let+ h = Rollup_node_rpc.current_block_number () in - (h, h) - -let valid_range log_filter_config (Qty from) (Qty to_) = - Z.( - to_ >= from - && to_ - from < of_int log_filter_config.Configuration.max_nb_blocks) - -let emit_and_return_none event arg = - let open Lwt_result_syntax in - let*! () = Internal_event.Simple.emit event arg in - return_none - -(* Parses the [from_block] and [to_block] fields, as described before. *) -let validate_range log_filter_config - (module Rollup_node_rpc : Services_backend_sig.S) (filter : filter) = - let open Lwt_result_syntax in - match filter with - | {from_block = Some _; to_block = Some _; block_hash = Some _; _} -> - tzfail Incompatible_block_params - | {block_hash = Some block_hash; _} -> - let* block = - Rollup_node_rpc.block_by_hash ~full_transaction_object:false block_hash - in - return (block.number, block.number) - | {from_block; to_block; _} -> - let from_block = Option.value ~default:Latest from_block in - let to_block = Option.value ~default:Latest to_block in - let* from_block, to_block = - height_from_param (module Rollup_node_rpc) from_block to_block - in - if valid_range log_filter_config from_block to_block then - return (from_block, to_block) - else - tzfail (Block_range_too_large {limit = log_filter_config.max_nb_blocks}) - -(* Constructs the bloom filter *) -let make_bloom (filter : filter) = - let bloom = Ethbloom.make () in - Option.iter - (function - | Single (Address address) -> Ethbloom.accrue ~input:address bloom - | _ -> ()) - filter.address ; - Option.iter - (List.iter (function - | Some (One (Hash topic)) -> Ethbloom.accrue ~input:topic bloom - | _ -> ())) - filter.topics ; - bloom - -let validate_topics (filter : filter) = - let open Lwt_result_syntax in - match filter.topics with - | Some topics when List.compare_length_with topics 4 > 0 -> - tzfail Topic_list_too_large - | _ -> return_unit - -(* Parsing a filter into a simpler representation, this is the - input validation step *) -let validate_filter log_filter_config - (module Rollup_node_rpc : Services_backend_sig.S) : - filter -> valid_filter tzresult Lwt.t = - fun filter -> - let open Lwt_result_syntax in - let* from_block, to_block = - validate_range log_filter_config (module Rollup_node_rpc) filter - in - let* () = validate_topics filter in - let bloom = make_bloom filter in - let address = - Option.map (function Single a -> [a] | Vec l -> l) filter.address - |> Option.value ~default:[] - in - return - { - from_block; - to_block; - bloom; - topics = Option.value ~default:[] filter.topics; - address; - } - -let hex_to_bytes h = hex_to_bytes h |> Bytes.of_string - -(* Checks if a filter's topics matches a log's topics, as specified in - https://ethereum.org/en/developers/docs/apis/json-rpc/#eth_getfilterchanges *) -let match_filter_topics (filter : valid_filter) (log_topics : hash list) : bool - = - let match_one_topic (filter_topic : filter_topic option) (log_topic : hash) = - match (filter_topic, log_topic) with - (* Null matches with every topic *) - | None, _ -> true - | Some (One ft), lt -> ft = lt - | Some (Or fts), lt -> List.mem ~equal:( = ) lt fts - in - (* A log has at most 4 topics, no need to make it tail-rec *) - let rec go filter_topics log_topics = - match (filter_topics, log_topics) with - (* Empty filter matches with everything *) - | [], _ -> true - (* Non-empty filter never matches with empty topics *) - | _ :: _, [] -> false - | ft :: fts, lt :: lts -> match_one_topic ft lt && go fts lts - in - go filter.topics log_topics - -(* Checks if a filter's address matches a log's address *) -let match_filter_address (filter : valid_filter) (address : address) : bool = - List.is_empty filter.address || List.mem ~equal:( = ) address filter.address - -(* Apply a filter on one log *) -let filter_one_log : valid_filter -> transaction_log -> filter_changes option = - fun filter log -> - if - match_filter_address filter log.address - && match_filter_topics filter log.topics - then Some (Log log) - else None - -(* Apply a filter on one transaction *) -let filter_one_tx (module Rollup_node_rpc : Services_backend_sig.S) : - valid_filter -> hash -> filter_changes list option tzresult Lwt.t = - fun filter tx_hash -> - let open Lwt_result_syntax in - let* receipt = Rollup_node_rpc.transaction_receipt tx_hash in - match receipt with - | Some receipt -> - if Ethbloom.contains_bloom (hex_to_bytes receipt.logsBloom) filter.bloom - then return_some @@ List.filter_map (filter_one_log filter) receipt.logs - else return_none - | None -> tzfail (Receipt_not_found tx_hash) - -(* Apply a filter on one block *) -let filter_one_block (module Rollup_node_rpc : Services_backend_sig.S) : - valid_filter -> Z.t -> filter_changes list option tzresult Lwt.t = - fun filter block_number -> - let open Lwt_result_syntax in - let* block = - Rollup_node_rpc.nth_block ~full_transaction_object:false block_number - in - let indexed_transaction_hashes = - match block.transactions with - | TxHash l -> l - | TxFull _ -> - (* Impossible: - The block is requested without tx objects *) - assert false - in - if Ethbloom.contains_bloom (hex_to_bytes block.logsBloom) filter.bloom then - let+ changes = - List.filter_map_ep - (filter_one_tx (module Rollup_node_rpc) filter) - indexed_transaction_hashes - in - Some (List.concat changes) - else return_none - -(** [split_in_chunks ~chunk_size ~base ~length] returns a list of - lists (chunks) containing the consecutive numbers from [base] - to [base + length - 1]. - Each chunk is at most of length [chunk_size]. Only the last - chunk can be shorter than [chunk_size]. - - Example [split_in_chunks ~chunk_size:2 ~base:1 ~length:5] is - <<1, 2>, <3,4>, <5>>. - *) -let split_in_chunks ~chunk_size ~base ~length = - (* nb_chunks = ceil(length / chunk_size) *) - let nb_chunks = (length + chunk_size - 1) / chunk_size in - let rem = length mod chunk_size in - Stdlib.List.init nb_chunks (fun chunk -> - let chunk_length = - if chunk = nb_chunks - 1 && rem <> 0 then (* Last chunk isn't full *) - rem - else chunk_size - in - let chunk_offset = chunk * chunk_size in - Stdlib.List.init chunk_length (fun i -> - Z.(base + of_int chunk_offset + of_int i))) - -(* [get_logs (module Rollup_node_rpc) filter] applies the [filter]. - - It does so using a chunking mechanism: - Blocks to be filtered are split in chunks, which will be filtered - in sequence. Within each chunk, the block filtering is done - concurrently. - - This design is meant to strike a balance between concurrent - performace and not exceeding the bound in number of logs. -*) -let get_logs (log_filter_config : Configuration.log_filter_config) - (module Rollup_node_rpc : Services_backend_sig.S) filter = - let open Lwt_result_syntax in - let* filter = - validate_filter log_filter_config (module Rollup_node_rpc) filter - in - let (Qty from) = filter.from_block in - let (Qty to_) = filter.to_block in - let length = Z.(to_int (to_ - from)) + 1 in - let block_numbers = - split_in_chunks ~chunk_size:log_filter_config.chunk_size ~length ~base:from - in - let* logs, _n_logs = - List.fold_left_es - (function - | acc_logs, n_logs -> - fun chunk -> - (* Apply the filter to the entire chunk concurrently *) - let* new_logs = - Lwt_result.map List.concat - @@ List.filter_map_ep - (filter_one_block (module Rollup_node_rpc) filter) - chunk - in - let n_new_logs = List.length new_logs in - if n_logs + n_new_logs > log_filter_config.max_nb_logs then - tzfail (Too_many_logs {limit = log_filter_config.max_nb_logs}) - else return (acc_logs @ new_logs, n_logs + n_new_logs)) - ([], 0) - block_numbers - in - return logs - -(* Errors registration *) - -let () = - register_error_kind - `Permanent - ~id:"evm_node_prod_incompatible_block_params" - ~title:"Incompatible block parameters" - ~description: - "block_hash field cannot be set when from_block and to_block are set" - Data_encoding.(obj1 (req "incompatible_block_params" unit)) - (function Incompatible_block_params -> Some () | _ -> None) - (fun () -> Incompatible_block_params) ; - register_error_kind - `Permanent - ~id:"evm_node_prod_block_range_too_large" - ~title:"Block range is too large" - ~description:"Block_range is too large" - ~pp:(fun fmt limit -> - Format.fprintf fmt "Cannot request logs over more than %d blocks" limit) - Data_encoding.( - obj1 (req "block_range_too_large" (obj1 (req "limit" int31)))) - (function Block_range_too_large {limit} -> Some limit | _ -> None) - (fun limit -> Block_range_too_large {limit}) ; - register_error_kind - `Permanent - ~id:"evm_node_prod_topic_list_too_large" - ~title:"Topic list is too large" - ~description:"Topic_list is too large" - Data_encoding.(obj1 (req "topic_list_too_large" unit)) - (function Topic_list_too_large -> Some () | _ -> None) - (fun () -> Topic_list_too_large) ; - register_error_kind - `Permanent - ~id:"evm_node_prod_receipt_not_found" - ~title:"Receipt not found" - ~description:"Could not found requested receipt" - Data_encoding.(obj1 (req "receipt_not_found" Ethereum_types.hash_encoding)) - (function Receipt_not_found hash -> Some hash | _ -> None) - (fun hash -> Receipt_not_found hash) ; - register_error_kind - `Permanent - ~id:"evm_node_prod_too_many_logs" - ~title:"Too many logs" - ~description: - "Result would return too many logs. Request on a smaller block range" - ~pp:(fun fmt limit -> - Format.fprintf - fmt - "Result would return too many logs, current limit is %d" - limit) - Data_encoding.(obj1 (req "too_many_logs" (obj1 (req "limit" int31)))) - (function Too_many_logs {limit} -> Some limit | _ -> None) - (fun limit -> Too_many_logs {limit}) diff --git a/etherlink/bin_node/lib_prod/helpers.ml b/etherlink/bin_node/lib_prod/helpers.ml deleted file mode 100644 index 3914f21737a4da2f26316c1af93ef4c8fba14659..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/helpers.ml +++ /dev/null @@ -1,37 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -let now () = - let now = Ptime_clock.now () in - let now = Ptime.to_rfc3339 now in - Time.Protocol.of_notation_exn now - -let with_timing event k = - let open Lwt_syntax in - let start = Time.System.now () in - - let* res = k () in - - let stop = Time.System.now () in - let diff = Ptime.diff stop start in - let* () = event diff in - - return res - -let unwrap_error_monad f = - let open Lwt_syntax in - let* res = f () in - match res with - | Ok v -> return v - | Error errs -> - Lwt.fail_with (Format.asprintf "%a" Error_monad.pp_print_trace errs) - -let normalize_addr str = - let str = String.lowercase_ascii str in - match String.remove_prefix ~prefix:"0x" str with - | Some str -> str - | None -> str diff --git a/etherlink/bin_node/lib_prod/helpers.mli b/etherlink/bin_node/lib_prod/helpers.mli deleted file mode 100644 index 97b33c67c5f81a0b3bca4ac589998fa8dc39b4e5..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/helpers.mli +++ /dev/null @@ -1,21 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(** [now ()] returns the current time. *) -val now : unit -> Time.Protocol.t - -(** [with_timing event k] computes how much time [k ()] takes to be computed - and advertises it with [event]. *) -val with_timing : (Ptime.span -> unit Lwt.t) -> (unit -> 'a Lwt.t) -> 'a Lwt.t - -(** [unwrap_error_monad f] execute f and fails with a Failure when the - error monad returns an error. *) -val unwrap_error_monad : (unit -> 'a tzresult Lwt.t) -> 'a Lwt.t - -(** [normalize_addr addr] normalized an L2 address [addr], - i.e. lowercase it and remove prefix "0x". *) -val normalize_addr : string -> string diff --git a/etherlink/bin_node/lib_prod/kernel_config.ml b/etherlink/bin_node/lib_prod/kernel_config.ml deleted file mode 100644 index f0923abbdcd200fc2fe5b8459694bf14ee8290be..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/kernel_config.ml +++ /dev/null @@ -1,76 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -let make_instr ?(path_prefix = "/evm/") ?(convert = Fun.id) arg_opt = - arg_opt - |> Option.map (fun (key, value) -> - Installer_config.make ~key:(path_prefix ^ key) ~value:(convert value)) - |> Option.to_list - -let padded_32_le_int_bytes z = - String.of_bytes @@ Ethereum_types.encode_u256_le (Qty z) - -let parse_z_to_padded_32_le_int_bytes s = - let z = Z.of_string s in - padded_32_le_int_bytes z - -let make ~boostrap_balance ?bootstrap_accounts ?kernel_root_hash ?chain_id - ?sequencer ?delayed_bridge ?ticketer ?admin ?sequencer_governance - ?kernel_governance ?kernel_security_governance ?minimum_base_fee_per_gas - ?da_fee_per_byte ?delayed_inbox_timeout ?delayed_inbox_min_levels - ?sequencer_pool_address ?maximum_allowed_ticks ?maximum_gas_per_transaction - ?remove_whitelist ~output () = - let bootstrap_accounts = - match bootstrap_accounts with - | None -> [] - | Some bootstrap_accounts -> - let balance = padded_32_le_int_bytes boostrap_balance in - List.map - (fun address -> - make_instr - ~path_prefix:"/evm/world_state/eth_accounts/" - (Some (address ^ "/balance", balance))) - bootstrap_accounts - |> List.flatten - in - let le_int_bytes i = Z.of_string i |> Z.to_bits in - let le_int64_bytes i = - let b = Bytes.make 8 '\000' in - Bytes.set_int64_le b 0 (Int64.of_string i) ; - String.of_bytes b - in - let instrs = - make_instr - ~convert:(fun s -> Hex.to_bytes_exn (`Hex s) |> Bytes.to_string) - kernel_root_hash - @ make_instr ~convert:parse_z_to_padded_32_le_int_bytes chain_id - @ make_instr sequencer @ make_instr delayed_bridge @ make_instr ticketer - @ make_instr admin - @ make_instr sequencer_governance - @ make_instr kernel_governance - @ make_instr kernel_security_governance - @ make_instr - ~path_prefix:"/evm/world_state/fees/" - ~convert:parse_z_to_padded_32_le_int_bytes - minimum_base_fee_per_gas - @ make_instr - ~path_prefix:"/evm/world_state/fees/" - ~convert:parse_z_to_padded_32_le_int_bytes - da_fee_per_byte - @ make_instr ~convert:le_int_bytes delayed_inbox_timeout - @ make_instr ~convert:le_int_bytes delayed_inbox_min_levels - @ make_instr - ~convert:(fun addr -> - let addr = Helpers.normalize_addr addr in - Hex.to_bytes_exn (`Hex addr) |> String.of_bytes) - sequencer_pool_address - @ make_instr ~convert:le_int64_bytes maximum_allowed_ticks - @ make_instr ~convert:le_int64_bytes maximum_gas_per_transaction - @ bootstrap_accounts - @ make_instr remove_whitelist - in - Installer_config.to_file instrs ~output diff --git a/etherlink/bin_node/lib_prod/kernel_config.mli b/etherlink/bin_node/lib_prod/kernel_config.mli deleted file mode 100644 index d146d4a9fb4e561b6d8e13056d59981513dc48b6..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/kernel_config.mli +++ /dev/null @@ -1,33 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(** [make ~boostrap_balance ?bootstrap_accounts ... ~output ()] - generates a configuration file located at [output], where - [bootstrap_accounts] are provisioned with [bootstrap_balance]. *) -val make : - boostrap_balance:Ethereum_types.NonceMap.key -> - ?bootstrap_accounts:string list -> - ?kernel_root_hash:string * string -> - ?chain_id:string * string -> - ?sequencer:string * string -> - ?delayed_bridge:string * string -> - ?ticketer:string * string -> - ?admin:string * string -> - ?sequencer_governance:string * string -> - ?kernel_governance:string * string -> - ?kernel_security_governance:string * string -> - ?minimum_base_fee_per_gas:string * string -> - ?da_fee_per_byte:string * string -> - ?delayed_inbox_timeout:string * string -> - ?delayed_inbox_min_levels:string * string -> - ?sequencer_pool_address:string * string -> - ?maximum_allowed_ticks:string * string -> - ?maximum_gas_per_transaction:string * string -> - ?remove_whitelist:string * string -> - output:string -> - unit -> - unit tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/metrics.ml b/etherlink/bin_node/lib_prod/metrics.ml deleted file mode 100644 index b547d295a135fd79d86587bdc9e909e248b62703..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/metrics.ml +++ /dev/null @@ -1,79 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -open Prometheus - -(* The registry and the callback needs to be redefined because - Prometheus always use the {!CollectRegistry.default}. However, if - we use the default one, we link the metrics of the octez-node, the - solution is to create a new registry and implement the callback - that serves this new registry specifically. *) - -let registry = CollectorRegistry.create () - -module Cohttp (Server : Cohttp_lwt.S.Server) = struct - let callback _conn req _body = - let open Cohttp in - let open Lwt_syntax in - let uri = Request.uri req in - match (Request.meth req, Uri.path uri) with - | `GET, "/metrics" -> - let* data = CollectorRegistry.collect registry in - let body = - Fmt.to_to_string Prometheus_app.TextFormat_0_0_4.output data - in - let headers = - Header.init_with "Content-Type" "text/plain; version=0.0.4" - in - Server.respond_string ~status:`OK ~headers ~body () - | _ -> Server.respond_error ~status:`Bad_request ~body:"Bad request" () -end - -module Metrics_server = Cohttp (Cohttp_lwt_unix.Server) - -let namespace = Tezos_version.Octez_node_version.namespace - -let subsystem = "evm_node" - -module Chain = struct - type t = {head : Gauge.t; confirmed_head : Gauge.t} - - let init name = - let head = - Gauge.v_label - ~registry - ~label_name:"head" - ~help:"Level of the node's head" - ~namespace - ~subsystem - "head" - name - in - let confirmed_head = - Gauge.v_label - ~registry - ~label_name:"confirmed_head" - ~help:"Confirmed level (smart rollup node's head)" - ~namespace - ~subsystem - "confirmed_head" - name - in - {head; confirmed_head} -end - -type t = {chain : Chain.t} - -let metrics = - let name = "Etherlink" in - let chain = Chain.init name in - {chain} - -let set_level ~level = Gauge.set metrics.chain.head (Z.to_float level) - -let set_confirmed_level ~level = - Gauge.set metrics.chain.confirmed_head (Z.to_float level) diff --git a/etherlink/bin_node/lib_prod/node_error.ml b/etherlink/bin_node/lib_prod/node_error.ml deleted file mode 100644 index 6d17b09d1c04c1494fc85ace563e4e771cd4d723..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/node_error.ml +++ /dev/null @@ -1,64 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -let exit_code_when_diverge = 100 - -let exit_code_when_out_of_sync = 101 - -type error += - | Diverged of - (Z.t * Ethereum_types.block_hash * Ethereum_types.block_hash option) - | Out_of_sync of {level_expected : int32; level_received : int32} - -let () = - register_error_kind - `Permanent - ~id:"evm_node.prod.evm_event_follower.rollup_diverged" - ~title:"Sequencer diverged from rollup node." - ~description:"Sequencer diverged from rollup node." - ~pp:(fun ppf (level, expected_hash, found_hash) -> - Format.fprintf - ppf - "Evm node sequencer diverged from rollup node at blueprint %a, \ - expected hash %a%a." - Z.pp_print - level - Ethereum_types.pp_block_hash - expected_hash - Format.( - pp_print_option (fun fmt hash -> - fprintf fmt " (found hash: %a)" Ethereum_types.pp_block_hash hash)) - found_hash) - Data_encoding.( - obj3 - (req "blueprint_level" z) - (req "expected_hash" Ethereum_types.block_hash_encoding) - (opt "found_hash" Ethereum_types.block_hash_encoding)) - (function - | Diverged (level, expected_hash, found_hash) -> - Some (level, expected_hash, found_hash) - | _ -> None) - (fun (level, expected_hash, found_hash) -> - Diverged (level, expected_hash, found_hash)) ; - register_error_kind - `Permanent - ~id:"evm_node.prod.evm_event_follower.rollup_out_of_sync" - ~title:"Evm node out of sync with rollup node." - ~description:"Sequencer and the rollup node are out of sync." - ~pp:(fun ppf (expected, received) -> - Format.fprintf - ppf - "Evm node received finalized level %ld but was expected %ld." - expected - received) - Data_encoding.(obj2 (req "expected" int32) (req "received" int32)) - (function - | Out_of_sync {level_expected; level_received} -> - Some (level_expected, level_received) - | _ -> None) - (fun (level_expected, level_received) -> - Out_of_sync {level_expected; level_received}) diff --git a/etherlink/bin_node/lib_prod/observer.ml b/etherlink/bin_node/lib_prod/observer.ml deleted file mode 100644 index 923671a5f0c2b8858cbaa7d2fdd8a79e0fb4d83f..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/observer.ml +++ /dev/null @@ -1,323 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* Copyright (c) 2024 Functori *) -(* *) -(*****************************************************************************) - -open Ethereum_types - -module MakeBackend (Ctxt : sig - val evm_node_endpoint : Uri.t - - val keep_alive : bool - - val smart_rollup_address : Tezos_crypto.Hashed.Smart_rollup_address.t -end) : Services_backend_sig.Backend = struct - module Reader = struct - let read path = Evm_context.inspect path - end - - module TxEncoder = struct - type transactions = string list - - type messages = string list - - let encode_transactions ~smart_rollup_address:_ ~transactions = - let open Result_syntax in - let hashes = - List.map - (fun transaction -> - let tx_hash_str = Ethereum_types.hash_raw_tx transaction in - Ethereum_types.( - Hash Hex.(of_string tx_hash_str |> show |> hex_of_string))) - transactions - in - return (hashes, transactions) - end - - module Publisher = struct - type messages = TxEncoder.messages - - let check_response = - let open Rpc_encodings.JSONRPC in - let open Lwt_result_syntax in - function - | {value = Ok _; _} -> return_unit - | {value = Error {message; _}; _} -> - failwith "Send_raw_transaction failed with message \"%s\"" message - - let check_batched_response = - let open Services in - function - | Batch l -> List.iter_es check_response l - | Singleton r -> check_response r - - let send_raw_transaction_method txn = - let open Rpc_encodings in - let message = - Hex.of_string txn |> Hex.show |> Ethereum_types.hex_of_string - in - JSONRPC. - { - method_ = Send_raw_transaction.method_; - parameters = - Some - (Data_encoding.Json.construct - Send_raw_transaction.input_encoding - message); - id = None; - } - - let publish_messages ~timestamp:_ ~smart_rollup_address:_ ~messages = - let open Rollup_services in - let open Lwt_result_syntax in - let methods = List.map send_raw_transaction_method messages in - - let* response = - call_service - ~keep_alive:Ctxt.keep_alive - ~base:Ctxt.evm_node_endpoint - (Services.dispatch_service ~path:Resto.Path.root) - () - () - (Batch methods) - in - - let* () = check_batched_response response in - - return_unit - end - - module SimulatorBackend = struct - let simulate_and_read ~input = - let open Lwt_result_syntax in - let* raw_insights = Evm_context.execute_and_inspect input in - match raw_insights with - | [Some bytes] -> return bytes - | _ -> Error_monad.failwith "Invalid insights format" - end - - let smart_rollup_address = - Tezos_crypto.Hashed.Smart_rollup_address.to_string Ctxt.smart_rollup_address -end - -let on_new_blueprint next_blueprint_number - ({delayed_transactions; blueprint} : Blueprint_types.with_events) = - let open Lwt_result_syntax in - let (Qty level) = blueprint.number in - let (Qty number) = next_blueprint_number in - if Z.(equal level number) then - let events = - List.map - (fun delayed_transaction -> - Ethereum_types.Evm_events.New_delayed_transaction delayed_transaction) - delayed_transactions - in - let* () = Evm_context.apply_evm_events events in - let delayed_transactions = - List.map - (fun Ethereum_types.Delayed_transaction.{hash; _} -> hash) - delayed_transactions - in - Evm_context.apply_blueprint - blueprint.timestamp - blueprint.payload - delayed_transactions - else failwith "Received a blueprint with an unexpected number." - -module Make (Ctxt : sig - val evm_node_endpoint : Uri.t - - val keep_alive : bool - - val smart_rollup_address : Tezos_crypto.Hashed.Smart_rollup_address.t -end) : Services_backend_sig.S = - Services_backend_sig.Make (MakeBackend (Ctxt)) - -let callback_log server conn req body = - let open Cohttp in - let open Lwt_syntax in - let path = Request.uri req |> Uri.path in - if path = "/metrics" then - let* response = Metrics.Metrics_server.callback conn req body in - Lwt.return (`Response response) - else - let uri = req |> Request.uri |> Uri.to_string in - let meth = req |> Request.meth |> Code.string_of_method in - let* body_str = body |> Cohttp_lwt.Body.to_string in - let* () = Events.callback_log ~uri ~meth ~body:body_str in - Tezos_rpc_http_server.RPC_server.resto_callback - server - conn - req - (Cohttp_lwt.Body.of_string body_str) - -let observer_start - ({rpc_addr; rpc_port; cors_origins; cors_headers; max_active_connections; _} : - Configuration.t) ~directory = - let open Lwt_result_syntax in - let open Tezos_rpc_http_server in - let p2p_addr = P2p_addr.of_string_exn rpc_addr in - let host = Ipaddr.V6.to_string p2p_addr in - let node = `TCP (`Port rpc_port) in - let acl = RPC_server.Acl.allow_all in - let cors = - Resto_cohttp.Cors. - {allowed_headers = cors_headers; allowed_origins = cors_origins} - in - let server = - RPC_server.init_server - ~acl - ~cors - ~media_types:Media_type.all_media_types - directory - in - let*! () = - RPC_server.launch - ~max_active_connections - ~host - server - ~callback:(callback_log server) - node - in - let*! () = Events.is_ready ~rpc_addr ~rpc_port in - return server - -let install_finalizer_observer server = - let open Lwt_syntax in - Lwt_exit.register_clean_up_callback ~loc:__LOC__ @@ fun exit_status -> - let* () = Events.shutdown_node ~exit_status in - let* () = Tezos_rpc_http_server.RPC_server.shutdown server in - let* () = Events.shutdown_rpc_server ~private_:false in - Helpers.unwrap_error_monad @@ fun () -> - let open Lwt_result_syntax in - let* () = Tx_pool.shutdown () in - let* () = Evm_events_follower.shutdown () in - Evm_context.shutdown () - -let[@tailrec] rec main_loop ~first_connection ~evm_node_endpoint = - let open Lwt_result_syntax in - let* () = - when_ (not first_connection) @@ fun () -> - let delay = Random.float 2. in - let*! () = Events.retrying_connect ~endpoint:evm_node_endpoint ~delay in - let*! () = Lwt_unix.sleep delay in - return_unit - in - - let*! head = Evm_context.head_info () in - - let*! call_result = - Evm_services.monitor_blueprints - ~evm_node_endpoint - head.next_blueprint_number - in - - match call_result with - | Ok blueprints_stream -> - (stream_loop [@tailcall]) - ~evm_node_endpoint - head.next_blueprint_number - blueprints_stream - | Error _ -> - (main_loop [@tailcall]) ~first_connection:false ~evm_node_endpoint - -and[@tailrec] stream_loop ~evm_node_endpoint (Qty next_blueprint_number) stream - = - let open Lwt_result_syntax in - let*! candidate = Lwt_stream.get stream in - match candidate with - | Some blueprint -> - let* () = on_new_blueprint (Qty next_blueprint_number) blueprint in - let* _ = Tx_pool.pop_and_inject_transactions () in - (stream_loop [@tailcall]) - ~evm_node_endpoint - (Qty (Z.succ next_blueprint_number)) - stream - | None -> (main_loop [@tailcall]) ~first_connection:false ~evm_node_endpoint - -let main ?kernel_path ~data_dir ~(config : Configuration.t) () = - let open Lwt_result_syntax in - let rollup_node_endpoint = config.rollup_node_endpoint in - let*? { - evm_node_endpoint; - threshold_encryption_bundler_endpoint; - preimages; - preimages_endpoint; - _; - } = - Configuration.observer_config_exn config - in - let* smart_rollup_address = - Evm_services.get_smart_rollup_address ~evm_node_endpoint - in - let* _loaded = - Evm_context.start - ~data_dir - ?kernel_path - ~preimages - ~preimages_endpoint - ~smart_rollup_address: - (Tezos_crypto.Hashed.Smart_rollup_address.to_string - smart_rollup_address) - ~fail_on_missing_blueprint:false - () - in - - let observer_backend = - (module Make (struct - let smart_rollup_address = smart_rollup_address - - let keep_alive = config.keep_alive - - let evm_node_endpoint = - match threshold_encryption_bundler_endpoint with - | Some endpoint -> endpoint - | None -> evm_node_endpoint - end) : Services_backend_sig.S) - in - - let* () = - Tx_pool.start - { - rollup_node = observer_backend; - smart_rollup_address = - Tezos_crypto.Hashed.Smart_rollup_address.to_b58check - smart_rollup_address; - mode = Observer; - tx_timeout_limit = config.tx_pool_timeout_limit; - tx_pool_addr_limit = Int64.to_int config.tx_pool_addr_limit; - tx_pool_tx_per_addr_limit = - Int64.to_int config.tx_pool_tx_per_addr_limit; - max_number_of_chunks = None; - } - in - - let directory = - Services.directory config (observer_backend, smart_rollup_address) - in - let directory = directory |> Evm_services.register smart_rollup_address in - - let* server = observer_start config ~directory in - - let (_ : Lwt_exit.clean_up_callback_id) = install_finalizer_observer server in - let* () = - Evm_events_follower.start - { - rollup_node_endpoint; - keep_alive = config.keep_alive; - filter_event = - (function New_delayed_transaction _ -> false | _ -> true); - } - in - let () = - Rollup_node_follower.start - ~keep_alive:config.keep_alive - ~proxy:false - ~rollup_node_endpoint - () - in - - main_loop ~first_connection:true ~evm_node_endpoint diff --git a/etherlink/bin_node/lib_prod/observer.mli b/etherlink/bin_node/lib_prod/observer.mli deleted file mode 100644 index 2038a8204cff627bc2ba455d5bbd628b5a178b44..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/observer.mli +++ /dev/null @@ -1,16 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(** [main ?kernel_path ~rollup_node_endpoint ~evm_node_endpoint - ~data_dir ~config] starts the main event-loop of the Observer, - consuming the blueprints received from [evm_node_endpoint]. *) -val main : - ?kernel_path:string -> - data_dir:string -> - config:Configuration.t -> - unit -> - unit tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/proxy.ml b/etherlink/bin_node/lib_prod/proxy.ml deleted file mode 100644 index 53c17bd5cee2c0bca5b09abcf6be3f4dc2754f40..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/proxy.ml +++ /dev/null @@ -1,109 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023-2024 Functori *) -(* Copyright (c) 2023 Marigold *) -(* *) -(*****************************************************************************) - -let callback_log server conn req body = - let open Cohttp in - let open Lwt_syntax in - let uri = req |> Request.uri |> Uri.to_string in - let meth = req |> Request.meth |> Code.string_of_method in - let* body_str = body |> Cohttp_lwt.Body.to_string in - let* () = Events.callback_log ~uri ~meth ~body:body_str in - Tezos_rpc_http_server.RPC_server.resto_callback - server - conn - req - (Cohttp_lwt.Body.of_string body_str) - -let start - ({rpc_addr; rpc_port; cors_origins; cors_headers; max_active_connections; _} : - Configuration.t) ~directory = - let open Lwt_result_syntax in - let open Tezos_rpc_http_server in - let p2p_addr = P2p_addr.of_string_exn rpc_addr in - let host = Ipaddr.V6.to_string p2p_addr in - let node = `TCP (`Port rpc_port) in - let acl = RPC_server.Acl.allow_all in - let cors = - Resto_cohttp.Cors. - {allowed_headers = cors_headers; allowed_origins = cors_origins} - in - let server = - RPC_server.init_server - ~acl - ~cors - ~media_types:Media_type.all_media_types - directory - in - Lwt.catch - (fun () -> - let*! () = - RPC_server.launch - ~max_active_connections - ~host - server - ~callback:(callback_log server) - node - in - let*! () = Events.is_ready ~rpc_addr ~rpc_port in - return server) - (fun _ -> return server) - -let install_finalizer server = - let open Lwt_syntax in - Lwt_exit.register_clean_up_callback ~loc:__LOC__ @@ fun exit_status -> - let* () = Events.shutdown_node ~exit_status in - let* () = Tezos_rpc_http_server.RPC_server.shutdown server in - let* () = Events.shutdown_rpc_server ~private_:false in - Helpers.unwrap_error_monad @@ fun () -> - let open Lwt_result_syntax in - let* () = Tx_pool.shutdown () in - Evm_context.shutdown () - -let main ({keep_alive; rollup_node_endpoint; _} as config : Configuration.t) = - let open Lwt_result_syntax in - let* smart_rollup_address = - Rollup_services.smart_rollup_address - ~keep_alive:config.keep_alive - rollup_node_endpoint - in - let module Rollup_node_rpc = Rollup_node.Make (struct - let base = rollup_node_endpoint - - let keep_alive = keep_alive - - let smart_rollup_address = smart_rollup_address - end) in - let* () = - Tx_pool.start - { - rollup_node = (module Rollup_node_rpc); - smart_rollup_address; - mode = Proxy; - tx_timeout_limit = config.tx_pool_timeout_limit; - tx_pool_addr_limit = Int64.to_int config.tx_pool_addr_limit; - tx_pool_tx_per_addr_limit = - Int64.to_int config.tx_pool_tx_per_addr_limit; - max_number_of_chunks = None; - } - in - let () = - Rollup_node_follower.start - ~keep_alive:config.keep_alive - ~proxy:true - ~rollup_node_endpoint - () - in - let directory = - Services.directory config ((module Rollup_node_rpc), smart_rollup_address) - in - let* server = start config ~directory in - let (_ : Lwt_exit.clean_up_callback_id) = install_finalizer server in - let wait, _resolve = Lwt.wait () in - let* () = wait in - return_unit diff --git a/etherlink/bin_node/lib_prod/proxy.mli b/etherlink/bin_node/lib_prod/proxy.mli deleted file mode 100644 index 3dff990005b1d22d4c9bdb0a9837a8263e3794dc..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/proxy.mli +++ /dev/null @@ -1,12 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Functori *) -(* Copyright (c) 2023 Marigold *) -(* *) -(*****************************************************************************) - -(** [main config] starts the main event-loop of the proxy using - [config.rollup_node_endpoint]. *) -val main : Configuration.t -> unit tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/publisher.ml b/etherlink/bin_node/lib_prod/publisher.ml deleted file mode 100644 index 4bcb43c94766f9b292fca786054bf7d33e786552..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/publisher.ml +++ /dev/null @@ -1,49 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -open Ethereum_types - -module type TxEncoder = sig - (* Transactions to be encoded *) - type transactions = string list - - (* Encoded messages to be injected *) - type messages - - val encode_transactions : - smart_rollup_address:string -> - transactions:transactions -> - (hash list * messages) tzresult -end - -module type Publisher = sig - type messages - - val publish_messages : - timestamp:Time.Protocol.t -> - smart_rollup_address:string -> - messages:messages -> - unit tzresult Lwt.t -end - -module Make - (TxEncoder : TxEncoder) - (Publisher : Publisher with type messages = TxEncoder.messages) = -struct - let inject_raw_transactions ~timestamp ~smart_rollup_address ~transactions = - let open Lwt_result_syntax in - let*? tx_hashes, to_publish = - TxEncoder.encode_transactions ~smart_rollup_address ~transactions - in - let* () = - Publisher.publish_messages - ~timestamp - ~smart_rollup_address - ~messages:to_publish - in - return tx_hashes -end diff --git a/etherlink/bin_node/lib_prod/replay.ml b/etherlink/bin_node/lib_prod/replay.ml deleted file mode 100644 index 0258ee3e7af4601ba42bb37cdba5bf9c59d5e413..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/replay.ml +++ /dev/null @@ -1,66 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -let read_kernel_from_file kernel_path = - let open Lwt_result_syntax in - if Filename.(check_suffix kernel_path ".hex") then - let*! content = Repl_helpers.read_file kernel_path in - let*? content = - match Hex.to_string (`Hex content) with - | Some content -> Ok (content, true) - | None -> error_with "%S is not a valid hexadecimal file" kernel_path - in - return content - else - let*! content = Repl_helpers.read_file kernel_path in - let*? binary = - if Filename.check_suffix kernel_path ".wasm" then Ok true - else if Filename.check_suffix kernel_path ".wast" then Ok false - else error_with "Kernels should have .wasm or .wast file extension" - in - return (content, binary) - -let patch_kernel ~kernel_path evm_state = - let open Lwt_result_syntax in - let* content, binary = read_kernel_from_file kernel_path in - let*! kernel = - if binary then Lwt.return content else Wasm_utils.wat2wasm content - in - let*! evm_state = - Evm_state.modify ~key:"/kernel/boot.wasm" ~value:kernel evm_state - in - return evm_state - -let main ?profile ?kernel_path ~data_dir ~preimages ~preimages_endpoint - ~smart_rollup_address number = - let open Lwt_result_syntax in - let* _init = - Evm_context.start - ~data_dir - ~preimages - ~preimages_endpoint - ~fail_on_missing_blueprint:false - ~smart_rollup_address - () - in - let alter_evm_state = - match kernel_path with - | None -> None - | Some kernel_path -> Some (patch_kernel ~kernel_path) - in - let* apply_result = Evm_context.replay ?profile ?alter_evm_state number in - match apply_result with - | Apply_success (_, _, hash) -> - Format.printf - "Replaying blueprint %a led to block %a\n%!" - Ethereum_types.pp_quantity - number - Ethereum_types.pp_block_hash - hash ; - return_unit - | Apply_failure -> - failwith "Could not replay blueprint %a" Ethereum_types.pp_quantity number diff --git a/etherlink/bin_node/lib_prod/replay.mli b/etherlink/bin_node/lib_prod/replay.mli deleted file mode 100644 index 56ff35d12797d5bc72f2e574fff42f3ac519bcbd..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/replay.mli +++ /dev/null @@ -1,18 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(** [main ~data_dir ~preimages ~preimages_endpoint ~smart_rollup_address level] - replays the [level]th blueprint on top of the expected context. *) -val main : - ?profile:bool -> - ?kernel_path:string -> - data_dir:string -> - preimages:string -> - preimages_endpoint:Uri.t option -> - smart_rollup_address:string -> - Ethereum_types.quantity -> - unit tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/rollup_node.ml b/etherlink/bin_node/lib_prod/rollup_node.ml deleted file mode 100644 index 1b2ba55f15b9a0adb740ad04a3cfefafb464ee65..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/rollup_node.ml +++ /dev/null @@ -1,121 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Marigold *) -(* Copyright (c) 2023 Functori *) -(* Copyright (c) 2023 Trilitech *) -(* *) -(* 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 Rollup_services -open Transaction_format - -module MakeBackend (Base : sig - val base : Uri.t - - val keep_alive : bool - - val smart_rollup_address : string -end) : Services_backend_sig.Backend = struct - module Reader = struct - let read path = - call_service - ~keep_alive:Base.keep_alive - ~base:Base.base - durable_state_value - ((), Block_id.Head) - {key = path} - () - end - - module TxEncoder = struct - type transactions = string list - - type messages = string list - - let encode_transactions ~smart_rollup_address ~transactions = - let open Result_syntax in - let* rev_hashes, messages = - List.fold_left_e - (fun (tx_hashes, to_publish) tx_raw -> - let* tx_hash, messages = - make_encoded_messages ~smart_rollup_address tx_raw - in - return (tx_hash :: tx_hashes, to_publish @ messages)) - ([], []) - transactions - in - return (List.rev rev_hashes, messages) - end - - module Publisher = struct - type messages = TxEncoder.messages - - let publish_messages ~timestamp:_ ~smart_rollup_address:_ ~messages = - let open Lwt_result_syntax in - (* The injection's service returns a notion of L2 message ids (defined - by the rollup node) used to track the message's injection in the batcher. - We do not wish to follow the message's inclusion, and thus, ignore - the resulted ids. *) - let* _answer = - call_service - ~keep_alive:Base.keep_alive - ~base:Base.base - batcher_injection - () - () - messages - in - return_unit - end - - module SimulatorBackend = struct - let simulate_and_read ~input = - let open Lwt_result_syntax in - let* json = - call_service - ~keep_alive:Base.keep_alive - ~base:Base.base - simulation - () - () - input - in - let eval_result = - Data_encoding.Json.destruct Simulation.Encodings.eval_result json - in - match eval_result.insights with - | [data] -> return data - | _ -> failwith "Inconsistent simulation results" - end - - let smart_rollup_address = Base.smart_rollup_address -end - -module Make (Base : sig - val base : Uri.t - - val keep_alive : bool - - val smart_rollup_address : string -end) = - Services_backend_sig.Make (MakeBackend (Base)) diff --git a/etherlink/bin_node/lib_prod/rollup_node.mli b/etherlink/bin_node/lib_prod/rollup_node.mli deleted file mode 100644 index 51837b2f14ae1e767c72eada30820509907db87c..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/rollup_node.mli +++ /dev/null @@ -1,38 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Functori *) -(* Copyright (c) 2023 Marigold *) -(* *) -(* 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. *) -(* *) -(*****************************************************************************) - -(** Instantiate a module of type {!Services_backend_sig.S} that communicates with a rollup - node endpoint given by [Base.base]. *) -module Make : functor - (Base : sig - val base : Uri.t - - val keep_alive : bool - - val smart_rollup_address : string - end) - -> Services_backend_sig.S diff --git a/etherlink/bin_node/lib_prod/rollup_node_follower.ml b/etherlink/bin_node/lib_prod/rollup_node_follower.ml deleted file mode 100644 index 90a1fc8995cc14ed1e7b468d7c9ec458c5d4f1cd..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/rollup_node_follower.ml +++ /dev/null @@ -1,249 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -let read_from_rollup_node ~keep_alive path level rollup_node_endpoint = - let open Rollup_services in - call_service - ~keep_alive - ~base:rollup_node_endpoint - durable_state_value - ((), Block_id.Level level) - {key = path} - () - -let advertize_blueprints_publisher ~keep_alive rollup_node_endpoint - finalized_level = - let open Lwt_result_syntax in - let* finalized_current_number = - read_from_rollup_node - ~keep_alive - Durable_storage_path.Block.current_number - finalized_level - rollup_node_endpoint - in - match finalized_current_number with - | Some bytes -> - let (Qty evm_block_number) = Ethereum_types.decode_number bytes in - let* () = Blueprints_publisher.new_l2_head evm_block_number in - return_unit - | None -> return_unit - -let process_new_block ~keep_alive ~rollup_node_endpoint ~finalized_level () = - let open Lwt_result_syntax in - let* () = Evm_events_follower.new_rollup_block finalized_level in - let* () = - advertize_blueprints_publisher - ~keep_alive - rollup_node_endpoint - finalized_level - in - Tx_pool.pop_and_inject_transactions_lazy () - -type error += Connection_lost | Connection_timeout - -(** [process_finalized_level ~oldest_rollup_node_known_l1_level - ~finalized_level ~rollup_node_endpoint] process the rollup node - block level [finalized_level] iff it's known by the rollup node - (i.e. superior to [oldest_rollup_node_known_l1_level]. - - This is necessary for the very beginning of the rollup life, when - the evm node is started at the same moment at the origination of - the rollup, and so `finalized_level` is < origination level. *) -let process_finalized_level ~keep_alive ~oldest_rollup_node_known_l1_level - ~finalized_level ~rollup_node_endpoint () = - let open Lwt_result_syntax in - if oldest_rollup_node_known_l1_level <= finalized_level then - process_new_block ~keep_alive ~finalized_level ~rollup_node_endpoint () - else return_unit - -let reconnection_delay = 5.0 - -let min_timeout = 10. - -let timeout_factor = 10. - -type rollup_node_connection = { - close : unit -> unit; (** stream closing function *) - stream : Sc_rollup_block.t Lwt_stream.t; - (** current rollup node block stream *) - rollup_node_endpoint : Uri.t; (** endpoint used to reconnect to the node *) - timeout : Float.t; - (** expected time to receive a l2 block from the rollup node. is - recalculated at each received block. *) -} - -(** [timeout] is updated to reflect reality of how long we should with - the next block or assume the connection is failing/hanging. *) -let update_timeout ~elapsed ~connection = - let new_timeout = elapsed *. timeout_factor in - if new_timeout < min_timeout then connection - else {connection with timeout = new_timeout} - -let sleep_before_reconnection ~factor = - let open Lwt_syntax in - if factor = 0 then return_unit - else - (* randomised the sleep time to not DoS the rollup node if - multiple evm node are connected to the same rollup node *) - let fcount = float_of_int (factor - 1) in - (* Randomized exponential backoff capped to 1.5h: 1.5^count * delay ± 50% *) - let delay = reconnection_delay *. (1.5 ** fcount) in - let delay = min delay 3600. in - let randomization_factor = 0.5 (* 50% *) in - let delay = - delay - +. Random.float (delay *. 2. *. randomization_factor) - -. (delay *. randomization_factor) - in - let* () = Rollup_node_follower_events.trying_reconnection delay in - Lwt_unix.sleep delay - -(**[connect_to_stream ?count ~rollup_node_endpoint ()] try to connect - to the stream of rollup node block. If [count] is superior to [0] - then sleep some time with [sleep_before_reconnection] before trying - to reconnect. - - [count] is the number of time we tried to reconnect in a row. *) -let[@tailrec] rec connect_to_stream ?(count = 0) ~rollup_node_endpoint () = - let open Lwt_result_syntax in - let*! () = sleep_before_reconnection ~factor:count in - let*! res = Rollup_services.make_streamed_call ~rollup_node_endpoint in - match res with - | Ok (stream, close) -> - let*! () = Rollup_node_follower_events.connection_acquired () in - return {close; stream; rollup_node_endpoint; timeout = 300.} - | Error _e -> - (connect_to_stream [@tailcall]) - ~count:(count + 1) - ~rollup_node_endpoint - () - -(** [catchup_evm_event ~rollup_node_endpoint ~from ~to_] catchup on - evm events from [from] to [to_] from the rollup node. *) -let[@tailrec] rec catchup_evm_event ~rollup_node_endpoint ~from ~to_ = - let open Lwt_result_syntax in - if from = to_ then (*we are catch up *) return_unit - else if from > to_ then - failwith - "Internal error: The catchup of evm_event went too far, it should be \ - impossible." - else - (* reading event from [from] level then catching up from [from + - 1]. *) - let next_l1_level = Int32.succ from in - let* () = Evm_events_follower.new_rollup_block next_l1_level in - catchup_evm_event ~rollup_node_endpoint ~from:next_l1_level ~to_ - -(** [catchup_and_next_block ~proxy ~catchup_event ~connection] - returns the next block found in [connection.stream]. - - - If the connection drops then it tries to reconnect the stream - using [connect_to_stream]. - - - If the connection timeout (takes more than [connection.timeout]) - or if the connection fails then reconnect with [connect_to_stream] - and try to fetch [catchup_and_next_block] with that new stream.*) -let[@tailrec] rec catchup_and_next_block ~proxy ~catchup_event ~connection = - let open Lwt_result_syntax in - let get_promise () = - let*! res = Lwt_stream.get connection.stream in - match res with None -> tzfail Connection_lost | Some block -> return block - in - let timeout_promise timeout = - let*! () = Lwt_unix.sleep timeout in - tzfail Connection_timeout - in - let*! get_or_timeout = - Lwt.pick [get_promise (); timeout_promise connection.timeout] - in - match get_or_timeout with - | Ok block -> - let* () = - if catchup_event then - let* latest_known_l1_level = Evm_context.last_known_l1_level () in - match latest_known_l1_level with - | None -> - (* sequencer has no value to start from, it must be the - initial start. *) - let*! () = Evm_store_events.no_l1_latest_level_to_catch_up () in - return_unit - | Some from -> - let to_ = Sc_rollup_block.(Int32.(sub block.header.level 2l)) in - catchup_evm_event - ~rollup_node_endpoint:connection.rollup_node_endpoint - ~from - ~to_ - else return_unit - in - return (block, connection) - | Error [Connection_lost] | Error [Connection_timeout] -> - connection.close () ; - let* connection = - connect_to_stream - ~count:1 - ~rollup_node_endpoint:connection.rollup_node_endpoint - () - in - (catchup_and_next_block [@tailcall]) - ~proxy - ~catchup_event:(not proxy) - (* catchup event if not in proxy mode, proxy does not have - `evm_context` and would fail to fetch some data. Else - catchup possible missed event.*) - ~connection - | Error errs -> fail errs - -(** [loop_on_rollup_node_stream ~proxy - ~oldest_rollup_node_known_l1_level ~connection] main loop to - process the block. - - get the current rollup node block with [catchup_and_next_block], process it - with [process_finalized_level] then loop over. *) -let[@tailrec] rec loop_on_rollup_node_stream ~keep_alive ~catchup_event ~proxy - ~oldest_rollup_node_known_l1_level ~connection () = - let open Lwt_result_syntax in - let start_time = Unix.gettimeofday () in - let* block, connection = - catchup_and_next_block ~proxy ~catchup_event ~connection - in - let elapsed = Unix.gettimeofday () -. start_time in - let connection = update_timeout ~elapsed ~connection in - let finalized_level = Sc_rollup_block.(Int32.(sub block.header.level 2l)) in - let* () = - process_finalized_level - ~keep_alive - ~oldest_rollup_node_known_l1_level - ~rollup_node_endpoint:connection.rollup_node_endpoint - ~finalized_level - () - in - (loop_on_rollup_node_stream [@tailcall]) - ~keep_alive - ~catchup_event:false - ~proxy - ~oldest_rollup_node_known_l1_level - ~connection - () - -let start ~keep_alive ~proxy ~rollup_node_endpoint () = - Lwt.async @@ fun () -> - let open Lwt_syntax in - let* () = Rollup_node_follower_events.started () in - Helpers.unwrap_error_monad @@ fun () -> - let open Lwt_result_syntax in - let* oldest_rollup_node_known_l1_level = - Rollup_services.oldest_known_l1_level ~keep_alive rollup_node_endpoint - in - let* connection = connect_to_stream ~rollup_node_endpoint () in - loop_on_rollup_node_stream - ~keep_alive - (* when fetching first block it should try to catchup if needed *) - ~catchup_event:(not proxy) - ~proxy - ~oldest_rollup_node_known_l1_level - ~connection - () diff --git a/etherlink/bin_node/lib_prod/rollup_node_follower.mli b/etherlink/bin_node/lib_prod/rollup_node_follower.mli deleted file mode 100644 index 581120604fa308a1efb2ef1ddeb1ecdf79faf19c..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/rollup_node_follower.mli +++ /dev/null @@ -1,12 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(** [start ~keep_alive ~proxy ~rollup_node_endpoint ()] starts the - rollup node follower. In proxy mode does not try to catchup evm - event. *) -val start : - keep_alive:bool -> proxy:bool -> rollup_node_endpoint:Uri.t -> unit -> unit diff --git a/etherlink/bin_node/lib_prod/rollup_node_follower_events.ml b/etherlink/bin_node/lib_prod/rollup_node_follower_events.ml deleted file mode 100644 index 37252a65d355767d6a8250f177a43846c7a94de4..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/rollup_node_follower_events.ml +++ /dev/null @@ -1,74 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -module Event = struct - open Internal_event.Simple - - let section = Events.section - - let started = - declare_0 - ~section - ~name:"rollup_node_follower_started" - ~msg:"Rollup node follower has been started" - ~level:Notice - () - - let new_block = - declare_1 - ~section - ~name:"rollup_node_follower_new_block" - ~msg:"Rollup node follower detected a new block (level: {block})" - ~level:Info - ("block", Data_encoding.int32) - - let shutdown = - declare_0 - ~section - ~name:"shutting_down_rollup_node_follower" - ~msg:"Stopping the rollup node follower" - ~level:Notice - () - - let connection_acquired = - declare_0 - ~section - ~name:"rollup_node_follower_connection_acquired" - ~msg:"Rollup node follower connected to the rollup node" - ~level:Info - () - - let connection_lost = - declare_0 - ~section - ~name:"rollup_node_follower_connection_lost" - ~msg:"Connection with the rollup node has been lost" - ~level:Error - () - - let trying_reconnection = - declare_1 - ~section - ~name:"rollup_node_follower_trying_reconnection" - ~msg: - "Waiting {duration} sec before trying to reconnect to the rollup node" - ~level:Info - ("duration", Data_encoding.float) -end - -let started = Internal_event.Simple.emit Event.started - -let new_block level = Internal_event.Simple.emit Event.new_block level - -let shutdown = Internal_event.Simple.emit Event.shutdown - -let connection_lost = Internal_event.Simple.emit Event.connection_lost - -let trying_reconnection duration = - Internal_event.Simple.emit Event.trying_reconnection duration - -let connection_acquired = Internal_event.Simple.emit Event.connection_acquired diff --git a/etherlink/bin_node/lib_prod/rollup_node_storage.ml b/etherlink/bin_node/lib_prod/rollup_node_storage.ml deleted file mode 100644 index 4d39441a7ac90e63d7a2296335f6377478b0cfff..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/rollup_node_storage.ml +++ /dev/null @@ -1,113 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(* This module provides a subset of the rollup node storage. It could - be factorised with existing rollup node storage module if - needed/more used. *) - -module Last_finalized_level = Indexed_store.Make_singleton (struct - type t = int32 - - let name = "finalized_level" - - let encoding = Data_encoding.int32 -end) - -module Block_key = struct - include Block_hash - - let hash_size = 31 - - let t = - let open Repr in - map - (bytes_of (`Fixed hash_size)) - (fun b -> Block_hash.of_bytes_exn b) - (fun bh -> Block_hash.to_bytes bh) - - let encode bh = Block_hash.to_string bh - - let encoded_size = Block_hash.size - - let decode str off = - let str = String.sub str off encoded_size in - Block_hash.of_string_exn str - - let pp = Block_hash.pp -end - -module L2_blocks = - Indexed_store.Make_indexed_file - (struct - let name = "l2_blocks" - end) - (Block_key) - (struct - type t = (unit, unit) Sc_rollup_block.block - - let name = "sc_rollup_block_info" - - let encoding = - Sc_rollup_block.block_encoding Data_encoding.unit Data_encoding.unit - - module Header = struct - type t = Sc_rollup_block.header - - let name = "sc_rollup_block_header" - - let encoding = Sc_rollup_block.header_encoding - - let fixed_size = Sc_rollup_block.header_size - end - end) - -module Levels_to_hashes = - Indexed_store.Make_indexable - (struct - let name = "tezos_levels" - end) - (Indexed_store.Make_index_key (struct - type t = int32 - - let encoding = Data_encoding.int32 - - let name = "level" - - let fixed_size = 4 - - let equal = Int32.equal - end)) - (Block_key) - -(** [load ~rollup_node_data_dir] load the needed storage from the - rollup node: last_finalized_level, levels_to_hashes, and - l2_blocks. default [index_buffer_size] is [10_000] an - [cache_size] is [300_000]. They are the same value as for the - rollup node. *) -let load ?(index_buffer_size = 10_000) ?(cache_size = 300_000) - ~rollup_node_data_dir () = - let open Lwt_result_syntax in - let store = Filename.Infix.(rollup_node_data_dir // "storage") in - let* last_finalized_level = - Last_finalized_level.load - Read_only - ~path:(Filename.concat store "last_finalized_level") - in - let* levels_to_hashes = - Levels_to_hashes.load - Read_only - ~index_buffer_size - ~path:(Filename.concat store "levels_to_hashes") - in - let* l2_blocks = - L2_blocks.load - Read_only - ~index_buffer_size - ~cache_size - ~path:(Filename.concat store "l2_blocks") - in - return (last_finalized_level, levels_to_hashes, l2_blocks) diff --git a/etherlink/bin_node/lib_prod/rollup_services.ml b/etherlink/bin_node/lib_prod/rollup_services.ml deleted file mode 100644 index 219af6787fc3140d8a6b2947cead083456afb361..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/rollup_services.ml +++ /dev/null @@ -1,337 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Marigold *) -(* Copyright (c) 2023 Functori *) -(* Copyright (c) 2023 Trilitech *) -(* *) -(*****************************************************************************) - -(* TODO: https://gitlab.com/tezos/tezos/-/issues/6953 - - Make the sequencer node resilient to rollup node disconnect. - - RPC failures makes the sequencer stop or maybe fails to parse - specific element. -*) - -open Tezos_rpc -open Path - -type error += Lost_connection - -let () = - let description = - "The EVM node is no longer able to communicate with the rollup node, the \ - communication was lost" - in - register_error_kind - `Temporary - ~id:"evm_node_prod_lost_connection" - ~title:"Lost connection with rollup node" - ~description - ~pp:(fun ppf () -> Format.fprintf ppf "%s" description) - Data_encoding.unit - (function Lost_connection -> Some () | _ -> None) - (fun () -> Lost_connection) - -let is_connection_error trace = - TzTrace.fold - (fun yes error -> - yes - || - match error with - | RPC_client_errors.(Request_failed {error = Connection_failed _; _}) -> - true - | _ -> false) - false - trace - -let smart_rollup_address : - ([`GET], unit, unit, unit, unit, bytes) Service.service = - Service.get_service - ~description:"Smart rollup address" - ~query:Query.empty - ~output:(Data_encoding.Fixed.bytes 20) - (open_root / "global" / "smart_rollup_address") - -let gc_info_encoding = - Data_encoding.( - obj3 - (req "last_gc_level" int32) - (req "first_available_level" int32) - (opt "last_context_split_level" int32)) - -let gc_info : - ( [`GET], - unit, - unit, - unit, - unit, - int32 * int32 * int32 option ) - Service.service = - Service.get_service - ~description:"Smart rollup address" - ~query:Query.empty - ~output:gc_info_encoding - (open_root / "local" / "gc_info") - -type state_value_query = {key : string} - -module Block_id = struct - type t = Head | Level of Int32.t - - let construct = function - | Head -> "head" - | Level level -> Int32.to_string level - - let destruct id = - match id with - | "head" -> Ok Head - | n -> ( - match Int32.of_string_opt n with - | Some n -> Ok (Level n) - | None -> Error "Cannot parse block id") - - let arg : t Tezos_rpc.Arg.t = - Tezos_rpc.Arg.make - ~descr:"An L1 block identifier." - ~name:"block_id" - ~construct - ~destruct - () -end - -let state_value_query : state_value_query Tezos_rpc.Query.t = - let open Tezos_rpc.Query in - query (fun key -> {key}) - |+ field "key" Tezos_rpc.Arg.string "" (fun t -> t.key) - |> seal - -let durable_state_value : - ( [`GET], - unit, - unit * Block_id.t, - state_value_query, - unit, - bytes option ) - Service.service = - Tezos_rpc.Service.get_service - ~description: - "Retrieve value by key from PVM durable storage. PVM state is taken with \ - respect to the specified block level. Value returned in hex format." - ~query:state_value_query - ~output:Data_encoding.(option bytes) - (open_root / "global" / "block" /: Block_id.arg / "durable" / "wasm_2_0_0" - / "value") - -let batcher_injection : - ([`POST], unit, unit, unit, string trace, string trace) Service.service = - Tezos_rpc.Service.post_service - ~description:"Inject messages in the batcher's queue" - ~query:Tezos_rpc.Query.empty - ~input: - Data_encoding.( - def "messages" ~description:"Messages to inject" (list (string' Hex))) - ~output: - Data_encoding.( - def - "message_ids" - ~description:"Ids of injected L2 messages" - (list string)) - (open_root / "local" / "batcher" / "injection") - -let simulation : - ( [`POST], - unit, - unit, - unit, - Simulation.Encodings.simulate_input, - Data_encoding.json ) - Service.service = - Tezos_rpc.Service.post_service - ~description: - "Simulate messages evaluation by the PVM, and find result in durable \ - storage" - ~query:Tezos_rpc.Query.empty - ~input:Simulation.Encodings.simulate_input - ~output:Data_encoding.Json.encoding - (open_root / "global" / "block" / "head" / "simulate") - -let global_block_watcher : - ([`GET], unit, unit, unit, unit, Sc_rollup_block.t) Service.service = - Tezos_rpc.Service.get_service - ~description:"Monitor and streaming the L2 blocks" - ~query:Tezos_rpc.Query.empty - ~output:Sc_rollup_block.encoding - (open_root / "global" / "monitor_blocks") - -let global_current_tezos_level : - ([`GET], unit, unit, unit, unit, int32 option) Service.service = - Tezos_rpc.Service.get_service - ~description:"Current tezos level of the rollup node" - ~query:Tezos_rpc.Query.empty - ~output:Data_encoding.(option int32) - (open_root / "global" / "tezos_level") - -let rpc_timeout = 300. - -(** [retry_connection f] retries the connection using [f]. If an error - happens in [f] and it has lost the connection, the rpc is - retried *) -let retry_connection (f : Uri.t -> 'a tzresult Lwt.t) endpoint : - 'a tzresult Lwt.t = - let open Lwt_result_syntax in - let rec retry ~delay () = - let*! result = f endpoint in - match result with - | Error err when is_connection_error err -> - let*! () = Events.retrying_connect ~endpoint ~delay in - let*! () = Lwt_unix.sleep delay in - let next_delay = delay *. 2. in - let delay = Float.min next_delay 30. in - retry ~delay () - | res -> Lwt.return res - in - retry ~delay:1. () - -let call_service ~base ?(media_types = Media_type.all_media_types) rpc b c input - = - let open Lwt_result_syntax in - let*! res = - Tezos_rpc_http_client_unix.RPC_client_unix.call_service - media_types - ~base - rpc - b - c - input - in - match res with - | Ok res -> return res - | Error trace when is_connection_error trace -> fail (Lost_connection :: trace) - | Error trace -> fail trace - -let call_service ~keep_alive ~base ?media_types rpc b c input = - let f base = call_service ~base ?media_types rpc b c input in - if keep_alive then retry_connection f base else f base - -let make_streamed_call ~rollup_node_endpoint = - let open Lwt_result_syntax in - let stream, push = Lwt_stream.create () in - let on_chunk v = push (Some v) and on_close () = push None in - let* spill_all = - Tezos_rpc_http_client_unix.RPC_client_unix.call_streamed_service - [Media_type.json] - ~base:rollup_node_endpoint - global_block_watcher - ~on_chunk - ~on_close - () - () - () - in - let close () = - spill_all () ; - if Lwt_stream.is_closed stream then () else on_close () - in - return (stream, close) - -let publish : - keep_alive:bool -> - rollup_node_endpoint:Uri.t -> - [< `External of string] list -> - unit tzresult Lwt.t = - fun ~keep_alive ~rollup_node_endpoint inputs -> - let open Lwt_result_syntax in - let inputs = List.map (function `External s -> s) inputs in - let* _answer = - call_service - ~keep_alive - ~base:rollup_node_endpoint - batcher_injection - () - () - inputs - in - return_unit - -let durable_state_subkeys : - ( [`GET], - unit, - unit * Block_id.t, - state_value_query, - unit, - string list option ) - Service.service = - Tezos_rpc.Service.get_service - ~description: - "Retrieve subkeys by key from PVM durable storage. PVM state is taken \ - with respect to the specified block level. Value returned in hex \ - format." - ~query:state_value_query - ~output:Data_encoding.(option (list string)) - (open_root / "global" / "block" /: Block_id.arg / "durable" / "wasm_2_0_0" - / "subkeys") - -(** [smart_rollup_address base] asks for the smart rollup node's - address, using the endpoint [base]. *) -let smart_rollup_address ~keep_alive base = - let open Lwt_result_syntax in - let*! answer = - call_service - ~keep_alive - ~base - ~media_types:[Media_type.octet_stream] - smart_rollup_address - () - () - () - in - match answer with - | Ok address -> return (Bytes.to_string address) - | Error trace -> fail trace - -let oldest_known_l1_level ~keep_alive base = - let open Lwt_result_syntax in - let*! answer = - call_service - ~keep_alive - ~base - ~media_types:[Media_type.octet_stream] - gc_info - () - () - () - in - match answer with - | Ok (_last_gc_level, first_available_level, _last_context_split) -> - return first_available_level - | Error trace -> fail trace - -(** [tezos_level base] asks for the smart rollup node's - latest l1 level, using the endpoint [base]. *) -let tezos_level ~keep_alive base = - let open Lwt_result_syntax in - let* level_opt = - call_service - ~keep_alive - ~base - ~media_types:[Media_type.octet_stream] - global_current_tezos_level - () - () - () - in - let*? level = - Option.to_result - ~none: - [ - error_of_fmt - "Rollup node is not yet bootstrapped, please wait for the rollup \ - to process an initial block. "; - ] - level_opt - in - return level diff --git a/etherlink/bin_node/lib_prod/rpc_encodings.ml b/etherlink/bin_node/lib_prod/rpc_encodings.ml deleted file mode 100644 index 9be59bbddc8a38c4a1a43cf8b594794e8b3ffd95..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/rpc_encodings.ml +++ /dev/null @@ -1,756 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Functori *) -(* *) -(* 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. *) -(* *) -(*****************************************************************************) - -(** Encodings for the JSON-RPC standard. See - https://www.jsonrpc.org/specification. -*) -module JSONRPC = struct - let version = "2.0" - - (** Ids in the JSON-RPC specification can be either a string, a number or NULL - (which is represented by the option type). *) - type id_repr = Id_string of string | Id_float of float - - let id_repr_encoding = - let open Data_encoding in - union - [ - case - ~title:"id-string" - (Tag 0) - string - (function Id_string s -> Some s | _ -> None) - (fun s -> Id_string s); - case - ~title:"id-int" - (Tag 1) - float - (function Id_float i -> Some i | _ -> None) - (fun i -> Id_float i); - ] - - type id = id_repr option - - type request = { - method_ : string; - parameters : Data_encoding.json option; - id : id; - } - - let request_encoding = - Data_encoding.( - conv - (fun {parameters; id; method_; _} -> ((), method_, parameters, id)) - (fun ((), method_, parameters, id) -> {method_; parameters; id}) - (obj4 - (req "jsonrpc" (constant version)) - (req "method" string) - (opt "params" Data_encoding.json) - (opt "id" id_repr_encoding))) - - type 'data error = {code : int; message : string; data : 'data option} - - let error_encoding data_encoding = - Data_encoding.( - conv - (fun {code; message; data} -> (code, message, data)) - (fun (code, message, data) -> {code; message; data}) - (obj3 - (req "code" int31) - (req "message" string) - (opt "data" data_encoding))) - - type value = (Data_encoding.json, Data_encoding.json error) result - - type response = {value : value; id : id} - - let response_encoding = - Data_encoding.( - conv - (fun {value; id} -> - let result, error = - match value with Ok r -> (Some r, None) | Error e -> (None, Some e) - in - ((), result, error, id)) - (fun ((), result, error, id) -> - let value = - match (result, error) with - | Some r, None -> Ok r - | None, Some e -> Error e - | _ -> assert false - (* Impossible case according to the JSON-RPC standard: result XOR - error. *) - in - {value; id}) - (obj4 - (req "jsonrpc" (constant version)) - (opt "result" Data_encoding.json) - (opt "error" (error_encoding Data_encoding.json)) - (req "id" (option id_repr_encoding)))) -end - -module Error = struct - type t = unit - - let encoding = Data_encoding.unit -end - -type 'result rpc_result = ('result, Error.t JSONRPC.error) result - -type ('input, 'output) method_ = .. - -module type METHOD = sig - val method_ : string - - type input - - type output - - val input_encoding : input Data_encoding.t - - val output_encoding : output Data_encoding.t - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Kernel_version = struct - type input = unit - - type output = string - - let input_encoding = Data_encoding.unit - - let output_encoding = Data_encoding.string - - let method_ = "tez_kernelVersion" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Kernel_root_hash = struct - type input = unit - - type output = string option - - let input_encoding = Data_encoding.unit - - let output_encoding = Data_encoding.(option (string' Hex)) - - let method_ = "tez_kernelRootHash" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Network_id = struct - type input = unit - - type output = string - - let input_encoding = Data_encoding.unit - - let output_encoding = Data_encoding.string - - let method_ = "net_version" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Chain_id = struct - type input = unit - - type output = Ethereum_types.quantity - - let input_encoding = Data_encoding.unit - - let output_encoding = Ethereum_types.quantity_encoding - - let method_ = "eth_chainId" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Accounts = struct - type input = unit - - type output = Ethereum_types.address list - - let input_encoding = Data_encoding.unit - - let output_encoding = Data_encoding.list Ethereum_types.address_encoding - - let method_ = "eth_accounts" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_balance = struct - open Ethereum_types - - type input = address * block_param - - type output = quantity - - let input_encoding = Data_encoding.tup2 address_encoding block_param_encoding - - let output_encoding = quantity_encoding - - let method_ = "eth_getBalance" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_storage_at = struct - open Ethereum_types - - type input = address * quantity * block_param - - type output = hex - - let input_encoding = - Data_encoding.tup3 address_encoding quantity_encoding block_param_encoding - - let output_encoding = hex_encoding - - let method_ = "eth_getStorageAt" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Block_number = struct - open Ethereum_types - - type input = unit - - type output = quantity - - let input_encoding = Data_encoding.unit - - let output_encoding = quantity_encoding - - let method_ = "eth_blockNumber" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_block_by_number = struct - open Ethereum_types - - type input = block_param * bool - - type output = block - - let input_encoding = - Data_encoding.tup2 block_param_encoding Data_encoding.bool - - let output_encoding = block_encoding - - let method_ = "eth_getBlockByNumber" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_block_by_hash = struct - open Ethereum_types - - type input = block_hash * bool - - type output = block - - let input_encoding = Data_encoding.tup2 block_hash_encoding Data_encoding.bool - - let output_encoding = block_encoding - - let method_ = "eth_getBlockByHash" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_code = struct - open Ethereum_types - - type input = address * block_param - - type output = hex - - let input_encoding = Data_encoding.tup2 address_encoding block_param_encoding - - let output_encoding = hex_encoding - - let method_ = "eth_getCode" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Gas_price = struct - open Ethereum_types - - type input = unit - - type output = quantity - - let input_encoding = Data_encoding.unit - - let output_encoding = quantity_encoding - - let method_ = "eth_gasPrice" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_transaction_count = struct - open Ethereum_types - - type input = address * block_param - - type output = quantity - - let input_encoding = Data_encoding.tup2 address_encoding block_param_encoding - - let output_encoding = quantity_encoding - - let method_ = "eth_getTransactionCount" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_block_transaction_count_by_hash = struct - open Ethereum_types - - type input = block_hash - - type output = quantity - - let input_encoding = Data_encoding.tup1 block_hash_encoding - - let output_encoding = quantity_encoding - - let method_ = "eth_getBlockTransactionCountByHash" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_block_transaction_count_by_number = struct - open Ethereum_types - - type input = block_param - - type output = quantity - - let input_encoding = Data_encoding.tup1 block_param_encoding - - let output_encoding = quantity_encoding - - let method_ = "eth_getBlockTransactionCountByNumber" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_uncle_count_by_block_hash = struct - open Ethereum_types - - type input = block_hash - - type output = quantity - - let input_encoding = Data_encoding.tup1 block_hash_encoding - - let output_encoding = quantity_encoding - - let method_ = "eth_getUncleCountByBlockHash" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_uncle_count_by_block_number = struct - open Ethereum_types - - type input = block_param - - type output = quantity - - let input_encoding = Data_encoding.tup1 block_param_encoding - - let output_encoding = quantity_encoding - - let method_ = "eth_getUncleCountByBlockNumber" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_transaction_receipt = struct - open Ethereum_types - - type input = hash - - type output = transaction_receipt option - - let input_encoding = Data_encoding.tup1 hash_encoding - - let output_encoding = Data_encoding.option transaction_receipt_encoding - - let method_ = "eth_getTransactionReceipt" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_transaction_by_hash = struct - open Ethereum_types - - type input = hash - - type output = transaction_object option - - let input_encoding = Data_encoding.tup1 hash_encoding - - let output_encoding = Data_encoding.option transaction_object_encoding - - let method_ = "eth_getTransactionByHash" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_transaction_by_block_hash_and_index = struct - open Ethereum_types - - type input = block_hash * quantity - - type output = transaction_object option - - let input_encoding = Data_encoding.tup2 block_hash_encoding quantity_encoding - - let output_encoding = Data_encoding.option transaction_object_encoding - - let method_ = "eth_getTransactionByBlockHashAndIndex" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_transaction_by_block_number_and_index = struct - open Ethereum_types - - type input = block_param * quantity - - type output = transaction_object option - - let input_encoding = Data_encoding.tup2 block_param_encoding quantity_encoding - - let output_encoding = Data_encoding.option transaction_object_encoding - - let method_ = "eth_getTransactionByBlockNumberAndIndex" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_uncle_by_block_hash_and_index = struct - open Ethereum_types - - type input = block_hash * quantity - - type output = block option - - let input_encoding = Data_encoding.tup2 block_hash_encoding quantity_encoding - - let output_encoding = Data_encoding.option block_encoding - - let method_ = "eth_getUncleByBlockHashAndIndex" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_uncle_by_block_number_and_index = struct - open Ethereum_types - - type input = block_param * quantity - - type output = block option - - let input_encoding = Data_encoding.tup2 block_param_encoding quantity_encoding - - let output_encoding = Data_encoding.option block_encoding - - let method_ = "eth_getUncleByBlockNumberAndIndex" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Send_raw_transaction = struct - open Ethereum_types - - type input = hex - - type output = hash - - let input_encoding = Data_encoding.tup1 hex_encoding - - let output_encoding = hash_encoding - - let method_ = "eth_sendRawTransaction" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Send_transaction = struct - open Ethereum_types - - type input = transaction - - type output = hash - - let input_encoding = transaction_encoding - - let output_encoding = hash_encoding - - let method_ = "eth_sendTransaction" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Eth_call = struct - open Ethereum_types - - type input = call * block_param - - type output = hash - - let input_encoding = - let open Data_encoding in - union - [ - case - ~title:"full_parameters" - (Tag 0) - (tup2 call_encoding block_param_encoding) - (fun (call, block_param) -> Some (call, block_param)) - (fun (call, block_param) -> (call, block_param)); - (* eth-cli doesn't put the block parameter. *) - case - ~title:"only_call_parameter" - (Tag 1) - (tup1 call_encoding) - (fun (call, _) -> Some call) - (fun call -> (call, Latest)); - ] - - let output_encoding = hash_encoding - - let method_ = "eth_call" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_estimate_gas = struct - open Ethereum_types - - type input = call * block_param - - type output = quantity - - let input_encoding = - let open Data_encoding in - union - [ - case - ~title:"full_parameters" - (Tag 0) - (tup2 call_encoding block_param_encoding) - (fun (call, block_param) -> Some (call, block_param)) - (fun (call, block_param) -> (call, block_param)); - (* eth-cli doesn't put the block parameter. *) - case - ~title:"only_call_parameter" - (Tag 1) - (tup1 call_encoding) - (fun (call, _) -> Some call) - (fun call -> (call, Latest)); - ] - - let output_encoding = quantity_encoding - - let method_ = "eth_estimateGas" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Txpool_content = struct - open Ethereum_types - - type input = unit - - type output = txpool - - let input_encoding = Data_encoding.unit - - let output_encoding = txpool_encoding - - let method_ = "txpool_content" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Web3_clientVersion = struct - type input = unit - - type output = string - - let input_encoding = Data_encoding.unit - - let output_encoding = Data_encoding.string - - let method_ = "web3_clientVersion" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Web3_sha3 = struct - open Ethereum_types - - type input = hex - - type output = hash - - let input_encoding = Data_encoding.tup1 hex_encoding - - let output_encoding = hash_encoding - - let method_ = "web3_sha3" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Get_logs = struct - open Ethereum_types - - type input = filter - - type output = filter_changes list - - let input_encoding = Data_encoding.tup1 filter_encoding - - let output_encoding = Data_encoding.list filter_changes_encoding - - let method_ = "eth_getLogs" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Produce_block = struct - type input = Time.Protocol.t - - type output = Ethereum_types.quantity - - let input_encoding = Time.Protocol.encoding - - let output_encoding = Ethereum_types.quantity_encoding - - let method_ = "produceBlock" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Durable_state_value = struct - type input = Durable_storage_path.path - - type output = Bytes.t option - - let input_encoding = Data_encoding.string - - let output_encoding = Data_encoding.(option bytes) - - let method_ = "stateValue" - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -type map_result = - | Method : - ('input, 'output) method_ - * (module METHOD with type input = 'input and type output = 'output) - -> map_result - | Unsupported - | Unknown - -let supported_methods : (module METHOD) list = - [ - (module Kernel_version); - (module Kernel_root_hash); - (module Network_id); - (module Chain_id); - (module Accounts); - (module Get_balance); - (module Get_storage_at); - (module Block_number); - (module Get_block_by_number); - (module Get_block_by_hash); - (module Get_code); - (module Gas_price); - (module Get_transaction_count); - (module Get_block_transaction_count_by_hash); - (module Get_block_transaction_count_by_number); - (module Get_logs); - (module Get_uncle_count_by_block_hash); - (module Get_uncle_count_by_block_number); - (module Get_transaction_receipt); - (module Get_transaction_by_hash); - (module Get_transaction_by_block_hash_and_index); - (module Get_transaction_by_block_number_and_index); - (module Get_uncle_by_block_hash_and_index); - (module Get_uncle_by_block_number_and_index); - (module Send_transaction); - (module Send_raw_transaction); - (module Eth_call); - (module Get_estimate_gas); - (module Txpool_content); - (module Web3_clientVersion); - (module Web3_sha3); - (module Produce_block); - (module Durable_state_value); - ] - -let unsupported_methods : string list = - [ - "net_listening"; - "net_peerCount"; - "eth_protocolVersion"; - "eth_syncing"; - "eth_coinbase"; - "eth_mining"; - "eth_hashrate"; - "eth_accounts"; - "eth_sign"; - "eth_signTransaction"; - "eth_sendTransaction"; - ] - -let map_method_name method_name = - match - List.find - (fun (module M : METHOD) -> M.method_ = method_name) - supported_methods - with - | Some (module M) -> Method (M.Method, (module M)) - | None -> - if List.mem ~equal:( = ) method_name unsupported_methods then Unsupported - else Unknown diff --git a/etherlink/bin_node/lib_prod/rpc_encodings.mli b/etherlink/bin_node/lib_prod/rpc_encodings.mli deleted file mode 100644 index 1eb9d47a957299aba615dc6b71f353c80057dae4..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/rpc_encodings.mli +++ /dev/null @@ -1,276 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Functori *) -(* *) -(* 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. *) -(* *) -(*****************************************************************************) - -(** Encodings for the JSON-RPC standard. See - https://www.jsonrpc.org/specification. -*) -module JSONRPC : sig - (** Constant being `2.0`. *) - val version : string - - (** Ids in the JSON-RPC specification can be either a string, a number or NULL - (which is represented by the option type). Note that MetaMask uses ids - that only fit in 64 bits, which is not supported by Data_encoding. *) - type id_repr = Id_string of string | Id_float of float - - val id_repr_encoding : id_repr Data_encoding.t - - type id = id_repr option - - (** JSON-RPC Request object: - {@js[ - { "jsonrpc" : "2.0", - "method": , - "params": , //optional - "id": //optional - } - ]} - *) - type request = { - method_ : string; - parameters : Data_encoding.json option; (** `params` is optional. *) - id : id; (** `id` is optional. *) - } - - val request_encoding : request Data_encoding.t - - (** JSON-RPC Error representation. - {@js[ - { "code" : , - "message": , - "data": - } - ]} - *) - type 'data error = {code : int; message : string; data : 'data option} - - val error_encoding : 'a Data_encoding.t -> 'a error Data_encoding.t - - type value = (Data_encoding.json, Data_encoding.json error) result - - (** JSON-RPC Response object: - {@js[ - { "jsonrpc": "2.0", - "result": , - "error": , - "id": - } - ]} - - Note that `result` and `error` cannot appear at the same time, hence the - choice of using the result type as representation. *) - type response = {value : value; id : id} - - val response_encoding : response Data_encoding.t -end - -(* Errors returned by the RPC server, to be embedded as data to the JSON-RPC - error object. *) -module Error : sig - type t = unit - - val encoding : unit Data_encoding.t -end - -type 'result rpc_result = ('result, Error.t JSONRPC.error) result - -type ('input, 'output) method_ = .. - -(** API of an Ethereum method. *) -module type METHOD = sig - (** Method name in the specification. *) - val method_ : string - - (** Type of expected input, if any. *) - type input - - (** Type of the value returned by the RPC. *) - type output - - val input_encoding : input Data_encoding.t - - val output_encoding : output Data_encoding.t - - type ('input, 'output) method_ += Method : (input, output) method_ -end - -module Kernel_version : METHOD with type input = unit and type output = string - -module Kernel_root_hash : - METHOD with type input = unit and type output = string option - -module Network_id : METHOD with type input = unit and type output = string - -module Chain_id : - METHOD with type input = unit and type output = Ethereum_types.quantity - -module Accounts : - METHOD with type input = unit and type output = Ethereum_types.address list - -module Get_balance : - METHOD - with type input = Ethereum_types.address * Ethereum_types.block_param - and type output = Ethereum_types.quantity - -module Get_storage_at : - METHOD - with type input = - Ethereum_types.address - * Ethereum_types.quantity - * Ethereum_types.block_param - and type output = Ethereum_types.hex - -module Block_number : - METHOD with type input = unit and type output = Ethereum_types.quantity - -module Get_block_by_number : - METHOD - with type input = Ethereum_types.block_param * bool - and type output = Ethereum_types.block - -module Get_block_by_hash : - METHOD - with type input = Ethereum_types.block_hash * bool - and type output = Ethereum_types.block - -module Get_code : - METHOD - with type input = Ethereum_types.address * Ethereum_types.block_param - and type output = Ethereum_types.hex - -module Gas_price : - METHOD with type input = unit and type output = Ethereum_types.quantity - -module Get_transaction_count : - METHOD - with type input = Ethereum_types.address * Ethereum_types.block_param - and type output = Ethereum_types.quantity - -module Get_block_transaction_count_by_hash : - METHOD - with type input = Ethereum_types.block_hash - and type output = Ethereum_types.quantity - -module Get_block_transaction_count_by_number : - METHOD - with type input = Ethereum_types.block_param - and type output = Ethereum_types.quantity - -module Get_uncle_count_by_block_hash : - METHOD - with type input = Ethereum_types.block_hash - and type output = Ethereum_types.quantity - -module Get_uncle_count_by_block_number : - METHOD - with type input = Ethereum_types.block_param - and type output = Ethereum_types.quantity - -module Get_transaction_receipt : - METHOD - with type input = Ethereum_types.hash - and type output = Ethereum_types.transaction_receipt option - -module Get_transaction_by_hash : - METHOD - with type input = Ethereum_types.hash - and type output = Ethereum_types.transaction_object option - -module Get_transaction_by_block_hash_and_index : - METHOD - with type input = Ethereum_types.block_hash * Ethereum_types.quantity - and type output = Ethereum_types.transaction_object option - -module Get_transaction_by_block_number_and_index : - METHOD - with type input = Ethereum_types.block_param * Ethereum_types.quantity - and type output = Ethereum_types.transaction_object option - -module Get_uncle_by_block_hash_and_index : - METHOD - with type input = Ethereum_types.block_hash * Ethereum_types.quantity - and type output = Ethereum_types.block option - -module Get_uncle_by_block_number_and_index : - METHOD - with type input = Ethereum_types.block_param * Ethereum_types.quantity - and type output = Ethereum_types.block option - -module Send_raw_transaction : - METHOD - with type input = Ethereum_types.hex - and type output = Ethereum_types.hash - -module Send_transaction : - METHOD - with type input = Ethereum_types.transaction - and type output = Ethereum_types.hash - -module Eth_call : - METHOD - with type input = Ethereum_types.call * Ethereum_types.block_param - and type output = Ethereum_types.hash - -module Get_estimate_gas : - METHOD - with type input = Ethereum_types.call * Ethereum_types.block_param - and type output = Ethereum_types.quantity - -module Txpool_content : - METHOD with type input = unit and type output = Ethereum_types.txpool - -module Web3_clientVersion : - METHOD with type input = unit and type output = string - -module Web3_sha3 : - METHOD - with type input = Ethereum_types.hex - and type output = Ethereum_types.hash - -module Get_logs : - METHOD - with type input = Ethereum_types.filter - and type output = Ethereum_types.filter_changes list - -module Produce_block : - METHOD - with type input = Time.Protocol.t - and type output = Ethereum_types.quantity - -module Durable_state_value : - METHOD - with type input = Durable_storage_path.path - and type output = Bytes.t option - -type map_result = - | Method : - ('input, 'output) method_ - * (module METHOD with type input = 'input and type output = 'output) - -> map_result - | Unsupported - | Unknown - -val map_method_name : string -> map_result diff --git a/etherlink/bin_node/lib_prod/rpc_errors.ml b/etherlink/bin_node/lib_prod/rpc_errors.ml deleted file mode 100644 index b158b32b903886572bd7b374bf5188ef2df3cadb..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/rpc_errors.ml +++ /dev/null @@ -1,87 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2024 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. *) -(* *) -(*****************************************************************************) - -(** Errors from EIP-1474 *) - -open Rpc_encodings - -type t = Data_encoding.json JSONRPC.error - -let parse_error = JSONRPC.{code = -32700; message = "Parse error"; data = None} - -let invalid_request reason = - JSONRPC.{code = -32600; message = reason; data = None} - -let method_not_found method_ = - JSONRPC. - {code = -32601; message = "Method not found"; data = Some (`String method_)} - -let invalid_params reason = - JSONRPC.{code = -32602; message = reason; data = None} - -let internal_error reason = - JSONRPC.{code = -32603; message = reason; data = None} - -let invalid_input = - JSONRPC.{code = -32000; message = "Invalid input"; data = None} - -let resource_not_found reason = - JSONRPC.{code = -32001; message = reason; data = None} - -let resource_unavailable reason = - JSONRPC.{code = -32002; message = reason; data = None} - -let transaction_rejected reason hash = - JSONRPC. - { - code = -32003; - message = reason; - data = - hash - |> Option.map - (Data_encoding.Json.construct Ethereum_types.hash_encoding); - } - -let method_not_supported method_ = - JSONRPC. - { - code = -32004; - message = "Method not supported"; - data = Some (`String method_); - } - -let limit_exceeded reason hash = - JSONRPC. - { - code = -32005; - message = reason; - data = - hash - |> Option.map - (Data_encoding.Json.construct Ethereum_types.hash_encoding); - } - -let json_rpc_version_not_supported reason = - JSONRPC.{code = -32006; message = reason; data = None} diff --git a/etherlink/bin_node/lib_prod/sequencer.ml b/etherlink/bin_node/lib_prod/sequencer.ml deleted file mode 100644 index 923efcadf58e9ab428cb22836872f548e1a20ac1..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/sequencer.ml +++ /dev/null @@ -1,305 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2024 Functori *) -(* *) -(*****************************************************************************) - -module MakeBackend (Ctxt : sig - val smart_rollup_address : Tezos_crypto.Hashed.Smart_rollup_address.t -end) : Services_backend_sig.Backend = struct - module Reader = struct - let read path = Evm_context.inspect path - end - - module TxEncoder = struct - type transactions = string list - - type messages = transactions - - let encode_transactions ~smart_rollup_address:_ ~transactions:_ = - assert false - end - - module Publisher = struct - type messages = TxEncoder.messages - - let publish_messages ~timestamp:_ ~smart_rollup_address:_ ~messages:_ = - assert false - end - - module SimulatorBackend = struct - let simulate_and_read ~input = - let open Lwt_result_syntax in - let* raw_insights = Evm_context.execute_and_inspect input in - match raw_insights with - | [Some bytes] -> return bytes - | _ -> Error_monad.failwith "Invalid insights format" - end - - let smart_rollup_address = - Tezos_crypto.Hashed.Smart_rollup_address.to_string Ctxt.smart_rollup_address -end - -module Make (Ctxt : sig - val smart_rollup_address : Tezos_crypto.Hashed.Smart_rollup_address.t -end) = - Services_backend_sig.Make (MakeBackend (Ctxt)) - -let install_finalizer_seq server private_server = - let open Lwt_syntax in - Lwt_exit.register_clean_up_callback ~loc:__LOC__ @@ fun exit_status -> - let* () = Events.shutdown_node ~exit_status in - let* () = Tezos_rpc_http_server.RPC_server.shutdown server in - let* () = Events.shutdown_rpc_server ~private_:false in - let* () = - Option.iter_s - (fun private_server -> - let* () = Tezos_rpc_http_server.RPC_server.shutdown private_server in - Events.shutdown_rpc_server ~private_:true) - private_server - in - Helpers.unwrap_error_monad @@ fun () -> - let open Lwt_result_syntax in - let* () = Tx_pool.shutdown () in - let* () = Evm_events_follower.shutdown () in - let* () = Blueprints_publisher.shutdown () in - return_unit - -let callback_log server conn req body = - let open Cohttp in - let open Lwt_syntax in - let path = Request.uri req |> Uri.path in - if path = "/metrics" then - let* response = Metrics.Metrics_server.callback conn req body in - Lwt.return (`Response response) - else - let uri = req |> Request.uri |> Uri.to_string in - let meth = req |> Request.meth |> Code.string_of_method in - let* body_str = body |> Cohttp_lwt.Body.to_string in - let* () = Events.callback_log ~uri ~meth ~body:body_str in - Tezos_rpc_http_server.RPC_server.resto_callback - server - conn - req - (Cohttp_lwt.Body.of_string body_str) - -let start_server - Configuration. - { - rpc_addr; - rpc_port; - cors_origins; - cors_headers; - max_active_connections; - _; - } ~directory ~private_info = - let open Lwt_result_syntax in - let open Tezos_rpc_http_server in - let p2p_addr = P2p_addr.of_string_exn rpc_addr in - let host = Ipaddr.V6.to_string p2p_addr in - let node = `TCP (`Port rpc_port) in - let acl = RPC_server.Acl.allow_all in - let cors = - Resto_cohttp.Cors. - {allowed_headers = cors_headers; allowed_origins = cors_origins} - in - let server = - RPC_server.init_server - ~acl - ~cors - ~media_types:Media_type.all_media_types - directory - in - let private_info = - Option.map - (fun (private_directory, private_rpc_port) -> - let private_server = - RPC_server.init_server - ~acl - ~cors - ~media_types:Media_type.all_media_types - private_directory - in - (private_server, private_rpc_port)) - private_info - in - let private_server = Option.map fst private_info in - Lwt.catch - (fun () -> - let*! () = - RPC_server.launch - ~max_active_connections - ~host - server - ~callback:(callback_log server) - node - in - let*! () = - Option.iter_s - (fun (private_server, private_rpc_port) -> - let host = Ipaddr.V4.(to_string localhost) in - let*! () = - RPC_server.launch - ~max_active_connections - ~host - private_server - ~callback:(callback_log private_server) - (`TCP (`Port private_rpc_port)) - in - Events.private_server_is_ready - ~rpc_addr:host - ~rpc_port:private_rpc_port) - private_info - in - let*! () = Events.is_ready ~rpc_addr ~rpc_port in - return (server, private_server)) - (fun _ -> return (server, private_server)) - -let loop_sequencer (sequencer_config : Configuration.sequencer) = - let open Lwt_result_syntax in - let time_between_blocks = sequencer_config.time_between_blocks in - let rec loop last_produced_block = - match time_between_blocks with - | Nothing -> - (* Bind on a never-resolved promise ensures this call never returns, - meaning no block will ever be produced. *) - let task, _resolver = Lwt.task () in - let*! () = task in - return_unit - | Time_between_blocks time_between_blocks -> - let now = Helpers.now () in - (* We force if the last produced block is older than [time_between_blocks]. *) - let force = - let diff = Time.Protocol.(diff now last_produced_block) in - diff >= Int64.of_float time_between_blocks - in - let* nb_transactions = - Block_producer.produce_block ~force ~timestamp:now - and* () = Lwt.map Result.ok @@ Lwt_unix.sleep 0.5 in - if nb_transactions > 0 || force then loop now - else loop last_produced_block - in - let now = Helpers.now () in - loop now - -let main ~data_dir ?(genesis_timestamp = Helpers.now ()) ~cctxt - ~(configuration : Configuration.t) ?kernel () = - let open Lwt_result_syntax in - let open Configuration in - let {rollup_node_endpoint; keep_alive; _} = configuration in - let* smart_rollup_address = - Rollup_services.smart_rollup_address - ~keep_alive:configuration.keep_alive - rollup_node_endpoint - in - let*? sequencer_config = Configuration.sequencer_config_exn configuration in - let* status = - Evm_context.start - ?kernel_path:kernel - ~data_dir - ~preimages:sequencer_config.preimages - ~preimages_endpoint:sequencer_config.preimages_endpoint - ~smart_rollup_address - ~fail_on_missing_blueprint:true - () - in - let*! head = Evm_context.head_info () in - let (Qty next_blueprint_number) = head.next_blueprint_number in - Metrics.set_level ~level:(Z.pred next_blueprint_number) ; - let* () = - Blueprints_publisher.start - ~rollup_node_endpoint - ~config:sequencer_config.blueprints_publisher_config - ~latest_level_seen:(Z.pred next_blueprint_number) - () - in - let* () = - if status = Created then - (* Create the first empty block. *) - let* genesis = - Sequencer_blueprint.create - ~cctxt - ~sequencer_key:sequencer_config.sequencer - ~timestamp:genesis_timestamp - ~smart_rollup_address - ~transactions:[] - ~delayed_transactions:[] - ~number:Ethereum_types.(Qty Z.zero) - ~parent_hash:Ethereum_types.genesis_parent_hash - in - let* () = Evm_context.apply_blueprint genesis_timestamp genesis [] in - Blueprints_publisher.publish Z.zero genesis - else return_unit - in - - let smart_rollup_address_typed = - Tezos_crypto.Hashed.Smart_rollup_address.of_string_exn smart_rollup_address - in - - let module Sequencer = Make (struct - let smart_rollup_address = smart_rollup_address_typed - end) in - let* () = - Tx_pool.start - { - rollup_node = (module Sequencer); - smart_rollup_address; - mode = Sequencer; - tx_timeout_limit = configuration.tx_pool_timeout_limit; - tx_pool_addr_limit = Int64.to_int configuration.tx_pool_addr_limit; - tx_pool_tx_per_addr_limit = - Int64.to_int configuration.tx_pool_tx_per_addr_limit; - max_number_of_chunks = - (match configuration.sequencer with - | Some {max_number_of_chunks; _} -> Some max_number_of_chunks - | None -> None); - } - in - let* () = - Block_producer.start - { - cctxt; - smart_rollup_address; - sequencer_key = sequencer_config.sequencer; - maximum_number_of_chunks = sequencer_config.max_number_of_chunks; - } - in - let* () = - Evm_events_follower.start - {rollup_node_endpoint; keep_alive; filter_event = (fun _ -> true)} - in - let () = - Rollup_node_follower.start - ~keep_alive:configuration.keep_alive - ~proxy:false - ~rollup_node_endpoint - () - in - - let directory = - Services.directory configuration ((module Sequencer), smart_rollup_address) - in - let directory = - directory |> Evm_services.register smart_rollup_address_typed - in - let private_info = - Option.map - (fun private_rpc_port -> - let private_directory = - Services.private_directory - configuration - ((module Sequencer), smart_rollup_address) - in - (private_directory, private_rpc_port)) - sequencer_config.private_rpc_port - in - let* server, private_server = - start_server configuration ~directory ~private_info - in - let (_ : Lwt_exit.clean_up_callback_id) = - install_finalizer_seq server private_server - in - let* () = loop_sequencer sequencer_config in - return_unit diff --git a/etherlink/bin_node/lib_prod/sequencer_blueprint.ml b/etherlink/bin_node/lib_prod/sequencer_blueprint.ml deleted file mode 100644 index be819f0657488d8ffa8403637c2cb60bea85235f..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/sequencer_blueprint.ml +++ /dev/null @@ -1,125 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2024 TriliTech *) -(* *) -(*****************************************************************************) - -open Ethereum_types - -(* U256 *) -let blueprint_number_size = 32 - -(* U16 *) -let nb_chunks_size = 2 - -(* U16 *) -let chunk_index_size = 2 - -let blueprint_tag_size = 1 - -(* ED25519 *) -let signature_size = 64 - -(* Tags added by RLP encoding for the sequencer blueprint. - The sequencer blueprint follows the format: - [ chunk, <- max size around 4kb, requires tag of 3 bytes - number, <- 32 bytes, requires a tag of 1 byte - nb_chunks, <- 2 bytes, requires a tag of 1 byte - chunk_index <- 2 bytes, requires a tag of 1 byte - ] <- outer list requires tag of 3 bytes. - - In total, the tags take 9 bytes. We use 16 to be safe. -*) -let rlp_tags_size = 16 - -let max_chunk_size = - let open Transaction_format in - (* max_input_size already considers the external tag *) - max_input_size - framing_protocol_tag_size - smart_rollup_address_size - - blueprint_tag_size - blueprint_number_size - nb_chunks_size - - chunk_index_size - rlp_tags_size - signature_size - -let maximum_usable_space_in_blueprint chunks_count = - chunks_count * max_chunk_size - -let maximum_chunks_per_l1_level = 512 * 1024 / 4096 - -let encode_transaction raw = - let open Rlp in - Value (Bytes.of_string raw) - -let make_blueprint_chunks ~timestamp ~transactions - ~(delayed_transactions : Ethereum_types.hash list) ~parent_hash = - let open Rlp in - let delayed_transactions = - List - (List.map - (fun hash -> Value (hash_to_bytes hash |> Bytes.of_string)) - delayed_transactions) - in - let messages = - let m = List.map encode_transaction transactions in - List m - in - let timestamp = Value (Ethereum_types.timestamp_to_bytes timestamp) in - let parent_hash = - Value (block_hash_to_bytes parent_hash |> Bytes.of_string) - in - let blueprint = - List [parent_hash; delayed_transactions; messages; timestamp] |> encode - in - match String.chunk_bytes max_chunk_size blueprint with - | Ok chunks -> chunks - | _ -> - (* [chunk_bytes] can only return an [Error] if the optional - argument [error_on_partial_chunk] is passed. As this is not - the case in this call, this branch is impossible. *) - assert false - -let encode_u16_le i = - let bytes = Bytes.make 2 '\000' in - Bytes.set_uint16_le bytes 0 i ; - bytes - -type t = Blueprint_types.payload - -let create ~cctxt ~sequencer_key ~timestamp ~smart_rollup_address ~number - ~parent_hash ~(delayed_transactions : Ethereum_types.hash list) - ~transactions = - let open Lwt_result_syntax in - let open Rlp in - let number = Value (encode_u256_le number) in - let chunks = - make_blueprint_chunks - ~timestamp - ~transactions - ~delayed_transactions - ~parent_hash - in - let nb_chunks = Rlp.Value (encode_u16_le @@ List.length chunks) in - let message_from_chunk nb_chunks chunk_index chunk = - let chunk_index = Rlp.Value (encode_u16_le chunk_index) in - let value = Value (Bytes.of_string chunk) in - (* Takes the blueprints fields and sign them. *) - let rlp_unsigned_blueprint = - List [value; number; nb_chunks; chunk_index] |> encode - in - let* signature = - Client_keys.sign cctxt sequencer_key rlp_unsigned_blueprint - in - let signature_bytes = Signature.to_bytes signature in - (* Encode the blueprints fields and its signature. *) - let rlp_sequencer_blueprint = - List [value; number; nb_chunks; chunk_index; Value signature_bytes] - |> encode |> Bytes.to_string - in - `External - ("\000" (* Framed protocol *) ^ smart_rollup_address - ^ "\003" - ^ (* Sequencer blueprint *) - rlp_sequencer_blueprint) - |> return - in - List.mapi_ep (message_from_chunk nb_chunks) chunks diff --git a/etherlink/bin_node/lib_prod/sequencer_blueprint.mli b/etherlink/bin_node/lib_prod/sequencer_blueprint.mli deleted file mode 100644 index 78fc1777a3c21fb5d7bfd33b36cc61e6cd3f454f..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/sequencer_blueprint.mli +++ /dev/null @@ -1,33 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -type t = Blueprint_types.payload - -(** [create ~secret_key ~timestamp ~smart_rollup_address ~number - ~parent_hash ~delayed_transactions ~transactions] - creates a sequencer blueprint at [timestamp] with a given [number] - containing [transactions], signed with [secret_key]. Returns - valid list of external messages inputs to put in the inbox. -*) -val create : - cctxt:#Client_context.wallet -> - sequencer_key:Client_keys.sk_uri -> - timestamp:Time.Protocol.t -> - smart_rollup_address:string -> - number:Ethereum_types.quantity -> - parent_hash:Ethereum_types.block_hash -> - delayed_transactions:Ethereum_types.hash list -> - transactions:string list -> - t tzresult Lwt.t - -(** [maximum_usable_size_in_blueprint chunks_count] returns the available space - for transactions in a blueprint composed of [chunks_count] chunks. *) -val maximum_usable_space_in_blueprint : int -> int - -(* [maximum_chunks_per_l1_level] is the maximum number of chunks a L1 block can - hold at once. *) -val maximum_chunks_per_l1_level : int diff --git a/etherlink/bin_node/lib_prod/services.ml b/etherlink/bin_node/lib_prod/services.ml deleted file mode 100644 index d9322cfbca69abc3c3278c12a7b946f8eaebcd35..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/services.ml +++ /dev/null @@ -1,481 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 Nomadic Labs *) -(* Copyright (c) 2023 Functori *) -(* Copyright (c) 2023 Marigold *) -(* *) -(* 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 Tezos_rpc -open Rpc_encodings - -let version_service = - Service.get_service - ~description:"version" - ~query:Query.empty - ~output:Data_encoding.string - Path.(root / "version") - -let client_version = - Format.sprintf - "%s/%s-%s/%s/ocamlc.%s" - "octez-evm-node" - (Tezos_version.Version.to_string - Tezos_version_value.Current_git_info.etherlink_version) - Tezos_version_value.Current_git_info.abbreviated_commit_hash - Stdlib.Sys.os_type - Stdlib.Sys.ocaml_version - -let version dir = - Directory.register0 dir version_service (fun () () -> - Lwt.return_ok client_version) - -(* The node can either take a single request or multiple requests at - once. *) -type 'a batched_request = Singleton of 'a | Batch of 'a list - -let request_encoding kind = - Data_encoding.( - union - [ - case - ~title:"singleton" - (Tag 0) - kind - (function Singleton i -> Some i | _ -> None) - (fun i -> Singleton i); - case - ~title:"batch" - (Tag 1) - (list kind) - (function Batch i -> Some i | _ -> None) - (fun i -> Batch i); - ]) - -let dispatch_service ~path = - Service.post_service - ~query:Query.empty - ~input:(request_encoding JSONRPC.request_encoding) - ~output:(request_encoding JSONRPC.response_encoding) - path - -let get_block_by_number ~full_transaction_object block_param - (module Rollup_node_rpc : Services_backend_sig.S) = - match block_param with - | Ethereum_types.(Hash_param (Qty n)) -> - Rollup_node_rpc.nth_block ~full_transaction_object n - | Latest | Earliest | Pending -> - Rollup_node_rpc.current_block ~full_transaction_object - -let get_transaction_from_index block index - (module Rollup_node_rpc : Services_backend_sig.S) = - let open Lwt_result_syntax in - match block.Ethereum_types.transactions with - | TxHash l -> ( - match List.nth_opt l index with - | None -> return_none - | Some hash -> Rollup_node_rpc.transaction_object hash) - | TxFull l -> return @@ List.nth_opt l index - -let block_transaction_count block = - Ethereum_types.quantity_of_z @@ Z.of_int - @@ - match block.Ethereum_types.transactions with - | TxHash l -> List.length l - | TxFull l -> List.length l - -let decode : - type a. (module METHOD with type input = a) -> Data_encoding.json -> a = - fun (module M) v -> Data_encoding.Json.destruct M.input_encoding v - -let encode : - type a. (module METHOD with type output = a) -> a -> Data_encoding.json = - fun (module M) v -> Data_encoding.Json.construct M.output_encoding v - -let build : - type input output. - (module METHOD with type input = input and type output = output) -> - f:(input option -> (output, Rpc_errors.t) Result.t tzresult Lwt.t) -> - Data_encoding.json option -> - JSONRPC.value Lwt.t = - fun (module Method) ~f parameters -> - let open Lwt_syntax in - Lwt.catch - (fun () -> - let decoded = Option.map (decode (module Method)) parameters in - let+ v = f decoded in - match v with - | Error err -> - Error - (Rpc_errors.internal_error - @@ Format.asprintf "%a" pp_print_trace err) - | Ok value -> Result.map (encode (module Method)) value) - (fun exn -> - Lwt.return_error @@ Rpc_errors.invalid_request @@ Printexc.to_string exn) - -let rpc_ok result = Lwt_result.return @@ Ok result - -let rpc_error err = Lwt_result.return @@ Error err - -let missing_parameter () = rpc_error Rpc_errors.invalid_input - -let expect_input input f = - match input with None -> missing_parameter () | Some v -> f v - -let build_with_input method_ ~f parameters = - build method_ ~f:(fun input -> expect_input input f) parameters - -let dispatch_request (config : Configuration.t) - ((module Backend_rpc : Services_backend_sig.S), _) - ({method_; parameters; id} : JSONRPC.request) : JSONRPC.response Lwt.t = - let open Lwt_result_syntax in - let open Ethereum_types in - let*! value = - match map_method_name method_ with - | Unknown -> Lwt.return_error (Rpc_errors.method_not_found method_) - | Unsupported -> Lwt.return_error (Rpc_errors.method_not_supported method_) - (* Ethereum JSON-RPC API methods we support *) - | Method (Accounts.Method, module_) -> - let f (_ : unit option) = rpc_ok [] in - build ~f module_ parameters - | Method (Network_id.Method, module_) -> - let f (_ : unit option) = - let open Lwt_result_syntax in - let* (Qty chain_id) = Backend_rpc.chain_id () in - rpc_ok (Z.to_string chain_id) - in - build ~f module_ parameters - | Method (Chain_id.Method, module_) -> - let f (_ : unit option) = - let* chain_id = Backend_rpc.chain_id () in - rpc_ok chain_id - in - build ~f module_ parameters - | Method (Get_balance.Method, module_) -> - let f (address, _block_param) = - let* balance = Backend_rpc.balance address in - rpc_ok balance - in - build_with_input ~f module_ parameters - | Method (Get_storage_at.Method, module_) -> - let f (address, position, _block_param) = - let* value = Backend_rpc.storage_at address position in - rpc_ok value - in - build_with_input ~f module_ parameters - | Method (Block_number.Method, module_) -> - let f (_ : unit option) = - let* block_number = Backend_rpc.current_block_number () in - rpc_ok block_number - in - build ~f module_ parameters - | Method (Get_block_by_number.Method, module_) -> - let f (block_param, full_transaction_object) = - let* block = - get_block_by_number - ~full_transaction_object - block_param - (module Backend_rpc) - in - rpc_ok block - in - build_with_input ~f module_ parameters - | Method (Get_block_by_hash.Method, module_) -> - let f (block_hash, full_transaction_object) = - let* block = - Backend_rpc.block_by_hash ~full_transaction_object block_hash - in - rpc_ok block - in - build_with_input ~f module_ parameters - | Method (Get_code.Method, module_) -> - let f (address, _) = - let* code = Backend_rpc.code address in - rpc_ok code - in - build_with_input ~f module_ parameters - | Method (Gas_price.Method, module_) -> - let f (_ : unit option) = - let* base_fee = Backend_rpc.base_fee_per_gas () in - rpc_ok base_fee - in - build ~f module_ parameters - | Method (Get_transaction_count.Method, module_) -> - let f (address, _) = - let* nonce = Tx_pool.nonce address in - rpc_ok nonce - in - build_with_input ~f module_ parameters - | Method (Get_block_transaction_count_by_hash.Method, module_) -> - let f block_hash = - let* block = - Backend_rpc.block_by_hash ~full_transaction_object:false block_hash - in - rpc_ok (block_transaction_count block) - in - build_with_input ~f module_ parameters - | Method (Get_block_transaction_count_by_number.Method, module_) -> - let f block_param = - let* block = - get_block_by_number - ~full_transaction_object:false - block_param - (module Backend_rpc) - in - rpc_ok (block_transaction_count block) - in - build_with_input ~f module_ parameters - | Method (Get_uncle_count_by_block_hash.Method, module_) -> - let f _block_param = rpc_ok (Qty Z.zero) in - build_with_input ~f module_ parameters - | Method (Get_uncle_count_by_block_number.Method, module_) -> - let f _block_param = rpc_ok (Qty Z.zero) in - build_with_input ~f module_ parameters - | Method (Get_transaction_receipt.Method, module_) -> - let f tx_hash = - let* receipt = Backend_rpc.transaction_receipt tx_hash in - rpc_ok receipt - in - build_with_input ~f module_ parameters - | Method (Get_transaction_by_hash.Method, module_) -> - let f tx_hash = - let* transaction_object = Backend_rpc.transaction_object tx_hash in - rpc_ok transaction_object - in - build_with_input ~f module_ parameters - | Method (Get_transaction_by_block_hash_and_index.Method, module_) -> - let f (block_hash, Qty index) = - let* block = - Backend_rpc.block_by_hash ~full_transaction_object:false block_hash - in - let* transaction_object = - get_transaction_from_index - block - (Z.to_int index) - (module Backend_rpc) - in - rpc_ok transaction_object - in - build_with_input ~f module_ parameters - | Method (Get_transaction_by_block_number_and_index.Method, module_) -> - let f (block_number, Qty index) = - let* block = - get_block_by_number - ~full_transaction_object:false - block_number - (module Backend_rpc) - in - let* transaction_object = - get_transaction_from_index - block - (Z.to_int index) - (module Backend_rpc) - in - rpc_ok transaction_object - in - build_with_input ~f module_ parameters - | Method (Get_uncle_by_block_hash_and_index.Method, module_) -> - let f (_block_hash, _index) = - (* A block cannot have uncles. *) - rpc_ok None - in - build_with_input ~f module_ parameters - | Method (Get_uncle_by_block_number_and_index.Method, module_) -> - let f (_block_number, _index) = - (* A block cannot have uncles. *) - rpc_ok None - in - build_with_input ~f module_ parameters - | Method (Send_raw_transaction.Method, module_) -> - let f tx_raw = - let* tx_hash = Tx_pool.add (Ethereum_types.hex_to_bytes tx_raw) in - match tx_hash with - | Ok tx_hash -> rpc_ok tx_hash - | Error reason -> - rpc_error (Rpc_errors.transaction_rejected reason None) - in - - build_with_input ~f module_ parameters - | Method (Eth_call.Method, module_) -> - let f (call, _) = - let* call_result = Backend_rpc.simulate_call call in - match call_result with - | Ok (Ok {value = Some value; gas_used = _}) -> rpc_ok value - | Ok (Ok {value = None; gas_used = _}) -> rpc_ok (hash_of_string "") - | Ok (Error reason) -> - rpc_error - @@ Rpc_errors.transaction_rejected - "execution reverted" - (Some reason) - | Error reason -> - rpc_error (Rpc_errors.transaction_rejected reason None) - in - build_with_input ~f module_ parameters - | Method (Get_estimate_gas.Method, module_) -> - let f (call, _) = - let* result = Backend_rpc.estimate_gas call in - match result with - | Ok (Ok {value = _; gas_used = Some gas}) -> rpc_ok gas - | Ok (Ok {value = _; gas_used = None}) -> - rpc_error - (Rpc_errors.limit_exceeded - "Simulation failed before execution, cannot estimate gas." - None) - | Ok (Error reason) -> - rpc_error - @@ Rpc_errors.limit_exceeded "execution reverted" (Some reason) - | Error reason -> rpc_error (Rpc_errors.limit_exceeded reason None) - in - build_with_input ~f module_ parameters - | Method (Txpool_content.Method, module_) -> - let f (_ : unit option) = - rpc_ok - Ethereum_types. - {pending = AddressMap.empty; queued = AddressMap.empty} - in - build ~f module_ parameters - | Method (Web3_clientVersion.Method, module_) -> - let f (_ : unit option) = rpc_ok client_version in - build ~f module_ parameters - | Method (Web3_sha3.Method, module_) -> - let f data = - let open Ethereum_types in - let (Hex h) = data in - let bytes = Hex.to_bytes_exn (`Hex h) in - let hash_bytes = Tezos_crypto.Hacl.Hash.Keccak_256.digest bytes in - let hash = Hex.of_bytes hash_bytes |> Hex.show in - rpc_ok (Hash (Hex hash)) - in - build_with_input ~f module_ parameters - | Method (Get_logs.Method, module_) -> - let f filter = - let* logs = - Filter_helpers.get_logs - config.log_filter - (module Backend_rpc) - filter - in - rpc_ok logs - in - build_with_input ~f module_ parameters - (* Internal RPC methods *) - | Method (Kernel_version.Method, module_) -> - let f (_ : unit option) = - let* kernel_version = Backend_rpc.kernel_version () in - rpc_ok kernel_version - in - build ~f module_ parameters - | Method (Kernel_root_hash.Method, module_) -> - let f (_ : unit option) = - let* kernel_root_hash = Backend_rpc.kernel_root_hash () in - rpc_ok kernel_root_hash - in - build ~f module_ parameters - | _ -> Stdlib.failwith "The pattern matching of methods is not exhaustive" - in - Lwt.return JSONRPC.{value; id} - -let dispatch_private_request (_config : Configuration.t) - ((module Backend_rpc : Services_backend_sig.S), _) - ({method_; parameters; id} : JSONRPC.request) : JSONRPC.response Lwt.t = - let open Lwt_syntax in - let* value = - match map_method_name method_ with - | Unknown -> - return - (Error - JSONRPC. - { - code = -3200; - message = "Method not found"; - data = Some (`String method_); - }) - | Unsupported -> - return - (Error - JSONRPC. - { - code = -3200; - message = "Method not supported"; - data = Some (`String method_); - }) - | Method (Produce_block.Method, module_) -> - let f (timestamp : Time.Protocol.t option) = - let open Lwt_result_syntax in - let timestamp = Option.value timestamp ~default:(Helpers.now ()) in - let* nb_transactions = - Block_producer.produce_block ~force:true ~timestamp - in - rpc_ok (Ethereum_types.quantity_of_z @@ Z.of_int nb_transactions) - in - build ~f module_ parameters - | Method (Durable_state_value.Method, module_) -> - let f path = - let open Lwt_result_syntax in - let*? path = - Option.to_result - ~none:[error_of_fmt "missing params, please provide a path"] - path - in - let* value = Backend_rpc.Reader.read path in - rpc_ok value - in - build ~f module_ parameters - | _ -> Stdlib.failwith "The pattern matching of methods is not exhaustive" - in - return JSONRPC.{value; id} - -let generic_dispatch config ctx dir path dispatch_request = - Directory.register0 dir (dispatch_service ~path) (fun () input -> - let open Lwt_result_syntax in - match input with - | Singleton request -> - let*! response = dispatch_request config ctx request in - return (Singleton response) - | Batch requests -> - let*! outputs = List.map_s (dispatch_request config ctx) requests in - return (Batch outputs)) - -let dispatch_public config ctx dir = - generic_dispatch config ctx dir Path.root dispatch_request - -let dispatch_private config ctx dir = - generic_dispatch - config - ctx - dir - Path.(add_suffix root "private") - dispatch_private_request - -let directory config - ((module Rollup_node_rpc : Services_backend_sig.S), smart_rollup_address) = - Directory.empty |> version - |> dispatch_public - config - ((module Rollup_node_rpc : Services_backend_sig.S), smart_rollup_address) - -let private_directory config - ((module Rollup_node_rpc : Services_backend_sig.S), smart_rollup_address) = - Directory.empty |> version - |> dispatch_private - config - ((module Rollup_node_rpc : Services_backend_sig.S), smart_rollup_address) diff --git a/etherlink/bin_node/lib_prod/services_backend_sig.ml b/etherlink/bin_node/lib_prod/services_backend_sig.ml deleted file mode 100644 index 917f84e11c2d82fb9f62030749887a8b0b03dfcb..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/services_backend_sig.ml +++ /dev/null @@ -1,140 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -module type S = sig - module Reader : Durable_storage.READER - - (** [balance address] returns the [address]'s balance. *) - val balance : Ethereum_types.address -> Ethereum_types.quantity tzresult Lwt.t - - (** [nonce address] returns the [address]'s nonce. *) - val nonce : - Ethereum_types.address -> Ethereum_types.quantity option tzresult Lwt.t - - (** [code address] returns the [address]'s code. *) - val code : Ethereum_types.address -> Ethereum_types.hex tzresult Lwt.t - - (** [inject_raw_transactions ~timestamp ~smart_rollup_address - ~transactions] crafts the hashes and chunks of each transaction - of [transactions]. Injects the chunks and returns the hashes of - injected transactions. *) - val inject_raw_transactions : - timestamp:Time.Protocol.t -> - smart_rollup_address:string -> - transactions:string list -> - Ethereum_types.hash list tzresult Lwt.t - - (** [current_block ~full_transaction_object] returns the most recent - processed and stored block. - - If [full_transaction_object] is [true], returns the transaction objects, - the transactions hashes otherwise. - *) - val current_block : - full_transaction_object:bool -> Ethereum_types.block tzresult Lwt.t - - (** [current_block_number ()] returns the most recent processed and - stored block number. *) - val current_block_number : unit -> Ethereum_types.quantity tzresult Lwt.t - - (** [nth_block_hash n] returns the hash of the [n]th processed and - stored block. *) - val nth_block_hash : Z.t -> Ethereum_types.block_hash option tzresult Lwt.t - - (** [nth_block ~full_transaction_object n] returns the [n]th - processed and stored block. - - If [full_transaction_object] is [true], returns the transaction objects, - the transactions hashes otherwise. - *) - val nth_block : - full_transaction_object:bool -> Z.t -> Ethereum_types.block tzresult Lwt.t - - (** [block_by_hash ~full_transaction_object hash] returns the block with the - given [hash]. - - If [full_transaction_object] is [true], returns the transaction objects, - the transactions hashes otherwise. - *) - val block_by_hash : - full_transaction_object:bool -> - Ethereum_types.block_hash -> - Ethereum_types.block tzresult Lwt.t - - (** [transaction_receipt tx_hash] returns the receipt of [tx_hash]. *) - val transaction_receipt : - Ethereum_types.hash -> - Ethereum_types.transaction_receipt option tzresult Lwt.t - - (** [transaction_object tx_hash] returns the informations of [tx_hash]. *) - val transaction_object : - Ethereum_types.hash -> - Ethereum_types.transaction_object option tzresult Lwt.t - - (** [chain_id ()] returns chain id defined by the rollup. *) - val chain_id : unit -> Ethereum_types.quantity tzresult Lwt.t - - (** [base_fee_per_gas ()] returns base fee defined by the rollup. *) - val base_fee_per_gas : unit -> Ethereum_types.quantity tzresult Lwt.t - - (** [kernel_version ()] returns the internal kernel version (i.e the - commit hash where the kernel was compiled). *) - val kernel_version : unit -> string tzresult Lwt.t - - (** [kernel_root_hash ()] returns the internal kernel root hash (i.e the - latest root hash that was applied during an upgrade). *) - val kernel_root_hash : unit -> string option tzresult Lwt.t - - (** [simulate_call call_info] asks the rollup to simulate a call, - and returns the result. *) - val simulate_call : - Ethereum_types.call -> - Simulation.call_result Simulation.simulation_result tzresult Lwt.t - - (** [estimate_gas call_info] asks the rollup to simulate a call, and - returns the gas used to execute the call. *) - val estimate_gas : - Ethereum_types.call -> - Simulation.call_result Simulation.simulation_result tzresult Lwt.t - - (** [is_tx_valid tx_raw] checks if the transaction is valid. Checks - if the nonce is correct and returns the associated public key of - transaction. *) - val is_tx_valid : - string -> - Simulation.validation_result Simulation.simulation_result tzresult Lwt.t - - (** [storage_at address pos] returns the value at index [pos] of the - account [address]'s storage. *) - val storage_at : - Ethereum_types.address -> - Ethereum_types.quantity -> - Ethereum_types.hex tzresult Lwt.t - - val smart_rollup_address : string -end - -module type Backend = sig - module Reader : Durable_storage.READER - - module TxEncoder : Publisher.TxEncoder - - module Publisher : Publisher.Publisher with type messages = TxEncoder.messages - - module SimulatorBackend : Simulator.SimulationBackend - - val smart_rollup_address : string -end - -module Make (Backend : Backend) : S = struct - module Reader = Backend.Reader - include Durable_storage.Make (Backend.Reader) - include Publisher.Make (Backend.TxEncoder) (Backend.Publisher) - include Simulator.Make (Backend.SimulatorBackend) - - let smart_rollup_address = Backend.smart_rollup_address -end diff --git a/etherlink/bin_node/lib_prod/simulation.ml b/etherlink/bin_node/lib_prod/simulation.ml deleted file mode 100644 index 42cd04eb33a8e39baa0d79c0375e309d42b57786..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/simulation.ml +++ /dev/null @@ -1,322 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2023 Marigold *) -(* *) -(* 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 Ethereum_types - -(** [hex_string_to_bytes s] transforms a hex string [s] into a byte string. *) -let hex_string_to_bytes (Hex s) = `Hex s |> Hex.to_bytes_exn - -(** Encoding used to forward the call to the kernel, to be used in simulation - mode only. *) -let rlp_encode call = - let of_opt of_val = function - | None -> Rlp.Value Bytes.empty - | Some v -> of_val v - in - let of_addr (Address s) = Rlp.Value (hex_string_to_bytes s) in - let of_qty (Qty z) = Rlp.Value (Z.to_bits z |> Bytes.of_string) in - let of_hash (Hash h) = Rlp.Value (hex_string_to_bytes h) in - let rlp_form = - Rlp.List - [ - of_opt of_addr call.from; - of_opt of_addr call.to_; - of_opt of_qty call.gas; - of_opt of_qty call.gasPrice; - of_opt of_qty call.value; - of_opt of_hash call.data; - ] - in - (* we aim to use [String.chunk_bytes] *) - Rlp.encode rlp_form - -type simulation_message = - | Start - | Simple of string - | NewChunked of int - | Chunk of int * string - -(* Max input size : 4096B - - Simulation tag : 1B - - Chunk tag : 1B - - Number of chunks : 2B *) -let max_chunk_size = 4092 - -let split_in_messages call = - let open Result_syntax in - let* chunks = String.chunk_bytes max_chunk_size call in - match chunks with - | [s] -> return [Start; Simple s] - | l -> - let len = List.length l in - let chunks = List.mapi (fun i c -> Chunk (i, c)) l in - return (Start :: NewChunked len :: chunks) - -(** Tag signaling a simulation message *) -let simulation_tag = "\255" - -(** Tag signaling a simulation message containing a full simulation call *) -let simple_tag = "\001" - -(** Tag signaling a simulation message starting a serie of chunks *) -let new_chunked_tag = "\002" - -(** Tag signaling a simulation message containing a chunk *) -let chunk_tag = "\003" - -(** Tag indicating simulation is an evaluation *) -let evaluation_tag = "\000" - -(** Tag indicating simulation is a validation *) -let validation_tag = "\001" - -(** [add_tag tag bytes] prefixes bytes by the given tag *) -let add_tag tag bytes = tag ^ Bytes.to_string bytes |> String.to_bytes - -let encode_message = function - | Start -> simulation_tag - | Simple s -> simulation_tag ^ simple_tag ^ s - | NewChunked n -> - let n_le_str = Ethereum_types.u16_to_bytes n in - simulation_tag ^ new_chunked_tag ^ n_le_str - | Chunk (i, c) -> - let i_le_str = Ethereum_types.u16_to_bytes i in - simulation_tag ^ chunk_tag ^ i_le_str ^ c - -let encode call = - let open Result_syntax in - let* messages = - call |> rlp_encode |> add_tag evaluation_tag |> split_in_messages - in - return @@ List.map encode_message messages - -let encode_tx tx = - let open Result_syntax in - let* messages = - Bytes.of_string tx |> add_tag validation_tag |> split_in_messages - in - return @@ List.map encode_message messages - -type execution_result = {value : hash option; gas_used : quantity option} - -type call_result = (execution_result, hash) result - -type validation_result = {address : address} - -type 'a simulation_result = ('a, string) result - -module Encodings = struct - open Data_encoding - - type eval_result = { - state_hash : string; - status : string; - output : unit; - inbox_level : unit; - num_ticks : Z.t; - insights : bytes list; - (** The simulation can ask to look at values on the state after - the simulation. *) - } - - type insight_request = - | Pvm_state_key of string list - | Durable_storage_key of string list - - type simulate_input = { - messages : string list; - reveal_pages : string list option; - insight_requests : insight_request list; - log_kernel_debug_file : string option; - } - - let insight_request = - union - [ - case - (Tag 0) - ~title:"pvm_state" - ~description:"Path in the PVM state" - (obj2 (req "kind" (constant "pvm_state")) (req "key" (list string))) - (function Pvm_state_key key -> Some ((), key) | _ -> None) - (fun ((), key) -> Pvm_state_key key); - case - (Tag 1) - ~title:"durable_storage" - ~description:"Path in the PVM durable storage" - (obj2 - (req "kind" (constant "durable_storage")) - (req "key" (list string))) - (function Durable_storage_key key -> Some ((), key) | _ -> None) - (fun ((), key) -> Durable_storage_key key); - ] - - let simulate_input = - conv - (fun {messages; reveal_pages; insight_requests; log_kernel_debug_file} -> - (messages, reveal_pages, insight_requests, log_kernel_debug_file)) - (fun (messages, reveal_pages, insight_requests, log_kernel_debug_file) -> - {messages; reveal_pages; insight_requests; log_kernel_debug_file}) - @@ obj4 - (req - "messages" - (list (string' Hex)) - ~description:"Serialized messages for simulation.") - (opt - "reveal_pages" - (list (string' Hex)) - ~description:"Pages (at most 4kB) to be used for revelation ticks") - (dft - "insight_requests" - (list insight_request) - [] - ~description:"Paths in the PVM to inspect after the simulation") - (opt - "log_kernel_debug_file" - string - ~description: - "File in which to emit kernel logs. This file will be created in \ - /simulation_kernel_logs/, where is the \ - data directory of the rollup node.") - - let decode_data = - let open Result_syntax in - function - | Rlp.Value v -> return (decode_hash v) - | Rlp.List _ -> error_with "The simulation returned an ill-encoded data" - - let decode_gas_used = - let open Result_syntax in - function - | Rlp.Value v -> return (decode_number v) - | Rlp.List _ -> error_with "The simulation returned an ill-encoded gas" - - let decode_execution_result = - let open Result_syntax in - function - | Rlp.List [value; gas_used] -> - let* value = Rlp.decode_option decode_data value in - let* gas_used = Rlp.decode_option decode_gas_used gas_used in - return {value; gas_used} - | _ -> - error_with - "The simulation for eth_call/eth_estimateGas returned an ill-encoded \ - format" - - let decode_call_result v = - let open Result_syntax in - let decode_revert = function - | Rlp.Value msg -> return (decode_hash msg) - | _ -> error_with "The revert message is ill-encoded" - in - Rlp.decode_result decode_execution_result decode_revert v - - let decode_validation_result = - let open Result_syntax in - function - | Rlp.Value address -> return {address = decode_address address} - | _ -> error_with "The transaction pool returned an illformed value" - - let simulation_result_from_rlp decode_payload bytes = - let open Result_syntax in - let decode_error_msg = function - | Rlp.Value msg -> return @@ Bytes.to_string msg - | rlp -> - error_with - "The simulation returned an unexpected error message: %a" - Rlp.pp - rlp - in - let* rlp = Rlp.decode bytes in - match Rlp.decode_result decode_payload decode_error_msg rlp with - | Ok v -> Ok v - | Error e -> - error_with - "The simulation returned an unexpected format: %a, with error %a" - Rlp.pp - rlp - pp_print_trace - e - - let eval_result = - conv - (fun {state_hash; status; output; inbox_level; num_ticks; insights} -> - (state_hash, status, output, inbox_level, num_ticks, insights)) - (fun (state_hash, status, output, inbox_level, num_ticks, insights) -> - {state_hash; status; output; inbox_level; num_ticks; insights}) - @@ obj6 - (req - "state_hash" - string - ~description: - "Hash of the state after execution of the PVM on the input \ - messages") - (req "status" string ~description:"Status of the PVM after evaluation") - (req - "output" - unit - ~description:"Output produced by evaluation of the messages") - (req - "inbox_level" - unit - ~description:"Level of the inbox that would contain these messages") - (req - "num_ticks" - z - ~description:"Ticks taken by the PVM for evaluating the messages") - (req - "insights" - (list bytes) - ~description:"PVM state values requested after the simulation") -end - -let simulation_result bytes = - Encodings.simulation_result_from_rlp Encodings.decode_call_result bytes - -let gas_estimation bytes = - let open Result_syntax in - let* result = - Encodings.simulation_result_from_rlp Encodings.decode_call_result bytes - in - match result with - | Ok (Ok {gas_used = Some (Qty gas_used); value}) -> - (* See EIP2200 for reference. But the tl;dr is: we cannot do the - opcode SSTORE if we have less than 2300 gas available, even - if we don't consume it. The simulated amount then gives an - amount of gas insufficient to execute the transaction. - - The extra gas units, i.e. 2300, will be refunded. - *) - let simulated_amount = Z.(add gas_used (of_int 2300)) in - (* add a safety margin of 2%, sufficient to cover a 1/64th difference *) - let simulated_amount = - Z.(add simulated_amount (cdiv simulated_amount (of_int 50))) - in - return - @@ Ok (Ok {gas_used = Some (quantity_of_z @@ simulated_amount); value}) - | _ -> return result - -let is_tx_valid bytes = - Encodings.simulation_result_from_rlp Encodings.decode_validation_result bytes diff --git a/etherlink/bin_node/lib_prod/simulator.ml b/etherlink/bin_node/lib_prod/simulator.ml deleted file mode 100644 index 419df6f88e0bfae9ea97d085f8e7f0f1aeadf522..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/simulator.ml +++ /dev/null @@ -1,87 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -module type SimulationBackend = sig - val simulate_and_read : - input:Simulation.Encodings.simulate_input -> bytes tzresult Lwt.t -end - -(* This value is a hard maximum used by estimateGas. Set at Int64.max_int / 2 *) -let max_gas_limit = Z.of_int64 0x3FFFFFFFFFFFFFFFL - -module Make (SimulationBackend : SimulationBackend) = struct - let call_simulation ~log_file ~input_encoder ~input = - let open Lwt_result_syntax in - let*? messages = input_encoder input in - let insight_requests = - [Simulation.Encodings.Durable_storage_key ["evm"; "simulation_result"]] - in - SimulationBackend.simulate_and_read - ~input: - { - messages; - reveal_pages = None; - insight_requests; - log_kernel_debug_file = Some log_file; - } - - let simulate_call call = - let open Lwt_result_syntax in - let* bytes = - call_simulation - ~log_file:"simulate_call" - ~input_encoder:Simulation.encode - ~input:call - in - Lwt.return (Simulation.simulation_result bytes) - - let call_estimate_gas call = - let open Lwt_result_syntax in - let* bytes = - call_simulation - ~log_file:"estimate_gas" - ~input_encoder:Simulation.encode - ~input:call - in - Lwt.return (Simulation.gas_estimation bytes) - - let rec confirm_gas (call : Ethereum_types.call) gas = - let open Ethereum_types in - let open Lwt_result_syntax in - let double (Qty z) = Qty Z.(mul (of_int 2) z) in - let reached_max (Qty z) = z >= max_gas_limit in - let new_call = {call with gas = Some gas} in - let* result = call_estimate_gas new_call in - match result with - | Error _ | Ok (Error _) -> - (* TODO: https://gitlab.com/tezos/tezos/-/issues/6984 - All errors should not be treated the same *) - let new_gas = double gas in - if reached_max new_gas then - failwith "Gas estimate reached max gas limit." - else confirm_gas call new_gas - | Ok (Ok _) -> return gas - - let estimate_gas call = - let open Lwt_result_syntax in - let* res = call_estimate_gas call in - match res with - | Ok (Ok {gas_used = Some gas; value}) -> - let+ gas_used = confirm_gas call gas in - Ok (Ok {Simulation.gas_used = Some gas_used; value}) - | _ -> return res - - let is_tx_valid tx_raw = - let open Lwt_result_syntax in - let* bytes = - call_simulation - ~log_file:"tx_validity" - ~input_encoder:Simulation.encode_tx - ~input:tx_raw - in - Lwt.return (Simulation.is_tx_valid bytes) -end diff --git a/etherlink/bin_node/lib_prod/transaction_format.ml b/etherlink/bin_node/lib_prod/transaction_format.ml deleted file mode 100644 index 3e51c177b760b8cf9951825e1945872d4f6f30b3..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/transaction_format.ml +++ /dev/null @@ -1,87 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Nomadic Labs *) -(* *) -(*****************************************************************************) - -(* The hard limit is 4096 but it needs to add the external message tag. *) -let max_input_size = 4095 - -let smart_rollup_address_size = 20 - -let transaction_tag_size = 1 - -let framing_protocol_tag_size = 1 - -type transaction = - | Simple of string - | NewChunked of (string * int * string) - | Chunk of string - -let encode_transaction ~smart_rollup_address kind = - let data = - match kind with - | Simple data -> "\000" ^ data - | NewChunked (tx_hash, len, all_chunk_hashes) -> - let number_of_chunks_bytes = Ethereum_types.u16_to_bytes len in - "\001" ^ tx_hash ^ number_of_chunks_bytes ^ all_chunk_hashes - | Chunk data -> "\002" ^ data - in - "\000" ^ smart_rollup_address ^ data - -let chunk_transaction ~tx_hash ~tx_raw = - let open Result_syntax in - let size_per_chunk = - max_input_size - framing_protocol_tag_size - smart_rollup_address_size - - transaction_tag_size - 2 (* Index as u16 *) - - (Ethereum_types.transaction_hash_size * 2) - in - let* chunks = String.chunk_bytes size_per_chunk (Bytes.of_string tx_raw) in - let all_chunk_hashes, chunks = - List.fold_left_i - (fun i (all_chunk_hashes, chunks) chunk -> - let chunk_hash = Ethereum_types.hash_raw_tx chunk in - let all_chunk_hashes = all_chunk_hashes ^ chunk_hash in - let chunk = - Chunk (tx_hash ^ Ethereum_types.u16_to_bytes i ^ chunk_hash ^ chunk) - in - (all_chunk_hashes, chunk :: chunks)) - ("", []) - chunks - in - let new_chunk_transaction = - NewChunked (tx_hash, List.length chunks, all_chunk_hashes) - in - return (tx_hash, new_chunk_transaction :: chunks) - -let make_evm_inbox_transactions tx_raw = - let open Result_syntax in - (* Maximum size describes the maximum size of [tx_raw] to fit - in a simple transaction. *) - let maximum_size = - max_input_size - framing_protocol_tag_size - smart_rollup_address_size - - transaction_tag_size - Ethereum_types.transaction_hash_size - in - let tx_hash = Ethereum_types.hash_raw_tx tx_raw in - if String.length tx_raw <= maximum_size then - (* Simple transaction, fits in a single input. *) - let tx = Simple (tx_hash ^ tx_raw) in - return (tx_hash, [tx]) - else chunk_transaction ~tx_hash ~tx_raw - -(** [make_encoded_messages ~smart_rollup_address raw_tx] returns the - hash of the transaction, and a list of transactions to include in the inbox. - - [smart_rollup_address] is encoded on 20 bytes - - [raw_tx] is an ethereum transaction in hex format (without the 0x prefix). - - All messages go through the same encoding, but will only be chunked if - necessary. *) -let make_encoded_messages ~smart_rollup_address tx_raw = - let open Result_syntax in - let* tx_hash, messages = make_evm_inbox_transactions tx_raw in - let tx_hash = - Ethereum_types.(Hash Hex.(of_string tx_hash |> show |> hex_of_string)) - in - let messages = List.map (encode_transaction ~smart_rollup_address) messages in - return (tx_hash, messages) diff --git a/etherlink/bin_node/lib_prod/tx_pool.ml b/etherlink/bin_node/lib_prod/tx_pool.ml deleted file mode 100644 index d18ced26f18e12728acaba8453a11b976ebe66bd..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/tx_pool.ml +++ /dev/null @@ -1,675 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Marigold *) -(* Copyright (c) 2024 Functori *) -(* *) -(*****************************************************************************) - -module Pool = struct - module Pkey_map = Map.Make (Ethereum_types.Address) - module Nonce_map = Map.Make (Z) - - (** Transaction stored in the pool. *) - type transaction = { - index : int64; (* Global index of the transaction. *) - raw_tx : string; (* Current transaction. *) - gas_price : Z.t; (* The maximum price the user can pay for fees. *) - gas_limit : Z.t; (* The maximum limit the user can reach in terms of gas. *) - inclusion_timestamp : Time.Protocol.t; - (* Time of inclusion in the transaction pool. *) - } - - type t = { - transactions : transaction Nonce_map.t Pkey_map.t; - global_index : int64; (* Index to order the transactions. *) - } - - let empty : t = {transactions = Pkey_map.empty; global_index = Int64.zero} - - (** Add a transaction to the pool. *) - let add {transactions; global_index} pkey raw_tx = - let open Result_syntax in - let* nonce = Ethereum_types.transaction_nonce raw_tx in - let* gas_price = Ethereum_types.transaction_gas_price raw_tx in - let* gas_limit = Ethereum_types.transaction_gas_limit raw_tx in - let inclusion_timestamp = Helpers.now () in - (* Add the transaction to the user's transaction map *) - let transactions = - let transaction = - { - index = global_index; - raw_tx; - gas_price; - gas_limit; - inclusion_timestamp; - } - in - Pkey_map.update - pkey - (function - | None -> - (* User has no transactions in the pool *) - Some (Nonce_map.singleton nonce transaction) - | Some user_transactions -> - Some - (Nonce_map.update - nonce - (function - | None -> Some transaction - | Some user_transaction -> - if gas_price > user_transaction.gas_price then - Some transaction - else Some user_transaction) - user_transactions)) - transactions - in - return {transactions; global_index = Int64.(add global_index one)} - - (** Returns all the addresses of the pool *) - let addresses {transactions; _} = - Pkey_map.bindings transactions |> List.map fst - - (** Returns the transaction matching the predicate. - And remove them from the pool. *) - let partition pkey predicate {transactions; global_index} = - (* Get the sequence of transaction *) - let selected, remaining = - transactions |> Pkey_map.find pkey - |> Option.value ~default:Nonce_map.empty - |> Nonce_map.partition predicate - in - (* Remove transactions from the public key map if empty *) - let transactions = - if Nonce_map.is_empty remaining then Pkey_map.remove pkey transactions - else Pkey_map.add pkey remaining transactions - in - (* Convert the sequence to a list *) - let selected = selected |> Nonce_map.bindings |> List.map snd in - (selected, {transactions; global_index}) - - (** Removes from the pool the transactions matching the predicate - for the given pkey. *) - let remove pkey predicate t = - let _txs, t = partition pkey predicate t in - t - - (** Returns the next nonce for a given user. - Returns the given nonce if the user does not have any transactions in the pool. *) - let next_nonce pkey current_nonce (t : t) = - let open Ethereum_types in - let ({transactions; _} : t) = t in - (* Retrieves the list of transactions for a given user. *) - let user_transactions = - Pkey_map.find pkey transactions - |> Option.value ~default:Nonce_map.empty - |> Nonce_map.bindings |> List.map fst - in - let rec aux current_nonce = function - | [] -> current_nonce - | nonce :: txs -> - if current_nonce > nonce then aux current_nonce txs - else if current_nonce = nonce then - (aux [@tailcall]) Z.(add current_nonce one) txs - else current_nonce - in - let (Qty current_nonce) = current_nonce in - aux current_nonce user_transactions |> Ethereum_types.quantity_of_z -end - -type mode = Proxy | Sequencer | Observer - -type parameters = { - rollup_node : (module Services_backend_sig.S); - smart_rollup_address : string; - mode : mode; - tx_timeout_limit : int64; - tx_pool_addr_limit : int; - tx_pool_tx_per_addr_limit : int; - max_number_of_chunks : int option; -} - -module Types = struct - type state = { - rollup_node : (module Services_backend_sig.S); - smart_rollup_address : string; - mutable pool : Pool.t; - mode : mode; - tx_timeout_limit : int64; - tx_pool_addr_limit : int; - tx_pool_tx_per_addr_limit : int; - max_number_of_chunks : int option; - mutable locked : bool; - } - - type nonrec parameters = parameters -end - -module Name = struct - (* We only have a single tx-pool in the evm node *) - type t = unit - - let encoding = Data_encoding.unit - - let base = ["evm_node"; "tx-pool"; "prod"; "worker"] - - let pp _ _ = () - - let equal () () = true -end - -module Request = struct - type ('a, 'b) t = - | Add_transaction : - string - -> ((Ethereum_types.hash, string) result, tztrace) t - | Pop_transactions : int -> (string list, tztrace) t - | Pop_and_inject_transactions : (unit, tztrace) t - | Lock_transactions : (unit, tztrace) t - | Unlock_transactions : (unit, tztrace) t - | Is_locked : (bool, tztrace) t - - type view = View : _ t -> view - - let view req = View req - - let encoding = - let open Data_encoding in - union - [ - case - (Tag 0) - ~title:"Add_transaction" - (obj2 - (req "request" (constant "add_transaction")) - (req "transaction" string)) - (function - | View (Add_transaction transaction) -> Some ((), transaction) - | _ -> None) - (fun ((), transaction) -> View (Add_transaction transaction)); - case - (Tag 1) - ~title:"Pop_transactions" - (obj2 - (req "request" (constant "pop_transactions")) - (req "maximum_cumulatize_size" int31)) - (function - | View (Pop_transactions maximum_cumulative_size) -> - Some ((), maximum_cumulative_size) - | _ -> None) - (fun ((), maximum_cumulative_size) -> - View (Pop_transactions maximum_cumulative_size)); - case - (Tag 2) - ~title:"Pop_and_inject_transactions" - (obj1 (req "request" (constant "pop_and_inject_transactions"))) - (function View Pop_and_inject_transactions -> Some () | _ -> None) - (fun () -> View Pop_and_inject_transactions); - case - (Tag 3) - ~title:"Lock_transactions" - (obj1 (req "request" (constant "lock_transactions"))) - (function View Lock_transactions -> Some () | _ -> None) - (fun () -> View Lock_transactions); - case - (Tag 4) - ~title:"Unlock_transactions" - (obj1 (req "request" (constant "unlock_transactions"))) - (function View Unlock_transactions -> Some () | _ -> None) - (fun () -> View Unlock_transactions); - case - (Tag 5) - ~title:"Is_locked" - (obj1 (req "request" (constant "is_locked"))) - (function View Is_locked -> Some () | _ -> None) - (fun () -> View Is_locked); - ] - - let pp ppf (View r) = - match r with - | Add_transaction tx_raw -> - Format.fprintf - ppf - "Add tx [%s] to tx-pool" - (Hex.of_string tx_raw |> Hex.show) - | Pop_transactions maximum_cumulative_size -> - Format.fprintf - ppf - "Popping transactions of maximum cumulative size %d bytes" - maximum_cumulative_size - | Pop_and_inject_transactions -> - Format.fprintf ppf "Popping and injecting transactions" - | Lock_transactions -> Format.fprintf ppf "Locking the transactions" - | Unlock_transactions -> Format.fprintf ppf "Unlocking the transactions" - | Is_locked -> Format.fprintf ppf "Checking if the tx pool is locked" -end - -module Worker = Worker.MakeSingle (Name) (Request) (Types) - -type worker = Worker.infinite Worker.queue Worker.t - -let tx_data_size_limit_reached ~max_number_of_chunks ~tx_data = - let maximum_chunks_per_l1_level = - Option.value - ~default:Sequencer_blueprint.maximum_chunks_per_l1_level - max_number_of_chunks - in - Bytes.length tx_data - > Sequencer_blueprint.maximum_usable_space_in_blueprint - (* Minus one so that the "rest" of the raw transaction can - be contained within one of the chunks. *) - (maximum_chunks_per_l1_level - 1) - -let check_address_boundaries ~pool ~address ~tx_pool_addr_limit - ~tx_pool_tx_per_addr_limit = - let open Lwt_result_syntax in - let boundaries_are_not_reached = return (false, "") in - match Pool.Pkey_map.find address pool.Pool.transactions with - | None -> - if Pool.Pkey_map.cardinal pool.Pool.transactions < tx_pool_addr_limit then - boundaries_are_not_reached - else - let*! () = Tx_pool_events.users_threshold_reached () in - return - ( true, - "The transaction pool has reached its maximum threshold for user \ - transactions. Transaction is rejected." ) - | Some txs -> - if Pool.Nonce_map.cardinal txs < tx_pool_tx_per_addr_limit then - boundaries_are_not_reached - else - let*! () = - Tx_pool_events.txs_per_user_threshold_reached - ~address:(Ethereum_types.Address.to_string address) - in - return - ( true, - "Limit of transaction for a user was reached. Transaction is \ - rejected." ) - -let on_normal_transaction state tx_raw = - let open Lwt_result_syntax in - let open Types in - let { - rollup_node = (module Rollup_node); - pool; - tx_pool_addr_limit; - tx_pool_tx_per_addr_limit; - max_number_of_chunks; - _; - } = - state - in - let* is_valid = Rollup_node.is_tx_valid tx_raw in - match is_valid with - | Error err -> - let*! () = - Tx_pool_events.invalid_transaction - ~transaction:(Hex.of_string tx_raw |> Hex.show) - in - return (Error err) - | Ok {address} -> - let*? tx_data = Ethereum_types.transaction_data tx_raw in - if tx_data_size_limit_reached ~max_number_of_chunks ~tx_data then - let*! () = Tx_pool_events.tx_data_size_limit_reached () in - return @@ Error "Transaction data exceeded the allowed size." - else - let* address_boundaries_are_reached, error_msg = - check_address_boundaries - ~pool - ~address - ~tx_pool_addr_limit - ~tx_pool_tx_per_addr_limit - in - if address_boundaries_are_reached then return @@ Error error_msg - else - (* Add the transaction to the pool *) - let*? pool = Pool.add pool address tx_raw in - (* Compute the hash *) - let tx_hash = Ethereum_types.hash_raw_tx tx_raw in - let hash = - Ethereum_types.hash_of_string Hex.(of_string tx_hash |> show) - in - let*! () = - Tx_pool_events.add_transaction - ~transaction:(Ethereum_types.hash_to_string hash) - in - state.pool <- pool ; - return (Ok hash) - -(** Checks that [balance] is enough to pay up to the maximum [gas_limit] - the sender defined parametrized by the [gas_price]. *) -let can_prepay ~balance ~gas_price ~gas_limit = - balance >= Z.(gas_limit * gas_price) - -(** Checks that the transaction can be payed given the [gas_price] that was set - and the current [base_fee_per_gas]. *) -let can_pay_with_current_base_fee ~gas_price ~base_fee_per_gas = - gas_price >= base_fee_per_gas - -(** Check if a transaction timed out since the moment it was included in the - transaction pool. *) -let transaction_timed_out ~tx_timeout_limit ~current_timestamp - ~inclusion_timestamp = - Time.Protocol.diff current_timestamp inclusion_timestamp >= tx_timeout_limit - -let pop_transactions state ~maximum_cumulative_size = - let open Lwt_result_syntax in - let Types. - { - rollup_node = (module Rollup_node : Services_backend_sig.S); - pool; - locked; - tx_timeout_limit; - _; - } = - state - in - if locked then return [] - else - (* Get all the addresses in the tx-pool. *) - let addresses = Pool.addresses pool in - (* Get the nonce related to each address. *) - let*! addr_with_nonces = - Lwt_list.map_p - (fun address -> - let* nonce = Rollup_node.nonce address in - let (Qty nonce) = Option.value ~default:(Qty Z.zero) nonce in - let* (Qty balance) = Rollup_node.balance address in - Lwt.return_ok (address, balance, nonce)) - addresses - in - let addr_with_nonces = List.filter_ok addr_with_nonces in - (* Remove transactions with too low nonce, timed-out and the ones that - can not be prepayed anymore. *) - let* (Qty base_fee_per_gas) = Rollup_node.base_fee_per_gas () in - let current_timestamp = Helpers.now () in - let pool = - addr_with_nonces - |> List.fold_left - (fun pool (pkey, balance, current_nonce) -> - Pool.remove - pkey - (fun nonce {gas_limit; gas_price; inclusion_timestamp; _} -> - nonce < current_nonce - || (not (can_prepay ~balance ~gas_price ~gas_limit)) - || transaction_timed_out - ~current_timestamp - ~inclusion_timestamp - ~tx_timeout_limit) - pool) - pool - in - (* Select transaction with nonce equal to user's nonce, that can be prepaid - and selects a sum of transactions that wouldn't go above the size limit - of the blueprint. - Also removes the transactions from the pool. *) - let txs, pool, _ = - addr_with_nonces - |> List.fold_left - (fun (txs, pool, cumulative_size) (pkey, _, current_nonce) -> - (* This mutable counter is purely local and used only for the - partition. *) - let accumulated_size = ref cumulative_size in - let selected, pool = - Pool.partition - pkey - (fun nonce {gas_price; raw_tx; _} -> - let check_nonce = nonce = current_nonce in - let can_fit = - !accumulated_size + String.length raw_tx - <= maximum_cumulative_size - in - let can_pay = - can_pay_with_current_base_fee ~gas_price ~base_fee_per_gas - in - let selected = check_nonce && can_pay && can_fit in - (* If the transaction is selected, this means it will fit *) - if selected then - accumulated_size := - !accumulated_size + String.length raw_tx ; - selected) - pool - in - let txs = List.append txs selected in - (txs, pool, !accumulated_size)) - ([], pool, 0) - in - (* Sorting transactions by index. - First tx in the pool is the first tx to be sent to the batcher. *) - let txs = - txs - |> List.sort (fun Pool.{index = index_a; _} {index = index_b; _} -> - Int64.compare index_a index_b) - |> List.map (fun Pool.{raw_tx; _} -> raw_tx) - in - (* update the pool *) - state.pool <- pool ; - return txs - -let pop_and_inject_transactions state = - let open Lwt_result_syntax in - let open Types in - match state.mode with - | Sequencer -> - failwith - "Internal error: the sequencer is not supposed to use this function" - | Observer | Proxy -> - (* We over approximate the number of transactions to pop in proxy and - observer mode to the maximum size an L1 block can hold. If the proxy - sends more, they won't be applied at the next level. For the observer, - it prevents spamming the sequencer. *) - let maximum_cumulative_size = - Sequencer_blueprint.maximum_usable_space_in_blueprint - Sequencer_blueprint.maximum_chunks_per_l1_level - in - let* txs = pop_transactions state ~maximum_cumulative_size in - if not (List.is_empty txs) then - let (module Rollup_node : Services_backend_sig.S) = state.rollup_node in - let*! hashes = - Rollup_node.inject_raw_transactions - (* The timestamp is ignored in observer and proxy mode, it's just for - compatibility with sequencer mode. *) - ~timestamp:(Helpers.now ()) - ~smart_rollup_address:state.smart_rollup_address - ~transactions:txs - in - match hashes with - | Error trace -> - let*! () = Tx_pool_events.transaction_injection_failed trace in - return_unit - | Ok hashes -> - let*! () = - List.iter_s - (fun hash -> Tx_pool_events.transaction_injected ~hash) - hashes - in - return_unit - else return_unit - -let lock_transactions state = state.Types.locked <- true - -let unlock_transactions state = state.Types.locked <- false - -let is_locked state = state.Types.locked - -module Handlers = struct - type self = worker - - let observer_self_inject_request w = - let open Lwt_result_syntax in - let state = Worker.state w in - match state.mode with - | Observer -> - let*! _ = - Worker.Queue.push_request w Request.Pop_and_inject_transactions - in - return_unit - | Sequencer | Proxy -> return_unit - - let on_request : - type r request_error. - worker -> (r, request_error) Request.t -> (r, request_error) result Lwt.t - = - fun w request -> - let open Lwt_result_syntax in - let state = Worker.state w in - match request with - | Request.Add_transaction transaction -> - protect @@ fun () -> - let* res = on_normal_transaction state transaction in - let* () = observer_self_inject_request w in - return res - | Request.Pop_transactions maximum_cumulative_size -> - protect @@ fun () -> pop_transactions state ~maximum_cumulative_size - | Request.Pop_and_inject_transactions -> - protect @@ fun () -> pop_and_inject_transactions state - | Request.Lock_transactions -> - protect @@ fun () -> return (lock_transactions state) - | Request.Unlock_transactions -> return (unlock_transactions state) - | Request.Is_locked -> protect @@ fun () -> return (is_locked state) - - type launch_error = error trace - - let on_launch _w () - ({ - rollup_node; - smart_rollup_address; - mode; - tx_timeout_limit; - tx_pool_addr_limit; - tx_pool_tx_per_addr_limit; - max_number_of_chunks; - } : - Types.parameters) = - let state = - Types. - { - rollup_node; - smart_rollup_address; - pool = Pool.empty; - mode; - tx_timeout_limit; - tx_pool_addr_limit; - tx_pool_tx_per_addr_limit; - max_number_of_chunks; - locked = false; - } - in - Lwt_result_syntax.return state - - let on_error (type a b) _w _st (_r : (a, b) Request.t) (_errs : b) : - unit tzresult Lwt.t = - Lwt_result_syntax.return_unit - - let on_completion _ _ _ _ = Lwt.return_unit - - let on_no_request _ = Lwt.return_unit - - let on_close _ = Lwt.return_unit -end - -let table = Worker.create_table Queue - -let worker_promise, worker_waker = Lwt.task () - -type error += No_worker - -type error += Tx_pool_terminated - -let worker = - lazy - (match Lwt.state worker_promise with - | Lwt.Return worker -> Ok worker - | Lwt.Fail e -> Result_syntax.tzfail (error_of_exn e) - | Lwt.Sleep -> Result_syntax.tzfail No_worker) - -let bind_worker f = - let open Lwt_result_syntax in - let res = Lazy.force worker in - match res with - | Error [No_worker] -> - (* There is no worker, nothing to do *) - return_unit - | Error errs -> fail errs - | Ok w -> f w - -let handle_request_error rq = - let open Lwt_syntax in - let* rq in - match rq with - | Ok res -> return_ok res - | Error (Worker.Request_error errs) -> Lwt.return_error errs - | Error (Closed None) -> Lwt.return_error [Tx_pool_terminated] - | Error (Closed (Some errs)) -> Lwt.return_error errs - | Error (Any exn) -> Lwt.return_error [Exn exn] - -let start parameters = - let open Lwt_result_syntax in - let+ worker = Worker.launch table () parameters (module Handlers) in - Lwt.wakeup worker_waker worker - -let shutdown () = - let open Lwt_result_syntax in - bind_worker @@ fun w -> - let*! () = Tx_pool_events.shutdown () in - let*! () = Worker.shutdown w in - return_unit - -let add raw_tx = - let open Lwt_result_syntax in - let*? w = Lazy.force worker in - Worker.Queue.push_request_and_wait w (Request.Add_transaction raw_tx) - |> handle_request_error - -let nonce pkey = - let open Lwt_result_syntax in - let*? w = Lazy.force worker in - let Types.{rollup_node = (module Rollup_node); pool; _} = Worker.state w in - let* current_nonce = Rollup_node.nonce pkey in - let next_nonce = - match current_nonce with - | None -> Ethereum_types.Qty Z.zero - | Some current_nonce -> Pool.next_nonce pkey current_nonce pool - in - return next_nonce - -let pop_transactions ~maximum_cumulative_size = - let open Lwt_result_syntax in - let*? worker = Lazy.force worker in - Worker.Queue.push_request_and_wait - worker - (Request.Pop_transactions maximum_cumulative_size) - |> handle_request_error - -let pop_and_inject_transactions () = - let open Lwt_result_syntax in - let*? worker = Lazy.force worker in - Worker.Queue.push_request_and_wait worker Request.Pop_and_inject_transactions - |> handle_request_error - -let pop_and_inject_transactions_lazy () = - let open Lwt_result_syntax in - bind_worker @@ fun w -> - let*! (_pushed : bool) = - Worker.Queue.push_request w Request.Pop_and_inject_transactions - in - return_unit - -let lock_transactions () = - let open Lwt_result_syntax in - let*? worker = Lazy.force worker in - Worker.Queue.push_request_and_wait worker Request.Lock_transactions - |> handle_request_error - -let unlock_transactions () = - let open Lwt_result_syntax in - let*? worker = Lazy.force worker in - Worker.Queue.push_request_and_wait worker Request.Unlock_transactions - |> handle_request_error - -let is_locked () = - let open Lwt_result_syntax in - let*? worker = Lazy.force worker in - Worker.Queue.push_request_and_wait worker Request.Is_locked - |> handle_request_error diff --git a/etherlink/bin_node/lib_prod/tx_pool.mli b/etherlink/bin_node/lib_prod/tx_pool.mli deleted file mode 100644 index 0ba90526ea6f66807a5debc80c0f3a7fbb22d8f3..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/tx_pool.mli +++ /dev/null @@ -1,63 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2023 Marigold *) -(* Copyright (c) 2024 Functori *) -(* *) -(*****************************************************************************) - -type mode = Proxy | Sequencer | Observer - -type parameters = { - rollup_node : (module Services_backend_sig.S); (** The backend RPC module. *) - smart_rollup_address : string; (** The address of the smart rollup. *) - mode : mode; - tx_timeout_limit : int64; (** TTL of a transaction inside the pool. *) - tx_pool_addr_limit : int; (** Maximum allowed addresses inside the pool. *) - tx_pool_tx_per_addr_limit : int; - (** Maximum allowed transactions per address inside the pool. *) - max_number_of_chunks : int option; - (** Maximum allowed number of chunks to be sent (relevant for the - sequencer). *) -} - -(** [start parameters] starts the tx-pool *) -val start : parameters -> unit tzresult Lwt.t - -(** [shutdown ()] stops the tx-pool, waiting for the ongoing request - to be processed. *) -val shutdown : unit -> unit tzresult Lwt.t - -(** [add raw_tx] adds a raw eth transaction to the tx-pool. *) -val add : string -> (Ethereum_types.hash, string) result tzresult Lwt.t - -(** [nonce address] returns the nonce of the user - Returns the first gap in the tx-pool, or the nonce stored on the rollup - if no transactions are in the pool. *) -val nonce : Ethereum_types.Address.t -> Ethereum_types.quantity tzresult Lwt.t - -(** [pop_transactions maximum_cumulative_size] pops as much valid transactions - as possible from the pool, until their cumulative size exceeds - `maximum_cumulative_size`. Returns no transactions if the pool is locked. *) -val pop_transactions : maximum_cumulative_size:int -> string list tzresult Lwt.t - -(** [pop_and_inject_transactions ()] pops the valid transactions from - the pool using {!pop_transactions} and injects them using - [inject_raw_transactions] provided by {!parameters.rollup_node}. *) -val pop_and_inject_transactions : unit -> unit tzresult Lwt.t - -(** [pop_and_inject_transactions_lazy ()] same as - [pop_and_inject_transactions] but don't wait for the request to - complete *) -val pop_and_inject_transactions_lazy : unit -> unit tzresult Lwt.t - -(** [lock_transactions] locks the transactions in the pool, new transactions - can be added but nothing can be retrieved with {!pop_transactions}. *) -val lock_transactions : unit -> unit tzresult Lwt.t - -(** [unlock_transactions] unlocks the transactions if it was locked by - {!lock_transactions}. *) -val unlock_transactions : unit -> unit tzresult Lwt.t - -(** [is_locked] checks if the pools is locked. *) -val is_locked : unit -> bool tzresult Lwt.t diff --git a/etherlink/bin_node/lib_prod/tx_pool_events.ml b/etherlink/bin_node/lib_prod/tx_pool_events.ml deleted file mode 100644 index aa8fe59141d088c0dd3e41e3c56c415f32691466..0000000000000000000000000000000000000000 --- a/etherlink/bin_node/lib_prod/tx_pool_events.ml +++ /dev/null @@ -1,135 +0,0 @@ -(*****************************************************************************) -(* *) -(* SPDX-License-Identifier: MIT *) -(* Copyright (c) 2024 Nomadic Labs *) -(* *) -(*****************************************************************************) - -module Event = struct - open Internal_event.Simple - - let section = Events.section - - let started = - declare_0 - ~section - ~name:"tx_pool_started" - ~msg:"Tx-pool has been started" - ~level:Notice - () - - let add_transaction = - declare_1 - ~section - ~name:"tx_pool_add_transaction" - ~msg:"Add transaction {transaction} to the tx-pool" - ~level:Info - ("transaction", Data_encoding.string) - ~pp1:Format.pp_print_string - - let invalid_transaction = - declare_1 - ~section - ~name:"tx_pool_invalid_transaction" - ~msg:"Transaction {transaction} is not valid" - ~level:Info - ("transaction", Data_encoding.string) - ~pp1:Format.pp_print_string - - let users_threshold_reached = - declare_0 - ~section - ~name:"tx_pool_users_threshold_reached" - ~msg: - "The transaction pool has reached its maximum threshold for user \ - transactions" - ~level:Info - () - - let txs_per_user_threshold_reached = - declare_1 - ~section - ~name:"txs_per_user_threshold_reached" - ~msg:"User {address} has reached the maximum threshold for transactions" - ~level:Info - ("address", Data_encoding.string) - ~pp1:Format.pp_print_string - - let tx_data_size_limit_reached = - declare_0 - ~section - ~name:"tx_data_size_limit_reached" - ~msg:"The transaction data size is beyond the allowed threshold." - ~level:Info - () - - let transaction_injected = - declare_1 - ~section - ~name:"tx_pool_transaction_injected" - ~msg:"Transaction {transaction} has been injected" - ~level:Info - ("transaction", Ethereum_types.hash_encoding) - ~pp1:Ethereum_types.pp_hash - - let transaction_injection_failed = - declare_1 - ~section - ~name:"tx_pool_transaction_injection_failed" - ~msg:"Injection of transactions failed" - ~level:Error - ("trace", trace_encoding) - - let connection_lost = - declare_0 - ~section - ~name:"tx_pool_connection_lost" - ~msg:"Connection with the rollup node has been lost, retrying..." - ~level:Error - () - - let stopped = - declare_0 - ~section - ~name:"tx_pool_stopped" - ~msg:"Tx-pool has been stopped" - ~level:Notice - () - - let shutdown = - declare_0 - ~section - ~name:"shutting_down_tx_pool" - ~msg:"Stopping the tx-pool" - ~level:Notice - () -end - -let started = Internal_event.Simple.emit Event.started - -let add_transaction ~transaction = - Internal_event.Simple.emit Event.add_transaction transaction - -let invalid_transaction ~transaction = - Internal_event.Simple.emit Event.invalid_transaction transaction - -let users_threshold_reached = - Internal_event.Simple.emit Event.users_threshold_reached - -let txs_per_user_threshold_reached ~address = - Internal_event.Simple.emit Event.txs_per_user_threshold_reached address - -let tx_data_size_limit_reached = - Internal_event.Simple.emit Event.tx_data_size_limit_reached - -let transaction_injection_failed trace = - Internal_event.Simple.emit Event.transaction_injection_failed trace - -let transaction_injected ~hash = - Internal_event.Simple.emit Event.transaction_injected hash - -let connection_lost = Internal_event.Simple.emit Event.connection_lost - -let stopped = Internal_event.Simple.emit Event.stopped - -let shutdown = Internal_event.Simple.emit Event.shutdown diff --git a/etherlink/bin_node/main.ml b/etherlink/bin_node/main.ml index 8923f31e00856ef33d136dc6bc63db1d24d9d9b6..3eabb0ac3115f81e4a0ba74fd37e72c10074095f 100644 --- a/etherlink/bin_node/main.ml +++ b/etherlink/bin_node/main.ml @@ -187,7 +187,20 @@ let cors_allowed_origins_arg = Params.string_list let devmode_arg = - Tezos_clic.switch ~long:"devmode" ~doc:"The EVM node in development mode." () + Tezos_clic.switch + ~long:"devmode" + ~doc: + "DEPRECATED — The EVM node now aims to be backward compatible with the \ + kernel deployed on Mainnet and Ghostnet" + () + +let mainnet_compat_arg = + Tezos_clic.switch + ~long:"mainnet-compat" + ~doc: + "Generate a configuration compatible with the first Etherlink Mainnet \ + kernel" + () let profile_arg = Tezos_clic.switch @@ -478,7 +491,7 @@ let assert_rollup_node_endpoint_equal ~arg ~param = ] else Ok () -let start_proxy ~data_dir ~devmode ~keep_alive ?rpc_addr ?rpc_port ?cors_origins +let start_proxy ~data_dir ~keep_alive ?rpc_addr ?rpc_port ?cors_origins ?cors_headers ?log_filter_max_nb_blocks ?log_filter_max_nb_logs ?log_filter_chunk_size ?rollup_node_endpoint ?tx_pool_timeout_limit ?tx_pool_addr_limit ?tx_pool_tx_per_addr_limit ~verbose ~read_only () = @@ -486,7 +499,6 @@ let start_proxy ~data_dir ~devmode ~keep_alive ?rpc_addr ?rpc_port ?cors_origins let* config = Cli.create_or_read_config ~data_dir - ~devmode ~keep_alive ?rpc_addr ?rpc_port @@ -521,10 +533,7 @@ let start_proxy ~data_dir ~devmode ~keep_alive ?rpc_addr ?rpc_port ?cors_origins init ~config:(make_with_defaults ~verbosity:config.verbose ()) () in let*! () = Internal_event.Simple.emit Event.event_starting "proxy" in - let* () = - if config.devmode then Evm_node_lib_dev.Proxy.main config - else Evm_node_lib_prod.Proxy.main config - in + let* () = Evm_node_lib_dev.Proxy.main config in let wait, _resolve = Lwt.wait () in let* () = wait in return_unit @@ -548,7 +557,7 @@ let proxy_command = (fun ( ( data_dir, rpc_addr, rpc_port, - devmode, + _devmode, cors_origins, cors_headers, log_filter_max_nb_blocks, @@ -573,7 +582,6 @@ let proxy_command = in start_proxy ~data_dir - ~devmode ~keep_alive ?rpc_addr ?rpc_port @@ -602,14 +610,14 @@ let register_wallet ?password_filename ~wallet_dir () = in wallet_ctxt -let start_sequencer ?password_filename ~wallet_dir ~data_dir ~devmode ?rpc_addr - ?rpc_port ?cors_origins ?cors_headers ?tx_pool_timeout_limit - ?tx_pool_addr_limit ?tx_pool_tx_per_addr_limit ~keep_alive - ?rollup_node_endpoint ~verbose ?preimages ?preimages_endpoint - ?time_between_blocks ?max_number_of_chunks ?private_rpc_port ?sequencer_str - ?max_blueprints_lag ?max_blueprints_ahead ?max_blueprints_catchup - ?catchup_cooldown ?log_filter_max_nb_blocks ?log_filter_max_nb_logs - ?log_filter_chunk_size ?genesis_timestamp ?kernel () = +let start_sequencer ?password_filename ~wallet_dir ~data_dir ?rpc_addr ?rpc_port + ?cors_origins ?cors_headers ?tx_pool_timeout_limit ?tx_pool_addr_limit + ?tx_pool_tx_per_addr_limit ~keep_alive ?rollup_node_endpoint ~verbose + ?preimages ?preimages_endpoint ?time_between_blocks ?max_number_of_chunks + ?private_rpc_port ?sequencer_str ?max_blueprints_lag ?max_blueprints_ahead + ?max_blueprints_catchup ?catchup_cooldown ?log_filter_max_nb_blocks + ?log_filter_max_nb_logs ?log_filter_chunk_size ?genesis_timestamp ?kernel () + = let open Lwt_result_syntax in let wallet_ctxt = register_wallet ?password_filename ~wallet_dir () in let* sequencer_key = @@ -620,7 +628,6 @@ let start_sequencer ?password_filename ~wallet_dir ~data_dir ~devmode ?rpc_addr let* configuration = Cli.create_or_read_config ~data_dir - ~devmode ?rpc_addr ?rpc_port ?cors_origins @@ -668,25 +675,17 @@ let start_sequencer ?password_filename ~wallet_dir ~data_dir ~devmode ?rpc_addr init ~config () in let*! () = Internal_event.Simple.emit Event.event_starting "sequencer" in - if configuration.devmode then - Evm_node_lib_dev.Sequencer.main - ~data_dir - ?genesis_timestamp - ~cctxt:(wallet_ctxt :> Client_context.wallet) - ~configuration - ?kernel - () - else - Evm_node_lib_prod.Sequencer.main - ~data_dir - ?genesis_timestamp - ~cctxt:(wallet_ctxt :> Client_context.wallet) - ~configuration - ?kernel - () + + Evm_node_lib_dev.Sequencer.main + ~data_dir + ?genesis_timestamp + ~cctxt:(wallet_ctxt :> Client_context.wallet) + ~configuration + ?kernel + () let start_threshold_encryption_sequencer ?password_filename ~wallet_dir - ~data_dir ~devmode ?rpc_addr ?rpc_port ?cors_origins ?cors_headers + ~data_dir ?rpc_addr ?rpc_port ?cors_origins ?cors_headers ?tx_pool_timeout_limit ?tx_pool_addr_limit ?tx_pool_tx_per_addr_limit ~keep_alive ?rollup_node_endpoint ~verbose ?preimages ?preimages_endpoint ?time_between_blocks ?max_number_of_chunks ?private_rpc_port ?sequencer_str @@ -704,7 +703,6 @@ let start_threshold_encryption_sequencer ?password_filename ~wallet_dir let* configuration = Cli.create_or_read_config ~data_dir - ~devmode ?rpc_addr ?rpc_port ?cors_origins @@ -753,15 +751,13 @@ let start_threshold_encryption_sequencer ?password_filename ~wallet_dir init ~config () in let*! () = Internal_event.Simple.emit Event.event_starting "te_sequencer" in - if configuration.devmode then - Evm_node_lib_dev.Threshold_encryption_sequencer.main - ~data_dir - ?genesis_timestamp - ~cctxt:(wallet_ctxt :> Client_context.wallet) - ~configuration - ?kernel - () - else failwith "Threshold encryption is not enabled in prod mode." + Evm_node_lib_dev.Threshold_encryption_sequencer.main + ~data_dir + ?genesis_timestamp + ~cctxt:(wallet_ctxt :> Client_context.wallet) + ~configuration + ?kernel + () let sequencer_command = let open Tezos_clic in @@ -798,7 +794,7 @@ let sequencer_command = (fun ( ( data_dir, rpc_addr, rpc_port, - devmode, + _devmode, cors_origins, cors_headers, log_filter_max_nb_blocks, @@ -838,7 +834,6 @@ let sequencer_command = ?password_filename ~wallet_dir ~data_dir - ~devmode ?rpc_addr ?rpc_port ?cors_origins @@ -866,17 +861,16 @@ let sequencer_command = ?kernel ()) -let start_observer ~data_dir ~devmode ~keep_alive ?rpc_addr ?rpc_port - ?cors_origins ?cors_headers ~verbose ?preimages ?rollup_node_endpoint - ?preimages_endpoint ?evm_node_endpoint - ?threshold_encryption_bundler_endpoint ?tx_pool_timeout_limit - ?tx_pool_addr_limit ?tx_pool_tx_per_addr_limit ?log_filter_chunk_size - ?log_filter_max_nb_logs ?log_filter_max_nb_blocks ?kernel () = +let start_observer ~data_dir ~keep_alive ?rpc_addr ?rpc_port ?cors_origins + ?cors_headers ~verbose ?preimages ?rollup_node_endpoint ?preimages_endpoint + ?evm_node_endpoint ?threshold_encryption_bundler_endpoint + ?tx_pool_timeout_limit ?tx_pool_addr_limit ?tx_pool_tx_per_addr_limit + ?log_filter_chunk_size ?log_filter_max_nb_logs ?log_filter_max_nb_blocks + ?kernel () = let open Lwt_result_syntax in let* config = Cli.create_or_read_config ~data_dir - ~devmode ~keep_alive ?rpc_addr ?rpc_port @@ -918,9 +912,7 @@ let start_observer ~data_dir ~devmode ~keep_alive ?rpc_addr ?rpc_port init ~config () in let*! () = Internal_event.Simple.emit Event.event_starting "observer" in - if config.devmode then - Evm_node_lib_dev.Observer.main ?kernel_path:kernel ~data_dir ~config () - else Evm_node_lib_prod.Observer.main ?kernel_path:kernel ~data_dir ~config () + Evm_node_lib_dev.Observer.main ?kernel_path:kernel ~data_dir ~config () let observer_command = let open Tezos_clic in @@ -948,7 +940,7 @@ let observer_command = @@ fun ( ( data_dir, rpc_addr, rpc_port, - devmode, + _devmode, cors_origins, cors_headers, log_filter_max_nb_blocks, @@ -977,7 +969,6 @@ let observer_command = in start_observer ~data_dir - ~devmode ~keep_alive ?rpc_addr ?rpc_port @@ -998,41 +989,6 @@ let observer_command = ?kernel () -let make_prod_messages ~kind ~smart_rollup_address data = - let open Lwt_result_syntax in - let open Evm_node_lib_dev in - let open Evm_node_lib_dev_encoding in - let transactions = - List.map - (fun s -> Ethereum_types.hex_of_string s |> Ethereum_types.hex_to_bytes) - data - in - let* messages = - match kind with - | `Blueprint (cctxt, sk_uri, timestamp, number, parent_hash) -> - let* blueprint = - Sequencer_blueprint.create - ~cctxt - ~sequencer_key:sk_uri - ~timestamp - ~smart_rollup_address - ~number:(Ethereum_types.quantity_of_z number) - ~parent_hash:(Ethereum_types.block_hash_of_string parent_hash) - ~transactions - ~delayed_transactions:[] - in - return @@ List.map (fun (`External s) -> s) blueprint - | `Transaction -> - let*? chunks = - List.map_e - (fun tx -> - Transaction_format.make_encoded_messages ~smart_rollup_address tx) - transactions - in - return (chunks |> List.map snd |> List.flatten) - in - return (List.map (fun m -> m |> Hex.of_string |> Hex.show) messages) - let make_dev_messages ~kind ~smart_rollup_address data = let open Lwt_result_syntax in let open Evm_node_lib_dev in @@ -1110,7 +1066,7 @@ let chunker_command = is prefixed with `file:`, the content is read from the given \ filename and can contain a list of data separated by a whitespace." (Tezos_clic.parameter (fun _ -> from_data_or_file))) - (fun ( devmode, + (fun ( _devmode, rollup_address, as_blueprint, blueprint_timestamp, @@ -1142,10 +1098,7 @@ let chunker_command = in let data = List.flatten data in let print_chunks smart_rollup_address data = - let* messages = - if devmode then make_dev_messages ~kind ~smart_rollup_address data - else make_prod_messages ~kind ~smart_rollup_address data - in + let* messages = make_dev_messages ~kind ~smart_rollup_address data in Format.printf "Chunked transactions :\n%!" ; List.iter (Format.printf "%s\n%!") messages ; return_unit @@ -1173,14 +1126,10 @@ let make_upgrade_command = "After activation timestamp, the kernel will upgrade to this value" Params.timestamp @@ stop) - (fun devmode root_hash timestamp () -> + (fun _devmode root_hash timestamp () -> let payload = - if devmode then - Evm_node_lib_dev_encoding.Ethereum_types.Upgrade.( - to_bytes @@ {hash = Hash (Hex root_hash); timestamp}) - else - Evm_node_lib_prod_encoding.Ethereum_types.Upgrade.( - to_bytes @@ {hash = Hash (Hex root_hash); timestamp}) + Evm_node_lib_dev_encoding.Ethereum_types.Upgrade.( + to_bytes @@ {hash = Hash (Hex root_hash); timestamp}) in Printf.printf "%s%!" Hex.(of_bytes payload |> show) ; return_unit) @@ -1204,7 +1153,7 @@ let make_sequencer_upgrade_command = "After activation timestamp, the kernel will upgrade to this value" Params.timestamp @@ prefix "for" @@ Params.sequencer_key @@ stop) - (fun (wallet_dir, devmode) + (fun (wallet_dir, _devmode) pool_address activation_timestamp sequencer_str @@ -1219,16 +1168,11 @@ let make_sequencer_upgrade_command = sequencer_sk_opt in let* payload = - if devmode then - let open Evm_node_lib_dev_encoding.Ethereum_types in - let sequencer_upgrade : Sequencer_upgrade.t = - {sequencer; pool_address; timestamp = activation_timestamp} - in - return @@ Sequencer_upgrade.to_bytes sequencer_upgrade - else - tzfail - (error_of_fmt - "devmode must be set for producing the sequencer upgrade") + let open Evm_node_lib_dev_encoding.Ethereum_types in + let sequencer_upgrade : Sequencer_upgrade.t = + {sequencer; pool_address; timestamp = activation_timestamp} + in + return @@ Sequencer_upgrade.to_bytes sequencer_upgrade in Printf.printf "%s%!" Hex.(of_bytes payload |> show) ; return_unit) @@ -1248,23 +1192,17 @@ let init_from_rollup_node_command = (prefixes ["init"; "from"; "rollup"; "node"] @@ rollup_node_data_dir_param @@ stop) (fun ( data_dir, - devmode, + _devmode, omit_delayed_tx_events, reconstruct_from_boot_sector ) rollup_node_data_dir () -> - if devmode then - Evm_node_lib_dev.Evm_context.init_from_rollup_node - ~omit_delayed_tx_events - ~data_dir - ~rollup_node_data_dir - ?reconstruct_from_boot_sector - () - else - Evm_node_lib_prod.Evm_context.init_from_rollup_node - ~omit_delayed_tx_events - ~data_dir - ~rollup_node_data_dir) + Evm_node_lib_dev.Evm_context.init_from_rollup_node + ~omit_delayed_tx_events + ~data_dir + ~rollup_node_data_dir + ?reconstruct_from_boot_sector + ()) let dump_to_rlp_command = let open Tezos_clic in @@ -1277,7 +1215,7 @@ let dump_to_rlp_command = @@ prefixes ["to"; "rlp"] @@ param ~name:"dump.rlp" ~desc:"Description" Params.string @@ stop) - (fun (devmode, keep_everything) dump_json dump_rlp () -> + (fun (_devmode, keep_everything) dump_json dump_rlp () -> let* dump_json = Lwt_utils_unix.Json.read_file dump_json in let config = Data_encoding.Json.destruct @@ -1298,26 +1236,8 @@ let dump_to_rlp_command = :: acc else acc in - if devmode then - let open Evm_node_lib_dev_encoding.Rlp in - List.fold_left aux [] config |> fun l -> encode (List l) - else - let aux = - let open Evm_node_lib_prod_encoding.Rlp in - if keep_everything then - fun acc Octez_smart_rollup.Installer_config.(Set {value; to_}) -> - List [Value (String.to_bytes to_); Value (String.to_bytes value)] - :: acc - else - fun acc Octez_smart_rollup.Installer_config.(Set {value; to_}) -> - if String.starts_with ~prefix:"/evm" to_ then - List - [Value (String.to_bytes to_); Value (String.to_bytes value)] - :: acc - else acc - in - let open Evm_node_lib_prod_encoding.Rlp in - List.fold_left aux [] config |> fun l -> encode (List l) + let open Evm_node_lib_dev_encoding.Rlp in + List.fold_left aux [] config |> fun l -> encode (List l) in let write_bytes_to_file filename bytes = @@ -1442,7 +1362,7 @@ mode.|} (fun ( ( data_dir, rpc_addr, rpc_port, - devmode, + _devmode, cors_origins, cors_headers, log_filter_max_nb_blocks, @@ -1482,7 +1402,6 @@ mode.|} ~data_dir ?rpc_addr ?rpc_port - ~devmode ?cors_origins ?cors_headers ?log_filter_max_nb_blocks @@ -1539,7 +1458,7 @@ let make_kernel_config_command = command ~desc:"Transforms the JSON list of instructions to a RLP list" (args20 - devmode_arg + mainnet_compat_arg (config_key_arg ~name:"kernel_root_hash" ~placeholder:"root hash") (config_key_arg ~name:"chain_id" ~placeholder:"chain id") (config_key_arg ~name:"sequencer" ~placeholder:"edpk...") @@ -1572,7 +1491,7 @@ let make_kernel_config_command = ~desc:"file path where the config will be written to" Params.string @@ stop) - (fun ( devmode, + (fun ( mainnet_compat, kernel_root_hash, chain_id, sequencer, @@ -1594,52 +1513,29 @@ let make_kernel_config_command = bootstrap_accounts ) output () -> - if devmode then - Evm_node_lib_dev.Kernel_config.make - ?kernel_root_hash - ?chain_id - ?sequencer - ?delayed_bridge - ?ticketer - ?admin - ?sequencer_governance - ?kernel_governance - ?kernel_security_governance - ?minimum_base_fee_per_gas - ?da_fee_per_byte - ?delayed_inbox_timeout - ?delayed_inbox_min_levels - ?sequencer_pool_address - ?maximum_allowed_ticks - ?maximum_gas_per_transaction - ?remove_whitelist - ~boostrap_balance - ?bootstrap_accounts - ~output - () - else - Evm_node_lib_prod.Kernel_config.make - ?kernel_root_hash - ?chain_id - ?sequencer - ?delayed_bridge - ?ticketer - ?admin - ?sequencer_governance - ?kernel_governance - ?kernel_security_governance - ?minimum_base_fee_per_gas - ?da_fee_per_byte - ?delayed_inbox_timeout - ?delayed_inbox_min_levels - ?sequencer_pool_address - ?maximum_allowed_ticks - ?maximum_gas_per_transaction - ?remove_whitelist - ~boostrap_balance - ?bootstrap_accounts - ~output - ()) + Evm_node_lib_dev.Kernel_config.make + ~mainnet_compat + ?kernel_root_hash + ?chain_id + ?sequencer + ?delayed_bridge + ?ticketer + ?admin + ?sequencer_governance + ?kernel_governance + ?kernel_security_governance + ?minimum_base_fee_per_gas + ?da_fee_per_byte + ?delayed_inbox_timeout + ?delayed_inbox_min_levels + ?sequencer_pool_address + ?maximum_allowed_ticks + ?maximum_gas_per_transaction + ?remove_whitelist + ~boostrap_balance + ?bootstrap_accounts + ~output + ()) let proxy_simple_command = let open Tezos_clic in @@ -1650,7 +1546,7 @@ let proxy_simple_command = (fun ( ( data_dir, rpc_addr, rpc_port, - devmode, + _devmode, cors_origins, cors_headers, log_filter_max_nb_blocks, @@ -1666,7 +1562,6 @@ let proxy_simple_command = () -> start_proxy ~data_dir - ~devmode ~keep_alive ?rpc_addr ?rpc_port @@ -1709,7 +1604,7 @@ let sequencer_simple_command = (fun ( ( data_dir, rpc_addr, rpc_port, - devmode, + _devmode, cors_origins, cors_headers, log_filter_max_nb_blocks, @@ -1740,7 +1635,6 @@ let sequencer_simple_command = ?password_filename ~wallet_dir ~data_dir - ~devmode ?rpc_addr ?rpc_port ?cors_origins @@ -1797,7 +1691,7 @@ let threshold_encryption_sequencer_command = (fun ( ( data_dir, rpc_addr, rpc_port, - devmode, + _devmode, cors_origins, cors_headers, log_filter_max_nb_blocks, @@ -1829,7 +1723,6 @@ let threshold_encryption_sequencer_command = ?password_filename ~wallet_dir ~data_dir - ~devmode ?rpc_addr ?rpc_port ?cors_origins @@ -1875,7 +1768,7 @@ let observer_simple_command = (fun ( ( data_dir, rpc_addr, rpc_port, - devmode, + _devmode, cors_origins, cors_headers, log_filter_max_nb_blocks, @@ -1895,7 +1788,6 @@ let observer_simple_command = () -> start_observer ~data_dir - ~devmode ~keep_alive ?rpc_addr ?rpc_port diff --git a/etherlink/bin_node/test/dune b/etherlink/bin_node/test/dune index fc95d8b84b110b67249fded8bca9c9fd34c454fc..c2d75222a419ce6ad87009613944080c9f1689f2 100644 --- a/etherlink/bin_node/test/dune +++ b/etherlink/bin_node/test/dune @@ -12,7 +12,6 @@ octez-libs.test-helpers qcheck-alcotest octez-alcotezt - octez-evm-node-libs.evm_node_lib_prod octez-evm-node-libs.evm_node_lib_dev) (library_flags (:standard -linkall)) (flags diff --git a/etherlink/tezt/lib/evm_node.ml b/etherlink/tezt/lib/evm_node.ml index 027c400f7b7c6de54f9f588c857d2bd8e860fc09..1f38d35203bb2e4594f67adc3274c17ede6148ff 100644 --- a/etherlink/tezt/lib/evm_node.ml +++ b/etherlink/tezt/lib/evm_node.ml @@ -34,14 +34,12 @@ type mode = preimages_dir : string; rollup_node_endpoint : string; time_between_blocks : time_between_blocks option; - devmode : bool; } | Threshold_encryption_observer of { initial_kernel : string; preimages_dir : string; rollup_node_endpoint : string; bundler_node_endpoint : string; - devmode : bool; } | Sequencer of { initial_kernel : string; @@ -55,7 +53,6 @@ type mode = max_blueprints_catchup : int option; catchup_cooldown : int option; max_number_of_chunks : int option; - devmode : bool; wallet_dir : string option; tx_pool_timeout_limit : int option; tx_pool_addr_limit : int option; @@ -73,14 +70,13 @@ type mode = max_blueprints_catchup : int option; catchup_cooldown : int option; max_number_of_chunks : int option; - devmode : bool; wallet_dir : string option; tx_pool_timeout_limit : int option; tx_pool_addr_limit : int option; tx_pool_tx_per_addr_limit : int option; sequencer_sidecar_endpoint : string; } - | Proxy of {devmode : bool} + | Proxy module Per_level_map = Map.Make (Int) @@ -115,7 +111,7 @@ let mode t = t.persistent_state.mode let is_sequencer t = match t.persistent_state.mode with | Sequencer _ | Threshold_encryption_sequencer _ -> true - | Observer _ | Threshold_encryption_observer _ | Proxy _ -> false + | Observer _ | Threshold_encryption_observer _ | Proxy -> false let initial_kernel t = match t.persistent_state.mode with @@ -124,7 +120,7 @@ let initial_kernel t = | Observer {initial_kernel; _} | Threshold_encryption_observer {initial_kernel; _} -> initial_kernel - | Proxy _ -> + | Proxy -> Test.fail "Wrong argument: [initial_kernel] does not support the proxy node" @@ -133,7 +129,7 @@ let can_apply_blueprint t = | Sequencer _ | Threshold_encryption_sequencer _ | Observer _ | Threshold_encryption_observer _ -> true - | Proxy _ -> false + | Proxy -> false let connection_arguments ?rpc_addr ?rpc_port () = let open Cli_arg in @@ -421,14 +417,14 @@ let wait_for_tx_pool_add_transaction ?timeout evm_node = wait_for_event ?timeout evm_node ~event:"tx_pool_add_transaction.v0" @@ JSON.as_string_opt -let create ?name ?runner ?(mode = Proxy {devmode = false}) ?data_dir ?rpc_addr - ?rpc_port endpoint = +let create ?name ?runner ?(mode = Proxy) ?data_dir ?rpc_addr ?rpc_port endpoint + = let arguments, rpc_addr, rpc_port = connection_arguments ?rpc_addr ?rpc_port () in let new_name () = match mode with - | Proxy _ -> "proxy_" ^ fresh_name () + | Proxy -> "proxy_" ^ fresh_name () | Sequencer _ -> "sequencer_" ^ fresh_name () | Threshold_encryption_sequencer _ -> "te_sequencer" ^ fresh_name () | Observer _ -> "observer_" ^ fresh_name () @@ -473,7 +469,7 @@ let run_args evm_node = let shared_args = data_dir evm_node @ evm_node.persistent_state.arguments in let mode_args = match evm_node.persistent_state.mode with - | Proxy _ -> ["run"; "proxy"] + | Proxy -> ["run"; "proxy"] | Sequencer {initial_kernel; genesis_timestamp; wallet_dir; _} -> ["run"; "sequencer"; "--initial-kernel"; initial_kernel] @ Cli_arg.optional_arg @@ -597,9 +593,7 @@ let spawn_init_config ?(extra_arguments = []) evm_node = in let mode_args = match evm_node.persistent_state.mode with - | Proxy {devmode} -> - ["--rollup-node-endpoint"; evm_node.persistent_state.endpoint] - @ Cli_arg.optional_switch "devmode" devmode + | Proxy -> ["--rollup-node-endpoint"; evm_node.persistent_state.endpoint] | Sequencer { initial_kernel = _; @@ -613,7 +607,6 @@ let spawn_init_config ?(extra_arguments = []) evm_node = max_blueprints_catchup; catchup_cooldown; max_number_of_chunks; - devmode; wallet_dir; tx_pool_timeout_limit; tx_pool_addr_limit; @@ -651,7 +644,6 @@ let spawn_init_config ?(extra_arguments = []) evm_node = "max-number-of-chunks" string_of_int max_number_of_chunks - @ Cli_arg.optional_switch "devmode" devmode @ Cli_arg.optional_arg "wallet-dir" Fun.id wallet_dir @ Cli_arg.optional_arg "tx-pool-timeout-limit" @@ -678,7 +670,6 @@ let spawn_init_config ?(extra_arguments = []) evm_node = max_blueprints_catchup; catchup_cooldown; max_number_of_chunks; - devmode; wallet_dir; tx_pool_timeout_limit; tx_pool_addr_limit; @@ -719,7 +710,6 @@ let spawn_init_config ?(extra_arguments = []) evm_node = "max-number-of-chunks" string_of_int max_number_of_chunks - @ Cli_arg.optional_switch "devmode" devmode @ Cli_arg.optional_arg "wallet-dir" Fun.id wallet_dir @ Cli_arg.optional_arg "tx-pool-timeout-limit" @@ -738,7 +728,6 @@ let spawn_init_config ?(extra_arguments = []) evm_node = preimages_dir; initial_kernel = _; rollup_node_endpoint; - devmode; time_between_blocks; } -> [ @@ -753,14 +742,12 @@ let spawn_init_config ?(extra_arguments = []) evm_node = "time-between-blocks" time_between_blocks_fmt time_between_blocks - @ Cli_arg.optional_switch "devmode" devmode | Threshold_encryption_observer { preimages_dir; initial_kernel = _; rollup_node_endpoint; bundler_node_endpoint; - devmode; } -> [ "--evm-node-endpoint"; @@ -772,7 +759,6 @@ let spawn_init_config ?(extra_arguments = []) evm_node = "--preimages-dir"; preimages_dir; ] - @ Cli_arg.optional_switch "devmode" devmode in spawn_command evm_node @@ ["init"; "config"] @ mode_args @ shared_args @ extra_arguments @@ -791,7 +777,7 @@ let endpoint ?(private_ = false) (evm_node : t) = | Threshold_encryption_sequencer {private_rpc_port = None; _} -> Test.fail "Threshold encryption sequencer doesn't have a private RPC server" - | Proxy _ -> Test.fail "Proxy doesn't have a private RPC server" + | Proxy -> Test.fail "Proxy doesn't have a private RPC server" | Observer _ -> Test.fail "Observer doesn't have a private RPC server" | Threshold_encryption_observer _ -> Test.fail @@ -839,15 +825,13 @@ let init ?patch_config ?name ?runner ?mode ?data_dir ?rpc_addr ?rpc_port let* () = run evm_node in return evm_node -let init_from_rollup_node_data_dir ?(devmode = false) ?reconstruct evm_node - rollup_node = +let init_from_rollup_node_data_dir ?reconstruct evm_node rollup_node = let rollup_node_data_dir = Sc_rollup_node.data_dir rollup_node in let process = spawn_command evm_node (["init"; "from"; "rollup"; "node"; rollup_node_data_dir] @ data_dir evm_node - @ Cli_arg.optional_switch "devmode" devmode @ Cli_arg.optional_arg "reconstruct" Fun.id reconstruct) in Process.check process @@ -926,8 +910,8 @@ let reset evm_node ~l2_level = let process = Process.spawn (Uses.path Constant.octez_evm_node) @@ args in Process.check process -let sequencer_upgrade_payload ?(devmode = true) ?client ~public_key - ~pool_address ~activation_timestamp () = +let sequencer_upgrade_payload ?client ~public_key ~pool_address + ~activation_timestamp () = let args = [ "make"; @@ -953,13 +937,12 @@ let sequencer_upgrade_payload ?(devmode = true) ?client ~public_key "wallet-dir" Fun.id (Option.map Client.base_dir client) - @ Cli_arg.optional_switch "devmode" devmode in let* payload = Process.check_and_read_stdout process in return (String.trim payload) -let chunk_data ?(devmode = true) ~rollup_address ?sequencer_key ?timestamp - ?parent_hash ?number ?client data = +let chunk_data ~rollup_address ?sequencer_key ?timestamp ?parent_hash ?number + ?client data = let args = "chunk" :: "data" :: data in let sequencer = match sequencer_key with @@ -970,11 +953,9 @@ let chunk_data ?(devmode = true) ~rollup_address ?sequencer_key ?timestamp let timestamp = Cli_arg.optional_arg "timestamp" Fun.id timestamp in let parent_hash = Cli_arg.optional_arg "parent-hash" Fun.id parent_hash in let number = Cli_arg.optional_arg "number" string_of_int number in - let devmode = Cli_arg.optional_switch "devmode" devmode in let process = Process.spawn (Uses.path Constant.octez_evm_node) @@ args @ rollup_address @ sequencer @ timestamp @ parent_hash @ number - @ devmode @ Cli_arg.optional_arg "wallet-dir" Fun.id @@ -992,15 +973,16 @@ let wait_termination (evm_node : t) = let* _status = Process.wait process in unit -let make_kernel_installer_config ?(devmode = true) ?(remove_whitelist = false) - ?kernel_root_hash ?chain_id ?bootstrap_balance ?bootstrap_accounts - ?sequencer ?delayed_bridge ?ticketer ?administrator ?sequencer_governance - ?kernel_governance ?kernel_security_governance ?minimum_base_fee_per_gas - ?(da_fee_per_byte = Wei.zero) ?delayed_inbox_timeout - ?delayed_inbox_min_levels ?sequencer_pool_address ?maximum_allowed_ticks - ?maximum_gas_per_transaction ~output () = +let make_kernel_installer_config ?(mainnet_compat = false) + ?(remove_whitelist = false) ?kernel_root_hash ?chain_id ?bootstrap_balance + ?bootstrap_accounts ?sequencer ?delayed_bridge ?ticketer ?administrator + ?sequencer_governance ?kernel_governance ?kernel_security_governance + ?minimum_base_fee_per_gas ?(da_fee_per_byte = Wei.zero) + ?delayed_inbox_timeout ?delayed_inbox_min_levels ?sequencer_pool_address + ?maximum_allowed_ticks ?maximum_gas_per_transaction ~output () = let cmd = ["make"; "kernel"; "installer"; "config"; output] + @ Cli_arg.optional_switch "mainnet-compat" mainnet_compat @ Cli_arg.optional_switch "remove-whitelist" remove_whitelist @ Cli_arg.optional_arg "kernel-root-hash" Fun.id kernel_root_hash @ Cli_arg.optional_arg "chain-id" string_of_int chain_id @@ -1040,7 +1022,6 @@ let make_kernel_installer_config ?(devmode = true) ?(remove_whitelist = false) Int64.to_string maximum_gas_per_transaction @ Cli_arg.optional_arg "bootstrap-balance" Wei.to_string bootstrap_balance - @ Cli_arg.optional_switch "devmode" devmode @ match bootstrap_accounts with | None -> [] diff --git a/etherlink/tezt/lib/evm_node.mli b/etherlink/tezt/lib/evm_node.mli index 1101969951f98c4aa8be77c50bd25fd505803165..a622632eb01d6d2a5e21b7c4c204a2a79785d1e7 100644 --- a/etherlink/tezt/lib/evm_node.mli +++ b/etherlink/tezt/lib/evm_node.mli @@ -42,14 +42,12 @@ type mode = preimages_dir : string; rollup_node_endpoint : string; time_between_blocks : time_between_blocks option; - devmode : bool; } | Threshold_encryption_observer of { initial_kernel : string; preimages_dir : string; rollup_node_endpoint : string; bundler_node_endpoint : string; - devmode : bool; } | Sequencer of { initial_kernel : string; @@ -67,7 +65,6 @@ type mode = max_blueprints_catchup : int option; catchup_cooldown : int option; max_number_of_chunks : int option; - devmode : bool; (** --devmode flag. *) wallet_dir : string option; (** --wallet-dir: client directory. *) tx_pool_timeout_limit : int option; (** --tx-pool-timeout-limit: transaction timeout inside the pool. *) @@ -94,7 +91,6 @@ type mode = max_blueprints_catchup : int option; catchup_cooldown : int option; max_number_of_chunks : int option; - devmode : bool; (** --devmode flag. *) wallet_dir : string option; (** --wallet-dir: client directory. *) tx_pool_timeout_limit : int option; (** --tx-pool-timeout-limit: transaction timeout inside the pool. *) @@ -108,7 +104,7 @@ type mode = (** --sequencer-sidecar-endpoint: Uri of the sidecar endpoints to which proposals are forwarded, and from where preblocks are fetched. *) } - | Proxy of {devmode : bool (** --devmode flag. *)} + | Proxy (** Returns the mode of the EVM node. *) val mode : t -> mode @@ -311,13 +307,12 @@ val fetch_contract_code : t -> string -> string Lwt.t val upgrade_payload : root_hash:string -> activation_timestamp:string -> string Lwt.t -(** [sequencer_upgrade_payload ?devmode ?client ~public_key ~pool_address +(** [sequencer_upgrade_payload ?client ~public_key ~pool_address ~activation_timestamp ()] gives the sequencer upgrade payload to put in a upgrade message, it will upgrade the sequencer to [public_key] at the first l1 block after [activation_timestamp] - (in RFC3399 format). [devmode] is true by default. *) + (in RFC3399 format). *) val sequencer_upgrade_payload : - ?devmode:bool -> ?client:Client.t -> public_key:string -> pool_address:string -> @@ -325,11 +320,11 @@ val sequencer_upgrade_payload : unit -> string Lwt.t -(** [init_from_rollup_node_data_dir ?devmode ?reconstruct evm_node rollup_node] +(** [init_from_rollup_node_data_dir ?reconstruct evm_node rollup_node] initialises the data dir of the evm node by importing the evm state from a rollup node data dir. [devmode] is false by default. *) val init_from_rollup_node_data_dir : - ?devmode:bool -> ?reconstruct:string -> t -> Sc_rollup_node.t -> unit Lwt.t + ?reconstruct:string -> t -> Sc_rollup_node.t -> unit Lwt.t (** [transform_dump ~dump_json ~dump_rlp] transforms a JSON list of instructions stored in [dump_json] to an RLP list, which is @@ -340,12 +335,11 @@ val transform_dump : dump_json:string -> dump_rlp:string -> unit Lwt.t l2_level. *) val reset : t -> l2_level:int -> unit Lwt.t -(** [chunk data ?devmode ~rollup_address ?sequencer_key ?timestamp ?parent_hash +(** [chunk data ~rollup_address ?sequencer_key ?timestamp ?parent_hash ?number ?client data] generates the valid inputs for the rollup at [rollup_address] from the given [data]. If [sequencer_key] is given, the data produced is for the sequencer mode. *) val chunk_data : - ?devmode:bool -> rollup_address:string -> ?sequencer_key:string -> ?timestamp:string -> @@ -360,7 +354,7 @@ val wait_termination : t -> unit Lwt.t (** [make_kernel_installer_config ~output ()] create the config needed for the evm kernel used by the installer *) val make_kernel_installer_config : - ?devmode:bool -> + ?mainnet_compat:bool -> ?remove_whitelist:bool -> ?kernel_root_hash:string -> ?chain_id:int -> diff --git a/etherlink/tezt/lib/helpers.ml b/etherlink/tezt/lib/helpers.ml index 9781dce16b606c0a3006970a1c497a78d03446ab..7d524608d2b9431c1681f9f90ef8fa21c898465d 100644 --- a/etherlink/tezt/lib/helpers.ml +++ b/etherlink/tezt/lib/helpers.ml @@ -55,7 +55,7 @@ let next_rollup_node_level ~sc_rollup_node ~client = let next_evm_level ~evm_node ~sc_rollup_node ~client = match Evm_node.mode evm_node with - | Proxy _ -> + | Proxy -> let* _l1_level = next_rollup_node_level ~sc_rollup_node ~client in unit | Sequencer _ | Threshold_encryption_sequencer _ -> diff --git a/etherlink/tezt/lib/kernel.ml b/etherlink/tezt/lib/kernel.ml index 419daf00b64c1ca04e68599b7979c96920f7939d..4e4cdb0fd23733b72405da3513d5ef071a8cf670 100644 --- a/etherlink/tezt/lib/kernel.ml +++ b/etherlink/tezt/lib/kernel.ml @@ -24,6 +24,13 @@ let upgrade_to = function | Ghostnet -> Latest | Latest -> Latest +(** [mainnet_compat_kernel_config kernel] returns [true] when the [kernel] + requires the data model of the initial kernel originated on Mainnet. *) +let mainnet_compat_kernel_config = function + | Mainnet -> true + | Ghostnet -> true + | Latest -> false + let of_use u = if Uses.(tag u = tag Constant.WASM.mainnet_evm_kernel) then Mainnet else if Uses.(tag u = tag Constant.WASM.ghostnet_evm_kernel) then Ghostnet diff --git a/etherlink/tezt/tests/evm_rollup.ml b/etherlink/tezt/tests/evm_rollup.ml index 39bb16fbb0e878914dd223c8df1118de62ae77bb..376642c16206cfaccc7b3248f86104d3c4fbac17 100644 --- a/etherlink/tezt/tests/evm_rollup.ml +++ b/etherlink/tezt/tests/evm_rollup.ml @@ -275,13 +275,11 @@ type setup_mode = | Setup_sequencer of { time_between_blocks : Evm_node.time_between_blocks option; sequencer : Account.key; - devmode : bool; } - | Setup_proxy of {devmode : bool} + | Setup_proxy -let setup_evm_kernel ?devmode ?additional_config - ?(setup_kernel_root_hash = true) - ?(kernel_installee = Constant.WASM.evm_kernel) +let setup_evm_kernel ?additional_config ?(setup_kernel_root_hash = true) + ?(kernel = Kernel.Latest) ?(originator_key = Constant.bootstrap1.public_key_hash) ?(rollup_operator_key = Constant.bootstrap1.public_key_hash) ?(bootstrap_accounts = @@ -291,8 +289,9 @@ let setup_evm_kernel ?devmode ?additional_config ?(with_administrator = true) ?da_fee_per_byte ?minimum_base_fee_per_gas ~admin ?sequencer_admin ?commitment_period ?challenge_window ?timestamp ?tx_pool_timeout_limit ?tx_pool_addr_limit ?tx_pool_tx_per_addr_limit - ?max_number_of_chunks ?(setup_mode = Setup_proxy {devmode = true}) + ?max_number_of_chunks ?(setup_mode = Setup_proxy) ?(force_install_kernel = true) ?whitelist ?maximum_allowed_ticks protocol = + let _, kernel_installee = Kernel.to_uses_and_tags kernel in let* node, client = setup_l1 ?commitment_period ?challenge_window ?timestamp protocol in @@ -331,14 +330,14 @@ let setup_evm_kernel ?devmode ?additional_config in let sequencer = match setup_mode with - | Setup_proxy _ -> None + | Setup_proxy -> None | Setup_sequencer {sequencer; _} -> Some sequencer.public_key in let output_config = Temp.file "config.yaml" in let*! () = Evm_node.make_kernel_installer_config + ~mainnet_compat:Kernel.(mainnet_compat_kernel_config kernel) ~remove_whitelist:Option.(is_some whitelist) - ?devmode ?kernel_root_hash ~bootstrap_accounts ?da_fee_per_byte @@ -399,8 +398,8 @@ let setup_evm_kernel ?devmode ?additional_config in let* mode = match setup_mode with - | Setup_proxy {devmode} -> return (Evm_node.Proxy {devmode}) - | Setup_sequencer {time_between_blocks; sequencer; devmode} -> + | Setup_proxy -> return Evm_node.Proxy + | Setup_sequencer {time_between_blocks; sequencer} -> let private_rpc_port = Some (Port.fresh ()) in return (Evm_node.Sequencer @@ -416,7 +415,6 @@ let setup_evm_kernel ?devmode ?additional_config max_blueprints_catchup = None; catchup_cooldown = None; max_number_of_chunks; - devmode; wallet_dir = Some (Client.base_dir client); tx_pool_timeout_limit; tx_pool_addr_limit; @@ -448,14 +446,15 @@ let register_test ~title ~tags ?(kernels = Kernel.all) ?additional_config ?admin ?rollup_operator_key ?maximum_allowed_ticks ~setup_mode f protocols = let extra_tag = match setup_mode with - | Setup_proxy _ -> "proxy" + | Setup_proxy -> "proxy" | Setup_sequencer _ -> "sequencer" in List.iter - (fun (kernel_tag, kernel) -> + (fun kernel -> + let kernel_tag, kernel_use = Kernel.to_uses_and_tags kernel in let uses _protocol = [ - kernel; + kernel_use; Constant.octez_smart_rollup_node; Constant.octez_evm_node; Constant.smart_rollup_installer; @@ -471,10 +470,7 @@ let register_test ~title ~tags ?(kernels = Kernel.all) ?additional_config ?admin (fun protocol -> let* evm_setup = setup_evm_kernel - (* TODO: https://gitlab.com/tezos/tezos/-/issues/7285 - Remove once the upgrade is done *) - ~devmode:(kernel = Constant.WASM.evm_kernel) - ~kernel_installee:kernel + ~kernel ?additional_config ?whitelist ?commitment_period @@ -490,7 +486,7 @@ let register_test ~title ~tags ?(kernels = Kernel.all) ?additional_config ?admin in f ~protocol ~evm_setup) protocols) - (List.map Kernel.to_uses_and_tags kernels) + kernels let register_proxy ~title ~tags ?kernels ?additional_uses ?admin ?commitment_period ?challenge_window ?bootstrap_accounts @@ -508,7 +504,7 @@ let register_proxy ~title ~tags ?kernels ?additional_uses ?admin ?maximum_allowed_ticks f protocols - ~setup_mode:(Setup_proxy {devmode = true}) + ~setup_mode:Setup_proxy let register_sequencer ~title ~tags ?kernels ?additional_uses ?additional_config ?admin ?commitment_period ?challenge_window ?bootstrap_accounts @@ -535,8 +531,7 @@ let register_sequencer ~title ~tags ?kernels ?additional_uses ?additional_config in register ~setup_mode: - (Setup_sequencer - {time_between_blocks; sequencer = Constant.bootstrap1; devmode = true}) + (Setup_sequencer {time_between_blocks; sequencer = Constant.bootstrap1}) let register_both ~title ~tags ?kernels ?additional_uses ?additional_config ?admin ?commitment_period ?challenge_window ?bootstrap_accounts @@ -561,11 +556,10 @@ let register_both ~title ~tags ?kernels ?additional_uses ?additional_config f protocols in - register ~setup_mode:(Setup_proxy {devmode = true}) ; + register ~setup_mode:Setup_proxy ; register ~setup_mode: - (Setup_sequencer - {time_between_blocks; sequencer = Constant.bootstrap1; devmode = true}) + (Setup_sequencer {time_between_blocks; sequencer = Constant.bootstrap1}) let deploy ~contract ~sender full_evm_setup = let {client; sc_rollup_node; evm_node; _} = full_evm_setup in @@ -2426,8 +2420,8 @@ let get_kernel_boot_wasm ~sc_rollup_node = | Some boot_wasm -> return boot_wasm | None -> failwith "Kernel `boot.wasm` should be accessible/readable." -let gen_test_kernel_upgrade ?devmode ?setup_kernel_root_hash ?admin_contract - ?timestamp ?(activation_timestamp = "0") ?evm_setup ?rollup_address +let gen_test_kernel_upgrade ?setup_kernel_root_hash ?admin_contract ?timestamp + ?(activation_timestamp = "0") ?evm_setup ?rollup_address ?(should_fail = false) ~installee ?with_administrator ?expect_l1_failure ?(admin = Constant.bootstrap1) ?(upgrador = admin) protocol = let* { @@ -2443,7 +2437,6 @@ let gen_test_kernel_upgrade ?devmode ?setup_kernel_root_hash ?admin_contract | Some evm_setup -> return evm_setup | None -> setup_evm_kernel - ?devmode ?setup_kernel_root_hash ?timestamp ?with_administrator @@ -2889,19 +2882,16 @@ let gen_kernel_migration_test ?bootstrap_accounts ?(admin = Constant.bootstrap5) ~scenario_prior ~scenario_after protocol = let* evm_setup = setup_evm_kernel - ~devmode:false ?bootstrap_accounts ~da_fee_per_byte:Wei.zero ~minimum_base_fee_per_gas:(Wei.of_string "21000") - ~kernel_installee:Constant.WASM.ghostnet_evm_kernel + ~kernel:Ghostnet ~admin:(Some admin) protocol in (* Load the EVM rollup's storage and sanity check results. *) let* evm_node = - Evm_node.init - ~mode:(Proxy {devmode = false}) - (Sc_rollup_node.endpoint evm_setup.sc_rollup_node) + Evm_node.init ~mode:Proxy (Sc_rollup_node.endpoint evm_setup.sc_rollup_node) in let endpoint = Evm_node.endpoint evm_node in let* sanity_check = @@ -2923,9 +2913,7 @@ let gen_kernel_migration_test ?bootstrap_accounts ?(admin = Constant.bootstrap5) ~client:evm_setup.client in let* evm_node = - Evm_node.init - ~mode:(Proxy {devmode = true}) - (Sc_rollup_node.endpoint evm_setup.sc_rollup_node) + Evm_node.init ~mode:Proxy (Sc_rollup_node.endpoint evm_setup.sc_rollup_node) in let evm_setup = {evm_setup with evm_node} in (* Check the values after the upgrade with [sanity_check] results. *) @@ -4636,7 +4624,6 @@ let test_migrate_proxy_to_sequencer_future = max_blueprints_catchup = None; catchup_cooldown = None; max_number_of_chunks = None; - devmode = true; wallet_dir = Some (Client.base_dir client); tx_pool_timeout_limit = None; tx_pool_addr_limit = None; @@ -4653,10 +4640,7 @@ let test_migrate_proxy_to_sequencer_future = in (* Run the sequencer from the rollup node state. *) let* () = - Evm_node.init_from_rollup_node_data_dir - ~devmode:true - sequencer_node - sc_rollup_node + Evm_node.init_from_rollup_node_data_dir sequencer_node sc_rollup_node in let* () = Evm_node.run sequencer_node in (* Same head after initialisation. *) @@ -4803,7 +4787,6 @@ let test_migrate_proxy_to_sequencer_past = max_blueprints_catchup = None; catchup_cooldown = None; max_number_of_chunks = None; - devmode = true; wallet_dir = Some (Client.base_dir client); tx_pool_timeout_limit = None; tx_pool_addr_limit = None; @@ -4815,10 +4798,7 @@ let test_migrate_proxy_to_sequencer_past = let* () = Process.check @@ Evm_node.spawn_init_config sequencer_node in (* Run the sequencer from the rollup node state. *) let* () = - Evm_node.init_from_rollup_node_data_dir - ~devmode:true - sequencer_node - sc_rollup_node + Evm_node.init_from_rollup_node_data_dir sequencer_node sc_rollup_node in let* () = Evm_node.run sequencer_node in (* Same head after initialisation. *) @@ -4889,12 +4869,7 @@ let test_ghostnet_kernel = ]) ~title:"Regression test for Ghostnet kernel" @@ fun protocol -> - let* {evm_node; _} = - setup_evm_kernel - ~kernel_installee:Constant.WASM.ghostnet_evm_kernel - ~admin:None - protocol - in + let* {evm_node; _} = setup_evm_kernel ~kernel:Ghostnet ~admin:None protocol in let*@ version = Rpc.tez_kernelVersion evm_node in Check.((version = Constant.WASM.ghostnet_evm_commit) string) ~error_msg:"The ghostnet kernel has version %L but constant says %R" ; @@ -5356,11 +5331,7 @@ let test_tx_pool_timeout = let admin = Some Constant.bootstrap3 in let setup_mode = Setup_sequencer - { - time_between_blocks = Some Nothing; - sequencer = sequencer_admin; - devmode = true; - } + {time_between_blocks = Some Nothing; sequencer = sequencer_admin} in let ttl = 15 in let* {evm_node = sequencer_node; _} = @@ -5456,11 +5427,7 @@ let test_tx_pool_address_boundaries = let admin = Some Constant.bootstrap3 in let setup_mode = Setup_sequencer - { - time_between_blocks = Some Nothing; - sequencer = sequencer_admin; - devmode = true; - } + {time_between_blocks = Some Nothing; sequencer = sequencer_admin} in let* {evm_node = sequencer_node; _} = setup_evm_kernel @@ -5579,11 +5546,7 @@ let test_tx_pool_transaction_size_exceeded = let admin = Some Constant.bootstrap3 in let setup_mode = Setup_sequencer - { - time_between_blocks = Some Nothing; - sequencer = sequencer_admin; - devmode = true; - } + {time_between_blocks = Some Nothing; sequencer = sequencer_admin} in let* {evm_node = sequencer_node; _} = setup_evm_kernel diff --git a/etherlink/tezt/tests/evm_sequencer.ml b/etherlink/tezt/tests/evm_sequencer.ml index 6a85444535184ddbae5082ce5ebb42d06ffe3908..4d32283fc85cf41cd84955d8453175946f3735f7 100644 --- a/etherlink/tezt/tests/evm_sequencer.ml +++ b/etherlink/tezt/tests/evm_sequencer.ml @@ -142,7 +142,7 @@ let setup_l1_contracts ?(dictator = Constant.bootstrap2) client = return {delayed_transaction_bridge; exchanger; bridge; admin; sequencer_governance} -let setup_sequencer ?(devmode = true) ?genesis_timestamp ?time_between_blocks +let setup_sequencer ~mainnet_compat ?genesis_timestamp ?time_between_blocks ?max_blueprints_lag ?max_blueprints_ahead ?max_blueprints_catchup ?catchup_cooldown ?delayed_inbox_timeout ?delayed_inbox_min_levels ?max_number_of_chunks @@ -173,9 +173,7 @@ let setup_sequencer ?(devmode = true) ?genesis_timestamp ?time_between_blocks let output_config = Temp.file "config.yaml" in let*! () = Evm_node.make_kernel_installer_config - (* TODO: https://gitlab.com/tezos/tezos/-/issues/7285 - Replace by ~devmode after the upgrade *) - ~devmode:(kernel = Constant.WASM.evm_kernel) + ~mainnet_compat ~sequencer:sequencer.public_key ~delayed_bridge:l1_contracts.delayed_transaction_bridge ~ticketer:l1_contracts.exchanger @@ -235,7 +233,6 @@ let setup_sequencer ?(devmode = true) ?genesis_timestamp ?time_between_blocks max_blueprints_catchup; catchup_cooldown; max_number_of_chunks; - devmode; wallet_dir = Some (Client.base_dir client); tx_pool_timeout_limit = None; tx_pool_addr_limit = None; @@ -257,7 +254,6 @@ let setup_sequencer ?(devmode = true) ?genesis_timestamp ?time_between_blocks max_blueprints_catchup; catchup_cooldown; max_number_of_chunks; - devmode; wallet_dir = Some (Client.base_dir client); tx_pool_timeout_limit = None; tx_pool_addr_limit = None; @@ -283,7 +279,6 @@ let setup_sequencer ?(devmode = true) ?genesis_timestamp ?time_between_blocks preimages_dir; rollup_node_endpoint = Sc_rollup_node.endpoint sc_rollup_node; bundler_node_endpoint = Dsn_node.endpoint bundler; - devmode; }) else return @@ -292,7 +287,6 @@ let setup_sequencer ?(devmode = true) ?genesis_timestamp ?time_between_blocks initial_kernel = output; preimages_dir; rollup_node_endpoint = Sc_rollup_node.endpoint sc_rollup_node; - devmode; time_between_blocks; }) in @@ -305,7 +299,7 @@ let setup_sequencer ?(devmode = true) ?genesis_timestamp ?time_between_blocks let* proxy = Evm_node.init ~patch_config - ~mode:(Proxy {devmode}) + ~mode:Proxy (Sc_rollup_node.endpoint sc_rollup_node) in return @@ -372,7 +366,7 @@ let send_deposit_to_delayed_inbox ~amount ~l1_contracts ~depositor ~receiver let* _ = next_rollup_node_level ~sc_rollup_node ~client in unit -let register_test ?devmode ?genesis_timestamp ?time_between_blocks +let register_test ~mainnet_compat ?genesis_timestamp ?time_between_blocks ?max_blueprints_lag ?max_blueprints_ahead ?max_blueprints_catchup ?catchup_cooldown ?delayed_inbox_timeout ?delayed_inbox_min_levels ?max_number_of_chunks ?bootstrap_accounts ?sequencer ?sequencer_pool_address @@ -388,7 +382,7 @@ let register_test ?devmode ?genesis_timestamp ?time_between_blocks let body protocol = let* sequencer_setup = setup_sequencer - ?devmode + ~mainnet_compat ?genesis_timestamp ?time_between_blocks ?max_blueprints_lag @@ -419,16 +413,17 @@ let register_test ?devmode ?genesis_timestamp ?time_between_blocks ~uses:(fun protocol -> uses protocol @ additional_uses) body -let register_both ?devmode ?genesis_timestamp ?time_between_blocks - ?max_blueprints_lag ?max_blueprints_ahead ?max_blueprints_catchup - ?catchup_cooldown ?delayed_inbox_timeout ?delayed_inbox_min_levels - ?max_number_of_chunks ?bootstrap_accounts ?sequencer ?sequencer_pool_address +let register_both ?genesis_timestamp ?time_between_blocks ?max_blueprints_lag + ?max_blueprints_ahead ?max_blueprints_catchup ?catchup_cooldown + ?delayed_inbox_timeout ?delayed_inbox_min_levels ?max_number_of_chunks + ?bootstrap_accounts ?sequencer ?sequencer_pool_address ?(kernels = Kernel.all) ?da_fee ?minimum_base_fee_per_gas ?preimages_dir ?maximum_allowed_ticks ?maximum_gas_per_transaction ?history_mode ?additional_uses ~title ~tags body protocols = let register ~kernel ~threshold_encryption = + let _, kernel_use = Kernel.to_uses_and_tags kernel in register_test - ?devmode + ~mainnet_compat:Kernel.(mainnet_compat_kernel_config kernel) ?genesis_timestamp ?time_between_blocks ?max_blueprints_lag @@ -441,7 +436,7 @@ let register_both ?devmode ?genesis_timestamp ?time_between_blocks ?bootstrap_accounts ?sequencer ?sequencer_pool_address - ~kernel + ~kernel:kernel_use ?da_fee ?minimum_base_fee_per_gas ?preimages_dir @@ -454,23 +449,25 @@ let register_both ?devmode ?genesis_timestamp ?time_between_blocks protocols in List.iter - (fun (kernel_tag, kernel) -> + (fun kernel -> + let kernel_tag, _ = Kernel.to_uses_and_tags kernel in let tags = kernel_tag :: tags in register ~kernel ~threshold_encryption:false ~title:(sf "%s (sequencer, %s)" title kernel_tag) ~tags) - (List.map Kernel.to_uses_and_tags kernels) ; + kernels ; List.iter - (fun (kernel_tag, kernel) -> + (fun kernel -> + let kernel_tag, _ = Kernel.to_uses_and_tags kernel in let tags = kernel_tag :: tags in register ~kernel ~threshold_encryption:true ~title:(sf "%s (te_sequencer, %s)" title kernel_tag) ~tags:(Tag.ci_disabled :: "threshold_encryption" :: tags)) - [Kernel.(to_uses_and_tags Latest)] + [Latest] let register_upgrade_both ~title ~tags ~genesis_timestamp ?(time_between_blocks = Evm_node.Nothing) ?(kernels = Kernel.all) @@ -1225,10 +1222,7 @@ let test_delayed_deposit_from_init_rollup_node = in let* () = Process.check @@ Evm_node.spawn_init_config new_sequencer in let* () = - Evm_node.init_from_rollup_node_data_dir - ~devmode:true - new_sequencer - sc_rollup_node + Evm_node.init_from_rollup_node_data_dir new_sequencer sc_rollup_node in let* () = Evm_node.run new_sequencer in @@ -1286,7 +1280,6 @@ let test_init_from_rollup_node_data_dir = let* () = Evm_node.init_from_rollup_node_data_dir - ~devmode:true ~reconstruct:boot_sector evm_node' sc_rollup_node @@ -1370,12 +1363,7 @@ let test_init_from_rollup_node_with_delayed_inbox = unit) in - let* () = - Evm_node.init_from_rollup_node_data_dir - ~devmode:true - evm_node' - sc_rollup_node - in + let* () = Evm_node.init_from_rollup_node_data_dir evm_node' sc_rollup_node in let* () = Evm_node.run evm_node' in @@ -1505,7 +1493,6 @@ let test_get_balance_block_param = initial_kernel = "evm_kernel.wasm"; preimages_dir = "/tmp"; rollup_node_endpoint = Sc_rollup_node.endpoint sc_rollup_node; - devmode = true; time_between_blocks = Some Nothing; }) ~data_dir:(Temp.dir name) @@ -1516,7 +1503,6 @@ let test_get_balance_block_param = in let* () = Evm_node.init_from_rollup_node_data_dir - ~devmode:true observer_partial_history sc_rollup_node in @@ -1580,7 +1566,6 @@ let test_get_block_by_number_block_param = initial_kernel = "evm_kernel.wasm"; preimages_dir = "/tmp"; rollup_node_endpoint = Sc_rollup_node.endpoint sc_rollup_node; - devmode = true; time_between_blocks = Some Nothing; }) ~data_dir:(Temp.dir name) @@ -1591,7 +1576,6 @@ let test_get_block_by_number_block_param = in let* () = Evm_node.init_from_rollup_node_data_dir - ~devmode:true observer_partial_history sc_rollup_node in @@ -2229,9 +2213,7 @@ let test_force_kernel_upgrade_too_early = (* Wait for the sequencer to publish its genesis block. *) let* () = bake_until_sync ~sc_rollup_node ~client ~sequencer ~proxy () in let* proxy = - Evm_node.init - ~mode:(Proxy {devmode = true}) - (Sc_rollup_node.endpoint sc_rollup_node) + Evm_node.init ~mode:Proxy (Sc_rollup_node.endpoint sc_rollup_node) in (* Assert the kernel version is the same at start up. *) @@ -2293,9 +2275,7 @@ let test_force_kernel_upgrade = (* Wait for the sequencer to publish its genesis block. *) let* () = bake_until_sync ~sc_rollup_node ~client ~sequencer ~proxy () in let* proxy = - Evm_node.init - ~mode:(Proxy {devmode = true}) - (Sc_rollup_node.endpoint sc_rollup_node) + Evm_node.init ~mode:Proxy (Sc_rollup_node.endpoint sc_rollup_node) in (* Assert the kernel version is the same at start up. *) @@ -2507,115 +2487,6 @@ let test_no_automatic_block_production = ~error_msg:"No transaction hash expected" ; unit -let test_migration_from_ghostnet = - (* Creates a sequencer using prod version and ghostnet kernel. *) - register_test - ~threshold_encryption:false - ~time_between_blocks:Nothing - ~kernel:Constant.WASM.ghostnet_evm_kernel - ~devmode:false - ~max_blueprints_lag:0 - ~tags:["evm"; "sequencer"; "upgrade"; "migration"; "ghostnet"] - ~title:"Sequencer can upgrade from ghostnet" - ~additional_uses:[Constant.WASM.evm_kernel] - @@ fun { - sequencer; - client; - sc_rollup_node; - sc_rollup_address; - l1_contracts; - proxy; - _; - } - _protocol -> - let* _ = next_rollup_node_level ~sc_rollup_node ~client in - (* Check kernelVersion. *) - let* _kernel_version = - check_kernel_version - ~evm_node:sequencer - ~equal:true - Constant.WASM.ghostnet_evm_commit - in - let* _kernel_version = - check_kernel_version - ~evm_node:proxy - ~equal:true - Constant.WASM.ghostnet_evm_commit - in - - (* Produces a few blocks. *) - let* _ = - repeat 2 (fun () -> - let*@ _ = Rpc.produce_block sequencer in - unit) - in - let* () = - repeat 4 (fun () -> - let* _ = next_rollup_node_level ~client ~sc_rollup_node in - unit) - in - (* Check the consistency. *) - let* () = check_head_consistency ~left:proxy ~right:sequencer () in - (* Sends upgrade to current version. *) - let* () = - upgrade - ~sc_rollup_node - ~sc_rollup_address - ~admin:Constant.bootstrap2.public_key_hash - ~admin_contract:l1_contracts.admin - ~client - ~upgrade_to:Constant.WASM.evm_kernel - ~activation_timestamp:"0" - in - (* Bakes 2 blocks for the event follower to see the upgrade. *) - let* _ = - repeat 2 (fun () -> - let* _ = next_rollup_node_level ~client ~sc_rollup_node in - unit) - in - (* Produce a block to trigger the upgrade. *) - let*@ _ = Rpc.produce_block sequencer in - let* _ = - repeat 4 (fun () -> - let* _ = next_rollup_node_level ~client ~sc_rollup_node in - unit) - in - (* Check that the prod sequencer has updated. *) - let* new_kernel_version = - check_kernel_version - ~evm_node:sequencer - ~equal:false - Constant.WASM.ghostnet_evm_commit - in - (* Runs sequencer and proxy with --devmode. *) - let* () = Evm_node.terminate proxy in - let* () = Evm_node.terminate sequencer in - (* Manually put `--devmode` to use the same command line. *) - let* () = Evm_node.run ~extra_arguments:["--devmode"] proxy in - let* () = Evm_node.run ~extra_arguments:["--devmode"] sequencer in - (* Check that new sequencer and proxy are on a new version. *) - let* _kernel_version = - check_kernel_version ~evm_node:sequencer ~equal:true new_kernel_version - in - let* _kernel_version = - check_kernel_version ~evm_node:proxy ~equal:true new_kernel_version - in - (* Check the consistency. *) - let* () = check_head_consistency ~left:proxy ~right:sequencer () in - (* Produces a few blocks. *) - let* _ = - repeat 2 (fun () -> - let*@ _ = Rpc.produce_block sequencer in - unit) - in - let* () = - repeat 4 (fun () -> - let* _ = next_rollup_node_level ~client ~sc_rollup_node in - unit) - in - (* Final consistency check. *) - check_head_consistency ~left:sequencer ~right:proxy () - (** This tests the situation where the kernel has an upgrade and the sequencer upgrade by following the event of the kernel. *) let test_sequencer_upgrade = @@ -2731,10 +2602,7 @@ let test_sequencer_upgrade = let* _ = Evm_node.wait_for_shutdown_event sequencer and* () = let* () = - Evm_node.init_from_rollup_node_data_dir - ~devmode:true - new_sequencer - sc_rollup_node + Evm_node.init_from_rollup_node_data_dir new_sequencer sc_rollup_node in let* () = Evm_node.run new_sequencer in let* () = @@ -2820,10 +2688,7 @@ let test_sequencer_diverge = in let* () = Process.check @@ Evm_node.spawn_init_config observer_bis in let* () = - Evm_node.init_from_rollup_node_data_dir - ~devmode:true - sequencer_bis - sc_rollup_node + Evm_node.init_from_rollup_node_data_dir sequencer_bis sc_rollup_node in let diverged_and_shutdown sequencer observer = let* _ = Evm_node.wait_for_diverged sequencer @@ -3321,10 +3186,7 @@ let test_preimages_endpoint = unit) in let* () = - Evm_node.init_from_rollup_node_data_dir - ~devmode:true - new_sequencer - sc_rollup_node + Evm_node.init_from_rollup_node_data_dir new_sequencer sc_rollup_node in (* Sends an upgrade with new preimages. *) let* () = @@ -3927,7 +3789,6 @@ let () = test_delayed_transfer_timeout_fails_l1_levels protocols ; test_delayed_inbox_flushing protocols ; test_no_automatic_block_production protocols ; - test_migration_from_ghostnet protocols ; test_sequencer_upgrade protocols ; test_sequencer_diverge protocols ; test_sequencer_can_catch_up_on_event protocols ; diff --git a/manifest/product_etherlink.ml b/manifest/product_etherlink.ml index e23f3cf897f69aaf4586b41858e872a7f914997e..bc8d17b7827d236645a527a5b6284e152dcfc5e7 100644 --- a/manifest/product_etherlink.ml +++ b/manifest/product_etherlink.ml @@ -58,16 +58,6 @@ let evm_node_config = octez_stdlib_unix |> open_; ] -let evm_node_lib_prod_encoding = - octez_evm_node_lib - "evm_node_lib_prod_encoding" - ~path:"etherlink/bin_node/lib_prod/encodings" - ~synopsis: - "EVM encodings for the EVM node and plugin for the WASM Debugger [prod \ - version]" - ~deps: - [octez_base |> open_ ~m:"TzPervasives"; octez_scoru_wasm_debugger_plugin] - let _evm_node_sequencer_protobuf = let protobuf_rules = Dune.[protobuf_rule "narwhal"; protobuf_rule "exporter"] @@ -112,43 +102,6 @@ let evm_node_migrations = ]; ] -let evm_node_lib_prod = - octez_evm_node_lib - "evm_node_lib_prod" - ~path:"etherlink/bin_node/lib_prod" - ~synopsis: - "An implementation of a subset of Ethereum JSON-RPC API for the EVM \ - rollup [prod version]" - ~deps: - [ - octez_base |> open_ ~m:"TzPervasives"; - octez_rpc_http |> open_; - octez_rpc_http_server; - octez_workers |> open_; - octez_rpc_http_client_unix; - octez_version_value; - octez_stdlib_unix |> open_; - evm_node_lib_prod_encoding |> open_; - lwt_watcher; - lwt_exit; - caqti; - caqti_lwt; - caqti_lwt_unix; - caqti_sqlite; - octez_client_base |> open_; - evm_node_config |> open_; - octez_context_sigs; - octez_context_disk; - octez_context_encoding; - octez_scoru_wasm; - octez_scoru_wasm_helpers |> open_; - octez_scoru_wasm_debugger_lib |> open_; - octez_layer2_store |> open_; - octez_smart_rollup_lib |> open_; - evm_node_migrations; - prometheus_app; - ] - let evm_node_lib_dev_encoding = octez_evm_node_lib "evm_node_lib_dev_encoding" @@ -211,7 +164,6 @@ let _octez_evm_node_tests = octez_test_helpers |> open_; qcheck_alcotest; alcotezt; - evm_node_lib_prod; evm_node_lib_dev; ] @@ -257,7 +209,6 @@ let _evm_node = octez_version_value; octez_client_base |> open_; octez_client_base_unix |> open_; - evm_node_lib_prod; evm_node_lib_dev; evm_node_config |> open_; ] diff --git a/opam/octez-evm-node-libs.opam b/opam/octez-evm-node-libs.opam index 034b97a6f0031ff7b524de1fa967118e382968c8..1e0d954bc83cbb15413475495c9c3629cfdf4797 100644 --- a/opam/octez-evm-node-libs.opam +++ b/opam/octez-evm-node-libs.opam @@ -12,11 +12,11 @@ depends: [ "ocaml" { >= "4.14" } "octez-libs" "octez-shell-libs" - "octez-smart-rollup-wasm-debugger-plugin" "ocaml-protoc-plugin" { >= "4.5.0" } "caqti-lwt" { >= "2.0.1" } "crunch" { >= "3.3.0" } "re" { >= "1.10.0" } + "octez-smart-rollup-wasm-debugger-plugin" "octez-version" "lwt-watcher" { = "0.2" } "lwt-exit" diff --git a/src/bin_testnet_scenarios/evm_rollup.ml b/src/bin_testnet_scenarios/evm_rollup.ml index 3d53475d44189ddb351102199b32aadf6c53b0e1..5954fd8d9be5d911163ff802f5ae651220cc3b80 100644 --- a/src/bin_testnet_scenarios/evm_rollup.ml +++ b/src/bin_testnet_scenarios/evm_rollup.ml @@ -133,10 +133,7 @@ let setup_evm_infra ~config ~operator ?runner ?preexisting_rollup let* current_level = Node.get_level node in let* _ = Sc_rollup_node.wait_for_level rollup_node current_level in let* evm_node = - Evm_node.init - ~mode:(Proxy {devmode = true}) - ?runner - (Sc_rollup_node.endpoint rollup_node) + Evm_node.init ~mode:Proxy ?runner (Sc_rollup_node.endpoint rollup_node) in Log.info "Node API is available at %s." (Evm_node.endpoint evm_node) ; return (rollup_address, rollup_node, evm_node)