From ef51d29a86c535ccd9a2bd0593473d9347499052 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 29 Apr 2025 13:30:05 +0200 Subject: [PATCH 1/3] Tezlink/Node: turn chain_family into a GADT --- etherlink/bin_node/config/configuration.ml | 4 +- etherlink/bin_node/config/configuration.mli | 4 +- etherlink/bin_node/lib_dev/block_producer.ml | 6 +- etherlink/bin_node/lib_dev/block_producer.mli | 2 +- .../bin_node/lib_dev/durable_storage_path.ml | 2 +- .../bin_node/lib_dev/durable_storage_path.mli | 2 +- .../bin_node/lib_dev/encodings/l2_types.ml | 27 ++++++--- .../bin_node/lib_dev/encodings/l2_types.mli | 59 ++++++++++++++++--- etherlink/bin_node/lib_dev/evm_context.ml | 16 ++--- etherlink/bin_node/lib_dev/evm_ro_context.mli | 2 +- etherlink/bin_node/lib_dev/evm_state.mli | 6 +- etherlink/bin_node/lib_dev/kernel_config.mli | 2 +- etherlink/bin_node/lib_dev/node_error.ml | 11 +++- etherlink/bin_node/lib_dev/observer.ml | 11 ++-- etherlink/bin_node/lib_dev/proxy.ml | 2 +- etherlink/bin_node/lib_dev/rpc.ml | 9 ++- etherlink/bin_node/lib_dev/rpc_encodings.ml | 6 +- etherlink/bin_node/lib_dev/rpc_encodings.mli | 2 +- etherlink/bin_node/lib_dev/rpc_server.ml | 4 +- etherlink/bin_node/lib_dev/rpc_types.ml | 4 +- etherlink/bin_node/lib_dev/sequencer.ml | 12 ++-- etherlink/bin_node/lib_dev/services.ml | 2 +- .../bin_node/lib_dev/services_backend_sig.ml | 13 ++-- etherlink/bin_node/lib_dev/tx_pool.ml | 7 ++- etherlink/bin_node/lib_dev/tx_pool.mli | 2 +- etherlink/bin_node/main.ml | 4 +- 26 files changed, 145 insertions(+), 76 deletions(-) diff --git a/etherlink/bin_node/config/configuration.ml b/etherlink/bin_node/config/configuration.ml index cfbc39484f7d..799380b23a90 100644 --- a/etherlink/bin_node/config/configuration.ml +++ b/etherlink/bin_node/config/configuration.ml @@ -73,7 +73,7 @@ let chain_id_encoding : L2_types.chain_id Data_encoding.t = type l2_chain = { chain_id : L2_types.chain_id; - chain_family : L2_types.chain_family; + chain_family : L2_types.ex_chain_family; } type tx_queue = { @@ -265,7 +265,7 @@ let is_tx_queue_enabled {experimental_features = {enable_tx_queue; _}; _} = let retrieve_chain_family ~l2_chains = match l2_chains with | Some [l2_chain] -> l2_chain.chain_family - | None -> L2_types.EVM + | None -> L2_types.Ex_chain_family EVM | _ -> assert false let default_filter_config ?max_nb_blocks ?max_nb_logs ?chunk_size () = diff --git a/etherlink/bin_node/config/configuration.mli b/etherlink/bin_node/config/configuration.mli index 43394187d8b0..5bafd29850cf 100644 --- a/etherlink/bin_node/config/configuration.mli +++ b/etherlink/bin_node/config/configuration.mli @@ -93,7 +93,7 @@ val chain_id : supported_network -> L2_types.chain_id type l2_chain = { chain_id : L2_types.chain_id; - chain_family : L2_types.chain_family; + chain_family : L2_types.ex_chain_family; } type tx_queue = { @@ -228,7 +228,7 @@ val is_tx_queue_enabled : t -> bool This function will be removed when multichain is implemented *) val retrieve_chain_family : - l2_chains:l2_chain list option -> L2_types.chain_family + l2_chains:l2_chain list option -> L2_types.ex_chain_family val history_mode_encoding : history_mode Data_encoding.t diff --git a/etherlink/bin_node/lib_dev/block_producer.ml b/etherlink/bin_node/lib_dev/block_producer.ml index 50a816885b65..71fe00472b92 100644 --- a/etherlink/bin_node/lib_dev/block_producer.ml +++ b/etherlink/bin_node/lib_dev/block_producer.ml @@ -10,7 +10,7 @@ type parameters = { smart_rollup_address : string; sequencer_key : Client_keys.sk_uri; maximum_number_of_chunks : int; - chain_family : L2_types.chain_family; + chain_family : L2_types.ex_chain_family; tx_container : (module Services_backend_sig.Tx_container); } @@ -216,7 +216,7 @@ let validate_tx ~maximum_cumulative_size (current_size, validation_state) raw_tx in return `Drop -let pop_valid_tx ~chain_family +let pop_valid_tx (type f) ~(chain_family : f L2_types.chain_family) ~(tx_container : (module Services_backend_sig.Tx_container)) (head_info : Evm_context.head) ~maximum_cumulative_size = let open Lwt_result_syntax in @@ -385,7 +385,7 @@ module Handlers = struct smart_rollup_address; sequencer_key; maximum_number_of_chunks; - chain_family; + chain_family = Ex_chain_family chain_family; tx_container; } = state diff --git a/etherlink/bin_node/lib_dev/block_producer.mli b/etherlink/bin_node/lib_dev/block_producer.mli index cabbd676e14c..c727fd5003c2 100644 --- a/etherlink/bin_node/lib_dev/block_producer.mli +++ b/etherlink/bin_node/lib_dev/block_producer.mli @@ -10,7 +10,7 @@ type parameters = { smart_rollup_address : string; sequencer_key : Client_keys.sk_uri; maximum_number_of_chunks : int; - chain_family : L2_types.chain_family; + chain_family : L2_types.ex_chain_family; tx_container : (module Services_backend_sig.Tx_container); } diff --git a/etherlink/bin_node/lib_dev/durable_storage_path.ml b/etherlink/bin_node/lib_dev/durable_storage_path.ml index 0169894b0d5a..54b7b70a9081 100644 --- a/etherlink/bin_node/lib_dev/durable_storage_path.ml +++ b/etherlink/bin_node/lib_dev/durable_storage_path.ml @@ -36,7 +36,7 @@ end let etherlink_root = World_state.make "" -let root_of_chain_family chain_family = +let root_of_chain_family (type f) (chain_family : f L2_types.chain_family) = match chain_family with | L2_types.EVM -> etherlink_root | L2_types.Michelson -> tezlink_root diff --git a/etherlink/bin_node/lib_dev/durable_storage_path.mli b/etherlink/bin_node/lib_dev/durable_storage_path.mli index b1660f21ee4f..14097e1eb516 100644 --- a/etherlink/bin_node/lib_dev/durable_storage_path.mli +++ b/etherlink/bin_node/lib_dev/durable_storage_path.mli @@ -16,7 +16,7 @@ val tezlink_root : path val etherlink_root : path -val root_of_chain_family : L2_types.chain_family -> path +val root_of_chain_family : _ L2_types.chain_family -> path val reboot_counter : string diff --git a/etherlink/bin_node/lib_dev/encodings/l2_types.ml b/etherlink/bin_node/lib_dev/encodings/l2_types.ml index 6d4253e8d462..e9106c2a597d 100644 --- a/etherlink/bin_node/lib_dev/encodings/l2_types.ml +++ b/etherlink/bin_node/lib_dev/encodings/l2_types.ml @@ -30,19 +30,30 @@ module Chain_id = struct Format.fprintf fmt "Chain_id (%s)" (Z.to_string cid) end -type chain_family = EVM | Michelson +type evm_chain_family = Evm_chain_family + +type michelson_chain_family = Michelson_chain_family + +type _ chain_family = + | EVM : evm_chain_family chain_family + | Michelson : michelson_chain_family chain_family + +type ex_chain_family = Ex_chain_family : _ chain_family -> ex_chain_family module Chain_family = struct - let to_string = function EVM -> "EVM" | Michelson -> "Michelson" + let to_string (type f) : f chain_family -> string = function + | EVM -> "EVM" + | Michelson -> "Michelson" let of_string_exn s = match String.lowercase_ascii s with - | "evm" -> EVM - | "michelson" -> Michelson + | "evm" -> Ex_chain_family EVM + | "michelson" -> Ex_chain_family Michelson | _ -> invalid_arg "Chain_family.of_string" let encoding = - Data_encoding.string_enum [("EVM", EVM); ("Michelson", Michelson)] + Data_encoding.string_enum + [("EVM", Ex_chain_family EVM); ("Michelson", Ex_chain_family Michelson)] let pp fmt cf = Format.fprintf fmt "%s" (to_string cf) end @@ -128,17 +139,17 @@ let block_number_of_transactions block = let block_parent block = match block with Eth block -> block.parent | Tez block -> block.parent_hash -let decode_block_hash ~chain_family bytes = +let decode_block_hash (type f) ~(chain_family : f chain_family) bytes = match chain_family with | EVM -> Ethereum_types.decode_block_hash bytes | Michelson -> Tezos_block.decode_block_hash bytes -let genesis_parent_hash ~chain_family = +let genesis_parent_hash (type f) ~(chain_family : f chain_family) = match chain_family with | EVM -> Ethereum_types.genesis_parent_hash | Michelson -> Tezos_block.genesis_parent_hash -let block_from_bytes ~chain_family bytes = +let block_from_bytes (type f) ~(chain_family : f chain_family) bytes = match chain_family with | EVM -> let eth_block = Ethereum_types.block_from_rlp bytes in diff --git a/etherlink/bin_node/lib_dev/encodings/l2_types.mli b/etherlink/bin_node/lib_dev/encodings/l2_types.mli index b13fa1225e04..0871e6610490 100644 --- a/etherlink/bin_node/lib_dev/encodings/l2_types.mli +++ b/etherlink/bin_node/lib_dev/encodings/l2_types.mli @@ -28,20 +28,62 @@ module Chain_id : sig val pp : Format.formatter -> chain_id -> unit end -type chain_family = EVM | Michelson +(** Each L2 chain has a chain family wich is either [EVM] (for + Etherlink) or [Michelson] (for Tezlink). We use GADTs to + statically distinguish the parts of the codebase corresponding to + each. + + The types [evm_chain_family] and [michelson_chain_family] are only + used to tag other types. The only thing that matters is that these + two types are considered different by the OCaml type checker. +*) + +type evm_chain_family = Evm_chain_family + +type michelson_chain_family = Michelson_chain_family + +type 'f chain_family = + | EVM : evm_chain_family chain_family + | Michelson : michelson_chain_family chain_family + +(** The type [ex_chain_family] is an + {{:https://octez.tezos.com/docs/developer/gadt.html#building-complex-expressions}existential + type} abstracting over the type parameter of [chain_family]. This + is useful to type the result of functions returning a chain family + because we don't know which one will be returned before calling + the function (otherwise we would not need the function in the + first place). So a typical pattern is to have a function fetching + the chain family (for example + [Configuration.retrieve_chain_family])) whose return type is + [ex_chain_family] and each time we call it, we immeditalely unwrap + the [Ex_chain_family] constructor to get a ['f chain_family] for an + unknown ['f] instead: + + {[ + let (Ex_chain_family chain_family) = + Configuration.retrieve_chain_family ~l2_chains + in + ]} + + In general, the rule of thumb is that functions {e returning} a + chain family have type [... -> ex_chain_family] but functions {e + using} a chain family have type ['f chain_family -> ...]. +*) + +type ex_chain_family = Ex_chain_family : _ chain_family -> ex_chain_family module Chain_family : sig - val encoding : chain_family Data_encoding.t + val encoding : ex_chain_family Data_encoding.t (** [of_string_exn s] returns the chain family corresponding to the string [s]. The comparison is case-insensitive, so ["Evm"], ["evm"], ["EVM"], etc. are all valid. @raise Invalid_argument if [s] does not correspond to a recognized chain family. *) - val of_string_exn : string -> chain_family + val of_string_exn : string -> ex_chain_family - val to_string : chain_family -> string + val to_string : _ chain_family -> string - val pp : Format.formatter -> chain_family -> unit + val pp : Format.formatter -> _ chain_family -> unit end module Tezos_block : sig @@ -75,11 +117,12 @@ val block_number_of_transactions : 'a block -> int val block_parent : 'a block -> Ethereum_types.block_hash val decode_block_hash : - chain_family:chain_family -> bytes -> Ethereum_types.block_hash + chain_family:_ chain_family -> bytes -> Ethereum_types.block_hash -val genesis_parent_hash : chain_family:chain_family -> Ethereum_types.block_hash +val genesis_parent_hash : + chain_family:_ chain_family -> Ethereum_types.block_hash val block_from_bytes : - chain_family:chain_family -> + chain_family:_ chain_family -> bytes -> Ethereum_types.legacy_transaction_object block diff --git a/etherlink/bin_node/lib_dev/evm_context.ml b/etherlink/bin_node/lib_dev/evm_context.ml index ff9938c8160b..fed7f9a939ad 100644 --- a/etherlink/bin_node/lib_dev/evm_context.ml +++ b/etherlink/bin_node/lib_dev/evm_context.ml @@ -257,7 +257,9 @@ module State = struct Evm_store.use store @@ fun conn -> let* latest = Evm_store.Context_hashes.find_latest conn in (* TODO: We should iterate when multichain https://gitlab.com/tezos/tezos/-/issues/7859 *) - let chain_family = Configuration.retrieve_chain_family ~l2_chains in + let (Ex_chain_family chain_family) = + Configuration.retrieve_chain_family ~l2_chains + in match latest with | Some (Qty latest_blueprint_number, checkpoint) -> let*! context = Irmin_context.checkout_exn index checkpoint in @@ -483,7 +485,7 @@ module State = struct (* Update mutable session values. *) let next_blueprint_number = Ethereum_types.Qty.next l2_level in (* TODO: We should iterate when multichain https://gitlab.com/tezos/tezos/-/issues/7859 *) - let chain_family = + let (Ex_chain_family chain_family) = Configuration.retrieve_chain_family ~l2_chains:ctxt.configuration.experimental_features.l2_chains in @@ -521,7 +523,7 @@ module State = struct if not ctxt.legacy_block_storage then Evm_store.Blocks.find_hash_of_number conn (Qty number) else - let chain_family = + let (Ex_chain_family chain_family) = Configuration.retrieve_chain_family ~l2_chains:ctxt.configuration.experimental_features.l2_chains in @@ -719,7 +721,7 @@ module State = struct let time_processed = ref Ptime.Span.zero in (* TODO: We should iterate when multichain https://gitlab.com/tezos/tezos/-/issues/7859 *) - let chain_family = + let (Ex_chain_family chain_family) = Configuration.retrieve_chain_family ~l2_chains:ctxt.configuration.experimental_features.l2_chains in @@ -1214,7 +1216,7 @@ module State = struct (* Prepare an event list to be reapplied on current head *) let events = Evm_events.of_parts delayed_transactions lost_upgrade in (* TODO: We should iterate when multichain https://gitlab.com/tezos/tezos/-/issues/7859 *) - let chain_family = + let (Ex_chain_family chain_family) = Configuration.retrieve_chain_family ~l2_chains:ctxt.configuration.experimental_features.l2_chains in @@ -1761,7 +1763,7 @@ module State = struct if not ctxt.legacy_block_storage then Evm_store.Blocks.find_hash_of_number conn (Qty pred_number) else - let chain_family = + let (Ex_chain_family chain_family) = Configuration.retrieve_chain_family ~l2_chains:ctxt.configuration.experimental_features.l2_chains in @@ -2208,7 +2210,7 @@ let init_from_rollup_node ~configuration ~omit_delayed_tx_events ~data_dir let* evm_events = get_evm_events_from_rollup_node_state ~omit_delayed_tx_events evm_state in - let chain_family = + let (Ex_chain_family chain_family) = Configuration.retrieve_chain_family ~l2_chains:configuration.Configuration.experimental_features.l2_chains in diff --git a/etherlink/bin_node/lib_dev/evm_ro_context.mli b/etherlink/bin_node/lib_dev/evm_ro_context.mli index a7215c9c9bbb..9b85985f6eeb 100644 --- a/etherlink/bin_node/lib_dev/evm_ro_context.mli +++ b/etherlink/bin_node/lib_dev/evm_ro_context.mli @@ -36,7 +36,7 @@ val load : (** [read_chain_family chain_id] returns the chain_family associated to the chain_id passed on parameter. *) val read_chain_family : - t -> L2_types.chain_id -> L2_types.chain_family tzresult Lwt.t + t -> L2_types.chain_id -> L2_types.ex_chain_family tzresult Lwt.t (** [read_enable_multichain_flag] reads the value of the `enable_multichain` feature_flag that enables multichain and tezos compatibility on the l2_node. *) diff --git a/etherlink/bin_node/lib_dev/evm_state.mli b/etherlink/bin_node/lib_dev/evm_state.mli index 6c0b2502b31f..91a6c92d214d 100644 --- a/etherlink/bin_node/lib_dev/evm_state.mli +++ b/etherlink/bin_node/lib_dev/evm_state.mli @@ -79,7 +79,7 @@ val current_block_height : (** Same as {!current_block_height} for the block hash. *) val current_block_hash : - chain_family:L2_types.chain_family -> + chain_family:_ L2_types.chain_family -> t -> Ethereum_types.block_hash tzresult Lwt.t @@ -103,7 +103,7 @@ val apply_blueprint : ?log_file:string -> ?profile:Configuration.profile_mode -> data_dir:string -> - chain_family:L2_types.chain_family -> + chain_family:_ L2_types.chain_family -> config:Wasm_debugger.config -> native_execution_policy:Configuration.native_execution_policy -> t -> @@ -140,7 +140,7 @@ val get_delayed_inbox_item : and all durable storage information stored for [block], if this function is called they need to be store elsewhere, mainly it consists in transactions. *) val clear_block_storage : - L2_types.chain_family -> 'transaction_object L2_types.block -> t -> t Lwt.t + _ L2_types.chain_family -> 'transaction_object L2_types.block -> t -> t Lwt.t (** [storage_version tree] returns the current storage version set by the kernel. This storage version is used by the EVM node to determine whether a diff --git a/etherlink/bin_node/lib_dev/kernel_config.mli b/etherlink/bin_node/lib_dev/kernel_config.mli index e38aa25f0f3c..8ff5c68d4b6a 100644 --- a/etherlink/bin_node/lib_dev/kernel_config.mli +++ b/etherlink/bin_node/lib_dev/kernel_config.mli @@ -63,7 +63,7 @@ val make_l2 : ?set_account_code:(string * string) list -> ?world_state_path:string * string -> l2_chain_id:string -> - l2_chain_family:L2_types.chain_family -> + l2_chain_family:_ L2_types.chain_family -> output:string -> unit -> unit tzresult Lwt.t diff --git a/etherlink/bin_node/lib_dev/node_error.ml b/etherlink/bin_node/lib_dev/node_error.ml index eefb12f94a43..ea9616c464c4 100644 --- a/etherlink/bin_node/lib_dev/node_error.ml +++ b/etherlink/bin_node/lib_dev/node_error.ml @@ -37,8 +37,8 @@ type error += | Singlechain_node_multichain_kernel | Mismatched_chain_family of { chain_id : L2_types.chain_id; - node_family : L2_types.chain_family; - kernel_family : L2_types.chain_family; + node_family : L2_types.ex_chain_family; + kernel_family : L2_types.ex_chain_family; } | Dream_rpc_tezlink @@ -159,7 +159,12 @@ let () = ~description: "The node was configured with a chain family which does not match the \ one found in the durable storage." - ~pp:(fun ppf (chain_id, node_family, kernel_family) -> + ~pp:(fun + ppf + ( chain_id, + L2_types.Ex_chain_family node_family, + L2_types.Ex_chain_family kernel_family ) + -> Format.fprintf ppf "The node was configured with the %a chain family for chain %a but the \ diff --git a/etherlink/bin_node/lib_dev/observer.ml b/etherlink/bin_node/lib_dev/observer.ml index bc5a74fb7a27..55009581ca0a 100644 --- a/etherlink/bin_node/lib_dev/observer.ml +++ b/etherlink/bin_node/lib_dev/observer.ml @@ -231,7 +231,7 @@ let main ?network ?kernel_path ~data_dir ~(config : Configuration.t) ~no_sync in let* enable_multichain = Evm_ro_context.read_enable_multichain_flag ro_ctxt in - let* l2_chain_id, chain_family = + let* l2_chain_id, Ex_chain_family chain_family = let (module Backend) = observer_backend in Backend.single_chain_id_and_family ~config ~enable_multichain in @@ -254,7 +254,7 @@ let main ?network ?kernel_path ~data_dir ~(config : Configuration.t) ~no_sync 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; - chain_family; + chain_family = Ex_chain_family chain_family; } in @@ -263,13 +263,16 @@ let main ?network ?kernel_path ~data_dir ~(config : Configuration.t) ~no_sync ~tx_pool_size_info:Tx_pool.size_info ~smart_rollup_address ; + let rpc_server_family = + Rpc_types.Single_chain_node_rpc_server (Ex_chain_family chain_family) + in let* finalizer_public_server = Rpc_server.start_public_server ~l2_chain_id ~evm_services: Evm_ro_context.(evm_services_methods ro_ctxt time_between_blocks) ~data_dir - ~rpc_server_family:(Rpc_types.Single_chain_node_rpc_server chain_family) + ~rpc_server_family Minimal config tx_container @@ -277,7 +280,7 @@ let main ?network ?kernel_path ~data_dir ~(config : Configuration.t) ~no_sync in let* finalizer_private_server = Rpc_server.start_private_server - ~rpc_server_family:(Rpc_types.Single_chain_node_rpc_server chain_family) + ~rpc_server_family config tx_container (observer_backend, smart_rollup_address) diff --git a/etherlink/bin_node/lib_dev/proxy.ml b/etherlink/bin_node/lib_dev/proxy.ml index ddb8ee8bdc68..238ce9103622 100644 --- a/etherlink/bin_node/lib_dev/proxy.ml +++ b/etherlink/bin_node/lib_dev/proxy.ml @@ -164,7 +164,7 @@ let main then (* The finalized view of the proxy mode and the multichain feature are not compatible. *) tzfail (Node_error.Proxy_finalize_with_multichain `Node) - else return (None, L2_types.EVM) + else return (None, L2_types.Ex_chain_family EVM) else let* enable_multichain = Rollup_node_rpc.is_multichain_enabled () in Rollup_node_rpc.single_chain_id_and_family ~config ~enable_multichain diff --git a/etherlink/bin_node/lib_dev/rpc.ml b/etherlink/bin_node/lib_dev/rpc.ml index b82fe507f2e6..7b4eb80db093 100644 --- a/etherlink/bin_node/lib_dev/rpc.ml +++ b/etherlink/bin_node/lib_dev/rpc.ml @@ -181,7 +181,7 @@ let main ~data_dir ~evm_node_endpoint ?evm_node_private_endpoint let rpc_backend = Evm_ro_context.ro_backend ctxt config ~evm_node_endpoint in let* enable_multichain = Evm_ro_context.read_enable_multichain_flag ctxt in - let* l2_chain_id, chain_family = + let* l2_chain_id, Ex_chain_family chain_family = let (module Backend) = rpc_backend in Backend.single_chain_id_and_family ~config ~enable_multichain in @@ -223,7 +223,7 @@ let main ~data_dir ~evm_node_endpoint ?evm_node_private_endpoint 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; - chain_family; + chain_family = Ex_chain_family chain_family; } in return @@ -248,6 +248,9 @@ let main ~data_dir ~evm_node_endpoint ?evm_node_private_endpoint } in + let rpc_server_family = + Rpc_types.Single_chain_node_rpc_server (Ex_chain_family chain_family) + in let* server_public_finalizer = Rpc_server.start_public_server ~l2_chain_id @@ -255,7 +258,7 @@ let main ~data_dir ~evm_node_endpoint ?evm_node_private_endpoint ~evm_services: Evm_ro_context.(evm_services_methods ctxt time_between_blocks) ~data_dir - ~rpc_server_family:(Rpc_types.Single_chain_node_rpc_server chain_family) + ~rpc_server_family Minimal rpc_config tx_container diff --git a/etherlink/bin_node/lib_dev/rpc_encodings.ml b/etherlink/bin_node/lib_dev/rpc_encodings.ml index 68190ca76906..10b4758cade2 100644 --- a/etherlink/bin_node/lib_dev/rpc_encodings.ml +++ b/etherlink/bin_node/lib_dev/rpc_encodings.ml @@ -264,7 +264,7 @@ end module Chain_family = struct type input = L2_types.chain_id - type output = L2_types.chain_family + type output = L2_types.ex_chain_family let input_encoding = Data_encoding.tup1 L2_types.Chain_id.encoding @@ -1203,9 +1203,9 @@ let map_method_name ~rpc_server_family ~restrict method_name = | Rpc_types.Multichain_sequencer_rpc_server -> ( multichain_sequencer_supported_methods, multichain_sequencer_unsupported_methods ) - | Rpc_types.Single_chain_node_rpc_server L2_types.EVM -> + | Rpc_types.Single_chain_node_rpc_server (Ex_chain_family EVM) -> (evm_supported_methods, evm_unsupported_methods) - | Rpc_types.Single_chain_node_rpc_server L2_types.Michelson -> + | Rpc_types.Single_chain_node_rpc_server (Ex_chain_family Michelson) -> (michelson_supported_methods, michelson_unsupported_methods) in let disabled = diff --git a/etherlink/bin_node/lib_dev/rpc_encodings.mli b/etherlink/bin_node/lib_dev/rpc_encodings.mli index e4fdc1ac8f5a..25ef20b24b7c 100644 --- a/etherlink/bin_node/lib_dev/rpc_encodings.mli +++ b/etherlink/bin_node/lib_dev/rpc_encodings.mli @@ -142,7 +142,7 @@ module Chain_id : module Chain_family : METHOD with type input = L2_types.chain_id - and type output = L2_types.chain_family + and type output = L2_types.ex_chain_family module Accounts : METHOD with type input = unit and type output = Ethereum_types.address list diff --git a/etherlink/bin_node/lib_dev/rpc_server.ml b/etherlink/bin_node/lib_dev/rpc_server.ml index 8b5e83c72c75..4cb09cc62719 100644 --- a/etherlink/bin_node/lib_dev/rpc_server.ml +++ b/etherlink/bin_node/lib_dev/rpc_server.ml @@ -163,7 +163,7 @@ let start_public_server ~(rpc_server_family : Rpc_types.rpc_server_family) let*? () = Rpc_types.check_rpc_server_config rpc_server_family config in let* register_tezos_services = match rpc_server_family with - | Rpc_types.Single_chain_node_rpc_server L2_types.Michelson -> + | Rpc_types.Single_chain_node_rpc_server (Ex_chain_family Michelson) -> let (module Backend : Services_backend_sig.S), _ = ctxt in let* l2_chain_id = match l2_chain_id with @@ -174,7 +174,7 @@ let start_public_server ~(rpc_server_family : Rpc_types.rpc_server_family) @@ Tezos_services.register_tezlink_services ~l2_chain_id (module Backend.Tezlink) - | Single_chain_node_rpc_server L2_types.EVM + | Single_chain_node_rpc_server (Ex_chain_family EVM) | Multichain_sequencer_rpc_server -> return @@ Evm_directory.empty config.experimental_features.rpc_server in diff --git a/etherlink/bin_node/lib_dev/rpc_types.ml b/etherlink/bin_node/lib_dev/rpc_types.ml index 9cab54bb6012..64838c443bd6 100644 --- a/etherlink/bin_node/lib_dev/rpc_types.ml +++ b/etherlink/bin_node/lib_dev/rpc_types.ml @@ -13,10 +13,10 @@ type rpc_server_family = | Multichain_sequencer_rpc_server - | Single_chain_node_rpc_server of L2_types.chain_family + | Single_chain_node_rpc_server of L2_types.ex_chain_family let check_rpc_server_config rpc_server_family (config : Configuration.t) = match (rpc_server_family, config.experimental_features.rpc_server) with - | Single_chain_node_rpc_server L2_types.Michelson, Dream -> + | Single_chain_node_rpc_server (Ex_chain_family Michelson), Dream -> Result_syntax.tzfail Node_error.Dream_rpc_tezlink | _ -> Result_syntax.return_unit diff --git a/etherlink/bin_node/lib_dev/sequencer.ml b/etherlink/bin_node/lib_dev/sequencer.ml index 2183aa01057a..19d0b588f983 100644 --- a/etherlink/bin_node/lib_dev/sequencer.ml +++ b/etherlink/bin_node/lib_dev/sequencer.ml @@ -288,7 +288,7 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt let* () = if status = Created then (* TODO: We should iterate when multichain https://gitlab.com/tezos/tezos/-/issues/7859 *) - let chain_family = + let (Ex_chain_family chain_family) = Configuration.retrieve_chain_family ~l2_chains:configuration.experimental_features.l2_chains in @@ -320,7 +320,7 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt let backend = Evm_ro_context.ro_backend ro_ctxt configuration in let* enable_multichain = Evm_ro_context.read_enable_multichain_flag ro_ctxt in - let* l2_chain_id, chain_family = + let* l2_chain_id, Ex_chain_family chain_family = let (module Backend) = backend in Backend.single_chain_id_and_family ~config:configuration ~enable_multichain in @@ -341,7 +341,7 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt 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; - chain_family; + chain_family = Ex_chain_family chain_family; } in Metrics.init @@ -355,7 +355,7 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt smart_rollup_address = smart_rollup_address_b58; sequencer_key = sequencer_config.sequencer; maximum_number_of_chunks = sequencer_config.max_number_of_chunks; - chain_family; + chain_family = Ex_chain_family chain_family; tx_container; } in @@ -385,7 +385,7 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt ~data_dir ~rpc_server_family: (if enable_multichain then Rpc_types.Multichain_sequencer_rpc_server - else Rpc_types.Single_chain_node_rpc_server EVM) + else Rpc_types.Single_chain_node_rpc_server (Ex_chain_family EVM)) (* When the tx_queue is enabled the validation is done in the block_producer instead of in the RPC. This allows for a more accurate validation as it's delayed up to when the block is @@ -399,7 +399,7 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt Rpc_server.start_private_server ~rpc_server_family: (if enable_multichain then Rpc_types.Multichain_sequencer_rpc_server - else Rpc_types.Single_chain_node_rpc_server EVM) + else Rpc_types.Single_chain_node_rpc_server (Ex_chain_family EVM)) ~block_production:`Single_node configuration tx_container diff --git a/etherlink/bin_node/lib_dev/services.ml b/etherlink/bin_node/lib_dev/services.ml index 27b853b283c9..041b3cafcaf4 100644 --- a/etherlink/bin_node/lib_dev/services.ml +++ b/etherlink/bin_node/lib_dev/services.ml @@ -558,7 +558,7 @@ let dispatch_request ~websocket build_with_input ~f module_ parameters | Generic_block_number.Method -> let f (_ : unit option) = - let chain_family = + let (Ex_chain_family chain_family) = Configuration.retrieve_chain_family ~l2_chains:config.experimental_features.l2_chains in diff --git a/etherlink/bin_node/lib_dev/services_backend_sig.ml b/etherlink/bin_node/lib_dev/services_backend_sig.ml index 7bf936c5e6d4..6a30281b6ced 100644 --- a/etherlink/bin_node/lib_dev/services_backend_sig.ml +++ b/etherlink/bin_node/lib_dev/services_backend_sig.ml @@ -16,7 +16,7 @@ module type S = sig module Tracer_etherlink : Tracer_sig.S val block_param_to_block_number : - chain_family:L2_types.chain_family -> + chain_family:_ L2_types.chain_family -> Ethereum_types.Block_parameter.extended -> Ethereum_types.quantity tzresult Lwt.t @@ -29,7 +29,8 @@ module type S = sig val chain_id : unit -> L2_types.chain_id tzresult Lwt.t (** [chain_family chain_id] returns chain family defined for the chain with id chain_id. *) - val chain_family : L2_types.chain_id -> L2_types.chain_family tzresult Lwt.t + val chain_family : + L2_types.chain_id -> L2_types.ex_chain_family tzresult Lwt.t (** [single_chain_id_and_family] should only be called if the node is expected to follow a single chain. It compares the @@ -51,7 +52,7 @@ module type S = sig val single_chain_id_and_family : config:Configuration.t -> enable_multichain:bool -> - (L2_types.chain_id option * L2_types.chain_family) tzresult Lwt.t + (L2_types.chain_id option * L2_types.ex_chain_family) tzresult Lwt.t (** [storage_version ()] returns the latest storage version known to the current kernel. This can be used to determine which features are and are @@ -90,7 +91,7 @@ module type Backend = sig (** [block_param_to_block_number block_param] returns the block number of the block identified by [block_param]. *) val block_param_to_block_number : - chain_family:L2_types.chain_family -> + chain_family:_ L2_types.chain_family -> Ethereum_types.Block_parameter.extended -> Ethereum_types.quantity tzresult Lwt.t @@ -155,11 +156,11 @@ module Make (Backend : Backend) (Executor : Evm_execution.S) : S = struct = let open Lwt_result_syntax in match (config.experimental_features.l2_chains, enable_multichain) with - | None, false -> return (None, L2_types.EVM) + | None, false -> return (None, L2_types.Ex_chain_family EVM) | None, true -> tzfail Node_error.Singlechain_node_multichain_kernel | Some [l2_chain], false -> let*! () = Events.multichain_node_singlechain_kernel () in - return (Some l2_chain.chain_id, L2_types.EVM) + return (Some l2_chain.chain_id, L2_types.Ex_chain_family EVM) | Some [l2_chain], true -> let chain_id = l2_chain.chain_id in let* chain_family = chain_family chain_id in diff --git a/etherlink/bin_node/lib_dev/tx_pool.ml b/etherlink/bin_node/lib_dev/tx_pool.ml index 0c24e07f4ce3..7e609b38f414 100644 --- a/etherlink/bin_node/lib_dev/tx_pool.ml +++ b/etherlink/bin_node/lib_dev/tx_pool.ml @@ -231,7 +231,7 @@ type parameters = { tx_timeout_limit : int64; tx_pool_addr_limit : int; tx_pool_tx_per_addr_limit : int; - chain_family : L2_types.chain_family; + chain_family : L2_types.ex_chain_family; } module Types = struct @@ -245,7 +245,7 @@ module Types = struct tx_pool_addr_limit : int; tx_pool_tx_per_addr_limit : int; mutable locked : bool; - chain_family : L2_types.chain_family; + chain_family : L2_types.ex_chain_family; } type nonrec parameters = parameters @@ -498,11 +498,12 @@ let pop_transactions state ~maximum_cumulative_size = pool; locked; tx_timeout_limit; + chain_family; _; } = state in - if locked || state.chain_family = L2_types.Michelson then return [] + if locked || chain_family = L2_types.Ex_chain_family Michelson then return [] else (* Get all the addresses in the tx-pool. *) let addresses = Pool.addresses pool in diff --git a/etherlink/bin_node/lib_dev/tx_pool.mli b/etherlink/bin_node/lib_dev/tx_pool.mli index 9f02a6c96f4e..4805aa5eab1d 100644 --- a/etherlink/bin_node/lib_dev/tx_pool.mli +++ b/etherlink/bin_node/lib_dev/tx_pool.mli @@ -20,7 +20,7 @@ type parameters = { 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. *) - chain_family : L2_types.chain_family; + chain_family : L2_types.ex_chain_family; } (** [start parameters] starts the tx-pool *) diff --git a/etherlink/bin_node/main.ml b/etherlink/bin_node/main.ml index baaf39de6c06..7fe267d9d8b2 100644 --- a/etherlink/bin_node/main.ml +++ b/etherlink/bin_node/main.ml @@ -1059,7 +1059,7 @@ let add_tezlink_to_node_configuration tezlink_chain_id configuration = [ { chain_id = Chain_id Z.(of_int tezlink_chain_id); - chain_family = Michelson; + chain_family = Ex_chain_family Michelson; }; ]); spawn_rpc = @@ -2114,7 +2114,7 @@ let make_l2_kernel_config_command = set_account_code, world_state_path, l2_chain_id, - l2_chain_family ) + Ex_chain_family l2_chain_family ) output () -> let* l2_chain_id = -- GitLab From 90823e67897543dda24fc7df41331371f2e86c24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 29 Apr 2025 14:15:28 +0200 Subject: [PATCH 2/3] Tezlink/Node: introduce the tx_container GADT --- etherlink/bin_node/lib_dev/block_producer.ml | 18 +- etherlink/bin_node/lib_dev/block_producer.mli | 2 +- .../bin_node/lib_dev/blueprints_publisher.ml | 13 +- .../bin_node/lib_dev/blueprints_publisher.mli | 2 +- etherlink/bin_node/lib_dev/evm_context.ml | 22 +- etherlink/bin_node/lib_dev/evm_context.mli | 4 +- etherlink/bin_node/lib_dev/observer.ml | 80 +++---- etherlink/bin_node/lib_dev/proxy.ml | 87 ++++---- etherlink/bin_node/lib_dev/rpc.ml | 198 +++++++++--------- etherlink/bin_node/lib_dev/rpc_server.mli | 4 +- etherlink/bin_node/lib_dev/sequencer.ml | 28 +-- etherlink/bin_node/lib_dev/services.ml | 77 +++++-- .../bin_node/lib_dev/services_backend_sig.ml | 42 ++++ etherlink/bin_node/lib_dev/tx_pool.ml | 2 + etherlink/bin_node/lib_dev/tx_pool.mli | 2 +- etherlink/bin_node/lib_dev/tx_queue.ml | 2 + etherlink/bin_node/lib_dev/tx_queue.mli | 2 +- etherlink/bin_node/main.ml | 6 +- .../fa-bridge-watchtower/etherlink_monitor.ml | 12 +- 19 files changed, 366 insertions(+), 237 deletions(-) diff --git a/etherlink/bin_node/lib_dev/block_producer.ml b/etherlink/bin_node/lib_dev/block_producer.ml index 71fe00472b92..3534650f5659 100644 --- a/etherlink/bin_node/lib_dev/block_producer.ml +++ b/etherlink/bin_node/lib_dev/block_producer.ml @@ -11,7 +11,7 @@ type parameters = { sequencer_key : Client_keys.sk_uri; maximum_number_of_chunks : int; chain_family : L2_types.ex_chain_family; - tx_container : (module Services_backend_sig.Tx_container); + tx_container : L2_types.evm_chain_family Services_backend_sig.tx_container; } (* The size of a delayed transaction is overapproximated to the maximum size @@ -217,10 +217,11 @@ let validate_tx ~maximum_cumulative_size (current_size, validation_state) raw_tx return `Drop let pop_valid_tx (type f) ~(chain_family : f L2_types.chain_family) - ~(tx_container : (module Services_backend_sig.Tx_container)) + ~(tx_container : + L2_types.evm_chain_family Services_backend_sig.tx_container) (head_info : Evm_context.head) ~maximum_cumulative_size = let open Lwt_result_syntax in - let (module Tx_container) = tx_container in + let (Evm_tx_container (module Tx_container)) = tx_container in (* Skip validation if chain_family is Michelson. *) match chain_family with | L2_types.Michelson -> @@ -268,9 +269,10 @@ let pop_valid_tx (type f) ~(chain_family : f L2_types.chain_family) pool or if [force] is true. *) let produce_block_if_needed ~cctxt ~chain_family ~smart_rollup_address ~sequencer_key ~force ~timestamp ~delayed_hashes ~remaining_cumulative_size - ~(tx_container : (module Services_backend_sig.Tx_container)) head_info = + ~(tx_container : + L2_types.evm_chain_family Services_backend_sig.tx_container) head_info = let open Lwt_result_syntax in - let (module Tx_container) = tx_container in + let (Evm_tx_container (module Tx_container)) = tx_container in let* transactions_and_objects = (* Low key optimization to avoid even checking the txpool if there is not enough space for the smallest transaction. *) @@ -323,9 +325,11 @@ let head_info_and_delayed_transactions ~with_delayed_transactions let produce_block ~chain_family ~cctxt ~smart_rollup_address ~sequencer_key ~force ~timestamp ~maximum_number_of_chunks ~with_delayed_transactions - ~(tx_container : (module Services_backend_sig.Tx_container)) = + ~tx_container = let open Lwt_result_syntax in - let (module Tx_container) = tx_container in + let (module Tx_container) = + Services_backend_sig.tx_container_module tx_container + in let* is_locked = Tx_container.is_locked () in if is_locked then let*! () = Block_producer_events.production_locked () in diff --git a/etherlink/bin_node/lib_dev/block_producer.mli b/etherlink/bin_node/lib_dev/block_producer.mli index c727fd5003c2..1087f05b5926 100644 --- a/etherlink/bin_node/lib_dev/block_producer.mli +++ b/etherlink/bin_node/lib_dev/block_producer.mli @@ -11,7 +11,7 @@ type parameters = { sequencer_key : Client_keys.sk_uri; maximum_number_of_chunks : int; chain_family : L2_types.ex_chain_family; - tx_container : (module Services_backend_sig.Tx_container); + tx_container : L2_types.evm_chain_family Services_backend_sig.tx_container; } (** [start parameters] starts the events follower. *) diff --git a/etherlink/bin_node/lib_dev/blueprints_publisher.ml b/etherlink/bin_node/lib_dev/blueprints_publisher.ml index 0ca4d2c32755..1ad76e90e8cd 100644 --- a/etherlink/bin_node/lib_dev/blueprints_publisher.ml +++ b/etherlink/bin_node/lib_dev/blueprints_publisher.ml @@ -18,7 +18,7 @@ type parameters = { keep_alive : bool; drop_duplicate : bool; order_enabled : bool; - tx_container : (module Services_backend_sig.Tx_container); + tx_container : L2_types.evm_chain_family Services_backend_sig.tx_container; } type state = { @@ -39,7 +39,7 @@ type state = { mutable cooldown : int; (** Do not try to catch-up if [cooldown] is not equal to 0 *) enable_dal : bool; - tx_container : (module Services_backend_sig.Tx_container); + tx_container : L2_types.evm_chain_family Services_backend_sig.tx_container; } module Types = struct @@ -165,7 +165,9 @@ module Worker = struct match rollup_is_lagging_behind self with | No_lag | Needs_republish -> return_unit | Needs_lock -> - let (module Tx_container) = tx_container self in + let (module Tx_container) = + Services_backend_sig.tx_container_module (tx_container self) + in Tx_container.lock_transactions () let catch_up worker = @@ -325,7 +327,10 @@ module Handlers = struct 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. *) - let (module Tx_container) = Worker.tx_container self in + let (module Tx_container) = + Services_backend_sig.tx_container_module + (Worker.tx_container self) + in Tx_container.unlock_transactions ()) let on_completion (type a err) _self (_r : (a, err) Request.t) (_res : a) _st diff --git a/etherlink/bin_node/lib_dev/blueprints_publisher.mli b/etherlink/bin_node/lib_dev/blueprints_publisher.mli index 0531919abe03..b11d27891dcb 100644 --- a/etherlink/bin_node/lib_dev/blueprints_publisher.mli +++ b/etherlink/bin_node/lib_dev/blueprints_publisher.mli @@ -18,7 +18,7 @@ val start : keep_alive:bool -> drop_duplicate:bool -> order_enabled:bool -> - tx_container:(module Services_backend_sig.Tx_container) -> + tx_container:L2_types.evm_chain_family Services_backend_sig.tx_container -> unit -> unit tzresult Lwt.t diff --git a/etherlink/bin_node/lib_dev/evm_context.ml b/etherlink/bin_node/lib_dev/evm_context.ml index fed7f9a939ad..05e5753c0422 100644 --- a/etherlink/bin_node/lib_dev/evm_context.ml +++ b/etherlink/bin_node/lib_dev/evm_context.ml @@ -18,6 +18,9 @@ type head = { pending_upgrade : Evm_events.Upgrade.t option; } +type ex_tx_container = + | Ex_tx_container : _ Services_backend_sig.tx_container -> ex_tx_container + type parameters = { configuration : Configuration.t; kernel_path : Wasm_debugger.kernel option; @@ -26,7 +29,7 @@ type parameters = { store_perm : Sqlite.perm; sequencer_wallet : (Client_keys.sk_uri * Client_context.wallet) option; snapshot_url : string option; - tx_container : (module Services_backend_sig.Tx_container); + tx_container : ex_tx_container; } type session_state = { @@ -49,7 +52,7 @@ type t = { session : session_state; sequencer_wallet : (Client_keys.sk_uri * Client_context.wallet) option; legacy_block_storage : bool; - tx_container : (module Services_backend_sig.Tx_container); + tx_container : ex_tx_container; } let is_sequencer t = Option.is_some t.sequencer_wallet @@ -476,7 +479,10 @@ module State = struct let*! evm_state = Irmin_context.PVMState.get context in (* Clear the TX queue if needed, to preserve its invariants about nonces always increasing. *) let* () = - let (module Tx_container) = ctxt.tx_container in + let (Ex_tx_container tx_container) = ctxt.tx_container in + let (module Tx_container) = + Services_backend_sig.tx_container_module tx_container + in Tx_container.clear () in (* Clear the store. *) @@ -1427,7 +1433,7 @@ module State = struct let init ~(configuration : Configuration.t) ?kernel_path ~data_dir ?smart_rollup_address ~store_perm ?sequencer_wallet ?snapshot_url - ~tx_container () = + ~(tx_container : _ Services_backend_sig.tx_container) () = let open Lwt_result_syntax in let*! () = Lwt_utils_unix.create_dir (Evm_state.kernel_logs_directory ~data_dir) @@ -1541,7 +1547,7 @@ module State = struct store; sequencer_wallet; legacy_block_storage; - tx_container; + tx_container = Ex_tx_container tx_container; } in @@ -1837,7 +1843,7 @@ module Handlers = struct store_perm; sequencer_wallet; snapshot_url; - tx_container; + tx_container = Ex_tx_container tx_container; } = let open Lwt_result_syntax in let* ctxt, status = @@ -2020,7 +2026,7 @@ let worker_wait_for_request req = let start ~configuration ?kernel_path ~data_dir ?smart_rollup_address ~store_perm ?sequencer_wallet ?snapshot_url - ~(tx_container : (module Services_backend_sig.Tx_container)) () = + ~(tx_container : _ Services_backend_sig.tx_container) () = let open Lwt_result_syntax in let* () = lock_data_dir ~data_dir in let* worker = @@ -2035,7 +2041,7 @@ let start ~configuration ?kernel_path ~data_dir ?smart_rollup_address store_perm; sequencer_wallet; snapshot_url; - tx_container; + tx_container = Ex_tx_container tx_container; } (module Handlers) in diff --git a/etherlink/bin_node/lib_dev/evm_context.mli b/etherlink/bin_node/lib_dev/evm_context.mli index aec7f8287efe..facdc50e38e0 100644 --- a/etherlink/bin_node/lib_dev/evm_context.mli +++ b/etherlink/bin_node/lib_dev/evm_context.mli @@ -48,7 +48,7 @@ val start : store_perm:Sqlite.perm -> ?sequencer_wallet:Client_keys.sk_uri * Client_context.wallet -> ?snapshot_url:string -> - tx_container:(module Services_backend_sig.Tx_container) -> + tx_container:_ Services_backend_sig.tx_container -> unit -> (init_status * Address.t) tzresult Lwt.t @@ -63,7 +63,7 @@ val init_from_rollup_node : omit_delayed_tx_events:bool -> data_dir:string -> rollup_node_data_dir:string -> - tx_container:(module Services_backend_sig.Tx_container) -> + tx_container:_ Services_backend_sig.tx_container -> unit -> unit tzresult Lwt.t diff --git a/etherlink/bin_node/lib_dev/observer.ml b/etherlink/bin_node/lib_dev/observer.ml index 55009581ca0a..e4ca830fa321 100644 --- a/etherlink/bin_node/lib_dev/observer.ml +++ b/etherlink/bin_node/lib_dev/observer.ml @@ -21,12 +21,13 @@ open Ethereum_types into a forced blueprint. The sequencer has performed a reorganization and starts submitting blocks from the new branch. *) -let on_new_blueprint (tx_container : (module Services_backend_sig.Tx_container)) +let on_new_blueprint + (tx_container : L2_types.evm_chain_family Services_backend_sig.tx_container) evm_node_endpoint next_blueprint_number (({delayed_transactions; blueprint; _} : Blueprint_types.with_events) as blueprint_with_events) = let open Lwt_result_syntax in - let (module Tx_container) = tx_container in + let (Evm_tx_container (module Tx_container)) = tx_container in let (Qty level) = blueprint.number in let (Qty number) = next_blueprint_number in if Z.(equal level number) then @@ -95,10 +96,13 @@ let on_new_blueprint (tx_container : (module Services_backend_sig.Tx_container)) in return (`Restart_from next_blueprint_number) -let install_finalizer_observer ~rollup_node_tracking finalizer_public_server - finalizer_private_server finalizer_rpc_process - (module Tx_container : Services_backend_sig.Tx_container) = +let install_finalizer_observer ~rollup_node_tracking + ~(tx_container : _ Services_backend_sig.tx_container) + finalizer_public_server finalizer_private_server finalizer_rpc_process = let open Lwt_syntax in + let (module Tx_container) = + Services_backend_sig.tx_container_module tx_container + in Lwt_exit.register_clean_up_callback ~loc:__LOC__ @@ fun exit_status -> let* () = Events.shutdown_node ~exit_status in let* () = finalizer_public_server () in @@ -111,43 +115,45 @@ let install_finalizer_observer ~rollup_node_tracking finalizer_public_server when_ rollup_node_tracking @@ fun () -> Evm_events_follower.shutdown () let container_forward_tx ~keep_alive ~evm_node_endpoint : - (module Services_backend_sig.Tx_container) = - (module struct - let nonce ~next_nonce _address = Lwt_result.return next_nonce + L2_types.evm_chain_family Services_backend_sig.tx_container = + Services_backend_sig.Evm_tx_container + (module struct + let nonce ~next_nonce _address = Lwt_result.return next_nonce - let add ~next_nonce:_ _tx_object ~raw_tx = - Injector.send_raw_transaction - ~keep_alive - ~base:evm_node_endpoint - ~raw_tx:(Ethereum_types.hex_to_bytes raw_tx) + let add ~next_nonce:_ _tx_object ~raw_tx = + Injector.send_raw_transaction + ~keep_alive + ~base:evm_node_endpoint + ~raw_tx:(Ethereum_types.hex_to_bytes raw_tx) - let find _hash = Lwt_result.return None + let find _hash = Lwt_result.return None - let content () = - Lwt_result.return {pending = AddressMap.empty; queued = AddressMap.empty} + let content () = + Lwt_result.return + {pending = AddressMap.empty; queued = AddressMap.empty} - let shutdown () = Lwt_result_syntax.return_unit + let shutdown () = Lwt_result_syntax.return_unit - let clear () = Lwt_result_syntax.return_unit + let clear () = Lwt_result_syntax.return_unit - let tx_queue_tick ~evm_node_endpoint:_ = Lwt_result_syntax.return_unit + let tx_queue_tick ~evm_node_endpoint:_ = Lwt_result_syntax.return_unit - let tx_queue_beacon ~evm_node_endpoint:_ ~tick_interval:_ = - Lwt_result_syntax.return_unit + let tx_queue_beacon ~evm_node_endpoint:_ ~tick_interval:_ = + Lwt_result_syntax.return_unit - let lock_transactions () = Lwt_result_syntax.return_unit + let lock_transactions () = Lwt_result_syntax.return_unit - let unlock_transactions () = Lwt_result_syntax.return_unit + let unlock_transactions () = Lwt_result_syntax.return_unit - let is_locked () = Lwt_result_syntax.return_false + let is_locked () = Lwt_result_syntax.return_false - let confirm_transactions ~clear_pending_queue_after:_ ~confirmed_txs:_ = - Lwt_result_syntax.return_unit + let confirm_transactions ~clear_pending_queue_after:_ ~confirmed_txs:_ = + Lwt_result_syntax.return_unit - let pop_transactions ~maximum_cumulative_size:_ ~validate_tx:_ - ~initial_validation_state:_ = - Lwt_result_syntax.return_nil - end) + let pop_transactions ~maximum_cumulative_size:_ ~validate_tx:_ + ~initial_validation_state:_ = + Lwt_result_syntax.return_nil + end) let main ?network ?kernel_path ~data_dir ~(config : Configuration.t) ~no_sync ~init_from_snapshot () = @@ -188,9 +194,7 @@ let main ?network ?kernel_path ~data_dir ~(config : Configuration.t) ~no_sync let tx_container, ping_tx_pool = match config.experimental_features.enable_tx_queue with - | Some _tx_queue_config -> - ( (module Tx_queue.Tx_container : Services_backend_sig.Tx_container), - false ) + | Some _tx_queue_config -> (Tx_queue.tx_container, false) | None -> if config.finalized_view then let tx_container = @@ -199,9 +203,7 @@ let main ?network ?kernel_path ~data_dir ~(config : Configuration.t) ~no_sync ~evm_node_endpoint in (tx_container, false) - else - ( (module Tx_pool.Tx_container : Services_backend_sig.Tx_container), - true ) + else (Tx_pool.tx_container, true) in let* _loaded = @@ -338,7 +340,7 @@ let main ?network ?kernel_path ~data_dir ~(config : Configuration.t) ~no_sync finalizer_public_server finalizer_private_server finalizer_rpc_process - tx_container + ~tx_container in let*! next_blueprint_number = Evm_context.next_blueprint_number () in @@ -359,7 +361,9 @@ let main ?network ?kernel_path ~data_dir ~(config : Configuration.t) ~no_sync and* () = Drift_monitor.run ~evm_node_endpoint Evm_context.next_blueprint_number and* () = - let (module Tx_container) = tx_container in + let (module Tx_container) = + Services_backend_sig.tx_container_module tx_container + in Tx_container.tx_queue_beacon ~evm_node_endpoint:(Rpc evm_node_endpoint) ~tick_interval:0.05 diff --git a/etherlink/bin_node/lib_dev/proxy.ml b/etherlink/bin_node/lib_dev/proxy.ml index 238ce9103622..03b2716339a4 100644 --- a/etherlink/bin_node/lib_dev/proxy.ml +++ b/etherlink/bin_node/lib_dev/proxy.ml @@ -7,9 +7,12 @@ (* *) (*****************************************************************************) -let install_finalizer server_finalizer - (module Tx_container : Services_backend_sig.Tx_container) = +let install_finalizer ~(tx_container : _ Services_backend_sig.tx_container) + server_finalizer = let open Lwt_syntax in + let (module Tx_container) = + Services_backend_sig.tx_container_module tx_container + in Lwt_exit.register_clean_up_callback ~loc:__LOC__ @@ fun exit_status -> let* () = Events.shutdown_node ~exit_status in let* () = server_finalizer () in @@ -19,55 +22,58 @@ let install_finalizer server_finalizer Evm_context.shutdown () let container_forward_tx ~evm_node_endpoint ~keep_alive : - (module Services_backend_sig.Tx_container) = - (module struct - let nonce ~next_nonce _address = Lwt_result.return next_nonce + L2_types.evm_chain_family Services_backend_sig.tx_container = + Services_backend_sig.Evm_tx_container + (module struct + let nonce ~next_nonce _address = Lwt_result.return next_nonce - let add ~next_nonce:_ _tx_object ~raw_tx = - match evm_node_endpoint with - | Some evm_node_endpoint -> - Injector.send_raw_transaction - ~keep_alive - ~base:evm_node_endpoint - ~raw_tx:(Ethereum_types.hex_to_bytes raw_tx) - | None -> - Lwt.return_ok - @@ Error - "the node is in read-only mode, it doesn't accept transactions" + let add ~next_nonce:_ _tx_object ~raw_tx = + match evm_node_endpoint with + | Some evm_node_endpoint -> + Injector.send_raw_transaction + ~keep_alive + ~base:evm_node_endpoint + ~raw_tx:(Ethereum_types.hex_to_bytes raw_tx) + | None -> + Lwt.return_ok + @@ Error + "the node is in read-only mode, it doesn't accept transactions" - let find _hash = Lwt_result.return None + let find _hash = Lwt_result.return None - let content () = - Lwt_result.return - Ethereum_types.{pending = AddressMap.empty; queued = AddressMap.empty} + let content () = + Lwt_result.return + Ethereum_types.{pending = AddressMap.empty; queued = AddressMap.empty} - let shutdown () = Lwt_result_syntax.return_unit + let shutdown () = Lwt_result_syntax.return_unit - let clear () = Lwt_result_syntax.return_unit + let clear () = Lwt_result_syntax.return_unit - let tx_queue_tick ~evm_node_endpoint:_ = Lwt_result_syntax.return_unit + let tx_queue_tick ~evm_node_endpoint:_ = Lwt_result_syntax.return_unit - let tx_queue_beacon ~evm_node_endpoint:_ ~tick_interval:_ = - Lwt_result_syntax.return_unit + let tx_queue_beacon ~evm_node_endpoint:_ ~tick_interval:_ = + Lwt_result_syntax.return_unit - let lock_transactions () = Lwt_result_syntax.return_unit + let lock_transactions () = Lwt_result_syntax.return_unit - let unlock_transactions () = Lwt_result_syntax.return_unit + let unlock_transactions () = Lwt_result_syntax.return_unit - let is_locked () = Lwt_result_syntax.return_false + let is_locked () = Lwt_result_syntax.return_false - let pop_transactions ~maximum_cumulative_size:_ ~validate_tx:_ - ~initial_validation_state:_ = - Lwt_result_syntax.return_nil + let pop_transactions ~maximum_cumulative_size:_ ~validate_tx:_ + ~initial_validation_state:_ = + Lwt_result_syntax.return_nil - let confirm_transactions ~clear_pending_queue_after:_ ~confirmed_txs:_ = - Lwt_result_syntax.return_unit - end) + let confirm_transactions ~clear_pending_queue_after:_ ~confirmed_txs:_ = + Lwt_result_syntax.return_unit + end) let tx_queue_pop_and_inject (module Rollup_node_rpc : Services_backend_sig.S) - (module Tx_container : Services_backend_sig.Tx_container) + ~(tx_container : + L2_types.evm_chain_family Services_backend_sig.tx_container) ~smart_rollup_address = let open Lwt_result_syntax in + let (Evm_tx_container (module Tx_container)) = tx_container in let maximum_cumulative_size = Sequencer_blueprint.maximum_usable_space_in_blueprint Sequencer_blueprint.maximum_chunks_per_l1_level @@ -182,15 +188,13 @@ let main ~keep_alive:config.keep_alive () in - let tx_container = - (module Tx_queue.Tx_container : Services_backend_sig.Tx_container) - in + let tx_container = Tx_queue.tx_container in return @@ ( Some (fun () -> tx_queue_pop_and_inject (module Rollup_node_rpc) - tx_container + ~tx_container ~smart_rollup_address), tx_container ) | true, None, None -> @@ -208,8 +212,7 @@ let main } in return - ( Some Tx_pool.pop_and_inject_transactions_lazy, - (module Tx_pool.Tx_container : Services_backend_sig.Tx_container) ) + (Some Tx_pool.pop_and_inject_transactions_lazy, Tx_pool.tx_container) | enable_send_raw_transaction, evm_node_endpoint, _ -> let evm_node_endpoint = if enable_send_raw_transaction then evm_node_endpoint else None @@ -234,7 +237,7 @@ let main ((module Rollup_node_rpc), smart_rollup_address) in let (_ : Lwt_exit.clean_up_callback_id) = - install_finalizer server_finalizer tx_container + install_finalizer server_finalizer ~tx_container in let wait, _resolve = Lwt.wait () in let* () = wait in diff --git a/etherlink/bin_node/lib_dev/rpc.ml b/etherlink/bin_node/lib_dev/rpc.ml index 7b4eb80db093..6fb054f29e57 100644 --- a/etherlink/bin_node/lib_dev/rpc.ml +++ b/etherlink/bin_node/lib_dev/rpc.ml @@ -34,9 +34,12 @@ let spawn_main ~exposed_port ~protected_endpoint ?private_endpoint ~data_dir () let finalizer () = Lwt.return process#terminate in finalizer -let install_finalizer_rpc server_public_finalizer - (module Tx_container : Services_backend_sig.Tx_container) = +let install_finalizer_rpc ~(tx_container : _ Services_backend_sig.tx_container) + server_public_finalizer = let open Lwt_syntax in + let (module Tx_container) = + Services_backend_sig.tx_container_module tx_container + in Lwt_exit.register_clean_up_callback ~loc:__LOC__ @@ fun exit_status -> let* () = Events.shutdown_node ~exit_status in let* () = server_public_finalizer () in @@ -59,103 +62,107 @@ let set_metrics_confirmed_levels (ctxt : Evm_ro_context.t) = | None -> () let container_forward_request ~public_endpoint ~private_endpoint ~keep_alive : - (module Services_backend_sig.Tx_container) = - (module struct - let rpc_error = - Internal_event.Simple.declare_2 - ~section:Events.section - ~name:"local_node_rpc_failure" - ~msg:"local node failed answering {rpc} with {message}" - ~level:Error - ("rpc", Data_encoding.string) - ("message", Data_encoding.string) - - let forwarding_transaction = - Internal_event.Simple.declare_1 - ~section:Events.section - ~name:"forward_transaction" - ~msg:"forwarding transaction {tx_hash} to local node" - ~level:Info - ~pp1:(fun fmt Ethereum_types.(Hash (Hex h)) -> - Format.fprintf fmt "%10s" h) - ("tx_hash", Ethereum_types.hash_encoding) - - let get_or_emit_error ~rpc_name res = - let open Lwt_result_syntax in - match res with - | Ok res -> return_some res - | Error msg -> - let*! () = Internal_event.Simple.emit rpc_error (rpc_name, msg) in - return_none - - let nonce ~next_nonce address = - let open Lwt_result_syntax in - let* res = - Injector.get_transaction_count + L2_types.evm_chain_family Services_backend_sig.tx_container = + Services_backend_sig.Evm_tx_container + (module struct + let rpc_error = + Internal_event.Simple.declare_2 + ~section:Events.section + ~name:"local_node_rpc_failure" + ~msg:"local node failed answering {rpc} with {message}" + ~level:Error + ("rpc", Data_encoding.string) + ("message", Data_encoding.string) + + let forwarding_transaction = + Internal_event.Simple.declare_1 + ~section:Events.section + ~name:"forward_transaction" + ~msg:"forwarding transaction {tx_hash} to local node" + ~level:Info + ~pp1:(fun fmt Ethereum_types.(Hash (Hex h)) -> + Format.fprintf fmt "%10s" h) + ("tx_hash", Ethereum_types.hash_encoding) + + let get_or_emit_error ~rpc_name res = + let open Lwt_result_syntax in + match res with + | Ok res -> return_some res + | Error msg -> + let*! () = Internal_event.Simple.emit rpc_error (rpc_name, msg) in + return_none + + let nonce ~next_nonce address = + let open Lwt_result_syntax in + let* res = + Injector.get_transaction_count + ~keep_alive + ~base:public_endpoint + address + (* The function [nonce] is only ever called when + requesting the nonce for the pending block. It's + safe to assume the pending block. *) + Ethereum_types.Block_parameter.(Block_parameter Pending) + in + let* nonce = get_or_emit_error ~rpc_name:"get_transaction_count" res in + match nonce with + | Some nonce -> return nonce + | None -> + (*we return the known next_nonce instead of failing *) + return next_nonce + + let add ~next_nonce:_ + (tx_object : Ethereum_types.legacy_transaction_object) ~raw_tx = + let open Lwt_syntax in + let* () = + Internal_event.Simple.emit forwarding_transaction tx_object.hash + in + Injector.inject_transaction ~keep_alive - ~base:public_endpoint - address - (* The function [nonce] is only ever called when - requesting the nonce for the pending block. It's - safe to assume the pending block. *) - Ethereum_types.Block_parameter.(Block_parameter Pending) - in - let* nonce = get_or_emit_error ~rpc_name:"get_transaction_count" res in - match nonce with - | Some nonce -> return nonce - | None -> - (*we return the known next_nonce instead of failing *) - return next_nonce - - let add ~next_nonce:_ (tx_object : Ethereum_types.legacy_transaction_object) - ~raw_tx = - let open Lwt_syntax in - let* () = - Internal_event.Simple.emit forwarding_transaction tx_object.hash - in - Injector.inject_transaction - ~keep_alive - ~base:private_endpoint - ~tx_object - ~raw_tx:(Ethereum_types.hex_to_bytes raw_tx) - - let find hash = - let open Lwt_result_syntax in - let* res = - Injector.get_transaction_by_hash ~keep_alive ~base:public_endpoint hash - in - let* tx_object = - get_or_emit_error ~rpc_name:"get_transaction_by_hash" res - in - let tx_object = Option.join tx_object in - return tx_object + ~base:private_endpoint + ~tx_object + ~raw_tx:(Ethereum_types.hex_to_bytes raw_tx) + + let find hash = + let open Lwt_result_syntax in + let* res = + Injector.get_transaction_by_hash + ~keep_alive + ~base:public_endpoint + hash + in + let* tx_object = + get_or_emit_error ~rpc_name:"get_transaction_by_hash" res + in + let tx_object = Option.join tx_object in + return tx_object - let content () = - Lwt_result.return - Ethereum_types.{pending = AddressMap.empty; queued = AddressMap.empty} + let content () = + Lwt_result.return + Ethereum_types.{pending = AddressMap.empty; queued = AddressMap.empty} - let shutdown () = Lwt_result_syntax.return_unit + let shutdown () = Lwt_result_syntax.return_unit - let clear () = Lwt_result_syntax.return_unit + let clear () = Lwt_result_syntax.return_unit - let tx_queue_tick ~evm_node_endpoint:_ = Lwt_result_syntax.return_unit + let tx_queue_tick ~evm_node_endpoint:_ = Lwt_result_syntax.return_unit - let tx_queue_beacon ~evm_node_endpoint:_ ~tick_interval:_ = - Lwt_result_syntax.return_unit + let tx_queue_beacon ~evm_node_endpoint:_ ~tick_interval:_ = + Lwt_result_syntax.return_unit - let lock_transactions () = Lwt_result_syntax.return_unit + let lock_transactions () = Lwt_result_syntax.return_unit - let unlock_transactions () = Lwt_result_syntax.return_unit + let unlock_transactions () = Lwt_result_syntax.return_unit - let is_locked () = Lwt_result_syntax.return_false + let is_locked () = Lwt_result_syntax.return_false - let confirm_transactions ~clear_pending_queue_after:_ ~confirmed_txs:_ = - Lwt_result_syntax.return_unit + let confirm_transactions ~clear_pending_queue_after:_ ~confirmed_txs:_ = + Lwt_result_syntax.return_unit - let pop_transactions ~maximum_cumulative_size:_ ~validate_tx:_ - ~initial_validation_state:_ = - Lwt_result_syntax.return_nil - end) + let pop_transactions ~maximum_cumulative_size:_ ~validate_tx:_ + ~initial_validation_state:_ = + Lwt_result_syntax.return_nil + end) let main ~data_dir ~evm_node_endpoint ?evm_node_private_endpoint ~(config : Configuration.t) () = @@ -206,10 +213,7 @@ let main ~data_dir ~evm_node_endpoint ?evm_node_private_endpoint ~keep_alive:config.keep_alive () in - return - ( false, - (module Tx_queue.Tx_container : Services_backend_sig.Tx_container) - ) + return (false, Tx_queue.tx_container) | None, None -> let* () = Tx_pool.start @@ -226,9 +230,7 @@ let main ~data_dir ~evm_node_endpoint ?evm_node_private_endpoint chain_family = Ex_chain_family chain_family; } in - return - ( true, - (module Tx_pool.Tx_container : Services_backend_sig.Tx_container) ) + return (true, Tx_pool.tx_container) in let* () = set_metrics_level ctxt in @@ -266,7 +268,7 @@ let main ~data_dir ~evm_node_endpoint ?evm_node_private_endpoint in let (_ : Lwt_exit.clean_up_callback_id) = - install_finalizer_rpc server_public_finalizer tx_container + install_finalizer_rpc server_public_finalizer ~tx_container in let* () = @@ -276,7 +278,9 @@ let main ~data_dir ~evm_node_endpoint ?evm_node_private_endpoint let* next_blueprint_number = Evm_ro_context.next_blueprint_number ctxt in let* () = - let (module Tx_container) = tx_container in + let (module Tx_container) = + Services_backend_sig.tx_container_module tx_container + in Tx_container.tx_queue_beacon ~evm_node_endpoint:(Rpc evm_node_endpoint) ~tick_interval:0.05 diff --git a/etherlink/bin_node/lib_dev/rpc_server.mli b/etherlink/bin_node/lib_dev/rpc_server.mli index fe652fc5eca1..a48bbd9783c0 100644 --- a/etherlink/bin_node/lib_dev/rpc_server.mli +++ b/etherlink/bin_node/lib_dev/rpc_server.mli @@ -32,7 +32,7 @@ val start_private_server : rpc_server_family:Rpc_types.rpc_server_family -> ?block_production:block_production -> Configuration.t -> - (module Services_backend_sig.Tx_container) -> + _ Services_backend_sig.tx_container -> (module Services_backend_sig.S) * 'a -> finalizer tzresult Lwt.t @@ -52,6 +52,6 @@ val start_public_server : ?data_dir:string -> Validate.validation_mode -> Configuration.t -> - (module Services_backend_sig.Tx_container) -> + _ Services_backend_sig.tx_container -> (module Services_backend_sig.S) * 'a -> finalizer tzresult Lwt.t diff --git a/etherlink/bin_node/lib_dev/sequencer.ml b/etherlink/bin_node/lib_dev/sequencer.ml index 19d0b588f983..9e9e470e4071 100644 --- a/etherlink/bin_node/lib_dev/sequencer.ml +++ b/etherlink/bin_node/lib_dev/sequencer.ml @@ -18,10 +18,12 @@ type sandbox_config = { tezlink : int option; } -let install_finalizer_seq server_public_finalizer server_private_finalizer - finalizer_rpc_process - (module Tx_container : Services_backend_sig.Tx_container) = +let install_finalizer_seq ~(tx_container : _ Services_backend_sig.tx_container) + server_public_finalizer server_private_finalizer finalizer_rpc_process = let open Lwt_syntax in + let (module Tx_container) = + Services_backend_sig.tx_container_module tx_container + in Lwt_exit.register_clean_up_callback ~loc:__LOC__ @@ fun exit_status -> let* () = Events.shutdown_node ~exit_status in let* () = server_public_finalizer () in @@ -36,9 +38,11 @@ let install_finalizer_seq server_public_finalizer server_private_finalizer return_unit let loop_sequencer multichain backend - (module Tx_container : Services_backend_sig.Tx_container) ?sandbox_config - time_between_blocks = + ~(tx_container : + L2_types.evm_chain_family Services_backend_sig.tx_container) + ?sandbox_config time_between_blocks = let open Lwt_result_syntax in + let (Evm_tx_container (module Tx_container)) = tx_container in match sandbox_config with | Some {parent_chain = Some evm_node_endpoint; _} -> let*! head = Evm_context.head_info () in @@ -170,11 +174,11 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt in let* tx_container = match configuration.experimental_features.enable_tx_queue with - | Some _tx_queue_config -> - return - (module Tx_queue.Tx_container : Services_backend_sig.Tx_container) - | None -> - return (module Tx_pool.Tx_container : Services_backend_sig.Tx_container) + | Some _tx_queue_config -> return Tx_queue.tx_container + | None -> return Tx_pool.tx_container + in + let (module Tx_container) = + Services_backend_sig.tx_container_module tx_container in let* status, smart_rollup_address_typed = Evm_context.start @@ -429,13 +433,13 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt finalizer_public_server finalizer_private_server finalizer_rpc_process - tx_container + ~tx_container in let* () = loop_sequencer enable_multichain backend - tx_container + ~tx_container ?sandbox_config sequencer_config.time_between_blocks in diff --git a/etherlink/bin_node/lib_dev/services.ml b/etherlink/bin_node/lib_dev/services.ml index 041b3cafcaf4..ea48453245c0 100644 --- a/etherlink/bin_node/lib_dev/services.ml +++ b/etherlink/bin_node/lib_dev/services.ml @@ -487,10 +487,10 @@ let process_trace_result trace = let msg = Format.asprintf "%a" pp_print_trace e in rpc_error (Rpc_errors.internal_error msg) -let dispatch_request ~websocket +let dispatch_request (type f) ~websocket (rpc_server_family : Rpc_types.rpc_server_family) (rpc : Configuration.rpc) (validation : Validate.validation_mode) (config : Configuration.t) - (module Tx_container : Services_backend_sig.Tx_container) + (tx_container : f Services_backend_sig.tx_container) ((module Backend_rpc : Services_backend_sig.S), _) ({method_; parameters; id} : JSONRPC.request) : JSONRPC.response Lwt.t = let open Lwt_result_syntax in @@ -657,6 +657,14 @@ let dispatch_request ~websocket let f (address, block_param) = match block_param with | Ethereum_types.Block_parameter.(Block_parameter Pending) -> + let* (module Tx_container) = + match tx_container with + | Evm_tx_container m -> return m + | Michelson_tx_container _ -> + failwith + "Unsupported JSONRPC method in Tezlink: \ + getTransactionCount" + in let* next_nonce = Backend_rpc.Etherlink.nonce address block_param in @@ -759,6 +767,14 @@ let dispatch_request ~websocket build_with_input ~f module_ parameters | Get_transaction_by_hash.Method -> let f tx_hash = + let* (module Tx_container) = + match tx_container with + | Evm_tx_container m -> return m + | Michelson_tx_container _ -> + failwith + "Unsupported JSONRPC method in Tezlink: \ + getTransactionByHash" + in let* transaction_object = Tx_container.find tx_hash in let* transaction_object = match transaction_object with @@ -844,6 +860,14 @@ let dispatch_request ~websocket in rpc_error (Rpc_errors.transaction_rejected err None) | Ok (next_nonce, transaction_object) -> ( + let* (module Tx_container) = + match tx_container with + | Evm_tx_container m -> return m + | Michelson_tx_container _ -> + failwith + "Unsupported JSONRPC method in Tezlink: \ + sendRawTransaction" + in let* tx_hash = Tx_container.add ~next_nonce transaction_object ~raw_tx in @@ -902,6 +926,13 @@ let dispatch_request ~websocket build_with_input ~f module_ parameters | Txpool_content.Method -> let f (_ : unit option) = + let* (module Tx_container) = + match tx_container with + | Evm_tx_container m -> return m + | Michelson_tx_container _ -> + failwith + "Unsupported JSONRPC method in Tezlink: txpoolContent" + in let* txpool_content = Tx_container.content () in rpc_ok txpool_content in @@ -1020,10 +1051,10 @@ let dispatch_request ~websocket in Lwt.return JSONRPC.{value; id} -let dispatch_private_request ~websocket +let dispatch_private_request (type f) ~websocket (rpc_server_family : Rpc_types.rpc_server_family) (rpc : Configuration.rpc) (config : Configuration.t) - (module Tx_container : Services_backend_sig.Tx_container) + (tx_container : f Services_backend_sig.tx_container) ((module Backend_rpc : Services_backend_sig.S), _) ~block_production ({method_; parameters; id} : JSONRPC.request) : JSONRPC.response Lwt.t = let open Lwt_syntax in @@ -1127,6 +1158,14 @@ let dispatch_private_request ~websocket rpc_error (Rpc_errors.transaction_rejected err None) | Ok (next_nonce, transaction_object) -> ( let* tx_hash = + let* (module Tx_container) = + match tx_container with + | Evm_tx_container m -> return m + | Michelson_tx_container _ -> + failwith + "Unsupported JSONRPC method in Tezlink: \ + injectTransaction" + in Tx_container.add ~next_nonce transaction_object @@ -1305,8 +1344,9 @@ let generic_dispatch ~service_name (rpc : Configuration.rpc) config tx_container input |> Lwt_result.ok) -let dispatch_public (rpc_server_family : Rpc_types.rpc_server_family) - (rpc : Configuration.rpc) validation config tx_container ctx dir = +let dispatch_public (type f) (rpc_server_family : Rpc_types.rpc_server_family) + (rpc : Configuration.rpc) validation config + (tx_container : f Services_backend_sig.tx_container) ctx dir = generic_dispatch ~service_name:"public_rpc" rpc @@ -1317,8 +1357,9 @@ let dispatch_public (rpc_server_family : Rpc_types.rpc_server_family) Path.root (dispatch_request ~websocket:false rpc_server_family rpc validation) -let dispatch_private (rpc_server_family : Rpc_types.rpc_server_family) - (rpc : Configuration.rpc) ~block_production config tx_container ctx dir = +let dispatch_private (type f) (rpc_server_family : Rpc_types.rpc_server_family) + (rpc : Configuration.rpc) ~block_production config + (tx_container : f Services_backend_sig.tx_container) ctx dir = generic_dispatch ~service_name:"private_rpc" rpc @@ -1345,8 +1386,10 @@ let generic_websocket_dispatch (config : Configuration.t) tx_container ctx dir path (dispatch_websocket config tx_container ctx) -let dispatch_websocket_public (rpc_server_family : Rpc_types.rpc_server_family) - (rpc : Configuration.rpc) validation config tx_container ctx dir = +let dispatch_websocket_public (type f) + (rpc_server_family : Rpc_types.rpc_server_family) (rpc : Configuration.rpc) + validation config (tx_container : f Services_backend_sig.tx_container) ctx + dir = generic_websocket_dispatch config tx_container @@ -1355,8 +1398,10 @@ let dispatch_websocket_public (rpc_server_family : Rpc_types.rpc_server_family) "/ws" (dispatch_websocket rpc_server_family rpc validation) -let dispatch_websocket_private (rpc_server_family : Rpc_types.rpc_server_family) - (rpc : Configuration.rpc) ~block_production config tx_container ctx dir = +let dispatch_websocket_private (type f) + (rpc_server_family : Rpc_types.rpc_server_family) (rpc : Configuration.rpc) + ~block_production config + (tx_container : f Services_backend_sig.tx_container) ctx dir = generic_websocket_dispatch config tx_container @@ -1365,8 +1410,9 @@ let dispatch_websocket_private (rpc_server_family : Rpc_types.rpc_server_family) "/private/ws" (dispatch_private_websocket rpc_server_family ~block_production rpc) -let directory ~rpc_server_family ?delegate_health_check_to rpc validation config - tx_container backend dir = +let directory (type f) ~rpc_server_family ?delegate_health_check_to rpc + validation config (tx_container : f Services_backend_sig.tx_container) + backend dir = dir |> version |> configuration config |> health_check ?delegate_to:delegate_health_check_to |> dispatch_public @@ -1384,7 +1430,8 @@ let directory ~rpc_server_family ?delegate_health_check_to rpc validation config tx_container backend -let private_directory ~rpc_server_family rpc config tx_container backend +let private_directory (type f) ~rpc_server_family rpc config + (tx_container : f Services_backend_sig.tx_container) backend ~block_production = Evm_directory.empty config.experimental_features.rpc_server |> version diff --git a/etherlink/bin_node/lib_dev/services_backend_sig.ml b/etherlink/bin_node/lib_dev/services_backend_sig.ml index 6a30281b6ced..f606fda9e200 100644 --- a/etherlink/bin_node/lib_dev/services_backend_sig.ml +++ b/etherlink/bin_node/lib_dev/services_backend_sig.ml @@ -267,3 +267,45 @@ module type Tx_container = sig initial_validation_state:'a -> (string * Ethereum_types.legacy_transaction_object) list tzresult Lwt.t end + +(** ['f tx_container] is a GADT parametrized by the same type argument + as [L2_types.chain_family]. It is useful to statically guarantee + that the launched tx-container uses types compatible with the + chain's chain family. *) + +type 'f tx_container = + | Evm_tx_container : + (module Tx_container) + -> L2_types.evm_chain_family tx_container + | Michelson_tx_container : + (module Tx_container) + -> L2_types.michelson_chain_family tx_container + +(** Some functions of the Tx_container module, such as [add], have + interfaces which actually depend on the chain family but many + others, such as [clear] don't. + + In the former case, we usually know statically the type of the + chain family and hence of the tx-container and we can for example + invoke [add] as follows: + + {[ + let Evm_tx_container (module Tx_container) = tx_container in + let** hash = Tx_container.add ~next_nonce ~raw_tx tx_obj in + ]} + + In the latter case, statically knowing the type of the chain + family is not required and the following [tx_container_module] + function can be used to get a [Tx_container] module: + + {[ + let (module Tx_container) = Services_backend_sig.tx_container_module tx_container in + let* () = Tx_container.clear () in + ]} + + +*) +let tx_container_module (type f) (tx_container : f tx_container) = + match tx_container with + | Evm_tx_container m -> (m :> (module Tx_container)) + | Michelson_tx_container m -> m diff --git a/etherlink/bin_node/lib_dev/tx_pool.ml b/etherlink/bin_node/lib_dev/tx_pool.ml index 7e609b38f414..90e763efac69 100644 --- a/etherlink/bin_node/lib_dev/tx_pool.ml +++ b/etherlink/bin_node/lib_dev/tx_pool.ml @@ -985,3 +985,5 @@ module Tx_container = struct ~initial_validation_state:_ = pop_transactions ~maximum_cumulative_size end + +let tx_container = Services_backend_sig.Evm_tx_container (module Tx_container) diff --git a/etherlink/bin_node/lib_dev/tx_pool.mli b/etherlink/bin_node/lib_dev/tx_pool.mli index 4805aa5eab1d..3d8fc89ced37 100644 --- a/etherlink/bin_node/lib_dev/tx_pool.mli +++ b/etherlink/bin_node/lib_dev/tx_pool.mli @@ -53,4 +53,4 @@ val mode : unit -> mode tzresult Lwt.t (** wrapper of the Tx_pool to be compatible with the Tx_container signature for the services. *) -module Tx_container : Services_backend_sig.Tx_container +val tx_container : L2_types.evm_chain_family Services_backend_sig.tx_container diff --git a/etherlink/bin_node/lib_dev/tx_queue.ml b/etherlink/bin_node/lib_dev/tx_queue.ml index 0427bef60c5e..9cc7f479b2cd 100644 --- a/etherlink/bin_node/lib_dev/tx_queue.ml +++ b/etherlink/bin_node/lib_dev/tx_queue.ml @@ -1139,3 +1139,5 @@ module Tx_container = struct end let start = Tx_container.start + +let tx_container = Services_backend_sig.Evm_tx_container (module Tx_container) diff --git a/etherlink/bin_node/lib_dev/tx_queue.mli b/etherlink/bin_node/lib_dev/tx_queue.mli index 2d419faf96f6..1c3f7a149460 100644 --- a/etherlink/bin_node/lib_dev/tx_queue.mli +++ b/etherlink/bin_node/lib_dev/tx_queue.mli @@ -35,7 +35,7 @@ val start : (** wrapper of the Tx_queue to be compatible with the Tx_container signature for the services. *) -module Tx_container : Services_backend_sig.Tx_container +val tx_container : L2_types.evm_chain_family Services_backend_sig.tx_container (**/*) diff --git a/etherlink/bin_node/main.ml b/etherlink/bin_node/main.ml index 7fe267d9d8b2..96e4f92641e6 100644 --- a/etherlink/bin_node/main.ml +++ b/etherlink/bin_node/main.ml @@ -1555,7 +1555,7 @@ let init_from_rollup_node_command = ~omit_delayed_tx_events ~data_dir ~rollup_node_data_dir - ~tx_container:(module Evm_node_lib_dev.Tx_queue.Tx_container) + ~tx_container:Evm_node_lib_dev.Tx_queue.tx_container ()) let dump_to_rlp_command = @@ -1770,7 +1770,7 @@ let patch_kernel_command = ~configuration ~data_dir ~store_perm:Read_write - ~tx_container:(module Evm_node_lib_dev.Tx_queue.Tx_container) + ~tx_container:Evm_node_lib_dev.Tx_queue.tx_container () in Evm_context.patch_kernel ?block_number (On_disk kernel_path) @@ -3015,7 +3015,7 @@ let patch_state_command = ~configuration ~data_dir ~store_perm:Read_write - ~tx_container:(module Evm_node_lib_dev.Tx_queue.Tx_container) + ~tx_container:Evm_node_lib_dev.Tx_queue.tx_container () in Evm_context.patch_state ?block_number ~key ~value () diff --git a/etherlink/fa-bridge-watchtower/etherlink_monitor.ml b/etherlink/fa-bridge-watchtower/etherlink_monitor.ml index 950432d6e841..c79456f673dc 100644 --- a/etherlink/fa-bridge-watchtower/etherlink_monitor.ml +++ b/etherlink/fa-bridge-watchtower/etherlink_monitor.ml @@ -54,6 +54,8 @@ end module Tx_queue = struct include Tx_queue + let (Services_backend_sig.Evm_tx_container tx_container) = tx_container + let ( let**? ) v f = let open Lwt_result_syntax in match v with Ok v -> f v | Error err -> return (Error err) @@ -61,6 +63,7 @@ module Tx_queue = struct (* as found in etherlink/bin_floodgate/tx_queue.ml *) let transfer ctx ?to_ ?(value = Z.zero) ~data () = let open Lwt_result_syntax in + let (module Tx_container) = tx_container in let (Ethereum_types.Qty nonce as qnonce) = ctx.nonce in let txn = Craft.transfer ctx ~nonce ?to_ ~value ~data () in let tx_raw = Ethereum_types.hex_to_bytes txn in @@ -704,8 +707,9 @@ let handle_confirmed_txs {db; ws_client; _} (nonce, exec.transactionHash, exec.blockNumber) in let* () = Db.Deposits.set_claimed db nonce exec in + let (module Tx_container) = Tx_queue.tx_container in let* () = - Tx_queue.Tx_container.confirm_transactions + Tx_container.confirm_transactions ~clear_pending_queue_after:false ~confirmed_txs:(Seq.cons tx_hash Seq.empty) in @@ -738,7 +742,8 @@ let claim_deposits ctx = in ctx.nonce <- nonce ; (* Clear queue because we reinject all missing claims. *) - let* () = Tx_queue.Tx_container.clear () in + let (module Tx_container) = Tx_queue.tx_container in + let* () = Tx_container.clear () in List.iter_es (fun deposit -> let (Qty deposit_id) = deposit.Db.nonce in @@ -892,9 +897,10 @@ let start db ~config ~notify_ws_change ~first_block = in let rec tx_queue_beacon () = let open Lwt_syntax in + let (module Tx_container) = Tx_queue.tx_container in let* res = protect @@ fun () -> - Tx_queue.Tx_container.tx_queue_tick ~evm_node_endpoint:!tx_queue_endpoint + Tx_container.tx_queue_tick ~evm_node_endpoint:!tx_queue_endpoint in let* () = match res with -- GitLab From 0ae1700c8b931f836ba41dee66bd66f2ef04f569 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 29 Apr 2025 14:27:44 +0200 Subject: [PATCH 3/3] Tezlink/Node: turn rpc_server_family into a GADT --- etherlink/bin_node/lib_dev/observer.ml | 4 +-- etherlink/bin_node/lib_dev/proxy.ml | 4 +-- etherlink/bin_node/lib_dev/rpc.ml | 4 +-- etherlink/bin_node/lib_dev/rpc_encodings.ml | 7 +++-- etherlink/bin_node/lib_dev/rpc_encodings.mli | 2 +- etherlink/bin_node/lib_dev/rpc_server.ml | 12 +++---- etherlink/bin_node/lib_dev/rpc_server.mli | 4 +-- etherlink/bin_node/lib_dev/rpc_types.ml | 25 ++++++++++----- etherlink/bin_node/lib_dev/sequencer.ml | 4 +-- etherlink/bin_node/lib_dev/services.ml | 33 +++++++++++--------- 10 files changed, 54 insertions(+), 45 deletions(-) diff --git a/etherlink/bin_node/lib_dev/observer.ml b/etherlink/bin_node/lib_dev/observer.ml index e4ca830fa321..d71db38ad45b 100644 --- a/etherlink/bin_node/lib_dev/observer.ml +++ b/etherlink/bin_node/lib_dev/observer.ml @@ -265,9 +265,7 @@ let main ?network ?kernel_path ~data_dir ~(config : Configuration.t) ~no_sync ~tx_pool_size_info:Tx_pool.size_info ~smart_rollup_address ; - let rpc_server_family = - Rpc_types.Single_chain_node_rpc_server (Ex_chain_family chain_family) - in + let rpc_server_family = Rpc_types.Single_chain_node_rpc_server chain_family in let* finalizer_public_server = Rpc_server.start_public_server ~l2_chain_id diff --git a/etherlink/bin_node/lib_dev/proxy.ml b/etherlink/bin_node/lib_dev/proxy.ml index 03b2716339a4..87c0eda79ab9 100644 --- a/etherlink/bin_node/lib_dev/proxy.ml +++ b/etherlink/bin_node/lib_dev/proxy.ml @@ -161,7 +161,7 @@ let main | Some _base -> Validate.Minimal | None -> Validate.Full in - let* l2_chain_id, chain_family = + let* l2_chain_id, Ex_chain_family chain_family = if finalized_view then if (* When finalized_view is set, it's too early to request the @@ -208,7 +208,7 @@ let main 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; - chain_family; + chain_family = Ex_chain_family chain_family; } in return diff --git a/etherlink/bin_node/lib_dev/rpc.ml b/etherlink/bin_node/lib_dev/rpc.ml index 6fb054f29e57..74e64aee37cd 100644 --- a/etherlink/bin_node/lib_dev/rpc.ml +++ b/etherlink/bin_node/lib_dev/rpc.ml @@ -250,9 +250,7 @@ let main ~data_dir ~evm_node_endpoint ?evm_node_private_endpoint } in - let rpc_server_family = - Rpc_types.Single_chain_node_rpc_server (Ex_chain_family chain_family) - in + let rpc_server_family = Rpc_types.Single_chain_node_rpc_server chain_family in let* server_public_finalizer = Rpc_server.start_public_server ~l2_chain_id diff --git a/etherlink/bin_node/lib_dev/rpc_encodings.ml b/etherlink/bin_node/lib_dev/rpc_encodings.ml index 10b4758cade2..f68aace7cc63 100644 --- a/etherlink/bin_node/lib_dev/rpc_encodings.ml +++ b/etherlink/bin_node/lib_dev/rpc_encodings.ml @@ -1197,15 +1197,16 @@ let multichain_sequencer_unsupported_methods = in evm_unsupported_methods @ diff_method_names -let map_method_name ~rpc_server_family ~restrict method_name = +let map_method_name (type f) + ~(rpc_server_family : f Rpc_types.rpc_server_family) ~restrict method_name = let supported_methods, unsupported_methods = match rpc_server_family with | Rpc_types.Multichain_sequencer_rpc_server -> ( multichain_sequencer_supported_methods, multichain_sequencer_unsupported_methods ) - | Rpc_types.Single_chain_node_rpc_server (Ex_chain_family EVM) -> + | Rpc_types.Single_chain_node_rpc_server EVM -> (evm_supported_methods, evm_unsupported_methods) - | Rpc_types.Single_chain_node_rpc_server (Ex_chain_family Michelson) -> + | Rpc_types.Single_chain_node_rpc_server Michelson -> (michelson_supported_methods, michelson_unsupported_methods) in let disabled = diff --git a/etherlink/bin_node/lib_dev/rpc_encodings.mli b/etherlink/bin_node/lib_dev/rpc_encodings.mli index 25ef20b24b7c..2de83d6fb277 100644 --- a/etherlink/bin_node/lib_dev/rpc_encodings.mli +++ b/etherlink/bin_node/lib_dev/rpc_encodings.mli @@ -378,7 +378,7 @@ type map_result = | Disabled val map_method_name : - rpc_server_family:Rpc_types.rpc_server_family -> + rpc_server_family:_ Rpc_types.rpc_server_family -> restrict:Configuration.restricted_rpcs -> string -> map_result diff --git a/etherlink/bin_node/lib_dev/rpc_server.ml b/etherlink/bin_node/lib_dev/rpc_server.ml index 4cb09cc62719..d6862280e3c5 100644 --- a/etherlink/bin_node/lib_dev/rpc_server.ml +++ b/etherlink/bin_node/lib_dev/rpc_server.ml @@ -140,8 +140,9 @@ let monitor_performances ~data_dir = in Lwt.dont_wait aux (Fun.const ()) -let start_public_server ~(rpc_server_family : Rpc_types.rpc_server_family) - ~l2_chain_id ?delegate_health_check_to ?evm_services ?data_dir validation +let start_public_server (type f) + ~(rpc_server_family : f Rpc_types.rpc_server_family) ~l2_chain_id + ?delegate_health_check_to ?evm_services ?data_dir validation (config : Configuration.t) tx_container ctxt = let open Lwt_result_syntax in let*! can_start_performance_metrics = @@ -163,7 +164,7 @@ let start_public_server ~(rpc_server_family : Rpc_types.rpc_server_family) let*? () = Rpc_types.check_rpc_server_config rpc_server_family config in let* register_tezos_services = match rpc_server_family with - | Rpc_types.Single_chain_node_rpc_server (Ex_chain_family Michelson) -> + | Rpc_types.Single_chain_node_rpc_server Michelson -> let (module Backend : Services_backend_sig.S), _ = ctxt in let* l2_chain_id = match l2_chain_id with @@ -174,8 +175,7 @@ let start_public_server ~(rpc_server_family : Rpc_types.rpc_server_family) @@ Tezos_services.register_tezlink_services ~l2_chain_id (module Backend.Tezlink) - | Single_chain_node_rpc_server (Ex_chain_family EVM) - | Multichain_sequencer_rpc_server -> + | Single_chain_node_rpc_server EVM | Multichain_sequencer_rpc_server -> return @@ Evm_directory.empty config.experimental_features.rpc_server in (* If spawn_rpc is defined, use it as intermediate *) @@ -209,7 +209,7 @@ let start_public_server ~(rpc_server_family : Rpc_types.rpc_server_family) in return finalizer -let start_private_server ~(rpc_server_family : Rpc_types.rpc_server_family) +let start_private_server ~(rpc_server_family : _ Rpc_types.rpc_server_family) ?(block_production = `Disabled) config tx_container ctxt = let open Lwt_result_syntax in match config.Configuration.private_rpc with diff --git a/etherlink/bin_node/lib_dev/rpc_server.mli b/etherlink/bin_node/lib_dev/rpc_server.mli index a48bbd9783c0..6a7c16e88c5c 100644 --- a/etherlink/bin_node/lib_dev/rpc_server.mli +++ b/etherlink/bin_node/lib_dev/rpc_server.mli @@ -29,7 +29,7 @@ type block_production = [`Single_node | `Disabled] sequencer setup, [`Disabled] means no block production method is available. *) val start_private_server : - rpc_server_family:Rpc_types.rpc_server_family -> + rpc_server_family:_ Rpc_types.rpc_server_family -> ?block_production:block_production -> Configuration.t -> _ Services_backend_sig.tx_container -> @@ -45,7 +45,7 @@ val start_private_server : If [data_dir] is provided and the host provides the necessary binaries, performance metrics are enabled. *) val start_public_server : - rpc_server_family:Rpc_types.rpc_server_family -> + rpc_server_family:_ Rpc_types.rpc_server_family -> l2_chain_id:L2_types.chain_id option -> ?delegate_health_check_to:Uri.t -> ?evm_services:evm_services_methods -> diff --git a/etherlink/bin_node/lib_dev/rpc_types.ml b/etherlink/bin_node/lib_dev/rpc_types.ml index 64838c443bd6..77ef143a538c 100644 --- a/etherlink/bin_node/lib_dev/rpc_types.ml +++ b/etherlink/bin_node/lib_dev/rpc_types.ml @@ -5,18 +5,27 @@ (* *) (*****************************************************************************) -(* The set of supported RPCs depends on the mode. +(* The set of supported RPCs depends on the mode and on the chain + family. + For the sequencer, only very few JSON RPCs need to be supported. For the observer, proxy, and RPC modes, we assume that a single - chain is followed even when the multichain feature is activated - and the set of supported RPCs depends on the chain family. *) + chain is followed even when the multichain feature is activated and + the set of supported RPCs depends on the chain family. + + The ['f rpc_server_family] GADT keeps track of the dependency to + the chain family. +*) -type rpc_server_family = - | Multichain_sequencer_rpc_server - | Single_chain_node_rpc_server of L2_types.ex_chain_family +type 'f rpc_server_family = + | Multichain_sequencer_rpc_server : _ rpc_server_family + | Single_chain_node_rpc_server : + 'f L2_types.chain_family + -> 'f rpc_server_family -let check_rpc_server_config rpc_server_family (config : Configuration.t) = +let check_rpc_server_config (type f) (rpc_server_family : f rpc_server_family) + (config : Configuration.t) = match (rpc_server_family, config.experimental_features.rpc_server) with - | Single_chain_node_rpc_server (Ex_chain_family Michelson), Dream -> + | Single_chain_node_rpc_server Michelson, Dream -> Result_syntax.tzfail Node_error.Dream_rpc_tezlink | _ -> Result_syntax.return_unit diff --git a/etherlink/bin_node/lib_dev/sequencer.ml b/etherlink/bin_node/lib_dev/sequencer.ml index 9e9e470e4071..217d81bce683 100644 --- a/etherlink/bin_node/lib_dev/sequencer.ml +++ b/etherlink/bin_node/lib_dev/sequencer.ml @@ -389,7 +389,7 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt ~data_dir ~rpc_server_family: (if enable_multichain then Rpc_types.Multichain_sequencer_rpc_server - else Rpc_types.Single_chain_node_rpc_server (Ex_chain_family EVM)) + else Rpc_types.Single_chain_node_rpc_server EVM) (* When the tx_queue is enabled the validation is done in the block_producer instead of in the RPC. This allows for a more accurate validation as it's delayed up to when the block is @@ -403,7 +403,7 @@ let main ~data_dir ?(genesis_timestamp = Misc.now ()) ~cctxt Rpc_server.start_private_server ~rpc_server_family: (if enable_multichain then Rpc_types.Multichain_sequencer_rpc_server - else Rpc_types.Single_chain_node_rpc_server (Ex_chain_family EVM)) + else Rpc_types.Single_chain_node_rpc_server EVM) ~block_production:`Single_node configuration tx_container diff --git a/etherlink/bin_node/lib_dev/services.ml b/etherlink/bin_node/lib_dev/services.ml index ea48453245c0..ca58e552a4f6 100644 --- a/etherlink/bin_node/lib_dev/services.ml +++ b/etherlink/bin_node/lib_dev/services.ml @@ -488,8 +488,9 @@ let process_trace_result trace = rpc_error (Rpc_errors.internal_error msg) let dispatch_request (type f) ~websocket - (rpc_server_family : Rpc_types.rpc_server_family) (rpc : Configuration.rpc) - (validation : Validate.validation_mode) (config : Configuration.t) + (rpc_server_family : _ Rpc_types.rpc_server_family) + (rpc : Configuration.rpc) (validation : Validate.validation_mode) + (config : Configuration.t) (tx_container : f Services_backend_sig.tx_container) ((module Backend_rpc : Services_backend_sig.S), _) ({method_; parameters; id} : JSONRPC.request) : JSONRPC.response Lwt.t = @@ -1052,8 +1053,8 @@ let dispatch_request (type f) ~websocket Lwt.return JSONRPC.{value; id} let dispatch_private_request (type f) ~websocket - (rpc_server_family : Rpc_types.rpc_server_family) (rpc : Configuration.rpc) - (config : Configuration.t) + (rpc_server_family : _ Rpc_types.rpc_server_family) + (rpc : Configuration.rpc) (config : Configuration.t) (tx_container : f Services_backend_sig.tx_container) ((module Backend_rpc : Services_backend_sig.S), _) ~block_production ({method_; parameters; id} : JSONRPC.request) : JSONRPC.response Lwt.t = @@ -1253,7 +1254,7 @@ let empty_stream = let empty_sid = Ethereum_types.(Subscription.Id (Hex "")) -let dispatch_websocket (rpc_server_family : Rpc_types.rpc_server_family) +let dispatch_websocket (rpc_server_family : _ Rpc_types.rpc_server_family) (rpc : Configuration.rpc) validation config tx_container ctx (input : JSONRPC.request) = let open Lwt_syntax in @@ -1314,9 +1315,10 @@ let dispatch_websocket (rpc_server_family : Rpc_types.rpc_server_family) in websocket_response_of_response response -let dispatch_private_websocket (rpc_server_family : Rpc_types.rpc_server_family) - ~block_production (rpc : Configuration.rpc) config tx_container ctx - (input : JSONRPC.request) = +let dispatch_private_websocket + (rpc_server_family : _ Rpc_types.rpc_server_family) ~block_production + (rpc : Configuration.rpc) config tx_container ctx (input : JSONRPC.request) + = let open Lwt_syntax in let+ response = dispatch_private_request @@ -1344,7 +1346,7 @@ let generic_dispatch ~service_name (rpc : Configuration.rpc) config tx_container input |> Lwt_result.ok) -let dispatch_public (type f) (rpc_server_family : Rpc_types.rpc_server_family) +let dispatch_public (type f) (rpc_server_family : _ Rpc_types.rpc_server_family) (rpc : Configuration.rpc) validation config (tx_container : f Services_backend_sig.tx_container) ctx dir = generic_dispatch @@ -1357,7 +1359,8 @@ let dispatch_public (type f) (rpc_server_family : Rpc_types.rpc_server_family) Path.root (dispatch_request ~websocket:false rpc_server_family rpc validation) -let dispatch_private (type f) (rpc_server_family : Rpc_types.rpc_server_family) +let dispatch_private (type f) + (rpc_server_family : _ Rpc_types.rpc_server_family) (rpc : Configuration.rpc) ~block_production config (tx_container : f Services_backend_sig.tx_container) ctx dir = generic_dispatch @@ -1387,9 +1390,9 @@ let generic_websocket_dispatch (config : Configuration.t) tx_container ctx dir (dispatch_websocket config tx_container ctx) let dispatch_websocket_public (type f) - (rpc_server_family : Rpc_types.rpc_server_family) (rpc : Configuration.rpc) - validation config (tx_container : f Services_backend_sig.tx_container) ctx - dir = + (rpc_server_family : _ Rpc_types.rpc_server_family) + (rpc : Configuration.rpc) validation config + (tx_container : f Services_backend_sig.tx_container) ctx dir = generic_websocket_dispatch config tx_container @@ -1399,8 +1402,8 @@ let dispatch_websocket_public (type f) (dispatch_websocket rpc_server_family rpc validation) let dispatch_websocket_private (type f) - (rpc_server_family : Rpc_types.rpc_server_family) (rpc : Configuration.rpc) - ~block_production config + (rpc_server_family : _ Rpc_types.rpc_server_family) + (rpc : Configuration.rpc) ~block_production config (tx_container : f Services_backend_sig.tx_container) ctx dir = generic_websocket_dispatch config -- GitLab