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

src/proto_alpha/lib_client/client_proto_programs.ml

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

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

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) ->
+      fold_left_s (fun (c, total) diff_item ->
-          match value with
+          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
 

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

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
+                    (opt "big_map_diff" Contract.big_map_diff_encoding))
-                                                 Script_expr_hash.encoding
-                                                 (option Script.expr_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"
+                    (req "trace" trace_encoding)
-                       (list @@ obj3
+                    (opt "big_map_diff" Contract.big_map_diff_encoding))
-                          (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)))))
         RPC_path.(path / "trace_code")
 
     let typecheck_code =

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) ->
+       end >>=? fun (diff_value, ctxt) ->
-       return ((hash, value) :: acc, 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 *)