diff --git a/lib_embedded_client_alpha/client_proto_programs.ml b/lib_embedded_client_alpha/client_proto_programs.ml index 459f1cf14..d407b4473 100644 --- a/lib_embedded_client_alpha/client_proto_programs.ml +++ b/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 = - Client_proto_rpcs.Helpers.hash_data cctxt block (data.expanded) >>=? fun hash -> +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, typ.expanded) >>=? fun hash -> let signature = Ed25519.sign key (MBytes.of_string hash) in return (hash, signature |> diff --git a/lib_embedded_client_alpha/client_proto_programs.mli b/lib_embedded_client_alpha/client_proto_programs.mli index 7fcc5551d..14e531329 100644 --- a/lib_embedded_client_alpha/client_proto_programs.mli +++ b/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 -> diff --git a/lib_embedded_client_alpha/client_proto_programs_commands.ml b/lib_embedded_client_alpha/client_proto_programs_commands.ml index 68d17f0e6..a7ffbb383 100644 --- a/lib_embedded_client_alpha/client_proto_programs_commands.ml +++ b/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 -> - Client_proto_programs.hash_and_sign data key cctxt#block cctxt >>= begin function - |Ok (hash, signature) -> - cctxt#message "Hash: %S@.Signature: %S" hash signature + (fun () data typ (_, key) cctxt -> + Client_proto_programs.hash_and_sign data typ key cctxt#block cctxt >>= begin function + | Ok (hash, signature) -> + cctxt#message "@[Hash: %S@,Signature: %S@]" hash signature | Error errs -> cctxt#warning "%a" pp_print_error errs >>= fun () -> cctxt#error "ill-formed data" diff --git a/lib_embedded_client_alpha/client_proto_rpcs.mli b/lib_embedded_client_alpha/client_proto_rpcs.mli index 95d3840d6..7fc5edfa2 100644 --- a/lib_embedded_client_alpha/client_proto_rpcs.mli +++ b/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 diff --git a/lib_embedded_protocol_alpha/src/script_interpreter.ml b/lib_embedded_protocol_alpha/src/script_interpreter.ml index 05260e6ab..0fd9c2d99 100644 --- a/lib_embedded_protocol_alpha/src/script_interpreter.ml +++ b/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 diff --git a/lib_embedded_protocol_alpha/src/script_ir_translator.ml b/lib_embedded_protocol_alpha/src/script_ir_translator.ml index 9c8d134fe..1d39dbe51 100644 --- a/lib_embedded_protocol_alpha/src/script_ir_translator.ml +++ b/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 = diff --git a/lib_embedded_protocol_alpha/src/script_ir_translator.mli b/lib_embedded_protocol_alpha/src/script_ir_translator.mli index 7e4f1b768..1ed0e0fd9 100644 --- a/lib_embedded_protocol_alpha/src/script_ir_translator.mli +++ b/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 diff --git a/lib_embedded_protocol_alpha/src/script_repr.ml b/lib_embedded_protocol_alpha/src/script_repr.ml index 784ae044f..30452e152 100644 --- a/lib_embedded_protocol_alpha/src/script_repr.ml +++ b/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 = diff --git a/lib_embedded_protocol_alpha/src/script_repr.mli b/lib_embedded_protocol_alpha/src/script_repr.mli index 1701fabd1..5dec60498 100644 --- a/lib_embedded_protocol_alpha/src/script_repr.mli +++ b/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 diff --git a/lib_embedded_protocol_alpha/src/services.ml b/lib_embedded_protocol_alpha/src/services.ml index ec685b80c..4c98ba7c3 100644 --- a/lib_embedded_protocol_alpha/src/services.ml +++ b/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 diff --git a/lib_embedded_protocol_alpha/src/services_registration.ml b/lib_embedded_protocol_alpha/src/services_registration.ml index 85de5b0a8..2cb325e4d 100644 --- a/lib_embedded_protocol_alpha/src/services_registration.ml +++ b/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 diff --git a/lib_embedded_protocol_alpha/src/tezos_context.mli b/lib_embedded_protocol_alpha/src/tezos_context.mli index b9c35c1ee..b13814e92 100644 --- a/lib_embedded_protocol_alpha/src/tezos_context.mli +++ b/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