Michelson: makes command line consistent with Michelson

lib_embedded_client_alpha/client_proto_programs.ml

@@ -83,8 +83,8 @@ let trace
   Client_proto_rpcs.Helpers.trace_code cctxt
     block program.expanded (storage.expanded, input.expanded, amount)
 
-let hash_and_sign (data : Michelson_v1_parser.parsed) key block cctxt =
+let hash_and_sign (data : Michelson_v1_parser.parsed) (typ : Michelson_v1_parser.parsed) key block cctxt =
-  Client_proto_rpcs.Helpers.hash_data cctxt block (data.expanded) >>=? fun hash ->
+  Client_proto_rpcs.Helpers.hash_data cctxt block (data.expanded, typ.expanded) >>=? fun hash ->
   let signature = Ed25519.sign key (MBytes.of_string hash) in
   return (hash,
           signature |>

lib_embedded_client_alpha/client_proto_programs.mli

@@ -46,6 +46,7 @@ val print_run_result :
   unit tzresult Lwt.t
 
 val hash_and_sign :
+  Michelson_v1_parser.parsed ->
   Michelson_v1_parser.parsed ->
   Ed25519.Secret_key.t ->
   Client_proto_rpcs.block ->

lib_embedded_client_alpha/client_proto_programs_commands.ml

@@ -141,10 +141,13 @@ let commands () =
       (prefixes [ "hash" ; "data" ]
        @@ Cli_entries.param ~name:"data" ~desc:"the data to hash"
          data_parameter
+       @@ prefixes [ "of" ; "type" ]
+       @@ Cli_entries.param ~name:"type" ~desc:"the type of the data"
+         data_parameter
        @@ stop)
-      (fun () data cctxt ->
+      (fun () data typ cctxt ->
          Client_proto_rpcs.Helpers.hash_data cctxt
-           cctxt#block (data.expanded) >>= function
+           cctxt#block (data.expanded, typ.expanded) >>= function
          | Ok hash ->
              cctxt#message "%S" hash >>= fun () ->
              return ()
@@ -161,13 +164,16 @@ let commands () =
       (prefixes [ "hash" ; "and" ; "sign" ; "data" ]
        @@ Cli_entries.param ~name:"data" ~desc:"the data to hash"
          data_parameter
+       @@ prefixes [ "of" ; "type" ]
+       @@ Cli_entries.param ~name:"type" ~desc:"the type of the data"
+         data_parameter
        @@ prefixes [ "for" ]
        @@ Client_keys.Secret_key.alias_param
        @@ stop)
-      (fun () data (_, key) cctxt ->
+      (fun () data typ (_, key) cctxt ->
-         Client_proto_programs.hash_and_sign data key cctxt#block cctxt >>= begin function
+         Client_proto_programs.hash_and_sign data typ key cctxt#block cctxt >>= begin function
-           |Ok (hash, signature) ->
+           | Ok (hash, signature) ->
-               cctxt#message "Hash: %S@.Signature: %S" hash signature
+               cctxt#message "@[<v 0>Hash: %S@,Signature: %S@]" hash signature
            | Error errs ->
                cctxt#warning "%a" pp_print_error errs >>= fun () ->
                cctxt#error "ill-formed data"

lib_embedded_client_alpha/client_proto_rpcs.mli

@@ -172,7 +172,7 @@ module Helpers : sig
     block -> Script.expr * Script.expr -> unit tzresult Lwt.t
   val hash_data:
     #Client_rpcs.ctxt ->
-    block -> Script.expr -> string tzresult Lwt.t
+    block -> Script.expr * Script.expr -> string tzresult Lwt.t
   val level:
     #Client_rpcs.ctxt ->
     block -> ?offset:int32 -> Raw_level.t -> Level.t tzresult Lwt.t

lib_embedded_protocol_alpha/src/script_interpreter.ml

@@ -721,7 +721,7 @@ let rec interp
         | H ty, Item (v, rest) ->
             let gas = Gas.consume gas (Gas.Cost_of.hash v) in
             Gas.check gas >>=? fun () ->
-            let hash = Script.hash_expr (Micheline.strip_locations (unparse_data ty v)) in
+            let hash = hash_data ty v in
             logged_return (Item (hash, rest), gas, ctxt)
         | Steps_to_quota, rest ->
             let gas = Gas.consume gas Gas.Cost_of.steps_to_quota in

lib_embedded_protocol_alpha/src/script_ir_translator.ml

@@ -764,6 +764,12 @@ let error_unexpected_annot loc annot =
   | None -> ok ()
   | Some _ -> error (Unexpected_annotation loc)
 
+let rec strip_annotations = function
+  | (Int (_,_) as i) -> i
+  | (String (_,_) as s) -> s
+  | Prim (loc, prim, args, _) -> Prim (loc, prim, List.map strip_annotations args, None)
+  | Seq (loc, items, _) -> Seq (loc, List.map strip_annotations items, None)
+
 let fail_unexpected_annot loc annot =
   Lwt.return (error_unexpected_annot loc annot)
 
@@ -2078,6 +2084,11 @@ let typecheck_data
       (parse_data ?type_logger ctxt exp_ty (root data)) >>=? fun _ ->
     return ()
 
+let hash_data typ data =
+  let unparsed = strip_annotations @@ unparse_data typ data in
+  let bytes = Data_encoding.Binary.to_bytes expr_encoding (Micheline.strip_locations unparsed) in
+  Tezos_hash.Script_expr_hash.(hash_bytes [ bytes ] |> to_b58check)
+
 (* ---- Error registration --------------------------------------------------*)
 
 let ex_ty_enc =

lib_embedded_protocol_alpha/src/script_ir_translator.mli

@@ -118,3 +118,5 @@ val typecheck_data :
 val parse_script :
   ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) ->
   context -> Script.t -> ex_script tzresult Lwt.t
+
+val hash_data : 'a Script_typed_ir.ty -> 'a -> string

lib_embedded_protocol_alpha/src/script_repr.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Tezos_hash
-
 type location = Micheline.canonical_location
 
 let location_encoding = Micheline.canonical_location_encoding
@@ -19,10 +17,6 @@ type node = (location, Michelson_v1_primitives.prim) Micheline.node
 
 let expr_encoding = Micheline.canonical_encoding Michelson_v1_primitives.prim_encoding
 
-let hash_expr data =
-  let bytes = Data_encoding.Binary.to_bytes expr_encoding data in
-  Script_expr_hash.(hash_bytes [ bytes ] |> to_b58check)
-
 type t = { code : expr ; storage : expr }
 
 let encoding =

lib_embedded_protocol_alpha/src/script_repr.mli

@@ -17,8 +17,6 @@ val location_encoding : location Data_encoding.t
 
 val expr_encoding : expr Data_encoding.t
 
-val hash_expr : expr -> string
-
 type t = { code : expr ; storage : expr }
 
 val encoding : t Data_encoding.encoding

lib_embedded_protocol_alpha/src/services.ml

@@ -510,7 +510,8 @@ module Helpers = struct
       ~description: "Computes the hash of some data expression \
                      using the same algorithm as script instruction H"
       ~query: RPC_query.empty
-      ~input: (obj1 (req "data" Script.expr_encoding))
+      ~input: (obj2 (req "data" Script.expr_encoding)
+                 (req "type" Script.expr_encoding))
       ~output: (wrap_tzerror @@
                 obj1 (req "hash" string))
       ~error: Data_encoding.empty

lib_embedded_protocol_alpha/src/services_registration.ml

@@ -321,7 +321,11 @@ let () =
 
 let () =
   register1 Services.Helpers.hash_data
-    (fun _ctxt () expr -> return (Script.hash_expr expr))
+    (fun ctxt () (expr, typ) ->
+       let open Script_ir_translator in
+       Lwt.return @@ parse_ty (Micheline.root typ) >>=? fun (Ex_ty typ, _) ->
+       parse_data ctxt typ (Micheline.root expr) >>=? fun data ->
+       return (Script_ir_translator.hash_data typ data))
 
 let () =
   register2 Services.Helpers.level

lib_embedded_protocol_alpha/src/tezos_context.mli

@@ -243,9 +243,6 @@ module Script : sig
   val expr_encoding: expr Data_encoding.t
   val prim_encoding: prim Data_encoding.t
   val encoding: t Data_encoding.t
-
-  val hash_expr : expr -> string
-
 end
 
 module Bootstrap : sig