From 048ca9e04e8c10975b4aca68d5bc910c9e07c764 Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Mon, 13 Feb 2023 16:57:31 +0100 Subject: [PATCH 1/8] Injector: remove injector for 013 and 014 protocols --- .gitlab/ci/jobs/packaging/opam_package.yml | 4 - dune-project | 2 - manifest/main.ml | 2 +- opam/tezos-injector-013-PtJakart.opam | 29 - opam/tezos-injector-014-PtKathma.opam | 29 - src/proto_013_PtJakart/lib_injector/common.ml | 100 -- .../lib_injector/common.mli | 76 -- .../lib_injector/disk_persistence.ml | 393 ------- .../lib_injector/disk_persistence.mli | 145 --- src/proto_013_PtJakart/lib_injector/dune | 32 - .../lib_injector/injector_errors.ml | 75 -- .../lib_injector/injector_errors.mli | 36 - .../lib_injector/injector_events.ml | 232 ---- .../lib_injector/injector_functor.ml | 1036 ----------------- .../lib_injector/injector_functor.mli | 29 - .../lib_injector/injector_sigs.ml | 158 --- .../lib_injector/injector_tags.ml | 39 - .../lib_injector/injector_tags.mli | 35 - .../lib_injector/injector_worker_types.ml | 108 -- .../lib_injector/injector_worker_types.mli | 47 - .../lib_injector/l1_operation.ml | 193 --- .../lib_injector/l1_operation.mli | 48 - src/proto_014_PtKathma/lib_injector/common.ml | 100 -- .../lib_injector/common.mli | 76 -- .../lib_injector/disk_persistence.ml | 393 ------- .../lib_injector/disk_persistence.mli | 145 --- src/proto_014_PtKathma/lib_injector/dune | 32 - .../lib_injector/injector_errors.ml | 75 -- .../lib_injector/injector_errors.mli | 36 - .../lib_injector/injector_events.ml | 232 ---- .../lib_injector/injector_functor.ml | 1036 ----------------- .../lib_injector/injector_functor.mli | 29 - .../lib_injector/injector_sigs.ml | 158 --- .../lib_injector/injector_tags.ml | 39 - .../lib_injector/injector_tags.mli | 35 - .../lib_injector/injector_worker_types.ml | 108 -- .../lib_injector/injector_worker_types.mli | 47 - .../lib_injector/l1_operation.ml | 206 ---- .../lib_injector/l1_operation.mli | 48 - 39 files changed, 1 insertion(+), 5642 deletions(-) delete mode 100644 opam/tezos-injector-013-PtJakart.opam delete mode 100644 opam/tezos-injector-014-PtKathma.opam delete mode 100644 src/proto_013_PtJakart/lib_injector/common.ml delete mode 100644 src/proto_013_PtJakart/lib_injector/common.mli delete mode 100644 src/proto_013_PtJakart/lib_injector/disk_persistence.ml delete mode 100644 src/proto_013_PtJakart/lib_injector/disk_persistence.mli delete mode 100644 src/proto_013_PtJakart/lib_injector/dune delete mode 100644 src/proto_013_PtJakart/lib_injector/injector_errors.ml delete mode 100644 src/proto_013_PtJakart/lib_injector/injector_errors.mli delete mode 100644 src/proto_013_PtJakart/lib_injector/injector_events.ml delete mode 100644 src/proto_013_PtJakart/lib_injector/injector_functor.ml delete mode 100644 src/proto_013_PtJakart/lib_injector/injector_functor.mli delete mode 100644 src/proto_013_PtJakart/lib_injector/injector_sigs.ml delete mode 100644 src/proto_013_PtJakart/lib_injector/injector_tags.ml delete mode 100644 src/proto_013_PtJakart/lib_injector/injector_tags.mli delete mode 100644 src/proto_013_PtJakart/lib_injector/injector_worker_types.ml delete mode 100644 src/proto_013_PtJakart/lib_injector/injector_worker_types.mli delete mode 100644 src/proto_013_PtJakart/lib_injector/l1_operation.ml delete mode 100644 src/proto_013_PtJakart/lib_injector/l1_operation.mli delete mode 100644 src/proto_014_PtKathma/lib_injector/common.ml delete mode 100644 src/proto_014_PtKathma/lib_injector/common.mli delete mode 100644 src/proto_014_PtKathma/lib_injector/disk_persistence.ml delete mode 100644 src/proto_014_PtKathma/lib_injector/disk_persistence.mli delete mode 100644 src/proto_014_PtKathma/lib_injector/dune delete mode 100644 src/proto_014_PtKathma/lib_injector/injector_errors.ml delete mode 100644 src/proto_014_PtKathma/lib_injector/injector_errors.mli delete mode 100644 src/proto_014_PtKathma/lib_injector/injector_events.ml delete mode 100644 src/proto_014_PtKathma/lib_injector/injector_functor.ml delete mode 100644 src/proto_014_PtKathma/lib_injector/injector_functor.mli delete mode 100644 src/proto_014_PtKathma/lib_injector/injector_sigs.ml delete mode 100644 src/proto_014_PtKathma/lib_injector/injector_tags.ml delete mode 100644 src/proto_014_PtKathma/lib_injector/injector_tags.mli delete mode 100644 src/proto_014_PtKathma/lib_injector/injector_worker_types.ml delete mode 100644 src/proto_014_PtKathma/lib_injector/injector_worker_types.mli delete mode 100644 src/proto_014_PtKathma/lib_injector/l1_operation.ml delete mode 100644 src/proto_014_PtKathma/lib_injector/l1_operation.mli diff --git a/.gitlab/ci/jobs/packaging/opam_package.yml b/.gitlab/ci/jobs/packaging/opam_package.yml index 1dfc23fcdca3..38b8da1829c2 100644 --- a/.gitlab/ci/jobs/packaging/opam_package.yml +++ b/.gitlab/ci/jobs/packaging/opam_package.yml @@ -840,10 +840,6 @@ opam:tezos-hacl: variables: package: tezos-hacl -# Ignoring unreleased package tezos-injector-013-PtJakart. - -# Ignoring unreleased package tezos-injector-014-PtKathma. - opam:tezos-injector-015-PtLimaPt: extends: - .opam_template diff --git a/dune-project b/dune-project index 04f502b60e3c..8d0c9976320a 100644 --- a/dune-project +++ b/dune-project @@ -116,8 +116,6 @@ (package (name tezos-event-logging-test-helpers)) (package (name tezos-expect-helper)) (package (name tezos-hacl)) -(package (name tezos-injector-013-PtJakart)) -(package (name tezos-injector-014-PtKathma)) (package (name tezos-injector-015-PtLimaPt)) (package (name tezos-injector-016-PtMumbai)) (package (name tezos-injector-alpha)) diff --git a/manifest/main.ml b/manifest/main.ml index 903da2645fed..c67a4804f8ef 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -5052,7 +5052,7 @@ module Protocol = Protocol ~linkall:true in let injector = - only_if N.(number >= 013) @@ fun () -> + only_if (active && N.(number >= 013)) @@ fun () -> public_lib (sf "tezos-injector-%s" name_dash) ~path:(path // "lib_injector") diff --git a/opam/tezos-injector-013-PtJakart.opam b/opam/tezos-injector-013-PtJakart.opam deleted file mode 100644 index b2223f3099a7..000000000000 --- a/opam/tezos-injector-013-PtJakart.opam +++ /dev/null @@ -1,29 +0,0 @@ -# This file was automatically generated, do not edit. -# Edit file manifest/main.ml instead. -opam-version: "2.0" -maintainer: "contact@tezos.com" -authors: ["Tezos devteam"] -homepage: "https://www.tezos.com/" -bug-reports: "https://gitlab.com/tezos/tezos/issues" -dev-repo: "git+https://gitlab.com/tezos/tezos.git" -license: "MIT" -depends: [ - "dune" { >= "3.0" } - "ocaml" { >= "4.14" } - "ppx_expect" - "tezos-base" - "tezos-stdlib-unix" - "tezos-crypto" - "tezos-protocol-013-PtJakart" - "tezos-micheline" - "tezos-client-013-PtJakart" - "tezos-client-base" - "tezos-workers" - "tezos-shell" -] -build: [ - ["rm" "-r" "vendors"] - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -synopsis: "Tezos/Protocol: protocol specific library building injectors" diff --git a/opam/tezos-injector-014-PtKathma.opam b/opam/tezos-injector-014-PtKathma.opam deleted file mode 100644 index 4801dd614ddc..000000000000 --- a/opam/tezos-injector-014-PtKathma.opam +++ /dev/null @@ -1,29 +0,0 @@ -# This file was automatically generated, do not edit. -# Edit file manifest/main.ml instead. -opam-version: "2.0" -maintainer: "contact@tezos.com" -authors: ["Tezos devteam"] -homepage: "https://www.tezos.com/" -bug-reports: "https://gitlab.com/tezos/tezos/issues" -dev-repo: "git+https://gitlab.com/tezos/tezos.git" -license: "MIT" -depends: [ - "dune" { >= "3.0" } - "ocaml" { >= "4.14" } - "ppx_expect" - "tezos-base" - "tezos-stdlib-unix" - "tezos-crypto" - "tezos-protocol-014-PtKathma" - "tezos-micheline" - "tezos-client-014-PtKathma" - "tezos-client-base" - "tezos-workers" - "tezos-shell" -] -build: [ - ["rm" "-r" "vendors"] - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -synopsis: "Tezos/Protocol: protocol specific library building injectors" diff --git a/src/proto_013_PtJakart/lib_injector/common.ml b/src/proto_013_PtJakart/lib_injector/common.ml deleted file mode 100644 index 162a9278ed11..000000000000 --- a/src/proto_013_PtJakart/lib_injector/common.ml +++ /dev/null @@ -1,100 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol_client_context - -type signer = { - alias : string; - pkh : Tezos_crypto.Signature.V0.public_key_hash; - pk : Tezos_crypto.Signature.V0.public_key; - sk : Client_keys_v0.sk_uri; -} - -let get_signer cctxt pkh = - let open Lwt_result_syntax in - let* alias, pk, sk = Client_keys_v0.get_key cctxt pkh in - return {alias; pkh; pk; sk} - -type 'block reorg = {old_chain : 'block list; new_chain : 'block list} - -let no_reorg = {old_chain = []; new_chain = []} - -let reorg_encoding block_encoding = - let open Data_encoding in - conv - (fun {old_chain; new_chain} -> (old_chain, new_chain)) - (fun (old_chain, new_chain) -> {old_chain; new_chain}) - @@ obj2 - (req "old_chain" (list block_encoding)) - (req "new_chain" (list block_encoding)) - -let fetch_tezos_block ~find_in_cache (cctxt : #full) hash : - (Alpha_block_services.block_info, error trace) result Lwt.t = - let fetch hash = - Alpha_block_services.info - cctxt - ~chain:cctxt#chain - ~block:(`Hash (hash, 0)) - ~metadata:`Always - () - in - find_in_cache hash fetch - -(* Compute the reorganization of L1 blocks from the chain whose head is - [old_head_hash] and the chain whose head [new_head_hash]. *) -let tezos_reorg fetch_tezos_block ~old_head_hash ~new_head_hash = - let open Alpha_block_services in - let open Lwt_result_syntax in - let rec loop old_chain new_chain old_head_hash new_head_hash = - if Block_hash.(old_head_hash = new_head_hash) then - return {old_chain = List.rev old_chain; new_chain = List.rev new_chain} - else - let* new_head = fetch_tezos_block new_head_hash in - let* old_head = fetch_tezos_block old_head_hash in - let old_level = old_head.header.shell.level in - let new_level = new_head.header.shell.level in - let diff = Int32.sub new_level old_level in - let old_chain, new_chain, old, new_ = - if diff = 0l then - (* Heads at same level *) - let new_chain = new_head :: new_chain in - let old_chain = old_head :: old_chain in - let new_head_hash = new_head.header.shell.predecessor in - let old_head_hash = old_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - else if diff > 0l then - (* New chain is longer *) - let new_chain = new_head :: new_chain in - let new_head_hash = new_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - else - (* Old chain was longer *) - let old_chain = old_head :: old_chain in - let old_head_hash = old_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - in - loop old_chain new_chain old new_ - in - loop [] [] old_head_hash new_head_hash diff --git a/src/proto_013_PtJakart/lib_injector/common.mli b/src/proto_013_PtJakart/lib_injector/common.mli deleted file mode 100644 index 081dc1e98615..000000000000 --- a/src/proto_013_PtJakart/lib_injector/common.mli +++ /dev/null @@ -1,76 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol_client_context - -(** The type of signers for operations injected by the injector *) -type signer = { - alias : string; - pkh : Tezos_crypto.Signature.V0.public_key_hash; - pk : Tezos_crypto.Signature.V0.public_key; - sk : Client_keys_v0.sk_uri; -} - -(** Type of chain reorganizations. *) -type 'block reorg = { - old_chain : 'block list; - (** The blocks that were in the old chain and which are not in the new one. *) - new_chain : 'block list; - (** The blocks that are now in the new chain. The length of [old_chain] and - [new_chain] may be different. *) -} - -(** Retrieve a signer from the client wallet. *) -val get_signer : - #Client_context.wallet -> - Tezos_crypto.Signature.V0.public_key_hash -> - signer tzresult Lwt.t - -val no_reorg : 'a reorg - -val reorg_encoding : 'a Data_encoding.t -> 'a reorg Data_encoding.t - -type block_info := Alpha_block_services.block_info - -(** [fetch_tezos_block ~find_in_cache cctxt hash] returns a block info given a - block hash. Looks for the block using [find_in_cache] first, and fetches - it from the L1 node otherwise. *) -val fetch_tezos_block : - find_in_cache: - (Block_hash.t -> - (Block_hash.t -> block_info tzresult Lwt.t) -> - block_info tzresult Lwt.t) -> - #full -> - Block_hash.t -> - block_info tzresult Lwt.t - -(** [tezos_reorg fetch ~old_head_hash ~new_head_hash] computes the - reorganization of L1 blocks from the chain whose head is [old_head_hash] and - the chain whose head [new_head_hash]. *) -val tezos_reorg : - (Block_hash.t -> block_info tzresult Lwt.t) -> - old_head_hash:Block_hash.t -> - new_head_hash:Block_hash.t -> - block_info reorg tzresult Lwt.t diff --git a/src/proto_013_PtJakart/lib_injector/disk_persistence.ml b/src/proto_013_PtJakart/lib_injector/disk_persistence.ml deleted file mode 100644 index 9941a6928cdd..000000000000 --- a/src/proto_013_PtJakart/lib_injector/disk_persistence.ml +++ /dev/null @@ -1,393 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -type error += - | Cannot_write_file of string - | Cannot_create_dir of string - | Cannot_delete_file of string - | Cannot_read_file of string - | Io_error of [`Close | `Open] Lwt_utils_unix.io_error - | Unix_error of Unix.error - | Decoding_error of Data_encoding.Binary.read_error - -let () = - register_error_kind - ~id:"rollups.injector.cannot_write_file" - ~title:"Cannot write file" - ~description:"An element for a persistent table could not be written" - ~pp:(fun ppf s -> - Format.fprintf ppf "The persistent element %s could not be written" s) - `Temporary - Data_encoding.(obj1 (req "file" string)) - (function Cannot_write_file s -> Some s | _ -> None) - (fun s -> Cannot_write_file s) ; - register_error_kind - ~id:"rollups.injector.cannot_create_dir" - ~title:"Cannot create directory" - ~description:"Directory for persistent data structure could not be created" - ~pp:(fun ppf s -> - Format.fprintf - ppf - "Directory %s for persistent data structure could not be created" - s) - `Temporary - Data_encoding.(obj1 (req "directory" string)) - (function Cannot_create_dir s -> Some s | _ -> None) - (fun s -> Cannot_create_dir s) ; - register_error_kind - ~id:"rollups.injector.cannot_delete_file" - ~title:"Cannot delete file" - ~description:"An element for a persistent table could not be deleted" - ~pp:(fun ppf s -> - Format.fprintf ppf "The persistent element %s could not be deleted" s) - `Temporary - Data_encoding.(obj1 (req "file" string)) - (function Cannot_delete_file s -> Some s | _ -> None) - (fun s -> Cannot_delete_file s) ; - register_error_kind - ~id:"rollups.injector.cannot_read_file" - ~title:"Cannot read file" - ~description:"A file for a persistent element could not be read" - ~pp:(fun ppf s -> - Format.fprintf ppf "The persistent element %s could not be read" s) - `Temporary - Data_encoding.(obj1 (req "file" string)) - (function Cannot_read_file s -> Some s | _ -> None) - (fun s -> Cannot_read_file s) ; - register_error_kind - ~id:"rollups.injector.io_error" - ~title:"IO error" - ~description:"IO error" - ~pp:(fun ppf (_action, unix_code, caller, arg) -> - Format.fprintf - ppf - "IO error in %s(%s): %s)" - caller - arg - (Unix.error_message unix_code)) - `Temporary - Data_encoding.( - obj4 - (req "action" (string_enum [("close", `Close); ("open", `Open)])) - (req "unix_code" Tezos_stdlib_unix.Unix_error.encoding) - (req "caller" string) - (req "arg" string)) - (function - | Io_error Lwt_utils_unix.{action; unix_code; caller; arg} -> - Some (action, unix_code, caller, arg) - | _ -> None) - (fun (action, unix_code, caller, arg) -> - Io_error Lwt_utils_unix.{action; unix_code; caller; arg}) ; - register_error_kind - ~id:"rollups.injector.unix_error" - ~title:"Unix error" - ~description:"Unix error" - ~pp:(fun ppf error -> - Format.fprintf ppf "Unix error: %s" (Unix.error_message error)) - `Temporary - Data_encoding.(obj1 (req "error" Tezos_stdlib_unix.Unix_error.encoding)) - (function Unix_error e -> Some e | _ -> None) - (fun e -> Unix_error e) ; - register_error_kind - ~id:"rollups.injector.decoding_error" - ~title:"Cannot decode file" - ~description:"A file for a persistent element could not be decoded" - ~pp:(fun ppf error -> - Format.fprintf - ppf - "Decoding error: %a" - Data_encoding.Json.pp - (Data_encoding.Json.construct - Data_encoding.Binary.read_error_encoding - error)) - `Permanent - Data_encoding.(obj1 (req "error" Data_encoding.Binary.read_error_encoding)) - (function Decoding_error e -> Some e | _ -> None) - (fun e -> Decoding_error e) ; - () - -module type H = sig - include Hashtbl.SeededS - - type value - - val name : string - - val string_of_key : key -> string - - val key_of_string : string -> key option - - val value_encoding : value Data_encoding.t -end - -let create_dir dir = - trace (Cannot_create_dir dir) - @@ protect - @@ fun () -> - let open Lwt_result_syntax in - let*! () = Lwt_utils_unix.create_dir dir in - return_unit - -let read_value file encoding = - let open Lwt_syntax in - trace (Cannot_read_file file) - @@ Lwt.catch - (fun () -> - Lwt_io.with_file ~flags:[Unix.O_RDONLY; O_CLOEXEC] ~mode:Input file - @@ fun channel -> - let+ bytes = Lwt_io.read channel in - Result.map_error (fun e -> [Decoding_error e]) - @@ Data_encoding.Binary.of_bytes - encoding - (Bytes.unsafe_of_string bytes)) - (function - | Unix.Unix_error (e, _, _) -> fail (Unix_error e) | e -> fail (Exn e)) - -let maybe_read_value ~warn file encoding = - let open Lwt_syntax in - let* v = read_value file encoding in - match v with - | Error e -> - let+ () = warn file e in - None - | Ok v -> return_some v - -let write_value file encoding value = - trace (Cannot_write_file file) - @@ protect - @@ fun () -> - Lwt_result.map_error (fun e -> [Io_error e]) - @@ Lwt_utils_unix.with_open_out ~overwrite:true file - @@ fun fd -> - let block_bytes = Data_encoding.Binary.to_bytes_exn encoding value in - Lwt_utils_unix.write_bytes fd block_bytes - -let delete_file file = - trace (Cannot_delete_file file) - @@ protect - @@ fun () -> - let open Lwt_result_syntax in - let*! () = Lwt_unix.unlink file in - return_unit - -module Make_table (H : H) = struct - type key = H.key - - type value = H.value - - type t = {path : string; table : value H.t} - - let filedata t k = Filename.concat t.path (H.string_of_key k) - - let create ~data_dir n = - let open Lwt_result_syntax in - let table = H.create n in - let path = Filename.concat data_dir H.name in - let+ () = create_dir path in - {path; table} - - let replace t k v = - H.replace t.table k v ; - write_value (filedata t k) H.value_encoding v - - let remove t k = - H.remove t.table k ; - delete_file (filedata t k) - - let find t k = H.find t.table k - - let mem t k = H.mem t.table k - - let iter_s f t = H.iter_s f t.table - - let iter_es f t = H.iter_es f t.table - - let length t = H.length t.table - - let replace_seq t seq = - H.replace_seq t.table seq ; - Seq.iter_es - (fun (k, v) -> write_value (filedata t k) H.value_encoding v) - seq - - let load_from_disk ~warn_unreadable ~initial_size ~data_dir ~filter = - let open Lwt_result_syntax in - let* t = create ~data_dir initial_size in - let*! d = Lwt_unix.opendir t.path in - let rec browse () = - let*! filename = - let open Lwt_syntax in - Lwt.catch - (fun () -> - let+ f = Lwt_unix.readdir d in - Some f) - (function End_of_file -> return_none | e -> raise e) - in - match filename with - | None -> return_unit - | Some filename -> - let* () = - match H.key_of_string filename with - | None -> return_unit - | Some k -> ( - let+ v = - match warn_unreadable with - | None -> - let+ v = read_value (filedata t k) H.value_encoding in - Some v - | Some warn -> - let*! v = - maybe_read_value ~warn (filedata t k) H.value_encoding - in - return v - in - match v with - | None -> () - | Some v -> if filter v then H.add t.table k v) - in - browse () - in - let+ () = browse () in - t -end - -module Make_queue (N : sig - val name : string -end) -(K : Tezos_crypto.Intfs.HASH) (V : sig - type t - - val encoding : t Data_encoding.t -end) = -struct - module Q = Hash_queue.Make (K) (V) - - type t = {path : string; metadata_path : string; queue : Q.t} - - let counter = ref min_int - - let filedata q k = Filename.concat q.path (K.to_b58check k) - - let filemetadata q k = Filename.concat q.metadata_path (K.to_b58check k) - - let create ~data_dir n = - let open Lwt_result_syntax in - let queue = Q.create n in - let path = Filename.concat data_dir N.name in - let metadata_path = Filename.concat path "metadata" in - let* () = create_dir path in - let+ () = create_dir metadata_path in - {path; metadata_path; queue} - - let remove q k = - let open Lwt_result_syntax in - Q.remove q.queue k ; - let* () = delete_file (filedata q k) - and* () = delete_file (filemetadata q k) in - return_unit - - let create_metadata () = - let time = Time.System.now () in - let d, ps = Ptime.to_span time |> Ptime.Span.to_d_ps in - let c = !counter in - incr counter ; - (d, ps, c) - - let metadata_encoding = - let open Data_encoding in - conv - (fun (d, ps, c) -> (Int64.of_int d, ps, Int64.of_int c)) - (fun (d, ps, c) -> (Int64.to_int d, ps, Int64.to_int c)) - @@ tup3 int64 int64 int64 - - let replace q k v = - let open Lwt_result_syntax in - Q.replace q.queue k v ; - let* () = write_value (filedata q k) V.encoding v - and* () = - write_value (filemetadata q k) metadata_encoding (create_metadata ()) - in - return_unit - - let fold f q = Q.fold f q.queue - - let length q = Q.length q.queue - - let load_from_disk ~warn_unreadable ~capacity ~data_dir ~filter = - let open Lwt_result_syntax in - let* q = create ~data_dir capacity in - let*! d = Lwt_unix.opendir q.path in - let rec browse acc = - let*! filename = - let open Lwt_syntax in - Lwt.catch - (fun () -> - let+ f = Lwt_unix.readdir d in - Some f) - (function End_of_file -> return_none | e -> raise e) - in - match filename with - | None -> return acc - | Some filename -> - let* acc = - match K.of_b58check_opt filename with - | None -> return acc - | Some k -> ( - let+ v_meta = - match warn_unreadable with - | None -> - let* v = read_value (filedata q k) V.encoding - and* meta = - read_value (filemetadata q k) metadata_encoding - in - return_some (v, meta) - | Some warn -> - let open Lwt_syntax in - let* v = maybe_read_value ~warn (filedata q k) V.encoding - and* meta = - maybe_read_value - ~warn - (filemetadata q k) - metadata_encoding - in - return_ok @@ Option.bind v - @@ fun v -> Option.bind meta @@ fun meta -> Some (v, meta) - in - match v_meta with - | None -> acc - | Some (v, meta) -> - if filter v then (k, v, meta) :: acc else acc) - in - browse acc - in - let* list = browse [] in - let list = - List.fast_sort - (fun (_, _, meta1) (_, _, meta2) -> Stdlib.compare meta1 meta2) - list - in - List.iter (fun (k, v, _) -> Q.replace q.queue k v) list ; - return q -end diff --git a/src/proto_013_PtJakart/lib_injector/disk_persistence.mli b/src/proto_013_PtJakart/lib_injector/disk_persistence.mli deleted file mode 100644 index 8314c45538df..000000000000 --- a/src/proto_013_PtJakart/lib_injector/disk_persistence.mli +++ /dev/null @@ -1,145 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -type error += - | Cannot_write_file of string - | Cannot_create_dir of string - | Cannot_read_file of string - | Io_error of [`Close | `Open] Lwt_utils_unix.io_error - | Unix_error of Unix.error - | Decoding_error of Data_encoding.Binary.read_error - -(** Signature for hash tables with additional information *) -module type H = sig - include Hashtbl.SeededS - - (** Type of values *) - type value - - (** Name used to derive a path (relative to [data_dir] in [load_from_disk]) of - where to store the persistent information for this hash table. *) - val name : string - - (** String version of key (used for filenames). *) - val string_of_key : key -> string - - (** Parse a key. We must have [key_of_string (string_of_key k) = k]. *) - val key_of_string : string -> key option - - (** Encoding for values (only the binary encoding is used *) - val value_encoding : value Data_encoding.t -end - -(** Create an on-disk persistent version of {!Hashtbl}. *) -module Make_table (H : H) : sig - type key = H.key - - type value = H.value - - (** Type of persistent hash tables *) - type t - - (** Persistent version of {!module-type-H.replace} *) - val replace : t -> key -> value -> unit tzresult Lwt.t - - (** Persistent version of {!module-type-H.remove} *) - val remove : t -> key -> unit tzresult Lwt.t - - (** Same as {!module-type-H.find} *) - val find : t -> key -> value option - - (** Same as {!module-type-H.mem} *) - val mem : t -> key -> bool - - (** Same as {!module-type-H.iter_s} *) - val iter_s : (key -> value -> unit Lwt.t) -> t -> unit Lwt.t - - (** Same as {!module-type-H.iter_es} *) - val iter_es : - (key -> value -> unit tzresult Lwt.t) -> t -> unit tzresult Lwt.t - - (** Same as {!module-type-H.length} *) - val length : t -> int - - (** Persistent version of {!module-type-H.replace_seq} *) - val replace_seq : t -> (key * value) Seq.t -> unit tzresult Lwt.t - - (** [load_from_disk ~warn_unreadable ~initial_size ~data_dir] creates a hash - table of size [initial_size]. The hash table is populated by persistent - elements present in [data_dir/H.name] which pass the [filter] (the - directory is created if it does not exist). If [warn_unreadable] is [Some - warn], unreadable files are ignored but a warning is printed with [warn], - otherwise the loading fails on the first unreadable file. *) - val load_from_disk : - warn_unreadable:(string -> error trace -> unit Lwt.t) option -> - initial_size:int -> - data_dir:string -> - filter:(value -> bool) -> - t tzresult Lwt.t -end - -(** Create an on-disk persistent version of the {!Hash_queue} data structure. *) -module Make_queue (N : sig - (** Name used to derive a path (relative to [data_dir] in [load_from_disk]) of where - to store the persistent information for this queue. *) - val name : string -end) -(K : Tezos_crypto.Intfs.HASH) (V : sig - type t - - val encoding : t Data_encoding.t -end) : sig - type t - - (** [remove q k] removes the binding from [k] in [q]. If [k] is not bound in - [c], it does nothing. The removal is persisted on disk. *) - val remove : t -> K.t -> unit tzresult Lwt.t - - (** [replace q k v] binds the key [k] to the value [v] in the queue [q]. This - may or may not cause another binding to be removed, depending on the - number of bindings already present in [q]. The addition (or replacement) - is persisted on disk. *) - val replace : t -> K.t -> V.t -> unit tzresult Lwt.t - - (** [fold f q init] folds the function [f] over the bindings - of [q] (in memory). The elements are iterated from oldest to newest. *) - val fold : (K.t -> V.t -> 'a -> 'a) -> t -> 'a -> 'a - - (** [length q] is the number of bindings held by [q]. *) - val length : t -> int - - (** [load_from_disk ~warn_unreadable ~capacity ~data_dir ~filter] creates a - bounded hash queue of capacity [capacity]. The queue is populated by - persistent elements present in [data_dir/N.name] which pass the [filter] - (the directory is created if it does not exist). If [warn_unreadable] is - [Some warn], unreadable files are ignored but a warning is printed with - [warn], otherwise the loading fails on the first unreadable file. *) - val load_from_disk : - warn_unreadable:(string -> error trace -> unit Lwt.t) option -> - capacity:int -> - data_dir:string -> - filter:(V.t -> bool) -> - t tzresult Lwt.t -end diff --git a/src/proto_013_PtJakart/lib_injector/dune b/src/proto_013_PtJakart/lib_injector/dune deleted file mode 100644 index c8b4ce5d483a..000000000000 --- a/src/proto_013_PtJakart/lib_injector/dune +++ /dev/null @@ -1,32 +0,0 @@ -; This file was automatically generated, do not edit. -; Edit file manifest/main.ml instead. - -(library - (name tezos_injector_013_PtJakart) - (public_name tezos-injector-013-PtJakart) - (instrumentation (backend bisect_ppx)) - (libraries - tezos-base - tezos-base.unix - tezos-stdlib-unix - tezos-crypto - tezos-protocol-013-PtJakart - tezos-micheline - tezos-client-013-PtJakart - tezos-client-base - tezos-workers - tezos-shell) - (inline_tests (flags -verbose) (modes native)) - (preprocess (pps ppx_expect)) - (library_flags (:standard -linkall)) - (flags - (:standard) - -open Tezos_base.TzPervasives - -open Tezos_base.TzPervasives.Error_monad.Legacy_monad_globals - -open Tezos_base - -open Tezos_stdlib_unix - -open Tezos_protocol_013_PtJakart - -open Tezos_micheline - -open Tezos_client_013_PtJakart - -open Tezos_client_base - -open Tezos_workers)) diff --git a/src/proto_013_PtJakart/lib_injector/injector_errors.ml b/src/proto_013_PtJakart/lib_injector/injector_errors.ml deleted file mode 100644 index b0e69ff4f6da..000000000000 --- a/src/proto_013_PtJakart/lib_injector/injector_errors.ml +++ /dev/null @@ -1,75 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -type error += - | No_worker_for_source of Tezos_crypto.Signature.V0.Public_key_hash.t - -let () = - register_error_kind - ~id:"rollups.injector.no_worker_for_source" - ~title:"No injecting queue for source" - ~description: - "An L1 operation could not be queued because its source has no worker." - ~pp:(fun ppf s -> - Format.fprintf - ppf - "No worker for source %a" - Tezos_crypto.Signature.V0.Public_key_hash.pp - s) - `Permanent - Data_encoding.( - obj1 (req "source" Tezos_crypto.Signature.V0.Public_key_hash.encoding)) - (function No_worker_for_source s -> Some s | _ -> None) - (fun s -> No_worker_for_source s) - -type error += No_worker_for_tag of string - -let () = - register_error_kind - ~id:"rollups.injector.no_worker_for_tag" - ~title:"No injecting queue for tag" - ~description: - "An L1 operation could not be queued because its tag has no worker." - ~pp:(fun ppf t -> Format.fprintf ppf "No worker for tag %s" t) - `Permanent - Data_encoding.(obj1 (req "tag" Data_encoding.string)) - (function No_worker_for_tag t -> Some t | _ -> None) - (fun t -> No_worker_for_tag t) - -type error += No_worker_for_operation of L1_operation.t - -let () = - register_error_kind - ~id:"rollups.injector.no_worker_for_operation" - ~title:"This operation is not supported by injector" - ~description: - "An L1 operation could not be queued because the injector does not \ - handle it." - ~pp:(fun ppf op -> - Format.fprintf ppf "No worker for operation %a" L1_operation.pp op) - `Permanent - Data_encoding.(obj1 (req "operation" L1_operation.encoding)) - (function No_worker_for_operation op -> Some op | _ -> None) - (fun op -> No_worker_for_operation op) diff --git a/src/proto_013_PtJakart/lib_injector/injector_errors.mli b/src/proto_013_PtJakart/lib_injector/injector_errors.mli deleted file mode 100644 index 4676461a00af..000000000000 --- a/src/proto_013_PtJakart/lib_injector/injector_errors.mli +++ /dev/null @@ -1,36 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Error when the injector has no worker for the source which must inject an - operation. *) -type error += - | No_worker_for_source of Tezos_crypto.Signature.V0.Public_key_hash.t - -(** Error when the injector has no worker for the tag of the operation to be - injected. *) -type error += No_worker_for_tag of string - -(** Error when the injector does not handle the operation. *) -type error += No_worker_for_operation of L1_operation.t diff --git a/src/proto_013_PtJakart/lib_injector/injector_events.ml b/src/proto_013_PtJakart/lib_injector/injector_events.ml deleted file mode 100644 index b22dbdd7d6a5..000000000000 --- a/src/proto_013_PtJakart/lib_injector/injector_events.ml +++ /dev/null @@ -1,232 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Injector_worker_types - -module Make (Rollup : Injector_sigs.PARAMETERS) = struct - module Tags = Injector_tags.Make (Rollup.Tag) - include Internal_event.Simple - - let section = Rollup.events_section - - let declare_1 ~name ~msg ~level ?pp1 enc1 = - declare_3 - ~section - ~name - ~msg:("[{signer}: {tags}] " ^ msg) - ~level - ("signer", Tezos_crypto.Signature.V0.Public_key_hash.encoding) - ("tags", Tags.encoding) - enc1 - ~pp1:Tezos_crypto.Signature.V0.Public_key_hash.pp_short - ~pp2:Tags.pp - ?pp3:pp1 - - let declare_2 ~name ~msg ~level ?pp1 ?pp2 enc1 enc2 = - declare_4 - ~section - ~name - ~msg:("[{signer}: {tags}] " ^ msg) - ~level - ("signer", Tezos_crypto.Signature.V0.Public_key_hash.encoding) - ("tags", Tags.encoding) - enc1 - enc2 - ~pp1:Tezos_crypto.Signature.V0.Public_key_hash.pp_short - ~pp2:Tags.pp - ?pp3:pp1 - ?pp4:pp2 - - let declare_3 ~name ~msg ~level ?pp1 ?pp2 ?pp3 enc1 enc2 enc3 = - declare_5 - ~section - ~name - ~msg:("[{signer}: {tags}] " ^ msg) - ~level - ("signer", Tezos_crypto.Signature.V0.Public_key_hash.encoding) - ("tags", Tags.encoding) - enc1 - enc2 - enc3 - ~pp1:Tezos_crypto.Signature.V0.Public_key_hash.pp_short - ~pp2:Tags.pp - ?pp3:pp1 - ?pp4:pp2 - ?pp5:pp3 - - let request_failed = - declare_3 - ~name:"request_failed" - ~msg:"request {view} failed ({worker_status}): {errors}" - ~level:Warning - ("view", Request.encoding) - ~pp1:Request.pp - ("worker_status", Worker_types.request_status_encoding) - ~pp2:Worker_types.pp_status - ("errors", Error_monad.trace_encoding) - ~pp3:Error_monad.pp_print_trace - - let request_completed_notice = - declare_2 - ~name:"request_completed_notice" - ~msg:"{view} {worker_status}" - ~level:Notice - ("view", Request.encoding) - ("worker_status", Worker_types.request_status_encoding) - ~pp1:Request.pp - ~pp2:Worker_types.pp_status - - let request_completed_debug = - declare_2 - ~name:"request_completed_debug" - ~msg:"{view} {worker_status}" - ~level:Debug - ("view", Request.encoding) - ("worker_status", Worker_types.request_status_encoding) - ~pp1:Request.pp - ~pp2:Worker_types.pp_status - - let new_tezos_head = - declare_1 - ~name:"new_tezos_head" - ~msg:"processing new Tezos head {head}" - ~level:Debug - ("head", Block_hash.encoding) - - let injecting_pending = - declare_1 - ~name:"injecting_pending" - ~msg:"Injecting {count} pending operations" - ~level:Notice - ("count", Data_encoding.int31) - - let pp_operations_list ppf operations = - Format.fprintf - ppf - "@[%a@]" - (Format.pp_print_list L1_operation.pp) - operations - - let pp_operations_hash_list ppf operations = - Format.fprintf - ppf - "@[%a@]" - (Format.pp_print_list L1_operation.Hash.pp) - operations - - let injecting_operations = - declare_1 - ~name:"injecting_operations" - ~msg:"Injecting operations: {operations}" - ~level:Notice - ("operations", Data_encoding.list L1_operation.encoding) - ~pp1:pp_operations_list - - let simulating_operations = - declare_2 - ~name:"simulating_operations" - ~msg:"Simulating operations (force = {force}): {operations}" - ~level:Debug - ("operations", Data_encoding.list L1_operation.encoding) - ("force", Data_encoding.bool) - ~pp1:pp_operations_list - - let dropping_operation = - declare_2 - ~name:"dropping_operation" - ~msg:"Dropping operation {operation} failing with {error}" - ~level:Notice - ("operation", L1_operation.encoding) - ~pp1:L1_operation.pp - ("error", Environment.Error_monad.trace_encoding) - ~pp2:Environment.Error_monad.pp_trace - - let injected = - declare_1 - ~name:"injected" - ~msg:"Injected in {oph}" - ~level:Notice - ("oph", Operation_hash.encoding) - - let add_pending = - declare_1 - ~name:"add_pending" - ~msg:"Add {operation} to pending" - ~level:Notice - ("operation", L1_operation.encoding) - ~pp1:L1_operation.pp - - let included = - declare_3 - ~name:"included" - ~msg:"Included operations of {block} at level {level}: {operations}" - ~level:Notice - ("block", Block_hash.encoding) - ("level", Data_encoding.int32) - ("operations", Data_encoding.list L1_operation.Hash.encoding) - ~pp3:pp_operations_hash_list - - let revert_operations = - declare_1 - ~name:"revert_operations" - ~msg:"Reverting operations: {operations}" - ~level:Notice - ("operations", Data_encoding.list L1_operation.Hash.encoding) - ~pp1:pp_operations_hash_list - - let confirmed_level = - declare_1 - ~name:"confirmed_level" - ~msg:"Confirmed Tezos level {level}" - ~level:Notice - ("level", Data_encoding.int32) - - let confirmed_operations = - declare_2 - ~name:"confirmed_operations" - ~msg:"Confirmed operations of level {level}: {operations}" - ~level:Notice - ("level", Data_encoding.int32) - ("operations", Data_encoding.list L1_operation.Hash.encoding) - ~pp2:pp_operations_hash_list - - let loaded_from_disk = - declare_2 - ~name:"loaded_from_disk" - ~msg:"Loaded {nb} elements in {kind} from disk" - ~level:Notice - ("nb", Data_encoding.int31) - ("kind", Data_encoding.string) - - let corrupted_operation_on_disk = - declare_2 - ~name:"corrupted_operation_on_disk" - ~msg:"Ignoring unreadable file {file} on disk: {error}" - ~level:Warning - ("file", Data_encoding.string) - ("error", Error_monad.trace_encoding) - ~pp1:Format.pp_print_string - ~pp2:Error_monad.pp_print_trace -end diff --git a/src/proto_013_PtJakart/lib_injector/injector_functor.ml b/src/proto_013_PtJakart/lib_injector/injector_functor.ml deleted file mode 100644 index c3200598c92c..000000000000 --- a/src/proto_013_PtJakart/lib_injector/injector_functor.ml +++ /dev/null @@ -1,1036 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol_client_context -open Protocol -open Alpha_context -open Common -open Injector_worker_types -open Injector_sigs -open Injector_errors - -(* This is the Tenderbake finality for blocks. *) -(* TODO: https://gitlab.com/tezos/tezos/-/issues/2815 - Centralize this and maybe make it configurable. *) -let confirmations = 2 - -type injection_strategy = [`Each_block | `Delay_block] - -(* TODO/TORU: https://gitlab.com/tezos/tezos/-/issues/2755 - Persist injector data on disk *) - -(** Builds a client context from another client context but uses logging instead - of printing on stdout directly. This client context cannot make the injector - exit. *) -let injector_context (cctxt : #Protocol_client_context.full) = - let log _channel msg = Logs_lwt.info (fun m -> m "%s" msg) in - object - inherit - Protocol_client_context.wrap_full - (new Client_context.proxy_context (cctxt :> Client_context.full)) - - inherit! Client_context.simple_printer log - - method! exit code = - Format.ksprintf Stdlib.failwith "Injector client wants to exit %d" code - end - -module Make (Rollup : PARAMETERS) = struct - module Tags = Injector_tags.Make (Rollup.Tag) - module Tags_table = Hashtbl.Make (Rollup.Tag) - - module Op_queue = - Disk_persistence.Make_queue - (struct - let name = "operations_queue" - end) - (L1_operation.Hash) - (L1_operation) - - (** Information stored about an L1 operation that was injected on a Tezos - node. *) - type injected_info = { - op : L1_operation.t; (** The L1 manager operation. *) - oph : Operation_hash.t; - (** The hash of the operation which contains [op] (this can be an L1 batch of - several manager operations). *) - } - - module Injected_operations = Disk_persistence.Make_table (struct - include L1_operation.Hash.Table - - type value = injected_info - - let name = "injected_operations" - - let string_of_key = L1_operation.Hash.to_b58check - - let key_of_string = L1_operation.Hash.of_b58check_opt - - let value_encoding = - let open Data_encoding in - conv (fun {op; oph} -> (oph, op)) (fun (oph, op) -> {op; oph}) - @@ merge_objs - (obj1 (req "oph" Operation_hash.encoding)) - L1_operation.encoding - end) - - module Injected_ophs = Disk_persistence.Make_table (struct - include Operation_hash.Table - - type value = L1_operation.Hash.t list - - let name = "injected_ophs" - - let string_of_key = Operation_hash.to_b58check - - let key_of_string = Operation_hash.of_b58check_opt - - let value_encoding = Data_encoding.list L1_operation.Hash.encoding - end) - - (** The part of the state which gathers information about injected - operations (but not included). *) - type injected_state = { - injected_operations : Injected_operations.t; - (** A table mapping L1 manager operation hashes to the injection info for that - operation. *) - injected_ophs : Injected_ophs.t; - (** A mapping of all L1 manager operations contained in a L1 batch (i.e. an L1 - operation). *) - } - - (** Information stored about an L1 operation that was included in a Tezos - block. *) - type included_info = { - op : L1_operation.t; (** The L1 manager operation. *) - oph : Operation_hash.t; - (** The hash of the operation which contains [op] (this can be an L1 batch of - several manager operations). *) - l1_block : Block_hash.t; - (** The hash of the L1 block in which the operation was included. *) - l1_level : int32; (** The level of [l1_block]. *) - } - - module Included_operations = Disk_persistence.Make_table (struct - include L1_operation.Hash.Table - - type value = included_info - - let name = "included_operations" - - let string_of_key = L1_operation.Hash.to_b58check - - let key_of_string = L1_operation.Hash.of_b58check_opt - - let value_encoding = - let open Data_encoding in - conv - (fun {op; oph; l1_block; l1_level} -> (op, (oph, l1_block, l1_level))) - (fun (op, (oph, l1_block, l1_level)) -> {op; oph; l1_block; l1_level}) - @@ merge_objs - L1_operation.encoding - (obj3 - (req "oph" Operation_hash.encoding) - (req "l1_block" Block_hash.encoding) - (req "l1_level" int32)) - end) - - module Included_in_blocks = Disk_persistence.Make_table (struct - include Block_hash.Table - - type value = int32 * L1_operation.Hash.t list - - let name = "included_in_blocks" - - let string_of_key = Block_hash.to_b58check - - let key_of_string = Block_hash.of_b58check_opt - - let value_encoding = - let open Data_encoding in - obj2 (req "level" int32) (req "l1_ops" (list L1_operation.Hash.encoding)) - end) - - (** The part of the state which gathers information about - operations which are included in the L1 chain (but not confirmed). *) - type included_state = { - included_operations : Included_operations.t; - included_in_blocks : Included_in_blocks.t; - } - - (** The internal state of each injector worker. *) - type state = { - cctxt : Protocol_client_context.full; - (** The client context which is used to perform the injections. *) - signer : signer; (** The signer for this worker. *) - tags : Tags.t; - (** The tags of this worker, for both informative and identification - purposes. *) - strategy : injection_strategy; - (** The strategy of this worker for injecting the pending operations. *) - save_dir : string; (** Path to where save persistent state *) - queue : Op_queue.t; - (** The queue of pending operations for this injector. *) - injected : injected_state; - (** The information about injected operations. *) - included : included_state; - (** The information about included operations. {b Note}: Operations which - are confirmed are simply removed from the state and do not appear - anymore. *) - rollup_node_state : Rollup.rollup_node_state; - (** The state of the rollup node. *) - } - - module Event = struct - include Injector_events.Make (Rollup) - - let emit1 e state x = emit e (state.signer.pkh, state.tags, x) - - let emit2 e state x y = emit e (state.signer.pkh, state.tags, x, y) - - let emit3 e state x y z = emit e (state.signer.pkh, state.tags, x, y, z) - end - - let init_injector cctxt ~data_dir rollup_node_state ~signer strategy tags = - let open Lwt_result_syntax in - let* signer = get_signer cctxt signer in - let data_dir = Filename.concat data_dir "injector" in - let*! () = Lwt_utils_unix.create_dir data_dir in - let filter op_proj op = - let {L1_operation.manager_operation = Manager op; _} = op_proj op in - match Rollup.operation_tag op with - | None -> false - | Some t -> Tags.mem t tags - in - let warn_unreadable = - (* Warn of corrupted files but don't fail *) - Some - (fun file error -> - Event.(emit corrupted_operation_on_disk) - (signer.pkh, tags, file, error)) - in - let emit_event_loaded kind nb = - Event.(emit loaded_from_disk) (signer.pkh, tags, nb, kind) - in - let* queue = - Op_queue.load_from_disk - ~warn_unreadable - ~capacity:50_000 - ~data_dir - ~filter:(filter (fun op -> op)) - in - let*! () = emit_event_loaded "operations_queue" @@ Op_queue.length queue in - (* Very coarse approximation for the number of operation we expect for each - block *) - let n = - Tags.fold (fun t acc -> acc + Rollup.table_estimated_size t) tags 0 - in - let* injected_operations = - Injected_operations.load_from_disk - ~warn_unreadable - ~initial_size:n - ~data_dir - ~filter:(filter (fun (i : injected_info) -> i.op)) - in - let*! () = - emit_event_loaded "injected_operations" - @@ Injected_operations.length injected_operations - in - - let* included_operations = - Included_operations.load_from_disk - ~warn_unreadable - ~initial_size:(confirmations * n) - ~data_dir - ~filter:(filter (fun (i : included_info) -> i.op)) - in - let*! () = - emit_event_loaded "included_operations" - @@ Included_operations.length included_operations - in - let* injected_ophs = - Injected_ophs.load_from_disk - ~warn_unreadable - ~initial_size:n - ~data_dir - ~filter:(List.exists (Injected_operations.mem injected_operations)) - in - let*! () = - emit_event_loaded "injected_ophs" @@ Injected_ophs.length injected_ophs - in - let* included_in_blocks = - Included_in_blocks.load_from_disk - ~warn_unreadable - ~initial_size:(confirmations * n) - ~data_dir - ~filter:(fun (_, ops) -> - List.exists (Included_operations.mem included_operations) ops) - in - let*! () = - emit_event_loaded "included_in_blocks" - @@ Included_in_blocks.length included_in_blocks - in - - return - { - cctxt = injector_context (cctxt :> #Protocol_client_context.full); - signer; - tags; - strategy; - save_dir = data_dir; - queue; - injected = {injected_operations; injected_ophs}; - included = {included_operations; included_in_blocks}; - rollup_node_state; - } - - (** Add an operation to the pending queue corresponding to the signer for this - operation. *) - let add_pending_operation state op = - let open Lwt_result_syntax in - let*! () = Event.(emit1 add_pending) state op in - Op_queue.replace state.queue op.L1_operation.hash op - - (** Mark operations as injected (in [oph]). *) - let add_injected_operations state oph operations = - let open Lwt_result_syntax in - let infos = - List.map (fun op -> (op.L1_operation.hash, {op; oph})) operations - in - let* () = - Injected_operations.replace_seq - state.injected.injected_operations - (List.to_seq infos) - in - Injected_ophs.replace state.injected.injected_ophs oph (List.map fst infos) - - (** [add_included_operations state oph l1_block l1_level operations] marks the - [operations] as included (in the L1 batch [oph]) in the Tezos block - [l1_block] of level [l1_level]. *) - let add_included_operations state oph l1_block l1_level operations = - let open Lwt_result_syntax in - let*! () = - Event.(emit3 included) - state - l1_block - l1_level - (List.map (fun o -> o.L1_operation.hash) operations) - in - let infos = - List.map - (fun op -> (op.L1_operation.hash, {op; oph; l1_block; l1_level})) - operations - in - let* () = - Included_operations.replace_seq - state.included.included_operations - (List.to_seq infos) - in - Included_in_blocks.replace - state.included.included_in_blocks - l1_block - (l1_level, List.map fst infos) - - (** [remove state oph] removes the operations that correspond to the L1 batch - [oph] from the injected operations in the injector state. This function is - used to move operations from injected to included. *) - let remove_injected_operation state oph = - let open Lwt_result_syntax in - match Injected_ophs.find state.injected.injected_ophs oph with - | None -> - (* Nothing removed *) - return [] - | Some mophs -> - let* () = Injected_ophs.remove state.injected.injected_ophs oph in - List.fold_left_es - (fun removed moph -> - match - Injected_operations.find state.injected.injected_operations moph - with - | None -> return removed - | Some info -> - let+ () = - Injected_operations.remove - state.injected.injected_operations - moph - in - info :: removed) - [] - mophs - - (** [remove state block] removes the included operations that correspond to all - the L1 batches included in [block]. This function is used when [block] is on - an alternative chain in the case of a reorganization. *) - let remove_included_operation state block = - let open Lwt_result_syntax in - match Included_in_blocks.find state.included.included_in_blocks block with - | None -> - (* Nothing removed *) - return [] - | Some (_level, mophs) -> - let* () = - Included_in_blocks.remove state.included.included_in_blocks block - in - List.fold_left_es - (fun removed moph -> - match - Included_operations.find state.included.included_operations moph - with - | None -> return removed - | Some info -> - let+ () = - Included_operations.remove - state.included.included_operations - moph - in - info :: removed) - [] - mophs - - let fee_parameter_of_operations state ops = - List.fold_left - (fun acc {L1_operation.manager_operation = Manager op; _} -> - let param = Rollup.fee_parameter state op in - Injection. - { - minimal_fees = Tez.max acc.minimal_fees param.minimal_fees; - minimal_nanotez_per_byte = - Q.max acc.minimal_nanotez_per_byte param.minimal_nanotez_per_byte; - minimal_nanotez_per_gas_unit = - Q.max - acc.minimal_nanotez_per_gas_unit - param.minimal_nanotez_per_gas_unit; - force_low_fee = acc.force_low_fee || param.force_low_fee; - fee_cap = - WithExceptions.Result.get_ok - ~loc:__LOC__ - Tez.(acc.fee_cap +? param.fee_cap); - burn_cap = - WithExceptions.Result.get_ok - ~loc:__LOC__ - Tez.(acc.burn_cap +? param.burn_cap); - }) - Injection. - { - minimal_fees = Tez.zero; - minimal_nanotez_per_byte = Q.zero; - minimal_nanotez_per_gas_unit = Q.zero; - force_low_fee = false; - fee_cap = Tez.zero; - burn_cap = Tez.zero; - } - ops - - (** Simulate the injection of [operations]. See {!inject_operations} for the - specification of [must_succeed]. *) - let simulate_operations ~must_succeed state (operations : L1_operation.t list) - = - let open Lwt_result_syntax in - let open Annotated_manager_operation in - let force = - match operations with - | [] -> assert false - | [_] -> - (* If there is only one operation, fail when simulation fails *) - false - | _ -> ( - (* We want to see which operation failed in the batch if not all must - succeed *) - match must_succeed with `All -> false | `At_least_one -> true) - in - let*! () = Event.(emit2 simulating_operations) state operations force in - let fee_parameter = - fee_parameter_of_operations state.rollup_node_state operations - in - let operations = - List.map - (fun {L1_operation.manager_operation = Manager operation; _} -> - Annotated_manager_operation - (Injection.prepare_manager_operation - ~fee:Limit.unknown - ~gas_limit:Limit.unknown - ~storage_limit:Limit.unknown - operation)) - operations - in - let (Manager_list annot_op) = - Annotated_manager_operation.manager_of_list operations - in - let* _, op, _, result = - Injection.inject_manager_operation - state.cctxt - ~simulation:true (* Only simulation here *) - ~force - ~chain:state.cctxt#chain - ~block:(`Head 0) - ~source:state.signer.pkh - ~src_pk:state.signer.pk - ~src_sk:state.signer.sk - ~successor_level:true - (* Needed to simulate tx_rollup operations in the next block *) - ~fee:Limit.unknown - ~gas_limit:Limit.unknown - ~storage_limit:Limit.unknown - ~fee_parameter - annot_op - in - return (op, Apply_results.Contents_result_list result) - - let inject_on_node state {shell; protocol_data = Operation_data {contents; _}} - = - let open Lwt_result_syntax in - let unsigned_op = (shell, Contents_list contents) in - let unsigned_op_bytes = - Data_encoding.Binary.to_bytes_exn Operation.unsigned_encoding unsigned_op - in - let* signature = - Client_keys_v0.sign - state.cctxt - ~watermark:Tezos_crypto.Signature.V0.Generic_operation - state.signer.sk - unsigned_op_bytes - in - let op : _ Operation.t = - {shell; protocol_data = {contents; signature = Some signature}} - in - let op_bytes = - Data_encoding.Binary.to_bytes_exn Operation.encoding (Operation.pack op) - in - Tezos_shell_services.Shell_services.Injection.operation - state.cctxt - ~chain:state.cctxt#chain - op_bytes - >>=? fun oph -> - let*! () = Event.(emit1 injected) state oph in - return oph - - (** Inject the given [operations] in an L1 batch. If [must_succeed] is [`All] - then all the operations must succeed in the simulation of injection. If - [must_succeed] is [`At_least_one] at least one operation in the list - [operations] must be successful in the simulation. In any case, only - operations which are known as successful will be included in the injected L1 - batch. {b Note}: [must_succeed = `At_least_one] allows to incrementally build - "or-batches" by iteratively removing operations that fail from the desired - batch. *) - let rec inject_operations ~must_succeed state - (operations : L1_operation.t list) = - let open Lwt_result_syntax in - let* packed_op, result = - simulate_operations ~must_succeed state operations - in - let results = Apply_results.to_list result in - let failure = ref false in - let* rev_non_failing_operations = - List.fold_left2_s - ~when_different_lengths: - [ - Exn - (Failure - "Unexpected error: length of operations and result differ in \ - simulation"); - ] - (fun acc op (Apply_results.Contents_result result) -> - match result with - | Apply_results.Manager_operation_result - { - operation_result = - Failed (_, error) | Backtracked (_, Some error); - _; - } -> - let*! () = Event.(emit2 dropping_operation) state op error in - failure := true ; - Lwt.return acc - | Apply_results.Manager_operation_result - { - operation_result = Applied _ | Backtracked (_, None) | Skipped _; - _; - } -> - (* Not known to be failing *) - Lwt.return (op :: acc) - | _ -> - (* Only manager operations *) - assert false) - [] - operations - results - in - if !failure then - (* Invariant: must_succeed = `At_least_one, otherwise the simulation would have - returned an error. We try to inject without the failing operation. *) - let operations = List.rev rev_non_failing_operations in - inject_operations ~must_succeed state operations - else - (* Inject on node for real *) - let+ oph = inject_on_node state packed_op in - (oph, operations) - - (** Returns the (upper bound on) the size of an L1 batch of operations composed - of the manager operations [rev_ops]. *) - let size_l1_batch state rev_ops = - let contents_list = - List.map - (fun (op : L1_operation.t) -> - let (Manager operation) = op.manager_operation in - let {fee; counter; gas_limit; storage_limit} = - Rollup.approximate_fee_bound state.rollup_node_state operation - in - let contents = - Manager_operation - { - source = state.signer.pkh; - operation; - fee; - counter; - gas_limit; - storage_limit; - } - in - Contents contents) - rev_ops - in - let (Contents_list contents) = - match Operation.of_list contents_list with - | Error _ -> - (* Cannot happen: rev_ops is non empty and contains only manager - operations *) - assert false - | Ok packed_contents_list -> packed_contents_list - in - let signature = Tezos_crypto.Signature.V0.zero in - let branch = Block_hash.zero in - let operation = - { - shell = {branch}; - protocol_data = Operation_data {contents; signature = Some signature}; - } - in - Data_encoding.Binary.length Operation.encoding operation - - (** Retrieve as many operations from the queue while remaining below the size - limit. *) - let get_operations_from_queue ~size_limit state = - let exception Reached_limit of L1_operation.t list in - let rev_ops = - try - Op_queue.fold - (fun _oph op ops -> - let new_ops = op :: ops in - let new_size = size_l1_batch state new_ops in - if new_size > size_limit then raise (Reached_limit ops) ; - new_ops) - state.queue - [] - with Reached_limit ops -> ops - in - List.rev rev_ops - - (* Ignore the failures of finalize and remove commitment operations. These - operations fail when there are either no commitment to finalize or to remove - (which can happen when there are no inbox for instance). *) - let ignore_ignorable_failing_operations operations = function - | Ok res -> Ok (`Injected res) - | Error _ as res -> - let open Result_syntax in - let+ operations_to_drop = - List.fold_left_e - (fun to_drop op -> - let (Manager operation) = op.L1_operation.manager_operation in - match Rollup.ignore_failing_operation operation with - | `Don't_ignore -> res - | `Ignore_keep -> Ok to_drop - | `Ignore_drop -> Ok (op :: to_drop)) - [] - operations - in - `Ignored operations_to_drop - - (** [inject_pending_operations_for ~size_limit state pending] injects - operations from the pending queue [pending], whose total size does - not exceed [size_limit]. Upon successful injection, the - operations are removed from the queue and marked as injected. *) - let inject_pending_operations - ?(size_limit = Constants.max_operation_data_length) state = - let open Lwt_result_syntax in - (* Retrieve and remove operations from pending *) - let operations_to_inject = get_operations_from_queue ~size_limit state in - match operations_to_inject with - | [] -> return_unit - | _ -> ( - let*! () = - Event.(emit1 injecting_pending) - state - (List.length operations_to_inject) - in - let must_succeed = - Rollup.batch_must_succeed - @@ List.map - (fun op -> op.L1_operation.manager_operation) - operations_to_inject - in - let*! res = - inject_operations ~must_succeed state operations_to_inject - in - let*? res = - ignore_ignorable_failing_operations operations_to_inject res - in - match res with - | `Injected (oph, injected_operations) -> - (* Injection succeeded, remove from pending and add to injected *) - let* () = - List.iter_es - (fun op -> Op_queue.remove state.queue op.L1_operation.hash) - injected_operations - in - add_injected_operations state oph operations_to_inject - | `Ignored operations_to_drop -> - (* Injection failed but we ignore the failure. *) - let* () = - List.iter_es - (fun op -> Op_queue.remove state.queue op.L1_operation.hash) - operations_to_drop - in - return_unit) - - (** [register_included_operation state block level oph] marks the manager - operations contained in the L1 batch [oph] as being included in the [block] - of level [level], by moving them from the "injected" state to the "included" - state. *) - let register_included_operation state block level oph = - let open Lwt_result_syntax in - let* rmed = remove_injected_operation state oph in - match rmed with - | [] -> return_unit - | injected_infos -> - let included_mops = - List.map (fun (i : injected_info) -> i.op) injected_infos - in - add_included_operations state oph block level included_mops - - (** [register_included_operations state block level oph] marks the known (by - this injector) manager operations contained in [block] as being included. *) - let register_included_operations state - (block : Alpha_block_services.block_info) = - List.iter_es - (List.iter_es (fun (op : Alpha_block_services.operation) -> - register_included_operation - state - block.hash - block.header.shell.level - op.hash - (* TODO/TORU: Handle operations for rollup_id here with - callback *))) - block.Alpha_block_services.operations - - (** [revert_included_operations state block] marks the known (by this injector) - manager operations contained in [block] as not being included any more, - typically in the case of a reorganization where [block] is on an alternative - chain. The operations are put back in the pending queue. *) - let revert_included_operations state block = - let open Lwt_result_syntax in - let* included_infos = remove_included_operation state block in - let*! () = - Event.(emit1 revert_operations) - state - (List.map (fun o -> o.op.hash) included_infos) - in - (* TODO/TORU: https://gitlab.com/tezos/tezos/-/issues/2814 - maybe put at the front of the queue for re-injection. *) - List.iter_es - (fun {op; _} -> - let {L1_operation.manager_operation = Manager mop; _} = op in - let*! requeue = - Rollup.requeue_reverted_operation state.rollup_node_state mop - in - if requeue then add_pending_operation state op else return_unit) - included_infos - - (** [register_confirmed_level state confirmed_level] is called when the level - [confirmed_level] is known as confirmed. In this case, the operations of - block which are below this level are also considered as confirmed and are - removed from the "included" state. These operations cannot be part of a - reorganization so there will be no need to re-inject them anymore. *) - let register_confirmed_level state confirmed_level = - let open Lwt_result_syntax in - let*! () = - Event.(emit confirmed_level) - (state.signer.pkh, state.tags, confirmed_level) - in - Included_in_blocks.iter_es - (fun block (level, _operations) -> - if level <= confirmed_level then - let* confirmed_ops = remove_included_operation state block in - let*! () = - Event.(emit2 confirmed_operations) - state - level - (List.map (fun o -> o.op.hash) confirmed_ops) - in - return_unit - else return_unit) - state.included.included_in_blocks - - (** [on_new_tezos_head state head reorg] is called when there is a new Tezos - head (with a potential reorganization [reorg]). It first reverts any blocks - that are in the alternative branch of the reorganization and then registers - the effect of the new branch (the newly included operation and confirmed - operations). *) - let on_new_tezos_head state (head : Alpha_block_services.block_info) - (reorg : Alpha_block_services.block_info reorg) = - let open Lwt_result_syntax in - let*! () = Event.(emit1 new_tezos_head) state head.hash in - let* () = - List.iter_es - (fun removed_block -> - revert_included_operations - state - removed_block.Alpha_block_services.hash) - (List.rev reorg.old_chain) - in - let* () = - List.iter_es - (fun added_block -> register_included_operations state added_block) - reorg.new_chain - in - (* Head is already included in the reorganization, so no need to process it - separately. *) - let confirmed_level = - Int32.sub - head.Alpha_block_services.header.shell.level - (Int32.of_int confirmations) - in - if confirmed_level >= 0l then register_confirmed_level state confirmed_level - else return_unit - - (* The request {Request.Inject} triggers an injection of the operations - the pending queue. *) - let on_inject state = inject_pending_operations state - - module Types = struct - type nonrec state = state - - type parameters = { - cctxt : Protocol_client_context.full; - data_dir : string; - rollup_node_state : Rollup.rollup_node_state; - strategy : injection_strategy; - tags : Tags.t; - } - end - - (* The worker for the injector. *) - module Worker = Worker.MakeSingle (Name) (Request) (Types) - - (* The queue for the requests to the injector worker is infinite. *) - type worker = Worker.infinite Worker.queue Worker.t - - let table = Worker.create_table Queue - - let tags_table = Tags_table.create 7 - - module Handlers = struct - type self = worker - - let on_request : - type r request_error. - worker -> - (r, request_error) Request.t -> - (r, request_error) result Lwt.t = - fun w request -> - let state = Worker.state w in - match request with - | Request.Add_pending op -> - (* The execution of the request handler is protected to avoid stopping the - worker in case of an exception. *) - protect @@ fun () -> add_pending_operation state op - | Request.New_tezos_head (head, reorg) -> - protect @@ fun () -> on_new_tezos_head state head reorg - | Request.Inject -> protect @@ fun () -> on_inject state - - type launch_error = error trace - - let on_launch _w signer - Types.{cctxt; data_dir; rollup_node_state; strategy; tags} = - init_injector cctxt ~data_dir rollup_node_state ~signer strategy tags - - let on_error (type a b) w st (r : (a, b) Request.t) (errs : b) : - unit tzresult Lwt.t = - let open Lwt_result_syntax in - let state = Worker.state w in - let request_view = Request.view r in - let emit_and_return_errors errs = - (* Errors do not stop the worker but emit an entry in the log. *) - let*! () = Event.(emit3 request_failed) state request_view st errs in - return_unit - in - match r with - | Request.Add_pending _ -> emit_and_return_errors errs - | Request.New_tezos_head _ -> emit_and_return_errors errs - | Request.Inject -> emit_and_return_errors errs - - let on_completion w r _ st = - let state = Worker.state w in - match Request.view r with - | Request.View (Add_pending _ | New_tezos_head _) -> - Event.(emit2 request_completed_debug) state (Request.view r) st - | View Inject -> - Event.(emit2 request_completed_notice) state (Request.view r) st - - let on_no_request _ = Lwt.return_unit - - let on_close w = - let state = Worker.state w in - Tags.iter (Tags_table.remove tags_table) state.tags ; - Lwt.return_unit - end - - (* TODO/TORU: https://gitlab.com/tezos/tezos/-/issues/2754 - Injector worker in a separate process *) - let init (cctxt : #Protocol_client_context.full) ~data_dir rollup_node_state - ~signers = - let open Lwt_result_syntax in - let signers_map = - List.fold_left - (fun acc (signer, strategy, tags) -> - let tags = Tags.of_list tags in - let strategy, tags = - match - Tezos_crypto.Signature.V0.Public_key_hash.Map.find_opt signer acc - with - | None -> (strategy, tags) - | Some (other_strategy, other_tags) -> - let strategy = - match (strategy, other_strategy) with - | `Each_block, `Each_block -> `Each_block - | `Delay_block, _ | _, `Delay_block -> - (* Delay_block strategy takes over because we can always wait a - little bit more to inject operation which are to be injected - "each block". *) - `Delay_block - in - (strategy, Tags.union other_tags tags) - in - Tezos_crypto.Signature.V0.Public_key_hash.Map.add - signer - (strategy, tags) - acc) - Tezos_crypto.Signature.V0.Public_key_hash.Map.empty - signers - in - Tezos_crypto.Signature.V0.Public_key_hash.Map.iter_es - (fun signer (strategy, tags) -> - let+ worker = - Worker.launch - table - signer - { - cctxt = (cctxt :> Protocol_client_context.full); - data_dir; - rollup_node_state; - strategy; - tags; - } - (module Handlers) - in - ignore worker) - signers_map - - let worker_of_signer signer_pkh = - match Worker.find_opt table signer_pkh with - | None -> - (* TODO: https://gitlab.com/tezos/tezos/-/issues/2818 - maybe lazily start worker here *) - error (No_worker_for_source signer_pkh) - | Some worker -> ok worker - - let worker_of_tag tag = - match Tags_table.find_opt tags_table tag with - | None -> - Format.kasprintf - (fun s -> error (No_worker_for_tag s)) - "%a" - Rollup.Tag.pp - tag - | Some worker -> ok worker - - let add_pending_operation ?source op = - let open Lwt_result_syntax in - let l1_operation = L1_operation.make op in - let*? w = - match source with - | Some source -> worker_of_signer source - | None -> ( - match Rollup.operation_tag op with - | None -> error (No_worker_for_operation l1_operation) - | Some tag -> worker_of_tag tag) - in - let*! (_pushed : bool) = - Worker.Queue.push_request w (Request.Add_pending l1_operation) - in - return_unit - - let new_tezos_head h reorg = - let open Lwt_syntax in - let workers = Worker.list table in - List.iter_p - (fun (_signer, w) -> - let* (_pushed : bool) = - Worker.Queue.push_request w (Request.New_tezos_head (h, reorg)) - in - return_unit) - workers - - let has_tag_in ~tags state = - match tags with - | None -> - (* Not filtering on tags *) - true - | Some tags -> not (Tags.disjoint state.tags tags) - - let has_strategy ~strategy state = - match strategy with - | None -> - (* Not filtering on strategy *) - true - | Some strategy -> state.strategy = strategy - - let inject ?tags ?strategy () = - let workers = Worker.list table in - let tags = Option.map Tags.of_list tags in - List.iter_p - (fun (_signer, w) -> - let open Lwt_syntax in - let worker_state = Worker.state w in - if has_tag_in ~tags worker_state && has_strategy ~strategy worker_state - then - let* _pushed = Worker.Queue.push_request w Request.Inject in - return_unit - else Lwt.return_unit) - workers - - let shutdown () = - let workers = Worker.list table in - List.iter_p (fun (_signer, w) -> Worker.shutdown w) workers -end diff --git a/src/proto_013_PtJakart/lib_injector/injector_functor.mli b/src/proto_013_PtJakart/lib_injector/injector_functor.mli deleted file mode 100644 index 183066b02a9a..000000000000 --- a/src/proto_013_PtJakart/lib_injector/injector_functor.mli +++ /dev/null @@ -1,29 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Injector_sigs - -module Make (P : PARAMETERS) : - S with type rollup_node_state := P.rollup_node_state and type tag := P.Tag.t diff --git a/src/proto_013_PtJakart/lib_injector/injector_sigs.ml b/src/proto_013_PtJakart/lib_injector/injector_sigs.ml deleted file mode 100644 index aad4ac33530e..000000000000 --- a/src/proto_013_PtJakart/lib_injector/injector_sigs.ml +++ /dev/null @@ -1,158 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol.Alpha_context - -(** Type to represent {e appoximate upper-bounds} for the fee and limits, used - to compute an upper bound on the size (in bytes) of an operation. *) -type approximate_fee_bound = { - fee : Tez.t; - counter : Z.t; - gas_limit : Gas.Arith.integral; - storage_limit : Z.t; -} - -type injection_strategy = - [ `Each_block (** Inject pending operations after each new L1 block *) - | `Delay_block - (** Wait for some time after the L1 block is produced to inject pending - operations. This strategy allows for maximizing the number of the same - kind of operations to include in a block. *) - ] - -(** Signature for tags used in injector *) -module type TAG = sig - include Stdlib.Set.OrderedType - - include Stdlib.Hashtbl.HashedType with type t := t - - val pp : Format.formatter -> t -> unit - - val encoding : t Data_encoding.t -end - -(** Module type for parameter of functor {!Injector_functor.Make}. *) -module type PARAMETERS = sig - (** The type of the state for the rollup node that the injector can access *) - type rollup_node_state - - (** A module which contains the different tags for the injector *) - module Tag : TAG - - (** Where to put the events for this injector *) - val events_section : string list - - (** Coarse approximation for the number of operation of each tag we expect to - inject for each block. *) - val table_estimated_size : Tag.t -> int - - (** [requeue_reverted_operation state op] should return [true] if an included - operation should be re-queued for injection when the block in which it is - included is reverted (due to a reorganization). *) - val requeue_reverted_operation : - rollup_node_state -> 'a manager_operation -> bool Lwt.t - - (** [ignore_failing_operation op] specifies if the injector should - ignore this operation when its simulation fails when trying to inject. - Returns: - - [`Ignore_keep] if the operation should be ignored but kept in the - pending queue, - - [`Ignore_drop] if the operation should be ignored and dropped from the - pending queue, - - [`Don't_ignore] if the failing operation should not be ignored and the - failure reported. - *) - val ignore_failing_operation : - 'a manager_operation -> [`Ignore_keep | `Ignore_drop | `Don't_ignore] - - (** The tag of a manager operation. This is used to send operations to the - correct queue automatically (when signer is not provided) and to recover - persistent information. *) - val operation_tag : 'a manager_operation -> Tag.t option - - (** Returns the {e appoximate upper-bounds} for the fee and limits of an - operation, used to compute an upper bound on the size (in bytes) for this - operation. *) - val approximate_fee_bound : - rollup_node_state -> 'a manager_operation -> approximate_fee_bound - - (** Returns the fee_parameter (to compute fee w.r.t. gas, size, etc.) and the - caps of fee and burn for each operation. *) - val fee_parameter : - rollup_node_state -> 'a manager_operation -> Injection.fee_parameter - - (** When injecting the given [operations] in an L1 batch, if - [batch_must_succeed operations] returns [`All] then all the operations must - succeed in the simulation of injection. If it returns [`At_least_one], at - least one operation in the list [operations] must be successful in the - simulation. In any case, only operations which are known as successful will - be included in the injected L1 batch. {b Note}: Returning [`At_least_one] - allows to incrementally build "or-batches" by iteratively removing - operations that fail from the desired batch. *) - val batch_must_succeed : - packed_manager_operation list -> [`All | `At_least_one] -end - -(** Output signature for functor {!Injector_functor.Make}. *) -module type S = sig - type rollup_node_state - - type tag - - (** Initializes the injector with the rollup node state, for a list of - signers, and start the workers. Each signer has its own worker with a - queue of operations to inject. *) - val init : - #Protocol_client_context.full -> - data_dir:string -> - rollup_node_state -> - signers:(public_key_hash * injection_strategy * tag list) list -> - unit tzresult Lwt.t - - (** Add an operation as pending injection in the injector. If the source is - not provided, the operation is queued to the worker which handles the - corresponding tag. *) - val add_pending_operation : - ?source:public_key_hash -> 'a manager_operation -> unit tzresult Lwt.t - - (** Notify the injector of a new Tezos head. The injector marks the operations - appropriately (for instance reverted operations that are part of a - reorganization are put back in the pending queue). When an operation is - considered as {e confirmed}, it disappears from the injector. *) - val new_tezos_head : - Protocol_client_context.Alpha_block_services.block_info -> - Protocol_client_context.Alpha_block_services.block_info Common.reorg -> - unit Lwt.t - - (** Trigger an injection of the pending operations for all workers. If [tags] - is given, only the workers which have a tag in [tags] inject their pending - operations. If [strategy] is given, only workers which have this strategy - inject their pending operations. *) - val inject : - ?tags:tag list -> ?strategy:injection_strategy -> unit -> unit Lwt.t - - (** Shutdown the injectors, waiting for the ongoing request to be processed. *) - val shutdown : unit -> unit Lwt.t -end diff --git a/src/proto_013_PtJakart/lib_injector/injector_tags.ml b/src/proto_013_PtJakart/lib_injector/injector_tags.ml deleted file mode 100644 index 1e92ff5de2cb..000000000000 --- a/src/proto_013_PtJakart/lib_injector/injector_tags.ml +++ /dev/null @@ -1,39 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -module Make (Tag : Injector_sigs.TAG) = struct - include Set.Make (Tag) - - let pp ppf tags = - Format.pp_print_list - ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ") - Tag.pp - ppf - (elements tags) - - let encoding = - let open Data_encoding in - conv elements of_list (list Tag.encoding) -end diff --git a/src/proto_013_PtJakart/lib_injector/injector_tags.mli b/src/proto_013_PtJakart/lib_injector/injector_tags.mli deleted file mode 100644 index 9efa6842376a..000000000000 --- a/src/proto_013_PtJakart/lib_injector/injector_tags.mli +++ /dev/null @@ -1,35 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Make a set of tags given a module for tags. *) -module Make (Tag : Injector_sigs.TAG) : sig - include Set.S with type elt = Tag.t - - (** Pretty print a set of tags *) - val pp : Format.formatter -> t -> unit - - (** Encoding for sets of tags *) - val encoding : t Data_encoding.t -end diff --git a/src/proto_013_PtJakart/lib_injector/injector_worker_types.ml b/src/proto_013_PtJakart/lib_injector/injector_worker_types.ml deleted file mode 100644 index f64be4e54cf5..000000000000 --- a/src/proto_013_PtJakart/lib_injector/injector_worker_types.ml +++ /dev/null @@ -1,108 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol_client_context -open Protocol -open Alpha_context -open Common - -module Request = struct - type ('a, 'b) t = - | Add_pending : L1_operation.t -> (unit, error trace) t - | New_tezos_head : - Alpha_block_services.block_info * Alpha_block_services.block_info reorg - -> (unit, error trace) t - | Inject : (unit, error trace) t - - type view = View : _ t -> view - - let view req = View req - - let encoding = - let open Data_encoding in - union - [ - case - (Tag 0) - ~title:"Add_pending" - (merge_objs - (obj1 (req "request" (constant "add_pending"))) - L1_operation.encoding) - (function View (Add_pending op) -> Some ((), op) | _ -> None) - (fun ((), op) -> View (Add_pending op)); - case - (Tag 1) - ~title:"New_tezos_head" - (obj3 - (req "request" (constant "new_tezos_head")) - (req "head" Alpha_block_services.block_info_encoding) - (req - "reorg" - (reorg_encoding Alpha_block_services.block_info_encoding))) - (function - | View (New_tezos_head (b, r)) -> Some ((), b, r) | _ -> None) - (fun ((), b, r) -> View (New_tezos_head (b, r))); - case - (Tag 2) - ~title:"Inject" - (obj1 (req "request" (constant "inject"))) - (function View Inject -> Some () | _ -> None) - (fun () -> View Inject); - ] - - let pp ppf (View r) = - match r with - | Add_pending op -> - Format.fprintf - ppf - "request add %a to pending queue" - L1_operation.Hash.pp - op.hash - | New_tezos_head (b, r) -> - Format.fprintf - ppf - "switching to new Tezos head %a" - Block_hash.pp - b.Alpha_block_services.hash ; - if r.old_chain <> [] || r.new_chain <> [] then - Format.fprintf - ppf - ", with reorg of -%d +%d" - (List.length r.old_chain) - (List.length r.new_chain) - | Inject -> Format.fprintf ppf "injection" -end - -module Name = struct - type t = public_key_hash - - let encoding = Tezos_crypto.Signature.V0.Public_key_hash.encoding - - let base = ["tx_rollup_injector"] - - let pp = Tezos_crypto.Signature.V0.Public_key_hash.pp_short - - let equal = Tezos_crypto.Signature.V0.Public_key_hash.equal -end diff --git a/src/proto_013_PtJakart/lib_injector/injector_worker_types.mli b/src/proto_013_PtJakart/lib_injector/injector_worker_types.mli deleted file mode 100644 index 8ad0632927e8..000000000000 --- a/src/proto_013_PtJakart/lib_injector/injector_worker_types.mli +++ /dev/null @@ -1,47 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol_client_context -open Protocol -open Alpha_context -open Common - -module Request : sig - type ('a, 'b) t = - | Add_pending : L1_operation.t -> (unit, error trace) t - | New_tezos_head : - Alpha_block_services.block_info * Alpha_block_services.block_info reorg - -> (unit, error trace) t - | Inject : (unit, error trace) t - - type view = View : _ t -> view - - include - Worker_intf.REQUEST - with type ('a, 'request_error) t := ('a, 'request_error) t - and type view := view -end - -module Name : Worker_intf.NAME with type t = public_key_hash diff --git a/src/proto_013_PtJakart/lib_injector/l1_operation.ml b/src/proto_013_PtJakart/lib_injector/l1_operation.ml deleted file mode 100644 index 920e15484c42..000000000000 --- a/src/proto_013_PtJakart/lib_injector/l1_operation.ml +++ /dev/null @@ -1,193 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context - -module Manager_operation = struct - type t = packed_manager_operation - - let encoding : t Data_encoding.t = - let open Data_encoding in - let open Operation.Encoding.Manager_operations in - let make (MCase {tag; name; encoding; select; proj; inj}) = - case - (Tag tag) - ~title:name - (merge_objs (obj1 (req "kind" (constant name))) encoding) - (fun o -> - match select o with None -> None | Some o -> Some ((), proj o)) - (fun ((), x) -> Manager (inj x)) - in - def "manager_operation" - @@ union - [ - make reveal_case; - make transaction_case; - make origination_case; - make delegation_case; - make set_deposits_limit_case; - make register_global_constant_case; - make tx_rollup_origination_case; - make tx_rollup_submit_batch_case; - make tx_rollup_commit_case; - make tx_rollup_return_bond_case; - make tx_rollup_finalize_commitment_case; - make tx_rollup_remove_commitment_case; - make tx_rollup_rejection_case; - make tx_rollup_dispatch_tickets_case; - make transfer_ticket_case; - make sc_rollup_originate_case; - make sc_rollup_add_messages_case; - make sc_rollup_cement_case; - make sc_rollup_publish_case; - ] - - let get_case : - type kind. - kind manager_operation -> kind Operation.Encoding.Manager_operations.case - = - let open Operation.Encoding.Manager_operations in - function - | Reveal _ -> reveal_case - | Transaction _ -> transaction_case - | Origination _ -> origination_case - | Delegation _ -> delegation_case - | Register_global_constant _ -> register_global_constant_case - | Set_deposits_limit _ -> set_deposits_limit_case - | Tx_rollup_origination -> tx_rollup_origination_case - | Tx_rollup_submit_batch _ -> tx_rollup_submit_batch_case - | Tx_rollup_commit _ -> tx_rollup_commit_case - | Tx_rollup_return_bond _ -> tx_rollup_return_bond_case - | Tx_rollup_finalize_commitment _ -> tx_rollup_finalize_commitment_case - | Tx_rollup_remove_commitment _ -> tx_rollup_remove_commitment_case - | Tx_rollup_rejection _ -> tx_rollup_rejection_case - | Tx_rollup_dispatch_tickets _ -> tx_rollup_dispatch_tickets_case - | Transfer_ticket _ -> transfer_ticket_case - | Sc_rollup_originate _ -> sc_rollup_originate_case - | Sc_rollup_add_messages _ -> sc_rollup_add_messages_case - | Sc_rollup_cement _ -> sc_rollup_cement_case - | Sc_rollup_publish _ -> sc_rollup_publish_case - - let pp_kind ppf op = - let open Operation.Encoding.Manager_operations in - let (MCase {name; _}) = get_case op in - Format.pp_print_string ppf name - - let pp ppf (Manager op) = - match op with - | Tx_rollup_commit {commitment = {level; _}; _} -> - Format.fprintf - ppf - "commitment for rollup level %a" - Tx_rollup_level.pp - level - | Tx_rollup_rejection {level; message_position; _} -> - Format.fprintf - ppf - "rejection for commitment at level %a for message %d" - Tx_rollup_level.pp - level - message_position - | Tx_rollup_dispatch_tickets {level; tickets_info; _} -> - let pp_rollup_reveal ppf - Tx_rollup_reveal.{contents; ty; amount; ticketer; claimer; _} = - let pp_lazy_expr ppf e = - Michelson_v1_printer.print_expr_unwrapped - ppf - (Result.value - (Script_repr.force_decode e) - ~default:(Micheline.strip_locations (Micheline.Seq ((), [])))) - in - Format.fprintf - ppf - "%a tickets (%a, %a, %a) to %a" - Tx_rollup_l2_qty.pp - amount - Contract.pp - ticketer - pp_lazy_expr - ty - pp_lazy_expr - contents - Tezos_crypto.Signature.V0.Public_key_hash.pp - claimer - in - Format.fprintf - ppf - "@[dispatch withdrawals at rollup level %a: %a@]" - Tx_rollup_level.pp - level - (Format.pp_print_list pp_rollup_reveal) - tickets_info - | _ -> pp_kind ppf op -end - -module Hash = - Tezos_crypto.Blake2B.Make - (Tezos_crypto.Base58) - (struct - let name = "manager_operation_hash" - - let title = "A manager operation hash" - - let b58check_prefix = "\068\160\013" (* mop(53) *) - - let size = None - end) - -let () = - Tezos_crypto.Base58.check_encoded_prefix Hash.b58check_encoding "mop" 53 - -type hash = Hash.t - -type t = {hash : hash; manager_operation : packed_manager_operation} - -let hash_manager_operation op = - Hash.hash_bytes - [Data_encoding.Binary.to_bytes_exn Manager_operation.encoding op] - -let make manager_operation = - let manager_operation = Manager manager_operation in - let hash = hash_manager_operation manager_operation in - {hash; manager_operation} - -let encoding = - let open Data_encoding in - conv - (fun {hash; manager_operation} -> (hash, manager_operation)) - (fun (hash, manager_operation) -> {hash; manager_operation}) - @@ obj2 - (req "hash" Hash.encoding) - (req "manager_operation" Manager_operation.encoding) - -let pp ppf {hash; manager_operation} = - Format.fprintf - ppf - "%a (%a)" - Manager_operation.pp - manager_operation - Hash.pp - hash diff --git a/src/proto_013_PtJakart/lib_injector/l1_operation.mli b/src/proto_013_PtJakart/lib_injector/l1_operation.mli deleted file mode 100644 index 6dc5bdeb9cd8..000000000000 --- a/src/proto_013_PtJakart/lib_injector/l1_operation.mli +++ /dev/null @@ -1,48 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol.Alpha_context - -(** Hash with b58check encoding mop(53), for hashes of L1 manager operations *) -module Hash : Tezos_crypto.Intfs.HASH - -(** Alias for L1 operations hashes *) -type hash = Hash.t - -(** The type of L1 operations that are injected on Tezos by the rollup node *) -type t = private { - hash : hash; (** The hash of the L1 manager operation (without the source) *) - manager_operation : packed_manager_operation; (** The manager operation *) -} - -(** [make op] returns an L1 operation with the corresponding hash. *) -val make : 'a manager_operation -> t - -(** Encoding for L1 operations *) -val encoding : t Data_encoding.t - -(** Pretty printer for L1 operations. Only the relevant part for the rollup node - is printed. *) -val pp : Format.formatter -> t -> unit diff --git a/src/proto_014_PtKathma/lib_injector/common.ml b/src/proto_014_PtKathma/lib_injector/common.ml deleted file mode 100644 index 162a9278ed11..000000000000 --- a/src/proto_014_PtKathma/lib_injector/common.ml +++ /dev/null @@ -1,100 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol_client_context - -type signer = { - alias : string; - pkh : Tezos_crypto.Signature.V0.public_key_hash; - pk : Tezos_crypto.Signature.V0.public_key; - sk : Client_keys_v0.sk_uri; -} - -let get_signer cctxt pkh = - let open Lwt_result_syntax in - let* alias, pk, sk = Client_keys_v0.get_key cctxt pkh in - return {alias; pkh; pk; sk} - -type 'block reorg = {old_chain : 'block list; new_chain : 'block list} - -let no_reorg = {old_chain = []; new_chain = []} - -let reorg_encoding block_encoding = - let open Data_encoding in - conv - (fun {old_chain; new_chain} -> (old_chain, new_chain)) - (fun (old_chain, new_chain) -> {old_chain; new_chain}) - @@ obj2 - (req "old_chain" (list block_encoding)) - (req "new_chain" (list block_encoding)) - -let fetch_tezos_block ~find_in_cache (cctxt : #full) hash : - (Alpha_block_services.block_info, error trace) result Lwt.t = - let fetch hash = - Alpha_block_services.info - cctxt - ~chain:cctxt#chain - ~block:(`Hash (hash, 0)) - ~metadata:`Always - () - in - find_in_cache hash fetch - -(* Compute the reorganization of L1 blocks from the chain whose head is - [old_head_hash] and the chain whose head [new_head_hash]. *) -let tezos_reorg fetch_tezos_block ~old_head_hash ~new_head_hash = - let open Alpha_block_services in - let open Lwt_result_syntax in - let rec loop old_chain new_chain old_head_hash new_head_hash = - if Block_hash.(old_head_hash = new_head_hash) then - return {old_chain = List.rev old_chain; new_chain = List.rev new_chain} - else - let* new_head = fetch_tezos_block new_head_hash in - let* old_head = fetch_tezos_block old_head_hash in - let old_level = old_head.header.shell.level in - let new_level = new_head.header.shell.level in - let diff = Int32.sub new_level old_level in - let old_chain, new_chain, old, new_ = - if diff = 0l then - (* Heads at same level *) - let new_chain = new_head :: new_chain in - let old_chain = old_head :: old_chain in - let new_head_hash = new_head.header.shell.predecessor in - let old_head_hash = old_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - else if diff > 0l then - (* New chain is longer *) - let new_chain = new_head :: new_chain in - let new_head_hash = new_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - else - (* Old chain was longer *) - let old_chain = old_head :: old_chain in - let old_head_hash = old_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - in - loop old_chain new_chain old new_ - in - loop [] [] old_head_hash new_head_hash diff --git a/src/proto_014_PtKathma/lib_injector/common.mli b/src/proto_014_PtKathma/lib_injector/common.mli deleted file mode 100644 index 081dc1e98615..000000000000 --- a/src/proto_014_PtKathma/lib_injector/common.mli +++ /dev/null @@ -1,76 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol_client_context - -(** The type of signers for operations injected by the injector *) -type signer = { - alias : string; - pkh : Tezos_crypto.Signature.V0.public_key_hash; - pk : Tezos_crypto.Signature.V0.public_key; - sk : Client_keys_v0.sk_uri; -} - -(** Type of chain reorganizations. *) -type 'block reorg = { - old_chain : 'block list; - (** The blocks that were in the old chain and which are not in the new one. *) - new_chain : 'block list; - (** The blocks that are now in the new chain. The length of [old_chain] and - [new_chain] may be different. *) -} - -(** Retrieve a signer from the client wallet. *) -val get_signer : - #Client_context.wallet -> - Tezos_crypto.Signature.V0.public_key_hash -> - signer tzresult Lwt.t - -val no_reorg : 'a reorg - -val reorg_encoding : 'a Data_encoding.t -> 'a reorg Data_encoding.t - -type block_info := Alpha_block_services.block_info - -(** [fetch_tezos_block ~find_in_cache cctxt hash] returns a block info given a - block hash. Looks for the block using [find_in_cache] first, and fetches - it from the L1 node otherwise. *) -val fetch_tezos_block : - find_in_cache: - (Block_hash.t -> - (Block_hash.t -> block_info tzresult Lwt.t) -> - block_info tzresult Lwt.t) -> - #full -> - Block_hash.t -> - block_info tzresult Lwt.t - -(** [tezos_reorg fetch ~old_head_hash ~new_head_hash] computes the - reorganization of L1 blocks from the chain whose head is [old_head_hash] and - the chain whose head [new_head_hash]. *) -val tezos_reorg : - (Block_hash.t -> block_info tzresult Lwt.t) -> - old_head_hash:Block_hash.t -> - new_head_hash:Block_hash.t -> - block_info reorg tzresult Lwt.t diff --git a/src/proto_014_PtKathma/lib_injector/disk_persistence.ml b/src/proto_014_PtKathma/lib_injector/disk_persistence.ml deleted file mode 100644 index 9941a6928cdd..000000000000 --- a/src/proto_014_PtKathma/lib_injector/disk_persistence.ml +++ /dev/null @@ -1,393 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -type error += - | Cannot_write_file of string - | Cannot_create_dir of string - | Cannot_delete_file of string - | Cannot_read_file of string - | Io_error of [`Close | `Open] Lwt_utils_unix.io_error - | Unix_error of Unix.error - | Decoding_error of Data_encoding.Binary.read_error - -let () = - register_error_kind - ~id:"rollups.injector.cannot_write_file" - ~title:"Cannot write file" - ~description:"An element for a persistent table could not be written" - ~pp:(fun ppf s -> - Format.fprintf ppf "The persistent element %s could not be written" s) - `Temporary - Data_encoding.(obj1 (req "file" string)) - (function Cannot_write_file s -> Some s | _ -> None) - (fun s -> Cannot_write_file s) ; - register_error_kind - ~id:"rollups.injector.cannot_create_dir" - ~title:"Cannot create directory" - ~description:"Directory for persistent data structure could not be created" - ~pp:(fun ppf s -> - Format.fprintf - ppf - "Directory %s for persistent data structure could not be created" - s) - `Temporary - Data_encoding.(obj1 (req "directory" string)) - (function Cannot_create_dir s -> Some s | _ -> None) - (fun s -> Cannot_create_dir s) ; - register_error_kind - ~id:"rollups.injector.cannot_delete_file" - ~title:"Cannot delete file" - ~description:"An element for a persistent table could not be deleted" - ~pp:(fun ppf s -> - Format.fprintf ppf "The persistent element %s could not be deleted" s) - `Temporary - Data_encoding.(obj1 (req "file" string)) - (function Cannot_delete_file s -> Some s | _ -> None) - (fun s -> Cannot_delete_file s) ; - register_error_kind - ~id:"rollups.injector.cannot_read_file" - ~title:"Cannot read file" - ~description:"A file for a persistent element could not be read" - ~pp:(fun ppf s -> - Format.fprintf ppf "The persistent element %s could not be read" s) - `Temporary - Data_encoding.(obj1 (req "file" string)) - (function Cannot_read_file s -> Some s | _ -> None) - (fun s -> Cannot_read_file s) ; - register_error_kind - ~id:"rollups.injector.io_error" - ~title:"IO error" - ~description:"IO error" - ~pp:(fun ppf (_action, unix_code, caller, arg) -> - Format.fprintf - ppf - "IO error in %s(%s): %s)" - caller - arg - (Unix.error_message unix_code)) - `Temporary - Data_encoding.( - obj4 - (req "action" (string_enum [("close", `Close); ("open", `Open)])) - (req "unix_code" Tezos_stdlib_unix.Unix_error.encoding) - (req "caller" string) - (req "arg" string)) - (function - | Io_error Lwt_utils_unix.{action; unix_code; caller; arg} -> - Some (action, unix_code, caller, arg) - | _ -> None) - (fun (action, unix_code, caller, arg) -> - Io_error Lwt_utils_unix.{action; unix_code; caller; arg}) ; - register_error_kind - ~id:"rollups.injector.unix_error" - ~title:"Unix error" - ~description:"Unix error" - ~pp:(fun ppf error -> - Format.fprintf ppf "Unix error: %s" (Unix.error_message error)) - `Temporary - Data_encoding.(obj1 (req "error" Tezos_stdlib_unix.Unix_error.encoding)) - (function Unix_error e -> Some e | _ -> None) - (fun e -> Unix_error e) ; - register_error_kind - ~id:"rollups.injector.decoding_error" - ~title:"Cannot decode file" - ~description:"A file for a persistent element could not be decoded" - ~pp:(fun ppf error -> - Format.fprintf - ppf - "Decoding error: %a" - Data_encoding.Json.pp - (Data_encoding.Json.construct - Data_encoding.Binary.read_error_encoding - error)) - `Permanent - Data_encoding.(obj1 (req "error" Data_encoding.Binary.read_error_encoding)) - (function Decoding_error e -> Some e | _ -> None) - (fun e -> Decoding_error e) ; - () - -module type H = sig - include Hashtbl.SeededS - - type value - - val name : string - - val string_of_key : key -> string - - val key_of_string : string -> key option - - val value_encoding : value Data_encoding.t -end - -let create_dir dir = - trace (Cannot_create_dir dir) - @@ protect - @@ fun () -> - let open Lwt_result_syntax in - let*! () = Lwt_utils_unix.create_dir dir in - return_unit - -let read_value file encoding = - let open Lwt_syntax in - trace (Cannot_read_file file) - @@ Lwt.catch - (fun () -> - Lwt_io.with_file ~flags:[Unix.O_RDONLY; O_CLOEXEC] ~mode:Input file - @@ fun channel -> - let+ bytes = Lwt_io.read channel in - Result.map_error (fun e -> [Decoding_error e]) - @@ Data_encoding.Binary.of_bytes - encoding - (Bytes.unsafe_of_string bytes)) - (function - | Unix.Unix_error (e, _, _) -> fail (Unix_error e) | e -> fail (Exn e)) - -let maybe_read_value ~warn file encoding = - let open Lwt_syntax in - let* v = read_value file encoding in - match v with - | Error e -> - let+ () = warn file e in - None - | Ok v -> return_some v - -let write_value file encoding value = - trace (Cannot_write_file file) - @@ protect - @@ fun () -> - Lwt_result.map_error (fun e -> [Io_error e]) - @@ Lwt_utils_unix.with_open_out ~overwrite:true file - @@ fun fd -> - let block_bytes = Data_encoding.Binary.to_bytes_exn encoding value in - Lwt_utils_unix.write_bytes fd block_bytes - -let delete_file file = - trace (Cannot_delete_file file) - @@ protect - @@ fun () -> - let open Lwt_result_syntax in - let*! () = Lwt_unix.unlink file in - return_unit - -module Make_table (H : H) = struct - type key = H.key - - type value = H.value - - type t = {path : string; table : value H.t} - - let filedata t k = Filename.concat t.path (H.string_of_key k) - - let create ~data_dir n = - let open Lwt_result_syntax in - let table = H.create n in - let path = Filename.concat data_dir H.name in - let+ () = create_dir path in - {path; table} - - let replace t k v = - H.replace t.table k v ; - write_value (filedata t k) H.value_encoding v - - let remove t k = - H.remove t.table k ; - delete_file (filedata t k) - - let find t k = H.find t.table k - - let mem t k = H.mem t.table k - - let iter_s f t = H.iter_s f t.table - - let iter_es f t = H.iter_es f t.table - - let length t = H.length t.table - - let replace_seq t seq = - H.replace_seq t.table seq ; - Seq.iter_es - (fun (k, v) -> write_value (filedata t k) H.value_encoding v) - seq - - let load_from_disk ~warn_unreadable ~initial_size ~data_dir ~filter = - let open Lwt_result_syntax in - let* t = create ~data_dir initial_size in - let*! d = Lwt_unix.opendir t.path in - let rec browse () = - let*! filename = - let open Lwt_syntax in - Lwt.catch - (fun () -> - let+ f = Lwt_unix.readdir d in - Some f) - (function End_of_file -> return_none | e -> raise e) - in - match filename with - | None -> return_unit - | Some filename -> - let* () = - match H.key_of_string filename with - | None -> return_unit - | Some k -> ( - let+ v = - match warn_unreadable with - | None -> - let+ v = read_value (filedata t k) H.value_encoding in - Some v - | Some warn -> - let*! v = - maybe_read_value ~warn (filedata t k) H.value_encoding - in - return v - in - match v with - | None -> () - | Some v -> if filter v then H.add t.table k v) - in - browse () - in - let+ () = browse () in - t -end - -module Make_queue (N : sig - val name : string -end) -(K : Tezos_crypto.Intfs.HASH) (V : sig - type t - - val encoding : t Data_encoding.t -end) = -struct - module Q = Hash_queue.Make (K) (V) - - type t = {path : string; metadata_path : string; queue : Q.t} - - let counter = ref min_int - - let filedata q k = Filename.concat q.path (K.to_b58check k) - - let filemetadata q k = Filename.concat q.metadata_path (K.to_b58check k) - - let create ~data_dir n = - let open Lwt_result_syntax in - let queue = Q.create n in - let path = Filename.concat data_dir N.name in - let metadata_path = Filename.concat path "metadata" in - let* () = create_dir path in - let+ () = create_dir metadata_path in - {path; metadata_path; queue} - - let remove q k = - let open Lwt_result_syntax in - Q.remove q.queue k ; - let* () = delete_file (filedata q k) - and* () = delete_file (filemetadata q k) in - return_unit - - let create_metadata () = - let time = Time.System.now () in - let d, ps = Ptime.to_span time |> Ptime.Span.to_d_ps in - let c = !counter in - incr counter ; - (d, ps, c) - - let metadata_encoding = - let open Data_encoding in - conv - (fun (d, ps, c) -> (Int64.of_int d, ps, Int64.of_int c)) - (fun (d, ps, c) -> (Int64.to_int d, ps, Int64.to_int c)) - @@ tup3 int64 int64 int64 - - let replace q k v = - let open Lwt_result_syntax in - Q.replace q.queue k v ; - let* () = write_value (filedata q k) V.encoding v - and* () = - write_value (filemetadata q k) metadata_encoding (create_metadata ()) - in - return_unit - - let fold f q = Q.fold f q.queue - - let length q = Q.length q.queue - - let load_from_disk ~warn_unreadable ~capacity ~data_dir ~filter = - let open Lwt_result_syntax in - let* q = create ~data_dir capacity in - let*! d = Lwt_unix.opendir q.path in - let rec browse acc = - let*! filename = - let open Lwt_syntax in - Lwt.catch - (fun () -> - let+ f = Lwt_unix.readdir d in - Some f) - (function End_of_file -> return_none | e -> raise e) - in - match filename with - | None -> return acc - | Some filename -> - let* acc = - match K.of_b58check_opt filename with - | None -> return acc - | Some k -> ( - let+ v_meta = - match warn_unreadable with - | None -> - let* v = read_value (filedata q k) V.encoding - and* meta = - read_value (filemetadata q k) metadata_encoding - in - return_some (v, meta) - | Some warn -> - let open Lwt_syntax in - let* v = maybe_read_value ~warn (filedata q k) V.encoding - and* meta = - maybe_read_value - ~warn - (filemetadata q k) - metadata_encoding - in - return_ok @@ Option.bind v - @@ fun v -> Option.bind meta @@ fun meta -> Some (v, meta) - in - match v_meta with - | None -> acc - | Some (v, meta) -> - if filter v then (k, v, meta) :: acc else acc) - in - browse acc - in - let* list = browse [] in - let list = - List.fast_sort - (fun (_, _, meta1) (_, _, meta2) -> Stdlib.compare meta1 meta2) - list - in - List.iter (fun (k, v, _) -> Q.replace q.queue k v) list ; - return q -end diff --git a/src/proto_014_PtKathma/lib_injector/disk_persistence.mli b/src/proto_014_PtKathma/lib_injector/disk_persistence.mli deleted file mode 100644 index 8314c45538df..000000000000 --- a/src/proto_014_PtKathma/lib_injector/disk_persistence.mli +++ /dev/null @@ -1,145 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -type error += - | Cannot_write_file of string - | Cannot_create_dir of string - | Cannot_read_file of string - | Io_error of [`Close | `Open] Lwt_utils_unix.io_error - | Unix_error of Unix.error - | Decoding_error of Data_encoding.Binary.read_error - -(** Signature for hash tables with additional information *) -module type H = sig - include Hashtbl.SeededS - - (** Type of values *) - type value - - (** Name used to derive a path (relative to [data_dir] in [load_from_disk]) of - where to store the persistent information for this hash table. *) - val name : string - - (** String version of key (used for filenames). *) - val string_of_key : key -> string - - (** Parse a key. We must have [key_of_string (string_of_key k) = k]. *) - val key_of_string : string -> key option - - (** Encoding for values (only the binary encoding is used *) - val value_encoding : value Data_encoding.t -end - -(** Create an on-disk persistent version of {!Hashtbl}. *) -module Make_table (H : H) : sig - type key = H.key - - type value = H.value - - (** Type of persistent hash tables *) - type t - - (** Persistent version of {!module-type-H.replace} *) - val replace : t -> key -> value -> unit tzresult Lwt.t - - (** Persistent version of {!module-type-H.remove} *) - val remove : t -> key -> unit tzresult Lwt.t - - (** Same as {!module-type-H.find} *) - val find : t -> key -> value option - - (** Same as {!module-type-H.mem} *) - val mem : t -> key -> bool - - (** Same as {!module-type-H.iter_s} *) - val iter_s : (key -> value -> unit Lwt.t) -> t -> unit Lwt.t - - (** Same as {!module-type-H.iter_es} *) - val iter_es : - (key -> value -> unit tzresult Lwt.t) -> t -> unit tzresult Lwt.t - - (** Same as {!module-type-H.length} *) - val length : t -> int - - (** Persistent version of {!module-type-H.replace_seq} *) - val replace_seq : t -> (key * value) Seq.t -> unit tzresult Lwt.t - - (** [load_from_disk ~warn_unreadable ~initial_size ~data_dir] creates a hash - table of size [initial_size]. The hash table is populated by persistent - elements present in [data_dir/H.name] which pass the [filter] (the - directory is created if it does not exist). If [warn_unreadable] is [Some - warn], unreadable files are ignored but a warning is printed with [warn], - otherwise the loading fails on the first unreadable file. *) - val load_from_disk : - warn_unreadable:(string -> error trace -> unit Lwt.t) option -> - initial_size:int -> - data_dir:string -> - filter:(value -> bool) -> - t tzresult Lwt.t -end - -(** Create an on-disk persistent version of the {!Hash_queue} data structure. *) -module Make_queue (N : sig - (** Name used to derive a path (relative to [data_dir] in [load_from_disk]) of where - to store the persistent information for this queue. *) - val name : string -end) -(K : Tezos_crypto.Intfs.HASH) (V : sig - type t - - val encoding : t Data_encoding.t -end) : sig - type t - - (** [remove q k] removes the binding from [k] in [q]. If [k] is not bound in - [c], it does nothing. The removal is persisted on disk. *) - val remove : t -> K.t -> unit tzresult Lwt.t - - (** [replace q k v] binds the key [k] to the value [v] in the queue [q]. This - may or may not cause another binding to be removed, depending on the - number of bindings already present in [q]. The addition (or replacement) - is persisted on disk. *) - val replace : t -> K.t -> V.t -> unit tzresult Lwt.t - - (** [fold f q init] folds the function [f] over the bindings - of [q] (in memory). The elements are iterated from oldest to newest. *) - val fold : (K.t -> V.t -> 'a -> 'a) -> t -> 'a -> 'a - - (** [length q] is the number of bindings held by [q]. *) - val length : t -> int - - (** [load_from_disk ~warn_unreadable ~capacity ~data_dir ~filter] creates a - bounded hash queue of capacity [capacity]. The queue is populated by - persistent elements present in [data_dir/N.name] which pass the [filter] - (the directory is created if it does not exist). If [warn_unreadable] is - [Some warn], unreadable files are ignored but a warning is printed with - [warn], otherwise the loading fails on the first unreadable file. *) - val load_from_disk : - warn_unreadable:(string -> error trace -> unit Lwt.t) option -> - capacity:int -> - data_dir:string -> - filter:(V.t -> bool) -> - t tzresult Lwt.t -end diff --git a/src/proto_014_PtKathma/lib_injector/dune b/src/proto_014_PtKathma/lib_injector/dune deleted file mode 100644 index 07db8fb6ec28..000000000000 --- a/src/proto_014_PtKathma/lib_injector/dune +++ /dev/null @@ -1,32 +0,0 @@ -; This file was automatically generated, do not edit. -; Edit file manifest/main.ml instead. - -(library - (name tezos_injector_014_PtKathma) - (public_name tezos-injector-014-PtKathma) - (instrumentation (backend bisect_ppx)) - (libraries - tezos-base - tezos-base.unix - tezos-stdlib-unix - tezos-crypto - tezos-protocol-014-PtKathma - tezos-micheline - tezos-client-014-PtKathma - tezos-client-base - tezos-workers - tezos-shell) - (inline_tests (flags -verbose) (modes native)) - (preprocess (pps ppx_expect)) - (library_flags (:standard -linkall)) - (flags - (:standard) - -open Tezos_base.TzPervasives - -open Tezos_base.TzPervasives.Error_monad.Legacy_monad_globals - -open Tezos_base - -open Tezos_stdlib_unix - -open Tezos_protocol_014_PtKathma - -open Tezos_micheline - -open Tezos_client_014_PtKathma - -open Tezos_client_base - -open Tezos_workers)) diff --git a/src/proto_014_PtKathma/lib_injector/injector_errors.ml b/src/proto_014_PtKathma/lib_injector/injector_errors.ml deleted file mode 100644 index b0e69ff4f6da..000000000000 --- a/src/proto_014_PtKathma/lib_injector/injector_errors.ml +++ /dev/null @@ -1,75 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -type error += - | No_worker_for_source of Tezos_crypto.Signature.V0.Public_key_hash.t - -let () = - register_error_kind - ~id:"rollups.injector.no_worker_for_source" - ~title:"No injecting queue for source" - ~description: - "An L1 operation could not be queued because its source has no worker." - ~pp:(fun ppf s -> - Format.fprintf - ppf - "No worker for source %a" - Tezos_crypto.Signature.V0.Public_key_hash.pp - s) - `Permanent - Data_encoding.( - obj1 (req "source" Tezos_crypto.Signature.V0.Public_key_hash.encoding)) - (function No_worker_for_source s -> Some s | _ -> None) - (fun s -> No_worker_for_source s) - -type error += No_worker_for_tag of string - -let () = - register_error_kind - ~id:"rollups.injector.no_worker_for_tag" - ~title:"No injecting queue for tag" - ~description: - "An L1 operation could not be queued because its tag has no worker." - ~pp:(fun ppf t -> Format.fprintf ppf "No worker for tag %s" t) - `Permanent - Data_encoding.(obj1 (req "tag" Data_encoding.string)) - (function No_worker_for_tag t -> Some t | _ -> None) - (fun t -> No_worker_for_tag t) - -type error += No_worker_for_operation of L1_operation.t - -let () = - register_error_kind - ~id:"rollups.injector.no_worker_for_operation" - ~title:"This operation is not supported by injector" - ~description: - "An L1 operation could not be queued because the injector does not \ - handle it." - ~pp:(fun ppf op -> - Format.fprintf ppf "No worker for operation %a" L1_operation.pp op) - `Permanent - Data_encoding.(obj1 (req "operation" L1_operation.encoding)) - (function No_worker_for_operation op -> Some op | _ -> None) - (fun op -> No_worker_for_operation op) diff --git a/src/proto_014_PtKathma/lib_injector/injector_errors.mli b/src/proto_014_PtKathma/lib_injector/injector_errors.mli deleted file mode 100644 index 4676461a00af..000000000000 --- a/src/proto_014_PtKathma/lib_injector/injector_errors.mli +++ /dev/null @@ -1,36 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Error when the injector has no worker for the source which must inject an - operation. *) -type error += - | No_worker_for_source of Tezos_crypto.Signature.V0.Public_key_hash.t - -(** Error when the injector has no worker for the tag of the operation to be - injected. *) -type error += No_worker_for_tag of string - -(** Error when the injector does not handle the operation. *) -type error += No_worker_for_operation of L1_operation.t diff --git a/src/proto_014_PtKathma/lib_injector/injector_events.ml b/src/proto_014_PtKathma/lib_injector/injector_events.ml deleted file mode 100644 index b22dbdd7d6a5..000000000000 --- a/src/proto_014_PtKathma/lib_injector/injector_events.ml +++ /dev/null @@ -1,232 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Injector_worker_types - -module Make (Rollup : Injector_sigs.PARAMETERS) = struct - module Tags = Injector_tags.Make (Rollup.Tag) - include Internal_event.Simple - - let section = Rollup.events_section - - let declare_1 ~name ~msg ~level ?pp1 enc1 = - declare_3 - ~section - ~name - ~msg:("[{signer}: {tags}] " ^ msg) - ~level - ("signer", Tezos_crypto.Signature.V0.Public_key_hash.encoding) - ("tags", Tags.encoding) - enc1 - ~pp1:Tezos_crypto.Signature.V0.Public_key_hash.pp_short - ~pp2:Tags.pp - ?pp3:pp1 - - let declare_2 ~name ~msg ~level ?pp1 ?pp2 enc1 enc2 = - declare_4 - ~section - ~name - ~msg:("[{signer}: {tags}] " ^ msg) - ~level - ("signer", Tezos_crypto.Signature.V0.Public_key_hash.encoding) - ("tags", Tags.encoding) - enc1 - enc2 - ~pp1:Tezos_crypto.Signature.V0.Public_key_hash.pp_short - ~pp2:Tags.pp - ?pp3:pp1 - ?pp4:pp2 - - let declare_3 ~name ~msg ~level ?pp1 ?pp2 ?pp3 enc1 enc2 enc3 = - declare_5 - ~section - ~name - ~msg:("[{signer}: {tags}] " ^ msg) - ~level - ("signer", Tezos_crypto.Signature.V0.Public_key_hash.encoding) - ("tags", Tags.encoding) - enc1 - enc2 - enc3 - ~pp1:Tezos_crypto.Signature.V0.Public_key_hash.pp_short - ~pp2:Tags.pp - ?pp3:pp1 - ?pp4:pp2 - ?pp5:pp3 - - let request_failed = - declare_3 - ~name:"request_failed" - ~msg:"request {view} failed ({worker_status}): {errors}" - ~level:Warning - ("view", Request.encoding) - ~pp1:Request.pp - ("worker_status", Worker_types.request_status_encoding) - ~pp2:Worker_types.pp_status - ("errors", Error_monad.trace_encoding) - ~pp3:Error_monad.pp_print_trace - - let request_completed_notice = - declare_2 - ~name:"request_completed_notice" - ~msg:"{view} {worker_status}" - ~level:Notice - ("view", Request.encoding) - ("worker_status", Worker_types.request_status_encoding) - ~pp1:Request.pp - ~pp2:Worker_types.pp_status - - let request_completed_debug = - declare_2 - ~name:"request_completed_debug" - ~msg:"{view} {worker_status}" - ~level:Debug - ("view", Request.encoding) - ("worker_status", Worker_types.request_status_encoding) - ~pp1:Request.pp - ~pp2:Worker_types.pp_status - - let new_tezos_head = - declare_1 - ~name:"new_tezos_head" - ~msg:"processing new Tezos head {head}" - ~level:Debug - ("head", Block_hash.encoding) - - let injecting_pending = - declare_1 - ~name:"injecting_pending" - ~msg:"Injecting {count} pending operations" - ~level:Notice - ("count", Data_encoding.int31) - - let pp_operations_list ppf operations = - Format.fprintf - ppf - "@[%a@]" - (Format.pp_print_list L1_operation.pp) - operations - - let pp_operations_hash_list ppf operations = - Format.fprintf - ppf - "@[%a@]" - (Format.pp_print_list L1_operation.Hash.pp) - operations - - let injecting_operations = - declare_1 - ~name:"injecting_operations" - ~msg:"Injecting operations: {operations}" - ~level:Notice - ("operations", Data_encoding.list L1_operation.encoding) - ~pp1:pp_operations_list - - let simulating_operations = - declare_2 - ~name:"simulating_operations" - ~msg:"Simulating operations (force = {force}): {operations}" - ~level:Debug - ("operations", Data_encoding.list L1_operation.encoding) - ("force", Data_encoding.bool) - ~pp1:pp_operations_list - - let dropping_operation = - declare_2 - ~name:"dropping_operation" - ~msg:"Dropping operation {operation} failing with {error}" - ~level:Notice - ("operation", L1_operation.encoding) - ~pp1:L1_operation.pp - ("error", Environment.Error_monad.trace_encoding) - ~pp2:Environment.Error_monad.pp_trace - - let injected = - declare_1 - ~name:"injected" - ~msg:"Injected in {oph}" - ~level:Notice - ("oph", Operation_hash.encoding) - - let add_pending = - declare_1 - ~name:"add_pending" - ~msg:"Add {operation} to pending" - ~level:Notice - ("operation", L1_operation.encoding) - ~pp1:L1_operation.pp - - let included = - declare_3 - ~name:"included" - ~msg:"Included operations of {block} at level {level}: {operations}" - ~level:Notice - ("block", Block_hash.encoding) - ("level", Data_encoding.int32) - ("operations", Data_encoding.list L1_operation.Hash.encoding) - ~pp3:pp_operations_hash_list - - let revert_operations = - declare_1 - ~name:"revert_operations" - ~msg:"Reverting operations: {operations}" - ~level:Notice - ("operations", Data_encoding.list L1_operation.Hash.encoding) - ~pp1:pp_operations_hash_list - - let confirmed_level = - declare_1 - ~name:"confirmed_level" - ~msg:"Confirmed Tezos level {level}" - ~level:Notice - ("level", Data_encoding.int32) - - let confirmed_operations = - declare_2 - ~name:"confirmed_operations" - ~msg:"Confirmed operations of level {level}: {operations}" - ~level:Notice - ("level", Data_encoding.int32) - ("operations", Data_encoding.list L1_operation.Hash.encoding) - ~pp2:pp_operations_hash_list - - let loaded_from_disk = - declare_2 - ~name:"loaded_from_disk" - ~msg:"Loaded {nb} elements in {kind} from disk" - ~level:Notice - ("nb", Data_encoding.int31) - ("kind", Data_encoding.string) - - let corrupted_operation_on_disk = - declare_2 - ~name:"corrupted_operation_on_disk" - ~msg:"Ignoring unreadable file {file} on disk: {error}" - ~level:Warning - ("file", Data_encoding.string) - ("error", Error_monad.trace_encoding) - ~pp1:Format.pp_print_string - ~pp2:Error_monad.pp_print_trace -end diff --git a/src/proto_014_PtKathma/lib_injector/injector_functor.ml b/src/proto_014_PtKathma/lib_injector/injector_functor.ml deleted file mode 100644 index c3200598c92c..000000000000 --- a/src/proto_014_PtKathma/lib_injector/injector_functor.ml +++ /dev/null @@ -1,1036 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol_client_context -open Protocol -open Alpha_context -open Common -open Injector_worker_types -open Injector_sigs -open Injector_errors - -(* This is the Tenderbake finality for blocks. *) -(* TODO: https://gitlab.com/tezos/tezos/-/issues/2815 - Centralize this and maybe make it configurable. *) -let confirmations = 2 - -type injection_strategy = [`Each_block | `Delay_block] - -(* TODO/TORU: https://gitlab.com/tezos/tezos/-/issues/2755 - Persist injector data on disk *) - -(** Builds a client context from another client context but uses logging instead - of printing on stdout directly. This client context cannot make the injector - exit. *) -let injector_context (cctxt : #Protocol_client_context.full) = - let log _channel msg = Logs_lwt.info (fun m -> m "%s" msg) in - object - inherit - Protocol_client_context.wrap_full - (new Client_context.proxy_context (cctxt :> Client_context.full)) - - inherit! Client_context.simple_printer log - - method! exit code = - Format.ksprintf Stdlib.failwith "Injector client wants to exit %d" code - end - -module Make (Rollup : PARAMETERS) = struct - module Tags = Injector_tags.Make (Rollup.Tag) - module Tags_table = Hashtbl.Make (Rollup.Tag) - - module Op_queue = - Disk_persistence.Make_queue - (struct - let name = "operations_queue" - end) - (L1_operation.Hash) - (L1_operation) - - (** Information stored about an L1 operation that was injected on a Tezos - node. *) - type injected_info = { - op : L1_operation.t; (** The L1 manager operation. *) - oph : Operation_hash.t; - (** The hash of the operation which contains [op] (this can be an L1 batch of - several manager operations). *) - } - - module Injected_operations = Disk_persistence.Make_table (struct - include L1_operation.Hash.Table - - type value = injected_info - - let name = "injected_operations" - - let string_of_key = L1_operation.Hash.to_b58check - - let key_of_string = L1_operation.Hash.of_b58check_opt - - let value_encoding = - let open Data_encoding in - conv (fun {op; oph} -> (oph, op)) (fun (oph, op) -> {op; oph}) - @@ merge_objs - (obj1 (req "oph" Operation_hash.encoding)) - L1_operation.encoding - end) - - module Injected_ophs = Disk_persistence.Make_table (struct - include Operation_hash.Table - - type value = L1_operation.Hash.t list - - let name = "injected_ophs" - - let string_of_key = Operation_hash.to_b58check - - let key_of_string = Operation_hash.of_b58check_opt - - let value_encoding = Data_encoding.list L1_operation.Hash.encoding - end) - - (** The part of the state which gathers information about injected - operations (but not included). *) - type injected_state = { - injected_operations : Injected_operations.t; - (** A table mapping L1 manager operation hashes to the injection info for that - operation. *) - injected_ophs : Injected_ophs.t; - (** A mapping of all L1 manager operations contained in a L1 batch (i.e. an L1 - operation). *) - } - - (** Information stored about an L1 operation that was included in a Tezos - block. *) - type included_info = { - op : L1_operation.t; (** The L1 manager operation. *) - oph : Operation_hash.t; - (** The hash of the operation which contains [op] (this can be an L1 batch of - several manager operations). *) - l1_block : Block_hash.t; - (** The hash of the L1 block in which the operation was included. *) - l1_level : int32; (** The level of [l1_block]. *) - } - - module Included_operations = Disk_persistence.Make_table (struct - include L1_operation.Hash.Table - - type value = included_info - - let name = "included_operations" - - let string_of_key = L1_operation.Hash.to_b58check - - let key_of_string = L1_operation.Hash.of_b58check_opt - - let value_encoding = - let open Data_encoding in - conv - (fun {op; oph; l1_block; l1_level} -> (op, (oph, l1_block, l1_level))) - (fun (op, (oph, l1_block, l1_level)) -> {op; oph; l1_block; l1_level}) - @@ merge_objs - L1_operation.encoding - (obj3 - (req "oph" Operation_hash.encoding) - (req "l1_block" Block_hash.encoding) - (req "l1_level" int32)) - end) - - module Included_in_blocks = Disk_persistence.Make_table (struct - include Block_hash.Table - - type value = int32 * L1_operation.Hash.t list - - let name = "included_in_blocks" - - let string_of_key = Block_hash.to_b58check - - let key_of_string = Block_hash.of_b58check_opt - - let value_encoding = - let open Data_encoding in - obj2 (req "level" int32) (req "l1_ops" (list L1_operation.Hash.encoding)) - end) - - (** The part of the state which gathers information about - operations which are included in the L1 chain (but not confirmed). *) - type included_state = { - included_operations : Included_operations.t; - included_in_blocks : Included_in_blocks.t; - } - - (** The internal state of each injector worker. *) - type state = { - cctxt : Protocol_client_context.full; - (** The client context which is used to perform the injections. *) - signer : signer; (** The signer for this worker. *) - tags : Tags.t; - (** The tags of this worker, for both informative and identification - purposes. *) - strategy : injection_strategy; - (** The strategy of this worker for injecting the pending operations. *) - save_dir : string; (** Path to where save persistent state *) - queue : Op_queue.t; - (** The queue of pending operations for this injector. *) - injected : injected_state; - (** The information about injected operations. *) - included : included_state; - (** The information about included operations. {b Note}: Operations which - are confirmed are simply removed from the state and do not appear - anymore. *) - rollup_node_state : Rollup.rollup_node_state; - (** The state of the rollup node. *) - } - - module Event = struct - include Injector_events.Make (Rollup) - - let emit1 e state x = emit e (state.signer.pkh, state.tags, x) - - let emit2 e state x y = emit e (state.signer.pkh, state.tags, x, y) - - let emit3 e state x y z = emit e (state.signer.pkh, state.tags, x, y, z) - end - - let init_injector cctxt ~data_dir rollup_node_state ~signer strategy tags = - let open Lwt_result_syntax in - let* signer = get_signer cctxt signer in - let data_dir = Filename.concat data_dir "injector" in - let*! () = Lwt_utils_unix.create_dir data_dir in - let filter op_proj op = - let {L1_operation.manager_operation = Manager op; _} = op_proj op in - match Rollup.operation_tag op with - | None -> false - | Some t -> Tags.mem t tags - in - let warn_unreadable = - (* Warn of corrupted files but don't fail *) - Some - (fun file error -> - Event.(emit corrupted_operation_on_disk) - (signer.pkh, tags, file, error)) - in - let emit_event_loaded kind nb = - Event.(emit loaded_from_disk) (signer.pkh, tags, nb, kind) - in - let* queue = - Op_queue.load_from_disk - ~warn_unreadable - ~capacity:50_000 - ~data_dir - ~filter:(filter (fun op -> op)) - in - let*! () = emit_event_loaded "operations_queue" @@ Op_queue.length queue in - (* Very coarse approximation for the number of operation we expect for each - block *) - let n = - Tags.fold (fun t acc -> acc + Rollup.table_estimated_size t) tags 0 - in - let* injected_operations = - Injected_operations.load_from_disk - ~warn_unreadable - ~initial_size:n - ~data_dir - ~filter:(filter (fun (i : injected_info) -> i.op)) - in - let*! () = - emit_event_loaded "injected_operations" - @@ Injected_operations.length injected_operations - in - - let* included_operations = - Included_operations.load_from_disk - ~warn_unreadable - ~initial_size:(confirmations * n) - ~data_dir - ~filter:(filter (fun (i : included_info) -> i.op)) - in - let*! () = - emit_event_loaded "included_operations" - @@ Included_operations.length included_operations - in - let* injected_ophs = - Injected_ophs.load_from_disk - ~warn_unreadable - ~initial_size:n - ~data_dir - ~filter:(List.exists (Injected_operations.mem injected_operations)) - in - let*! () = - emit_event_loaded "injected_ophs" @@ Injected_ophs.length injected_ophs - in - let* included_in_blocks = - Included_in_blocks.load_from_disk - ~warn_unreadable - ~initial_size:(confirmations * n) - ~data_dir - ~filter:(fun (_, ops) -> - List.exists (Included_operations.mem included_operations) ops) - in - let*! () = - emit_event_loaded "included_in_blocks" - @@ Included_in_blocks.length included_in_blocks - in - - return - { - cctxt = injector_context (cctxt :> #Protocol_client_context.full); - signer; - tags; - strategy; - save_dir = data_dir; - queue; - injected = {injected_operations; injected_ophs}; - included = {included_operations; included_in_blocks}; - rollup_node_state; - } - - (** Add an operation to the pending queue corresponding to the signer for this - operation. *) - let add_pending_operation state op = - let open Lwt_result_syntax in - let*! () = Event.(emit1 add_pending) state op in - Op_queue.replace state.queue op.L1_operation.hash op - - (** Mark operations as injected (in [oph]). *) - let add_injected_operations state oph operations = - let open Lwt_result_syntax in - let infos = - List.map (fun op -> (op.L1_operation.hash, {op; oph})) operations - in - let* () = - Injected_operations.replace_seq - state.injected.injected_operations - (List.to_seq infos) - in - Injected_ophs.replace state.injected.injected_ophs oph (List.map fst infos) - - (** [add_included_operations state oph l1_block l1_level operations] marks the - [operations] as included (in the L1 batch [oph]) in the Tezos block - [l1_block] of level [l1_level]. *) - let add_included_operations state oph l1_block l1_level operations = - let open Lwt_result_syntax in - let*! () = - Event.(emit3 included) - state - l1_block - l1_level - (List.map (fun o -> o.L1_operation.hash) operations) - in - let infos = - List.map - (fun op -> (op.L1_operation.hash, {op; oph; l1_block; l1_level})) - operations - in - let* () = - Included_operations.replace_seq - state.included.included_operations - (List.to_seq infos) - in - Included_in_blocks.replace - state.included.included_in_blocks - l1_block - (l1_level, List.map fst infos) - - (** [remove state oph] removes the operations that correspond to the L1 batch - [oph] from the injected operations in the injector state. This function is - used to move operations from injected to included. *) - let remove_injected_operation state oph = - let open Lwt_result_syntax in - match Injected_ophs.find state.injected.injected_ophs oph with - | None -> - (* Nothing removed *) - return [] - | Some mophs -> - let* () = Injected_ophs.remove state.injected.injected_ophs oph in - List.fold_left_es - (fun removed moph -> - match - Injected_operations.find state.injected.injected_operations moph - with - | None -> return removed - | Some info -> - let+ () = - Injected_operations.remove - state.injected.injected_operations - moph - in - info :: removed) - [] - mophs - - (** [remove state block] removes the included operations that correspond to all - the L1 batches included in [block]. This function is used when [block] is on - an alternative chain in the case of a reorganization. *) - let remove_included_operation state block = - let open Lwt_result_syntax in - match Included_in_blocks.find state.included.included_in_blocks block with - | None -> - (* Nothing removed *) - return [] - | Some (_level, mophs) -> - let* () = - Included_in_blocks.remove state.included.included_in_blocks block - in - List.fold_left_es - (fun removed moph -> - match - Included_operations.find state.included.included_operations moph - with - | None -> return removed - | Some info -> - let+ () = - Included_operations.remove - state.included.included_operations - moph - in - info :: removed) - [] - mophs - - let fee_parameter_of_operations state ops = - List.fold_left - (fun acc {L1_operation.manager_operation = Manager op; _} -> - let param = Rollup.fee_parameter state op in - Injection. - { - minimal_fees = Tez.max acc.minimal_fees param.minimal_fees; - minimal_nanotez_per_byte = - Q.max acc.minimal_nanotez_per_byte param.minimal_nanotez_per_byte; - minimal_nanotez_per_gas_unit = - Q.max - acc.minimal_nanotez_per_gas_unit - param.minimal_nanotez_per_gas_unit; - force_low_fee = acc.force_low_fee || param.force_low_fee; - fee_cap = - WithExceptions.Result.get_ok - ~loc:__LOC__ - Tez.(acc.fee_cap +? param.fee_cap); - burn_cap = - WithExceptions.Result.get_ok - ~loc:__LOC__ - Tez.(acc.burn_cap +? param.burn_cap); - }) - Injection. - { - minimal_fees = Tez.zero; - minimal_nanotez_per_byte = Q.zero; - minimal_nanotez_per_gas_unit = Q.zero; - force_low_fee = false; - fee_cap = Tez.zero; - burn_cap = Tez.zero; - } - ops - - (** Simulate the injection of [operations]. See {!inject_operations} for the - specification of [must_succeed]. *) - let simulate_operations ~must_succeed state (operations : L1_operation.t list) - = - let open Lwt_result_syntax in - let open Annotated_manager_operation in - let force = - match operations with - | [] -> assert false - | [_] -> - (* If there is only one operation, fail when simulation fails *) - false - | _ -> ( - (* We want to see which operation failed in the batch if not all must - succeed *) - match must_succeed with `All -> false | `At_least_one -> true) - in - let*! () = Event.(emit2 simulating_operations) state operations force in - let fee_parameter = - fee_parameter_of_operations state.rollup_node_state operations - in - let operations = - List.map - (fun {L1_operation.manager_operation = Manager operation; _} -> - Annotated_manager_operation - (Injection.prepare_manager_operation - ~fee:Limit.unknown - ~gas_limit:Limit.unknown - ~storage_limit:Limit.unknown - operation)) - operations - in - let (Manager_list annot_op) = - Annotated_manager_operation.manager_of_list operations - in - let* _, op, _, result = - Injection.inject_manager_operation - state.cctxt - ~simulation:true (* Only simulation here *) - ~force - ~chain:state.cctxt#chain - ~block:(`Head 0) - ~source:state.signer.pkh - ~src_pk:state.signer.pk - ~src_sk:state.signer.sk - ~successor_level:true - (* Needed to simulate tx_rollup operations in the next block *) - ~fee:Limit.unknown - ~gas_limit:Limit.unknown - ~storage_limit:Limit.unknown - ~fee_parameter - annot_op - in - return (op, Apply_results.Contents_result_list result) - - let inject_on_node state {shell; protocol_data = Operation_data {contents; _}} - = - let open Lwt_result_syntax in - let unsigned_op = (shell, Contents_list contents) in - let unsigned_op_bytes = - Data_encoding.Binary.to_bytes_exn Operation.unsigned_encoding unsigned_op - in - let* signature = - Client_keys_v0.sign - state.cctxt - ~watermark:Tezos_crypto.Signature.V0.Generic_operation - state.signer.sk - unsigned_op_bytes - in - let op : _ Operation.t = - {shell; protocol_data = {contents; signature = Some signature}} - in - let op_bytes = - Data_encoding.Binary.to_bytes_exn Operation.encoding (Operation.pack op) - in - Tezos_shell_services.Shell_services.Injection.operation - state.cctxt - ~chain:state.cctxt#chain - op_bytes - >>=? fun oph -> - let*! () = Event.(emit1 injected) state oph in - return oph - - (** Inject the given [operations] in an L1 batch. If [must_succeed] is [`All] - then all the operations must succeed in the simulation of injection. If - [must_succeed] is [`At_least_one] at least one operation in the list - [operations] must be successful in the simulation. In any case, only - operations which are known as successful will be included in the injected L1 - batch. {b Note}: [must_succeed = `At_least_one] allows to incrementally build - "or-batches" by iteratively removing operations that fail from the desired - batch. *) - let rec inject_operations ~must_succeed state - (operations : L1_operation.t list) = - let open Lwt_result_syntax in - let* packed_op, result = - simulate_operations ~must_succeed state operations - in - let results = Apply_results.to_list result in - let failure = ref false in - let* rev_non_failing_operations = - List.fold_left2_s - ~when_different_lengths: - [ - Exn - (Failure - "Unexpected error: length of operations and result differ in \ - simulation"); - ] - (fun acc op (Apply_results.Contents_result result) -> - match result with - | Apply_results.Manager_operation_result - { - operation_result = - Failed (_, error) | Backtracked (_, Some error); - _; - } -> - let*! () = Event.(emit2 dropping_operation) state op error in - failure := true ; - Lwt.return acc - | Apply_results.Manager_operation_result - { - operation_result = Applied _ | Backtracked (_, None) | Skipped _; - _; - } -> - (* Not known to be failing *) - Lwt.return (op :: acc) - | _ -> - (* Only manager operations *) - assert false) - [] - operations - results - in - if !failure then - (* Invariant: must_succeed = `At_least_one, otherwise the simulation would have - returned an error. We try to inject without the failing operation. *) - let operations = List.rev rev_non_failing_operations in - inject_operations ~must_succeed state operations - else - (* Inject on node for real *) - let+ oph = inject_on_node state packed_op in - (oph, operations) - - (** Returns the (upper bound on) the size of an L1 batch of operations composed - of the manager operations [rev_ops]. *) - let size_l1_batch state rev_ops = - let contents_list = - List.map - (fun (op : L1_operation.t) -> - let (Manager operation) = op.manager_operation in - let {fee; counter; gas_limit; storage_limit} = - Rollup.approximate_fee_bound state.rollup_node_state operation - in - let contents = - Manager_operation - { - source = state.signer.pkh; - operation; - fee; - counter; - gas_limit; - storage_limit; - } - in - Contents contents) - rev_ops - in - let (Contents_list contents) = - match Operation.of_list contents_list with - | Error _ -> - (* Cannot happen: rev_ops is non empty and contains only manager - operations *) - assert false - | Ok packed_contents_list -> packed_contents_list - in - let signature = Tezos_crypto.Signature.V0.zero in - let branch = Block_hash.zero in - let operation = - { - shell = {branch}; - protocol_data = Operation_data {contents; signature = Some signature}; - } - in - Data_encoding.Binary.length Operation.encoding operation - - (** Retrieve as many operations from the queue while remaining below the size - limit. *) - let get_operations_from_queue ~size_limit state = - let exception Reached_limit of L1_operation.t list in - let rev_ops = - try - Op_queue.fold - (fun _oph op ops -> - let new_ops = op :: ops in - let new_size = size_l1_batch state new_ops in - if new_size > size_limit then raise (Reached_limit ops) ; - new_ops) - state.queue - [] - with Reached_limit ops -> ops - in - List.rev rev_ops - - (* Ignore the failures of finalize and remove commitment operations. These - operations fail when there are either no commitment to finalize or to remove - (which can happen when there are no inbox for instance). *) - let ignore_ignorable_failing_operations operations = function - | Ok res -> Ok (`Injected res) - | Error _ as res -> - let open Result_syntax in - let+ operations_to_drop = - List.fold_left_e - (fun to_drop op -> - let (Manager operation) = op.L1_operation.manager_operation in - match Rollup.ignore_failing_operation operation with - | `Don't_ignore -> res - | `Ignore_keep -> Ok to_drop - | `Ignore_drop -> Ok (op :: to_drop)) - [] - operations - in - `Ignored operations_to_drop - - (** [inject_pending_operations_for ~size_limit state pending] injects - operations from the pending queue [pending], whose total size does - not exceed [size_limit]. Upon successful injection, the - operations are removed from the queue and marked as injected. *) - let inject_pending_operations - ?(size_limit = Constants.max_operation_data_length) state = - let open Lwt_result_syntax in - (* Retrieve and remove operations from pending *) - let operations_to_inject = get_operations_from_queue ~size_limit state in - match operations_to_inject with - | [] -> return_unit - | _ -> ( - let*! () = - Event.(emit1 injecting_pending) - state - (List.length operations_to_inject) - in - let must_succeed = - Rollup.batch_must_succeed - @@ List.map - (fun op -> op.L1_operation.manager_operation) - operations_to_inject - in - let*! res = - inject_operations ~must_succeed state operations_to_inject - in - let*? res = - ignore_ignorable_failing_operations operations_to_inject res - in - match res with - | `Injected (oph, injected_operations) -> - (* Injection succeeded, remove from pending and add to injected *) - let* () = - List.iter_es - (fun op -> Op_queue.remove state.queue op.L1_operation.hash) - injected_operations - in - add_injected_operations state oph operations_to_inject - | `Ignored operations_to_drop -> - (* Injection failed but we ignore the failure. *) - let* () = - List.iter_es - (fun op -> Op_queue.remove state.queue op.L1_operation.hash) - operations_to_drop - in - return_unit) - - (** [register_included_operation state block level oph] marks the manager - operations contained in the L1 batch [oph] as being included in the [block] - of level [level], by moving them from the "injected" state to the "included" - state. *) - let register_included_operation state block level oph = - let open Lwt_result_syntax in - let* rmed = remove_injected_operation state oph in - match rmed with - | [] -> return_unit - | injected_infos -> - let included_mops = - List.map (fun (i : injected_info) -> i.op) injected_infos - in - add_included_operations state oph block level included_mops - - (** [register_included_operations state block level oph] marks the known (by - this injector) manager operations contained in [block] as being included. *) - let register_included_operations state - (block : Alpha_block_services.block_info) = - List.iter_es - (List.iter_es (fun (op : Alpha_block_services.operation) -> - register_included_operation - state - block.hash - block.header.shell.level - op.hash - (* TODO/TORU: Handle operations for rollup_id here with - callback *))) - block.Alpha_block_services.operations - - (** [revert_included_operations state block] marks the known (by this injector) - manager operations contained in [block] as not being included any more, - typically in the case of a reorganization where [block] is on an alternative - chain. The operations are put back in the pending queue. *) - let revert_included_operations state block = - let open Lwt_result_syntax in - let* included_infos = remove_included_operation state block in - let*! () = - Event.(emit1 revert_operations) - state - (List.map (fun o -> o.op.hash) included_infos) - in - (* TODO/TORU: https://gitlab.com/tezos/tezos/-/issues/2814 - maybe put at the front of the queue for re-injection. *) - List.iter_es - (fun {op; _} -> - let {L1_operation.manager_operation = Manager mop; _} = op in - let*! requeue = - Rollup.requeue_reverted_operation state.rollup_node_state mop - in - if requeue then add_pending_operation state op else return_unit) - included_infos - - (** [register_confirmed_level state confirmed_level] is called when the level - [confirmed_level] is known as confirmed. In this case, the operations of - block which are below this level are also considered as confirmed and are - removed from the "included" state. These operations cannot be part of a - reorganization so there will be no need to re-inject them anymore. *) - let register_confirmed_level state confirmed_level = - let open Lwt_result_syntax in - let*! () = - Event.(emit confirmed_level) - (state.signer.pkh, state.tags, confirmed_level) - in - Included_in_blocks.iter_es - (fun block (level, _operations) -> - if level <= confirmed_level then - let* confirmed_ops = remove_included_operation state block in - let*! () = - Event.(emit2 confirmed_operations) - state - level - (List.map (fun o -> o.op.hash) confirmed_ops) - in - return_unit - else return_unit) - state.included.included_in_blocks - - (** [on_new_tezos_head state head reorg] is called when there is a new Tezos - head (with a potential reorganization [reorg]). It first reverts any blocks - that are in the alternative branch of the reorganization and then registers - the effect of the new branch (the newly included operation and confirmed - operations). *) - let on_new_tezos_head state (head : Alpha_block_services.block_info) - (reorg : Alpha_block_services.block_info reorg) = - let open Lwt_result_syntax in - let*! () = Event.(emit1 new_tezos_head) state head.hash in - let* () = - List.iter_es - (fun removed_block -> - revert_included_operations - state - removed_block.Alpha_block_services.hash) - (List.rev reorg.old_chain) - in - let* () = - List.iter_es - (fun added_block -> register_included_operations state added_block) - reorg.new_chain - in - (* Head is already included in the reorganization, so no need to process it - separately. *) - let confirmed_level = - Int32.sub - head.Alpha_block_services.header.shell.level - (Int32.of_int confirmations) - in - if confirmed_level >= 0l then register_confirmed_level state confirmed_level - else return_unit - - (* The request {Request.Inject} triggers an injection of the operations - the pending queue. *) - let on_inject state = inject_pending_operations state - - module Types = struct - type nonrec state = state - - type parameters = { - cctxt : Protocol_client_context.full; - data_dir : string; - rollup_node_state : Rollup.rollup_node_state; - strategy : injection_strategy; - tags : Tags.t; - } - end - - (* The worker for the injector. *) - module Worker = Worker.MakeSingle (Name) (Request) (Types) - - (* The queue for the requests to the injector worker is infinite. *) - type worker = Worker.infinite Worker.queue Worker.t - - let table = Worker.create_table Queue - - let tags_table = Tags_table.create 7 - - module Handlers = struct - type self = worker - - let on_request : - type r request_error. - worker -> - (r, request_error) Request.t -> - (r, request_error) result Lwt.t = - fun w request -> - let state = Worker.state w in - match request with - | Request.Add_pending op -> - (* The execution of the request handler is protected to avoid stopping the - worker in case of an exception. *) - protect @@ fun () -> add_pending_operation state op - | Request.New_tezos_head (head, reorg) -> - protect @@ fun () -> on_new_tezos_head state head reorg - | Request.Inject -> protect @@ fun () -> on_inject state - - type launch_error = error trace - - let on_launch _w signer - Types.{cctxt; data_dir; rollup_node_state; strategy; tags} = - init_injector cctxt ~data_dir rollup_node_state ~signer strategy tags - - let on_error (type a b) w st (r : (a, b) Request.t) (errs : b) : - unit tzresult Lwt.t = - let open Lwt_result_syntax in - let state = Worker.state w in - let request_view = Request.view r in - let emit_and_return_errors errs = - (* Errors do not stop the worker but emit an entry in the log. *) - let*! () = Event.(emit3 request_failed) state request_view st errs in - return_unit - in - match r with - | Request.Add_pending _ -> emit_and_return_errors errs - | Request.New_tezos_head _ -> emit_and_return_errors errs - | Request.Inject -> emit_and_return_errors errs - - let on_completion w r _ st = - let state = Worker.state w in - match Request.view r with - | Request.View (Add_pending _ | New_tezos_head _) -> - Event.(emit2 request_completed_debug) state (Request.view r) st - | View Inject -> - Event.(emit2 request_completed_notice) state (Request.view r) st - - let on_no_request _ = Lwt.return_unit - - let on_close w = - let state = Worker.state w in - Tags.iter (Tags_table.remove tags_table) state.tags ; - Lwt.return_unit - end - - (* TODO/TORU: https://gitlab.com/tezos/tezos/-/issues/2754 - Injector worker in a separate process *) - let init (cctxt : #Protocol_client_context.full) ~data_dir rollup_node_state - ~signers = - let open Lwt_result_syntax in - let signers_map = - List.fold_left - (fun acc (signer, strategy, tags) -> - let tags = Tags.of_list tags in - let strategy, tags = - match - Tezos_crypto.Signature.V0.Public_key_hash.Map.find_opt signer acc - with - | None -> (strategy, tags) - | Some (other_strategy, other_tags) -> - let strategy = - match (strategy, other_strategy) with - | `Each_block, `Each_block -> `Each_block - | `Delay_block, _ | _, `Delay_block -> - (* Delay_block strategy takes over because we can always wait a - little bit more to inject operation which are to be injected - "each block". *) - `Delay_block - in - (strategy, Tags.union other_tags tags) - in - Tezos_crypto.Signature.V0.Public_key_hash.Map.add - signer - (strategy, tags) - acc) - Tezos_crypto.Signature.V0.Public_key_hash.Map.empty - signers - in - Tezos_crypto.Signature.V0.Public_key_hash.Map.iter_es - (fun signer (strategy, tags) -> - let+ worker = - Worker.launch - table - signer - { - cctxt = (cctxt :> Protocol_client_context.full); - data_dir; - rollup_node_state; - strategy; - tags; - } - (module Handlers) - in - ignore worker) - signers_map - - let worker_of_signer signer_pkh = - match Worker.find_opt table signer_pkh with - | None -> - (* TODO: https://gitlab.com/tezos/tezos/-/issues/2818 - maybe lazily start worker here *) - error (No_worker_for_source signer_pkh) - | Some worker -> ok worker - - let worker_of_tag tag = - match Tags_table.find_opt tags_table tag with - | None -> - Format.kasprintf - (fun s -> error (No_worker_for_tag s)) - "%a" - Rollup.Tag.pp - tag - | Some worker -> ok worker - - let add_pending_operation ?source op = - let open Lwt_result_syntax in - let l1_operation = L1_operation.make op in - let*? w = - match source with - | Some source -> worker_of_signer source - | None -> ( - match Rollup.operation_tag op with - | None -> error (No_worker_for_operation l1_operation) - | Some tag -> worker_of_tag tag) - in - let*! (_pushed : bool) = - Worker.Queue.push_request w (Request.Add_pending l1_operation) - in - return_unit - - let new_tezos_head h reorg = - let open Lwt_syntax in - let workers = Worker.list table in - List.iter_p - (fun (_signer, w) -> - let* (_pushed : bool) = - Worker.Queue.push_request w (Request.New_tezos_head (h, reorg)) - in - return_unit) - workers - - let has_tag_in ~tags state = - match tags with - | None -> - (* Not filtering on tags *) - true - | Some tags -> not (Tags.disjoint state.tags tags) - - let has_strategy ~strategy state = - match strategy with - | None -> - (* Not filtering on strategy *) - true - | Some strategy -> state.strategy = strategy - - let inject ?tags ?strategy () = - let workers = Worker.list table in - let tags = Option.map Tags.of_list tags in - List.iter_p - (fun (_signer, w) -> - let open Lwt_syntax in - let worker_state = Worker.state w in - if has_tag_in ~tags worker_state && has_strategy ~strategy worker_state - then - let* _pushed = Worker.Queue.push_request w Request.Inject in - return_unit - else Lwt.return_unit) - workers - - let shutdown () = - let workers = Worker.list table in - List.iter_p (fun (_signer, w) -> Worker.shutdown w) workers -end diff --git a/src/proto_014_PtKathma/lib_injector/injector_functor.mli b/src/proto_014_PtKathma/lib_injector/injector_functor.mli deleted file mode 100644 index 183066b02a9a..000000000000 --- a/src/proto_014_PtKathma/lib_injector/injector_functor.mli +++ /dev/null @@ -1,29 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Injector_sigs - -module Make (P : PARAMETERS) : - S with type rollup_node_state := P.rollup_node_state and type tag := P.Tag.t diff --git a/src/proto_014_PtKathma/lib_injector/injector_sigs.ml b/src/proto_014_PtKathma/lib_injector/injector_sigs.ml deleted file mode 100644 index aad4ac33530e..000000000000 --- a/src/proto_014_PtKathma/lib_injector/injector_sigs.ml +++ /dev/null @@ -1,158 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol.Alpha_context - -(** Type to represent {e appoximate upper-bounds} for the fee and limits, used - to compute an upper bound on the size (in bytes) of an operation. *) -type approximate_fee_bound = { - fee : Tez.t; - counter : Z.t; - gas_limit : Gas.Arith.integral; - storage_limit : Z.t; -} - -type injection_strategy = - [ `Each_block (** Inject pending operations after each new L1 block *) - | `Delay_block - (** Wait for some time after the L1 block is produced to inject pending - operations. This strategy allows for maximizing the number of the same - kind of operations to include in a block. *) - ] - -(** Signature for tags used in injector *) -module type TAG = sig - include Stdlib.Set.OrderedType - - include Stdlib.Hashtbl.HashedType with type t := t - - val pp : Format.formatter -> t -> unit - - val encoding : t Data_encoding.t -end - -(** Module type for parameter of functor {!Injector_functor.Make}. *) -module type PARAMETERS = sig - (** The type of the state for the rollup node that the injector can access *) - type rollup_node_state - - (** A module which contains the different tags for the injector *) - module Tag : TAG - - (** Where to put the events for this injector *) - val events_section : string list - - (** Coarse approximation for the number of operation of each tag we expect to - inject for each block. *) - val table_estimated_size : Tag.t -> int - - (** [requeue_reverted_operation state op] should return [true] if an included - operation should be re-queued for injection when the block in which it is - included is reverted (due to a reorganization). *) - val requeue_reverted_operation : - rollup_node_state -> 'a manager_operation -> bool Lwt.t - - (** [ignore_failing_operation op] specifies if the injector should - ignore this operation when its simulation fails when trying to inject. - Returns: - - [`Ignore_keep] if the operation should be ignored but kept in the - pending queue, - - [`Ignore_drop] if the operation should be ignored and dropped from the - pending queue, - - [`Don't_ignore] if the failing operation should not be ignored and the - failure reported. - *) - val ignore_failing_operation : - 'a manager_operation -> [`Ignore_keep | `Ignore_drop | `Don't_ignore] - - (** The tag of a manager operation. This is used to send operations to the - correct queue automatically (when signer is not provided) and to recover - persistent information. *) - val operation_tag : 'a manager_operation -> Tag.t option - - (** Returns the {e appoximate upper-bounds} for the fee and limits of an - operation, used to compute an upper bound on the size (in bytes) for this - operation. *) - val approximate_fee_bound : - rollup_node_state -> 'a manager_operation -> approximate_fee_bound - - (** Returns the fee_parameter (to compute fee w.r.t. gas, size, etc.) and the - caps of fee and burn for each operation. *) - val fee_parameter : - rollup_node_state -> 'a manager_operation -> Injection.fee_parameter - - (** When injecting the given [operations] in an L1 batch, if - [batch_must_succeed operations] returns [`All] then all the operations must - succeed in the simulation of injection. If it returns [`At_least_one], at - least one operation in the list [operations] must be successful in the - simulation. In any case, only operations which are known as successful will - be included in the injected L1 batch. {b Note}: Returning [`At_least_one] - allows to incrementally build "or-batches" by iteratively removing - operations that fail from the desired batch. *) - val batch_must_succeed : - packed_manager_operation list -> [`All | `At_least_one] -end - -(** Output signature for functor {!Injector_functor.Make}. *) -module type S = sig - type rollup_node_state - - type tag - - (** Initializes the injector with the rollup node state, for a list of - signers, and start the workers. Each signer has its own worker with a - queue of operations to inject. *) - val init : - #Protocol_client_context.full -> - data_dir:string -> - rollup_node_state -> - signers:(public_key_hash * injection_strategy * tag list) list -> - unit tzresult Lwt.t - - (** Add an operation as pending injection in the injector. If the source is - not provided, the operation is queued to the worker which handles the - corresponding tag. *) - val add_pending_operation : - ?source:public_key_hash -> 'a manager_operation -> unit tzresult Lwt.t - - (** Notify the injector of a new Tezos head. The injector marks the operations - appropriately (for instance reverted operations that are part of a - reorganization are put back in the pending queue). When an operation is - considered as {e confirmed}, it disappears from the injector. *) - val new_tezos_head : - Protocol_client_context.Alpha_block_services.block_info -> - Protocol_client_context.Alpha_block_services.block_info Common.reorg -> - unit Lwt.t - - (** Trigger an injection of the pending operations for all workers. If [tags] - is given, only the workers which have a tag in [tags] inject their pending - operations. If [strategy] is given, only workers which have this strategy - inject their pending operations. *) - val inject : - ?tags:tag list -> ?strategy:injection_strategy -> unit -> unit Lwt.t - - (** Shutdown the injectors, waiting for the ongoing request to be processed. *) - val shutdown : unit -> unit Lwt.t -end diff --git a/src/proto_014_PtKathma/lib_injector/injector_tags.ml b/src/proto_014_PtKathma/lib_injector/injector_tags.ml deleted file mode 100644 index 1e92ff5de2cb..000000000000 --- a/src/proto_014_PtKathma/lib_injector/injector_tags.ml +++ /dev/null @@ -1,39 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -module Make (Tag : Injector_sigs.TAG) = struct - include Set.Make (Tag) - - let pp ppf tags = - Format.pp_print_list - ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ") - Tag.pp - ppf - (elements tags) - - let encoding = - let open Data_encoding in - conv elements of_list (list Tag.encoding) -end diff --git a/src/proto_014_PtKathma/lib_injector/injector_tags.mli b/src/proto_014_PtKathma/lib_injector/injector_tags.mli deleted file mode 100644 index 9efa6842376a..000000000000 --- a/src/proto_014_PtKathma/lib_injector/injector_tags.mli +++ /dev/null @@ -1,35 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Make a set of tags given a module for tags. *) -module Make (Tag : Injector_sigs.TAG) : sig - include Set.S with type elt = Tag.t - - (** Pretty print a set of tags *) - val pp : Format.formatter -> t -> unit - - (** Encoding for sets of tags *) - val encoding : t Data_encoding.t -end diff --git a/src/proto_014_PtKathma/lib_injector/injector_worker_types.ml b/src/proto_014_PtKathma/lib_injector/injector_worker_types.ml deleted file mode 100644 index f64be4e54cf5..000000000000 --- a/src/proto_014_PtKathma/lib_injector/injector_worker_types.ml +++ /dev/null @@ -1,108 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol_client_context -open Protocol -open Alpha_context -open Common - -module Request = struct - type ('a, 'b) t = - | Add_pending : L1_operation.t -> (unit, error trace) t - | New_tezos_head : - Alpha_block_services.block_info * Alpha_block_services.block_info reorg - -> (unit, error trace) t - | Inject : (unit, error trace) t - - type view = View : _ t -> view - - let view req = View req - - let encoding = - let open Data_encoding in - union - [ - case - (Tag 0) - ~title:"Add_pending" - (merge_objs - (obj1 (req "request" (constant "add_pending"))) - L1_operation.encoding) - (function View (Add_pending op) -> Some ((), op) | _ -> None) - (fun ((), op) -> View (Add_pending op)); - case - (Tag 1) - ~title:"New_tezos_head" - (obj3 - (req "request" (constant "new_tezos_head")) - (req "head" Alpha_block_services.block_info_encoding) - (req - "reorg" - (reorg_encoding Alpha_block_services.block_info_encoding))) - (function - | View (New_tezos_head (b, r)) -> Some ((), b, r) | _ -> None) - (fun ((), b, r) -> View (New_tezos_head (b, r))); - case - (Tag 2) - ~title:"Inject" - (obj1 (req "request" (constant "inject"))) - (function View Inject -> Some () | _ -> None) - (fun () -> View Inject); - ] - - let pp ppf (View r) = - match r with - | Add_pending op -> - Format.fprintf - ppf - "request add %a to pending queue" - L1_operation.Hash.pp - op.hash - | New_tezos_head (b, r) -> - Format.fprintf - ppf - "switching to new Tezos head %a" - Block_hash.pp - b.Alpha_block_services.hash ; - if r.old_chain <> [] || r.new_chain <> [] then - Format.fprintf - ppf - ", with reorg of -%d +%d" - (List.length r.old_chain) - (List.length r.new_chain) - | Inject -> Format.fprintf ppf "injection" -end - -module Name = struct - type t = public_key_hash - - let encoding = Tezos_crypto.Signature.V0.Public_key_hash.encoding - - let base = ["tx_rollup_injector"] - - let pp = Tezos_crypto.Signature.V0.Public_key_hash.pp_short - - let equal = Tezos_crypto.Signature.V0.Public_key_hash.equal -end diff --git a/src/proto_014_PtKathma/lib_injector/injector_worker_types.mli b/src/proto_014_PtKathma/lib_injector/injector_worker_types.mli deleted file mode 100644 index 8ad0632927e8..000000000000 --- a/src/proto_014_PtKathma/lib_injector/injector_worker_types.mli +++ /dev/null @@ -1,47 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol_client_context -open Protocol -open Alpha_context -open Common - -module Request : sig - type ('a, 'b) t = - | Add_pending : L1_operation.t -> (unit, error trace) t - | New_tezos_head : - Alpha_block_services.block_info * Alpha_block_services.block_info reorg - -> (unit, error trace) t - | Inject : (unit, error trace) t - - type view = View : _ t -> view - - include - Worker_intf.REQUEST - with type ('a, 'request_error) t := ('a, 'request_error) t - and type view := view -end - -module Name : Worker_intf.NAME with type t = public_key_hash diff --git a/src/proto_014_PtKathma/lib_injector/l1_operation.ml b/src/proto_014_PtKathma/lib_injector/l1_operation.ml deleted file mode 100644 index a023725ebd35..000000000000 --- a/src/proto_014_PtKathma/lib_injector/l1_operation.ml +++ /dev/null @@ -1,206 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context - -module Manager_operation = struct - type t = packed_manager_operation - - let encoding : t Data_encoding.t = - let open Data_encoding in - let open Operation.Encoding.Manager_operations in - let make (MCase {tag; name; encoding; select; proj; inj}) = - case - (Tag tag) - ~title:name - (merge_objs (obj1 (req "kind" (constant name))) encoding) - (fun o -> - match select o with None -> None | Some o -> Some ((), proj o)) - (fun ((), x) -> Manager (inj x)) - in - def "manager_operation" - @@ union - [ - make reveal_case; - make transaction_case; - make origination_case; - make delegation_case; - make set_deposits_limit_case; - make increase_paid_storage_case; - make register_global_constant_case; - make tx_rollup_origination_case; - make tx_rollup_submit_batch_case; - make tx_rollup_commit_case; - make tx_rollup_return_bond_case; - make tx_rollup_finalize_commitment_case; - make tx_rollup_remove_commitment_case; - make tx_rollup_rejection_case; - make tx_rollup_dispatch_tickets_case; - make transfer_ticket_case; - make dal_publish_slot_header_case; - make sc_rollup_originate_case; - make sc_rollup_add_messages_case; - make sc_rollup_cement_case; - make sc_rollup_publish_case; - make sc_rollup_refute_case; - make sc_rollup_timeout_case; - make sc_rollup_execute_outbox_message_case; - ] - - let get_case : - type kind. - kind manager_operation -> kind Operation.Encoding.Manager_operations.case - = - let open Operation.Encoding.Manager_operations in - function - | Reveal _ -> reveal_case - | Transaction _ -> transaction_case - | Origination _ -> origination_case - | Delegation _ -> delegation_case - | Register_global_constant _ -> register_global_constant_case - | Set_deposits_limit _ -> set_deposits_limit_case - | Increase_paid_storage _ -> increase_paid_storage_case - | Tx_rollup_origination -> tx_rollup_origination_case - | Tx_rollup_submit_batch _ -> tx_rollup_submit_batch_case - | Tx_rollup_commit _ -> tx_rollup_commit_case - | Tx_rollup_return_bond _ -> tx_rollup_return_bond_case - | Tx_rollup_finalize_commitment _ -> tx_rollup_finalize_commitment_case - | Tx_rollup_remove_commitment _ -> tx_rollup_remove_commitment_case - | Tx_rollup_rejection _ -> tx_rollup_rejection_case - | Tx_rollup_dispatch_tickets _ -> tx_rollup_dispatch_tickets_case - | Transfer_ticket _ -> transfer_ticket_case - | Dal_publish_slot_header _ -> dal_publish_slot_header_case - | Sc_rollup_originate _ -> sc_rollup_originate_case - | Sc_rollup_add_messages _ -> sc_rollup_add_messages_case - | Sc_rollup_cement _ -> sc_rollup_cement_case - | Sc_rollup_publish _ -> sc_rollup_publish_case - | Sc_rollup_refute _ -> sc_rollup_refute_case - | Sc_rollup_timeout _ -> sc_rollup_timeout_case - | Sc_rollup_execute_outbox_message _ -> - sc_rollup_execute_outbox_message_case - | Sc_rollup_recover_bond _ -> sc_rollup_recover_bond_case - | Sc_rollup_dal_slot_subscribe _ -> sc_rollup_dal_slot_subscribe_case - - let pp_kind ppf op = - let open Operation.Encoding.Manager_operations in - let (MCase {name; _}) = get_case op in - Format.pp_print_string ppf name - - let pp ppf (Manager op) = - match op with - | Tx_rollup_commit {commitment = {level; _}; _} -> - Format.fprintf - ppf - "commitment for rollup level %a" - Tx_rollup_level.pp - level - | Tx_rollup_rejection {level; message_position; _} -> - Format.fprintf - ppf - "rejection for commitment at level %a for message %d" - Tx_rollup_level.pp - level - message_position - | Tx_rollup_dispatch_tickets {level; tickets_info; _} -> - let pp_rollup_reveal ppf - Tx_rollup_reveal.{contents; ty; amount; ticketer; claimer; _} = - let pp_lazy_expr ppf e = - Michelson_v1_printer.print_expr_unwrapped - ppf - (Result.value - (Script_repr.force_decode e) - ~default:(Micheline.strip_locations (Micheline.Seq ((), [])))) - in - Format.fprintf - ppf - "%a tickets (%a, %a, %a) to %a" - Tx_rollup_l2_qty.pp - amount - Contract.pp - ticketer - pp_lazy_expr - ty - pp_lazy_expr - contents - Tezos_crypto.Signature.V0.Public_key_hash.pp - claimer - in - Format.fprintf - ppf - "@[dispatch withdrawals at rollup level %a: %a@]" - Tx_rollup_level.pp - level - (Format.pp_print_list pp_rollup_reveal) - tickets_info - | _ -> pp_kind ppf op -end - -module Hash = - Tezos_crypto.Blake2B.Make - (Tezos_crypto.Base58) - (struct - let name = "manager_operation_hash" - - let title = "A manager operation hash" - - let b58check_prefix = "\068\160\013" (* mop(53) *) - - let size = None - end) - -let () = - Tezos_crypto.Base58.check_encoded_prefix Hash.b58check_encoding "mop" 53 - -type hash = Hash.t - -type t = {hash : hash; manager_operation : packed_manager_operation} - -let hash_manager_operation op = - Hash.hash_bytes - [Data_encoding.Binary.to_bytes_exn Manager_operation.encoding op] - -let make manager_operation = - let manager_operation = Manager manager_operation in - let hash = hash_manager_operation manager_operation in - {hash; manager_operation} - -let encoding = - let open Data_encoding in - conv - (fun {hash; manager_operation} -> (hash, manager_operation)) - (fun (hash, manager_operation) -> {hash; manager_operation}) - @@ obj2 - (req "hash" Hash.encoding) - (req "manager_operation" Manager_operation.encoding) - -let pp ppf {hash; manager_operation} = - Format.fprintf - ppf - "%a (%a)" - Manager_operation.pp - manager_operation - Hash.pp - hash diff --git a/src/proto_014_PtKathma/lib_injector/l1_operation.mli b/src/proto_014_PtKathma/lib_injector/l1_operation.mli deleted file mode 100644 index 6dc5bdeb9cd8..000000000000 --- a/src/proto_014_PtKathma/lib_injector/l1_operation.mli +++ /dev/null @@ -1,48 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2022 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol.Alpha_context - -(** Hash with b58check encoding mop(53), for hashes of L1 manager operations *) -module Hash : Tezos_crypto.Intfs.HASH - -(** Alias for L1 operations hashes *) -type hash = Hash.t - -(** The type of L1 operations that are injected on Tezos by the rollup node *) -type t = private { - hash : hash; (** The hash of the L1 manager operation (without the source) *) - manager_operation : packed_manager_operation; (** The manager operation *) -} - -(** [make op] returns an L1 operation with the corresponding hash. *) -val make : 'a manager_operation -> t - -(** Encoding for L1 operations *) -val encoding : t Data_encoding.t - -(** Pretty printer for L1 operations. Only the relevant part for the rollup node - is printed. *) -val pp : Format.formatter -> t -> unit -- GitLab From da9ed5a6464ca39f42717661bea4388dbcf08a55 Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Fri, 3 Feb 2023 16:28:24 +0100 Subject: [PATCH 2/8] Injector: parameterize by protocol client Used for simulating and injecting operations. --- .../lib_injector/injector_functor.ml | 328 ++++++------------ .../lib_injector/injector_functor.mli | 6 +- src/proto_alpha/lib_injector/injector_sigs.ml | 81 ++++- 3 files changed, 184 insertions(+), 231 deletions(-) diff --git a/src/proto_alpha/lib_injector/injector_functor.ml b/src/proto_alpha/lib_injector/injector_functor.ml index 6c5f2c1cffd1..a44087186742 100644 --- a/src/proto_alpha/lib_injector/injector_functor.ml +++ b/src/proto_alpha/lib_injector/injector_functor.ml @@ -54,59 +54,12 @@ let injector_context (cctxt : #Protocol_client_context.full) = Format.ksprintf Stdlib.failwith "Injector client wants to exit %d" code end -let manager_operation_result_status (type kind) - (op_result : kind Apply_results.manager_operation_result) : operation_status - = - match op_result with - | Applied _ -> Successful - | Backtracked (_, None) -> Unsuccessful Backtracked - | Skipped _ -> Unsuccessful Skipped - | Backtracked (_, Some err) - (* Backtracked because internal operation failed *) - | Failed (_, err) -> - Unsuccessful (Failed (Environment.wrap_tztrace err)) - -let operation_result_status (type kind) - (op_result : kind Apply_results.contents_result) : operation_status = - match op_result with - | Preendorsement_result _ -> Successful - | Endorsement_result _ -> Successful - | Dal_attestation_result _ -> Successful - | Seed_nonce_revelation_result _ -> Successful - | Vdf_revelation_result _ -> Successful - | Double_endorsement_evidence_result _ -> Successful - | Double_preendorsement_evidence_result _ -> Successful - | Double_baking_evidence_result _ -> Successful - | Activate_account_result _ -> Successful - | Proposals_result -> Successful - | Ballot_result -> Successful - | Drain_delegate_result _ -> Successful - | Manager_operation_result {operation_result; _} -> - manager_operation_result_status operation_result - -let operation_contents_status (type kind) - (contents : kind Apply_results.contents_result_list) ~index : - operation_status tzresult = - let rec rec_status : - type kind. int -> kind Apply_results.contents_result_list -> _ = - fun n -> function - | Apply_results.Single_result _ when n <> 0 -> - error_with "No operation with index %d" index - | Single_result result -> Ok (operation_result_status result) - | Cons_result (result, _rest) when n = 0 -> - Ok (operation_result_status result) - | Cons_result (_result, rest) -> rec_status (n - 1) rest - in - rec_status index contents - -let operation_status (operation : Protocol.operation_receipt) ~index : - operation_status tzresult = - match (operation : _) with - | No_operation_metadata -> - error_with "Cannot find operation status because metadata is missing" - | Operation_metadata {contents} -> operation_contents_status contents ~index - -module Make (Parameters : PARAMETERS) = struct +module Make + (Parameters : PARAMETERS) + (Proto_client : PROTOCOL_CLIENT + with type state := Parameters.state + and type operation := Parameters.Operation.t) = +struct module Tags = Injector_tags.Make (Parameters.Tag) module Tags_table = Hashtbl.Make (Parameters.Tag) module POperation = Parameters.Operation @@ -506,34 +459,32 @@ module Make (Parameters : PARAMETERS) = struct List.fold_left (fun acc {Inj_operation.operation; _} -> let param = Parameters.fee_parameter state operation in - Injection. - { - minimal_fees = Tez.max acc.minimal_fees param.minimal_fees; - minimal_nanotez_per_byte = - Q.max acc.minimal_nanotez_per_byte param.minimal_nanotez_per_byte; - minimal_nanotez_per_gas_unit = - Q.max - acc.minimal_nanotez_per_gas_unit - param.minimal_nanotez_per_gas_unit; - force_low_fee = acc.force_low_fee || param.force_low_fee; - fee_cap = - WithExceptions.Result.get_ok - ~loc:__LOC__ - Tez.(acc.fee_cap +? param.fee_cap); - burn_cap = - WithExceptions.Result.get_ok - ~loc:__LOC__ - Tez.(acc.burn_cap +? param.burn_cap); - }) - Injection. { - minimal_fees = Tez.zero; - minimal_nanotez_per_byte = Q.zero; - minimal_nanotez_per_gas_unit = Q.zero; - force_low_fee = false; - fee_cap = Tez.zero; - burn_cap = Tez.zero; - } + minimal_fees = Tez.max acc.minimal_fees param.minimal_fees; + minimal_nanotez_per_byte = + Q.max acc.minimal_nanotez_per_byte param.minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit = + Q.max + acc.minimal_nanotez_per_gas_unit + param.minimal_nanotez_per_gas_unit; + force_low_fee = acc.force_low_fee || param.force_low_fee; + fee_cap = + WithExceptions.Result.get_ok + ~loc:__LOC__ + Tez.(acc.fee_cap +? param.fee_cap); + burn_cap = + WithExceptions.Result.get_ok + ~loc:__LOC__ + Tez.(acc.burn_cap +? param.burn_cap); + }) + { + minimal_fees = Tez.zero; + minimal_nanotez_per_byte = Q.zero; + minimal_nanotez_per_gas_unit = Q.zero; + force_low_fee = false; + fee_cap = Tez.zero; + burn_cap = Tez.zero; + } ops (** Returns the first half of the list [ops] if there is more than two @@ -551,7 +502,6 @@ module Make (Parameters : PARAMETERS) = struct let rec simulate_operations ~must_succeed state (operations : Inj_operation.t list) = let open Lwt_result_syntax in - let open Annotated_manager_operation in let force = match operations with | [] -> assert false @@ -563,114 +513,67 @@ module Make (Parameters : PARAMETERS) = struct succeed *) match must_succeed with `All -> false | `At_least_one -> true) in - let*! () = - Event.(emit2 simulating_operations) - state - (List.map (fun o -> o.Inj_operation.operation) operations) - force + let op_operations = + List.map (fun o -> o.Inj_operation.operation) operations in + let*! () = Event.(emit2 simulating_operations) state op_operations force in let fee_parameter = fee_parameter_of_operations state.state operations in - let annotated_operations = - List.map - (fun {Inj_operation.operation; _} -> - let (Manager operation) = POperation.to_manager_operation operation in - Annotated_manager_operation - (Injection.prepare_manager_operation - ~fee:Limit.unknown - ~gas_limit:Limit.unknown - ~storage_limit:Limit.unknown - operation)) - operations - in - let (Manager_list annot_op) = - Annotated_manager_operation.manager_of_list annotated_operations - in let*! simulation_result = - Injection.inject_manager_operation + Proto_client.simulate_operations state.cctxt - ~simulation:true (* Only simulation here *) ~force - ~chain:state.cctxt#chain - ~block:(`Head 0) ~source:state.signer.pkh ~src_pk:state.signer.pk - ~src_sk:state.signer.sk ~successor_level:true - (* Operations are simulated in the next block, which is important for rollups - and ok for other applications. *) - ~fee:Limit.unknown - ~gas_limit:Limit.unknown - ~storage_limit:Limit.unknown + (* Operations are simulated in the next block, which is important for + rollups and ok for other applications. *) ~fee_parameter - annot_op + op_operations in match simulation_result with - | Error trace -> + | Error (`TzError trace) -> fail trace + | Error (`Exceeds_quotas trace) -> ( let*! () = Event.(emit1 number_of_operations_in_queue) state (Op_queue.length state.queue) in - let exceeds_quota = - TzTrace.fold - (fun exceeds -> function - | Environment.Ecoproto_error - (Gas.Block_quota_exceeded | Gas.Operation_quota_exceeded) -> - true - | _ -> exceeds) - false - trace - in - if exceeds_quota then - (* We perform a dichotomy by injecting the first half of the - operations (we are not looking to maximize the number of operations - injected because of the cost of simulation). Only the operations - which are actually injected will be removed from the queue so the - other half will be reconsidered later. *) - match keep_half operations with - | None -> fail trace - | Some operations -> - simulate_operations ~must_succeed state operations - else fail trace - | Ok (_, op, _, result) -> - let nb_ops = List.length operations in - let nb_packed_ops = - let {protocol_data = Operation_data {contents; _}; _} = op in - Alpha_context.Operation.to_list (Contents_list contents) - |> List.length - in - (* packed_op can have reveal operations added automatically. *) - let start_index = nb_packed_ops - nb_ops in - (* Add indexes of operations in the packed, i.e. batched, operation. *) - let operations = - List.mapi (fun i op -> (i + start_index, op)) operations + (* We perform a dichotomy by injecting the first half of the + operations (we are not looking to maximize the number of operations + injected because of the cost of simulation). Only the operations + which are actually injected will be removed from the queue so the + other half will be reconsidered later. *) + match keep_half operations with + | None -> + fail + @@ TzTrace.cons + (Exn (Failure "Quotas exceeded when simulating one operation")) + trace + | Some operations -> simulate_operations ~must_succeed state operations) + | Ok {operations_statuses; unsigned_operation} -> + let*? results = + List.combine + ~when_different_lengths: + [ + Exn + (Failure + "Injector: Not the same number of results as operations \ + in simulation."); + ] + operations + operations_statuses in - return (op, operations, Apply_results.Contents_result_list result) + return (results, unsigned_operation) - let inject_on_node state ~nb - {shell; protocol_data = Operation_data {contents; _}} = + let inject_on_node state ~nb unsigned_op = let open Lwt_result_syntax in - let unsigned_op = (shell, Contents_list contents) in - let unsigned_op_bytes = - Data_encoding.Binary.to_bytes_exn Operation.unsigned_encoding unsigned_op - in - let* signature = - Client_keys.sign - state.cctxt - ~watermark:Signature.Generic_operation - state.signer.sk - unsigned_op_bytes - in - let op : _ Operation.t = - {shell; protocol_data = {contents; signature = Some signature}} - in - let op_bytes = - Data_encoding.Binary.to_bytes_exn Operation.encoding (Operation.pack op) + let* signed_op_bytes = + Proto_client.sign_operation state.cctxt state.signer.sk unsigned_op in Tezos_shell_services.Shell_services.Injection.operation state.cctxt ~chain:state.cctxt#chain - op_bytes + signed_op_bytes >>=? fun oph -> let*! () = Event.(emit2 injected) state nb oph in return oph @@ -686,32 +589,30 @@ module Make (Parameters : PARAMETERS) = struct let rec inject_operations ~must_succeed state (operations : Inj_operation.t list) = let open Lwt_result_syntax in - let* packed_op, operations, result = + let* operations_results, raw_op = trace (Step_failed "simulation") @@ simulate_operations ~must_succeed state operations in - let (Contents_result_list contents_result) = result in let failure = ref false in - let* rev_non_failing_operations = - List.fold_left_es - (fun acc (index, op) -> - let open Lwt_result_syntax in - let*? status = operation_contents_status contents_result ~index in + let*! rev_non_failing_operations = + List.fold_left_s + (fun acc (op, {status; _}) -> + let open Lwt_syntax in match status with | Unsuccessful (Failed error) -> - let*! () = + let+ () = Event.(emit2 dropping_operation) state op.Inj_operation.operation error in failure := true ; - return acc + acc | Successful | Unsuccessful (Backtracked | Skipped | Other_branch) -> (* Not known to be failing *) return (op :: acc)) [] - operations + operations_results in if !failure then (* Invariant: must_succeed = `At_least_one, otherwise the simulation would @@ -723,7 +624,12 @@ module Make (Parameters : PARAMETERS) = struct (* Inject on node for real *) let+ oph = trace (Step_failed "injection") - @@ inject_on_node ~nb:(List.length operations) state packed_op + @@ inject_on_node ~nb:(List.length operations) state raw_op + in + let operations = + List.map + (fun (op, {index_in_batch; _}) -> (index_in_batch, op)) + operations_results in (oph, operations) @@ -877,10 +783,9 @@ module Make (Parameters : PARAMETERS) = struct of level [level], by moving the successful ones from the "injected" state to the "included" state, and re-queuing the operations that should be retried. *) - let register_included_operation state block level - (operation : Alpha_block_services.operation) = + let register_included_operation state block level oph = let open Lwt_result_syntax in - let* injected_infos = remove_injected_operation state operation.hash in + let* injected_infos = remove_injected_operation state oph in match injected_infos with | [] -> (* No operations injected by us *) @@ -889,24 +794,20 @@ module Make (Parameters : PARAMETERS) = struct let* included, to_retry = List.fold_left_es (fun (included, to_retry) (info : injected_info) -> - let*? receipt = - match operation.receipt with - | Empty -> - error_with - "Empty receipt for %a" - Operation_hash.pp - operation.hash - | Too_large -> - error_with - "Receipt too large for %a" - Operation_hash.pp - operation.hash - | Receipt r -> Ok r + let* status = + Proto_client.operation_status + state.state + block + oph + ~index:info.op_index in - let*? status = operation_status receipt ~index:info.op_index in match status with - | Successful -> return (info :: included, to_retry) - | Unsuccessful status -> ( + | None -> + failwith + "Cannot get status for an operation which is not included \ + in the block" + | Some Successful -> return (info :: included, to_retry) + | Some (Unsuccessful status) -> ( let*! retry = Parameters.retry_unsuccessful_operation state.state @@ -937,7 +838,7 @@ module Make (Parameters : PARAMETERS) = struct state block.hash block.header.shell.level - op)) + op.hash)) block.Alpha_block_services.operations (** [revert_included_operations state block] marks the known (by this injector) @@ -1217,37 +1118,6 @@ module Make (Parameters : PARAMETERS) = struct true | Some tags -> not (Tags.disjoint state.tags tags) - let time_until_next_block constants (header : Tezos_base.Block_header.t) = - let open Result_syntax in - let Constants.Parametric.{minimal_block_delay; delay_increment_per_round; _} - = - constants.Constants.parametric - in - let next_level_timestamp = - let* durations = - Round.Durations.create - ~first_round_duration:minimal_block_delay - ~delay_increment_per_round - in - let* predecessor_round = Fitness.round_from_raw header.shell.fitness in - Round.timestamp_of_round - durations - ~predecessor_timestamp:header.shell.timestamp - ~predecessor_round - ~round:Round.zero - in - let next_level_timestamp = - Result.value - next_level_timestamp - ~default: - (WithExceptions.Result.get_ok - ~loc:__LOC__ - Timestamp.(header.shell.timestamp +? minimal_block_delay)) - in - Ptime.diff - (Time.System.of_protocol_exn next_level_timestamp) - (Time.System.now ()) - let delay_stategy state header f = let open Lwt_syntax in match state.strategy with @@ -1259,7 +1129,7 @@ module Make (Parameters : PARAMETERS) = struct state.constants.Constants.parametric.minimal_block_delay |> Period.to_seconds |> Int64.to_float | Some header -> - time_until_next_block state.constants header + Proto_client.time_until_next_block state.constants header |> Ptime.Span.to_float_s in let delay = time_until_next_block *. delay_factor in diff --git a/src/proto_alpha/lib_injector/injector_functor.mli b/src/proto_alpha/lib_injector/injector_functor.mli index 1c7d4f7c8f8c..ab5786a67469 100644 --- a/src/proto_alpha/lib_injector/injector_functor.mli +++ b/src/proto_alpha/lib_injector/injector_functor.mli @@ -25,7 +25,11 @@ open Injector_sigs -module Make (P : PARAMETERS) : +module Make + (P : PARAMETERS) + (_ : PROTOCOL_CLIENT + with type state := P.state + and type operation := P.Operation.t) : S with type state := P.state and type tag := P.Tag.t diff --git a/src/proto_alpha/lib_injector/injector_sigs.ml b/src/proto_alpha/lib_injector/injector_sigs.ml index f763dee30a82..613e3ec58f25 100644 --- a/src/proto_alpha/lib_injector/injector_sigs.ml +++ b/src/proto_alpha/lib_injector/injector_sigs.ml @@ -34,6 +34,15 @@ type approximate_fee_bound = { storage_limit : Z.t; } +type fee_parameter = { + minimal_fees : Tez.t; + minimal_nanotez_per_byte : Q.t; + minimal_nanotez_per_gas_unit : Q.t; + force_low_fee : bool; + fee_cap : Tez.t; + burn_cap : Tez.t; +} + type injection_strategy = [ `Each_block (** Inject pending operations after each new L1 block *) | `Delay_block of float @@ -58,6 +67,13 @@ type unsuccessful_status = type operation_status = Successful | Unsuccessful of unsuccessful_status +type simulation_status = {index_in_batch : int; status : operation_status} + +type 'unsigned_op simulation_result = { + operations_statuses : simulation_status list; + unsigned_operation : 'unsigned_op; +} + (** Action to be taken for unsuccessful operation. *) type retry_action = | Retry (** The operation is retried by being re-queued for injection. *) @@ -151,7 +167,7 @@ module type PARAMETERS = sig (** Returns the fee_parameter (to compute fee w.r.t. gas, size, etc.) and the caps of fee and burn for each operation. *) - val fee_parameter : state -> Operation.t -> Injection.fee_parameter + val fee_parameter : state -> Operation.t -> fee_parameter (** When injecting the given [operations] in an L1 batch, if [batch_must_succeed operations] returns [`All] then all the operations must @@ -164,6 +180,69 @@ module type PARAMETERS = sig val batch_must_succeed : Operation.t list -> [`All | `At_least_one] end +module type PROTOCOL_CLIENT = sig + type state + + type operation + + type unsigned_operation + + (** The validation pass of manager operations. *) + val manager_pass : int + + (** [operation_status block oph ~index] returns the status of the operation at + position [index] in the L1 batch [oph] included in the block [block]. It + returns [None] if the operation with the given index is not in the + block. *) + val operation_status : + state -> + Block_hash.t -> + Operation_hash.t -> + index:int -> + operation_status option tzresult Lwt.t + + (** Size of an operation in bytes according to the protocol. This only + accounts for the actual content of the corresponding manager operation + (and not its fees, gas, etc.). *) + val operation_size : operation -> int + + (** An upper bound of the overhead added to manager operations in + bytes. Typically, this would include the source, fees, counter, gas limit, + and storage limit. *) + val operation_size_overhead : int + + (** Simulating a batch of operations. This function returns the simulation + result for each of these operations (with its associated index in the + batch, in case there is a revelation operation added) together with a + Tezos raw unsigned operation that can be directly injected on a node if + one wishes to. *) + val simulate_operations : + #Client_context.full -> + force:bool -> + source:Signature.public_key_hash -> + src_pk:Signature.public_key -> + successor_level:bool -> + fee_parameter:fee_parameter -> + operation list -> + ( unsigned_operation simulation_result, + [`Exceeds_quotas of tztrace | `TzError of tztrace] ) + result + Lwt.t + + (** Sign an unsigned operation an return the serialized signed operation, + ready for injection. *) + val sign_operation : + #Client_context.full -> + Client_keys.sk_uri -> + unsigned_operation -> + bytes tzresult Lwt.t + + (** [time_until_next_block state block_header] computes the time until the + block following [block_header], with respect to the current time. *) + val time_until_next_block : + state -> Tezos_base.Block_header.t option -> Ptime.span +end + (** Output signature for functor {!Injector_functor.Make}. *) module type S = sig type state -- GitLab From b2ed2bcc827ed9c240b9881111eaacb1573c6c90 Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Sat, 4 Feb 2023 00:30:20 +0100 Subject: [PATCH 3/8] Injector: reorg messages contain just block hashes and levels --- .../lib_injector/injector_functor.ml | 58 +++++++++++-------- src/proto_alpha/lib_injector/injector_sigs.ml | 5 +- .../lib_injector/injector_worker_types.ml | 25 ++++---- .../lib_injector/injector_worker_types.mli | 7 +-- 4 files changed, 50 insertions(+), 45 deletions(-) diff --git a/src/proto_alpha/lib_injector/injector_functor.ml b/src/proto_alpha/lib_injector/injector_functor.ml index a44087186742..c2f4cb57c406 100644 --- a/src/proto_alpha/lib_injector/injector_functor.ml +++ b/src/proto_alpha/lib_injector/injector_functor.ml @@ -23,13 +23,15 @@ (* *) (*****************************************************************************) -open Protocol_client_context open Protocol open Alpha_context open Injector_common open Injector_worker_types open Injector_sigs open Injector_errors +module Block_cache = + Aches_lwt.Lache.Make_result + (Aches.Rache.Transfer (Aches.Rache.LRU) (Block_hash)) (* This is the Tenderbake finality for blocks. *) (* TODO: https://gitlab.com/tezos/tezos/-/issues/2815 @@ -828,18 +830,32 @@ struct (add_pending_operation ~retry:true state) (List.rev to_retry) - (** [register_included_operations state block level oph] marks the known (by - this injector) manager operations contained in [block] as being included. *) - let register_included_operations state - (block : Alpha_block_services.block_info) = + (** Retrieve operation hashes of a block with a small LRU cache. *) + let manager_operations_hashes_of_block = + let blocks_ops_cache = Block_cache.create 32 in + fun state block_hash -> + Block_cache.bind_or_put + blocks_ops_cache + block_hash + (fun block_hash -> + Tezos_shell_services.Shell_services.Blocks.Operation_hashes + .operation_hashes_in_pass + state.cctxt + ~chain:state.cctxt#chain + ~block:(`Hash (block_hash, 0)) + Proto_client.manager_pass) + Lwt.return + + (** [register_included_operations state (block, level)] marks the known (by + this injector) manager operations contained in [block] as being included. *) + let register_included_operations state (block_hash, level) = + let open Lwt_result_syntax in + let* operation_hashes = + manager_operations_hashes_of_block state block_hash + in List.iter_es - (List.iter_es (fun (op : Alpha_block_services.operation) -> - register_included_operation - state - block.hash - block.header.shell.level - op.hash)) - block.Alpha_block_services.operations + (fun oph -> register_included_operation state block_hash level oph) + operation_hashes (** [revert_included_operations state block] marks the known (by this injector) manager operations contained in [block] as not being included any more, @@ -895,16 +911,14 @@ struct that are in the alternative branch of the reorganization and then registers the effect of the new branch (the newly included operation and confirmed operations). *) - let on_new_tezos_head state (head : Alpha_block_services.block_info) - (reorg : Alpha_block_services.block_info reorg) = + let on_new_tezos_head state (head_hash, head_level) + (reorg : (Block_hash.t * int32) reorg) = let open Lwt_result_syntax in - let*! () = Event.(emit1 new_tezos_head) state head.hash in + let*! () = Event.(emit1 new_tezos_head) state head_hash in let* () = List.iter_es - (fun removed_block -> - revert_included_operations - state - removed_block.Alpha_block_services.hash) + (fun (removed_block, _) -> + revert_included_operations state removed_block) (List.rev reorg.old_chain) in let* () = @@ -914,11 +928,7 @@ struct in (* Head is already included in the reorganization, so no need to process it separately. *) - let confirmed_level = - Int32.sub - head.Alpha_block_services.header.shell.level - (Int32.of_int confirmations) - in + let confirmed_level = Int32.sub head_level (Int32.of_int confirmations) in if confirmed_level >= 0l then register_confirmed_level state confirmed_level else return_unit diff --git a/src/proto_alpha/lib_injector/injector_sigs.ml b/src/proto_alpha/lib_injector/injector_sigs.ml index 613e3ec58f25..e3ff7965d42a 100644 --- a/src/proto_alpha/lib_injector/injector_sigs.ml +++ b/src/proto_alpha/lib_injector/injector_sigs.ml @@ -319,9 +319,8 @@ module type S = sig reorganization are put back in the pending queue). When an operation is considered as {e confirmed}, it disappears from the injector. *) val new_tezos_head : - Protocol_client_context.Alpha_block_services.block_info -> - Protocol_client_context.Alpha_block_services.block_info - Injector_common.reorg -> + Block_hash.t * int32 -> + (Block_hash.t * int32) Injector_common.reorg -> unit Lwt.t (** Trigger an injection of the pending operations for all workers. If [tags] diff --git a/src/proto_alpha/lib_injector/injector_worker_types.ml b/src/proto_alpha/lib_injector/injector_worker_types.ml index 0702581588ee..4774790ec242 100644 --- a/src/proto_alpha/lib_injector/injector_worker_types.ml +++ b/src/proto_alpha/lib_injector/injector_worker_types.ml @@ -23,9 +23,6 @@ (* *) (*****************************************************************************) -open Protocol_client_context -open Protocol -open Alpha_context open Injector_common open Injector_sigs @@ -33,7 +30,7 @@ module Request (L1_operation : INJECTOR_OPERATION) = struct type ('a, 'b) t = | Add_pending : L1_operation.t -> (unit, error trace) t | New_tezos_head : - Alpha_block_services.block_info * Alpha_block_services.block_info reorg + (Block_hash.t * int32) * (Block_hash.t * int32) reorg -> (unit, error trace) t | Inject : (unit, error trace) t @@ -56,12 +53,13 @@ module Request (L1_operation : INJECTOR_OPERATION) = struct case (Tag 1) ~title:"New_tezos_head" - (obj3 + (let block_level = + obj2 (req "block" Block_hash.encoding) (req "level" int32) + in + obj3 (req "request" (constant "new_tezos_head")) - (req "head" Alpha_block_services.block_info_encoding) - (req - "reorg" - (reorg_encoding Alpha_block_services.block_info_encoding))) + (req "head" block_level) + (req "reorg" (reorg_encoding block_level))) (function | View (New_tezos_head (b, r)) -> Some ((), b, r) | _ -> None) (fun ((), b, r) -> View (New_tezos_head (b, r))); @@ -77,12 +75,13 @@ module Request (L1_operation : INJECTOR_OPERATION) = struct match r with | Add_pending op -> Format.fprintf ppf "request add %a to pending queue" L1_operation.pp op - | New_tezos_head (b, r) -> + | New_tezos_head ((block, level), r) -> Format.fprintf ppf - "switching to new Tezos head %a" + "switching to new Tezos head %a at level %ld" Block_hash.pp - b.Alpha_block_services.hash ; + block + level ; if r.old_chain <> [] || r.new_chain <> [] then Format.fprintf ppf @@ -93,7 +92,7 @@ module Request (L1_operation : INJECTOR_OPERATION) = struct end module Name = struct - type t = public_key_hash + type t = Signature.public_key_hash let encoding = Signature.Public_key_hash.encoding diff --git a/src/proto_alpha/lib_injector/injector_worker_types.mli b/src/proto_alpha/lib_injector/injector_worker_types.mli index 15ce64197275..1f70c5a48df0 100644 --- a/src/proto_alpha/lib_injector/injector_worker_types.mli +++ b/src/proto_alpha/lib_injector/injector_worker_types.mli @@ -23,9 +23,6 @@ (* *) (*****************************************************************************) -open Protocol_client_context -open Protocol -open Alpha_context open Injector_common open Injector_sigs @@ -33,7 +30,7 @@ module Request (Inj_operation : INJECTOR_OPERATION) : sig type ('a, 'b) t = | Add_pending : Inj_operation.t -> (unit, error trace) t | New_tezos_head : - Alpha_block_services.block_info * Alpha_block_services.block_info reorg + (Block_hash.t * int32) * (Block_hash.t * int32) reorg -> (unit, error trace) t | Inject : (unit, error trace) t @@ -45,4 +42,4 @@ module Request (Inj_operation : INJECTOR_OPERATION) : sig and type view := view end -module Name : Worker_intf.NAME with type t = public_key_hash +module Name : Worker_intf.NAME with type t = Signature.public_key_hash -- GitLab From ab8fc2083bbb5c71e10d909d1b77ca4d25f073b8 Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Mon, 13 Feb 2023 14:55:20 +0100 Subject: [PATCH 4/8] Injector: use Client_context instead of protocol client --- .../lib_injector/injector_functor.ml | 43 ++++++------------- src/proto_alpha/lib_injector/injector_sigs.ml | 2 +- 2 files changed, 14 insertions(+), 31 deletions(-) diff --git a/src/proto_alpha/lib_injector/injector_functor.ml b/src/proto_alpha/lib_injector/injector_functor.ml index c2f4cb57c406..ac69a62ba5e8 100644 --- a/src/proto_alpha/lib_injector/injector_functor.ml +++ b/src/proto_alpha/lib_injector/injector_functor.ml @@ -43,12 +43,10 @@ type injection_strategy = [`Each_block | `Delay_block of float] (** Builds a client context from another client context but uses logging instead of printing on stdout directly. This client context cannot make the injector exit. *) -let injector_context (cctxt : #Protocol_client_context.full) = +let injector_context (cctxt : #Client_context.full) : Client_context.full = let log _channel msg = Logs_lwt.info (fun m -> m "%s" msg) in object - inherit - Protocol_client_context.wrap_full - (new Client_context.proxy_context (cctxt :> Client_context.full)) + inherit Client_context.proxy_context cctxt inherit! Client_context.simple_printer log @@ -205,9 +203,8 @@ struct (** The internal state of each injector worker. *) type state = { - cctxt : Protocol_client_context.full; + cctxt : Client_context.full; (** The client context which is used to perform the injections. *) - constants : Constants.t; (** The constants of the protocol. *) signer : signer; (** The signer for this worker. *) tags : Tags.t; (** The tags of this worker, for both informative and identification @@ -241,8 +238,8 @@ struct let emit3 e state x y z = emit e (state.signer.pkh, state.tags, x, y, z) end - let init_injector cctxt constants ~data_dir state ~retention_period ~signer - strategy tags = + let init_injector cctxt ~data_dir state ~retention_period ~signer strategy + tags = let open Lwt_result_syntax in let* signer = get_signer cctxt signer in let data_dir = Filename.concat data_dir "injector" in @@ -321,8 +318,7 @@ struct return { - cctxt = injector_context (cctxt :> #Protocol_client_context.full); - constants; + cctxt = injector_context (cctxt :> #Client_context.full); signer; tags; strategy; @@ -940,8 +936,7 @@ struct type nonrec state = state type parameters = { - cctxt : Protocol_client_context.full; - constants : Constants.t; + cctxt : Client_context.full; data_dir : string; state : Parameters.state; retention_period : int; @@ -982,13 +977,10 @@ struct type launch_error = error trace let on_launch _w signer - Types. - {cctxt; constants; data_dir; state; retention_period; strategy; tags} - = + Types.{cctxt; data_dir; state; retention_period; strategy; tags} = trace (Step_failed "initialization") @@ init_injector cctxt - constants ~data_dir state ~retention_period @@ -1029,8 +1021,8 @@ struct (* TODO: https://gitlab.com/tezos/tezos/-/issues/2754 Injector worker in a separate process *) - let init (cctxt : #Protocol_client_context.full) ~data_dir - ?(retention_period = 0) state ~signers = + let init (cctxt : #Client_context.full) ~data_dir ?(retention_period = 0) + state ~signers = let open Lwt_result_syntax in assert (retention_period >= 0) ; let signers_map = @@ -1056,9 +1048,6 @@ struct Signature.Public_key_hash.Map.empty signers in - let* constants = - Protocol.Constants_services.all cctxt (cctxt#chain, cctxt#block) - in Signature.Public_key_hash.Map.iter_es (fun signer (strategy, tags) -> let+ worker = @@ -1066,8 +1055,7 @@ struct table signer { - cctxt = (cctxt :> Protocol_client_context.full); - constants; + cctxt = (cctxt :> Client_context.full); data_dir; state; retention_period; @@ -1134,13 +1122,8 @@ struct | `Each_block -> f () | `Delay_block delay_factor -> let time_until_next_block = - match header with - | None -> - state.constants.Constants.parametric.minimal_block_delay - |> Period.to_seconds |> Int64.to_float - | Some header -> - Proto_client.time_until_next_block state.constants header - |> Ptime.Span.to_float_s + Proto_client.time_until_next_block state.state header + |> Ptime.Span.to_float_s in let delay = time_until_next_block *. delay_factor in if delay <= 0. then f () diff --git a/src/proto_alpha/lib_injector/injector_sigs.ml b/src/proto_alpha/lib_injector/injector_sigs.ml index e3ff7965d42a..ec59108b7230 100644 --- a/src/proto_alpha/lib_injector/injector_sigs.ml +++ b/src/proto_alpha/lib_injector/injector_sigs.ml @@ -300,7 +300,7 @@ module type S = sig be useful to set this value to something [> 0] if we want to retrieve information about operations included on L1 for a given period. *) val init : - #Protocol_client_context.full -> + #Client_context.full -> data_dir:string -> ?retention_period:int -> state -> -- GitLab From 26bb0aa16e1c84a86d33bc07af332e56f2ea9c04 Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Mon, 13 Feb 2023 15:44:08 +0100 Subject: [PATCH 5/8] Injector: remove fee bound parameter Replaced by operation size function. --- .../lib_injector/injector_functor.ml | 57 ++++++------------- src/proto_alpha/lib_injector/injector_sigs.ml | 17 ------ 2 files changed, 16 insertions(+), 58 deletions(-) diff --git a/src/proto_alpha/lib_injector/injector_functor.ml b/src/proto_alpha/lib_injector/injector_functor.ml index ac69a62ba5e8..05e3229a96de 100644 --- a/src/proto_alpha/lib_injector/injector_functor.ml +++ b/src/proto_alpha/lib_injector/injector_functor.ml @@ -632,48 +632,23 @@ struct (oph, operations) (** Returns the (upper bound on) the size of an L1 batch of operations composed - of the manager operations [rev_ops]. *) - let size_l1_batch state rev_ops = - let contents_list = - List.map - (fun (op : Inj_operation.t) -> - let {fee; counter; gas_limit; storage_limit} = - Parameters.approximate_fee_bound state.state op.operation - in - let (Manager operation) = - POperation.to_manager_operation op.operation - in - let contents = - Manager_operation - { - source = state.signer.pkh; - operation; - fee; - counter; - gas_limit; - storage_limit; - } - in - Contents contents) - rev_ops + of the manager operations [ops]. *) + let size_l1_batch ops = + let size_shell_header = + (* Size of branch field *) + Block_hash.size in - let (Contents_list contents) = - match Operation.of_list contents_list with - | Error _ -> - (* Cannot happen: rev_ops is non empty and contains only manager - operations *) - assert false - | Ok packed_contents_list -> packed_contents_list - in - let signature = Signature.zero in - let branch = Block_hash.zero in - let operation = - { - shell = {branch}; - protocol_data = Operation_data {contents; signature = Some signature}; - } + let signature_size = Signature.size Signature.zero in + let contents_size = + List.fold_left + (fun acc o -> + acc + + Proto_client.operation_size o.Inj_operation.operation + + Proto_client.operation_size_overhead) + 0 + ops in - Data_encoding.Binary.length Operation.encoding operation + size_shell_header + contents_size + signature_size (** Retrieve as many operations from the queue while remaining below the size limit. *) @@ -684,7 +659,7 @@ struct Op_queue.fold (fun _oph op ops -> let new_ops = op :: ops in - let new_size = size_l1_batch state new_ops in + let new_size = size_l1_batch new_ops in if new_size > size_limit then raise (Reached_limit ops) ; new_ops) state.queue diff --git a/src/proto_alpha/lib_injector/injector_sigs.ml b/src/proto_alpha/lib_injector/injector_sigs.ml index ec59108b7230..b2b302be2d14 100644 --- a/src/proto_alpha/lib_injector/injector_sigs.ml +++ b/src/proto_alpha/lib_injector/injector_sigs.ml @@ -25,15 +25,6 @@ open Protocol.Alpha_context -(** Type to represent {e appoximate upper-bounds} for the fee and limits, used - to compute an upper bound on the size (in bytes) of an operation. *) -type approximate_fee_bound = { - fee : Tez.t; - counter : Manager_counter.t; - gas_limit : Gas.Arith.integral; - storage_limit : Z.t; -} - type fee_parameter = { minimal_fees : Tez.t; minimal_nanotez_per_byte : Q.t; @@ -100,9 +91,6 @@ module type PARAM_OPERATION = sig (** An encoding for injector's operations *) val encoding : t Data_encoding.t - (** Convert an injector operation to a manager_operation of the protocol *) - val to_manager_operation : t -> packed_manager_operation - (** Pretty-printing injector's operations *) val pp : Format.formatter -> t -> unit end @@ -160,11 +148,6 @@ module type PARAMETERS = sig persistent information. *) val operation_tag : Operation.t -> Tag.t - (** Returns the {e approximate upper-bounds} for the fee and limits of an - operation, used to compute an upper bound on the size (in bytes) for this - operation. *) - val approximate_fee_bound : state -> Operation.t -> approximate_fee_bound - (** Returns the fee_parameter (to compute fee w.r.t. gas, size, etc.) and the caps of fee and burn for each operation. *) val fee_parameter : state -> Operation.t -> fee_parameter -- GitLab From fc9a3a74181bb0f271b877dcd676155ae6634505 Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Mon, 13 Feb 2023 16:11:35 +0100 Subject: [PATCH 6/8] Injector: remove dependency on protocol The functor is still parameterized by protocol code at this point. --- .../lib_injector/injector_common.ml | 100 ------------------ .../lib_injector/injector_common.mli | 43 -------- .../lib_injector/injector_functor.ml | 23 ++-- src/proto_alpha/lib_injector/injector_sigs.ml | 16 +-- src/proto_alpha/lib_sc_rollup_node/layer1.ml | 79 +++++++++++--- 5 files changed, 84 insertions(+), 177 deletions(-) diff --git a/src/proto_alpha/lib_injector/injector_common.ml b/src/proto_alpha/lib_injector/injector_common.ml index 9ceb0f772172..397fcb9afd1f 100644 --- a/src/proto_alpha/lib_injector/injector_common.ml +++ b/src/proto_alpha/lib_injector/injector_common.ml @@ -23,8 +23,6 @@ (* *) (*****************************************************************************) -open Protocol_client_context - type signer = { alias : string; pkh : Signature.public_key_hash; @@ -49,101 +47,3 @@ let reorg_encoding block_encoding = @@ obj2 (req "old_chain" (list block_encoding)) (req "new_chain" (list block_encoding)) - -let fetch_tezos_shell_header ~find_in_cache (cctxt : #full) hash : - (Block_header.shell_header, error trace) result Lwt.t = - let open Lwt_syntax in - let errors = ref None in - let fetch hash = - let* shell_header = - Tezos_shell_services.Shell_services.Blocks.Header.shell_header - cctxt - ~chain:cctxt#chain - ~block:(`Hash (hash, 0)) - () - in - match shell_header with - | Error errs -> - errors := Some errs ; - return_none - | Ok shell_header -> return_some shell_header - in - let+ shell_header = find_in_cache hash fetch in - match (shell_header, !errors) with - | None, None -> - (* This should not happen if {!find_in_cache} behaves correctly, - i.e. calls {!fetch} for cache misses. *) - error_with - "Fetching Tezos block %a failed unexpectedly" - Block_hash.pp - hash - | None, Some errs -> Error errs - | Some shell_header, _ -> Ok shell_header - -let fetch_tezos_block ~find_in_cache (cctxt : #full) hash : - (Alpha_block_services.block_info, error trace) result Lwt.t = - let open Lwt_syntax in - let errors = ref None in - let fetch hash = - let* block = - Alpha_block_services.info - cctxt - ~chain:cctxt#chain - ~block:(`Hash (hash, 0)) - ~metadata:`Always - () - in - match block with - | Error errs -> - errors := Some errs ; - return_none - | Ok block -> return_some block - in - let+ block = find_in_cache hash fetch in - match (block, !errors) with - | None, None -> - (* This should not happen if {!find_in_cache} behaves correctly, - i.e. calls {!fetch} for cache misses. *) - error_with - "Fetching Tezos block %a failed unexpectedly" - Block_hash.pp - hash - | None, Some errs -> Error errs - | Some block, _ -> Ok block - -(* Compute the reorganization of L1 blocks from the chain whose head is - [old_head_hash] and the chain whose head [new_head_hash]. *) -let tezos_reorg fetch_tezos_block ~old_head_hash ~new_head_hash = - let open Alpha_block_services in - let open Lwt_result_syntax in - let rec loop old_chain new_chain old_head_hash new_head_hash = - if Block_hash.(old_head_hash = new_head_hash) then - return {old_chain = List.rev old_chain; new_chain = List.rev new_chain} - else - let* new_head = fetch_tezos_block new_head_hash in - let* old_head = fetch_tezos_block old_head_hash in - let old_level = old_head.header.shell.level in - let new_level = new_head.header.shell.level in - let diff = Int32.sub new_level old_level in - let old_chain, new_chain, old, new_ = - if diff = 0l then - (* Heads at same level *) - let new_chain = new_head :: new_chain in - let old_chain = old_head :: old_chain in - let new_head_hash = new_head.header.shell.predecessor in - let old_head_hash = old_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - else if diff > 0l then - (* New chain is longer *) - let new_chain = new_head :: new_chain in - let new_head_hash = new_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - else - (* Old chain was longer *) - let old_chain = old_head :: old_chain in - let old_head_hash = old_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - in - loop old_chain new_chain old new_ - in - loop [] [] old_head_hash new_head_hash diff --git a/src/proto_alpha/lib_injector/injector_common.mli b/src/proto_alpha/lib_injector/injector_common.mli index 9f7d6956fbe0..a329f09343f0 100644 --- a/src/proto_alpha/lib_injector/injector_common.mli +++ b/src/proto_alpha/lib_injector/injector_common.mli @@ -23,8 +23,6 @@ (* *) (*****************************************************************************) -open Protocol_client_context - (** The type of signers for operations injected by the injector *) type signer = { alias : string; @@ -49,44 +47,3 @@ val get_signer : val no_reorg : 'a reorg val reorg_encoding : 'a Data_encoding.t -> 'a reorg Data_encoding.t - -type block_info := Alpha_block_services.block_info - -type shell_header := Block_header.shell_header - -(** [fetch_tezos_shell_header ~find_in_cache cctxt hash] returns [Some - shell_header] given a block hash. Looks for the block using [find_in_cache] - first, and fetches it from the L1 node otherwise. Returns [None] if no such - block hash exists. [find_in_cache] should be from an instance of - {!Aches_lwt.Lache.MAP_RESULT}. *) -val fetch_tezos_shell_header : - find_in_cache: - (Block_hash.t -> - (Block_hash.t -> shell_header option Lwt.t) -> - shell_header option Lwt.t) -> - #full -> - Block_hash.t -> - shell_header tzresult Lwt.t - -(** [fetch_tezos_block ~find_in_cache cctxt hash] returns [Some block_info] - given a block hash. Looks for the block using [find_in_cache] first, and - fetches it from the L1 node otherwise. Returns [None] if no such block hash - exists. [find_in_cache] should be from an instance of - {!Aches_lwt.Lache.MAP_RESULT}. *) -val fetch_tezos_block : - find_in_cache: - (Block_hash.t -> - (Block_hash.t -> block_info option Lwt.t) -> - block_info option Lwt.t) -> - #full -> - Block_hash.t -> - block_info tzresult Lwt.t - -(** [tezos_reorg fetch ~old_head_hash ~new_head_hash] computes the - reorganization of L1 blocks from the chain whose head is [old_head_hash] and - the chain whose head [new_head_hash]. *) -val tezos_reorg : - (Block_hash.t -> block_info tzresult Lwt.t) -> - old_head_hash:Block_hash.t -> - new_head_hash:Block_hash.t -> - block_info reorg tzresult Lwt.t diff --git a/src/proto_alpha/lib_injector/injector_functor.ml b/src/proto_alpha/lib_injector/injector_functor.ml index 05e3229a96de..731981bac607 100644 --- a/src/proto_alpha/lib_injector/injector_functor.ml +++ b/src/proto_alpha/lib_injector/injector_functor.ml @@ -23,8 +23,6 @@ (* *) (*****************************************************************************) -open Protocol -open Alpha_context open Injector_common open Injector_worker_types open Injector_sigs @@ -458,7 +456,8 @@ struct (fun acc {Inj_operation.operation; _} -> let param = Parameters.fee_parameter state operation in { - minimal_fees = Tez.max acc.minimal_fees param.minimal_fees; + minimal_fees = + {mutez = Int64.max acc.minimal_fees.mutez param.minimal_fees.mutez}; minimal_nanotez_per_byte = Q.max acc.minimal_nanotez_per_byte param.minimal_nanotez_per_byte; minimal_nanotez_per_gas_unit = @@ -466,22 +465,16 @@ struct acc.minimal_nanotez_per_gas_unit param.minimal_nanotez_per_gas_unit; force_low_fee = acc.force_low_fee || param.force_low_fee; - fee_cap = - WithExceptions.Result.get_ok - ~loc:__LOC__ - Tez.(acc.fee_cap +? param.fee_cap); - burn_cap = - WithExceptions.Result.get_ok - ~loc:__LOC__ - Tez.(acc.burn_cap +? param.burn_cap); + fee_cap = {mutez = Int64.add acc.fee_cap.mutez param.fee_cap.mutez}; + burn_cap = {mutez = Int64.add acc.burn_cap.mutez param.burn_cap.mutez}; }) { - minimal_fees = Tez.zero; + minimal_fees = {mutez = 0L}; minimal_nanotez_per_byte = Q.zero; minimal_nanotez_per_gas_unit = Q.zero; force_low_fee = false; - fee_cap = Tez.zero; - burn_cap = Tez.zero; + fee_cap = {mutez = 0L}; + burn_cap = {mutez = 0L}; } ops @@ -696,7 +689,7 @@ struct not exceed [size_limit]. Upon successful injection, the operations are removed from the queue and marked as injected. *) let inject_pending_operations - ?(size_limit = Constants.max_operation_data_length) state = + ?(size_limit = Proto_client.max_operation_data_length) state = let open Lwt_result_syntax in (* Retrieve and remove operations from pending *) let operations_to_inject = get_operations_from_queue ~size_limit state in diff --git a/src/proto_alpha/lib_injector/injector_sigs.ml b/src/proto_alpha/lib_injector/injector_sigs.ml index b2b302be2d14..684606ad49fc 100644 --- a/src/proto_alpha/lib_injector/injector_sigs.ml +++ b/src/proto_alpha/lib_injector/injector_sigs.ml @@ -23,15 +23,15 @@ (* *) (*****************************************************************************) -open Protocol.Alpha_context +type tez = {mutez : int64} type fee_parameter = { - minimal_fees : Tez.t; + minimal_fees : tez; minimal_nanotez_per_byte : Q.t; minimal_nanotez_per_gas_unit : Q.t; force_low_fee : bool; - fee_cap : Tez.t; - burn_cap : Tez.t; + fee_cap : tez; + burn_cap : tez; } type injection_strategy = @@ -170,6 +170,8 @@ module type PROTOCOL_CLIENT = sig type unsigned_operation + val max_operation_data_length : int + (** The validation pass of manager operations. *) val manager_pass : int @@ -287,7 +289,7 @@ module type S = sig data_dir:string -> ?retention_period:int -> state -> - signers:(public_key_hash * injection_strategy * tag list) list -> + signers:(Signature.public_key_hash * injection_strategy * tag list) list -> unit tzresult Lwt.t (** Add an operation as pending injection in the injector. If the source is @@ -295,7 +297,9 @@ module type S = sig corresponding tag. It returns the hash of the operation in the injector queue. *) val add_pending_operation : - ?source:public_key_hash -> operation -> Inj_operation.Hash.t tzresult Lwt.t + ?source:Signature.public_key_hash -> + operation -> + Inj_operation.Hash.t tzresult Lwt.t (** Notify the injector of a new Tezos head. The injector marks the operations appropriately (for instance reverted operations that are part of a diff --git a/src/proto_alpha/lib_sc_rollup_node/layer1.ml b/src/proto_alpha/lib_sc_rollup_node/layer1.ml index e83767528c57..125693587be1 100644 --- a/src/proto_alpha/lib_sc_rollup_node/layer1.ml +++ b/src/proto_alpha/lib_sc_rollup_node/layer1.ml @@ -26,7 +26,6 @@ open Configuration open Protocol.Alpha_context open Plugin -open Injector_common (** @@ -241,25 +240,79 @@ let shutdown state = [hash]. Looks for the block in the blocks cache first, and fetches it from the L1 node otherwise. *) let fetch_tezos_shell_header l1_ctxt hash = + let open Lwt_syntax in trace (Cannot_find_block hash) - @@ fetch_tezos_shell_header - l1_ctxt.cctxt - hash - ~find_in_cache:(fun h fetch_by_rpc -> - let res = - Blocks_cache.bind l1_ctxt.blocks_cache h (function - | Some block_info -> Lwt.return_some block_info.header.shell - | None -> Lwt.return_none) - in - match res with Some lwt -> lwt | None -> fetch_by_rpc h) + @@ + let errors = ref None in + let fetch hash = + let* shell_header = + Tezos_shell_services.Shell_services.Blocks.Header.shell_header + l1_ctxt.cctxt + ~chain:`Main + ~block:(`Hash (hash, 0)) + () + in + match shell_header with + | Error errs -> + errors := Some errs ; + return_none + | Ok shell_header -> return_some shell_header + in + let+ shell_header = + let res = + Blocks_cache.bind l1_ctxt.blocks_cache hash (function + | Some block_info -> Lwt.return_some block_info.header.shell + | None -> Lwt.return_none) + in + match res with Some lwt -> lwt | None -> fetch hash + in + match (shell_header, !errors) with + | None, None -> + (* This should not happen if {!find_in_cache} behaves correctly, + i.e. calls {!fetch} for cache misses. *) + error_with + "Fetching Tezos block %a failed unexpectedly" + Block_hash.pp + hash + | None, Some errs -> Error errs + | Some shell_header, _ -> Ok shell_header (** [fetch_tezos_block l1_ctxt hash] returns a block info given a block hash. Looks for the block in the blocks cache first, and fetches it from the L1 node otherwise. *) let fetch_tezos_block l1_ctxt hash = + let open Lwt_syntax in trace (Cannot_find_block hash) - @@ fetch_tezos_block l1_ctxt.cctxt hash ~find_in_cache:(fun h fetch_by_rpc -> - Blocks_cache.bind_or_put l1_ctxt.blocks_cache h fetch_by_rpc Lwt.return) + @@ + let errors = ref None in + let fetch hash = + let* block = + Alpha_block_services.info + cctxt + ~chain:`Main + ~block:(`Hash (hash, 0)) + ~metadata:`Always + () + in + match block with + | Error errs -> + errors := Some errs ; + return_none + | Ok block -> return_some block + in + let+ block = + Blocks_cache.bind_or_put l1_ctxt.blocks_cache hash fetch Lwt.return + in + match (block, !errors) with + | None, None -> + (* This should not happen if {!find_in_cache} behaves correctly, + i.e. calls {!fetch} for cache misses. *) + error_with + "Fetching Tezos block %a failed unexpectedly" + Block_hash.pp + hash + | None, Some errs -> Error errs + | Some block, _ -> Ok block let nth_predecessor l1_state n block = let open Lwt_result_syntax in -- GitLab From 6de4ed64c2bbb159fd5e0b95b40cb90978c07b6a Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Mon, 13 Feb 2023 18:40:49 +0100 Subject: [PATCH 7/8] SCORU/Node: use new injector interface --- src/proto_alpha/lib_sc_rollup_node/daemon.ml | 24 +- .../lib_sc_rollup_node/injector.ml | 349 +++++++++++++++++- src/proto_alpha/lib_sc_rollup_node/layer1.ml | 23 +- 3 files changed, 358 insertions(+), 38 deletions(-) diff --git a/src/proto_alpha/lib_sc_rollup_node/daemon.ml b/src/proto_alpha/lib_sc_rollup_node/daemon.ml index 2714c43e920f..1fdbd511fdb7 100644 --- a/src/proto_alpha/lib_sc_rollup_node/daemon.ml +++ b/src/proto_alpha/lib_sc_rollup_node/daemon.ml @@ -367,20 +367,20 @@ module Make (PVM : Pvm.S) = struct in return_unit - let notify_injector {Node_context.l1_ctxt; _} new_head - (reorg : Layer1.head Injector_common.reorg) = + let notify_injector new_head (reorg : Layer1.head Injector_common.reorg) = let open Lwt_result_syntax in let open Layer1 in - let* new_chain = - List.map_ep - (fun {hash; _} -> fetch_tezos_block l1_ctxt hash) - reorg.new_chain - and* old_chain = - List.map_ep - (fun {hash; _} -> fetch_tezos_block l1_ctxt hash) - reorg.old_chain + let new_chain = + List.map (fun {hash; level} -> (hash, level)) reorg.new_chain + in + let old_chain = + List.map (fun {hash; level} -> (hash, level)) reorg.old_chain + in + let*! () = + Injector.new_tezos_head + (new_head.hash, new_head.level) + {new_chain; old_chain} in - let*! () = Injector.new_tezos_head new_head {new_chain; old_chain} in return_unit (* [on_layer_1_head node_ctxt head] processes a new head from the L1. It @@ -428,7 +428,7 @@ module Make (PVM : Pvm.S) = struct let* () = List.iter_es (process_head node_ctxt) reorg.new_chain in let* () = Components.Commitment.Publisher.publish_commitments () in let* () = Components.Commitment.Publisher.cement_commitments () in - let* () = notify_injector node_ctxt new_head reorg in + let* () = notify_injector head reorg in let*! () = Daemon_event.new_heads_processed reorg.new_chain in let* () = Components.Refutation_game.process head node_ctxt in let* () = Components.Batcher.batch () in diff --git a/src/proto_alpha/lib_sc_rollup_node/injector.ml b/src/proto_alpha/lib_sc_rollup_node/injector.ml index 8bcb5fbd1622..3f4a3648e8fd 100644 --- a/src/proto_alpha/lib_sc_rollup_node/injector.ml +++ b/src/proto_alpha/lib_sc_rollup_node/injector.ml @@ -23,8 +23,12 @@ (* *) (*****************************************************************************) -open Protocol.Alpha_context +open Protocol +open Alpha_context open Injector_sigs +module Block_cache = + Aches_lwt.Lache.Make_result + (Aches.Rache.Transfer (Aches.Rache.LRU) (Block_hash)) module Parameters : PARAMETERS @@ -74,21 +78,23 @@ module Parameters : | Refute _ -> Refute let fee_parameter node_ctxt operation = - Node_context.get_fee_parameter node_ctxt (operation_tag operation) - - (* Below are dummy values that are only used to approximate the - size. It is thus important that they remain above the real - values if we want the computed size to be an over_approximation - (without having to do a simulation first). - - TODO: https://gitlab.com/tezos/tezos/-/issues/2812 - check the size, or compute them wrt operation kind *) - let approximate_fee_bound _ _ = + let { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } = + Node_context.get_fee_parameter node_ctxt (operation_tag operation) + in { - fee = Tez.of_mutez_exn 3_000_000L; - counter = Manager_counter.Internal_for_tests.of_int 500_000; - gas_limit = Gas.Arith.integral_of_int_exn 500_000; - storage_limit = Z.of_int 500_000; + minimal_fees = {mutez = Tez.to_mutez minimal_fees}; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap = {mutez = Tez.to_mutez fee_cap}; + burn_cap = {mutez = Tez.to_mutez burn_cap}; } (* TODO: https://gitlab.com/tezos/tezos/-/issues/3459 @@ -143,4 +149,315 @@ module Parameters : | Publish _ -> return (Abort error)) end -include Injector_functor.Make (Parameters) +module Proto_client = struct + open Protocol_client_context + + type unsigned_operation = + Tezos_base.Operation.shell_header * packed_contents_list + + let max_operation_data_length = Constants.max_operation_data_length + + let manager_pass = Operation_repr.manager_pass + + let manager_operation_size (Manager operation) = + let contents = + Manager_operation + { + source = Signature.Public_key_hash.zero; + operation; + fee = Tez.zero; + counter = Manager_counter.Internal_for_tests.of_int 0; + gas_limit = Gas.Arith.zero; + storage_limit = Z.zero; + } + in + Data_encoding.Binary.length Operation.contents_encoding (Contents contents) + + let operation_size op = + manager_operation_size (L1_operation.to_manager_operation op) + + (* The operation size overhead is an upper bound (in practice) of the overhead + that will be added to a manager operation. To compute it we can use any + manager operation (here a revelation), add an overhead with upper bounds as + values (for the fees, limits, counters, etc.) and compare the encoded + operations with respect to their size. + NOTE: This information is only used to pre-select operations from the + injector queue as a candidate batch. *) + let operation_size_overhead = + let dummy_operation = + Reveal + (Signature.Public_key.of_b58check_exn + "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav") + in + let dummy_contents = + Manager_operation + { + source = Signature.Public_key_hash.zero; + operation = dummy_operation; + fee = Tez.of_mutez_exn 3_000_000L; + counter = Manager_counter.Internal_for_tests.of_int 500_000; + gas_limit = Gas.Arith.integral_of_int_exn 500_000; + storage_limit = Z.of_int 500_000; + } + in + let dummy_size = + Data_encoding.Binary.length + Operation.contents_encoding + (Contents dummy_contents) + in + dummy_size - manager_operation_size (Manager dummy_operation) + + let manager_operation_result_status (type kind) + (op_result : kind Apply_results.manager_operation_result) : + operation_status = + match op_result with + | Applied _ -> Successful + | Backtracked (_, None) -> Unsuccessful Backtracked + | Skipped _ -> Unsuccessful Skipped + | Backtracked (_, Some err) + (* Backtracked because internal operation failed *) + | Failed (_, err) -> + Unsuccessful (Failed (Environment.wrap_tztrace err)) + + let operation_result_status (type kind) + (op_result : kind Apply_results.contents_result) : operation_status = + match op_result with + | Preendorsement_result _ -> Successful + | Endorsement_result _ -> Successful + | Dal_attestation_result _ -> Successful + | Seed_nonce_revelation_result _ -> Successful + | Vdf_revelation_result _ -> Successful + | Double_endorsement_evidence_result _ -> Successful + | Double_preendorsement_evidence_result _ -> Successful + | Double_baking_evidence_result _ -> Successful + | Activate_account_result _ -> Successful + | Proposals_result -> Successful + | Ballot_result -> Successful + | Drain_delegate_result _ -> Successful + | Manager_operation_result {operation_result; _} -> + manager_operation_result_status operation_result + + let operation_contents_status (type kind) + (contents : kind Apply_results.contents_result_list) ~index : + operation_status tzresult = + let rec rec_status : + type kind. int -> kind Apply_results.contents_result_list -> _ = + fun n -> function + | Apply_results.Single_result _ when n <> 0 -> + error_with "No operation with index %d" index + | Single_result result -> Ok (operation_result_status result) + | Cons_result (result, _rest) when n = 0 -> + Ok (operation_result_status result) + | Cons_result (_result, rest) -> rec_status (n - 1) rest + in + rec_status index contents + + let operation_status_of_receipt (operation : Protocol.operation_receipt) + ~index : operation_status tzresult = + match (operation : _) with + | No_operation_metadata -> + error_with "Cannot find operation status because metadata is missing" + | Operation_metadata {contents} -> operation_contents_status contents ~index + + let get_block_operations = + let ops_cache = Block_cache.create 32 in + fun cctxt block_hash -> + Block_cache.bind_or_put + ops_cache + block_hash + (fun block_hash -> + let open Lwt_result_syntax in + let+ operations = + Alpha_block_services.Operations.operations_in_pass + cctxt + ~chain:cctxt#chain + ~block:(`Hash (block_hash, 0)) + ~metadata:`Always + manager_pass + in + List.fold_left + (fun acc (op : Alpha_block_services.operation) -> + Operation_hash.Map.add op.hash op acc) + Operation_hash.Map.empty + operations) + Lwt.return + + let operation_status (node_ctxt : Node_context.ro) block_hash operation_hash + ~index = + let open Lwt_result_syntax in + let* operations = get_block_operations node_ctxt.cctxt block_hash in + match Operation_hash.Map.find_opt operation_hash operations with + | None -> return_none + | Some operation -> ( + match operation.receipt with + | Empty -> + failwith "Cannot find operation status because metadata is empty" + | Too_large -> + failwith + "Cannot find operation status because metadata is too large" + | Receipt receipt -> + let*? status = operation_status_of_receipt receipt ~index in + return_some status) + + let dummy_sk_uri = + WithExceptions.Result.get_ok ~loc:__LOC__ + @@ Tezos_signer_backends.Unencrypted.make_sk + @@ Signature.Secret_key.of_b58check_exn + "edsk3UqeiQWXX7NFEY1wUs6J1t2ez5aQ3hEWdqX5Jr5edZiGLW8nZr" + + let simulate_operations cctxt ~force ~source ~src_pk ~successor_level + ~fee_parameter operations = + let open Lwt_result_syntax in + let fee_parameter : Injection.fee_parameter = + { + minimal_fees = Tez.of_mutez_exn fee_parameter.minimal_fees.mutez; + minimal_nanotez_per_byte = fee_parameter.minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit = + fee_parameter.minimal_nanotez_per_gas_unit; + force_low_fee = fee_parameter.force_low_fee; + fee_cap = Tez.of_mutez_exn fee_parameter.fee_cap.mutez; + burn_cap = Tez.of_mutez_exn fee_parameter.burn_cap.mutez; + } + in + let open Annotated_manager_operation in + let annotated_operations = + List.map + (fun operation -> + let (Manager operation) = + L1_operation.to_manager_operation operation + in + Annotated_manager_operation + (Injection.prepare_manager_operation + ~fee:Limit.unknown + ~gas_limit:Limit.unknown + ~storage_limit:Limit.unknown + operation)) + operations + in + let (Manager_list annot_op) = + Annotated_manager_operation.manager_of_list annotated_operations + in + let cctxt = + new Protocol_client_context.wrap_full (cctxt :> Client_context.full) + in + let*! simulation_result = + Injection.inject_manager_operation + cctxt + ~simulation:true (* Only simulation here *) + ~force + ~chain:cctxt#chain + ~block:(`Head 0) + ~source + ~src_pk + ~src_sk:dummy_sk_uri + (* Use dummy secret key as it is not used by simulation *) + ~successor_level + ~fee:Limit.unknown + ~gas_limit:Limit.unknown + ~storage_limit:Limit.unknown + ~fee_parameter + annot_op + in + match simulation_result with + | Error trace -> + let exceeds_quota = + TzTrace.fold + (fun exceeds -> function + | Environment.Ecoproto_error + (Gas.Block_quota_exceeded | Gas.Operation_quota_exceeded) -> + true + | _ -> exceeds) + false + trace + in + fail (if exceeds_quota then `Exceeds_quotas trace else `TzError trace) + | Ok (_oph, packed_op, _contents, results) -> + let nb_ops = List.length operations in + let results = Apply_results.to_list (Contents_result_list results) in + (* packed_op can have reveal operations added automatically. *) + let start_index = List.length results - nb_ops in + (* remove extra reveal operations *) + let operations_statuses = + List.fold_left_i + (fun index_in_batch acc (Apply_results.Contents_result result) -> + if index_in_batch < start_index then acc + else + {index_in_batch; status = operation_result_status result} :: acc) + [] + results + |> List.rev + in + let unsigned_operation = + let {shell; protocol_data = Operation_data {contents; signature = _}} + = + packed_op + in + (shell, Contents_list contents) + in + return {operations_statuses; unsigned_operation} + + let sign_operation cctxt src_sk + ((shell, Contents_list contents) as unsigned_op) = + let open Lwt_result_syntax in + let unsigned_bytes = + Data_encoding.Binary.to_bytes_exn Operation.unsigned_encoding unsigned_op + in + let cctxt = + new Protocol_client_context.wrap_full (cctxt :> Client_context.full) + in + let+ signature = + Client_keys.sign + cctxt + ~watermark:Signature.Generic_operation + src_sk + unsigned_bytes + in + let op : packed_operation = + { + shell; + protocol_data = Operation_data {contents; signature = Some signature}; + } + in + Data_encoding.Binary.to_bytes_exn Operation.encoding op + + let time_until_next_block (node_ctxt : Node_context.ro) + (header : Tezos_base.Block_header.t option) = + let open Result_syntax in + let Constants.Parametric.{minimal_block_delay; delay_increment_per_round; _} + = + node_ctxt.protocol_constants.Constants.parametric + in + match header with + | None -> + minimal_block_delay |> Period.to_seconds |> Int64.to_int + |> Ptime.Span.of_int_s + | Some header -> + let next_level_timestamp = + let* durations = + Round.Durations.create + ~first_round_duration:minimal_block_delay + ~delay_increment_per_round + in + let* predecessor_round = + Fitness.round_from_raw header.shell.fitness + in + Round.timestamp_of_round + durations + ~predecessor_timestamp:header.shell.timestamp + ~predecessor_round + ~round:Round.zero + in + let next_level_timestamp = + Result.value + next_level_timestamp + ~default: + (WithExceptions.Result.get_ok + ~loc:__LOC__ + Timestamp.(header.shell.timestamp +? minimal_block_delay)) + in + Ptime.diff + (Time.System.of_protocol_exn next_level_timestamp) + (Time.System.now ()) +end + +include Injector_functor.Make (Parameters) (Proto_client) diff --git a/src/proto_alpha/lib_sc_rollup_node/layer1.ml b/src/proto_alpha/lib_sc_rollup_node/layer1.ml index 125693587be1..419e1dcd784c 100644 --- a/src/proto_alpha/lib_sc_rollup_node/layer1.ml +++ b/src/proto_alpha/lib_sc_rollup_node/layer1.ml @@ -26,6 +26,7 @@ open Configuration open Protocol.Alpha_context open Plugin +open Protocol_client_context (** @@ -288,7 +289,7 @@ let fetch_tezos_block l1_ctxt hash = let fetch hash = let* block = Alpha_block_services.info - cctxt + l1_ctxt.cctxt ~chain:`Main ~block:(`Hash (hash, 0)) ~metadata:`Always @@ -334,10 +335,11 @@ let get_tezos_reorg_for_new_head l1_state old_head new_head = let* old_head_pred = get_predecessor l1_state old_head in let* new_head_pred = get_predecessor l1_state new_head in let reorg = - { - old_chain = old_head :: reorg.old_chain; - new_chain = new_head :: reorg.new_chain; - } + Injector_common. + { + old_chain = old_head :: reorg.old_chain; + new_chain = new_head :: reorg.new_chain; + } in aux reorg old_head_pred new_head_pred in @@ -345,13 +347,14 @@ let get_tezos_reorg_for_new_head l1_state old_head new_head = level *) let distance = Int32.(to_int @@ abs @@ sub new_head.level old_head.level) in let* old_head, new_head, reorg = - if old_head.level = new_head.level then return (old_head, new_head, no_reorg) + if old_head.level = new_head.level then + return (old_head, new_head, Injector_common.no_reorg) else if old_head.level < new_head.level then let+ new_head, new_chain = nth_predecessor l1_state distance new_head in - (old_head, new_head, {no_reorg with new_chain}) + (old_head, new_head, {Injector_common.no_reorg with new_chain}) else let+ old_head, old_chain = nth_predecessor l1_state distance old_head in - (old_head, new_head, {no_reorg with old_chain}) + (old_head, new_head, {Injector_common.no_reorg with old_chain}) in assert (old_head.level = new_head.level) ; aux reorg old_head new_head @@ -362,7 +365,7 @@ let get_tezos_reorg_for_new_head l1_state old_head new_head = match old_head with | `Level l -> (* No known tezos head, we want all blocks from l. *) - if new_head.level < l then return no_reorg + if new_head.level < l then return Injector_common.no_reorg else let* _block_at_l, new_chain = nth_predecessor @@ -370,5 +373,5 @@ let get_tezos_reorg_for_new_head l1_state old_head new_head = (Int32.sub new_head.level l |> Int32.to_int) new_head in - return {old_chain = []; new_chain} + return Injector_common.{old_chain = []; new_chain} | `Head old_head -> get_tezos_reorg_for_new_head l1_state old_head new_head -- GitLab From e11ffedb554ea1f51e4671895348aa79f15ebd9c Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Fri, 3 Feb 2023 16:28:24 +0100 Subject: [PATCH 8/8] SCORU/Node/Injector: backport !7573 to Mumbai rollup node - Injector: parameterize by protocol client - Injector: reorg messages contain just block hashes and levels - Injector: use Client_context instead of protocol client - Injector: remove fee bound parameter - Injector: remove dependency on protocol - SCORU/Node: use new injector interface --- .../lib_injector/injector_common.ml | 100 ---- .../lib_injector/injector_common.mli | 43 -- .../lib_injector/injector_functor.ml | 483 ++++++------------ .../lib_injector/injector_functor.mli | 6 +- .../lib_injector/injector_sigs.ml | 113 +++- .../lib_injector/injector_worker_types.ml | 25 +- .../lib_injector/injector_worker_types.mli | 7 +- .../lib_sc_rollup_node/daemon.ml | 24 +- .../lib_sc_rollup_node/injector.ml | 349 ++++++++++++- .../lib_sc_rollup_node/layer1.ml | 100 +++- 10 files changed, 688 insertions(+), 562 deletions(-) diff --git a/src/proto_016_PtMumbai/lib_injector/injector_common.ml b/src/proto_016_PtMumbai/lib_injector/injector_common.ml index ad6336e2a24c..4b1a5ad38ecd 100644 --- a/src/proto_016_PtMumbai/lib_injector/injector_common.ml +++ b/src/proto_016_PtMumbai/lib_injector/injector_common.ml @@ -23,8 +23,6 @@ (* *) (*****************************************************************************) -open Protocol_client_context - type signer = { alias : string; pkh : Tezos_crypto.Signature.public_key_hash; @@ -49,101 +47,3 @@ let reorg_encoding block_encoding = @@ obj2 (req "old_chain" (list block_encoding)) (req "new_chain" (list block_encoding)) - -let fetch_tezos_shell_header ~find_in_cache (cctxt : #full) hash : - (Block_header.shell_header, error trace) result Lwt.t = - let open Lwt_syntax in - let errors = ref None in - let fetch hash = - let* shell_header = - Tezos_shell_services.Shell_services.Blocks.Header.shell_header - cctxt - ~chain:cctxt#chain - ~block:(`Hash (hash, 0)) - () - in - match shell_header with - | Error errs -> - errors := Some errs ; - return_none - | Ok shell_header -> return_some shell_header - in - let+ shell_header = find_in_cache hash fetch in - match (shell_header, !errors) with - | None, None -> - (* This should not happen if {!find_in_cache} behaves correctly, - i.e. calls {!fetch} for cache misses. *) - error_with - "Fetching Tezos block %a failed unexpectedly" - Block_hash.pp - hash - | None, Some errs -> Error errs - | Some shell_header, _ -> Ok shell_header - -let fetch_tezos_block ~find_in_cache (cctxt : #full) hash : - (Alpha_block_services.block_info, error trace) result Lwt.t = - let open Lwt_syntax in - let errors = ref None in - let fetch hash = - let* block = - Alpha_block_services.info - cctxt - ~chain:cctxt#chain - ~block:(`Hash (hash, 0)) - ~metadata:`Always - () - in - match block with - | Error errs -> - errors := Some errs ; - return_none - | Ok block -> return_some block - in - let+ block = find_in_cache hash fetch in - match (block, !errors) with - | None, None -> - (* This should not happen if {!find_in_cache} behaves correctly, - i.e. calls {!fetch} for cache misses. *) - error_with - "Fetching Tezos block %a failed unexpectedly" - Block_hash.pp - hash - | None, Some errs -> Error errs - | Some block, _ -> Ok block - -(* Compute the reorganization of L1 blocks from the chain whose head is - [old_head_hash] and the chain whose head [new_head_hash]. *) -let tezos_reorg fetch_tezos_block ~old_head_hash ~new_head_hash = - let open Alpha_block_services in - let open Lwt_result_syntax in - let rec loop old_chain new_chain old_head_hash new_head_hash = - if Block_hash.(old_head_hash = new_head_hash) then - return {old_chain = List.rev old_chain; new_chain = List.rev new_chain} - else - let* new_head = fetch_tezos_block new_head_hash in - let* old_head = fetch_tezos_block old_head_hash in - let old_level = old_head.header.shell.level in - let new_level = new_head.header.shell.level in - let diff = Int32.sub new_level old_level in - let old_chain, new_chain, old, new_ = - if diff = 0l then - (* Heads at same level *) - let new_chain = new_head :: new_chain in - let old_chain = old_head :: old_chain in - let new_head_hash = new_head.header.shell.predecessor in - let old_head_hash = old_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - else if diff > 0l then - (* New chain is longer *) - let new_chain = new_head :: new_chain in - let new_head_hash = new_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - else - (* Old chain was longer *) - let old_chain = old_head :: old_chain in - let old_head_hash = old_head.header.shell.predecessor in - (old_chain, new_chain, old_head_hash, new_head_hash) - in - loop old_chain new_chain old new_ - in - loop [] [] old_head_hash new_head_hash diff --git a/src/proto_016_PtMumbai/lib_injector/injector_common.mli b/src/proto_016_PtMumbai/lib_injector/injector_common.mli index c5bfb943322f..d6088bb21aca 100644 --- a/src/proto_016_PtMumbai/lib_injector/injector_common.mli +++ b/src/proto_016_PtMumbai/lib_injector/injector_common.mli @@ -23,8 +23,6 @@ (* *) (*****************************************************************************) -open Protocol_client_context - (** The type of signers for operations injected by the injector *) type signer = { alias : string; @@ -51,44 +49,3 @@ val get_signer : val no_reorg : 'a reorg val reorg_encoding : 'a Data_encoding.t -> 'a reorg Data_encoding.t - -type block_info := Alpha_block_services.block_info - -type shell_header := Block_header.shell_header - -(** [fetch_tezos_shell_header ~find_in_cache cctxt hash] returns [Some - shell_header] given a block hash. Looks for the block using [find_in_cache] - first, and fetches it from the L1 node otherwise. Returns [None] if no such - block hash exists. [find_in_cache] should be from an instance of - {!Aches_lwt.Lache.MAP_RESULT}. *) -val fetch_tezos_shell_header : - find_in_cache: - (Block_hash.t -> - (Block_hash.t -> shell_header option Lwt.t) -> - shell_header option Lwt.t) -> - #full -> - Block_hash.t -> - shell_header tzresult Lwt.t - -(** [fetch_tezos_block ~find_in_cache cctxt hash] returns [Some block_info] - given a block hash. Looks for the block using [find_in_cache] first, and - fetches it from the L1 node otherwise. Returns [None] if no such block hash - exists. [find_in_cache] should be from an instance of - {!Aches_lwt.Lache.MAP_RESULT}. *) -val fetch_tezos_block : - find_in_cache: - (Block_hash.t -> - (Block_hash.t -> block_info option Lwt.t) -> - block_info option Lwt.t) -> - #full -> - Block_hash.t -> - block_info tzresult Lwt.t - -(** [tezos_reorg fetch ~old_head_hash ~new_head_hash] computes the - reorganization of L1 blocks from the chain whose head is [old_head_hash] and - the chain whose head [new_head_hash]. *) -val tezos_reorg : - (Block_hash.t -> block_info tzresult Lwt.t) -> - old_head_hash:Block_hash.t -> - new_head_hash:Block_hash.t -> - block_info reorg tzresult Lwt.t diff --git a/src/proto_016_PtMumbai/lib_injector/injector_functor.ml b/src/proto_016_PtMumbai/lib_injector/injector_functor.ml index 16143a52f137..33a8934fb57e 100644 --- a/src/proto_016_PtMumbai/lib_injector/injector_functor.ml +++ b/src/proto_016_PtMumbai/lib_injector/injector_functor.ml @@ -23,13 +23,13 @@ (* *) (*****************************************************************************) -open Protocol_client_context -open Protocol -open Alpha_context open Injector_common open Injector_worker_types open Injector_sigs open Injector_errors +module Block_cache = + Aches_lwt.Lache.Make_result + (Aches.Rache.Transfer (Aches.Rache.LRU) (Block_hash)) (* This is the Tenderbake finality for blocks. *) (* TODO: https://gitlab.com/tezos/tezos/-/issues/2815 @@ -41,12 +41,10 @@ type injection_strategy = [`Each_block | `Delay_block of float] (** Builds a client context from another client context but uses logging instead of printing on stdout directly. This client context cannot make the injector exit. *) -let injector_context (cctxt : #Protocol_client_context.full) = +let injector_context (cctxt : #Client_context.full) : Client_context.full = let log _channel msg = Logs_lwt.info (fun m -> m "%s" msg) in object - inherit - Protocol_client_context.wrap_full - (new Client_context.proxy_context (cctxt :> Client_context.full)) + inherit Client_context.proxy_context cctxt inherit! Client_context.simple_printer log @@ -54,59 +52,12 @@ let injector_context (cctxt : #Protocol_client_context.full) = Format.ksprintf Stdlib.failwith "Injector client wants to exit %d" code end -let manager_operation_result_status (type kind) - (op_result : kind Apply_results.manager_operation_result) : operation_status - = - match op_result with - | Applied _ -> Successful - | Backtracked (_, None) -> Unsuccessful Backtracked - | Skipped _ -> Unsuccessful Skipped - | Backtracked (_, Some err) - (* Backtracked because internal operation failed *) - | Failed (_, err) -> - Unsuccessful (Failed (Environment.wrap_tztrace err)) - -let operation_result_status (type kind) - (op_result : kind Apply_results.contents_result) : operation_status = - match op_result with - | Preendorsement_result _ -> Successful - | Endorsement_result _ -> Successful - | Dal_attestation_result _ -> Successful - | Seed_nonce_revelation_result _ -> Successful - | Vdf_revelation_result _ -> Successful - | Double_endorsement_evidence_result _ -> Successful - | Double_preendorsement_evidence_result _ -> Successful - | Double_baking_evidence_result _ -> Successful - | Activate_account_result _ -> Successful - | Proposals_result -> Successful - | Ballot_result -> Successful - | Drain_delegate_result _ -> Successful - | Manager_operation_result {operation_result; _} -> - manager_operation_result_status operation_result - -let operation_contents_status (type kind) - (contents : kind Apply_results.contents_result_list) ~index : - operation_status tzresult = - let rec rec_status : - type kind. int -> kind Apply_results.contents_result_list -> _ = - fun n -> function - | Apply_results.Single_result _ when n <> 0 -> - error_with "No operation with index %d" index - | Single_result result -> Ok (operation_result_status result) - | Cons_result (result, _rest) when n = 0 -> - Ok (operation_result_status result) - | Cons_result (_result, rest) -> rec_status (n - 1) rest - in - rec_status index contents - -let operation_status (operation : Protocol.operation_receipt) ~index : - operation_status tzresult = - match (operation : _) with - | No_operation_metadata -> - error_with "Cannot find operation status because metadata is missing" - | Operation_metadata {contents} -> operation_contents_status contents ~index - -module Make (Parameters : PARAMETERS) = struct +module Make + (Parameters : PARAMETERS) + (Proto_client : PROTOCOL_CLIENT + with type state := Parameters.state + and type operation := Parameters.Operation.t) = +struct module Tags = Injector_tags.Make (Parameters.Tag) module Tags_table = Hashtbl.Make (Parameters.Tag) module POperation = Parameters.Operation @@ -250,9 +201,8 @@ module Make (Parameters : PARAMETERS) = struct (** The internal state of each injector worker. *) type state = { - cctxt : Protocol_client_context.full; + cctxt : Client_context.full; (** The client context which is used to perform the injections. *) - constants : Constants.t; (** The constants of the protocol. *) signer : signer; (** The signer for this worker. *) tags : Tags.t; (** The tags of this worker, for both informative and identification @@ -286,8 +236,8 @@ module Make (Parameters : PARAMETERS) = struct let emit3 e state x y z = emit e (state.signer.pkh, state.tags, x, y, z) end - let init_injector cctxt constants ~data_dir state ~retention_period ~signer - strategy tags = + let init_injector cctxt ~data_dir state ~retention_period ~signer strategy + tags = let open Lwt_result_syntax in let* signer = get_signer cctxt signer in let data_dir = Filename.concat data_dir "injector" in @@ -366,8 +316,7 @@ module Make (Parameters : PARAMETERS) = struct return { - cctxt = injector_context (cctxt :> #Protocol_client_context.full); - constants; + cctxt = injector_context (cctxt :> #Client_context.full); signer; tags; strategy; @@ -506,34 +455,27 @@ module Make (Parameters : PARAMETERS) = struct List.fold_left (fun acc {Inj_operation.operation; _} -> let param = Parameters.fee_parameter state operation in - Injection. - { - minimal_fees = Tez.max acc.minimal_fees param.minimal_fees; - minimal_nanotez_per_byte = - Q.max acc.minimal_nanotez_per_byte param.minimal_nanotez_per_byte; - minimal_nanotez_per_gas_unit = - Q.max - acc.minimal_nanotez_per_gas_unit - param.minimal_nanotez_per_gas_unit; - force_low_fee = acc.force_low_fee || param.force_low_fee; - fee_cap = - WithExceptions.Result.get_ok - ~loc:__LOC__ - Tez.(acc.fee_cap +? param.fee_cap); - burn_cap = - WithExceptions.Result.get_ok - ~loc:__LOC__ - Tez.(acc.burn_cap +? param.burn_cap); - }) - Injection. { - minimal_fees = Tez.zero; - minimal_nanotez_per_byte = Q.zero; - minimal_nanotez_per_gas_unit = Q.zero; - force_low_fee = false; - fee_cap = Tez.zero; - burn_cap = Tez.zero; - } + minimal_fees = + {mutez = Int64.max acc.minimal_fees.mutez param.minimal_fees.mutez}; + minimal_nanotez_per_byte = + Q.max acc.minimal_nanotez_per_byte param.minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit = + Q.max + acc.minimal_nanotez_per_gas_unit + param.minimal_nanotez_per_gas_unit; + force_low_fee = acc.force_low_fee || param.force_low_fee; + fee_cap = {mutez = Int64.add acc.fee_cap.mutez param.fee_cap.mutez}; + burn_cap = {mutez = Int64.add acc.burn_cap.mutez param.burn_cap.mutez}; + }) + { + minimal_fees = {mutez = 0L}; + minimal_nanotez_per_byte = Q.zero; + minimal_nanotez_per_gas_unit = Q.zero; + force_low_fee = false; + fee_cap = {mutez = 0L}; + burn_cap = {mutez = 0L}; + } ops (** Returns the first half of the list [ops] if there is more than two @@ -551,7 +493,6 @@ module Make (Parameters : PARAMETERS) = struct let rec simulate_operations ~must_succeed state (operations : Inj_operation.t list) = let open Lwt_result_syntax in - let open Annotated_manager_operation in let force = match operations with | [] -> assert false @@ -563,114 +504,67 @@ module Make (Parameters : PARAMETERS) = struct succeed *) match must_succeed with `All -> false | `At_least_one -> true) in - let*! () = - Event.(emit2 simulating_operations) - state - (List.map (fun o -> o.Inj_operation.operation) operations) - force + let op_operations = + List.map (fun o -> o.Inj_operation.operation) operations in + let*! () = Event.(emit2 simulating_operations) state op_operations force in let fee_parameter = fee_parameter_of_operations state.state operations in - let annotated_operations = - List.map - (fun {Inj_operation.operation; _} -> - let (Manager operation) = POperation.to_manager_operation operation in - Annotated_manager_operation - (Injection.prepare_manager_operation - ~fee:Limit.unknown - ~gas_limit:Limit.unknown - ~storage_limit:Limit.unknown - operation)) - operations - in - let (Manager_list annot_op) = - Annotated_manager_operation.manager_of_list annotated_operations - in let*! simulation_result = - Injection.inject_manager_operation + Proto_client.simulate_operations state.cctxt - ~simulation:true (* Only simulation here *) ~force - ~chain:state.cctxt#chain - ~block:(`Head 0) ~source:state.signer.pkh ~src_pk:state.signer.pk - ~src_sk:state.signer.sk ~successor_level:true - (* Operations are simulated in the next block, which is important for rollups - and ok for other applications. *) - ~fee:Limit.unknown - ~gas_limit:Limit.unknown - ~storage_limit:Limit.unknown + (* Operations are simulated in the next block, which is important for + rollups and ok for other applications. *) ~fee_parameter - annot_op + op_operations in match simulation_result with - | Error trace -> + | Error (`TzError trace) -> fail trace + | Error (`Exceeds_quotas trace) -> ( let*! () = Event.(emit1 number_of_operations_in_queue) state (Op_queue.length state.queue) in - let exceeds_quota = - TzTrace.fold - (fun exceeds -> function - | Environment.Ecoproto_error - (Gas.Block_quota_exceeded | Gas.Operation_quota_exceeded) -> - true - | _ -> exceeds) - false - trace - in - if exceeds_quota then - (* We perform a dichotomy by injecting the first half of the - operations (we are not looking to maximize the number of operations - injected because of the cost of simulation). Only the operations - which are actually injected will be removed from the queue so the - other half will be reconsidered later. *) - match keep_half operations with - | None -> fail trace - | Some operations -> - simulate_operations ~must_succeed state operations - else fail trace - | Ok (_, op, _, result) -> - let nb_ops = List.length operations in - let nb_packed_ops = - let {protocol_data = Operation_data {contents; _}; _} = op in - Alpha_context.Operation.to_list (Contents_list contents) - |> List.length - in - (* packed_op can have reveal operations added automatically. *) - let start_index = nb_packed_ops - nb_ops in - (* Add indexes of operations in the packed, i.e. batched, operation. *) - let operations = - List.mapi (fun i op -> (i + start_index, op)) operations + (* We perform a dichotomy by injecting the first half of the + operations (we are not looking to maximize the number of operations + injected because of the cost of simulation). Only the operations + which are actually injected will be removed from the queue so the + other half will be reconsidered later. *) + match keep_half operations with + | None -> + fail + @@ TzTrace.cons + (Exn (Failure "Quotas exceeded when simulating one operation")) + trace + | Some operations -> simulate_operations ~must_succeed state operations) + | Ok {operations_statuses; unsigned_operation} -> + let*? results = + List.combine + ~when_different_lengths: + [ + Exn + (Failure + "Injector: Not the same number of results as operations \ + in simulation."); + ] + operations + operations_statuses in - return (op, operations, Apply_results.Contents_result_list result) + return (results, unsigned_operation) - let inject_on_node state ~nb - {shell; protocol_data = Operation_data {contents; _}} = + let inject_on_node state ~nb unsigned_op = let open Lwt_result_syntax in - let unsigned_op = (shell, Contents_list contents) in - let unsigned_op_bytes = - Data_encoding.Binary.to_bytes_exn Operation.unsigned_encoding unsigned_op - in - let* signature = - Client_keys.sign - state.cctxt - ~watermark:Tezos_crypto.Signature.Generic_operation - state.signer.sk - unsigned_op_bytes - in - let op : _ Operation.t = - {shell; protocol_data = {contents; signature = Some signature}} - in - let op_bytes = - Data_encoding.Binary.to_bytes_exn Operation.encoding (Operation.pack op) + let* signed_op_bytes = + Proto_client.sign_operation state.cctxt state.signer.sk unsigned_op in Tezos_shell_services.Shell_services.Injection.operation state.cctxt ~chain:state.cctxt#chain - op_bytes + signed_op_bytes >>=? fun oph -> let*! () = Event.(emit2 injected) state nb oph in return oph @@ -686,32 +580,30 @@ module Make (Parameters : PARAMETERS) = struct let rec inject_operations ~must_succeed state (operations : Inj_operation.t list) = let open Lwt_result_syntax in - let* packed_op, operations, result = + let* operations_results, raw_op = trace (Step_failed "simulation") @@ simulate_operations ~must_succeed state operations in - let (Contents_result_list contents_result) = result in let failure = ref false in - let* rev_non_failing_operations = - List.fold_left_es - (fun acc (index, op) -> - let open Lwt_result_syntax in - let*? status = operation_contents_status contents_result ~index in + let*! rev_non_failing_operations = + List.fold_left_s + (fun acc (op, {status; _}) -> + let open Lwt_syntax in match status with | Unsuccessful (Failed error) -> - let*! () = + let+ () = Event.(emit2 dropping_operation) state op.Inj_operation.operation error in failure := true ; - return acc + acc | Successful | Unsuccessful (Backtracked | Skipped | Other_branch) -> (* Not known to be failing *) return (op :: acc)) [] - operations + operations_results in if !failure then (* Invariant: must_succeed = `At_least_one, otherwise the simulation would @@ -723,53 +615,33 @@ module Make (Parameters : PARAMETERS) = struct (* Inject on node for real *) let+ oph = trace (Step_failed "injection") - @@ inject_on_node ~nb:(List.length operations) state packed_op + @@ inject_on_node ~nb:(List.length operations) state raw_op + in + let operations = + List.map + (fun (op, {index_in_batch; _}) -> (index_in_batch, op)) + operations_results in (oph, operations) (** Returns the (upper bound on) the size of an L1 batch of operations composed - of the manager operations [rev_ops]. *) - let size_l1_batch state rev_ops = - let contents_list = - List.map - (fun (op : Inj_operation.t) -> - let {fee; counter; gas_limit; storage_limit} = - Parameters.approximate_fee_bound state.state op.operation - in - let (Manager operation) = - POperation.to_manager_operation op.operation - in - let contents = - Manager_operation - { - source = state.signer.pkh; - operation; - fee; - counter; - gas_limit; - storage_limit; - } - in - Contents contents) - rev_ops + of the manager operations [ops]. *) + let size_l1_batch ops = + let size_shell_header = + (* Size of branch field *) + Block_hash.size in - let (Contents_list contents) = - match Operation.of_list contents_list with - | Error _ -> - (* Cannot happen: rev_ops is non empty and contains only manager - operations *) - assert false - | Ok packed_contents_list -> packed_contents_list - in - let signature = Tezos_crypto.Signature.zero in - let branch = Block_hash.zero in - let operation = - { - shell = {branch}; - protocol_data = Operation_data {contents; signature = Some signature}; - } + let signature_size = Signature.size Signature.zero in + let contents_size = + List.fold_left + (fun acc o -> + acc + + Proto_client.operation_size o.Inj_operation.operation + + Proto_client.operation_size_overhead) + 0 + ops in - Data_encoding.Binary.length Operation.encoding operation + size_shell_header + contents_size + signature_size (** Retrieve as many operations from the queue while remaining below the size limit. *) @@ -780,7 +652,7 @@ module Make (Parameters : PARAMETERS) = struct Op_queue.fold (fun _oph op ops -> let new_ops = op :: ops in - let new_size = size_l1_batch state new_ops in + let new_size = size_l1_batch new_ops in if new_size > size_limit then raise (Reached_limit ops) ; new_ops) state.queue @@ -817,7 +689,7 @@ module Make (Parameters : PARAMETERS) = struct not exceed [size_limit]. Upon successful injection, the operations are removed from the queue and marked as injected. *) let inject_pending_operations - ?(size_limit = Constants.max_operation_data_length) state = + ?(size_limit = Proto_client.max_operation_data_length) state = let open Lwt_result_syntax in (* Retrieve and remove operations from pending *) let operations_to_inject = get_operations_from_queue ~size_limit state in @@ -877,10 +749,9 @@ module Make (Parameters : PARAMETERS) = struct of level [level], by moving the successful ones from the "injected" state to the "included" state, and re-queuing the operations that should be retried. *) - let register_included_operation state block level - (operation : Alpha_block_services.operation) = + let register_included_operation state block level oph = let open Lwt_result_syntax in - let* injected_infos = remove_injected_operation state operation.hash in + let* injected_infos = remove_injected_operation state oph in match injected_infos with | [] -> (* No operations injected by us *) @@ -889,24 +760,20 @@ module Make (Parameters : PARAMETERS) = struct let* included, to_retry = List.fold_left_es (fun (included, to_retry) (info : injected_info) -> - let*? receipt = - match operation.receipt with - | Empty -> - error_with - "Empty receipt for %a" - Operation_hash.pp - operation.hash - | Too_large -> - error_with - "Receipt too large for %a" - Operation_hash.pp - operation.hash - | Receipt r -> Ok r + let* status = + Proto_client.operation_status + state.state + block + oph + ~index:info.op_index in - let*? status = operation_status receipt ~index:info.op_index in match status with - | Successful -> return (info :: included, to_retry) - | Unsuccessful status -> ( + | None -> + failwith + "Cannot get status for an operation which is not included \ + in the block" + | Some Successful -> return (info :: included, to_retry) + | Some (Unsuccessful status) -> ( let*! retry = Parameters.retry_unsuccessful_operation state.state @@ -927,18 +794,32 @@ module Make (Parameters : PARAMETERS) = struct (add_pending_operation ~retry:true state) (List.rev to_retry) - (** [register_included_operations state block level oph] marks the known (by - this injector) manager operations contained in [block] as being included. *) - let register_included_operations state - (block : Alpha_block_services.block_info) = + (** Retrieve operation hashes of a block with a small LRU cache. *) + let manager_operations_hashes_of_block = + let blocks_ops_cache = Block_cache.create 32 in + fun state block_hash -> + Block_cache.bind_or_put + blocks_ops_cache + block_hash + (fun block_hash -> + Tezos_shell_services.Shell_services.Blocks.Operation_hashes + .operation_hashes_in_pass + state.cctxt + ~chain:state.cctxt#chain + ~block:(`Hash (block_hash, 0)) + Proto_client.manager_pass) + Lwt.return + + (** [register_included_operations state (block, level)] marks the known (by + this injector) manager operations contained in [block] as being included. *) + let register_included_operations state (block_hash, level) = + let open Lwt_result_syntax in + let* operation_hashes = + manager_operations_hashes_of_block state block_hash + in List.iter_es - (List.iter_es (fun (op : Alpha_block_services.operation) -> - register_included_operation - state - block.hash - block.header.shell.level - op)) - block.Alpha_block_services.operations + (fun oph -> register_included_operation state block_hash level oph) + operation_hashes (** [revert_included_operations state block] marks the known (by this injector) manager operations contained in [block] as not being included any more, @@ -994,16 +875,14 @@ module Make (Parameters : PARAMETERS) = struct that are in the alternative branch of the reorganization and then registers the effect of the new branch (the newly included operation and confirmed operations). *) - let on_new_tezos_head state (head : Alpha_block_services.block_info) - (reorg : Alpha_block_services.block_info reorg) = + let on_new_tezos_head state (head_hash, head_level) + (reorg : (Block_hash.t * int32) reorg) = let open Lwt_result_syntax in - let*! () = Event.(emit1 new_tezos_head) state head.hash in + let*! () = Event.(emit1 new_tezos_head) state head_hash in let* () = List.iter_es - (fun removed_block -> - revert_included_operations - state - removed_block.Alpha_block_services.hash) + (fun (removed_block, _) -> + revert_included_operations state removed_block) (List.rev reorg.old_chain) in let* () = @@ -1013,11 +892,7 @@ module Make (Parameters : PARAMETERS) = struct in (* Head is already included in the reorganization, so no need to process it separately. *) - let confirmed_level = - Int32.sub - head.Alpha_block_services.header.shell.level - (Int32.of_int confirmations) - in + let confirmed_level = Int32.sub head_level (Int32.of_int confirmations) in if confirmed_level >= 0l then register_confirmed_level state confirmed_level else return_unit @@ -1029,8 +904,7 @@ module Make (Parameters : PARAMETERS) = struct type nonrec state = state type parameters = { - cctxt : Protocol_client_context.full; - constants : Constants.t; + cctxt : Client_context.full; data_dir : string; state : Parameters.state; retention_period : int; @@ -1071,13 +945,10 @@ module Make (Parameters : PARAMETERS) = struct type launch_error = error trace let on_launch _w signer - Types. - {cctxt; constants; data_dir; state; retention_period; strategy; tags} - = + Types.{cctxt; data_dir; state; retention_period; strategy; tags} = trace (Step_failed "initialization") @@ init_injector cctxt - constants ~data_dir state ~retention_period @@ -1118,8 +989,8 @@ module Make (Parameters : PARAMETERS) = struct (* TODO: https://gitlab.com/tezos/tezos/-/issues/2754 Injector worker in a separate process *) - let init (cctxt : #Protocol_client_context.full) ~data_dir - ?(retention_period = 0) state ~signers = + let init (cctxt : #Client_context.full) ~data_dir ?(retention_period = 0) + state ~signers = let open Lwt_result_syntax in assert (retention_period >= 0) ; let signers_map = @@ -1150,18 +1021,14 @@ module Make (Parameters : PARAMETERS) = struct Tezos_crypto.Signature.Public_key_hash.Map.empty signers in - let* constants = - Protocol.Constants_services.all cctxt (cctxt#chain, cctxt#block) - in - Tezos_crypto.Signature.Public_key_hash.Map.iter_es + Signature.Public_key_hash.Map.iter_es (fun signer (strategy, tags) -> let+ worker = Worker.launch table signer { - cctxt = (cctxt :> Protocol_client_context.full); - constants; + cctxt = (cctxt :> Client_context.full); data_dir; state; retention_period; @@ -1222,50 +1089,14 @@ module Make (Parameters : PARAMETERS) = struct true | Some tags -> not (Tags.disjoint state.tags tags) - let time_until_next_block constants (header : Tezos_base.Block_header.t) = - let open Result_syntax in - let Constants.Parametric.{minimal_block_delay; delay_increment_per_round; _} - = - constants.Constants.parametric - in - let next_level_timestamp = - let* durations = - Round.Durations.create - ~first_round_duration:minimal_block_delay - ~delay_increment_per_round - in - let* predecessor_round = Fitness.round_from_raw header.shell.fitness in - Round.timestamp_of_round - durations - ~predecessor_timestamp:header.shell.timestamp - ~predecessor_round - ~round:Round.zero - in - let next_level_timestamp = - Result.value - next_level_timestamp - ~default: - (WithExceptions.Result.get_ok - ~loc:__LOC__ - Timestamp.(header.shell.timestamp +? minimal_block_delay)) - in - Ptime.diff - (Time.System.of_protocol_exn next_level_timestamp) - (Time.System.now ()) - let delay_stategy state header f = let open Lwt_syntax in match state.strategy with | `Each_block -> f () | `Delay_block delay_factor -> let time_until_next_block = - match header with - | None -> - state.constants.Constants.parametric.minimal_block_delay - |> Period.to_seconds |> Int64.to_float - | Some header -> - time_until_next_block state.constants header - |> Ptime.Span.to_float_s + Proto_client.time_until_next_block state.state header + |> Ptime.Span.to_float_s in let delay = time_until_next_block *. delay_factor in if delay <= 0. then f () diff --git a/src/proto_016_PtMumbai/lib_injector/injector_functor.mli b/src/proto_016_PtMumbai/lib_injector/injector_functor.mli index 1c7d4f7c8f8c..ab5786a67469 100644 --- a/src/proto_016_PtMumbai/lib_injector/injector_functor.mli +++ b/src/proto_016_PtMumbai/lib_injector/injector_functor.mli @@ -25,7 +25,11 @@ open Injector_sigs -module Make (P : PARAMETERS) : +module Make + (P : PARAMETERS) + (_ : PROTOCOL_CLIENT + with type state := P.state + and type operation := P.Operation.t) : S with type state := P.state and type tag := P.Tag.t diff --git a/src/proto_016_PtMumbai/lib_injector/injector_sigs.ml b/src/proto_016_PtMumbai/lib_injector/injector_sigs.ml index f763dee30a82..684606ad49fc 100644 --- a/src/proto_016_PtMumbai/lib_injector/injector_sigs.ml +++ b/src/proto_016_PtMumbai/lib_injector/injector_sigs.ml @@ -23,15 +23,15 @@ (* *) (*****************************************************************************) -open Protocol.Alpha_context - -(** Type to represent {e appoximate upper-bounds} for the fee and limits, used - to compute an upper bound on the size (in bytes) of an operation. *) -type approximate_fee_bound = { - fee : Tez.t; - counter : Manager_counter.t; - gas_limit : Gas.Arith.integral; - storage_limit : Z.t; +type tez = {mutez : int64} + +type fee_parameter = { + minimal_fees : tez; + minimal_nanotez_per_byte : Q.t; + minimal_nanotez_per_gas_unit : Q.t; + force_low_fee : bool; + fee_cap : tez; + burn_cap : tez; } type injection_strategy = @@ -58,6 +58,13 @@ type unsuccessful_status = type operation_status = Successful | Unsuccessful of unsuccessful_status +type simulation_status = {index_in_batch : int; status : operation_status} + +type 'unsigned_op simulation_result = { + operations_statuses : simulation_status list; + unsigned_operation : 'unsigned_op; +} + (** Action to be taken for unsuccessful operation. *) type retry_action = | Retry (** The operation is retried by being re-queued for injection. *) @@ -84,9 +91,6 @@ module type PARAM_OPERATION = sig (** An encoding for injector's operations *) val encoding : t Data_encoding.t - (** Convert an injector operation to a manager_operation of the protocol *) - val to_manager_operation : t -> packed_manager_operation - (** Pretty-printing injector's operations *) val pp : Format.formatter -> t -> unit end @@ -144,14 +148,9 @@ module type PARAMETERS = sig persistent information. *) val operation_tag : Operation.t -> Tag.t - (** Returns the {e approximate upper-bounds} for the fee and limits of an - operation, used to compute an upper bound on the size (in bytes) for this - operation. *) - val approximate_fee_bound : state -> Operation.t -> approximate_fee_bound - (** Returns the fee_parameter (to compute fee w.r.t. gas, size, etc.) and the caps of fee and burn for each operation. *) - val fee_parameter : state -> Operation.t -> Injection.fee_parameter + val fee_parameter : state -> Operation.t -> fee_parameter (** When injecting the given [operations] in an L1 batch, if [batch_must_succeed operations] returns [`All] then all the operations must @@ -164,6 +163,71 @@ module type PARAMETERS = sig val batch_must_succeed : Operation.t list -> [`All | `At_least_one] end +module type PROTOCOL_CLIENT = sig + type state + + type operation + + type unsigned_operation + + val max_operation_data_length : int + + (** The validation pass of manager operations. *) + val manager_pass : int + + (** [operation_status block oph ~index] returns the status of the operation at + position [index] in the L1 batch [oph] included in the block [block]. It + returns [None] if the operation with the given index is not in the + block. *) + val operation_status : + state -> + Block_hash.t -> + Operation_hash.t -> + index:int -> + operation_status option tzresult Lwt.t + + (** Size of an operation in bytes according to the protocol. This only + accounts for the actual content of the corresponding manager operation + (and not its fees, gas, etc.). *) + val operation_size : operation -> int + + (** An upper bound of the overhead added to manager operations in + bytes. Typically, this would include the source, fees, counter, gas limit, + and storage limit. *) + val operation_size_overhead : int + + (** Simulating a batch of operations. This function returns the simulation + result for each of these operations (with its associated index in the + batch, in case there is a revelation operation added) together with a + Tezos raw unsigned operation that can be directly injected on a node if + one wishes to. *) + val simulate_operations : + #Client_context.full -> + force:bool -> + source:Signature.public_key_hash -> + src_pk:Signature.public_key -> + successor_level:bool -> + fee_parameter:fee_parameter -> + operation list -> + ( unsigned_operation simulation_result, + [`Exceeds_quotas of tztrace | `TzError of tztrace] ) + result + Lwt.t + + (** Sign an unsigned operation an return the serialized signed operation, + ready for injection. *) + val sign_operation : + #Client_context.full -> + Client_keys.sk_uri -> + unsigned_operation -> + bytes tzresult Lwt.t + + (** [time_until_next_block state block_header] computes the time until the + block following [block_header], with respect to the current time. *) + val time_until_next_block : + state -> Tezos_base.Block_header.t option -> Ptime.span +end + (** Output signature for functor {!Injector_functor.Make}. *) module type S = sig type state @@ -221,11 +285,11 @@ module type S = sig be useful to set this value to something [> 0] if we want to retrieve information about operations included on L1 for a given period. *) val init : - #Protocol_client_context.full -> + #Client_context.full -> data_dir:string -> ?retention_period:int -> state -> - signers:(public_key_hash * injection_strategy * tag list) list -> + signers:(Signature.public_key_hash * injection_strategy * tag list) list -> unit tzresult Lwt.t (** Add an operation as pending injection in the injector. If the source is @@ -233,16 +297,17 @@ module type S = sig corresponding tag. It returns the hash of the operation in the injector queue. *) val add_pending_operation : - ?source:public_key_hash -> operation -> Inj_operation.Hash.t tzresult Lwt.t + ?source:Signature.public_key_hash -> + operation -> + Inj_operation.Hash.t tzresult Lwt.t (** Notify the injector of a new Tezos head. The injector marks the operations appropriately (for instance reverted operations that are part of a reorganization are put back in the pending queue). When an operation is considered as {e confirmed}, it disappears from the injector. *) val new_tezos_head : - Protocol_client_context.Alpha_block_services.block_info -> - Protocol_client_context.Alpha_block_services.block_info - Injector_common.reorg -> + Block_hash.t * int32 -> + (Block_hash.t * int32) Injector_common.reorg -> unit Lwt.t (** Trigger an injection of the pending operations for all workers. If [tags] diff --git a/src/proto_016_PtMumbai/lib_injector/injector_worker_types.ml b/src/proto_016_PtMumbai/lib_injector/injector_worker_types.ml index 2d39e9243c78..8f56e02ec8a5 100644 --- a/src/proto_016_PtMumbai/lib_injector/injector_worker_types.ml +++ b/src/proto_016_PtMumbai/lib_injector/injector_worker_types.ml @@ -23,9 +23,6 @@ (* *) (*****************************************************************************) -open Protocol_client_context -open Protocol -open Alpha_context open Injector_common open Injector_sigs @@ -33,7 +30,7 @@ module Request (L1_operation : INJECTOR_OPERATION) = struct type ('a, 'b) t = | Add_pending : L1_operation.t -> (unit, error trace) t | New_tezos_head : - Alpha_block_services.block_info * Alpha_block_services.block_info reorg + (Block_hash.t * int32) * (Block_hash.t * int32) reorg -> (unit, error trace) t | Inject : (unit, error trace) t @@ -56,12 +53,13 @@ module Request (L1_operation : INJECTOR_OPERATION) = struct case (Tag 1) ~title:"New_tezos_head" - (obj3 + (let block_level = + obj2 (req "block" Block_hash.encoding) (req "level" int32) + in + obj3 (req "request" (constant "new_tezos_head")) - (req "head" Alpha_block_services.block_info_encoding) - (req - "reorg" - (reorg_encoding Alpha_block_services.block_info_encoding))) + (req "head" block_level) + (req "reorg" (reorg_encoding block_level))) (function | View (New_tezos_head (b, r)) -> Some ((), b, r) | _ -> None) (fun ((), b, r) -> View (New_tezos_head (b, r))); @@ -77,12 +75,13 @@ module Request (L1_operation : INJECTOR_OPERATION) = struct match r with | Add_pending op -> Format.fprintf ppf "request add %a to pending queue" L1_operation.pp op - | New_tezos_head (b, r) -> + | New_tezos_head ((block, level), r) -> Format.fprintf ppf - "switching to new Tezos head %a" + "switching to new Tezos head %a at level %ld" Block_hash.pp - b.Alpha_block_services.hash ; + block + level ; if r.old_chain <> [] || r.new_chain <> [] then Format.fprintf ppf @@ -93,7 +92,7 @@ module Request (L1_operation : INJECTOR_OPERATION) = struct end module Name = struct - type t = public_key_hash + type t = Signature.public_key_hash let encoding = Tezos_crypto.Signature.Public_key_hash.encoding diff --git a/src/proto_016_PtMumbai/lib_injector/injector_worker_types.mli b/src/proto_016_PtMumbai/lib_injector/injector_worker_types.mli index 15ce64197275..1f70c5a48df0 100644 --- a/src/proto_016_PtMumbai/lib_injector/injector_worker_types.mli +++ b/src/proto_016_PtMumbai/lib_injector/injector_worker_types.mli @@ -23,9 +23,6 @@ (* *) (*****************************************************************************) -open Protocol_client_context -open Protocol -open Alpha_context open Injector_common open Injector_sigs @@ -33,7 +30,7 @@ module Request (Inj_operation : INJECTOR_OPERATION) : sig type ('a, 'b) t = | Add_pending : Inj_operation.t -> (unit, error trace) t | New_tezos_head : - Alpha_block_services.block_info * Alpha_block_services.block_info reorg + (Block_hash.t * int32) * (Block_hash.t * int32) reorg -> (unit, error trace) t | Inject : (unit, error trace) t @@ -45,4 +42,4 @@ module Request (Inj_operation : INJECTOR_OPERATION) : sig and type view := view end -module Name : Worker_intf.NAME with type t = public_key_hash +module Name : Worker_intf.NAME with type t = Signature.public_key_hash diff --git a/src/proto_016_PtMumbai/lib_sc_rollup_node/daemon.ml b/src/proto_016_PtMumbai/lib_sc_rollup_node/daemon.ml index 4a44c41e4c31..c1cb9c240420 100644 --- a/src/proto_016_PtMumbai/lib_sc_rollup_node/daemon.ml +++ b/src/proto_016_PtMumbai/lib_sc_rollup_node/daemon.ml @@ -367,20 +367,20 @@ module Make (PVM : Pvm.S) = struct in return_unit - let notify_injector {Node_context.l1_ctxt; _} new_head - (reorg : Layer1.head Injector_common.reorg) = + let notify_injector new_head (reorg : Layer1.head Injector_common.reorg) = let open Lwt_result_syntax in let open Layer1 in - let* new_chain = - List.map_ep - (fun {hash; _} -> fetch_tezos_block l1_ctxt hash) - reorg.new_chain - and* old_chain = - List.map_ep - (fun {hash; _} -> fetch_tezos_block l1_ctxt hash) - reorg.old_chain + let new_chain = + List.map (fun {hash; level} -> (hash, level)) reorg.new_chain + in + let old_chain = + List.map (fun {hash; level} -> (hash, level)) reorg.old_chain + in + let*! () = + Injector.new_tezos_head + (new_head.hash, new_head.level) + {new_chain; old_chain} in - let*! () = Injector.new_tezos_head new_head {new_chain; old_chain} in return_unit (* [on_layer_1_head node_ctxt head] processes a new head from the L1. It @@ -428,7 +428,7 @@ module Make (PVM : Pvm.S) = struct let* () = List.iter_es (process_head node_ctxt) reorg.new_chain in let* () = Components.Commitment.Publisher.publish_commitments () in let* () = Components.Commitment.Publisher.cement_commitments () in - let* () = notify_injector node_ctxt new_head reorg in + let* () = notify_injector head reorg in let*! () = Daemon_event.new_heads_processed reorg.new_chain in let* () = Components.Refutation_game.process head node_ctxt in let* () = Components.Batcher.batch () in diff --git a/src/proto_016_PtMumbai/lib_sc_rollup_node/injector.ml b/src/proto_016_PtMumbai/lib_sc_rollup_node/injector.ml index 8bcb5fbd1622..3f4a3648e8fd 100644 --- a/src/proto_016_PtMumbai/lib_sc_rollup_node/injector.ml +++ b/src/proto_016_PtMumbai/lib_sc_rollup_node/injector.ml @@ -23,8 +23,12 @@ (* *) (*****************************************************************************) -open Protocol.Alpha_context +open Protocol +open Alpha_context open Injector_sigs +module Block_cache = + Aches_lwt.Lache.Make_result + (Aches.Rache.Transfer (Aches.Rache.LRU) (Block_hash)) module Parameters : PARAMETERS @@ -74,21 +78,23 @@ module Parameters : | Refute _ -> Refute let fee_parameter node_ctxt operation = - Node_context.get_fee_parameter node_ctxt (operation_tag operation) - - (* Below are dummy values that are only used to approximate the - size. It is thus important that they remain above the real - values if we want the computed size to be an over_approximation - (without having to do a simulation first). - - TODO: https://gitlab.com/tezos/tezos/-/issues/2812 - check the size, or compute them wrt operation kind *) - let approximate_fee_bound _ _ = + let { + Injection.minimal_fees; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap; + burn_cap; + } = + Node_context.get_fee_parameter node_ctxt (operation_tag operation) + in { - fee = Tez.of_mutez_exn 3_000_000L; - counter = Manager_counter.Internal_for_tests.of_int 500_000; - gas_limit = Gas.Arith.integral_of_int_exn 500_000; - storage_limit = Z.of_int 500_000; + minimal_fees = {mutez = Tez.to_mutez minimal_fees}; + minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit; + force_low_fee; + fee_cap = {mutez = Tez.to_mutez fee_cap}; + burn_cap = {mutez = Tez.to_mutez burn_cap}; } (* TODO: https://gitlab.com/tezos/tezos/-/issues/3459 @@ -143,4 +149,315 @@ module Parameters : | Publish _ -> return (Abort error)) end -include Injector_functor.Make (Parameters) +module Proto_client = struct + open Protocol_client_context + + type unsigned_operation = + Tezos_base.Operation.shell_header * packed_contents_list + + let max_operation_data_length = Constants.max_operation_data_length + + let manager_pass = Operation_repr.manager_pass + + let manager_operation_size (Manager operation) = + let contents = + Manager_operation + { + source = Signature.Public_key_hash.zero; + operation; + fee = Tez.zero; + counter = Manager_counter.Internal_for_tests.of_int 0; + gas_limit = Gas.Arith.zero; + storage_limit = Z.zero; + } + in + Data_encoding.Binary.length Operation.contents_encoding (Contents contents) + + let operation_size op = + manager_operation_size (L1_operation.to_manager_operation op) + + (* The operation size overhead is an upper bound (in practice) of the overhead + that will be added to a manager operation. To compute it we can use any + manager operation (here a revelation), add an overhead with upper bounds as + values (for the fees, limits, counters, etc.) and compare the encoded + operations with respect to their size. + NOTE: This information is only used to pre-select operations from the + injector queue as a candidate batch. *) + let operation_size_overhead = + let dummy_operation = + Reveal + (Signature.Public_key.of_b58check_exn + "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav") + in + let dummy_contents = + Manager_operation + { + source = Signature.Public_key_hash.zero; + operation = dummy_operation; + fee = Tez.of_mutez_exn 3_000_000L; + counter = Manager_counter.Internal_for_tests.of_int 500_000; + gas_limit = Gas.Arith.integral_of_int_exn 500_000; + storage_limit = Z.of_int 500_000; + } + in + let dummy_size = + Data_encoding.Binary.length + Operation.contents_encoding + (Contents dummy_contents) + in + dummy_size - manager_operation_size (Manager dummy_operation) + + let manager_operation_result_status (type kind) + (op_result : kind Apply_results.manager_operation_result) : + operation_status = + match op_result with + | Applied _ -> Successful + | Backtracked (_, None) -> Unsuccessful Backtracked + | Skipped _ -> Unsuccessful Skipped + | Backtracked (_, Some err) + (* Backtracked because internal operation failed *) + | Failed (_, err) -> + Unsuccessful (Failed (Environment.wrap_tztrace err)) + + let operation_result_status (type kind) + (op_result : kind Apply_results.contents_result) : operation_status = + match op_result with + | Preendorsement_result _ -> Successful + | Endorsement_result _ -> Successful + | Dal_attestation_result _ -> Successful + | Seed_nonce_revelation_result _ -> Successful + | Vdf_revelation_result _ -> Successful + | Double_endorsement_evidence_result _ -> Successful + | Double_preendorsement_evidence_result _ -> Successful + | Double_baking_evidence_result _ -> Successful + | Activate_account_result _ -> Successful + | Proposals_result -> Successful + | Ballot_result -> Successful + | Drain_delegate_result _ -> Successful + | Manager_operation_result {operation_result; _} -> + manager_operation_result_status operation_result + + let operation_contents_status (type kind) + (contents : kind Apply_results.contents_result_list) ~index : + operation_status tzresult = + let rec rec_status : + type kind. int -> kind Apply_results.contents_result_list -> _ = + fun n -> function + | Apply_results.Single_result _ when n <> 0 -> + error_with "No operation with index %d" index + | Single_result result -> Ok (operation_result_status result) + | Cons_result (result, _rest) when n = 0 -> + Ok (operation_result_status result) + | Cons_result (_result, rest) -> rec_status (n - 1) rest + in + rec_status index contents + + let operation_status_of_receipt (operation : Protocol.operation_receipt) + ~index : operation_status tzresult = + match (operation : _) with + | No_operation_metadata -> + error_with "Cannot find operation status because metadata is missing" + | Operation_metadata {contents} -> operation_contents_status contents ~index + + let get_block_operations = + let ops_cache = Block_cache.create 32 in + fun cctxt block_hash -> + Block_cache.bind_or_put + ops_cache + block_hash + (fun block_hash -> + let open Lwt_result_syntax in + let+ operations = + Alpha_block_services.Operations.operations_in_pass + cctxt + ~chain:cctxt#chain + ~block:(`Hash (block_hash, 0)) + ~metadata:`Always + manager_pass + in + List.fold_left + (fun acc (op : Alpha_block_services.operation) -> + Operation_hash.Map.add op.hash op acc) + Operation_hash.Map.empty + operations) + Lwt.return + + let operation_status (node_ctxt : Node_context.ro) block_hash operation_hash + ~index = + let open Lwt_result_syntax in + let* operations = get_block_operations node_ctxt.cctxt block_hash in + match Operation_hash.Map.find_opt operation_hash operations with + | None -> return_none + | Some operation -> ( + match operation.receipt with + | Empty -> + failwith "Cannot find operation status because metadata is empty" + | Too_large -> + failwith + "Cannot find operation status because metadata is too large" + | Receipt receipt -> + let*? status = operation_status_of_receipt receipt ~index in + return_some status) + + let dummy_sk_uri = + WithExceptions.Result.get_ok ~loc:__LOC__ + @@ Tezos_signer_backends.Unencrypted.make_sk + @@ Signature.Secret_key.of_b58check_exn + "edsk3UqeiQWXX7NFEY1wUs6J1t2ez5aQ3hEWdqX5Jr5edZiGLW8nZr" + + let simulate_operations cctxt ~force ~source ~src_pk ~successor_level + ~fee_parameter operations = + let open Lwt_result_syntax in + let fee_parameter : Injection.fee_parameter = + { + minimal_fees = Tez.of_mutez_exn fee_parameter.minimal_fees.mutez; + minimal_nanotez_per_byte = fee_parameter.minimal_nanotez_per_byte; + minimal_nanotez_per_gas_unit = + fee_parameter.minimal_nanotez_per_gas_unit; + force_low_fee = fee_parameter.force_low_fee; + fee_cap = Tez.of_mutez_exn fee_parameter.fee_cap.mutez; + burn_cap = Tez.of_mutez_exn fee_parameter.burn_cap.mutez; + } + in + let open Annotated_manager_operation in + let annotated_operations = + List.map + (fun operation -> + let (Manager operation) = + L1_operation.to_manager_operation operation + in + Annotated_manager_operation + (Injection.prepare_manager_operation + ~fee:Limit.unknown + ~gas_limit:Limit.unknown + ~storage_limit:Limit.unknown + operation)) + operations + in + let (Manager_list annot_op) = + Annotated_manager_operation.manager_of_list annotated_operations + in + let cctxt = + new Protocol_client_context.wrap_full (cctxt :> Client_context.full) + in + let*! simulation_result = + Injection.inject_manager_operation + cctxt + ~simulation:true (* Only simulation here *) + ~force + ~chain:cctxt#chain + ~block:(`Head 0) + ~source + ~src_pk + ~src_sk:dummy_sk_uri + (* Use dummy secret key as it is not used by simulation *) + ~successor_level + ~fee:Limit.unknown + ~gas_limit:Limit.unknown + ~storage_limit:Limit.unknown + ~fee_parameter + annot_op + in + match simulation_result with + | Error trace -> + let exceeds_quota = + TzTrace.fold + (fun exceeds -> function + | Environment.Ecoproto_error + (Gas.Block_quota_exceeded | Gas.Operation_quota_exceeded) -> + true + | _ -> exceeds) + false + trace + in + fail (if exceeds_quota then `Exceeds_quotas trace else `TzError trace) + | Ok (_oph, packed_op, _contents, results) -> + let nb_ops = List.length operations in + let results = Apply_results.to_list (Contents_result_list results) in + (* packed_op can have reveal operations added automatically. *) + let start_index = List.length results - nb_ops in + (* remove extra reveal operations *) + let operations_statuses = + List.fold_left_i + (fun index_in_batch acc (Apply_results.Contents_result result) -> + if index_in_batch < start_index then acc + else + {index_in_batch; status = operation_result_status result} :: acc) + [] + results + |> List.rev + in + let unsigned_operation = + let {shell; protocol_data = Operation_data {contents; signature = _}} + = + packed_op + in + (shell, Contents_list contents) + in + return {operations_statuses; unsigned_operation} + + let sign_operation cctxt src_sk + ((shell, Contents_list contents) as unsigned_op) = + let open Lwt_result_syntax in + let unsigned_bytes = + Data_encoding.Binary.to_bytes_exn Operation.unsigned_encoding unsigned_op + in + let cctxt = + new Protocol_client_context.wrap_full (cctxt :> Client_context.full) + in + let+ signature = + Client_keys.sign + cctxt + ~watermark:Signature.Generic_operation + src_sk + unsigned_bytes + in + let op : packed_operation = + { + shell; + protocol_data = Operation_data {contents; signature = Some signature}; + } + in + Data_encoding.Binary.to_bytes_exn Operation.encoding op + + let time_until_next_block (node_ctxt : Node_context.ro) + (header : Tezos_base.Block_header.t option) = + let open Result_syntax in + let Constants.Parametric.{minimal_block_delay; delay_increment_per_round; _} + = + node_ctxt.protocol_constants.Constants.parametric + in + match header with + | None -> + minimal_block_delay |> Period.to_seconds |> Int64.to_int + |> Ptime.Span.of_int_s + | Some header -> + let next_level_timestamp = + let* durations = + Round.Durations.create + ~first_round_duration:minimal_block_delay + ~delay_increment_per_round + in + let* predecessor_round = + Fitness.round_from_raw header.shell.fitness + in + Round.timestamp_of_round + durations + ~predecessor_timestamp:header.shell.timestamp + ~predecessor_round + ~round:Round.zero + in + let next_level_timestamp = + Result.value + next_level_timestamp + ~default: + (WithExceptions.Result.get_ok + ~loc:__LOC__ + Timestamp.(header.shell.timestamp +? minimal_block_delay)) + in + Ptime.diff + (Time.System.of_protocol_exn next_level_timestamp) + (Time.System.now ()) +end + +include Injector_functor.Make (Parameters) (Proto_client) diff --git a/src/proto_016_PtMumbai/lib_sc_rollup_node/layer1.ml b/src/proto_016_PtMumbai/lib_sc_rollup_node/layer1.ml index e83767528c57..419e1dcd784c 100644 --- a/src/proto_016_PtMumbai/lib_sc_rollup_node/layer1.ml +++ b/src/proto_016_PtMumbai/lib_sc_rollup_node/layer1.ml @@ -26,7 +26,7 @@ open Configuration open Protocol.Alpha_context open Plugin -open Injector_common +open Protocol_client_context (** @@ -241,25 +241,79 @@ let shutdown state = [hash]. Looks for the block in the blocks cache first, and fetches it from the L1 node otherwise. *) let fetch_tezos_shell_header l1_ctxt hash = + let open Lwt_syntax in trace (Cannot_find_block hash) - @@ fetch_tezos_shell_header - l1_ctxt.cctxt - hash - ~find_in_cache:(fun h fetch_by_rpc -> - let res = - Blocks_cache.bind l1_ctxt.blocks_cache h (function - | Some block_info -> Lwt.return_some block_info.header.shell - | None -> Lwt.return_none) - in - match res with Some lwt -> lwt | None -> fetch_by_rpc h) + @@ + let errors = ref None in + let fetch hash = + let* shell_header = + Tezos_shell_services.Shell_services.Blocks.Header.shell_header + l1_ctxt.cctxt + ~chain:`Main + ~block:(`Hash (hash, 0)) + () + in + match shell_header with + | Error errs -> + errors := Some errs ; + return_none + | Ok shell_header -> return_some shell_header + in + let+ shell_header = + let res = + Blocks_cache.bind l1_ctxt.blocks_cache hash (function + | Some block_info -> Lwt.return_some block_info.header.shell + | None -> Lwt.return_none) + in + match res with Some lwt -> lwt | None -> fetch hash + in + match (shell_header, !errors) with + | None, None -> + (* This should not happen if {!find_in_cache} behaves correctly, + i.e. calls {!fetch} for cache misses. *) + error_with + "Fetching Tezos block %a failed unexpectedly" + Block_hash.pp + hash + | None, Some errs -> Error errs + | Some shell_header, _ -> Ok shell_header (** [fetch_tezos_block l1_ctxt hash] returns a block info given a block hash. Looks for the block in the blocks cache first, and fetches it from the L1 node otherwise. *) let fetch_tezos_block l1_ctxt hash = + let open Lwt_syntax in trace (Cannot_find_block hash) - @@ fetch_tezos_block l1_ctxt.cctxt hash ~find_in_cache:(fun h fetch_by_rpc -> - Blocks_cache.bind_or_put l1_ctxt.blocks_cache h fetch_by_rpc Lwt.return) + @@ + let errors = ref None in + let fetch hash = + let* block = + Alpha_block_services.info + l1_ctxt.cctxt + ~chain:`Main + ~block:(`Hash (hash, 0)) + ~metadata:`Always + () + in + match block with + | Error errs -> + errors := Some errs ; + return_none + | Ok block -> return_some block + in + let+ block = + Blocks_cache.bind_or_put l1_ctxt.blocks_cache hash fetch Lwt.return + in + match (block, !errors) with + | None, None -> + (* This should not happen if {!find_in_cache} behaves correctly, + i.e. calls {!fetch} for cache misses. *) + error_with + "Fetching Tezos block %a failed unexpectedly" + Block_hash.pp + hash + | None, Some errs -> Error errs + | Some block, _ -> Ok block let nth_predecessor l1_state n block = let open Lwt_result_syntax in @@ -281,10 +335,11 @@ let get_tezos_reorg_for_new_head l1_state old_head new_head = let* old_head_pred = get_predecessor l1_state old_head in let* new_head_pred = get_predecessor l1_state new_head in let reorg = - { - old_chain = old_head :: reorg.old_chain; - new_chain = new_head :: reorg.new_chain; - } + Injector_common. + { + old_chain = old_head :: reorg.old_chain; + new_chain = new_head :: reorg.new_chain; + } in aux reorg old_head_pred new_head_pred in @@ -292,13 +347,14 @@ let get_tezos_reorg_for_new_head l1_state old_head new_head = level *) let distance = Int32.(to_int @@ abs @@ sub new_head.level old_head.level) in let* old_head, new_head, reorg = - if old_head.level = new_head.level then return (old_head, new_head, no_reorg) + if old_head.level = new_head.level then + return (old_head, new_head, Injector_common.no_reorg) else if old_head.level < new_head.level then let+ new_head, new_chain = nth_predecessor l1_state distance new_head in - (old_head, new_head, {no_reorg with new_chain}) + (old_head, new_head, {Injector_common.no_reorg with new_chain}) else let+ old_head, old_chain = nth_predecessor l1_state distance old_head in - (old_head, new_head, {no_reorg with old_chain}) + (old_head, new_head, {Injector_common.no_reorg with old_chain}) in assert (old_head.level = new_head.level) ; aux reorg old_head new_head @@ -309,7 +365,7 @@ let get_tezos_reorg_for_new_head l1_state old_head new_head = match old_head with | `Level l -> (* No known tezos head, we want all blocks from l. *) - if new_head.level < l then return no_reorg + if new_head.level < l then return Injector_common.no_reorg else let* _block_at_l, new_chain = nth_predecessor @@ -317,5 +373,5 @@ let get_tezos_reorg_for_new_head l1_state old_head new_head = (Int32.sub new_head.level l |> Int32.to_int) new_head in - return {old_chain = []; new_chain} + return Injector_common.{old_chain = []; new_chain} | `Head old_head -> get_tezos_reorg_for_new_head l1_state old_head new_head -- GitLab