diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index 930b43913..f0f8f16a1 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -58,16 +58,16 @@ let print_big_map_diff ppf = function "@[map diff:@,%a@]@," (Format.pp_print_list ~pp_sep:Format.pp_print_space - (fun ppf (key, value) -> + (fun ppf Contract.{ diff_key ; diff_value ; _ } -> Format.fprintf ppf "%s %a%a" - (match value with + (match diff_value with | None -> "-" | Some _ -> "+") - Script_expr_hash.pp key + print_expr diff_key (fun ppf -> function | None -> () | Some x -> Format.fprintf ppf "-> %a" print_expr x) - value)) + diff_value)) diff let print_run_result (cctxt : #Client_context.printer) ~show_source ~parsed = function diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 00e6f50bf..b283aadbb 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -574,7 +574,13 @@ module Contract : sig val fresh_contract_from_current_nonce : context -> (context * t) tzresult Lwt.t val originated_from_current_nonce: since: context -> until:context -> contract list tzresult Lwt.t - type big_map_diff = (Script_expr_hash.t * Script.expr option) list + type big_map_diff_item = { + diff_key : Script_repr.expr; + diff_key_hash : Script_expr_hash.t; + diff_value : Script_repr.expr option; + } + type big_map_diff = big_map_diff_item list + val big_map_diff_encoding : big_map_diff Data_encoding.t val originate: context -> contract -> diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.ml b/src/proto_alpha/lib_protocol/src/contract_storage.ml index 45b1c0661..64b672004 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/src/contract_storage.ml @@ -202,18 +202,40 @@ let () = let failwith msg = fail (Failure msg) -type big_map_diff = (Script_expr_hash.t * Script_repr.expr option) list +type big_map_diff_item = { + diff_key : Script_repr.expr; + diff_key_hash : Script_expr_hash.t; + diff_value : Script_repr.expr option; +} +type big_map_diff = big_map_diff_item list + +let big_map_diff_item_encoding = + let open Data_encoding in + conv + (fun { diff_key_hash ; diff_key ; diff_value } -> (diff_key_hash, diff_key, diff_value)) + (fun (diff_key_hash, diff_key, diff_value) -> { diff_key_hash ; diff_key ; diff_value }) + (obj3 + (req "key_hash" Script_expr_hash.encoding) + (req "key" Script_repr.expr_encoding) + (opt "value" Script_repr.expr_encoding)) + +let big_map_diff_encoding = + let open Data_encoding in + def "contract.big_map_diff" @@ + list big_map_diff_item_encoding let update_script_big_map c contract = function | None -> return (c, Z.zero) | Some diff -> - fold_left_s (fun (c, total) (key, value) -> - match value with + fold_left_s (fun (c, total) diff_item -> + match diff_item.diff_value with | None -> - Storage.Contract.Big_map.remove (c, contract) key >>=? fun (c, freed) -> + Storage.Contract.Big_map.remove (c, contract) diff_item.diff_key_hash + >>=? fun (c, freed) -> return (c, Z.sub total (Z.of_int freed)) | Some v -> - Storage.Contract.Big_map.init_set (c, contract) key v >>=? fun (c, size_diff) -> + Storage.Contract.Big_map.init_set (c, contract) diff_item.diff_key_hash v + >>=? fun (c, size_diff) -> return (c, Z.add total (Z.of_int size_diff))) (c, Z.zero) diff diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.mli b/src/proto_alpha/lib_protocol/src/contract_storage.mli index 8f2c92a9d..00ab16462 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.mli +++ b/src/proto_alpha/lib_protocol/src/contract_storage.mli @@ -77,7 +77,15 @@ val get_script: val get_storage: Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t -type big_map_diff = (Script_expr_hash.t * Script_repr.expr option) list + +type big_map_diff_item = { + diff_key : Script_repr.expr; + diff_key_hash : Script_expr_hash.t; + diff_value : Script_repr.expr option; +} +type big_map_diff = big_map_diff_item list + +val big_map_diff_encoding : big_map_diff Data_encoding.t val update_script_storage: Raw_context.t -> Contract_repr.t -> diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index da6189ec4..e78a590b2 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -65,6 +65,17 @@ module Scripts = struct (req "input" Script.expr_encoding) (req "amount" Tez.encoding)) + let trace_encoding = + def "scripted.trace" @@ + (list @@ obj3 + (req "location" Script.location_encoding) + (req "gas" Gas.encoding) + (req "stack" + (list + (obj2 + (req "item" (Script.expr_encoding)) + (opt "annot" string))))) + let run_code = RPC_service.post_service ~description: "Run a piece of code in the current context" @@ -73,9 +84,7 @@ module Scripts = struct ~output: (obj3 (req "storage" Script.expr_encoding) (req "operations" (list Operation.internal_operation_encoding)) - (opt "big_map_diff" (list (tup2 - Script_expr_hash.encoding - (option Script.expr_encoding))))) + (opt "big_map_diff" Contract.big_map_diff_encoding)) RPC_path.(path / "run_code") let trace_code = @@ -87,18 +96,8 @@ module Scripts = struct ~output: (obj4 (req "storage" Script.expr_encoding) (req "operations" (list Operation.internal_operation_encoding)) - (req "trace" - (list @@ obj3 - (req "location" Script.location_encoding) - (req "gas" Gas.encoding) - (req "stack" - (list - (obj2 - (req "item" (Script.expr_encoding)) - (opt "annot" string)))))) - (opt "big_map_diff" (list (tup2 - Script_expr_hash.encoding - (option Script.expr_encoding))))) + (req "trace" trace_encoding) + (opt "big_map_diff" Contract.big_map_diff_encoding)) RPC_path.(path / "trace_code") let typecheck_code = diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index 696545cb5..043dc01a0 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -3137,7 +3137,9 @@ let diff_of_big_map ctxt mode (Ex_bm { key_type ; value_type ; diff }) = fold_left_s (fun (acc, ctxt) (key, value) -> Lwt.return (Gas.consume ctxt Typecheck_costs.cycle) >>=? fun ctxt -> - hash_data ctxt key_type key >>=? fun (hash, ctxt) -> + hash_data ctxt key_type key >>=? fun (diff_key_hash, ctxt) -> + unparse_data ctxt mode key_type key >>=? fun (key_node, ctxt) -> + let diff_key = Micheline.strip_locations key_node in begin match value with | None -> return (None, ctxt) @@ -3146,8 +3148,9 @@ let diff_of_big_map ctxt mode (Ex_bm { key_type ; value_type ; diff }) = unparse_data ctxt mode value_type x >>=? fun (node, ctxt) -> return (Some (Micheline.strip_locations node), ctxt) end - end >>=? fun (value, ctxt) -> - return ((hash, value) :: acc, ctxt)) + end >>=? fun (diff_value, ctxt) -> + let diff_item = Contract.{ diff_key ; diff_key_hash ; diff_value } in + return (diff_item :: acc, ctxt)) ([], ctxt) pairs (* Get the big map from a contract's storage if one exists *)