diff --git a/etherlink/bin_node/lib_dev/evm_context.ml b/etherlink/bin_node/lib_dev/evm_context.ml index 0dacf40206ece6636476894d32c3cf19fe7d8883..c9b7fc98cbd546e97c40f0177ffbe95fec4ad596 100644 --- a/etherlink/bin_node/lib_dev/evm_context.ml +++ b/etherlink/bin_node/lib_dev/evm_context.ml @@ -55,7 +55,7 @@ type session_state = { only once the commits in Irmin and SQlite have been confirmed. *) mutable future_block_state : future_block_state option; (** This value starts at None to prevent inclusion confirmation - handling on an incomplete stream after startup. + handling on an incomplete stream after startup. In the case where we find a divergence between the next_blueprint_number and the one received by Next_block_info, we lock single transaction executions by setting this to None again. *) @@ -1764,7 +1764,7 @@ module State = struct | _ -> return_unit in Pvm.Context.load - (module Irmin_context) + (module Pvm.Irmin_context) ~cache_size:100_000 ~async_domain:true Read_write @@ -2508,7 +2508,7 @@ let init_context_from_rollup_node ~data_dir ~rollup_node_data_dir = in let* evm_node_index = Pvm.Context.load - (module Irmin_context) + (module Pvm.Irmin_context) ~cache_size:100_000 ~async_domain:true Read_write diff --git a/etherlink/bin_node/lib_dev/evm_ro_context.ml b/etherlink/bin_node/lib_dev/evm_ro_context.ml index 8c2686f2dcf9c237542b2c304061e262fa4ea159..6c397540e7f75a17175fc658e6807c9a3985a9a7 100644 --- a/etherlink/bin_node/lib_dev/evm_ro_context.ml +++ b/etherlink/bin_node/lib_dev/evm_ro_context.ml @@ -102,7 +102,7 @@ let load ~pool ?network ?smart_rollup_address (configuration : Configuration.t) let* index = Pvm.Context.( load - (module Irmin_context) + (module Pvm.Irmin_context) ~cache_size:100_000 Read_only (Evm_state.irmin_store_path ~data_dir:configuration.data_dir)) diff --git a/etherlink/bin_node/lib_dev/evm_state.ml b/etherlink/bin_node/lib_dev/evm_state.ml index 6eb745c06805fdb13c999978ce4c4d9b26b0a6b8..d8ed00794089c232e47c8ae31e16cf309fb86afb 100644 --- a/etherlink/bin_node/lib_dev/evm_state.ml +++ b/etherlink/bin_node/lib_dev/evm_state.ml @@ -186,7 +186,7 @@ let init_reboot_counter evm_state = let init ~kernel = let open Lwt_result_syntax in - let evm_state = Pvm.State.empty (module Irmin_context) () in + let evm_state = Pvm.State.empty (module Pvm.Irmin_context) () in let* evm_state = Pvm.Kernel.start ~tree:evm_state Tezos_scoru_wasm.Wasm_pvm_state.V3 kernel in diff --git a/etherlink/bin_node/lib_dev/pvm.ml b/etherlink/bin_node/lib_dev/pvm.ml index 49443a495e5a761e94be9860303ed09aaab45a16..61a8513acc45b6b7fe0c8cbb7b36b58c011fc7f1 100644 --- a/etherlink/bin_node/lib_dev/pvm.ml +++ b/etherlink/bin_node/lib_dev/pvm.ml @@ -18,7 +18,11 @@ module type S = sig (** Read only {!type:index}. *) type ro_index = [`Read] index - type 'a t = ('a, repo, tree) Context_sigs.t + type 'a t = { + index : 'a index; + tree : tree; + } + constraint 'a = [< `Read | `Write > `Read] (** Read/write context {!t}. *) type rw = [`Read | `Write] t @@ -27,7 +31,8 @@ module type S = sig committed to disk, i.e. the {!type:commit} hash. *) type hash - val equality_witness : (repo, tree) Context_sigs.equality_witness + val equality_witness : + repo Context_sigs.Equality_witness.t * tree Context_sigs.Equality_witness.t (** [load cache_size path] initializes from disk a context from [path]. [cache_size] allows to change the LRU cache size of Irmin @@ -120,7 +125,8 @@ module Context = struct let make_tree ~tree ~impl = Tree {tree; impl} - let equiv = Context.equiv + let equiv (a, b) (c, d) = + (Context_sigs.Equality_witness.eq a c, Context_sigs.Equality_witness.eq b d) let load : type tree repo. (repo, tree) impl -> @@ -202,6 +208,55 @@ module State = struct | _ -> raise (Invalid_argument "Implementation mismatch") end +module Irmin_context : + S + with type repo = Irmin_context.repo + and type tree = Irmin_context.tree + and type 'a index = 'a Irmin_context.index = struct + include Irmin_context + + type 'a t = { + index : 'a index; + tree : tree; + } + constraint 'a = [< `Read | `Write > `Read] + + type rw = [`Read | `Write] t + + let equality_witness = + let repo_eq_w, tree_eq_w, _ = Irmin_context.equality_witness in + (repo_eq_w, tree_eq_w) + + let commit ?message {index; tree} = + Irmin_context.commit ?message {index; state = ref tree} + + let checkout_exn index hash = + let open Lwt_syntax in + let+ {index; state} = Irmin_context.checkout_exn index hash in + {index; tree = !state} + + let empty index = + let {Context_sigs.index; state} = Irmin_context.empty index in + {index; tree = !state} + + module PVMState = struct + type value = Irmin_context.tree + + let empty () = !(Irmin_context.PVMState.empty ()) + + let get {index; tree} = + let open Lwt_syntax in + let+ state = Irmin_context.PVMState.get {index; state = ref tree} in + !state + + let set {index; tree} pvmstate = + let open Lwt_syntax in + let state = ref tree in + let+ () = Irmin_context.PVMState.set {index; state} (ref pvmstate) in + {index; tree = !state} + end +end + module Wasm_internal = struct let to_irmin_exn : Context.tree -> Irmin_context.tree = fun (Tree {tree; impl = (module Impl)}) -> diff --git a/etherlink/bin_node/lib_dev/pvm.mli b/etherlink/bin_node/lib_dev/pvm.mli index 4fcce0db1110b3dc2c5802e1c92e58c1f9300800..308a04c349bc84bbd7663e8b6d2b2d140d1bcab7 100644 --- a/etherlink/bin_node/lib_dev/pvm.mli +++ b/etherlink/bin_node/lib_dev/pvm.mli @@ -21,7 +21,11 @@ module type S = sig (** Read only {!type:index}. *) type ro_index = [`Read] index - type 'a t = ('a, repo, tree) Context_sigs.t + type 'a t = { + index : 'a index; + tree : tree; + } + constraint 'a = [< `Read | `Write > `Read] (** Read/write context {!t}. *) type rw = [`Read | `Write] t @@ -30,7 +34,8 @@ module type S = sig committed to disk, i.e. the {!type:commit} hash. *) type hash - val equality_witness : (repo, tree) Context_sigs.equality_witness + val equality_witness : + repo Context_sigs.Equality_witness.t * tree Context_sigs.Equality_witness.t (** [load cache_size path] initializes from disk a context from [path]. [cache_size] allows to change the LRU cache size of Irmin @@ -182,6 +187,12 @@ module State : sig val set : 'a Context.t -> t -> 'a Context.t Lwt.t end +module Irmin_context : + S + with type repo = Irmin_context.repo + and type tree = Irmin_context.tree + and type 'a index = 'a Irmin_context.index + (* TODO TZX-24: Only make `Wasm_internal` available when node is instantiated * with the Wasm PVM *) diff --git a/etherlink/lib_wasm_runtime_callbacks/vector.ml b/etherlink/lib_wasm_runtime_callbacks/vector.ml index f144b7119f6f5fbb21c38350b20021c2234aa78e..f888bc487988d862c794eade4dca0b0b99673690 100644 --- a/etherlink/lib_wasm_runtime_callbacks/vector.ml +++ b/etherlink/lib_wasm_runtime_callbacks/vector.ml @@ -70,7 +70,7 @@ let empty () = let open Lwt_syntax in let* tree = Irmin_context.Tree.add - (Irmin_context.PVMState.empty ()) + !(Irmin_context.PVMState.empty ()) ["length"] Data_encoding.(Binary.to_bytes_exn int64 0L) in diff --git a/src/bin_smart_rollup_node/dune b/src/bin_smart_rollup_node/dune index d8fa405c47bb88413c4c09077df5efe1dbe176ff..61c6fd118745776ee3725c19cba547cfcd9c5e83 100644 --- a/src/bin_smart_rollup_node/dune +++ b/src/bin_smart_rollup_node/dune @@ -17,26 +17,26 @@ octez-shell-libs.client-commands octez-l2-libs.smart-rollup octez-smart-rollup-node-lib - (select void_for_linking-octez_smart_rollup_node_PtNairob from - (octez_smart_rollup_node_PtNairob -> void_for_linking-octez_smart_rollup_node_PtNairob.empty) - (-> void_for_linking-octez_smart_rollup_node_PtNairob.empty)) - (select void_for_linking-octez_smart_rollup_node_Proxford from - (octez_smart_rollup_node_Proxford -> void_for_linking-octez_smart_rollup_node_Proxford.empty) - (-> void_for_linking-octez_smart_rollup_node_Proxford.empty)) - (select void_for_linking-octez_smart_rollup_node_PtParisB from - (octez_smart_rollup_node_PtParisB -> void_for_linking-octez_smart_rollup_node_PtParisB.empty) - (-> void_for_linking-octez_smart_rollup_node_PtParisB.empty)) - (select void_for_linking-octez_smart_rollup_node_PsParisC from - (octez_smart_rollup_node_PsParisC -> void_for_linking-octez_smart_rollup_node_PsParisC.empty) - (-> void_for_linking-octez_smart_rollup_node_PsParisC.empty)) - (select void_for_linking-octez_smart_rollup_node_PsQuebec from - (octez_smart_rollup_node_PsQuebec -> void_for_linking-octez_smart_rollup_node_PsQuebec.empty) - (-> void_for_linking-octez_smart_rollup_node_PsQuebec.empty)) - (select void_for_linking-octez_smart_rollup_node_PsRiotum from - (octez_smart_rollup_node_PsRiotum -> void_for_linking-octez_smart_rollup_node_PsRiotum.empty) - (-> void_for_linking-octez_smart_rollup_node_PsRiotum.empty)) - octez_smart_rollup_node_PtSeouLo - octez_smart_rollup_node_PtTALLiN + ; (select void_for_linking-octez_smart_rollup_node_PtNairob from + ; (octez_smart_rollup_node_PtNairob -> void_for_linking-octez_smart_rollup_node_PtNairob.empty) + ; (-> void_for_linking-octez_smart_rollup_node_PtNairob.empty)) + ; (select void_for_linking-octez_smart_rollup_node_Proxford from + ; (octez_smart_rollup_node_Proxford -> void_for_linking-octez_smart_rollup_node_Proxford.empty) + ; (-> void_for_linking-octez_smart_rollup_node_Proxford.empty)) + ; (select void_for_linking-octez_smart_rollup_node_PtParisB from + ; (octez_smart_rollup_node_PtParisB -> void_for_linking-octez_smart_rollup_node_PtParisB.empty) + ; (-> void_for_linking-octez_smart_rollup_node_PtParisB.empty)) + ; (select void_for_linking-octez_smart_rollup_node_PsParisC from + ; (octez_smart_rollup_node_PsParisC -> void_for_linking-octez_smart_rollup_node_PsParisC.empty) + ; (-> void_for_linking-octez_smart_rollup_node_PsParisC.empty)) + ; (select void_for_linking-octez_smart_rollup_node_PsQuebec from + ; (octez_smart_rollup_node_PsQuebec -> void_for_linking-octez_smart_rollup_node_PsQuebec.empty) + ; (-> void_for_linking-octez_smart_rollup_node_PsQuebec.empty)) + ; (select void_for_linking-octez_smart_rollup_node_PsRiotum from + ; (octez_smart_rollup_node_PsRiotum -> void_for_linking-octez_smart_rollup_node_PsRiotum.empty) + ; (-> void_for_linking-octez_smart_rollup_node_PsRiotum.empty)) + ; octez_smart_rollup_node_PtSeouLo + ; octez_smart_rollup_node_PtTALLiN (select void_for_linking-octez_smart_rollup_node_alpha from (octez_smart_rollup_node_alpha -> void_for_linking-octez_smart_rollup_node_alpha.empty) (-> void_for_linking-octez_smart_rollup_node_alpha.empty))) @@ -60,10 +60,10 @@ (rule (action (progn - (write-file void_for_linking-octez_smart_rollup_node_PtNairob.empty "") - (write-file void_for_linking-octez_smart_rollup_node_Proxford.empty "") - (write-file void_for_linking-octez_smart_rollup_node_PtParisB.empty "") - (write-file void_for_linking-octez_smart_rollup_node_PsParisC.empty "") - (write-file void_for_linking-octez_smart_rollup_node_PsQuebec.empty "") - (write-file void_for_linking-octez_smart_rollup_node_PsRiotum.empty "") + ; (write-file void_for_linking-octez_smart_rollup_node_PtNairob.empty "") + ; (write-file void_for_linking-octez_smart_rollup_node_Proxford.empty "") + ; (write-file void_for_linking-octez_smart_rollup_node_PtParisB.empty "") + ; (write-file void_for_linking-octez_smart_rollup_node_PsParisC.empty "") + ; (write-file void_for_linking-octez_smart_rollup_node_PsQuebec.empty "") + ; (write-file void_for_linking-octez_smart_rollup_node_PsRiotum.empty "") (write-file void_for_linking-octez_smart_rollup_node_alpha.empty "")))) diff --git a/src/lib_layer2_irmin_context/irmin_context.ml b/src/lib_layer2_irmin_context/irmin_context.ml index a07e902acb097b049b755b6da10b683bb4565cdc..f82e57a577ae3d40787ca458545d125c637b3d98 100644 --- a/src/lib_layer2_irmin_context/irmin_context.ml +++ b/src/lib_layer2_irmin_context/irmin_context.ml @@ -49,6 +49,8 @@ type repo = IStore.Repo.t type tree = IStore.tree +type state = tree + type mut_state = tree ref type 'a raw_index = ('a, repo) Context_sigs.raw_index @@ -59,7 +61,7 @@ type rw_index = [`Read | `Write] index type ro_index = [`Read] index -type 'a t = ('a, repo, tree) Context_sigs.t +type 'a t = ('a, repo, mut_state) Context_sigs.t type rw = [`Read | `Write] t @@ -92,8 +94,10 @@ let () = assert (Context_hash.size = IStore.Hash.hash_size) let impl_name = "Irmin" -let equality_witness : (repo, tree) Context_sigs.equality_witness = - (Context_sigs.Equality_witness.make (), Context_sigs.Equality_witness.make ()) +let equality_witness : (repo, tree, mut_state) Context_sigs.equality_witness = + ( Context_sigs.Equality_witness.make (), + Context_sigs.Equality_witness.make (), + Context_sigs.Equality_witness.make () ) let from_imm imm_state = ref imm_state @@ -140,7 +144,7 @@ let raw_commit ?(message = "") index tree = let commit ?message ctxt = let open Lwt_syntax in Opentelemetry_lwt.Trace.with_ ~service_name:"Irmin" "commit" @@ fun _ -> - let+ commit = raw_commit ?message ctxt.index ctxt.tree in + let+ commit = raw_commit ?message ctxt.index (to_imm ctxt.state) in IStore.Commit.hash commit let checkout index key = @@ -151,7 +155,7 @@ let checkout index key = | None -> return_none | Some commit -> let tree = IStore.Commit.tree commit in - return_some {index; tree} + return_some {index; state = from_imm tree} let checkout_exn index key = let open Lwt_syntax in @@ -160,9 +164,9 @@ let checkout_exn index key = | Some context -> return context | None -> Lwt.fail_with "No store found" -let empty index = {index; tree = IStore.Tree.empty ()} +let empty index = {index; state = from_imm (IStore.Tree.empty ())} -let is_empty ctxt = IStore.Tree.is_empty ctxt.tree +let is_empty ctxt = IStore.Tree.is_empty (to_imm ctxt.state) let split ctxt = IStore.split ctxt.repo @@ -299,15 +303,18 @@ end (** State of the PVM that this rollup node deals with. *) module PVMState = struct - type value = tree + type value = mut_state let key = ["pvm_state"] - let empty () = IStore.Tree.empty () + let empty () = IStore.Tree.empty () |> from_imm let find ctxt = Opentelemetry_lwt.Trace.with_ ~service_name:"Irmin" "PVMState.find" - @@ fun _ -> IStore.Tree.find_tree ctxt.tree key + @@ fun _ -> + let open Lwt_syntax in + let+ pvm_state = IStore.Tree.find_tree (to_imm ctxt.state) key in + Option.map from_imm pvm_state let get ctxt = let open Lwt_syntax in @@ -318,14 +325,14 @@ module PVMState = struct let lookup tree path = Opentelemetry_lwt.Trace.with_ ~service_name:"Irmin" "PVMState.lookup" - @@ fun _ -> IStore.Tree.find tree path + @@ fun _ -> IStore.Tree.find (to_imm tree) path let set ctxt state = let open Lwt_syntax in Opentelemetry_lwt.Trace.with_ ~service_name:"Irmin" "PVMState.set" @@ fun _ -> - let+ tree = IStore.Tree.add_tree ctxt.tree key state in - {ctxt with tree} + let+ tree = IStore.Tree.add_tree (to_imm ctxt.state) key (to_imm state) in + ctxt.state := tree end let load ~cache_size ?async_domain mode path = diff --git a/src/lib_layer2_irmin_context/irmin_context.mli b/src/lib_layer2_irmin_context/irmin_context.mli index 34f20b82bbffbff41d4cb9434a76f0aff78449ac..9a38c5139730c282f1efba5a09079775950483af 100644 --- a/src/lib_layer2_irmin_context/irmin_context.mli +++ b/src/lib_layer2_irmin_context/irmin_context.mli @@ -30,6 +30,8 @@ type repo (** The type of trees stored in the context, i.e. the actual data. *) type tree +type state = tree + type mut_state = tree ref type 'a raw_index = ('a, repo) Context_sigs.raw_index @@ -45,7 +47,7 @@ type rw_index = [`Read | `Write] index type ro_index = [`Read] index (** The type of context with its content. *) -type 'a t = ('a, repo, tree) Context_sigs.t +type 'a t = ('a, repo, mut_state) Context_sigs.t (** Read/write context {!t}. *) type rw = [`Read | `Write] t @@ -69,11 +71,11 @@ type commit val impl_name : string -val equality_witness : (repo, tree) Context_sigs.equality_witness +val equality_witness : (repo, state, mut_state) Context_sigs.equality_witness -val from_imm : tree -> mut_state +val from_imm : state -> mut_state -val to_imm : mut_state -> tree +val to_imm : mut_state -> state (** [load cache_size path] initializes from disk a context from [path]. [cache_size] allows to change the LRU cache size of Irmin @@ -215,7 +217,7 @@ end (** State of the PVM that this rollup node deals with *) module PVMState : sig (** The value of a PVM state *) - type value = tree + type value = mut_state (** [empty ()] is the empty PVM state. *) val empty : unit -> value @@ -229,10 +231,10 @@ module PVMState : sig state [state]. *) val lookup : value -> string list -> bytes option Lwt.t - (** [set context state] saves the PVM state [state] in the context and returns - the updated context. Note: [set] does not perform any write on disk, this - information must be committed using {!val:commit}. *) - val set : 'a t -> value -> 'a t Lwt.t + (** [set context state] saves the PVM state [state] in the context. Note: + [set] does not perform any write on disk, this information must be + committed using {!val:commit}. *) + val set : 'a t -> value -> unit Lwt.t end module Internal_for_tests : sig diff --git a/src/lib_layer2_riscv_context/riscv_context.ml b/src/lib_layer2_riscv_context/riscv_context.ml index bba73d7f33e3d50a9f5f419e32f57ed1fcd3a93c..3423278a682a120d1d49dd0aa91ff2b8716085e7 100644 --- a/src/lib_layer2_riscv_context/riscv_context.ml +++ b/src/lib_layer2_riscv_context/riscv_context.ml @@ -11,7 +11,7 @@ open Octez_riscv_pvm type repo = Storage.Repo.t -type tree = Storage.State.t +type state = Storage.State.t type 'a raw_index = ('a, repo) Context_sigs.raw_index @@ -21,18 +21,18 @@ type rw_index = [`Read | `Write] index let impl_name = "RISC-V" -module Mutable_state = struct - type t = Backend.Mutable_state.t +type mut_state = Storage.Mutable_state.t - let from_imm = Backend.Mutable_state.from_imm +let from_imm = Backend.Mutable_state.from_imm - let to_imm = Backend.Mutable_state.to_imm -end +let to_imm = Backend.Mutable_state.to_imm -let equality_witness : (repo, tree) Context_sigs.equality_witness = - (Context_sigs.Equality_witness.make (), Context_sigs.Equality_witness.make ()) +let equality_witness : (repo, state, mut_state) Context_sigs.equality_witness = + ( Context_sigs.Equality_witness.make (), + Context_sigs.Equality_witness.make (), + Context_sigs.Equality_witness.make () ) -type nonrec 'a t = ('a, repo, tree) t +type nonrec 'a t = ('a, repo, mut_state) t type hash = Storage.Id.t @@ -63,12 +63,12 @@ let readonly (index : [> `Read] index) = (index :> [`Read] index) let checkout index hash = let open Lwt_syntax in - let* tree = Storage.checkout index.repo hash in - Lwt.return (Option.bind tree (fun tree -> Some {index; tree})) + let+ state = Storage.checkout index.repo hash in + Option.map (fun state -> {index; state}) state -let empty index = {index; tree = Storage.empty ()} +let empty index = {index; state = Storage.empty ()} -let commit ?message ctxt = Storage.commit ?message ctxt.index.repo ctxt.tree +let commit ?message ctxt = Storage.commit ?message ctxt.index.repo ctxt.state let is_gc_finished index = Storage.is_gc_finished index.repo @@ -86,22 +86,19 @@ let export_snapshot {path = _; repo} hash ~path = Storage.export_snapshot repo hash path module PVMState = struct - type value = tree + type value = mut_state let empty () = Storage.empty () - let find ctxt = Storage.find ctxt.tree Storage.pvm_state_key + let find ctxt = Storage.find ctxt.state Storage.pvm_state_key let lookup tree path = Storage.lookup tree path - let set ctxt state = - let open Lwt_syntax in - let+ tree = Storage.set ctxt.tree Storage.pvm_state_key state in - {ctxt with tree} + let set ctxt state = Storage.set ctxt.state Storage.pvm_state_key state end module Internal_for_tests = struct let get_a_tree key = - let tree = Storage.empty () in + let tree = to_imm @@ Storage.empty () in Storage.add tree [key] Bytes.empty end diff --git a/src/lib_layer2_store/context.ml b/src/lib_layer2_store/context.ml index d3e30aeecb064cb8d8f78ce9d1d4fa9e7621a364..8b801ea03255939a87f2e7e0a0f19f164c8d2769 100644 --- a/src/lib_layer2_store/context.ml +++ b/src/lib_layer2_store/context.ml @@ -32,40 +32,74 @@ let err_implementation_mismatch ~expected ~got = open Context_sigs -type ('repo, 'tree) pvm_context_impl = - (module Context_sigs.S with type repo = 'repo and type tree = 'tree) +type ('repo, 'state, 'mut_state) pvm_context_impl = + (module Context_sigs.S + with type repo = 'repo + and type state = 'state + and type mut_state = 'mut_state) -let equiv (a, b) (c, d) = (Equality_witness.eq a c, Equality_witness.eq b d) +let equiv (r1, s1, m1) (r2, s2, m2) = + ( Equality_witness.eq r1 r2, + Equality_witness.eq s1 s2, + Equality_witness.eq m1 m2 ) module Hash = Smart_rollup_context_hash type hash = Hash.t -type ('a, 'repo, 'tree, 'loaded_tree) container = { - index : ('a, 'repo) index; - pvm_context_impl : ('repo, 'tree) pvm_context_impl; +type[@warning "-37"] 'a loaded = Loaded of 'a + +type[@warning "-37"] no_state = Index + +type ('a, 'state) loaded_state = + | No_state : ('a, no_state) loaded_state + | State : { + mode : 'a Access_mode.t; + v : 'state; + } + -> ('a, 'state loaded) loaded_state + +type ('index_access, + 'state_access, + 'repo, + 'state, + 'mut_state, + 'loaded_state) + container = { + index : ('index_access, 'repo) index; + pvm_context_impl : ('repo, 'state, 'mut_state) pvm_context_impl; impl_name : string; - tree : 'loaded_tree; - equality_witness : ('repo, 'tree) equality_witness; + state : ('state_access, 'loaded_state) loaded_state; + equality_witness : ('repo, 'state, 'mut_state) equality_witness; } + constraint 'state_access = [< `Read | `Write > `Read] -type 'a index = Index : ('a, 'repo, 'tree, unit) container -> 'a index +type 'a index = + | Index : ('a, 'b, 'repo, 'state, 'mut_state, no_state) container -> 'a index -type 'a t = Context : ('a, 'repo, 'tree, 'tree) container -> 'a t +type _ t' = + | Context : + ('a, 'b, 'repo, 'state, 'mut_state, 'mut_state loaded) container + -> < index : 'a ; state : 'b > t' -type ro = [`Read] t +type 'a t = 'a t' + constraint + 'a = + < index : [< `Read | `Write > `Read] ; state : [< `Read | `Write > `Read] > -type rw = [`Read | `Write] t +type ro = < index : [`Read] ; state : [`Read] > t + +type rw = < index : [`Read | `Write] ; state : [`Read | `Write] > t type ro_index = [`Read] index type rw_index = [`Read | `Write] index let make_index ~index ~pvm_context_impl ~equality_witness ~impl_name = - Index {index; tree = (); pvm_context_impl; equality_witness; impl_name} + Index {index; state = No_state; pvm_context_impl; equality_witness; impl_name} -let load : type tree repo. - (repo, tree) pvm_context_impl -> +let load : type state mut_state repo. + (repo, state, mut_state) pvm_context_impl -> cache_size:int -> 'a Access_mode.t -> string -> @@ -81,7 +115,8 @@ let load : type tree repo. ~impl_name ~equality_witness -let index (type a) (Context o : a t) : a index = Index {o with tree = ()} +let index (Context o : < index : 'a ; state : _ > t) : 'a index = + Index {o with state = No_state} let close (type a) (Index {pvm_context_impl = (module Pvm_Context_Impl); index; _} : a index) : @@ -93,28 +128,80 @@ let readonly (type a) a index) : ro_index = Index {o with index = Pvm_Context_Impl.readonly index} -let checkout (type a) +let readonly_context + (Context + ({ + pvm_context_impl = (module Pvm_Context_Impl); + index; + state = State {v; _}; + _; + } as o) : + _ t) : ro = + Context + { + o with + index = Pvm_Context_Impl.readonly index; + state = State {v; mode = Read_only}; + } + +let readonly_state + (Context + ({pvm_context_impl = (module Pvm_Context_Impl); state = State {v; _}; _} + as o) : + _ t) : < index : _ ; state : [`Read] > t = + Context {o with state = State {v; mode = Read_only}} + +let readonly_index + (Context ({pvm_context_impl = (module Pvm_Context_Impl); index; _} as o)) = + Context {o with index = Pvm_Context_Impl.readonly index} + +let access_mode_state + (Context + { + pvm_context_impl = (module Pvm_Context_Impl); + state = State {mode; _}; + _; + }) = + mode + +let checkout (Index ({pvm_context_impl = (module Pvm_Context_Impl); index; _} as o) : - a index) hash : a t option Lwt.t = + 'a index) hash : < index : 'a ; state : [`Read | `Write] > t option Lwt.t + = let open Lwt_syntax in let+ ctx = Pvm_Context_Impl.checkout index (Pvm_Context_Impl.hash_of_context_hash hash) in match ctx with | None -> None - | Some {index; tree} -> Some (Context {o with index; tree}) + | Some {index; state} -> + Some + (Context {o with index; state = State {v = state; mode = Read_write}}) -let empty (type a) +let empty (Index ({pvm_context_impl = (module Pvm_Context_Impl); index; _} as o) : - a index) : a t = - let {Context_sigs.index; tree} = Pvm_Context_Impl.empty index in - Context {o with index; tree} + 'a index) : < index : 'a ; state : [`Read | `Write] > t = + let {Context_sigs.index; state} = Pvm_Context_Impl.empty index in + Context {o with index; state = State {v = state; mode = Read_write}} + +let copy mode + (Context + ({pvm_context_impl = (module Pvm_Context_Impl); state = State {v; _}; _} + as o)) = + Context + {o with state = State {v = Pvm_Context_Impl.(from_imm @@ to_imm v); mode}} let commit ?message - (Context {pvm_context_impl = (module Pvm_Context_Impl); index; tree; _} : - [> `Write] t) = + (Context + { + pvm_context_impl = (module Pvm_Context_Impl); + index; + state = State {v = state; _}; + _; + } : + < index : [> `Write] ; state : _ > t) = let open Lwt_syntax in - let+ hash = Pvm_Context_Impl.commit ?message {index; tree} in + let+ hash = Pvm_Context_Impl.commit ?message {index; state} in Pvm_Context_Impl.context_hash_of_hash hash let is_gc_finished @@ -151,23 +238,27 @@ let export_snapshot (type a) index (Pvm_Context_Impl.hash_of_context_hash hash) -type pvmstate = +type 'a pvmstate' = | PVMState : { - pvm_context_impl : ('repo, 'tree) pvm_context_impl; + mode : 'a Access_mode.t; + pvm_context_impl : ('repo, 'state, 'mut_state) pvm_context_impl; impl_name : string; - pvmstate : 'tree; - equality_witness : ('repo, 'tree) equality_witness; + pvmstate : 'mut_state; + equality_witness : ('repo, 'state, 'mut_state) equality_witness; } - -> pvmstate + -> 'a pvmstate' + +type 'a pvmstate = 'a pvmstate' constraint 'a = [< `Read | `Write > `Read] -let make_pvmstate ~pvm_context_impl ~equality_witness ~impl_name ~pvmstate = - PVMState {pvm_context_impl; impl_name; pvmstate; equality_witness} +let make_pvmstate mode ~pvm_context_impl ~equality_witness ~impl_name ~pvmstate + = + PVMState {mode; pvm_context_impl; impl_name; pvmstate; equality_witness} (** State of the PVM that this rollup node deals with *) module PVMState = struct - type value = pvmstate + type 'a value = 'a pvmstate - let empty : type a. a index -> value = + let empty : type a. a index -> [`Read | `Write] value = fun (Index { pvm_context_impl = (module Pvm_Context_Impl); @@ -176,28 +267,30 @@ module PVMState = struct _; }) -> make_pvmstate + Access_mode.Read_write ~pvm_context_impl:(module Pvm_Context_Impl) ~equality_witness ~pvmstate:(Pvm_Context_Impl.PVMState.empty ()) ~impl_name - let find : type a. a t -> value option Lwt.t = + let find : < state : 'a ; index : _ > t -> 'a value option Lwt.t = fun (Context { pvm_context_impl = (module Pvm_Context_Impl); index; - tree; + state = State {v = state; mode}; equality_witness; impl_name; _; }) -> let open Lwt_syntax in - let+ pvmstate = Pvm_Context_Impl.PVMState.find {index; tree} in + let+ pvmstate = Pvm_Context_Impl.PVMState.find {index; state} in match pvmstate with | None -> None | Some pvmstate -> Some (make_pvmstate + mode ~pvm_context_impl:(module Pvm_Context_Impl) ~equality_witness ~pvmstate @@ -212,33 +305,68 @@ module PVMState = struct "Could not retrieve PVM state from context, this shouldn't happen." | Some pvm_state -> return pvm_state - let lookup : value -> string list -> bytes option Lwt.t = + let lookup : _ value -> string list -> bytes option Lwt.t = fun (PVMState {pvm_context_impl = (module Pvm_Context_Impl); pvmstate; _}) path -> Pvm_Context_Impl.PVMState.lookup pvmstate path - let set : type a. a t -> value -> a t Lwt.t = + let set : + < state : [`Read | `Write] ; index : _ > t -> + [`Read | `Write] value -> + unit Lwt.t = fun (Context - ({pvm_context_impl = (module Pvm_Context_Impl); index; tree; _} as o1)) + ({ + pvm_context_impl = (module Pvm_Context_Impl); + index; + state = State {v = state; _}; + _; + } as o1)) (PVMState o2) -> - let open Lwt_syntax in match equiv o1.equality_witness o2.equality_witness with - | Some Refl, Some Refl -> - let+ ctxt = Pvm_Context_Impl.PVMState.set {index; tree} o2.pvmstate in - Context {o1 with index = ctxt.index; tree = ctxt.tree} + | Some Refl, _, Some Refl -> + Pvm_Context_Impl.PVMState.set {index; state} o2.pvmstate | _ -> err_implementation_mismatch ~expected:o1.impl_name ~got:o2.impl_name + + let copy : _ value -> [`Read | `Write] value = + fun (PVMState + ({pvm_context_impl = (module Pvm_Context_Impl); pvmstate; _} as o)) -> + PVMState + { + o with + mode = Read_write; + pvmstate = + pvmstate |> Pvm_Context_Impl.to_imm |> Pvm_Context_Impl.from_imm; + } + + let readonly : 'a value -> [`Read] value = + fun (PVMState o) -> PVMState {o with mode = Read_only} + + let writable : [`Read] value -> [`Read | `Write] value = copy + + let access_mode (PVMState s) = s.mode + + let change_access (type a) (type b) ?(copy_on_rw = false) + (PVMState s : a pvmstate') (mode : b Access_mode.t) : b pvmstate' = + match (s.mode, mode) with + | Read_only, Read_only -> PVMState s + | Read_write, Read_write when copy_on_rw -> copy (PVMState s) + | Read_write, Read_write -> PVMState s + | Read_write, Read_only -> PVMState {s with mode = Read_only} + | Read_only, Read_write -> writable (PVMState s) end module Internal_for_tests = struct - let get_a_tree : (module Context_sigs.S) -> string -> pvmstate Lwt.t = + let get_a_tree : + (module Context_sigs.S) -> string -> [`Read | `Write] pvmstate Lwt.t = fun (module Pvm_Context_Impl) key -> let open Lwt_syntax in - let+ tree = Pvm_Context_Impl.Internal_for_tests.get_a_tree key in + let+ state = Pvm_Context_Impl.Internal_for_tests.get_a_tree key in make_pvmstate + Read_write ~pvm_context_impl:(module Pvm_Context_Impl) ~equality_witness:Pvm_Context_Impl.equality_witness ~impl_name:Pvm_Context_Impl.impl_name - ~pvmstate:tree + ~pvmstate:(Pvm_Context_Impl.from_imm state) end module Version = struct @@ -259,3 +387,101 @@ module Version = struct let to_string = function V0 -> "0" end + +module Wrapper = struct + module type S = sig + type repo + + type state + + type mut_state + + val of_node_context : 'a index -> ('a, repo) Context_sigs.index + + val to_node_context : ('a, repo) Context_sigs.index -> 'a index + + val of_node_pvmstate : _ pvmstate -> mut_state + + val to_node_pvmstate : mut_state -> Access_mode.rw pvmstate + + val from_imm : state -> mut_state + + val to_imm : mut_state -> state + end + + (* Context *) + let of_node_context : type repo state mut_state. + (repo, state, mut_state) equality_witness -> + 'a index -> + ('a, repo) Context_sigs.index = + fun eqw (Index {equality_witness; index; _}) -> + match equiv equality_witness eqw with + | Some Refl, _, _ -> index + | _ -> + (* This could happen if the context backend was to change for a + given pvm/rollup. For now we only use Irmin, if this changes, + this will demand to provide migration functions from prior + pmv_context to the next one. *) + assert false + + let to_node_context : type repo state mut_state. + (module Context_sigs.S + with type repo = repo + and type state = state + and type mut_state = mut_state) -> + ('a, repo) Context_sigs.index -> + 'a index = + fun (module C) index -> + make_index + ~index + ~pvm_context_impl:(module C) + ~equality_witness:C.equality_witness + ~impl_name:C.impl_name + + (* PVMState *) + let of_node_pvmstate : type repo state mut_state. + (repo, state, mut_state) equality_witness -> _ pvmstate -> mut_state = + fun eqw (PVMState {equality_witness; pvmstate; _}) -> + match equiv equality_witness eqw with + | _, _, Some Refl -> pvmstate + | _ -> assert false + + let to_node_pvmstate : type mut_state. + (module Context_sigs.S with type mut_state = mut_state) -> + mut_state -> + _ pvmstate = + fun (module C) pvmstate -> + make_pvmstate + Read_write + ~pvmstate + ~pvm_context_impl:(module C) + ~equality_witness:C.equality_witness + ~impl_name:C.impl_name + + module Make (C : Context_sigs.S) : + S + with type repo = C.repo + and type state = C.state + and type mut_state = C.mut_state = struct + type repo = C.repo + + type state = C.state + + type mut_state = C.mut_state + + let of_node_context : 'a index -> ('a, repo) Context_sigs.index = + fun ctxt -> of_node_context C.equality_witness ctxt + + let to_node_context : ('a, repo) Context_sigs.index -> 'a index = + fun ctxt -> to_node_context (module C) ctxt + + let of_node_pvmstate : _ pvmstate -> mut_state = + fun c -> of_node_pvmstate C.equality_witness c + + let to_node_pvmstate : mut_state -> _ pvmstate = to_node_pvmstate (module C) + + let from_imm : state -> mut_state = C.from_imm + + let to_imm : mut_state -> state = C.to_imm + end +end diff --git a/src/lib_layer2_store/context.mli b/src/lib_layer2_store/context.mli index c7daf6d7585e59e2f79a8d28866dd1a25aedec04..9e15800e3c83c6e01cd655091ca292391ca3eadb 100644 --- a/src/lib_layer2_store/context.mli +++ b/src/lib_layer2_store/context.mli @@ -24,38 +24,33 @@ (*****************************************************************************) (** This module is largely inspired from - {!module:Tezos_protocol_environment.Environement_context} *) + {!module:Tezos_protocol_environment.Environement_context}. -open Context_sigs - -(** This module dipatches context calls to contexts/pvm_states - corresponding to the used pvm *) + This module dipatches context calls to contexts/pvm_states + corresponding to the used pvm. *) (** See {!module:Tezos_protocol_environment.Environement_context.ops} *) -type ('repo, 'tree) pvm_context_impl = - (module Context_sigs.S with type repo = 'repo and type tree = 'tree) +type ('repo, 'state, 'mut_state) pvm_context_impl = + (module Context_sigs.S + with type repo = 'repo + and type state = 'state + and type mut_state = 'mut_state) (* Context existential that embeds the context_module associated to pvm protocol_plugins *) -(** See {!module:Tezos_protocol_environment.Environement_context.t} *) -type ('a, 'repo, 'tree, 'loaded_tree) container = private { - index : ('a, 'repo) index; - pvm_context_impl : ('repo, 'tree) pvm_context_impl; - impl_name : string; - tree : 'loaded_tree; - equality_witness : ('repo, 'tree) equality_witness; -} - -type 'a index = private Index : ('a, 'repo, 'tree, unit) container -> 'a index +type 'a index -type 'a t = private Context : ('a, 'repo, 'tree, 'tree) container -> 'a t +type 'a t + constraint + 'a = + < index : [< `Read | `Write > `Read] ; state : [< `Read | `Write > `Read] > (** Read/write context {!t}. *) -type rw = [`Read | `Write] t +type rw = < index : [`Read | `Write] ; state : [`Read | `Write] > t (** Read-only context {!t}. *) -type ro = [`Read] t +type ro = < index : [`Read] ; state : [`Read] > t (** Read/write {!index}. *) type rw_index = [`Read | `Write] index @@ -63,18 +58,6 @@ type rw_index = [`Read | `Write] index (** Read-only {!index}. *) type ro_index = [`Read] index -val make_index : - index:('a, 'b) Context_sigs.index -> - pvm_context_impl:('b, 'c) pvm_context_impl -> - equality_witness:('b, 'c) equality_witness -> - impl_name:string -> - 'a index - -val equiv : - 'a Equality_witness.t * 'b Equality_witness.t -> - 'c Equality_witness.t * 'd Equality_witness.t -> - ('a, 'c) Equality_witness.eq option * ('b, 'd) Equality_witness.eq option - module Hash = Smart_rollup_context_hash type hash = Hash.t @@ -84,14 +67,14 @@ type hash = Hash.t in use (for instance, the LRU cache size of Irmin (100_000 by default at irmin-pack/config.ml) *) val load : - ('repo, 'tree) pvm_context_impl -> + ('repo, 'state, 'mut_state) pvm_context_impl -> cache_size:int -> ([< `Read | `Write > `Read] as 'a) Access_mode.t -> string -> 'a index tzresult Lwt.t (** [index context] is the repository of the context [context]. *) -val index : 'a t -> 'a index +val index : < index : 'a ; state : _ > t -> 'a index (** [close ctxt] closes the context index [ctxt]. *) val close : 'a index -> unit Lwt.t @@ -99,18 +82,37 @@ val close : 'a index -> unit Lwt.t (** [readonly index] returns a read-only version of the index. *) val readonly : _ index -> [`Read] index +val readonly_context : _ t -> ro + +val readonly_state : + < index : 'a ; state : _ > t -> < index : 'a ; state : [`Read] > t + +val readonly_index : + < index : _ ; state : 'a > t -> < index : [`Read] ; state : 'a > t + +val access_mode_state : < index : _ ; state : 'a > t -> 'a Access_mode.t + (** [checkout ctxt hash] checkouts the content that corresponds to the commit hash [hash] in the repository [ctxt] and returns the corresponding context. If there is no commit that corresponds to [hash], it returns [None]. *) -val checkout : 'a index -> hash -> 'a t option Lwt.t +val checkout : + 'a index -> hash -> < index : 'a ; state : [`Read | `Write] > t option Lwt.t (** [empty ctxt] is the context with an empty content for the repository [ctxt]. *) -val empty : 'a index -> 'a t +val empty : 'a index -> < index : 'a ; state : [`Read | `Write] > t + +val copy : + 'a Access_mode.t -> + < index : 'b ; state : _ > t -> + < index : 'b ; state : 'a > t (** [commit ?message context] commits content of the context [context] on disk, and return the commit hash. *) -val commit : ?message:string -> [`Read | `Write] t -> hash Lwt.t +val commit : + ?message:string -> + < index : [`Read | `Write] ; state : [< `Read | `Write > `Read] > t -> + hash Lwt.t (** [is_gc_finished index] returns true if a GC is finished (or idle) and false if a GC is running for [index]. *) @@ -140,45 +142,52 @@ val export_snapshot : _ index -> hash -> path:string -> unit tzresult Lwt.t (* Pvm_state that embeds the context_module embedded associated to pvm protocol_plugins *) -type pvmstate = - | PVMState : { - pvm_context_impl : ('repo, 'tree) pvm_context_impl; - impl_name : string; - pvmstate : 'tree; - equality_witness : ('repo, 'tree) equality_witness; - } - -> pvmstate - -val make_pvmstate : - pvm_context_impl:('a, 'b) pvm_context_impl -> - equality_witness:('a, 'b) equality_witness -> - impl_name:string -> - pvmstate:'b -> - pvmstate +type 'a pvmstate constraint 'a = [< `Read | `Write > `Read] (** State of the PVM that this rollup node deals with *) module PVMState : sig (** The value of a PVM state *) - type value = pvmstate + type 'a value = 'a pvmstate (** [empty ()] is the empty PVM state. *) - val empty : 'a index -> value + val empty : 'a index -> [`Read | `Write] value (** [find context] returns the PVM state stored in the [context], if any. *) - val find : 'a t -> value option Lwt.t + val find : < state : 'a ; index : _ > t -> 'a value option Lwt.t (** [get context] is the same as {!find} but fails if there is no PVM state stored in the context. *) - val get : 'a t -> value tzresult Lwt.t + val get : < state : 'a ; index : _ > t -> 'a value tzresult Lwt.t (** [lookup state path] returns the data stored for the path [path] in the PVM state [state]. *) - val lookup : value -> string list -> bytes option Lwt.t + val lookup : _ value -> string list -> bytes option Lwt.t (** [set context state] saves the PVM state [state] in the context and returns the updated context. Note: [set] does not perform any write on disk, this information must be committed using {!val:commit}. *) - val set : 'a t -> value -> 'a t Lwt.t + val set : + < state : [`Read | `Write] ; index : _ > t -> + [`Read | `Write] value -> + unit Lwt.t + + (** Copy a (possibly mutable) PVM state. WARNING: Can incur a significant + memory allocation. *) + val copy : _ value -> [`Read | `Write] value + + (** Returns a read-only version of the state. Does not make any copy. *) + val readonly : _ value -> [`Read] value + + (** This is just an alias for copy. *) + val writable : [`Read] value -> [`Read | `Write] value + + val access_mode : 'a value -> 'a Access_mode.t + + (** [change_access state mode] makes [state] have access permissions + [mode]. WARNING: If [mode] is read-write and state has access mode + read-only, it will make a copy of the state. *) + val change_access : + ?copy_on_rw:bool -> 'a value -> 'b Access_mode.t -> 'b value end module Version : sig @@ -201,5 +210,47 @@ end module Internal_for_tests : sig (** [get_a_tree key] provides a value of internal type [tree] which can be used as a state to be set in the context directly. *) - val get_a_tree : (module Context_sigs.S) -> string -> pvmstate Lwt.t + val get_a_tree : + (module Context_sigs.S) -> string -> [`Read | `Write] pvmstate Lwt.t +end + +module Wrapper : sig + (** Context wrappers translate from/to node-context and node-pvmstate PVMs + internal representation to those used in the PVM. Also provides + conversion functions from/to mutable and immutable PVM types. Each + different PVM context will imply a dedicated wrapper.*) + module type S = sig + type repo + + type state + + (** Type used by the mutable API for PVMs *) + type mut_state + + val of_node_context : 'a index -> ('a, repo) Context_sigs.index + + val to_node_context : ('a, repo) Context_sigs.index -> 'a index + + (* TODO: erase access permissions on states because we don't track + permissions at the backend level (in the protocol plugins). We may need + to add this information if needed. *) + + (** WARNING: erase access permissions information. *) + val of_node_pvmstate : _ pvmstate -> mut_state + + (** WARNING: inject any access permissions information. *) + val to_node_pvmstate : mut_state -> Access_mode.rw pvmstate + + val from_imm : state -> mut_state + + val to_imm : mut_state -> state + end + + (** Specialized module to handle translation to/from a specific context + backend implementation *) + module Make (C : Context_sigs.S) : + S + with type repo = C.repo + and type state = C.state + and type mut_state = C.mut_state end diff --git a/src/lib_layer2_store/context_sigs.ml b/src/lib_layer2_store/context_sigs.ml index 1fcd6fe374101aeb925cd47b9622fa372356a913..eec8846102d3e08664d2d474084f737a5aea18b3 100644 --- a/src/lib_layer2_store/context_sigs.ml +++ b/src/lib_layer2_store/context_sigs.ml @@ -58,21 +58,24 @@ end = struct fun (module A) (module B) -> match A.Eq with B.Eq -> Some Refl | _ -> None end -type ('a, 'b) equality_witness = 'a Equality_witness.t * 'b Equality_witness.t +type ('a, 'b, 'c) equality_witness = + 'a Equality_witness.t * 'b Equality_witness.t * 'c Equality_witness.t type ('a, 'repo) raw_index = {path : string; repo : 'repo} type ('a, 'repo) index = ('a, 'repo) raw_index constraint 'a = [< `Read | `Write > `Read] -type ('a, 'repo, 'tree) t = { +type ('a, 'repo, 'state) t = { index : ('a, 'repo) index; - tree : 'tree; + state : 'state; } constraint 'a = [< `Read | `Write > `Read] module type S = sig - type tree + type state + + type mut_state type repo @@ -82,9 +85,9 @@ module type S = sig val impl_name : string - val equality_witness : (repo, tree) equality_witness + val equality_witness : (repo, state, mut_state) equality_witness - type nonrec 'a t = ('a, repo, tree) t + type nonrec 'a t = ('a, repo, mut_state) t (** [load cache_size path] initializes from disk a context from [path]. [cache_size] allows to change size of the Context Backend @@ -111,6 +114,10 @@ module type S = sig (** [empty ctxt] is the context with an empty content for the repository [ctxt]. *) val empty : 'a index -> 'a t + val to_imm : mut_state -> state + + val from_imm : state -> mut_state + (** [commit ?message context] commits content of the context [context] on disk, and return the commit hash. *) val commit : ?message:string -> [> `Write] t -> hash Lwt.t @@ -149,7 +156,7 @@ module type S = sig (** State of the PVM that this rollup node deals with *) module PVMState : sig (** The value of a PVM state *) - type value = tree + type value = mut_state (** [empty ()] is the empty PVM state. *) val empty : unit -> value @@ -161,15 +168,15 @@ module type S = sig state [state]. *) val lookup : value -> string list -> bytes option Lwt.t - (** [set context state] saves the PVM state [state] in the context and returns - the updated context. Note: [set] does not perform any write on disk, this - information must be committed using {!val:commit}. *) - val set : 'a t -> value -> 'a t Lwt.t + (** [set context state] saves the PVM state [state] in the context. Note: + [set] does not perform any write on disk, this information must be + committed using {!val:commit}. *) + val set : 'a t -> value -> unit Lwt.t end module Internal_for_tests : sig (** [get_a_tree key] provides a value of internal type [tree] which can be used as a state to be set in the context directly. *) - val get_a_tree : string -> tree Lwt.t + val get_a_tree : string -> state Lwt.t end end diff --git a/src/lib_protocol_environment/environment_V15.ml b/src/lib_protocol_environment/environment_V15.ml index cac5ea07215eca0e42c88a0ea60df016640d91f0..d9ac460935bc772bf3744bc0658978d215e434cd 100644 --- a/src/lib_protocol_environment/environment_V15.ml +++ b/src/lib_protocol_environment/environment_V15.ml @@ -1669,7 +1669,7 @@ struct let state_hash state = Backend.state_hash state - let empty_state () = Storage.empty () + let empty_state () = Backend.Mutable_state.to_imm @@ Storage.empty () let proof_start_state proof = Backend.proof_start_state proof diff --git a/src/lib_protocol_environment/environment_V16.ml b/src/lib_protocol_environment/environment_V16.ml index 1353dc8dfa078554f5d4e5a1b4a67c9713caab0b..dd5f4f75cbfdf880f4873679d27f7b4fa7bdaa18 100644 --- a/src/lib_protocol_environment/environment_V16.ml +++ b/src/lib_protocol_environment/environment_V16.ml @@ -1669,7 +1669,7 @@ struct let state_hash state = Backend.state_hash state - let empty_state () = Storage.empty () + let empty_state () = Backend.Mutable_state.to_imm @@ Storage.empty () let proof_start_state proof = Backend.proof_start_state proof diff --git a/src/lib_riscv/pvm/backend.ml b/src/lib_riscv/pvm/backend.ml index 01e3ca34abe1d57feeec943c6f907e38e78526e0..b9940a1610d74d2f3558008bd5036a00f17c7f17 100644 --- a/src/lib_riscv/pvm/backend.ml +++ b/src/lib_riscv/pvm/backend.ml @@ -126,6 +126,11 @@ module Mutable_state = struct let insert_failure state = Lwt.return @@ Api.octez_riscv_mut_insert_failure state + + let install_boot_sector state boot_sector = + Lwt.return + @@ Api.octez_riscv_mut_install_boot_sector state + @@ Bytes.of_string boot_sector end let compute_step_many ?reveal_builtins:_ ?write_debug ?stop_at_snapshot:_ diff --git a/src/lib_riscv/pvm/backend.mli b/src/lib_riscv/pvm/backend.mli index d2bd5b912b56ddcfeb8b8cda15ec32ad23ad1759..9a3b56157a5780179f33230a07edabbfc27e8dfc 100644 --- a/src/lib_riscv/pvm/backend.mli +++ b/src/lib_riscv/pvm/backend.mli @@ -70,6 +70,8 @@ module Mutable_state : sig val get_reveal_request : t -> string Lwt.t val insert_failure : t -> unit Lwt.t + + val install_boot_sector : t -> string -> unit Lwt.t end val compute_step_many : diff --git a/src/lib_riscv/pvm/storage.ml b/src/lib_riscv/pvm/storage.ml index abcf9fc3ac56dc72b2ebb09276879db8e0ae2f06..d27b803927ce1bd7dc4087137a5621ed4e12abe6 100644 --- a/src/lib_riscv/pvm/storage.ml +++ b/src/lib_riscv/pvm/storage.ml @@ -17,6 +17,13 @@ module State = struct let equal state1 state2 = Api.octez_riscv_storage_state_equal state1 state2 end +module Mutable_state = struct + type t = Api.mut_state + + let equal state1 state2 = + Api.octez_riscv_storage_mut_state_equal state1 state2 +end + module Id = struct type t = Api.id @@ -38,7 +45,7 @@ let close repo = let checkout repo id = Lwt.return (Api.octez_riscv_storage_checkout repo id) -let empty () = Api.octez_riscv_storage_state_empty () +let empty () = Api.octez_riscv_storage_mut_state_empty () let commit ?message:_ repo state = Lwt.return (Api.octez_riscv_storage_commit repo state) @@ -68,10 +75,15 @@ let find state key = (* Only used to inspect the durable storage, currently not supported *) let lookup _state _key = raise (Invalid_argument "lookup not implemented") -let set _state key substate = +let set state key substate = (* The entire context is the PVM state, no other keys are supported *) - if key == pvm_state_key then Lwt.return substate - else raise (Invalid_argument "key not supported") + if key != pvm_state_key then raise (Invalid_argument "key not supported") ; + (* substate should have been obtained by modifying state *) + if state != substate then + raise + (Invalid_argument + "state update not supported, modify mutable state instead") ; + Lwt.return_unit (* Only used for internal testing of the rollup node, not supported *) let add _state _key _bytes = raise (Invalid_argument "add not implemented") diff --git a/src/lib_riscv/pvm/storage.mli b/src/lib_riscv/pvm/storage.mli index 36bb1c7a3760002fec07d89c68b4ca57c3df69b6..664ed24423a396b19fbfe1286da51203f88243eb 100644 --- a/src/lib_riscv/pvm/storage.mli +++ b/src/lib_riscv/pvm/storage.mli @@ -15,6 +15,12 @@ module State : sig val equal : t -> t -> bool end +module Mutable_state : sig + type t = Octez_riscv_api.mut_state + + val equal : t -> t -> bool +end + module Id : sig type t @@ -29,11 +35,11 @@ val load : cache_size:int -> readonly:bool -> string -> Repo.t Lwt.t val close : Repo.t -> unit Lwt.t -val checkout : Repo.t -> Id.t -> State.t option Lwt.t +val checkout : Repo.t -> Id.t -> Mutable_state.t option Lwt.t -val empty : unit -> State.t +val empty : unit -> Mutable_state.t -val commit : ?message:string -> Repo.t -> State.t -> Id.t Lwt.t +val commit : ?message:string -> Repo.t -> Mutable_state.t -> Id.t Lwt.t val is_gc_finished : Repo.t -> bool @@ -49,10 +55,10 @@ val export_snapshot : Repo.t -> Id.t -> string -> unit tzresult Lwt.t val pvm_state_key : string list -val find : State.t -> string list -> State.t option Lwt.t +val find : Mutable_state.t -> string list -> Mutable_state.t option Lwt.t -val lookup : State.t -> string list -> bytes option Lwt.t +val lookup : Mutable_state.t -> string list -> bytes option Lwt.t -val set : State.t -> string list -> State.t -> State.t Lwt.t +val set : Mutable_state.t -> string list -> Mutable_state.t -> unit Lwt.t val add : State.t -> string list -> bytes -> State.t Lwt.t diff --git a/src/lib_smart_rollup_node/interpreter.ml b/src/lib_smart_rollup_node/interpreter.ml index 8cc0a391365c6d67ae28616664d940e8f36653fa..a98e039323f3f2a30be5782cde2addc765ee74e0 100644 --- a/src/lib_smart_rollup_node/interpreter.ml +++ b/src/lib_smart_rollup_node/interpreter.ml @@ -48,7 +48,7 @@ let apply_unsafe_patches (module Plugin : Protocol_plugin_sig.PARTIAL) (node_ctxt.unsafe_patches :> (Pvm_patches.unsafe_patch * Pvm_patches.kind) list) with - | [] -> return state + | [] -> return_unit | patches -> let has_user_provided_patches = List.exists @@ -74,17 +74,35 @@ let apply_unsafe_patches (module Plugin : Protocol_plugin_sig.PARTIAL) private_rollup Rollup_node_errors.Cannot_patch_pvm_of_public_rollup in - List.fold_left_es - (fun state (patch, _kind) -> + List.iter_es + (fun (patch, _kind) -> let*! () = Interpreter_event.patching_genesis_state patch in Plugin.Pvm.Unsafe.apply_patch node_ctxt.kind state patch) - state patches -type original_genesis_state = Original of Context.pvmstate +type patched = Patched -let genesis_state (module Plugin : Protocol_plugin_sig.PARTIAL) ?genesis_block - node_ctxt = +type unpatched = Unpatched + +type both = Both + +type _ genesis_state = + | Patched : Access_mode.rw Context.pvmstate -> patched genesis_state + | Unpatched : Access_mode.rw Context.pvmstate -> unpatched genesis_state + | Both : { + patched : Access_mode.rw Context.pvmstate; + original : Access_mode.rw Context.pvmstate; + } + -> both genesis_state + +type _ genesis_state_mode = + | Patched : patched genesis_state_mode + | Unpatched : unpatched genesis_state_mode + | Both : both genesis_state_mode + +let genesis_state (type m) (mode : m genesis_state_mode) + (module Plugin : Protocol_plugin_sig.PARTIAL) ?genesis_block node_ctxt : + m genesis_state tzresult Lwt.t = let open Lwt_result_syntax in let* genesis_block_hash = match genesis_block with @@ -94,18 +112,25 @@ let genesis_state (module Plugin : Protocol_plugin_sig.PARTIAL) ?genesis_block let* boot_sector = get_boot_sector (module Plugin) genesis_block_hash node_ctxt in - let*! initial_state = Plugin.Pvm.initial_state node_ctxt.kind in - let*! unpatched_genesis_state = - Plugin.Pvm.install_boot_sector node_ctxt.kind initial_state boot_sector - in - let* genesis_state = - apply_unsafe_patches - (module Plugin) - node_ctxt - ~genesis_block_hash - unpatched_genesis_state - in - return (genesis_state, Original unpatched_genesis_state) + (* Genesis state *) + let*! state = Plugin.Pvm.initial_state node_ctxt.kind in + (* Unpatched genesis state *) + let*! () = Plugin.Pvm.install_boot_sector node_ctxt.kind state boot_sector in + match mode with + | Unpatched -> return (Unpatched state : m genesis_state) + | Patched -> + (* Patch genesis state *) + let* () = + apply_unsafe_patches (module Plugin) node_ctxt ~genesis_block_hash state + in + return (Patched state : m genesis_state) + | Both -> + (* Copy and patch genesis state *) + let original = Context.PVMState.copy state in + let* () = + apply_unsafe_patches (module Plugin) node_ctxt ~genesis_block_hash state + in + return (Both {patched = state; original} : m genesis_state) let state_of_head plugin node_ctxt ctxt Layer1.{hash; level} = let open Lwt_result_syntax in @@ -114,8 +139,11 @@ let state_of_head plugin node_ctxt ctxt Layer1.{hash; level} = | None -> let genesis_level = node_ctxt.Node_context.genesis_info.level in if level = genesis_level then - let+ state, _ = genesis_state plugin ~genesis_block:hash node_ctxt in - state + let+ (Patched state) = + genesis_state Patched plugin ~genesis_block:hash node_ctxt + in + let mode = Context.access_mode_state ctxt in + Context.PVMState.change_access state mode else tzfail (Rollup_node_errors.Missing_PVM_state (hash, level)) | Some state -> return state @@ -144,12 +172,12 @@ let transition_pvm (module Plugin : Protocol_plugin_sig.PARTIAL) node_ctxt ctxt inbox_messages predecessor_state in - let*! ctxt = Context.PVMState.set ctxt state in + let*! () = Context.PVMState.set ctxt state in (* Produce events. *) let*! () = Interpreter_event.transitioned_pvm inbox_level state_hash tick num_messages in - return (ctxt, num_messages, Z.to_int64 num_ticks, initial_tick) + return (num_messages, Z.to_int64 num_ticks, initial_tick) (** [process_head plugin node_ctxt ctxt ~predecessor head inbox_and_messages] runs the PVM for the given head. *) @@ -160,10 +188,12 @@ let process_head plugin (node_ctxt : _ Node_context.t) ctxt if head.level >= first_inbox_level then transition_pvm plugin node_ctxt ctxt predecessor head inbox_and_messages else if head.level = node_ctxt.genesis_info.level then - let* state, _ = genesis_state plugin ~genesis_block:head.hash node_ctxt in - let*! ctxt = Context.PVMState.set ctxt state in - return (ctxt, 0, 0L, Z.zero) - else return (ctxt, 0, 0L, Z.zero) + let* (Patched state) = + genesis_state Patched plugin ~genesis_block:head.hash node_ctxt + in + let*! () = Context.PVMState.set ctxt state in + return (0, 0L, Z.zero) + else return (0, 0L, Z.zero) (** Returns the starting evaluation before the evaluation of the block. It contains the PVM state at the end of the execution of the previous block and diff --git a/src/lib_smart_rollup_node/interpreter.mli b/src/lib_smart_rollup_node/interpreter.mli index 2e4284bb763fb06880bf2791140e116ae5621049..4a8854f31cef63642cb4ab01a85765828340cf10 100644 --- a/src/lib_smart_rollup_node/interpreter.mli +++ b/src/lib_smart_rollup_node/interpreter.mli @@ -34,13 +34,31 @@ val process_head : (module Protocol_plugin_sig.PARTIAL) -> _ Node_context.t -> - 'a Context.t -> + < index : _ ; state : Access_mode.rw > Context.t -> predecessor:Layer1.head -> Layer1.head -> Octez_smart_rollup.Inbox.t * string list -> - ('a Context.t * int * int64 * Z.t) tzresult Lwt.t + (int * int64 * Z.t) tzresult Lwt.t -type original_genesis_state = Original of Context.pvmstate +type patched = Patched + +type unpatched = Unpatched + +type both = Both + +type _ genesis_state = + | Patched : Access_mode.rw Context.pvmstate -> patched genesis_state + | Unpatched : Access_mode.rw Context.pvmstate -> unpatched genesis_state + | Both : { + patched : Access_mode.rw Context.pvmstate; + original : Access_mode.rw Context.pvmstate; + } + -> both genesis_state + +type _ genesis_state_mode = + | Patched : patched genesis_state_mode + | Unpatched : unpatched genesis_state_mode + | Both : both genesis_state_mode (** [genesis_state plugin ?genesis_block node_ctxt] returns a pair [s1, s2] where [s1] is the PVM state at the genesis block and [s2] is the genesis @@ -48,10 +66,11 @@ type original_genesis_state = Original of Context.pvmstate genesis commitment. If there are no unsafe patches for the rollup [s2] is the same as [s1]. *) val genesis_state : + 'm genesis_state_mode -> (module Protocol_plugin_sig.PARTIAL) -> ?genesis_block:Block_hash.t -> _ Node_context.t -> - (Context.pvmstate * original_genesis_state) tzresult Lwt.t + 'm genesis_state tzresult Lwt.t (** [state_of_tick plugin node_ctxt cache ?start_state ~tick level] returns [Some state] for a given [tick] if this [tick] happened before [level] and where @@ -73,6 +92,6 @@ val state_of_tick : val state_of_head : (module Protocol_plugin_sig.PARTIAL) -> < context : 'a ; store : _ > Node_context.t -> - 'a Context.t -> + < index : 'a ; state : 'b > Context.t -> Layer1.head -> - Context.pvmstate tzresult Lwt.t + 'b Context.pvmstate tzresult Lwt.t diff --git a/src/lib_smart_rollup_node/node_context.ml b/src/lib_smart_rollup_node/node_context.ml index 13749e9bde9a6954bff2a6b9c72811df72b4a6f1..e51875557fe6bab999b97d8f7916f353dccfa67d 100644 --- a/src/lib_smart_rollup_node/node_context.ml +++ b/src/lib_smart_rollup_node/node_context.ml @@ -32,6 +32,14 @@ type genesis_info = Metadata.genesis_info = { commitment_hash : Commitment.Hash.t; } +type context_status = Valid | Dirty + +type 'index context_state = { + ctxt : < index : 'index ; state : Access_mode.rw > Context.t; + status : context_status; + block : Layer1.header; +} + type 'a store = 'a Store.t constraint 'a = [< `Read | `Write > `Read] module Node_store = struct @@ -114,6 +122,8 @@ type 'a t = { sync : sync_info; } constraint 'a = < store : 'store ; context : 'context > + constraint 'store = [< `Read | `Write > `Read] + constraint 'context = [< `Read | `Write > `Read] type rw = < store : [`Read | `Write] ; context : [`Read | `Write] > t diff --git a/src/lib_smart_rollup_node/node_context.mli b/src/lib_smart_rollup_node/node_context.mli index 4412bfe4f3e00a0bb83a46e5ca8173d00f00a8a2..0b72543cb5af2ad1205f37f2706871c201d2c6e6 100644 --- a/src/lib_smart_rollup_node/node_context.mli +++ b/src/lib_smart_rollup_node/node_context.mli @@ -34,6 +34,14 @@ type genesis_info = Metadata.genesis_info = { commitment_hash : Commitment.Hash.t; } +type context_status = Valid | Dirty + +type 'index context_state = { + ctxt : < index : 'index ; state : Access_mode.rw > Context.t; + status : context_status; + block : Layer1.header; +} + (** Abstract type for store to force access through this module. *) type 'a store constraint 'a = [< `Read | `Write > `Read] @@ -132,6 +140,8 @@ type 'a t = { sync : sync_info; (** Synchronization status with respect to the L1 node. *) } constraint 'a = < store : 'store ; context : 'context > + constraint 'store = [< `Read | `Write > `Read] + constraint 'context = [< `Read | `Write > `Read] (** Read/write node context {!t}. *) type rw = < store : [`Read | `Write] ; context : [`Read | `Write] > t @@ -197,7 +207,9 @@ val gc_lockfile_path : data_dir:string -> string (** [checkout_context node_ctxt block_hash] returns the context at block [block_hash]. *) val checkout_context : - < store : _ ; context : 'a > t -> Block_hash.t -> 'a Context.t tzresult Lwt.t + < store : _ ; context : 'a > t -> + Block_hash.t -> + < index : 'a ; state : Access_mode.rw > Context.t tzresult Lwt.t (** Returns [true] if the rollup node supports the DAL and if DAL is enabled for the current protocol. *) @@ -254,7 +266,7 @@ val find_l2_block_by_level : val get_full_l2_block : ?get_outbox_messages: ('a t -> - Context.pvmstate -> + Access_mode.rw Context.pvmstate -> outbox_level:int32 -> (int * Outbox_message.summary) list Lwt.t) -> 'a t -> diff --git a/src/lib_smart_rollup_node/protocol_plugin_sig.ml b/src/lib_smart_rollup_node/protocol_plugin_sig.ml index 0b49f3da9b04400bee2ae104a2da748fcd0273d0..84aaae8f6ab7e4b49c015b0009e9793e89dc9915 100644 --- a/src/lib_smart_rollup_node/protocol_plugin_sig.ml +++ b/src/lib_smart_rollup_node/protocol_plugin_sig.ml @@ -29,7 +29,7 @@ module type RPC_DIRECTORY = sig (** The RPC directory, specific to blocks of the protocol, for this rollup node. *) val block_directory : - Node_context.rw -> + Rpc_context.rw -> (unit * Rollup_node_services.Arg.block_id) Tezos_rpc.Directory.t end @@ -219,7 +219,7 @@ module type REFUTATION_GAME_HELPERS = sig val generate_proof : _ Node_context.rw_context -> Game.t -> - Context.pvmstate -> + Access_mode.rw Context.pvmstate -> string tzresult Lwt.t (** [make_dissection plugin node_ctxt cache ~start_state ~start_chunk diff --git a/src/lib_smart_rollup_node/publisher.ml b/src/lib_smart_rollup_node/publisher.ml index 43a68b06e8ffee8ef9fd047b4b8c47e1e8186b2c..35a3929854f75501c7e7fd0f86fe37b0efa0bd7f 100644 --- a/src/lib_smart_rollup_node/publisher.ml +++ b/src/lib_smart_rollup_node/publisher.ml @@ -144,13 +144,14 @@ let genesis_pvm_state (module Plugin : Protocol_plugin_sig.S) | Some pvm_state -> return pvm_state | None -> failwith "PVM state for genesis commitment is not available") | _ -> + let mode = Context.access_mode_state ctxt in (* If there are unsafe patches that were applied to the genesis PVM state, we instead recompute the unpatched version to derive the commitment as all the following ones will need to be chained to it. *) - let+ _, Original state = - Interpreter.genesis_state (module Plugin) node_ctxt + let+ (Unpatched state) = + Interpreter.genesis_state Unpatched (module Plugin) node_ctxt in - state + Context.PVMState.change_access state mode let genesis_commitment (module Plugin : Protocol_plugin_sig.S) (node_ctxt : _ Node_context.t) ctxt = diff --git a/src/lib_smart_rollup_node/pvm_plugin_sig.ml b/src/lib_smart_rollup_node/pvm_plugin_sig.ml index 057b4d533e1715a49f368da593b9f9ad68d54bf8..3aacf0dee7ee80825b02ec4a2c751dcd07e2ecd5 100644 --- a/src/lib_smart_rollup_node/pvm_plugin_sig.ml +++ b/src/lib_smart_rollup_node/pvm_plugin_sig.ml @@ -26,7 +26,7 @@ (** Evaluation state for the PVM. *) type 'fuel eval_state = { - state : Context.pvmstate; (** The actual PVM state. *) + state : Access_mode.rw Context.pvmstate; (** The actual PVM state. *) state_hash : State_hash.t; (** Hash of [state]. *) tick : Z.t; (** Tick of [state]. *) inbox_level : int32; (** Inbox level in which messages are evaluated. *) @@ -66,7 +66,7 @@ module type FUELED_PVM = sig fuel:fuel -> _ Node_context.t -> Inbox.t * string list -> - Context.pvmstate -> + Access_mode.rw Context.pvmstate -> fuel eval_result tzresult Lwt.t (** [eval_messages ?reveal_map ~fuel node_ctxt ~message_counter_offset state @@ -88,39 +88,40 @@ end module type S = sig val context : Kind.t -> (module Context_sigs.S) - val get_tick : Kind.t -> Context.pvmstate -> Z.t Lwt.t + val get_tick : Kind.t -> _ Context.pvmstate -> Z.t Lwt.t - val state_hash : Kind.t -> Context.pvmstate -> State_hash.t Lwt.t + val state_hash : Kind.t -> _ Context.pvmstate -> State_hash.t Lwt.t - val initial_state : Kind.t -> Context.pvmstate Lwt.t + val initial_state : Kind.t -> Access_mode.rw Context.pvmstate Lwt.t val parse_boot_sector : Kind.t -> string -> string option val install_boot_sector : - Kind.t -> Context.pvmstate -> string -> Context.pvmstate Lwt.t + Kind.t -> Access_mode.rw Context.pvmstate -> string -> unit Lwt.t - val get_status : _ Node_context.t -> Context.pvmstate -> string tzresult Lwt.t + val get_status : + _ Node_context.t -> _ Context.pvmstate -> string tzresult Lwt.t val find_whitelist_update_output_index : _ Node_context.t -> - Context.pvmstate -> + _ Context.pvmstate -> outbox_level:int32 -> int option Lwt.t val get_outbox_messages : _ Node_context.t -> - Context.pvmstate -> + _ Context.pvmstate -> outbox_level:int32 -> (int * Outbox_message.summary) list Lwt.t val produce_serialized_output_proof : _ Node_context.rw_context -> - Context.pvmstate -> + _ Context.pvmstate -> outbox_level:int32 -> message_index:int -> string tzresult Lwt.t - val get_current_level : Kind.t -> Context.pvmstate -> int32 option Lwt.t + val get_current_level : Kind.t -> _ Context.pvmstate -> int32 option Lwt.t val start_of_level_serialized : string @@ -134,19 +135,19 @@ module type S = sig module Unsafe : sig val apply_patch : Kind.t -> - Context.pvmstate -> + Access_mode.rw Context.pvmstate -> Pvm_patches.unsafe_patch -> - Context.pvmstate tzresult Lwt.t + unit tzresult Lwt.t end module Wasm_2_0_0 : sig (** [decode_durable_state enc tree] decodes a value using the encoder [enc] from the provided [tree] *) val decode_durable_state : - 'a Tezos_tree_encoding.t -> Context.pvmstate -> 'a Lwt.t + 'a Tezos_tree_encoding.t -> _ Context.pvmstate -> 'a Lwt.t (** [proof_mem_tree t k] is false iff [find_tree k = None].*) - val proof_mem_tree : Context.pvmstate -> string list -> bool Lwt.t + val proof_mem_tree : _ Context.pvmstate -> string list -> bool Lwt.t (** [fold ?depth t root ~order ~init ~f] recursively folds over the trees and values of t. The f callbacks are called with a key relative to root. f is @@ -165,11 +166,11 @@ module type S = sig order of their keys. *) val proof_fold_tree : ?depth:Tezos_context_sigs.Context.depth -> - Context.pvmstate -> + 'm Context.pvmstate -> string list -> order:[`Sorted | `Undefined] -> init:'a -> - f:(string list -> Context.pvmstate -> 'a -> 'a Lwt.t) -> + f:(string list -> 'm Context.pvmstate -> 'a -> 'a Lwt.t) -> 'a Lwt.t end diff --git a/src/lib_smart_rollup_node/rollup_node_daemon.ml b/src/lib_smart_rollup_node/rollup_node_daemon.ml index 0b06a17998de8cd42ad6c00080259b393a0d6021..b8ffeeb9a7eb52802b4784a8631fa1a9b0202bf2 100644 --- a/src/lib_smart_rollup_node/rollup_node_daemon.ml +++ b/src/lib_smart_rollup_node/rollup_node_daemon.ml @@ -30,6 +30,7 @@ type state = { rpc_server : Rpc_server.t; configuration : Configuration.t; node_ctxt : Node_context.rw; + current_ctxt : Access_mode.rw Node_context.context_state option Reference.rw; } let is_before_origination (node_ctxt : _ Node_context.t) @@ -37,14 +38,29 @@ let is_before_origination (node_ctxt : _ Node_context.t) let origination_level = node_ctxt.genesis_info.level in header.level < origination_level -let previous_context (node_ctxt : _ Node_context.t) - ~(predecessor : Layer1.header) = +let context_of_block' (node_ctxt : _ Node_context.t) (block : Layer1.header) = let open Lwt_result_syntax in - if is_before_origination node_ctxt predecessor then + if is_before_origination node_ctxt block then (* This is before we have interpreted the boot sector, so we start with an empty context in genesis *) return (Context.empty node_ctxt.context) - else Node_context.checkout_context node_ctxt predecessor.Layer1.hash + else Node_context.checkout_context node_ctxt block.hash + +let context_of_block {node_ctxt; current_ctxt; _} (block : Layer1.header) = + let open Lwt_result_syntax in + match Reference.get current_ctxt with + | Some current_ctxt when Block_hash.equal block.hash current_ctxt.block.hash + -> + return current_ctxt.ctxt + | _ -> context_of_block' node_ctxt block + +let start_block_evaluation state block ctxt = + Reference.set state.current_ctxt + @@ Some {Node_context.ctxt; status = Dirty; block} + +let finish_block_evaluation state block ctxt = + Reference.set state.current_ctxt + @@ Some {Node_context.ctxt; status = Valid; block} let start_workers (plugin : (module Protocol_plugin_sig.S)) (node_ctxt : _ Node_context.t) = @@ -138,7 +154,8 @@ let process_unseen_head ({node_ctxt; _} as state) ~catching_up ~predecessor ]) ; let* () = Node_context.save_protocol_info node_ctxt head ~predecessor in let* () = handle_protocol_migration ~catching_up state head in - let* rollup_ctxt = previous_context node_ctxt ~predecessor in + let* ctxt = context_of_block state predecessor in + start_block_evaluation state head ctxt ; let module Plugin = (val state.plugin) in let start_timestamp = Time.System.now () in let* inbox_hash, inbox, inbox_witness, messages = @@ -159,16 +176,17 @@ let process_unseen_head ({node_ctxt; _} as state) ~catching_up ~predecessor (* Avoid storing and publishing commitments if the head is not final. *) (* Avoid triggering the pvm execution if this has been done before for this head. *) - let* ctxt, _num_messages, num_ticks, initial_tick = + let* _num_messages, num_ticks, initial_tick = Interpreter.process_head (module Plugin) node_ctxt - rollup_ctxt + ctxt ~predecessor:(Layer1.head_of_header predecessor) (Layer1.head_of_header head) (inbox, messages) in let*! context_hash = Context.commit ctxt in + finish_block_evaluation state head ctxt ; let* commitment_hash = Publisher.process_head state.plugin @@ -275,10 +293,11 @@ and update_l2_chain ({node_ctxt; _} as state) ~catching_up (* TODO: https://gitlab.com/tezos/tezos/-/issues/7731 This just overwrites the outbox messages with the correct ones for the level but we need to properly handle reorgs in the storage. *) - let* ctxt = Node_context.checkout_context node_ctxt head.hash in + let* ctxt = context_of_block state head in let* () = register_outbox_messages state.plugin node_ctxt ctxt head.level in + finish_block_evaluation state head ctxt ; Node_context.set_l2_head node_ctxt l2_block | `New l2_block -> let* () = Node_context.set_l2_head node_ctxt l2_block in @@ -781,7 +800,7 @@ module Internal_for_tests = struct (node_ctxt : _ Node_context.t) ~is_first_block ~predecessor head messages = let open Lwt_result_syntax in - let* ctxt = previous_context node_ctxt ~predecessor in + let* ctxt = context_of_block' node_ctxt predecessor in let* () = Node_context.save_level node_ctxt (Layer1.head_of_header head) in let* inbox_hash, inbox, inbox_witness, messages = Plugin.Inbox.Internal_for_tests.process_messages @@ -790,7 +809,7 @@ module Internal_for_tests = struct ~predecessor messages in - let* ctxt, _num_messages, num_ticks, initial_tick = + let* _num_messages, num_ticks, initial_tick = Interpreter.process_head (module Plugin) node_ctxt @@ -959,7 +978,9 @@ let run ~data_dir ~irmin_cache_size (configuration : Configuration.t) current_protocol configuration in - let dir = Rpc_directory.directory node_ctxt in + let current_ctxt = Reference.new_ None in + let rpc_ctxt = Rpc_context.make node_ctxt current_ctxt in + let dir = Rpc_directory.directory rpc_ctxt in let* rpc_server = Rpc_server.start ~rpc_addr:configuration.rpc_addr @@ -968,7 +989,7 @@ let run ~data_dir ~irmin_cache_size (configuration : Configuration.t) ~cors:configuration.cors dir in - let state = {node_ctxt; rpc_server; configuration; plugin} in + let state = {node_ctxt; rpc_server; configuration; plugin; current_ctxt} in let* () = check_operator_balance state in let* () = Node_context.save_protocols_from_l1 node_ctxt in let (_ : Lwt_exit.clean_up_callback_id) = @@ -1118,17 +1139,17 @@ module Replay = struct level Block_hash.pp hash ; - let* rollup_ctxt = + let* ctxt = Node_context.checkout_context node_ctxt block.header.predecessor in let* (module Plugin) = Protocol_plugins.proto_plugin_for_level node_ctxt block.header.level in - let* ctxt, _num_messages, num_ticks, initial_tick = + let* _num_messages, num_ticks, initial_tick = Interpreter.process_head (module Plugin) node_ctxt - rollup_ctxt + ctxt ~predecessor: Layer1. { diff --git a/src/lib_smart_rollup_node/rpc_context.ml b/src/lib_smart_rollup_node/rpc_context.ml new file mode 100644 index 0000000000000000000000000000000000000000..cda09667b2c1d99e1f990a5d9ea8a56a6ef86828 --- /dev/null +++ b/src/lib_smart_rollup_node/rpc_context.ml @@ -0,0 +1,72 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2025 Functori *) +(* Copyright (c) 2025 Nomadic Labs *) +(* *) +(*****************************************************************************) + +type 'a t_ = + | Rpc_ctxt : { + node_ctxt : 'a Node_context.t; + current_ctxt : + (* Effectively, this forces a read-only access to the index through the + current context for RPCs. *) + _ Node_context.context_state option Reference.ro; + } + -> 'a t_ + +type 'a t = 'a t_ + constraint 'a = < store : 'store ; context : 'context > + constraint 'store = [< `Read | `Write > `Read] + constraint 'context = [< `Read | `Write > `Read] + +type rw = < store : [`Read | `Write] ; context : [`Read | `Write] > t + +type ro = < store : [`Read] ; context : [`Read] > t + +let make node_ctxt current_ctxt = + Rpc_ctxt {node_ctxt; current_ctxt = Reference.readonly current_ctxt} + +let node_ctxt (Rpc_ctxt {node_ctxt; _}) = node_ctxt + +let current_ctxt (Rpc_ctxt {current_ctxt; _}) : + Access_mode.ro Node_context.context_state option = + match Reference.get current_ctxt with + | None -> None + | Some {ctxt; status; block} -> + Some {ctxt = Context.readonly_index ctxt; status; block} + +let readonly (Rpc_ctxt {node_ctxt; current_ctxt}) = + Rpc_ctxt {node_ctxt = Node_context.readonly node_ctxt; current_ctxt} + +let get_pvm_state mode rpc_ctxt block_hash = + let node_ctxt = node_ctxt rpc_ctxt in + let current_ctxt = current_ctxt rpc_ctxt in + let open Lwt_result_syntax in + let* ctxt, copy_on_rw = + match current_ctxt with + | Some {block; ctxt; status = Valid} + when Block_hash.equal block_hash block.hash -> + return (ctxt, true) + | _ -> + let+ ctxt = Node_context.checkout_context node_ctxt block_hash in + (Context.readonly_index ctxt, false) + in + let*! state = Context.PVMState.find ctxt in + match state with + | None -> failwith "No state" + | Some state -> + Context.PVMState.change_access ~copy_on_rw state mode |> return + +let checkout_context_rw rpc_ctxt block_hash = + let node_ctxt = node_ctxt rpc_ctxt in + let current_ctxt = current_ctxt rpc_ctxt in + let open Lwt_result_syntax in + match current_ctxt with + | Some {block; ctxt; status = Valid} + when Block_hash.equal block_hash block.hash -> + return (Context.copy Read_write ctxt) + | _ -> + let+ ctxt = Node_context.checkout_context node_ctxt block_hash in + Context.readonly_index ctxt diff --git a/src/lib_smart_rollup_node/rpc_context.mli b/src/lib_smart_rollup_node/rpc_context.mli new file mode 100644 index 0000000000000000000000000000000000000000..4d173a2b87f07227ffba5cc7fdfa13e4984f71cb --- /dev/null +++ b/src/lib_smart_rollup_node/rpc_context.mli @@ -0,0 +1,53 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2025 Functori *) +(* Copyright (c) 2025 Nomadic Labs *) +(* *) +(*****************************************************************************) + +(** This module defines the RPC context for the smart rollup node. It is + used by the RPC server to access the node's data. *) + +(** The RPC context is a wrapper around the node context that provides access to + the store and the context. The type parameter ['a] is a phantom type that + specifies the access rights to the store and the context. Objects of this + type also contain the reference to the current context state but always in + read-only mode. This ensures that RPCs cannot modify the current state of + the rollup node. *) +type 'a t + constraint 'a = < store : 'store ; context : 'context > + constraint 'store = [< `Read | `Write > `Read] + constraint 'context = [< `Read | `Write > `Read] + +(** A read-write RPC context. *) +type rw = < context : [`Read | `Write] ; store : [`Read | `Write] > t + +(** A read-only RPC context. *) +type ro = < context : [`Read] ; store : [`Read] > t + +(** [make node_ctxt context_state] creates a new RPC context from a node + context and a reference to the current context state. *) +val make : + 'a Node_context.t -> + (_, _ Node_context.context_state option) Reference.t -> + 'a t + +(** [node_ctxt rpc_ctxt] returns the node context of the RPC context. *) +val node_ctxt : 'a t -> 'a Node_context.t + +(** [readonly rpc_ctxt] returns a read-only version of the RPC context. *) +val readonly : _ t -> ro + +(** [get_pvm_state mode rpc_ctxt block_hash] returns the PVM state for the given + block hash. The [mode] argument specifies whether the caller needs a + read-only or read-write access to the PVM state. If [mode = Read_write] and + the block hash is the head, a writable {e copy} of the current mutable PVM + state is returned. *) +val get_pvm_state : + 'a Access_mode.t -> _ t -> Block_hash.t -> 'a Context.pvmstate tzresult Lwt.t + +val checkout_context_rw : + _ t -> + Block_hash.t -> + < index : Access_mode.ro ; state : Access_mode.rw > Context.t tzresult Lwt.t diff --git a/src/lib_smart_rollup_node/rpc_directory.ml b/src/lib_smart_rollup_node/rpc_directory.ml index 51d9ddb71756072a6385b045a97ce7c8ec8c6c85..11af4bbc9cd4c1a5a828e9ff28e72bf5d0717c87 100644 --- a/src/lib_smart_rollup_node/rpc_directory.ml +++ b/src/lib_smart_rollup_node/rpc_directory.ml @@ -58,58 +58,63 @@ let get_head_level_opt node_ctxt = module Root_directory = Make_directory (struct include Rollup_node_services.Root - type context = Node_context.rw + type context = Rpc_context.rw type subcontext = Node_context.ro - let context_of_prefix node_ctxt () = - Lwt_result.return (Node_context.readonly node_ctxt) + let context_of_prefix rpc_ctxt () = + Rpc_context.node_ctxt rpc_ctxt |> Node_context.readonly |> Lwt_result.return end) module Global_directory = Make_directory (struct include Rollup_node_services.Global - type context = Node_context.rw + type context = Rpc_context.rw type subcontext = Node_context.ro - let context_of_prefix node_ctxt () = - Lwt_result.return (Node_context.readonly node_ctxt) + let context_of_prefix rpc_ctxt () = + Rpc_context.node_ctxt rpc_ctxt |> Node_context.readonly |> Lwt_result.return end) (* The block directory needs to be registered in the protocol plugin. *) module Block_directory = Make_sub_directory (struct include Rollup_node_services.Block - type context = Node_context.rw + type context = Rpc_context.rw - type subcontext = Node_context.ro * Block_hash.t + type subcontext = Rpc_context.ro * Block_hash.t - let context_of_prefix node_ctxt (((), block) : prefix) = + let context_of_prefix rpc_ctxt (((), block) : prefix) = let open Lwt_result_syntax in - let+ block = Block_directory_helpers.block_of_prefix node_ctxt block in - (Node_context.readonly node_ctxt, block) + let+ block = + Block_directory_helpers.block_of_prefix + (Rpc_context.node_ctxt rpc_ctxt) + block + in + (Rpc_context.readonly rpc_ctxt, block) end) module Local_directory = Make_directory (struct include Rollup_node_services.Local - type context = Node_context.rw + type context = Rpc_context.rw type subcontext = Node_context.ro - let context_of_prefix node_ctxt () = - Lwt_result.return (Node_context.readonly node_ctxt) + let context_of_prefix rpc_ctxt () = + Rpc_context.node_ctxt rpc_ctxt |> Node_context.readonly |> Lwt_result.return end) module Admin_directory = Make_directory (struct include Rollup_node_services.Admin - type context = Node_context.rw + type context = Rpc_context.rw type subcontext = Node_context.rw - let context_of_prefix node_ctxt () = Lwt_result.return node_ctxt + let context_of_prefix rpc_ctxt () = + Rpc_context.node_ctxt rpc_ctxt |> Lwt_result.return end) let () = @@ -294,8 +299,9 @@ let () = let () = Block_directory.register0 Rollup_node_services.Block.block - @@ fun (node_ctxt, block) outbox () -> + @@ fun (rpc_ctxt, block) outbox () -> let open Lwt_result_syntax in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let* get_outbox_messages = if not outbox then return_none else @@ -308,8 +314,9 @@ let () = let () = Block_directory.register0 Rollup_node_services.Block.num_messages - @@ fun (node_ctxt, block) () () -> + @@ fun (rpc_ctxt, block) () () -> let open Lwt_result_syntax in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let* l2_block = Node_context.get_l2_block node_ctxt block in let+ num_messages = Node_context.get_num_messages node_ctxt l2_block.header.inbox_witness @@ -319,35 +326,34 @@ let () = let () = let open Lwt_result_syntax in Block_directory.register0 Rollup_node_services.Block.hash - @@ fun (_node_ctxt, block) () () -> return block + @@ fun (_, block) () () -> return block let () = Block_directory.register0 Rollup_node_services.Block.level - @@ fun (node_ctxt, block) () () -> Node_context.level_of_hash node_ctxt block + @@ fun (rpc_ctxt, block) () () -> + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in + Node_context.level_of_hash node_ctxt block let () = Block_directory.register0 Rollup_node_services.Block.inbox - @@ fun (node_ctxt, block) () () -> + @@ fun (rpc_ctxt, block) () () -> + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in Node_context.get_inbox_by_block_hash node_ctxt block let () = Block_directory.register0 Rollup_node_services.Block.ticks - @@ fun (node_ctxt, block) () () -> + @@ fun (rpc_ctxt, block) () () -> let open Lwt_result_syntax in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let+ l2_block = Node_context.get_l2_block node_ctxt block in Z.of_int64 l2_block.num_ticks -let get_state (node_ctxt : _ Node_context.t) block_hash = - let open Lwt_result_syntax in - let* ctxt = Node_context.checkout_context node_ctxt block_hash in - let*! state = Context.PVMState.find ctxt in - match state with None -> failwith "No state" | Some state -> return state - let () = Block_directory.register0 Rollup_node_services.Block.total_ticks - @@ fun (node_ctxt, block) () () -> + @@ fun (rpc_ctxt, block) () () -> let open Lwt_result_syntax in - let* state = get_state node_ctxt block in + let* state = Rpc_context.get_pvm_state Read_only rpc_ctxt block in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let* (module Plugin) = Protocol_plugins.proto_plugin_for_block node_ctxt block in @@ -356,9 +362,10 @@ let () = let () = Block_directory.register0 Rollup_node_services.Block.state_hash - @@ fun (node_ctxt, block) () () -> + @@ fun (rpc_ctxt, block) () () -> let open Lwt_result_syntax in - let* state = get_state node_ctxt block in + let* state = Rpc_context.get_pvm_state Read_only rpc_ctxt block in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let* (module Plugin) = Protocol_plugins.proto_plugin_for_block node_ctxt block in @@ -367,9 +374,10 @@ let () = let () = Block_directory.register0 Rollup_node_services.Block.state_current_level - @@ fun (node_ctxt, block) () () -> + @@ fun (rpc_ctxt, block) () () -> let open Lwt_result_syntax in - let* state = get_state node_ctxt block in + let* state = Rpc_context.get_pvm_state Read_only rpc_ctxt block in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let* (module Plugin) = Protocol_plugins.proto_plugin_for_block node_ctxt block in @@ -378,9 +386,9 @@ let () = let () = Block_directory.register0 Rollup_node_services.Block.state_value - @@ fun (node_ctxt, block) {key} () -> + @@ fun (rpc_ctxt, block) {key} () -> let open Lwt_result_syntax in - let* ctx = get_state node_ctxt block in + let* ctx = Rpc_context.get_pvm_state Read_only rpc_ctxt block in let path = String.split_on_char '/' key in let*! value = Context.PVMState.lookup ctx path in match value with @@ -391,8 +399,9 @@ let () = let () = Block_directory.register0 Rollup_node_services.Block.committed_status - @@ fun (node_ctxt, block) () () -> + @@ fun (rpc_ctxt, block) () () -> let open Lwt_result_syntax in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let* block = Node_context.get_l2_block node_ctxt block in Publisher.Helpers.committed_status node_ctxt block @@ -852,9 +861,9 @@ let add_describe dir = dir Tezos_rpc.Service.description_service -let top_directory (node_ctxt : _ Node_context.t) = +let top_directory (rpc_ctxt : _ Rpc_context.t) = List.fold_left - (fun dir f -> Tezos_rpc.Directory.merge dir (f node_ctxt)) + (fun dir f -> Tezos_rpc.Directory.merge dir (f rpc_ctxt)) Tezos_rpc.Directory.empty [ Root_directory.build_directory; @@ -871,7 +880,7 @@ let block_prefix = let protocol_directories = Protocol_hash.Table.create 3 -let build_protocol_directory node_ctxt proto = +let build_protocol_directory rpc_ctxt proto = let plugin = match Protocol_plugins.proto_plugin_for_protocol proto with | Error e -> @@ -885,10 +894,10 @@ let build_protocol_directory node_ctxt proto = | Ok p -> p in let (module Plugin) = plugin in - let block_directory = Plugin.RPC_directory.block_directory node_ctxt in + let block_directory = Plugin.RPC_directory.block_directory rpc_ctxt in let full_static_dir = Tezos_rpc.Directory.merge - (top_directory node_ctxt) + (top_directory rpc_ctxt) (Tezos_rpc.Directory.prefix block_prefix block_directory) |> add_describe in @@ -941,9 +950,9 @@ let () = let*? _, dir, proto = get_proto_dir ?protocol node_ctxt in generate_openapi dir proto -let directory node_ctxt = - let dir = top_directory node_ctxt in - build_protocol_directories node_ctxt ; +let directory rpc_ctxt = + let dir = top_directory rpc_ctxt in + build_protocol_directories rpc_ctxt ; let path = Tezos_rpc.Path.( open_root / "global" / "block" /: Rollup_node_services.Arg.block_id) @@ -957,6 +966,7 @@ let directory node_ctxt = let open Lwt_syntax in let+ dir = let open Lwt_result_syntax in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let* level = Block_directory_helpers.block_level_of_id node_ctxt block_id in @@ -987,5 +997,9 @@ let generate_openapi ?protocol cctxt = let* node_ctxt = Node_context_loader.Internal_for_tests.openapi_context cctxt protocol in - let _, dir = build_protocol_directory node_ctxt protocol in + let _, dir = + build_protocol_directory + (Rpc_context.make node_ctxt (Reference.new_ None)) + protocol + in generate_openapi dir protocol diff --git a/src/lib_smart_rollup_node/rpc_directory.mli b/src/lib_smart_rollup_node/rpc_directory.mli index 82d972b7b91e7ff116a54b751195167037cf4975..9e07e8bd4d1c35c34f8433a8ecf0ef576b46f77f 100644 --- a/src/lib_smart_rollup_node/rpc_directory.mli +++ b/src/lib_smart_rollup_node/rpc_directory.mli @@ -25,10 +25,10 @@ (** The RPC top level directory (without the block directory) for this rollup node. *) -val top_directory : Node_context.rw -> unit Tezos_rpc.Directory.t +val top_directory : Rpc_context.rw -> unit Tezos_rpc.Directory.t (** The full RPC directory for the protocol agnostic rollup node. *) -val directory : Node_context.rw -> unit Tezos_rpc.Directory.t +val directory : Rpc_context.rw -> unit Tezos_rpc.Directory.t (** Generate the OpenAPI description for the RPC API of the node. If [protocol] is not specified, the API will be generated for the newest protocol. *) @@ -38,5 +38,5 @@ val generate_openapi : Ezjsonm.value tzresult Lwt.t val build_block_subdirectory : - Node_context.rw -> + Rpc_context.rw -> (unit * Rollup_node_services.Arg.block_id) Tezos_rpc.Directory.t diff --git a/src/lib_smart_rollup_node/simulation.ml b/src/lib_smart_rollup_node/simulation.ml index 1537ee6445a59030ad687c69ca429ea1c179b134..6089ac2238b9dcd765f8f04362aba5ceca31a069 100644 --- a/src/lib_smart_rollup_node/simulation.ml +++ b/src/lib_smart_rollup_node/simulation.ml @@ -32,9 +32,9 @@ type info_per_level = { type t = { node_ctxt : Node_context.ro; - ctxt : Context.ro; + ctxt : < index : Access_mode.ro ; state : Access_mode.rw > Context.t; inbox_level : int32; - state : Context.pvmstate; + state : Access_mode.rw Context.pvmstate; reveal_map : string Utils.Reveal_hash_map.t option; nb_messages_inbox : int; level_position : level_position; @@ -70,9 +70,10 @@ let set_simulation_kernel_log ?log_kernel_debug_file in return {node_ctxt with kernel_debug_logger; finaliser} -let start_simulation node_ctxt ~reveal_map ?log_kernel_debug_file +let start_simulation rpc_ctxt ~reveal_map ?log_kernel_debug_file (Layer1.{hash; level} as head) = let open Lwt_result_syntax in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let*! node_ctxt = set_simulation_kernel_log ?log_kernel_debug_file node_ctxt in @@ -89,7 +90,7 @@ let start_simulation node_ctxt ~reveal_map ?log_kernel_debug_file (* This is before we have interpreted the boot sector, so we start with an empty context in genesis *) return (Context.empty node_ctxt.context) - else Node_context.checkout_context node_ctxt hash + else Rpc_context.checkout_context_rw rpc_ctxt hash in let* state = Interpreter.state_of_head (module (val plugin)) node_ctxt ctxt head @@ -139,9 +140,9 @@ let simulate_messages_no_checks let* Pvm_plugin_sig.{state = {state; _}; num_ticks; num_messages; _} = Pvm.Fueled.Free.eval_messages ?reveal_map node_ctxt eval_state in - let*! ctxt = Context.PVMState.set ctxt state in + let*! () = Context.PVMState.set ctxt state in let nb_messages_inbox = nb_messages_inbox + num_messages in - return ({sim with ctxt; state; nb_messages_inbox}, num_ticks) + return ({sim with state; nb_messages_inbox}, num_ticks) let simulate_messages sim messages = let open Lwt_result_syntax in diff --git a/src/lib_smart_rollup_node/simulation.mli b/src/lib_smart_rollup_node/simulation.mli index 93c06caf8676a58763372c8872243ee664f76d1c..dc2bf6d71dc6c2afc516da74960c971aa1ded058 100644 --- a/src/lib_smart_rollup_node/simulation.mli +++ b/src/lib_smart_rollup_node/simulation.mli @@ -33,9 +33,9 @@ type info_per_level = { (** Type of the state for a simulation. *) type t = { node_ctxt : Node_context.ro; - ctxt : Context.ro; + ctxt : < index : Access_mode.ro ; state : Access_mode.rw > Context.t; inbox_level : int32; - state : Context.pvmstate; + state : Access_mode.rw Context.pvmstate; reveal_map : string Utils.Reveal_hash_map.t option; nb_messages_inbox : int; level_position : level_position; @@ -43,12 +43,12 @@ type t = { plugin : (module Protocol_plugin_sig.S); } -(** [start_simulation node_ctxt ~reveal_map ?log_kernel_debug_file block] starts +(** [start_simulation rpc_ctxt ~reveal_map ?log_kernel_debug_file block] starts a new simulation {e on top} of [block], i.e. for an hypothetical new inbox (level). If [log_kernel_debug_file] is provided, kernel logs will be written to [node_ctxt.data_dir/simulation_kernel_logs/log_kernel_debug_file]. *) val start_simulation : - Node_context.ro -> + Rpc_context.ro -> reveal_map:string Utils.Reveal_hash_map.t option -> ?log_kernel_debug_file:string -> Layer1.head -> diff --git a/src/lib_smart_rollup_node/snapshots.ml b/src/lib_smart_rollup_node/snapshots.ml index dc59f88a614017dc043b944af30dff69a6e2f2b0..7d19cdc08b35b2b7d5540ba923be8b57a9ad219d 100644 --- a/src/lib_smart_rollup_node/snapshots.ml +++ b/src/lib_smart_rollup_node/snapshots.ml @@ -229,13 +229,13 @@ let compute_pvm_state_for_genenis cctxt dest (store : _ Store.t) context ~data_dir:dest ~apply_unsafe_patches in - Interpreter.genesis_state plugin node_context + Interpreter.genesis_state Both plugin node_context let check_genesis_pvm_state_and_return cctxt dest store context header (module Plugin : Protocol_plugin_sig.PARTIAL) (metadata : Metadata.t) head_ctxt hash ~apply_unsafe_patches = let open Lwt_result_syntax in - let* patched_pvm_state, Original pvm_state = + let* (Both {patched = patched_pvm_state; original = pvm_state}) = compute_pvm_state_for_genenis cctxt dest @@ -467,8 +467,8 @@ let check_lcc metadata cctxt (store : _ Store.t) (head : Sc_rollup_block.t) let hash_level_of_l2_block (b : Sc_rollup_block.t) = Layer1.{hash = b.header.block_hash; level = b.header.level} -let reconstruct_level_context rollup_ctxt ~predecessor - (node_ctxt : _ Node_context.t) level = +let reconstruct_level_context ctxt ~predecessor (node_ctxt : _ Node_context.t) + level = let open Lwt_result_syntax in let* block = Node_context.get_l2_block_by_level node_ctxt level in let* inbox = Node_context.get_inbox node_ctxt block.header.inbox_hash @@ -478,11 +478,11 @@ let reconstruct_level_context rollup_ctxt ~predecessor let* (module Plugin) = Protocol_plugins.proto_plugin_for_level node_ctxt level in - let* ctxt, _num_messages, _num_ticks, _initial_tick = + let* _num_messages, _num_ticks, _initial_tick = Interpreter.process_head (module Plugin) node_ctxt - rollup_ctxt + ctxt ~predecessor:(hash_level_of_l2_block predecessor) (hash_level_of_l2_block block) (inbox, messages) diff --git a/src/lib_smart_rollup_node/wasm_2_0_0_utilities.ml b/src/lib_smart_rollup_node/wasm_2_0_0_utilities.ml index c5f9866aa8ac5a5ce0837e58dc749671d0784d7b..c2db8d73ee8f54ee2aba4e38ec5102d9827d216c 100644 --- a/src/lib_smart_rollup_node/wasm_2_0_0_utilities.ml +++ b/src/lib_smart_rollup_node/wasm_2_0_0_utilities.ml @@ -196,15 +196,15 @@ let patch_durable_storage ~data_dir ~key ~value = in (* Patches the state via an unsafe patch. *) - let* patched_state = + let* () = Plugin.Pvm.Unsafe.apply_patch Kind.Wasm_2_0_0 state (Pvm_patches.Patch_durable_storage {key; value}) in - (* Replaces the PVM state. *) - let*! context = Context.PVMState.set context patched_state in + (* PVM state is was modified in place, replace it. *) + let*! () = Context.PVMState.set context state in let*! new_commit = Context.commit context in let new_l2_block = {l2_block with header = {l2_block.header with context = new_commit}} diff --git a/src/proto_017_PtNairob/lib_sc_rollup_node/context_wrapper.ml b/src/proto_017_PtNairob/lib_sc_rollup_node/context_wrapper.ml index d0e46cf9574316c7b9b375ee7bc300d5edbc76f2..f8ce92b5ab0638146d7ff6d674b5500e0a796e37 100644 --- a/src/proto_017_PtNairob/lib_sc_rollup_node/context_wrapper.ml +++ b/src/proto_017_PtNairob/lib_sc_rollup_node/context_wrapper.ml @@ -22,67 +22,9 @@ (* DEALINGS IN THE SOFTWARE. *) (* *) (*****************************************************************************) -open Context_sigs -(* Context *) -let of_node_context : type repo tree. - (repo, tree) equality_witness -> - 'a Context.index -> - ('a, repo) Context_sigs.index = - fun eqw (Index {equality_witness; index; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> index - | _ -> - (* This could happen if the context backend was to change for a - given pvm/rollup. For now we only use Irmin, if this changes, - this will demand to provide migration functions from prior - pmv_context to the next one. *) - assert false +module Irmin = Context.Wrapper.Make (struct + include Irmin_context -let to_node_context : type repo tree. - (module Context_sigs.S with type tree = tree and type repo = repo) -> - ('a, repo) Context_sigs.index -> - 'a Context.index = - fun (module C) index -> - Context.make_index - ~index - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -(* PVMState *) -let of_node_pvmstate : type repo tree. - (repo, tree) equality_witness -> Context.pvmstate -> tree = - fun eqw (PVMState {equality_witness; pvmstate; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> pvmstate - | _ -> assert false - -let to_node_pvmstate : type tree. - (module Context_sigs.S with type tree = tree) -> tree -> Context.pvmstate = - fun (module C) pvmstate -> - Context.make_pvmstate - ~pvmstate - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:"Irmin" - -module Irmin = struct - module I = struct - include Irmin_context - - let load ~cache_size path = load ~cache_size path - end - - let of_node_context : 'a Context.index -> ('a, I.repo) Context_sigs.index = - fun ctxt -> of_node_context I.equality_witness ctxt - - let to_node_context : ('a, I.repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module I) ctxt - - let of_node_pvmstate : Context.pvmstate -> I.tree = - fun c -> of_node_pvmstate I.equality_witness c - - let to_node_pvmstate : I.tree -> Context.pvmstate = - to_node_pvmstate (module I) -end + let load ~cache_size path = load ~cache_size path +end) diff --git a/src/proto_017_PtNairob/lib_sc_rollup_node/context_wrapper.mli b/src/proto_017_PtNairob/lib_sc_rollup_node/context_wrapper.mli index 1ec9e94754f8237ccc07b758c08f5be2d9b18bce..7132f1c89a48ea5d206cb93c42ced9ef9b6cd781 100644 --- a/src/proto_017_PtNairob/lib_sc_rollup_node/context_wrapper.mli +++ b/src/proto_017_PtNairob/lib_sc_rollup_node/context_wrapper.mli @@ -23,37 +23,10 @@ (* *) (*****************************************************************************) -(** This modules offers functions to translate from node-context and - node-pvmstate representation to those used in the PVM *) -open Context_sigs - -(* Context *) -val of_node_context : - ('repo, 'tree) equality_witness -> - [`Read | `Write] Context.index -> - ([`Read | `Write], 'repo) Context_sigs.index - -val to_node_context : - (module Context_sigs.S with type tree = 'tree and type repo = 'repo) -> - ('a, 'repo) Context_sigs.index -> - 'a Context.index - -(* PVMState *) -val of_node_pvmstate : - ('repo, 'tree) equality_witness -> Context.pvmstate -> 'tree - -val to_node_pvmstate : - (module Context_sigs.S with type tree = 'tree) -> 'tree -> Context.pvmstate - -(** Specialized module to handle translation to/from Irmin_context *) -module Irmin : sig - val of_node_context : - 'a Context.index -> ('a, Irmin_context.repo) Context_sigs.index - - val to_node_context : - ('a, Irmin_context.repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> Irmin_context.tree - - val to_node_pvmstate : Irmin_context.tree -> Context.pvmstate -end +(** Specialized module to handle translation to/from Irmin_context. + Directly used in Arith, Wasm_2_0_0 and RISC-V PVM *) +module Irmin : + Context.Wrapper.S + with type repo = Irmin_context.repo + and type tree = Irmin_context.tree + and type mut_state = Irmin_context.mut_state diff --git a/src/proto_018_Proxford/lib_sc_rollup_node/context_wrapper.ml b/src/proto_018_Proxford/lib_sc_rollup_node/context_wrapper.ml index 82a4fed829e2d0d05f68609ed94f398a6ae8a9bc..f8ce92b5ab0638146d7ff6d674b5500e0a796e37 100644 --- a/src/proto_018_Proxford/lib_sc_rollup_node/context_wrapper.ml +++ b/src/proto_018_Proxford/lib_sc_rollup_node/context_wrapper.ml @@ -23,68 +23,8 @@ (* *) (*****************************************************************************) -open Context -open Context_sigs +module Irmin = Context.Wrapper.Make (struct + include Irmin_context -(* Context *) -let of_node_context : type repo tree. - (repo, tree) equality_witness -> - 'a Context.index -> - ('a, repo) Context_sigs.index = - fun eqw (Index {equality_witness; index; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> index - | _ -> - (* This could happen if the context backend was to change for a - given pvm/rollup. For now we only use Irmin, if this changes, - this will demand to provide migration functions from prior - pmv_context to the next one. *) - assert false - -let to_node_context : type repo tree. - (module Context_sigs.S with type tree = tree and type repo = repo) -> - ('a, repo) Context_sigs.index -> - 'a Context.index = - fun (module C) index -> - Context.make_index - ~index - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -(* PVMState *) -let of_node_pvmstate : type repo tree. - (repo, tree) equality_witness -> Context.pvmstate -> tree = - fun eqw (PVMState {equality_witness; pvmstate; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> pvmstate - | _ -> assert false - -let to_node_pvmstate : type tree. - (module Context_sigs.S with type tree = tree) -> tree -> Context.pvmstate = - fun (module C) pvmstate -> - Context.make_pvmstate - ~pvmstate - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:"Irmin" - -module Irmin = struct - module I = struct - include Irmin_context - - let load ~cache_size path = load ~cache_size path - end - - let of_node_context : 'a Context.index -> ('a, I.repo) Context_sigs.index = - fun ctxt -> of_node_context I.equality_witness ctxt - - let to_node_context : ('a, I.repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module I) ctxt - - let of_node_pvmstate : Context.pvmstate -> I.tree = - fun c -> of_node_pvmstate I.equality_witness c - - let to_node_pvmstate : I.tree -> Context.pvmstate = - to_node_pvmstate (module I) -end + let load ~cache_size path = load ~cache_size path +end) diff --git a/src/proto_018_Proxford/lib_sc_rollup_node/context_wrapper.mli b/src/proto_018_Proxford/lib_sc_rollup_node/context_wrapper.mli index 1ec9e94754f8237ccc07b758c08f5be2d9b18bce..7132f1c89a48ea5d206cb93c42ced9ef9b6cd781 100644 --- a/src/proto_018_Proxford/lib_sc_rollup_node/context_wrapper.mli +++ b/src/proto_018_Proxford/lib_sc_rollup_node/context_wrapper.mli @@ -23,37 +23,10 @@ (* *) (*****************************************************************************) -(** This modules offers functions to translate from node-context and - node-pvmstate representation to those used in the PVM *) -open Context_sigs - -(* Context *) -val of_node_context : - ('repo, 'tree) equality_witness -> - [`Read | `Write] Context.index -> - ([`Read | `Write], 'repo) Context_sigs.index - -val to_node_context : - (module Context_sigs.S with type tree = 'tree and type repo = 'repo) -> - ('a, 'repo) Context_sigs.index -> - 'a Context.index - -(* PVMState *) -val of_node_pvmstate : - ('repo, 'tree) equality_witness -> Context.pvmstate -> 'tree - -val to_node_pvmstate : - (module Context_sigs.S with type tree = 'tree) -> 'tree -> Context.pvmstate - -(** Specialized module to handle translation to/from Irmin_context *) -module Irmin : sig - val of_node_context : - 'a Context.index -> ('a, Irmin_context.repo) Context_sigs.index - - val to_node_context : - ('a, Irmin_context.repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> Irmin_context.tree - - val to_node_pvmstate : Irmin_context.tree -> Context.pvmstate -end +(** Specialized module to handle translation to/from Irmin_context. + Directly used in Arith, Wasm_2_0_0 and RISC-V PVM *) +module Irmin : + Context.Wrapper.S + with type repo = Irmin_context.repo + and type tree = Irmin_context.tree + and type mut_state = Irmin_context.mut_state diff --git a/src/proto_019_PtParisB/lib_sc_rollup_node/context_wrapper.ml b/src/proto_019_PtParisB/lib_sc_rollup_node/context_wrapper.ml index 51115a5b1977cf393bd8c98bc4659297184fce3b..f8ce92b5ab0638146d7ff6d674b5500e0a796e37 100644 --- a/src/proto_019_PtParisB/lib_sc_rollup_node/context_wrapper.ml +++ b/src/proto_019_PtParisB/lib_sc_rollup_node/context_wrapper.ml @@ -23,88 +23,8 @@ (* *) (*****************************************************************************) -open Context -open Context_sigs +module Irmin = Context.Wrapper.Make (struct + include Irmin_context -let err_implementation_mismatch ~got = - Format.kasprintf invalid_arg "PVM Context implementation mismatch: got %s" got - -module type S = sig - type repo - - type tree - - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate -end - -(* Context *) -let of_node_context : type repo tree. - (repo, tree) equality_witness -> - 'a Context.index -> - ('a, repo) Context_sigs.index = - fun eqw (Index {equality_witness; index; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> index - | _ -> - (* This could happen if the context backend was to change for a - given pvm/rollup. For now we only use Irmin, if this changes, - this will demand to provide migration functions from prior - pmv_context to the next one. *) - assert false - -let to_node_context : type repo tree. - (module Context_sigs.S with type tree = tree and type repo = repo) -> - ('a, repo) Context_sigs.index -> - 'a Context.index = - fun (module C) index -> - Context.make_index - ~index - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -(* PVMState *) -let of_node_pvmstate : type repo tree. - (repo, tree) equality_witness -> Context.pvmstate -> tree = - fun eqw (PVMState {equality_witness; pvmstate; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> pvmstate - | _ -> assert false - -let to_node_pvmstate : type tree. - (module Context_sigs.S with type tree = tree) -> tree -> Context.pvmstate = - fun (module C) pvmstate -> - Context.make_pvmstate - ~pvmstate - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -module Irmin = struct - module I = struct - include Irmin_context - - let load ~cache_size path = load ~cache_size path - end - - type repo = I.repo - - type tree = I.tree - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context I.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module I) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate I.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module I) -end + let load ~cache_size path = load ~cache_size path +end) diff --git a/src/proto_019_PtParisB/lib_sc_rollup_node/context_wrapper.mli b/src/proto_019_PtParisB/lib_sc_rollup_node/context_wrapper.mli index c211f03be2d03a0142559db433a62cb22bde11ed..7132f1c89a48ea5d206cb93c42ced9ef9b6cd781 100644 --- a/src/proto_019_PtParisB/lib_sc_rollup_node/context_wrapper.mli +++ b/src/proto_019_PtParisB/lib_sc_rollup_node/context_wrapper.mli @@ -23,26 +23,10 @@ (* *) (*****************************************************************************) -val err_implementation_mismatch : got:string -> 'a - -(** Context wrappers translate from/to node-context and node-pvmstate - PVMs internal representation to those used in the PVM. Each - different PVM context will imply a dedicated wrapper.*) -module type S = sig - type repo - - type tree - - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate -end - (** Specialized module to handle translation to/from Irmin_context. Directly used in Arith, Wasm_2_0_0 and RISC-V PVM *) module Irmin : - S with type repo = Irmin_context.repo and type tree = Irmin_context.tree + Context.Wrapper.S + with type repo = Irmin_context.repo + and type tree = Irmin_context.tree + and type mut_state = Irmin_context.mut_state diff --git a/src/proto_019_PtParisB/lib_sc_rollup_node/pvm_sig.ml b/src/proto_019_PtParisB/lib_sc_rollup_node/pvm_sig.ml index 0015cab73d1085438b47c0fc61a2c9f4b375e557..23299e6d77a96b8686b0c730fa4402003334c48e 100644 --- a/src/proto_019_PtParisB/lib_sc_rollup_node/pvm_sig.ml +++ b/src/proto_019_PtParisB/lib_sc_rollup_node/pvm_sig.ml @@ -34,7 +34,7 @@ module type S = sig type tree module Ctxt_wrapper : - Context_wrapper.S with type repo = repo and type tree = tree + Context.Wrapper.S with type repo = repo and type tree = tree include Sc_rollup.PVM.S diff --git a/src/proto_020_PsParisC/lib_sc_rollup_node/context_wrapper.ml b/src/proto_020_PsParisC/lib_sc_rollup_node/context_wrapper.ml index 51115a5b1977cf393bd8c98bc4659297184fce3b..f8ce92b5ab0638146d7ff6d674b5500e0a796e37 100644 --- a/src/proto_020_PsParisC/lib_sc_rollup_node/context_wrapper.ml +++ b/src/proto_020_PsParisC/lib_sc_rollup_node/context_wrapper.ml @@ -23,88 +23,8 @@ (* *) (*****************************************************************************) -open Context -open Context_sigs +module Irmin = Context.Wrapper.Make (struct + include Irmin_context -let err_implementation_mismatch ~got = - Format.kasprintf invalid_arg "PVM Context implementation mismatch: got %s" got - -module type S = sig - type repo - - type tree - - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate -end - -(* Context *) -let of_node_context : type repo tree. - (repo, tree) equality_witness -> - 'a Context.index -> - ('a, repo) Context_sigs.index = - fun eqw (Index {equality_witness; index; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> index - | _ -> - (* This could happen if the context backend was to change for a - given pvm/rollup. For now we only use Irmin, if this changes, - this will demand to provide migration functions from prior - pmv_context to the next one. *) - assert false - -let to_node_context : type repo tree. - (module Context_sigs.S with type tree = tree and type repo = repo) -> - ('a, repo) Context_sigs.index -> - 'a Context.index = - fun (module C) index -> - Context.make_index - ~index - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -(* PVMState *) -let of_node_pvmstate : type repo tree. - (repo, tree) equality_witness -> Context.pvmstate -> tree = - fun eqw (PVMState {equality_witness; pvmstate; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> pvmstate - | _ -> assert false - -let to_node_pvmstate : type tree. - (module Context_sigs.S with type tree = tree) -> tree -> Context.pvmstate = - fun (module C) pvmstate -> - Context.make_pvmstate - ~pvmstate - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -module Irmin = struct - module I = struct - include Irmin_context - - let load ~cache_size path = load ~cache_size path - end - - type repo = I.repo - - type tree = I.tree - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context I.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module I) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate I.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module I) -end + let load ~cache_size path = load ~cache_size path +end) diff --git a/src/proto_020_PsParisC/lib_sc_rollup_node/context_wrapper.mli b/src/proto_020_PsParisC/lib_sc_rollup_node/context_wrapper.mli index c211f03be2d03a0142559db433a62cb22bde11ed..7132f1c89a48ea5d206cb93c42ced9ef9b6cd781 100644 --- a/src/proto_020_PsParisC/lib_sc_rollup_node/context_wrapper.mli +++ b/src/proto_020_PsParisC/lib_sc_rollup_node/context_wrapper.mli @@ -23,26 +23,10 @@ (* *) (*****************************************************************************) -val err_implementation_mismatch : got:string -> 'a - -(** Context wrappers translate from/to node-context and node-pvmstate - PVMs internal representation to those used in the PVM. Each - different PVM context will imply a dedicated wrapper.*) -module type S = sig - type repo - - type tree - - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate -end - (** Specialized module to handle translation to/from Irmin_context. Directly used in Arith, Wasm_2_0_0 and RISC-V PVM *) module Irmin : - S with type repo = Irmin_context.repo and type tree = Irmin_context.tree + Context.Wrapper.S + with type repo = Irmin_context.repo + and type tree = Irmin_context.tree + and type mut_state = Irmin_context.mut_state diff --git a/src/proto_020_PsParisC/lib_sc_rollup_node/pvm_sig.ml b/src/proto_020_PsParisC/lib_sc_rollup_node/pvm_sig.ml index 0015cab73d1085438b47c0fc61a2c9f4b375e557..23299e6d77a96b8686b0c730fa4402003334c48e 100644 --- a/src/proto_020_PsParisC/lib_sc_rollup_node/pvm_sig.ml +++ b/src/proto_020_PsParisC/lib_sc_rollup_node/pvm_sig.ml @@ -34,7 +34,7 @@ module type S = sig type tree module Ctxt_wrapper : - Context_wrapper.S with type repo = repo and type tree = tree + Context.Wrapper.S with type repo = repo and type tree = tree include Sc_rollup.PVM.S diff --git a/src/proto_021_PsQuebec/lib_sc_rollup_node/context_wrapper.ml b/src/proto_021_PsQuebec/lib_sc_rollup_node/context_wrapper.ml index a79d02dbb7be428cdaa61a88babb1d64470a506b..418b0c0ea6eb2a3931a6608278e871a877807faa 100644 --- a/src/proto_021_PsQuebec/lib_sc_rollup_node/context_wrapper.ml +++ b/src/proto_021_PsQuebec/lib_sc_rollup_node/context_wrapper.ml @@ -5,107 +5,18 @@ (* *) (*****************************************************************************) -open Context -open Context_sigs +module Irmin = Context.Wrapper.Make (struct + include Irmin_context -let err_implementation_mismatch ~got = - Format.kasprintf invalid_arg "PVM Context implementation mismatch: got %s" got + let load ~cache_size path = load ~cache_size path +end) -module type S = sig - type repo +module Riscv = Context.Wrapper.Make (struct + include Riscv_context - type tree + type mut_state = Mutable_state.t - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index + let from_imm = Mutable_state.from_imm - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate -end - -(* Context *) -let of_node_context : type repo tree. - (repo, tree) equality_witness -> - 'a Context.index -> - ('a, repo) Context_sigs.index = - fun eqw (Index {equality_witness; index; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> index - | _ -> - (* This could happen if the context backend was to change for a - given pvm/rollup. For now we only use Irmin, if this changes, - this will demand to provide migration functions from prior - pmv_context to the next one. *) - assert false - -let to_node_context : type repo tree. - (module Context_sigs.S with type tree = tree and type repo = repo) -> - ('a, repo) Context_sigs.index -> - 'a Context.index = - fun (module C) index -> - Context.make_index - ~index - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -(* PVMState *) -let of_node_pvmstate : type repo tree. - (repo, tree) equality_witness -> Context.pvmstate -> tree = - fun eqw (PVMState {equality_witness; pvmstate; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> pvmstate - | _ -> assert false - -let to_node_pvmstate : type tree. - (module Context_sigs.S with type tree = tree) -> tree -> Context.pvmstate = - fun (module C) pvmstate -> - Context.make_pvmstate - ~pvmstate - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -module Irmin = struct - module I = struct - include Irmin_context - - let load ~cache_size path = load ~cache_size path - end - - type repo = I.repo - - type tree = I.tree - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context I.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module I) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate I.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module I) -end - -module Riscv = struct - module R = Riscv_context - - type repo = R.repo - - type tree = R.tree - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context R.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module R) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate R.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module R) -end + let to_imm = Mutable_state.to_imm +end) diff --git a/src/proto_021_PsQuebec/lib_sc_rollup_node/context_wrapper.mli b/src/proto_021_PsQuebec/lib_sc_rollup_node/context_wrapper.mli index 640e9a9680fa28ba8b06b6c00c4c2fd60b637c69..3b70e8fad42c81857947c25fe5aa92da474c291d 100644 --- a/src/proto_021_PsQuebec/lib_sc_rollup_node/context_wrapper.mli +++ b/src/proto_021_PsQuebec/lib_sc_rollup_node/context_wrapper.mli @@ -5,29 +5,16 @@ (* *) (*****************************************************************************) -val err_implementation_mismatch : got:string -> 'a - -(** Context wrappers translate from/to node-context and node-pvmstate - PVMs internal representation to those used in the PVM. Each - different PVM context will imply a dedicated wrapper.*) -module type S = sig - type repo - - type tree - - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate -end - (** Specialized module to handle translation to/from Irmin_context. Directly used in Arith, Wasm_2_0_0 and RISC-V PVM *) module Irmin : - S with type repo = Irmin_context.repo and type tree = Irmin_context.tree + Context.Wrapper.S + with type repo = Irmin_context.repo + and type tree = Irmin_context.tree + and type mut_state = Irmin_context.mut_state module Riscv : - S with type repo = Riscv_context.repo and type tree = Riscv_context.tree + Context.Wrapper.S + with type repo = Riscv_context.repo + and type tree = Riscv_context.tree + and type mut_state = Riscv_context.Mutable_state.t diff --git a/src/proto_021_PsQuebec/lib_sc_rollup_node/pvm_sig.ml b/src/proto_021_PsQuebec/lib_sc_rollup_node/pvm_sig.ml index 0015cab73d1085438b47c0fc61a2c9f4b375e557..23299e6d77a96b8686b0c730fa4402003334c48e 100644 --- a/src/proto_021_PsQuebec/lib_sc_rollup_node/pvm_sig.ml +++ b/src/proto_021_PsQuebec/lib_sc_rollup_node/pvm_sig.ml @@ -34,7 +34,7 @@ module type S = sig type tree module Ctxt_wrapper : - Context_wrapper.S with type repo = repo and type tree = tree + Context.Wrapper.S with type repo = repo and type tree = tree include Sc_rollup.PVM.S diff --git a/src/proto_022_PsRiotum/lib_sc_rollup_node/context_wrapper.ml b/src/proto_022_PsRiotum/lib_sc_rollup_node/context_wrapper.ml index 54ea2988a7c0937e85ffea51a01bc5bd73c45245..7609b2bba54426fa6dbb2da61afc50934baf7756 100644 --- a/src/proto_022_PsRiotum/lib_sc_rollup_node/context_wrapper.ml +++ b/src/proto_022_PsRiotum/lib_sc_rollup_node/context_wrapper.ml @@ -6,125 +6,18 @@ (* *) (*****************************************************************************) -open Context -open Context_sigs +module Irmin = Context.Wrapper.Make (struct + include Irmin_context -let err_implementation_mismatch ~got = - Format.kasprintf invalid_arg "PVM Context implementation mismatch: got %s" got + let load ~cache_size path = load ~cache_size path +end) -module type S = sig - type repo +module Riscv = Context.Wrapper.Make (struct + include Riscv_context - type tree + type mut_state = Mutable_state.t - type mut_state + let from_imm = Mutable_state.from_imm - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate - - val from_imm : tree -> mut_state - - val to_imm : mut_state -> tree -end - -(* Context *) -let of_node_context : type repo tree. - (repo, tree) equality_witness -> - 'a Context.index -> - ('a, repo) Context_sigs.index = - fun eqw (Index {equality_witness; index; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> index - | _ -> - (* This could happen if the context backend was to change for a - given pvm/rollup. For now we only use Irmin, if this changes, - this will demand to provide migration functions from prior - pmv_context to the next one. *) - assert false - -let to_node_context : type repo tree. - (module Context_sigs.S with type tree = tree and type repo = repo) -> - ('a, repo) Context_sigs.index -> - 'a Context.index = - fun (module C) index -> - Context.make_index - ~index - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -(* PVMState *) -let of_node_pvmstate : type repo tree. - (repo, tree) equality_witness -> Context.pvmstate -> tree = - fun eqw (PVMState {equality_witness; pvmstate; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> pvmstate - | _ -> assert false - -let to_node_pvmstate : type tree. - (module Context_sigs.S with type tree = tree) -> tree -> Context.pvmstate = - fun (module C) pvmstate -> - Context.make_pvmstate - ~pvmstate - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -module Irmin = struct - module I = struct - include Irmin_context - - let load ~cache_size path = load ~cache_size path - end - - type repo = I.repo - - type tree = I.tree - - type mut_state = I.mut_state - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context I.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module I) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate I.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module I) - - let from_imm : tree -> mut_state = I.from_imm - - let to_imm : mut_state -> tree = I.to_imm -end - -module Riscv = struct - module R = Riscv_context - - type repo = R.repo - - type tree = R.tree - - type mut_state = R.Mutable_state.t - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context R.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module R) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate R.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module R) - - let from_imm : tree -> mut_state = R.Mutable_state.from_imm - - let to_imm : mut_state -> tree = R.Mutable_state.to_imm -end + let to_imm = Mutable_state.to_imm +end) diff --git a/src/proto_022_PsRiotum/lib_sc_rollup_node/context_wrapper.mli b/src/proto_022_PsRiotum/lib_sc_rollup_node/context_wrapper.mli index c610b03e99252fa41147bac4419f4bb54267623f..c714b0eaf845e6867fccdd1b89ccef03a839da01 100644 --- a/src/proto_022_PsRiotum/lib_sc_rollup_node/context_wrapper.mli +++ b/src/proto_022_PsRiotum/lib_sc_rollup_node/context_wrapper.mli @@ -6,43 +6,16 @@ (* *) (*****************************************************************************) -val err_implementation_mismatch : got:string -> 'a - -(** Context wrappers translate from/to node-context and node-pvmstate - PVMs internal representation to those used in the PVM. - Also provides conversion functions from/to mutable and immutable PVM types. - Each different PVM context will imply a dedicated wrapper.*) -module type S = sig - type repo - - type tree - - (** Type used by the mutable API for PVMs *) - type mut_state - - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate - - val from_imm : tree -> mut_state - - val to_imm : mut_state -> tree -end - (** Specialized module to handle translation to/from Irmin_context. Directly used in Arith, Wasm_2_0_0 and RISC-V PVM *) module Irmin : - S + Context.Wrapper.S with type repo = Irmin_context.repo and type tree = Irmin_context.tree and type mut_state = Irmin_context.mut_state module Riscv : - S + Context.Wrapper.S with type repo = Riscv_context.repo and type tree = Riscv_context.tree and type mut_state = Riscv_context.Mutable_state.t diff --git a/src/proto_022_PsRiotum/lib_sc_rollup_node/pvm_sig.ml b/src/proto_022_PsRiotum/lib_sc_rollup_node/pvm_sig.ml index a5b53b2bfb34f4dde1c44644d2ea5a7569aeb4a9..4ca02f57271bfd279c5038c702c2c32b48d407e0 100644 --- a/src/proto_022_PsRiotum/lib_sc_rollup_node/pvm_sig.ml +++ b/src/proto_022_PsRiotum/lib_sc_rollup_node/pvm_sig.ml @@ -69,7 +69,7 @@ module type S = sig type tree module Ctxt_wrapper : - Context_wrapper.S with type repo = repo and type tree = tree + Context.Wrapper.S with type repo = repo and type tree = tree include Sc_rollup.PVM.S diff --git a/src/proto_023_PtSeouLo/lib_sc_rollup_node/context_wrapper.ml b/src/proto_023_PtSeouLo/lib_sc_rollup_node/context_wrapper.ml index 54ea2988a7c0937e85ffea51a01bc5bd73c45245..7609b2bba54426fa6dbb2da61afc50934baf7756 100644 --- a/src/proto_023_PtSeouLo/lib_sc_rollup_node/context_wrapper.ml +++ b/src/proto_023_PtSeouLo/lib_sc_rollup_node/context_wrapper.ml @@ -6,125 +6,18 @@ (* *) (*****************************************************************************) -open Context -open Context_sigs +module Irmin = Context.Wrapper.Make (struct + include Irmin_context -let err_implementation_mismatch ~got = - Format.kasprintf invalid_arg "PVM Context implementation mismatch: got %s" got + let load ~cache_size path = load ~cache_size path +end) -module type S = sig - type repo +module Riscv = Context.Wrapper.Make (struct + include Riscv_context - type tree + type mut_state = Mutable_state.t - type mut_state + let from_imm = Mutable_state.from_imm - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate - - val from_imm : tree -> mut_state - - val to_imm : mut_state -> tree -end - -(* Context *) -let of_node_context : type repo tree. - (repo, tree) equality_witness -> - 'a Context.index -> - ('a, repo) Context_sigs.index = - fun eqw (Index {equality_witness; index; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> index - | _ -> - (* This could happen if the context backend was to change for a - given pvm/rollup. For now we only use Irmin, if this changes, - this will demand to provide migration functions from prior - pmv_context to the next one. *) - assert false - -let to_node_context : type repo tree. - (module Context_sigs.S with type tree = tree and type repo = repo) -> - ('a, repo) Context_sigs.index -> - 'a Context.index = - fun (module C) index -> - Context.make_index - ~index - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -(* PVMState *) -let of_node_pvmstate : type repo tree. - (repo, tree) equality_witness -> Context.pvmstate -> tree = - fun eqw (PVMState {equality_witness; pvmstate; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> pvmstate - | _ -> assert false - -let to_node_pvmstate : type tree. - (module Context_sigs.S with type tree = tree) -> tree -> Context.pvmstate = - fun (module C) pvmstate -> - Context.make_pvmstate - ~pvmstate - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -module Irmin = struct - module I = struct - include Irmin_context - - let load ~cache_size path = load ~cache_size path - end - - type repo = I.repo - - type tree = I.tree - - type mut_state = I.mut_state - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context I.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module I) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate I.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module I) - - let from_imm : tree -> mut_state = I.from_imm - - let to_imm : mut_state -> tree = I.to_imm -end - -module Riscv = struct - module R = Riscv_context - - type repo = R.repo - - type tree = R.tree - - type mut_state = R.Mutable_state.t - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context R.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module R) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate R.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module R) - - let from_imm : tree -> mut_state = R.Mutable_state.from_imm - - let to_imm : mut_state -> tree = R.Mutable_state.to_imm -end + let to_imm = Mutable_state.to_imm +end) diff --git a/src/proto_023_PtSeouLo/lib_sc_rollup_node/context_wrapper.mli b/src/proto_023_PtSeouLo/lib_sc_rollup_node/context_wrapper.mli index c610b03e99252fa41147bac4419f4bb54267623f..c714b0eaf845e6867fccdd1b89ccef03a839da01 100644 --- a/src/proto_023_PtSeouLo/lib_sc_rollup_node/context_wrapper.mli +++ b/src/proto_023_PtSeouLo/lib_sc_rollup_node/context_wrapper.mli @@ -6,43 +6,16 @@ (* *) (*****************************************************************************) -val err_implementation_mismatch : got:string -> 'a - -(** Context wrappers translate from/to node-context and node-pvmstate - PVMs internal representation to those used in the PVM. - Also provides conversion functions from/to mutable and immutable PVM types. - Each different PVM context will imply a dedicated wrapper.*) -module type S = sig - type repo - - type tree - - (** Type used by the mutable API for PVMs *) - type mut_state - - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate - - val from_imm : tree -> mut_state - - val to_imm : mut_state -> tree -end - (** Specialized module to handle translation to/from Irmin_context. Directly used in Arith, Wasm_2_0_0 and RISC-V PVM *) module Irmin : - S + Context.Wrapper.S with type repo = Irmin_context.repo and type tree = Irmin_context.tree and type mut_state = Irmin_context.mut_state module Riscv : - S + Context.Wrapper.S with type repo = Riscv_context.repo and type tree = Riscv_context.tree and type mut_state = Riscv_context.Mutable_state.t diff --git a/src/proto_023_PtSeouLo/lib_sc_rollup_node/pvm_sig.ml b/src/proto_023_PtSeouLo/lib_sc_rollup_node/pvm_sig.ml index a5b53b2bfb34f4dde1c44644d2ea5a7569aeb4a9..4ca02f57271bfd279c5038c702c2c32b48d407e0 100644 --- a/src/proto_023_PtSeouLo/lib_sc_rollup_node/pvm_sig.ml +++ b/src/proto_023_PtSeouLo/lib_sc_rollup_node/pvm_sig.ml @@ -69,7 +69,7 @@ module type S = sig type tree module Ctxt_wrapper : - Context_wrapper.S with type repo = repo and type tree = tree + Context.Wrapper.S with type repo = repo and type tree = tree include Sc_rollup.PVM.S diff --git a/src/proto_024_PtTALLiN/lib_sc_rollup_node/context_wrapper.ml b/src/proto_024_PtTALLiN/lib_sc_rollup_node/context_wrapper.ml index 54ea2988a7c0937e85ffea51a01bc5bd73c45245..7609b2bba54426fa6dbb2da61afc50934baf7756 100644 --- a/src/proto_024_PtTALLiN/lib_sc_rollup_node/context_wrapper.ml +++ b/src/proto_024_PtTALLiN/lib_sc_rollup_node/context_wrapper.ml @@ -6,125 +6,18 @@ (* *) (*****************************************************************************) -open Context -open Context_sigs +module Irmin = Context.Wrapper.Make (struct + include Irmin_context -let err_implementation_mismatch ~got = - Format.kasprintf invalid_arg "PVM Context implementation mismatch: got %s" got + let load ~cache_size path = load ~cache_size path +end) -module type S = sig - type repo +module Riscv = Context.Wrapper.Make (struct + include Riscv_context - type tree + type mut_state = Mutable_state.t - type mut_state + let from_imm = Mutable_state.from_imm - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate - - val from_imm : tree -> mut_state - - val to_imm : mut_state -> tree -end - -(* Context *) -let of_node_context : type repo tree. - (repo, tree) equality_witness -> - 'a Context.index -> - ('a, repo) Context_sigs.index = - fun eqw (Index {equality_witness; index; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> index - | _ -> - (* This could happen if the context backend was to change for a - given pvm/rollup. For now we only use Irmin, if this changes, - this will demand to provide migration functions from prior - pmv_context to the next one. *) - assert false - -let to_node_context : type repo tree. - (module Context_sigs.S with type tree = tree and type repo = repo) -> - ('a, repo) Context_sigs.index -> - 'a Context.index = - fun (module C) index -> - Context.make_index - ~index - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -(* PVMState *) -let of_node_pvmstate : type repo tree. - (repo, tree) equality_witness -> Context.pvmstate -> tree = - fun eqw (PVMState {equality_witness; pvmstate; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> pvmstate - | _ -> assert false - -let to_node_pvmstate : type tree. - (module Context_sigs.S with type tree = tree) -> tree -> Context.pvmstate = - fun (module C) pvmstate -> - Context.make_pvmstate - ~pvmstate - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -module Irmin = struct - module I = struct - include Irmin_context - - let load ~cache_size path = load ~cache_size path - end - - type repo = I.repo - - type tree = I.tree - - type mut_state = I.mut_state - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context I.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module I) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate I.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module I) - - let from_imm : tree -> mut_state = I.from_imm - - let to_imm : mut_state -> tree = I.to_imm -end - -module Riscv = struct - module R = Riscv_context - - type repo = R.repo - - type tree = R.tree - - type mut_state = R.Mutable_state.t - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context R.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module R) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate R.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module R) - - let from_imm : tree -> mut_state = R.Mutable_state.from_imm - - let to_imm : mut_state -> tree = R.Mutable_state.to_imm -end + let to_imm = Mutable_state.to_imm +end) diff --git a/src/proto_024_PtTALLiN/lib_sc_rollup_node/context_wrapper.mli b/src/proto_024_PtTALLiN/lib_sc_rollup_node/context_wrapper.mli index c610b03e99252fa41147bac4419f4bb54267623f..c714b0eaf845e6867fccdd1b89ccef03a839da01 100644 --- a/src/proto_024_PtTALLiN/lib_sc_rollup_node/context_wrapper.mli +++ b/src/proto_024_PtTALLiN/lib_sc_rollup_node/context_wrapper.mli @@ -6,43 +6,16 @@ (* *) (*****************************************************************************) -val err_implementation_mismatch : got:string -> 'a - -(** Context wrappers translate from/to node-context and node-pvmstate - PVMs internal representation to those used in the PVM. - Also provides conversion functions from/to mutable and immutable PVM types. - Each different PVM context will imply a dedicated wrapper.*) -module type S = sig - type repo - - type tree - - (** Type used by the mutable API for PVMs *) - type mut_state - - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate - - val from_imm : tree -> mut_state - - val to_imm : mut_state -> tree -end - (** Specialized module to handle translation to/from Irmin_context. Directly used in Arith, Wasm_2_0_0 and RISC-V PVM *) module Irmin : - S + Context.Wrapper.S with type repo = Irmin_context.repo and type tree = Irmin_context.tree and type mut_state = Irmin_context.mut_state module Riscv : - S + Context.Wrapper.S with type repo = Riscv_context.repo and type tree = Riscv_context.tree and type mut_state = Riscv_context.Mutable_state.t diff --git a/src/proto_024_PtTALLiN/lib_sc_rollup_node/pvm_sig.ml b/src/proto_024_PtTALLiN/lib_sc_rollup_node/pvm_sig.ml index a5b53b2bfb34f4dde1c44644d2ea5a7569aeb4a9..4ca02f57271bfd279c5038c702c2c32b48d407e0 100644 --- a/src/proto_024_PtTALLiN/lib_sc_rollup_node/pvm_sig.ml +++ b/src/proto_024_PtTALLiN/lib_sc_rollup_node/pvm_sig.ml @@ -69,7 +69,7 @@ module type S = sig type tree module Ctxt_wrapper : - Context_wrapper.S with type repo = repo and type tree = tree + Context.Wrapper.S with type repo = repo and type tree = tree include Sc_rollup.PVM.S diff --git a/src/proto_alpha/lib_sc_rollup_node/RPC_directory.ml b/src/proto_alpha/lib_sc_rollup_node/RPC_directory.ml index f8fab6bc625044dbb2b492edde1665876b25f73e..f48e2077d39608ed0a99ba5e46022e48ac26de5c 100644 --- a/src/proto_alpha/lib_sc_rollup_node/RPC_directory.ml +++ b/src/proto_alpha/lib_sc_rollup_node/RPC_directory.ml @@ -37,14 +37,18 @@ end module Block_directory = Make_sub_directory (struct include Sc_rollup_services.Block - type context = Node_context.rw + type context = Rpc_context.rw - type subcontext = Node_context.ro * Block_hash.t + type subcontext = Rpc_context.ro * Block_hash.t - let context_of_prefix node_ctxt (((), block) : prefix) = + let context_of_prefix rpc_ctxt (((), block) : prefix) = let open Lwt_result_syntax in - let+ block = Block_directory_helpers.block_of_prefix node_ctxt block in - (Node_context.readonly node_ctxt, block) + let+ block = + Block_directory_helpers.block_of_prefix + (Rpc_context.node_ctxt rpc_ctxt) + block + in + (Rpc_context.readonly rpc_ctxt, block) end) module Block_helpers_directory = Make_sub_directory (struct @@ -52,28 +56,27 @@ module Block_helpers_directory = Make_sub_directory (struct (* The context needs to be accessed with write permissions because we need to commit on disk to generate the proofs. *) - type context = Node_context.rw + type context = Rpc_context.rw (* The context needs to be accessed with write permissions because we need to commit on disk to generate the proofs. *) - type subcontext = Node_context.rw * Block_hash.t + type subcontext = Rpc_context.rw * Block_hash.t - let context_of_prefix node_ctxt (((), block) : prefix) = + let context_of_prefix rpc_ctxt (((), block) : prefix) = let open Lwt_result_syntax in - let+ block = Block_directory_helpers.block_of_prefix node_ctxt block in - (node_ctxt, block) + let+ block = + Block_directory_helpers.block_of_prefix + (Rpc_context.node_ctxt rpc_ctxt) + block + in + (rpc_ctxt, block) end) -let get_state (node_ctxt : _ Node_context.t) block_hash = - let open Lwt_result_syntax in - let* ctxt = Node_context.checkout_context node_ctxt block_hash in - let*! state = Context.PVMState.find ctxt in - match state with None -> failwith "No state" | Some state -> return state - -let simulate_messages (node_ctxt : Node_context.ro) block ~reveal_pages +let simulate_messages (rpc_ctxt : Rpc_context.ro) block ~reveal_pages ~insight_requests ~log_kernel_debug_file messages = let open Lwt_result_syntax in let open Alpha_context in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let module PVM = (val Pvm.of_kind node_ctxt.kind) in let reveal_map = match reveal_pages with @@ -98,36 +101,32 @@ let simulate_messages (node_ctxt : Node_context.ro) block ~reveal_pages let* level = Node_context.level_of_hash node_ctxt block in let* sim = Simulation.start_simulation - node_ctxt + rpc_ctxt ~reveal_map ?log_kernel_debug_file Layer1.{hash = block; level} in let* sim, num_ticks_0 = Simulation.simulate_messages sim messages in let* {state; inbox_level; _}, num_ticks_end = Simulation.end_simulation sim in + let state = PVM.Ctxt_wrapper.of_node_pvmstate state in let*! insights = let open PVM in List.map_p (function - | Sc_rollup_services.Pvm_state_key key -> - State.lookup (Ctxt_wrapper.of_node_pvmstate state) key + | Sc_rollup_services.Pvm_state_key key -> Mutable_state.lookup state key | Durable_storage_key key -> - Inspect_durable_state.lookup - (Ctxt_wrapper.of_node_pvmstate state) - key) + Mutable_state.Inspect_durable_state.lookup state key) insight_requests in let num_ticks = Z.(num_ticks_0 + num_ticks_end) in let level = Raw_level.of_int32_exn inbox_level in - let*! outbox = - PVM.get_outbox level (PVM.Ctxt_wrapper.of_node_pvmstate state) - in + let*! outbox = PVM.Mutable_state.get_outbox inbox_level state in let output = List.filter (fun out -> out.Sc_rollup.output_info.outbox_level = level) outbox in - let*! state_hash = PVM.state_hash (PVM.Ctxt_wrapper.of_node_pvmstate state) in + let*! state_hash = PVM.Mutable_state.state_hash state in let* constants = Protocol_plugins.get_constants_of_level node_ctxt inbox_level in @@ -137,9 +136,7 @@ let simulate_messages (node_ctxt : Node_context.ro) block ~reveal_pages |> Sc_rollup_proto_types.Constants.reveal_activation_level_of_octez |> Protocol.Alpha_context.Sc_rollup.is_reveal_enabled_predicate in - let*! status = - PVM.get_status ~is_reveal_enabled (PVM.Ctxt_wrapper.of_node_pvmstate state) - in + let*! status = PVM.Mutable_state.get_status ~is_reveal_enabled state in let status = PVM.string_of_status status in return Sc_rollup_services. @@ -147,9 +144,10 @@ let simulate_messages (node_ctxt : Node_context.ro) block ~reveal_pages let () = Block_directory.register0 Sc_rollup_services.Block.status - @@ fun (node_ctxt, block) () () -> + @@ fun (rpc_ctxt, block) () () -> let open Lwt_result_syntax in - let* state = get_state node_ctxt block in + let* state = Rpc_context.get_pvm_state Read_only rpc_ctxt block in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let* constants = Protocol_plugins.get_constants_of_block_hash node_ctxt block in @@ -161,12 +159,15 @@ let () = in let open (val Pvm.of_kind node_ctxt.kind) in let*! status = - get_status ~is_reveal_enabled (Ctxt_wrapper.of_node_pvmstate state) + Mutable_state.get_status + ~is_reveal_enabled + (Ctxt_wrapper.of_node_pvmstate state) in return (string_of_status status) -let get_outbox_messages node_ctxt block outbox_level = +let get_outbox_messages rpc_ctxt block outbox_level = let open Lwt_result_syntax in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let* block_level = Node_context.level_of_hash node_ctxt block in let outbox_level_int32 = Alpha_context.Raw_level.to_int32 outbox_level in let* () = @@ -176,10 +177,12 @@ let get_outbox_messages node_ctxt block outbox_level = outbox_level_int32 block_level in - let* state = get_state node_ctxt block in + let* state = Rpc_context.get_pvm_state Read_only rpc_ctxt block in let open (val Pvm.of_kind node_ctxt.kind) in let*! outbox = - get_outbox outbox_level (Ctxt_wrapper.of_node_pvmstate state) + Mutable_state.get_outbox + outbox_level_int32 + (Ctxt_wrapper.of_node_pvmstate state) in return outbox @@ -196,8 +199,9 @@ let () = let () = Block_helpers_directory.register1 Sc_rollup_services.Block.Helpers.outbox_proof_simple - @@ fun (node_ctxt, _block_hash) outbox_level message_index () -> + @@ fun (rpc_ctxt, _block_hash) outbox_level message_index () -> let open Lwt_result_syntax in + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let+ commitment, proof = Outbox.proof_of_output_simple node_ctxt ~outbox_level ~message_index in @@ -206,22 +210,23 @@ let () = let () = Block_directory.register0 Sc_rollup_services.Block.simulate @@ - fun (node_ctxt, block) + fun (rpc_ctxt, block) () {messages; reveal_pages; insight_requests; log_kernel_debug_file} -> simulate_messages - node_ctxt + rpc_ctxt block ~reveal_pages ~insight_requests ~log_kernel_debug_file messages -let block_directory (node_ctxt : _ Node_context.t) = +let block_directory (rpc_ctxt : _ Rpc_context.t) = + let node_ctxt = Rpc_context.node_ctxt rpc_ctxt in let module PVM = (val Pvm_rpc.of_kind node_ctxt.kind) in List.fold_left - (fun dir f -> Tezos_rpc.Directory.merge dir (f node_ctxt)) + (fun dir f -> Tezos_rpc.Directory.merge dir (f rpc_ctxt)) Tezos_rpc.Directory.empty [ Rpc_directory.build_block_subdirectory; @@ -230,9 +235,9 @@ let block_directory (node_ctxt : _ Node_context.t) = PVM.build_sub_directory; ] -let directory (node_ctxt : _ Node_context.t) = +let directory (rpc_ctxt : _ Rpc_context.t) = Tezos_rpc.Directory.merge - (Octez_smart_rollup_node.Rpc_directory.top_directory node_ctxt) + (Octez_smart_rollup_node.Rpc_directory.top_directory rpc_ctxt) (Tezos_rpc.Directory.prefix Sc_rollup_services.Block.prefix - (block_directory node_ctxt)) + (block_directory rpc_ctxt)) diff --git a/src/proto_alpha/lib_sc_rollup_node/RPC_directory.mli b/src/proto_alpha/lib_sc_rollup_node/RPC_directory.mli index 1cac46c2ded4ff6d534f64eb1db05f8599832038..160ba6f975d63c83faaeb3948e40f1ed2a79187d 100644 --- a/src/proto_alpha/lib_sc_rollup_node/RPC_directory.mli +++ b/src/proto_alpha/lib_sc_rollup_node/RPC_directory.mli @@ -25,9 +25,9 @@ (** The RPC directory, specific to blocks, for this rollup node. *) val block_directory : - Node_context.rw -> + Rpc_context.rw -> (unit * Rollup_node_services.Arg.block_id) Tezos_rpc.Directory.t (** The full RPC directory for this rollup node, merging the top level directory and the block directory. *) -val directory : Node_context.rw -> unit Tezos_rpc.Directory.t +val directory : Rpc_context.rw -> unit Tezos_rpc.Directory.t diff --git a/src/proto_alpha/lib_sc_rollup_node/arith_pvm.ml b/src/proto_alpha/lib_sc_rollup_node/arith_pvm.ml index 14690711307d499d78a19f3bfd3ee56128518574..835ffa7eeedfc33814aa58f06ad3f8c79e5ee75d 100644 --- a/src/proto_alpha/lib_sc_rollup_node/arith_pvm.ml +++ b/src/proto_alpha/lib_sc_rollup_node/arith_pvm.ml @@ -56,7 +56,7 @@ module Impl : Pvm_sig.S = struct let kind = Sc_rollup.Kind.Example_arith - module State = Irmin_context.PVMState + (* module State = Irmin_context.PVMState *) module Inspect_durable_state = struct let lookup _state _keys = @@ -72,6 +72,8 @@ module Impl : Pvm_sig.S = struct | Increase_max_nb_ticks _ | Patch_durable_storage _ -> assert false let apply _state (x : t) = match x with _ -> . + + let apply_mutable _ (x : t) = match x with _ -> . end let new_dissection = Game_helpers.default_new_dissection @@ -114,15 +116,44 @@ module Impl : Pvm_sig.S = struct module Mutable_state : Pvm_sig.MUTABLE_STATE_S with type hash = hash + and type repo = repo + and type status = status and type t = Ctxt_wrapper.mut_state = struct + include Irmin_context.PVMState + type t = tree ref type hash = Sc_rollup.State_hash.t + type repo = Irmin_context.repo + + type nonrec status = status + let get_tick state = get_tick !state let state_hash state = state_hash !state + let get_current_level state = + let open Lwt_syntax in + let+ level = get_current_level !state in + Option.map Raw_level.to_int32 level + + let get_outbox level state = + get_outbox (Raw_level.of_int32_exn level) !state + + let get_status ~is_reveal_enabled state = + get_status ~is_reveal_enabled !state + + let initial_state ~empty = + let open Lwt_syntax in + let+ state = initial_state ~empty:!empty in + ref state + + let install_boot_sector state boot_sector = + let open Lwt_syntax in + let+ new_state = install_boot_sector !state boot_sector in + state := new_state + let is_input_state ~is_reveal_enabled state = is_input_state ~is_reveal_enabled !state @@ -148,6 +179,10 @@ module Impl : Pvm_sig.S = struct mut_state := imm_state ; return steps + module Inspect_durable_state = struct + let lookup state keys = Inspect_durable_state.lookup !state keys + end + module Internal_for_tests = struct let insert_failure state = let open Lwt_syntax in diff --git a/src/proto_alpha/lib_sc_rollup_node/context_wrapper.ml b/src/proto_alpha/lib_sc_rollup_node/context_wrapper.ml index 54ea2988a7c0937e85ffea51a01bc5bd73c45245..429604273fdaf8fbffa00eac7d75696dee9362f1 100644 --- a/src/proto_alpha/lib_sc_rollup_node/context_wrapper.ml +++ b/src/proto_alpha/lib_sc_rollup_node/context_wrapper.ml @@ -6,125 +6,10 @@ (* *) (*****************************************************************************) -open Context -open Context_sigs +module Irmin = Context.Wrapper.Make (struct + include Irmin_context -let err_implementation_mismatch ~got = - Format.kasprintf invalid_arg "PVM Context implementation mismatch: got %s" got + let load ~cache_size path = load ~cache_size path +end) -module type S = sig - type repo - - type tree - - type mut_state - - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate - - val from_imm : tree -> mut_state - - val to_imm : mut_state -> tree -end - -(* Context *) -let of_node_context : type repo tree. - (repo, tree) equality_witness -> - 'a Context.index -> - ('a, repo) Context_sigs.index = - fun eqw (Index {equality_witness; index; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> index - | _ -> - (* This could happen if the context backend was to change for a - given pvm/rollup. For now we only use Irmin, if this changes, - this will demand to provide migration functions from prior - pmv_context to the next one. *) - assert false - -let to_node_context : type repo tree. - (module Context_sigs.S with type tree = tree and type repo = repo) -> - ('a, repo) Context_sigs.index -> - 'a Context.index = - fun (module C) index -> - Context.make_index - ~index - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -(* PVMState *) -let of_node_pvmstate : type repo tree. - (repo, tree) equality_witness -> Context.pvmstate -> tree = - fun eqw (PVMState {equality_witness; pvmstate; _}) -> - match Context.equiv equality_witness eqw with - | Some Refl, Some Refl -> pvmstate - | _ -> assert false - -let to_node_pvmstate : type tree. - (module Context_sigs.S with type tree = tree) -> tree -> Context.pvmstate = - fun (module C) pvmstate -> - Context.make_pvmstate - ~pvmstate - ~pvm_context_impl:(module C) - ~equality_witness:C.equality_witness - ~impl_name:C.impl_name - -module Irmin = struct - module I = struct - include Irmin_context - - let load ~cache_size path = load ~cache_size path - end - - type repo = I.repo - - type tree = I.tree - - type mut_state = I.mut_state - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context I.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module I) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate I.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module I) - - let from_imm : tree -> mut_state = I.from_imm - - let to_imm : mut_state -> tree = I.to_imm -end - -module Riscv = struct - module R = Riscv_context - - type repo = R.repo - - type tree = R.tree - - type mut_state = R.Mutable_state.t - - let of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index = - fun ctxt -> of_node_context R.equality_witness ctxt - - let to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index = - fun ctxt -> to_node_context (module R) ctxt - - let of_node_pvmstate : Context.pvmstate -> tree = - fun c -> of_node_pvmstate R.equality_witness c - - let to_node_pvmstate : tree -> Context.pvmstate = to_node_pvmstate (module R) - - let from_imm : tree -> mut_state = R.Mutable_state.from_imm - - let to_imm : mut_state -> tree = R.Mutable_state.to_imm -end +module Riscv = Context.Wrapper.Make (Riscv_context) diff --git a/src/proto_alpha/lib_sc_rollup_node/context_wrapper.mli b/src/proto_alpha/lib_sc_rollup_node/context_wrapper.mli index c610b03e99252fa41147bac4419f4bb54267623f..e948c041bf660ad2895848f9e5ff4709c9548c50 100644 --- a/src/proto_alpha/lib_sc_rollup_node/context_wrapper.mli +++ b/src/proto_alpha/lib_sc_rollup_node/context_wrapper.mli @@ -6,43 +6,16 @@ (* *) (*****************************************************************************) -val err_implementation_mismatch : got:string -> 'a - -(** Context wrappers translate from/to node-context and node-pvmstate - PVMs internal representation to those used in the PVM. - Also provides conversion functions from/to mutable and immutable PVM types. - Each different PVM context will imply a dedicated wrapper.*) -module type S = sig - type repo - - type tree - - (** Type used by the mutable API for PVMs *) - type mut_state - - val of_node_context : 'a Context.index -> ('a, repo) Context_sigs.index - - val to_node_context : ('a, repo) Context_sigs.index -> 'a Context.index - - val of_node_pvmstate : Context.pvmstate -> tree - - val to_node_pvmstate : tree -> Context.pvmstate - - val from_imm : tree -> mut_state - - val to_imm : mut_state -> tree -end - (** Specialized module to handle translation to/from Irmin_context. Directly used in Arith, Wasm_2_0_0 and RISC-V PVM *) module Irmin : - S + Context.Wrapper.S with type repo = Irmin_context.repo - and type tree = Irmin_context.tree + and type state = Irmin_context.state and type mut_state = Irmin_context.mut_state module Riscv : - S + Context.Wrapper.S with type repo = Riscv_context.repo - and type tree = Riscv_context.tree - and type mut_state = Riscv_context.Mutable_state.t + and type state = Riscv_context.state + and type mut_state = Riscv_context.mut_state diff --git a/src/proto_alpha/lib_sc_rollup_node/fueled_pvm.ml b/src/proto_alpha/lib_sc_rollup_node/fueled_pvm.ml index 0f531e336a5b6da9e09bc1efbe8a57b72cf93a24..b3b2706edf69598414e2ec84aaf3980f84952bf6 100644 --- a/src/proto_alpha/lib_sc_rollup_node/fueled_pvm.ml +++ b/src/proto_alpha/lib_sc_rollup_node/fueled_pvm.ml @@ -493,13 +493,11 @@ module Make_fueled (F : Fuel.S) : FUELED_PVM with type fuel = F.t = struct (feed_messages [@tailcall]) (state, fuel) message_counter_offset messages let eval_block_inbox ~fuel (node_ctxt : _ Node_context.t) (inbox, messages) - (state : Context.pvmstate) : fuel eval_result tzresult Lwt.t = + (state : _ Context.pvmstate) : fuel eval_result tzresult Lwt.t = let open Lwt_result_syntax in let module PVM = (val Pvm.of_kind node_ctxt.kind) in let module PVM_mut_state = PVM.Mutable_state in - let mut_state = - PVM.Ctxt_wrapper.from_imm @@ PVM.Ctxt_wrapper.of_node_pvmstate state - in + let mut_state = PVM.Ctxt_wrapper.of_node_pvmstate state in (* Obtain inbox and its messages for this block. *) let inbox_level = Octez_smart_rollup.Inbox.inbox_level inbox in let*! initial_tick = PVM_mut_state.get_tick mut_state in @@ -518,9 +516,7 @@ module Make_fueled (F : Fuel.S) : FUELED_PVM with type fuel = F.t = struct let*! final_tick = PVM_mut_state.get_tick mut_state in let*! state_hash = PVM_mut_state.state_hash mut_state in let num_ticks = Sc_rollup.Tick.distance initial_tick final_tick in - let state = - PVM.Ctxt_wrapper.to_node_pvmstate @@ PVM.Ctxt_wrapper.to_imm mut_state - in + let state = PVM.Ctxt_wrapper.to_node_pvmstate mut_state in let eval_state = { state; @@ -547,9 +543,7 @@ module Make_fueled (F : Fuel.S) : FUELED_PVM with type fuel = F.t = struct let open Lwt_result_syntax in let module PVM = (val Pvm.of_kind node_ctxt.kind) in let module PVM_mut_state = PVM.Mutable_state in - let state = - PVM.Ctxt_wrapper.from_imm @@ PVM.Ctxt_wrapper.of_node_pvmstate state - in + let state = PVM.Ctxt_wrapper.of_node_pvmstate state in let* remaining_fuel, num_messages, remaining_messages = match messages with | [] -> @@ -592,9 +586,7 @@ module Make_fueled (F : Fuel.S) : FUELED_PVM with type fuel = F.t = struct let final_tick = Sc_rollup.Tick.to_z final_tick in let*! state_hash = PVM_mut_state.state_hash state in let num_ticks = Z.sub final_tick initial_tick in - let state = - PVM.Ctxt_wrapper.to_node_pvmstate @@ PVM.Ctxt_wrapper.to_imm state - in + let state = PVM.Ctxt_wrapper.to_node_pvmstate state in let eval_state = { state; diff --git a/src/proto_alpha/lib_sc_rollup_node/outbox.ml b/src/proto_alpha/lib_sc_rollup_node/outbox.ml index d30705bb6110b47de25c7d27f73e3b446cf8542c..0eedf97c0b40302ab2b38b78f840e5201bf414db 100644 --- a/src/proto_alpha/lib_sc_rollup_node/outbox.ml +++ b/src/proto_alpha/lib_sc_rollup_node/outbox.ml @@ -50,7 +50,7 @@ let proof_of_output node_ctxt output = let*! proof = produce_output_proof (Ctxt_wrapper.of_node_context node_ctxt.context) - (Ctxt_wrapper.of_node_pvmstate state) + Ctxt_wrapper.(to_imm @@ of_node_pvmstate state) output in match proof with diff --git a/src/proto_alpha/lib_sc_rollup_node/pvm_plugin.ml b/src/proto_alpha/lib_sc_rollup_node/pvm_plugin.ml index bb78723a6e6059964254e593260d3e884561e152..b58c302aa878e352db4241fb1306f5656d14cb73 100644 --- a/src/proto_alpha/lib_sc_rollup_node/pvm_plugin.ml +++ b/src/proto_alpha/lib_sc_rollup_node/pvm_plugin.ml @@ -32,19 +32,19 @@ let context = Pvm.context let get_tick kind state = let open Lwt_syntax in let open (val Pvm.of_kind kind) in - let+ tick = get_tick (Ctxt_wrapper.of_node_pvmstate state) in + let+ tick = Mutable_state.get_tick (Ctxt_wrapper.of_node_pvmstate state) in Sc_rollup.Tick.to_z tick let state_hash kind state = let open Lwt_syntax in let open (val Pvm.of_kind kind) in - let+ hash = state_hash (Ctxt_wrapper.of_node_pvmstate state) in + let+ hash = Mutable_state.state_hash (Ctxt_wrapper.of_node_pvmstate state) in Sc_rollup_proto_types.State_hash.to_octez hash let initial_state kind = let open Lwt_syntax in let open (val Pvm.of_kind kind) in - let+ state = initial_state ~empty:(State.empty ()) in + let+ state = Mutable_state.initial_state ~empty:(Mutable_state.empty ()) in Ctxt_wrapper.to_node_pvmstate state let parse_boot_sector kind = @@ -52,33 +52,24 @@ let parse_boot_sector kind = PVM.parse_boot_sector let install_boot_sector kind state boot_sector = - let open Lwt_syntax in let open (val Pvm.of_kind kind) in - let+ state = - install_boot_sector (Ctxt_wrapper.of_node_pvmstate state) boot_sector - in - Ctxt_wrapper.to_node_pvmstate state + Mutable_state.install_boot_sector + (Ctxt_wrapper.of_node_pvmstate state) + boot_sector let get_current_level kind state = - let open Lwt_option_syntax in let open (val Pvm.of_kind kind) in - let+ current_level = - get_current_level (Ctxt_wrapper.of_node_pvmstate state) - in - Raw_level.to_int32 current_level + Mutable_state.get_current_level (Ctxt_wrapper.of_node_pvmstate state) let get_status (node_ctxt : _ Node_context.t) state = let open Lwt_result_syntax in let module PVM = (val Pvm.of_kind node_ctxt.kind) in let state = PVM.Ctxt_wrapper.of_node_pvmstate state in - let*! current_level = PVM.get_current_level state in + let*! current_level = PVM.Mutable_state.get_current_level state in let* constants = match current_level with | None -> return (Reference.get node_ctxt.current_protocol).constants - | Some level -> - Protocol_plugins.get_constants_of_level - node_ctxt - (Raw_level.to_int32 level) + | Some level -> Protocol_plugins.get_constants_of_level node_ctxt level in let is_reveal_enabled = constants.sc_rollup.reveal_activation_level @@ -86,7 +77,7 @@ let get_status (node_ctxt : _ Node_context.t) state = |> Sc_rollup_proto_types.Constants.reveal_activation_level_of_octez |> Protocol.Alpha_context.Sc_rollup.is_reveal_enabled_predicate in - let*! status = PVM.get_status ~is_reveal_enabled state in + let*! status = PVM.Mutable_state.get_status ~is_reveal_enabled state in return (PVM.string_of_status status) module Fueled = Fueled_pvm @@ -110,9 +101,10 @@ let info_per_level_serialized ~predecessor ~predecessor_timestamp = let find_whitelist_update_output_index node_ctxt state ~outbox_level = let open Lwt_syntax in - let outbox_level = Raw_level.of_int32_exn outbox_level in let open (val Pvm.of_kind node_ctxt.Node_context.kind) in - let* outbox = get_outbox outbox_level (Ctxt_wrapper.of_node_pvmstate state) in + let* outbox = + Mutable_state.get_outbox outbox_level (Ctxt_wrapper.of_node_pvmstate state) + in let rec aux i = function | [] -> None | Sc_rollup.{message = Whitelist_update _; _} :: _rest -> Some i @@ -172,9 +164,10 @@ let outbox_message_summary (output : Sc_rollup.output) = let get_outbox_messages node_ctxt state ~outbox_level = let open Lwt_syntax in - let outbox_level = Raw_level.of_int32_exn outbox_level in let open (val Pvm.of_kind node_ctxt.Node_context.kind) in - let* outbox = get_outbox outbox_level (Ctxt_wrapper.of_node_pvmstate state) in + let* outbox = + Mutable_state.get_outbox outbox_level (Ctxt_wrapper.of_node_pvmstate state) + in List.rev_map outbox_message_summary outbox |> List.rev |> return let produce_serialized_output_proof node_ctxt state ~outbox_level ~message_index @@ -182,22 +175,20 @@ let produce_serialized_output_proof node_ctxt state ~outbox_level ~message_index let open Lwt_result_syntax in let module PVM = (val Pvm.of_kind node_ctxt.Node_context.kind) in let state = PVM.Ctxt_wrapper.of_node_pvmstate state in - let outbox_level = Raw_level.of_int32_exn outbox_level in - let*! outbox = PVM.get_outbox outbox_level state in + let*! outbox = PVM.Mutable_state.get_outbox outbox_level state in let output = List.nth outbox message_index in match output with | None -> failwith - "No message at index %d in outbox at level %a registered in cemented \ + "No message at index %d in outbox at level %ld registered in cemented \ state" message_index - Raw_level.pp outbox_level | Some output -> ( let*! proof = PVM.produce_output_proof (PVM.Ctxt_wrapper.of_node_context node_ctxt.context) - state + (PVM.Ctxt_wrapper.to_imm state) output in match proof with @@ -219,19 +210,26 @@ module Wasm_2_0_0 = struct let decode_durable_state enc tree = Wasm_2_0_0_pvm.Durable_state.Tree_encoding_runner.decode enc - (of_node_pvmstate tree) + !(of_node_pvmstate tree) let proof_mem_tree tree = - Wasm_2_0_0_pvm.Wasm_2_0_0_proof_format.Tree.mem_tree (of_node_pvmstate tree) + Wasm_2_0_0_pvm.Wasm_2_0_0_proof_format.Tree.mem_tree + !(of_node_pvmstate tree) let proof_fold_tree ?depth tree key ~order ~init ~f = + let mode = Context.PVMState.access_mode tree in + let state = !(of_node_pvmstate tree) in Wasm_2_0_0_pvm.Wasm_2_0_0_proof_format.Tree.fold ?depth - (of_node_pvmstate tree) + state key ~order ~init - ~f:(fun a b c -> f a (to_node_pvmstate b) c) + ~f:(fun a b c -> + let b = + Context.PVMState.change_access (to_node_pvmstate (ref b)) mode + in + f a b c) end module Unsafe = struct @@ -240,10 +238,7 @@ module Unsafe = struct let open Lwt_result_syntax in let open (val Pvm.of_kind kind) in let*? patch = Unsafe_patches.of_patch patch in - let* state = - protect @@ fun () -> - Unsafe_patches.apply (Ctxt_wrapper.of_node_pvmstate state) patch - |> Lwt_result.ok - in - return (Ctxt_wrapper.to_node_pvmstate state) + protect @@ fun () -> + Unsafe_patches.apply_mutable (Ctxt_wrapper.of_node_pvmstate state) patch + |> Lwt_result.ok end diff --git a/src/proto_alpha/lib_sc_rollup_node/pvm_rpc.ml b/src/proto_alpha/lib_sc_rollup_node/pvm_rpc.ml index b56e3b5d1c5c99eea63162c9bd803772a82d8131..5055fd70f2eb166f752169159ec99b3b0d938e98 100644 --- a/src/proto_alpha/lib_sc_rollup_node/pvm_rpc.ml +++ b/src/proto_alpha/lib_sc_rollup_node/pvm_rpc.ml @@ -26,7 +26,7 @@ module type S = sig (** Build RPC directory of the PVM *) val build_sub_directory : - Node_context.rw -> + Rpc_context.rw -> (unit * Rollup_node_services.Arg.block_id) Tezos_rpc.Directory.t end diff --git a/src/proto_alpha/lib_sc_rollup_node/pvm_sig.ml b/src/proto_alpha/lib_sc_rollup_node/pvm_sig.ml index a5b53b2bfb34f4dde1c44644d2ea5a7569aeb4a9..cb766c072af514c06efa96a7926fd75598fdd83f 100644 --- a/src/proto_alpha/lib_sc_rollup_node/pvm_sig.ml +++ b/src/proto_alpha/lib_sc_rollup_node/pvm_sig.ml @@ -28,18 +28,49 @@ open Protocol open Alpha_context (** Mutable API for the PVM. - - PVM functions which update the state in-place instead of returning a new state. + - PVM functions which update the state in-place instead of returning a new + state. This API helps the RISC-V PVM avoid unnecessary state copying. *) module type MUTABLE_STATE_S = sig type t + type repo + type hash + type status + + (** [empty ()] is the empty state. *) + val empty : unit -> t + + (** [find context] returns the PVM state stored in the [context], if any. *) + val find : ('a, repo, t) Context_sigs.t -> t option Lwt.t + + (** [lookup state path] returns the data stored for the path [path] in the + PVM state [state]. *) + val lookup : t -> string list -> bytes option Lwt.t + + (** [set context state] saves the PVM state [state] in the context and + returns the updated context. Note: [set] does not perform any write on + disk, this information must be committed using {!val:Context.commit}. *) + val set : ('a, repo, t) Context_sigs.t -> t -> unit Lwt.t + val get_tick : t -> Sc_rollup.Tick.t Lwt.t + val get_current_level : t -> int32 option Lwt.t + + val get_outbox : int32 -> t -> Sc_rollup.output list Lwt.t + + val get_status : + is_reveal_enabled:Sc_rollup.is_reveal_enabled -> t -> status Lwt.t + val state_hash : t -> hash Lwt.t + val initial_state : empty:t -> t Lwt.t + + val install_boot_sector : t -> string -> unit Lwt.t + val is_input_state : is_reveal_enabled:Sc_rollup.is_reveal_enabled -> t -> @@ -57,6 +88,10 @@ module type MUTABLE_STATE_S = sig t -> int64 Lwt.t + module Inspect_durable_state : sig + val lookup : t -> string list -> bytes option Lwt.t + end + module Internal_for_tests : sig val insert_failure : t -> unit Lwt.t end @@ -69,7 +104,7 @@ module type S = sig type tree module Ctxt_wrapper : - Context_wrapper.S with type repo = repo and type tree = tree + Context.Wrapper.S with type repo = repo and type state = tree include Sc_rollup.PVM.S @@ -115,32 +150,13 @@ module type S = sig our_stop_chunk:Sc_rollup.Dissection_chunk.t -> Sc_rollup.Tick.t list - (** State storage for this PVM. *) - module State : sig - type value = state - - (** [empty ()] is the empty state. *) - val empty : unit -> state - - (** [find context] returns the PVM state stored in the [context], if any. *) - val find : ('a, repo, tree) Context_sigs.t -> state option Lwt.t - - (** [lookup state path] returns the data stored for the path [path] in the - PVM state [state]. *) - val lookup : state -> string list -> bytes option Lwt.t - - (** [set context state] saves the PVM state [state] in the context and - returns the updated context. Note: [set] does not perform any write on - disk, this information must be committed using {!val:Context.commit}. *) - val set : - ('a, repo, tree) Context_sigs.t -> - state -> - ('a, repo, tree) Context_sigs.t Lwt.t - end - (** Mutable state API which allows updating the PVM state in-place. *) module Mutable_state : - MUTABLE_STATE_S with type hash = hash and type t = Ctxt_wrapper.mut_state + MUTABLE_STATE_S + with type t = Ctxt_wrapper.mut_state + and type repo = repo + and type hash = hash + and type status = status (** Inspect durable state using a more specialised way of reading the PVM state. @@ -164,5 +180,7 @@ module type S = sig (** [apply state patch] applies the unsafe patch [patch] on the state. *) val apply : state -> t -> state Lwt.t + + val apply_mutable : Mutable_state.t -> t -> unit Lwt.t end end diff --git a/src/proto_alpha/lib_sc_rollup_node/refutation_game_helpers.ml b/src/proto_alpha/lib_sc_rollup_node/refutation_game_helpers.ml index 81f4a9e342d4a6fcd3cdea6bbf840ff3dd068397..ecf8629188f420c9d1fe0e0e7551e3a07a54decf 100644 --- a/src/proto_alpha/lib_sc_rollup_node/refutation_game_helpers.ml +++ b/src/proto_alpha/lib_sc_rollup_node/refutation_game_helpers.ml @@ -66,7 +66,7 @@ let page_info_from_pvm_state constants (node_ctxt : _ Node_context.t) in let*! input_request = let open (val Pvm.of_kind node_ctxt.kind) in - is_input_state + Mutable_state.is_input_state ~is_reveal_enabled (Ctxt_wrapper.of_node_pvmstate start_state) in @@ -107,7 +107,7 @@ let metadata (node_ctxt : _ Node_context.t) = Sc_rollup.Metadata.{address; origination_level} let generate_proof (node_ctxt : _ Node_context.t) - (game : Octez_smart_rollup.Game.t) (start_state : Context.pvmstate) = + (game : Octez_smart_rollup.Game.t) (start_state : _ Context.pvmstate) = let open Lwt_result_syntax in let module PVM = (val Pvm.of_kind node_ctxt.kind) in let snapshot = @@ -160,7 +160,7 @@ let generate_proof (node_ctxt : _ Node_context.t) ) | _ -> return (None, max_int) in - let state = PVM.Ctxt_wrapper.of_node_pvmstate start_state in + let state = PVM.Ctxt_wrapper.(to_imm @@ of_node_pvmstate start_state) in let* page_info = (* The page content that could be imported at the current import level of the PVM. It is expected to be [None] if the page id is not valid or if @@ -248,7 +248,7 @@ let generate_proof (node_ctxt : _ Node_context.t) end in let metadata = metadata node_ctxt in let*! start_tick = - PVM.get_tick (PVM.Ctxt_wrapper.of_node_pvmstate start_state) + PVM.Mutable_state.get_tick (PVM.Ctxt_wrapper.of_node_pvmstate start_state) in let is_reveal_enabled = match constants.sc_rollup.reveal_activation_level with diff --git a/src/proto_alpha/lib_sc_rollup_node/riscv_pvm.ml b/src/proto_alpha/lib_sc_rollup_node/riscv_pvm.ml index d11ba8b7966deefe66ec98bae1513b6bfa6f7993..43e61c237c6d2457cde6221eed76a2d2ac5e2b02 100644 --- a/src/proto_alpha/lib_sc_rollup_node/riscv_pvm.ml +++ b/src/proto_alpha/lib_sc_rollup_node/riscv_pvm.ml @@ -13,9 +13,11 @@ module Storage = Octez_riscv_pvm.Storage type repo = Context.repo -type tree = Context.tree +type tree = Context.state -module State = Riscv_context.PVMState +(* type state = Context.state *) + +(* module State = Riscv_context.PVMState *) module Backend = Octez_riscv_pvm.Backend module Ctxt_wrapper = Context_wrapper.Riscv @@ -77,7 +79,7 @@ let make_is_input_state (get_status : 'a -> Backend.status Lwt.t) module PVM : Sc_rollup.PVM.S - with type state = tree + with type state = Context.state and type context = Riscv_context.rw_index and type proof = Backend.proof = struct let parse_boot_sector s = Some s @@ -113,7 +115,7 @@ module PVM : let state_hash state = Lwt.return @@ Backend.state_hash state - let initial_state ~empty:_ = Lwt.return (Storage.empty ()) + let initial_state ~empty = Lwt.return empty let install_boot_sector state boot_sector = Backend.install_boot_sector state boot_sector @@ -215,11 +217,19 @@ let eval_many ?check_invalid_kernel:_ ~reveal_builtins:_ ~write_debug module Mutable_state : Pvm_sig.MUTABLE_STATE_S with type hash = PVM.hash + and type repo = repo + and type status = status and type t = Ctxt_wrapper.mut_state = struct + include Riscv_context.PVMState + type t = Backend.Mutable_state.t type hash = PVM.hash + type repo = Context.repo + + type nonrec status = status + let get_tick state = let open Lwt_syntax in let* tick = Backend.Mutable_state.get_tick state in @@ -227,16 +237,30 @@ module Mutable_state : let state_hash state = Lwt.return @@ Backend.Mutable_state.state_hash state - let is_input_state = + let get_current_level state = Backend.Mutable_state.get_current_level state + + let get_outbox _level _state = Lwt.return [] + + let get_status ~is_reveal_enabled:_ state = + Backend.Mutable_state.get_status state + + let is_input_state ~is_reveal_enabled state = make_is_input_state Backend.Mutable_state.get_status Backend.Mutable_state.get_current_level Backend.Mutable_state.get_message_counter Backend.Mutable_state.get_reveal_request + ~is_reveal_enabled + state let set_input input state = Backend.Mutable_state.set_input state @@ to_pvm_input input + let initial_state ~empty = Lwt.return empty + + let install_boot_sector state boot_sector = + Backend.Mutable_state.install_boot_sector state boot_sector + let eval_many ?check_invalid_kernel:_ ~reveal_builtins:_ ~write_debug ~is_reveal_enabled:_ ?stop_at_snapshot ~max_steps initial_state = let debug_printer = @@ -250,6 +274,11 @@ module Mutable_state : ~max_steps initial_state + module Inspect_durable_state = struct + let lookup _state _keys = + raise (Invalid_argument "No durable storage for riscv PVM") + end + module Internal_for_tests = struct let insert_failure state = Backend.Mutable_state.insert_failure state end @@ -272,4 +301,6 @@ module Unsafe_patches = struct | Patch_durable_storage _ -> assert false let apply _state (x : t) = match x with _ -> . + + let apply_mutable _ (x : t) = match x with _ -> . end diff --git a/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_pvm.ml b/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_pvm.ml index a0edbfd8463a9ddb23c5101b2efe77fde9063709..2ce39a24a5ee3d9a552569407129dd0150d26afc 100644 --- a/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_pvm.ml +++ b/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_pvm.ml @@ -149,7 +149,7 @@ module Impl : Pvm_sig.S with type Unsafe_patches.t = unsafe_patch = struct let new_dissection = Game_helpers.Wasm.new_dissection - module State = Irmin_context.PVMState + (* module State = Irmin_context.PVMState *) module Inspect_durable_state = struct let lookup state keys = @@ -159,35 +159,6 @@ module Impl : Pvm_sig.S with type Unsafe_patches.t = unsafe_patch = struct module Backend = Make_backend (Wasm_2_0_0_proof_format.Tree) - module Unsafe_patches = struct - type t = unsafe_patch - - let of_patch (p : Pvm_patches.unsafe_patch) = - match p with - | Increase_max_nb_ticks max_nb_ticks -> - Ok (Increase_max_nb_ticks max_nb_ticks) - | Patch_durable_storage {key; value} -> - Ok (Patch_durable_storage {key; value}) - - let apply state unsafe_patch = - let open Lwt_syntax in - match unsafe_patch with - | Increase_max_nb_ticks max_nb_ticks -> - let* registered_max_nb_ticks = - Backend.Unsafe.get_max_nb_ticks state - in - let max_nb_ticks = Z.of_int64 max_nb_ticks in - if Z.Compare.(max_nb_ticks < registered_max_nb_ticks) then - Format.ksprintf - invalid_arg - "Decreasing tick limit of WASM PVM from %s to %s is not allowed" - (Z.to_string registered_max_nb_ticks) - (Z.to_string max_nb_ticks) ; - Backend.Unsafe.set_max_nb_ticks max_nb_ticks state - | Patch_durable_storage {key; value} -> - Backend.Unsafe.durable_set ~key ~value state - end - let string_of_status : status -> string = function | Waiting_for_input_message -> "Waiting for input message" | Waiting_for_reveal (Sc_rollup.Reveal_raw_data hash) -> @@ -220,15 +191,44 @@ module Impl : Pvm_sig.S with type Unsafe_patches.t = unsafe_patch = struct module Mutable_state : Pvm_sig.MUTABLE_STATE_S with type hash = hash + and type repo = repo + and type status = status and type t = Ctxt_wrapper.mut_state = struct + include Irmin_context.PVMState + type t = tree ref type hash = Sc_rollup.State_hash.t + type repo = Irmin_context.repo + + type nonrec status = status + let get_tick state = get_tick !state let state_hash state = state_hash !state + let get_current_level state = + let open Lwt_syntax in + let+ level = get_current_level !state in + Option.map Raw_level.to_int32 level + + let get_outbox level state = + get_outbox (Raw_level.of_int32_exn level) !state + + let get_status ~is_reveal_enabled state = + get_status ~is_reveal_enabled !state + + let initial_state ~empty = + let open Lwt_syntax in + let+ state = initial_state ~empty:!empty in + ref state + + let install_boot_sector state boot_sector = + let open Lwt_syntax in + let+ new_state = install_boot_sector !state boot_sector in + state := new_state + let is_input_state ~is_reveal_enabled state = is_input_state ~is_reveal_enabled !state @@ -254,6 +254,10 @@ module Impl : Pvm_sig.S with type Unsafe_patches.t = unsafe_patch = struct mut_state := imm_state ; return steps + module Inspect_durable_state = struct + let lookup state keys = Inspect_durable_state.lookup !state keys + end + module Internal_for_tests = struct let insert_failure state = let open Lwt_syntax in @@ -262,6 +266,40 @@ module Impl : Pvm_sig.S with type Unsafe_patches.t = unsafe_patch = struct return_unit end end + + module Unsafe_patches = struct + type t = unsafe_patch + + let of_patch (p : Pvm_patches.unsafe_patch) = + match p with + | Increase_max_nb_ticks max_nb_ticks -> + Ok (Increase_max_nb_ticks max_nb_ticks) + | Patch_durable_storage {key; value} -> + Ok (Patch_durable_storage {key; value}) + + let apply state unsafe_patch = + let open Lwt_syntax in + match unsafe_patch with + | Increase_max_nb_ticks max_nb_ticks -> + let* registered_max_nb_ticks = + Backend.Unsafe.get_max_nb_ticks state + in + let max_nb_ticks = Z.of_int64 max_nb_ticks in + if Z.Compare.(max_nb_ticks < registered_max_nb_ticks) then + Format.ksprintf + invalid_arg + "Decreasing tick limit of WASM PVM from %s to %s is not allowed" + (Z.to_string registered_max_nb_ticks) + (Z.to_string max_nb_ticks) ; + Backend.Unsafe.set_max_nb_ticks max_nb_ticks state + | Patch_durable_storage {key; value} -> + Backend.Unsafe.durable_set ~key ~value state + + let apply_mutable state patch = + let open Lwt_syntax in + let+ patched_state = apply !state patch in + state := patched_state + end end include Impl diff --git a/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_rpc.ml b/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_rpc.ml index 3a11d681a47ca53a8c5679ec79ae8f3e1ebf5e28..8d0d26a4a0629c3c741422c83e346eeeaae0809c 100644 --- a/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_rpc.ml +++ b/src/proto_alpha/lib_sc_rollup_node/wasm_2_0_0_rpc.ml @@ -34,14 +34,18 @@ struct module Block_directory = Make_sub_directory (struct include Sc_rollup_services.Block - type context = Node_context.rw + type context = Rpc_context.rw - type subcontext = Node_context.ro * Block_hash.t + type subcontext = Access_mode.ro Context.pvmstate - let context_of_prefix node_ctxt (((), block) : prefix) = + let context_of_prefix rpc_ctxt (((), block) : prefix) = let open Lwt_result_syntax in - let+ block = Block_directory_helpers.block_of_prefix node_ctxt block in - (Node_context.readonly node_ctxt, block) + let* block = + Block_directory_helpers.block_of_prefix + (Rpc_context.node_ctxt rpc_ctxt) + block + in + Rpc_context.get_pvm_state Read_only rpc_ctxt block end) let get_state (node_ctxt : _ Node_context.t) block_hash = @@ -54,34 +58,30 @@ struct let open Protocol.Alpha_context.Sc_rollup in ( Block_directory.register0 (Sc_rollup_services.Block.durable_state_value Kind.Wasm_2_0_0) - @@ fun (node_ctxt, block) {key} () -> + @@ fun state {key} () -> let open Lwt_result_syntax in - let* state = get_state node_ctxt block in - let*! value = Durable_state.lookup (of_node_pvmstate state) key in + let*! value = Durable_state.lookup !(of_node_pvmstate state) key in return value ) ; ( Block_directory.register0 (Sc_rollup_services.Block.durable_state_length Kind.Wasm_2_0_0) - @@ fun (node_ctxt, block) {key} () -> + @@ fun state {key} () -> let open Lwt_result_syntax in - let* state = get_state node_ctxt block in - let*! leng = Durable_state.value_length (of_node_pvmstate state) key in + let*! leng = Durable_state.value_length !(of_node_pvmstate state) key in return leng ) ; ( Block_directory.register0 (Sc_rollup_services.Block.durable_state_subkeys Kind.Wasm_2_0_0) - @@ fun (node_ctxt, block) {key} () -> + @@ fun state {key} () -> let open Lwt_result_syntax in - let* state = get_state node_ctxt block in - let*! subkeys = Durable_state.list (of_node_pvmstate state) key in + let*! subkeys = Durable_state.list !(of_node_pvmstate state) key in return subkeys ) ; Block_directory.register0 (Sc_rollup_services.Block.durable_state_values Kind.Wasm_2_0_0) - @@ fun (node_ctxt, block) {key} () -> + @@ fun state {key} () -> let open Lwt_result_syntax in - let* state = get_state node_ctxt block in - let tree = of_node_pvmstate state in + let tree = !(of_node_pvmstate state) in let*! subkeys = Durable_state.list tree key in let*! bindings = List.filter_map_s diff --git a/src/riscv/api/octez_riscv_api.ml b/src/riscv/api/octez_riscv_api.ml index 51126bd28f1e2f298efdbc43b5a46c219ed7e531..00ec5e10816cb3d7c1b70c963ec64f408343e954 100644 --- a/src/riscv/api/octez_riscv_api.ml +++ b/src/riscv/api/octez_riscv_api.ml @@ -21,11 +21,13 @@ external octez_riscv_id_unsafe_of_raw_bytes: bytes -> id = "octez_riscv_id_unsaf external octez_riscv_storage_id_to_raw_bytes: id -> bytes = "octez_riscv_storage_id_to_raw_bytes" external octez_riscv_storage_id_equal: id -> id -> bool = "octez_riscv_storage_id_equal" external octez_riscv_storage_state_equal: state -> state -> bool = "octez_riscv_storage_state_equal" +external octez_riscv_storage_mut_state_equal: mut_state -> mut_state -> bool = "octez_riscv_storage_mut_state_equal" external octez_riscv_storage_state_empty: unit -> state = "octez_riscv_storage_state_empty" +external octez_riscv_storage_mut_state_empty: unit -> mut_state = "octez_riscv_storage_mut_state_empty" external octez_riscv_storage_load: string -> repo = "octez_riscv_storage_load" external octez_riscv_storage_close: repo -> unit = "octez_riscv_storage_close" -external octez_riscv_storage_commit: repo -> state -> id = "octez_riscv_storage_commit" -external octez_riscv_storage_checkout: repo -> id -> state option = "octez_riscv_storage_checkout" +external octez_riscv_storage_commit: repo -> mut_state -> id = "octez_riscv_storage_commit" +external octez_riscv_storage_checkout: repo -> id -> mut_state option = "octez_riscv_storage_checkout" external octez_riscv_get_status: state -> status = "octez_riscv_get_status" external octez_riscv_mut_get_status: mut_state -> status = "octez_riscv_mut_get_status" external octez_riscv_string_of_status: status -> string = "octez_riscv_string_of_status" @@ -40,6 +42,7 @@ external octez_riscv_mut_get_tick: mut_state -> int64 = "octez_riscv_mut_get_tic external octez_riscv_get_level: state -> int32 option = "octez_riscv_get_level" external octez_riscv_mut_get_level: mut_state -> int32 option = "octez_riscv_mut_get_level" external octez_riscv_install_boot_sector: state -> bytes -> state = "octez_riscv_install_boot_sector" +external octez_riscv_mut_install_boot_sector: mut_state -> bytes -> unit = "octez_riscv_mut_install_boot_sector" external octez_riscv_state_hash: state -> bytes = "octez_riscv_state_hash" external octez_riscv_mut_state_hash: mut_state -> bytes = "octez_riscv_mut_state_hash" external octez_riscv_set_input: state -> input -> state = "octez_riscv_set_input" diff --git a/src/riscv/api/octez_riscv_api.mli b/src/riscv/api/octez_riscv_api.mli index 51126bd28f1e2f298efdbc43b5a46c219ed7e531..00ec5e10816cb3d7c1b70c963ec64f408343e954 100644 --- a/src/riscv/api/octez_riscv_api.mli +++ b/src/riscv/api/octez_riscv_api.mli @@ -21,11 +21,13 @@ external octez_riscv_id_unsafe_of_raw_bytes: bytes -> id = "octez_riscv_id_unsaf external octez_riscv_storage_id_to_raw_bytes: id -> bytes = "octez_riscv_storage_id_to_raw_bytes" external octez_riscv_storage_id_equal: id -> id -> bool = "octez_riscv_storage_id_equal" external octez_riscv_storage_state_equal: state -> state -> bool = "octez_riscv_storage_state_equal" +external octez_riscv_storage_mut_state_equal: mut_state -> mut_state -> bool = "octez_riscv_storage_mut_state_equal" external octez_riscv_storage_state_empty: unit -> state = "octez_riscv_storage_state_empty" +external octez_riscv_storage_mut_state_empty: unit -> mut_state = "octez_riscv_storage_mut_state_empty" external octez_riscv_storage_load: string -> repo = "octez_riscv_storage_load" external octez_riscv_storage_close: repo -> unit = "octez_riscv_storage_close" -external octez_riscv_storage_commit: repo -> state -> id = "octez_riscv_storage_commit" -external octez_riscv_storage_checkout: repo -> id -> state option = "octez_riscv_storage_checkout" +external octez_riscv_storage_commit: repo -> mut_state -> id = "octez_riscv_storage_commit" +external octez_riscv_storage_checkout: repo -> id -> mut_state option = "octez_riscv_storage_checkout" external octez_riscv_get_status: state -> status = "octez_riscv_get_status" external octez_riscv_mut_get_status: mut_state -> status = "octez_riscv_mut_get_status" external octez_riscv_string_of_status: status -> string = "octez_riscv_string_of_status" @@ -40,6 +42,7 @@ external octez_riscv_mut_get_tick: mut_state -> int64 = "octez_riscv_mut_get_tic external octez_riscv_get_level: state -> int32 option = "octez_riscv_get_level" external octez_riscv_mut_get_level: mut_state -> int32 option = "octez_riscv_mut_get_level" external octez_riscv_install_boot_sector: state -> bytes -> state = "octez_riscv_install_boot_sector" +external octez_riscv_mut_install_boot_sector: mut_state -> bytes -> unit = "octez_riscv_mut_install_boot_sector" external octez_riscv_state_hash: state -> bytes = "octez_riscv_state_hash" external octez_riscv_mut_state_hash: mut_state -> bytes = "octez_riscv_mut_state_hash" external octez_riscv_set_input: state -> input -> state = "octez_riscv_set_input" diff --git a/src/riscv/api/src/lib.rs b/src/riscv/api/src/lib.rs index 5f7827f84d0e7fe5f226cf0f9e92c815a319b50d..867c2adc602dfd15a12cdd0f7a619a6610b07c48 100644 --- a/src/riscv/api/src/lib.rs +++ b/src/riscv/api/src/lib.rs @@ -10,6 +10,7 @@ mod pointer_apply; use core::panic; use std::fs; +use std::ops::DerefMut; use std::str; use arbitrary_int::u31; @@ -292,12 +293,27 @@ pub fn octez_riscv_storage_state_equal(state1: Pointer, state2: Pointer mut_state -> bool")] +pub fn octez_riscv_storage_mut_state_equal( + state1: Pointer, + state2: Pointer, +) -> bool { + state1.apply_ro(|pvm1| state2.apply_ro(|pvm2| pvm1 == pvm2)) +} + #[ocaml::func] #[ocaml::sig("unit -> state")] pub fn octez_riscv_storage_state_empty() -> Pointer { ImmutableState::new(NodePvm::empty()).into() } +#[ocaml::func] +#[ocaml::sig("unit -> mut_state")] +pub fn octez_riscv_storage_mut_state_empty() -> Pointer { + MutableState::Owned(NodePvm::empty()).into() +} + #[ocaml::func] #[ocaml::sig("string -> repo")] pub fn octez_riscv_storage_load(path: String) -> OcamlFallible> { @@ -312,10 +328,10 @@ pub fn octez_riscv_storage_load(path: String) -> OcamlFallible> { pub fn octez_riscv_storage_close(_repo: Pointer) {} #[ocaml::func] -#[ocaml::sig("repo -> state -> id")] +#[ocaml::sig("repo -> mut_state -> id")] pub fn octez_riscv_storage_commit( mut repo: Pointer, - state: Pointer, + state: Pointer, ) -> OcamlFallible> { state.apply_ro(|pvm| match repo.as_mut().0.commit(pvm) { Ok(hash) => Ok(Id(hash).into()), @@ -324,14 +340,14 @@ pub fn octez_riscv_storage_commit( } #[ocaml::func] -#[ocaml::sig("repo -> id -> state option")] +#[ocaml::sig("repo -> id -> mut_state option")] pub fn octez_riscv_storage_checkout( repo: Pointer, id: Pointer, -) -> OcamlFallible>> { +) -> OcamlFallible>> { let id = &id.as_ref().0; match repo.as_ref().0.checkout(id) { - Ok(pvm) => Ok(Some(ImmutableState::new(pvm).into())), + Ok(pvm) => Ok(Some(MutableState::new(pvm).into())), Err(PvmStorageError::StorageError(StorageError::NotFound(_))) => Ok(None), Err(e) => Err(ocaml::Error::Error(Box::new(e))), } @@ -458,32 +474,41 @@ fn read_boot_sector_binary(path: &str, checksum: &str) -> Vec { binary } +// RISC-V kernels are too large to be originated directly. In order to +// temporarily bypass this limitation (TODO: RV-109 Port kernel installer to RISC-V) +// the boot sector is installed by loading it from a path passed at origination +// after checking consistency with the provided checksum. +// "kernel::" +// Any string not matching this format will be treated as an actual kernel to be installed. +fn install_boot_sector(pvm: &mut NodePvm, boot_sector: &[u8]) { + if let Ok(boot_sector) = str::from_utf8(boot_sector) { + let parts: Vec<&str> = boot_sector.split(':').collect(); + if let ["kernel", kernel_path, kernel_checksum] = parts.as_slice() { + let kernel = read_boot_sector_binary(kernel_path, kernel_checksum); + return pvm.install_boot_sector(&kernel); + } else { + return pvm.install_boot_sector(boot_sector.as_bytes()); + } + } + pvm.install_boot_sector(boot_sector); +} + #[ocaml::func] #[ocaml::sig("state -> bytes -> state")] pub fn octez_riscv_install_boot_sector( state: Pointer, boot_sector: &[u8], ) -> Pointer { - // RISC-V kernels are too large to be originated directly. In order to - // temporarily bypass this limitation (TODO: RV-109 Port kernel installer to RISC-V) - // the boot sector is installed by loading it from a path passed at origination - // after checking consistency with the provided checksum. - // "kernel::" - // Any string not matching this format will be treated as an actual kernel to be installed. - let install_kernel = |pvm: &mut NodePvm| { - if let Ok(boot_sector) = str::from_utf8(boot_sector) { - let parts: Vec<&str> = boot_sector.split(':').collect(); - if let ["kernel", kernel_path, kernel_checksum] = parts.as_slice() { - let kernel = read_boot_sector_binary(kernel_path, kernel_checksum); - return pvm.install_boot_sector(&kernel); - } else { - return pvm.install_boot_sector(boot_sector.as_bytes()); - } - } - pvm.install_boot_sector(boot_sector); - }; + apply_imm(state, |pvm| install_boot_sector(pvm, boot_sector)).0 +} - apply_imm(state, install_kernel).0 +#[ocaml::func] +#[ocaml::sig("mut_state -> bytes -> unit")] +pub fn octez_riscv_mut_install_boot_sector( + state: Pointer, + boot_sector: &[u8], +) { + apply_mut(state, |pvm| install_boot_sector(pvm, boot_sector)) } #[ocaml::func] diff --git a/src/riscv/api/src/move_semantics.rs b/src/riscv/api/src/move_semantics.rs index 8d9a876fe0da8866b67a1bfcc9e272ad076fafd4..dff744cb078b1408e20ffa9c2a97266c33226c49 100644 --- a/src/riscv/api/src/move_semantics.rs +++ b/src/riscv/api/src/move_semantics.rs @@ -81,6 +81,10 @@ impl From> for MutableState { } impl MutableState { + pub fn new(state: T) -> Self { + MutableState::Owned(state) + } + /// Create an immutable state from a mutable state #[inline] pub fn to_imm_state(&self) -> ImmutableState