diff --git a/src/lib_scoru_wasm/durable.ml b/src/lib_scoru_wasm/durable.ml index d429f7f12312b6a9b00906834be16435eb674602..04ff4b27d0c86906e99064f91edb9622d391f071 100644 --- a/src/lib_scoru_wasm/durable.ml +++ b/src/lib_scoru_wasm/durable.ml @@ -116,6 +116,11 @@ let count_subtrees tree key = let delete tree key = T.remove tree key +let move_tree_exn tree from_key to_key = + let open Lwt.Syntax in + let* tree = copy_tree_exn tree from_key to_key in + delete tree from_key + let hash_exn tree key = let open Lwt.Syntax in let+ opt = T.find_tree tree (to_value_key key) in diff --git a/src/lib_scoru_wasm/durable.mli b/src/lib_scoru_wasm/durable.mli index c746aac299480e44e934aa42ec49357277a6c418..3d3a4d04945304bee0451fa39cd51e9b5cb29606 100644 --- a/src/lib_scoru_wasm/durable.mli +++ b/src/lib_scoru_wasm/durable.mli @@ -68,9 +68,13 @@ val find_value : t -> key -> Lazy_containers.Chunked_byte_vector.t option Lwt.t val find_value_exn : t -> key -> Lazy_containers.Chunked_byte_vector.t Lwt.t (** [copy_tree_exn tree from_key to_key] produces a new tree in which a copy of - the entire subtree at from_key is copied at to_key.*) + the entire subtree at from_key is copied to to_key.*) val copy_tree_exn : t -> key -> key -> t Lwt.t +(** [move_tree_exn tree from_key to_key] produces a new tree in which + the entire subtree at from_key is moved to to_key.*) +val move_tree_exn : t -> key -> key -> t Lwt.t + (** [count_subtrees durable key] returns the number of subtrees under [key]. *) val count_subtrees : t -> key -> int Lwt.t diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml index a4bf310aed9283813faa01a477622c50f2baee1e..be112a384ec67ae8b18755760b833bbcd3bfb44b 100644 --- a/src/lib_scoru_wasm/host_funcs.ml +++ b/src/lib_scoru_wasm/host_funcs.ml @@ -258,21 +258,23 @@ let store_delete_type = let output_types = Vector.of_list [] in Types.FuncType (input_types, output_types) +let store_delete_aux durable memories key_offset key_length = + let open Lwt.Syntax in + let key_length = Int32.to_int key_length in + if key_length > Durable.max_key_length then raise (Key_too_large key_length) ; + let* memory = retrieve_memory memories in + let* key = Memory.load_bytes memory key_offset key_length in + let tree = Durable.of_storage_exn durable in + let key = Durable.key_of_string_exn key in + let+ tree = Durable.delete tree key in + (Durable.to_storage tree, []) + let store_delete = Host_funcs.Host_func (fun _input_buffer _output_buffer durable memories inputs -> - let open Lwt.Syntax in match inputs with | [Values.(Num (I32 key_offset)); Values.(Num (I32 key_length))] -> - let key_length = Int32.to_int key_length in - if key_length > Durable.max_key_length then - raise (Key_too_large key_length) ; - let* memory = retrieve_memory memories in - let* key = Memory.load_bytes memory key_offset key_length in - let tree = Durable.of_storage_exn durable in - let key = Durable.key_of_string_exn key in - let+ tree = Durable.delete tree key in - (Durable.to_storage tree, []) + store_delete_aux durable memories key_offset key_length | _ -> raise Bad_input) let store_list_size_name = "tezos_store_list_size" @@ -348,6 +350,53 @@ let store_copy = to_key_length | _ -> raise Bad_input) +let store_move_name = "tezos_store_move" + +let store_move_type = + let input_types = + Types.[NumType I32Type; NumType I32Type; NumType I32Type; NumType I32Type] + |> Vector.of_list + in + let output_types = Vector.of_list [] in + Types.FuncType (input_types, output_types) + +let store_move_aux durable memories from_key_offset from_key_length + to_key_offset to_key_length = + let open Lwt.Syntax in + let from_key_length = Int32.to_int from_key_length in + let to_key_length = Int32.to_int to_key_length in + if from_key_length > Durable.max_key_length then + raise (Key_too_large from_key_length) ; + if to_key_length > Durable.max_key_length then + raise (Key_too_large to_key_length) ; + let* memory = retrieve_memory memories in + let* from_key = Memory.load_bytes memory from_key_offset from_key_length in + let* to_key = Memory.load_bytes memory to_key_offset to_key_length in + let tree = Durable.of_storage_exn durable in + let from_key = Durable.key_of_string_exn from_key in + let to_key = Durable.key_of_string_exn to_key in + let+ tree = Durable.move_tree_exn tree from_key to_key in + (Durable.to_storage tree, []) + +let store_move = + Host_funcs.Host_func + (fun _input_buffer _output_buffer durable memories inputs -> + match inputs with + | [ + Values.(Num (I32 from_key_offset)); + Values.(Num (I32 from_key_length)); + Values.(Num (I32 to_key_offset)); + Values.(Num (I32 to_key_length)); + ] -> + store_move_aux + durable + memories + from_key_offset + from_key_length + to_key_offset + to_key_length + | _ -> raise Bad_input) + let lookup_opt name = match name with | "read_input" -> @@ -363,6 +412,8 @@ let lookup_opt name = Some (ExternFunc (HostFunc (store_delete_type, store_delete_name))) | "store_copy" -> Some (ExternFunc (HostFunc (store_copy_type, store_copy_name))) + | "store_move" -> + Some (ExternFunc (HostFunc (store_move_type, store_move_name))) | _ -> None let lookup name = @@ -381,6 +432,7 @@ let register_host_funcs registry = (store_list_size_name, store_list_size); (store_delete_name, store_delete); (store_copy_name, store_copy); + (store_move_name, store_move); ] module Internal_for_tests = struct @@ -398,6 +450,8 @@ module Internal_for_tests = struct let store_copy = Func.HostFunc (store_copy_type, store_copy_name) + let store_move = Func.HostFunc (store_move_type, store_move_name) + let store_list_size = Func.HostFunc (store_list_size_type, store_list_size_name) end diff --git a/src/lib_scoru_wasm/host_funcs.mli b/src/lib_scoru_wasm/host_funcs.mli index b5eec35e967924801c0713720ac3e8cfecc2ea00..5f0cd5031bc9e338c840780ab1f5e1f2d8f3cf03 100644 --- a/src/lib_scoru_wasm/host_funcs.mli +++ b/src/lib_scoru_wasm/host_funcs.mli @@ -109,5 +109,7 @@ module Internal_for_tests : sig val store_copy : Tezos_webassembly_interpreter.Instance.func_inst + val store_move : Tezos_webassembly_interpreter.Instance.func_inst + val store_list_size : Tezos_webassembly_interpreter.Instance.func_inst end diff --git a/src/lib_scoru_wasm/test/test_durable_storage.ml b/src/lib_scoru_wasm/test/test_durable_storage.ml index b0abc4f1b14e4ec40fdeaa1271093867f81e3e3b..b641045d7e16ac9fe22ebb7bc0242948eb1235fd 100644 --- a/src/lib_scoru_wasm/test/test_durable_storage.ml +++ b/src/lib_scoru_wasm/test/test_durable_storage.ml @@ -388,6 +388,77 @@ let test_store_copy () = let* () = equal_chunks old_value_from_key new_value_from_key in Lwt.return_ok () +let test_store_move () = + let open Lwt_syntax in + (* + Store the following tree: + /durable/a/short/path/_ = "..." + /durable/a/long/path/_ = "..." + /durable/a/long/path/one/_ = "..." + + We expect that moving "/a/short/path" to "a/long/path" is leaves only + "/durable/a/long/path". + *) + let* durable = + make_durable + [ + ("a/short/path", "a very long value"); + ("a/long/path", "a very long value"); + ("a/long/path/one", "a very long value"); + ] + in + let from_key = "/a/short/path" in + let to_key = "/a/long/path" in + let bad_key = "/a/long/path/one" in + let durable_st = Durable.of_storage_exn durable in + + let* from_tree = + Durable.find_value_exn durable_st @@ Durable.key_of_string_exn from_key + in + let src = 20l in + let module_reg, module_key, host_funcs_registry = + make_module_inst [from_key; to_key; bad_key] src + in + + let from_offset = src in + let from_length = Int32.of_int @@ String.length from_key in + Printf.printf "fl= %li" from_length ; + let to_offset = Int32.(add from_offset from_length) in + let to_length = Int32.of_int @@ String.length to_key in + let values = + Values. + [ + Num (I32 from_offset); + Num (I32 from_length); + Num (I32 to_offset); + Num (I32 to_length); + ] + in + let* durable, result = + Eval.invoke + ~module_reg + ~caller:module_key + ~durable + host_funcs_registry + Host_funcs.Internal_for_tests.store_move + values + in + assert (result = []) ; + let durable = Durable.of_storage_exn durable in + let* empty_from_tree_opt = + Durable.find_value durable @@ Durable.key_of_string_exn from_key + in + let* to_tree = + Durable.find_value_exn durable @@ Durable.key_of_string_exn to_key + in + let* empty_bad_key_tree_opt = + Durable.find_value durable @@ Durable.key_of_string_exn bad_key + in + assert (empty_from_tree_opt = None) ; + assert (empty_bad_key_tree_opt = None) ; + let* () = equal_chunks from_tree to_tree in + Lwt.return_ok () + (* Test invalid key encodings are rejected. *) let test_durable_invalid_keys () = let open Lwt.Syntax in @@ -421,6 +492,7 @@ let tests = tztest "store_list_size counts subtrees" `Quick test_store_list_size; tztest "store_delete removes subtree" `Quick test_store_delete; tztest "store_copy" `Quick test_store_copy; + tztest "store_move" `Quick test_store_move; tztest "Durable: find value" `Quick test_durable_find_value; tztest "Durable: count subtrees" `Quick test_durable_count_subtrees; tztest "Durable: invalid keys" `Quick test_durable_invalid_keys;