Proto: Show big map diffs with keys as expressions in addtion to hashes

This commit is contained in:
Alain Mebsout 2018-07-05 16:23:20 +02:00 committed by Benjamin Canou
parent 2da9a5331e
commit d73d3fdf2b
6 changed files with 67 additions and 29 deletions

View File

@ -58,16 +58,16 @@ let print_big_map_diff ppf = function
"@[<v 2>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

View File

@ -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 ->

View File

@ -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

View File

@ -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 ->

View File

@ -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 =

View File

@ -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 *)