balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Michelson: BLAKE2B and CHECK_SIGNATURE now operate on bytes

Browse Source
This commit is contained in:
Benjamin Canou 2018-06-14 17:55:20 +02:00
parent 96f6ef1c78
commit 70f4236d91
17 changed files with 45 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/bin_client/test/contracts/hash_consistency_checker.tz
View File

@ -1,3 +1,3 @@
parameter (pair mutez (pair timestamp int)) ;
storage string ;
storage bytes ;
code { CAR ; BLAKE2B ; NIL operation ; PAIR }

2
src/bin_client/test/contracts/hash_string.tz
View File

@ -1,3 +1,3 @@
parameter string;
storage string;
storage bytes;
code {CAR; BLAKE2B; NIL operation; PAIR};

14
src/bin_client/test/test_contracts.sh
View File

@ -230,8 +230,8 @@ assert_storage $contract_dir/first.tz '111' '{ 4 }' '4'
# Hash input string
# Test assumed to be correct -- hash is based on encoding of AST
assert_storage $contract_dir/hash_string.tz '"?"' '"abcdefg"' '"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF"'
assert_storage $contract_dir/hash_string.tz '"?"' '"12345"' '"expru81QVHsW2qaWLNHnMHSxDNhqtat17ajadri6mKUvXyc2EWHZC3"'
assert_storage $contract_dir/hash_string.tz '0x00' '"abcdefg"' '0xc8e816fa5921f08d25ead933aedc189a7b0abfa97c649a8d2eb9e0f323f7909e'
assert_storage $contract_dir/hash_string.tz '0x00' '"12345"' '0x4fc401c158dad6482d96f45bb2dc10bc445b1ff127a485814d735e5c3dcb36ec'
# Test ASSERT
assert_storage $contract_dir/assert.tz Unit True Unit
@ -315,11 +315,11 @@ assert_storage $contract_dir/map_caddaadr.tz \
# Did the given key sign the string? (key is bootstrap1)
assert_success $client run script $contract_dir/check_signature.tz \
on storage '(Pair 0x1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01 "hello")' \
on storage '(Pair "edsigtursTM9zynxFfyiLyTLuVh369H7Cd1nkH63dyc3jKBoujWeQRE9hZFRhqgTrY3BzdZenDc3D6v7gZEShpdPDMQ7YswgEL3" "hello")' \
and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"'
assert_fails $client run script $contract_dir/check_signature.tz \
on storage '(Pair 0x1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01 "abcd")' \
on storage '(Pair "edsigtursTM9zynxFfyiLyTLuVh369H7Cd1nkH63dyc3jKBoujWeQRE9hZFRhqgTrY3BzdZenDc3D6v7gZEShpdPDMQ7YswgEL3" "abcd")' \
and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"'
@ -449,12 +449,12 @@ assert_fails $client typecheck data '{ "A" ; "B" ; "B" }' against type '(set str
# Test hash consistency between Michelson and the CLI
hash_result=`$client hash data '(Pair 22220000000 (Pair "2017-12-13T04:49:00Z" 034))' \
of type '(pair mutez (pair timestamp int))' | grep expr`
of type '(pair mutez (pair timestamp int))' | grep 0x | sed 's/.*: *//'`
assert_storage $contract_dir/hash_consistency_checker.tz '"?"' \
assert_storage $contract_dir/hash_consistency_checker.tz '0x00' \
'(Pair 22220000000 (Pair "2017-12-13T04:49:00Z" 034))' "$hash_result"
assert_storage $contract_dir/hash_consistency_checker.tz '"?"' \
assert_storage $contract_dir/hash_consistency_checker.tz '0x00' \
'(Pair 22220000000 (Pair "2017-12-13T04:49:00+00:00" 34))' "$hash_result"
# Test for big maps

8
src/proto_alpha/lib_client/client_proto_programs.ml
View File

@ -43,11 +43,11 @@ let print_big_map_diff ppf = function
(Format.pp_print_list
~pp_sep:Format.pp_print_space
(fun ppf (key, value) ->
Format.fprintf ppf "%s %s%a"
Format.fprintf ppf "%s %a%a"
(match value with
| None -> "-"
| Some _ -> "+")
key
Script_expr_hash.pp key
(fun ppf -> function
| None -> ()
| Some x -> Format.fprintf ppf "-> %a" print_expr x)
@ -125,8 +125,8 @@ let hash_and_sign
sk =
Alpha_services.Helpers.Scripts.hash_data
cctxt (chain, block) (data.expanded, typ.expanded, gas) >>=? fun (hash, gas) ->
Client_keys.sign cctxt sk (MBytes.of_string hash) >>=? fun signature ->
return (hash, Signature.to_b58check signature, gas)
Client_keys.sign cctxt sk (Script_expr_hash.to_bytes hash) >>=? fun signature ->
return (hash, signature, gas)
let typecheck_data
cctxt

2
src/proto_alpha/lib_client/client_proto_programs.mli
View File

@ -69,7 +69,7 @@ val hash_and_sign :
Michelson_v1_parser.parsed ->
Michelson_v1_parser.parsed ->
Client_keys.sk_uri ->
(string * string * Gas.t) tzresult Lwt.t
(Script_expr_hash.t * Signature.t * Gas.t) tzresult Lwt.t
val typecheck_data :
#Proto_alpha.rpc_context ->

10
src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml
View File

@ -205,7 +205,9 @@ let commands () =
Alpha_services.Helpers.Scripts.hash_data cctxt (`Main, cctxt#block)
(data.expanded, typ.expanded, Some original_gas) >>= function
| Ok (hash, remaining_gas) ->
cctxt#message "%S@,Gas remaining: %a" hash
cctxt#message "Hash: %a@,Raw hash bytes: 0x%a@,Gas remaining: %a"
Script_expr_hash.pp hash
MBytes.pp_hex (Script_expr_hash.to_bytes hash)
Proto_alpha.Alpha_context.Gas.pp remaining_gas >>= fun () ->
return ()
| Error errs ->
@ -238,8 +240,10 @@ let commands () =
Client_proto_programs.hash_and_sign cctxt cctxt#block
~gas data typ sk >>= begin function
| Ok (hash, signature, current_gas) ->
cctxt#message "@[<v 0>Hash: %S@,Signature: %S@,Remaining gas: %a@]"
hash signature
cctxt#message "@[<v 0>Hash: %a@,Raw hash bytes: 0x%a@,Signature: %a@,Remaining gas: %a@]"
Script_expr_hash.pp hash
MBytes.pp_hex (Script_expr_hash.to_bytes hash)
Signature.pp signature
Proto_alpha.Alpha_context.Gas.pp current_gas
| Error errs ->
cctxt#warning "%a"

6
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -540,7 +540,7 @@ 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 = (string * Script.expr option) list
type big_map_diff = (Script_expr_hash.t * Script.expr option) list
val originate:
context -> contract ->
@ -585,9 +585,9 @@ module Contract : sig
module Big_map : sig
val mem:
context -> contract -> string -> (context * bool) tzresult Lwt.t
context -> contract -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t
val get_opt:
context -> contract -> string -> (context * Script_repr.expr option) tzresult Lwt.t
context -> contract -> Script_expr_hash.t -> (context * Script_repr.expr option) tzresult Lwt.t
end
(**/**)

2
src/proto_alpha/lib_protocol/src/contract_storage.ml
View File

@ -186,7 +186,7 @@ let () =
let failwith msg = fail (Failure msg)
type big_map_diff = (string * Script_repr.expr option) list
type big_map_diff = (Script_expr_hash.t * Script_repr.expr option) list
let update_script_big_map c contract = function
| None -> return (c, Z.zero)

6
src/proto_alpha/lib_protocol/src/contract_storage.mli
View File

@ -60,7 +60,7 @@ 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 = (string * Script_repr.expr option) list
type big_map_diff = (Script_expr_hash.t * Script_repr.expr option) list
val update_script_storage:
Raw_context.t -> Contract_repr.t ->
@ -108,7 +108,7 @@ val pay_for_storage_space: Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw
module Big_map : sig
val mem :
Raw_context.t -> Contract_repr.t -> string -> (Raw_context.t * bool) tzresult Lwt.t
Raw_context.t -> Contract_repr.t -> Script_expr_hash.t -> (Raw_context.t * bool) tzresult Lwt.t
val get_opt :
Raw_context.t -> Contract_repr.t -> string -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
Raw_context.t -> Contract_repr.t -> Script_expr_hash.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
end

10
src/proto_alpha/lib_protocol/src/helpers_services.ml
View File

@ -60,7 +60,9 @@ module Scripts = struct
~output: (obj3
(req "storage" Script.expr_encoding)
(req "operations" (list Operation.internal_operation_encoding))
(opt "big_map_diff" (list (tup2 string (option Script.expr_encoding)))))
(opt "big_map_diff" (list (tup2
Script_expr_hash.encoding
(option Script.expr_encoding)))))
RPC_path.(path / "run_code")
let trace_code =
@ -81,7 +83,9 @@ module Scripts = struct
(obj2
(req "item" (Script.expr_encoding))
(opt "annot" string))))))
(opt "big_map_diff" (list (tup2 string (option Script.expr_encoding)))))
(opt "big_map_diff" (list (tup2
Script_expr_hash.encoding
(option Script.expr_encoding)))))
RPC_path.(path / "trace_code")
let typecheck_code =
@ -118,7 +122,7 @@ module Scripts = struct
(req "type" Script.expr_encoding)
(opt "gas" z))
~output: (obj2
(req "hash" string)
(req "hash" Script_expr_hash.encoding)
(req "gas" Gas.encoding))
~query: RPC_query.empty
RPC_path.(path / "hash_data")

2
src/proto_alpha/lib_protocol/src/helpers_services.mli
View File

@ -50,7 +50,7 @@ module Scripts : sig
val hash_data:
'a #RPC_context.simple ->
'a -> Script.expr * Script.expr * Z.t option -> (string * Gas.t) shell_tzresult Lwt.t
'a -> Script.expr * Script.expr * Z.t option -> (Script_expr_hash.t * Gas.t) shell_tzresult Lwt.t
val run_operation:
'a #RPC_context.simple ->

2
src/proto_alpha/lib_protocol/src/script_interpreter.ml
View File

@ -678,7 +678,6 @@ let rec interp
logged_return (Item (now, rest), ctxt)
| Check_signature, Item (key, Item (signature, Item (message, rest))) ->
Lwt.return (Gas.consume ctxt Interp_costs.check_signature) >>=? fun ctxt ->
let message = MBytes.of_string message in
let res = Signature.check key signature message in
logged_return (Item (res, rest), ctxt)
| Hash_key, Item (key, rest) ->
@ -687,6 +686,7 @@ let rec interp
| Blake2b ty, Item (v, rest) ->
Lwt.return (Gas.consume ctxt (Interp_costs.hash v)) >>=? fun ctxt ->
hash_data ctxt ty v >>=? fun (hash, ctxt) ->
let hash = Script_expr_hash.to_bytes hash in
logged_return (Item (hash, rest), ctxt)
| Steps_to_quota, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.steps_to_quota) >>=? fun ctxt ->

6
src/proto_alpha/lib_protocol/src/script_ir_translator.ml
View File

@ -2341,7 +2341,7 @@ and parse_instr
typed ctxt loc Hash_key
(Item_t (Key_hash_t None, rest, annot))
| Prim (loc, I_CHECK_SIGNATURE, [], annot),
Item_t (Key_t _, Item_t (Signature_t _, Item_t (String_t _, rest, _), _), _) ->
Item_t (Key_t _, Item_t (Signature_t _, Item_t (Bytes_t _, rest, _), _), _) ->
parse_var_annot loc annot >>=? fun annot ->
typed ctxt loc Check_signature
(Item_t (Bool_t None, rest, annot))
@ -2349,7 +2349,7 @@ and parse_instr
Item_t (t, rest, _) ->
parse_var_annot loc annot >>=? fun annot ->
typed ctxt loc (Blake2b t)
(Item_t (String_t None, rest, annot))
(Item_t (Bytes_t None, rest, annot))
| Prim (loc, I_STEPS_TO_QUOTA, [], annot),
stack ->
parse_var_annot loc annot ~default:default_steps_annot >>=? fun annot ->
@ -2806,7 +2806,7 @@ let hash_data ctxt typ data =
unparse_data ctxt Optimized typ data >>=? fun (data, ctxt) ->
let unparsed = strip_annotations @@ data in
let bytes = Data_encoding.Binary.to_bytes_exn expr_encoding (Micheline.strip_locations unparsed) in
return (Script_expr_hash.(hash_bytes [ bytes ] |> to_b58check), ctxt)
return (Script_expr_hash.(hash_bytes [ bytes ]), ctxt)
(* ---------------- Big map -------------------------------------------------*)

2
src/proto_alpha/lib_protocol/src/script_ir_translator.mli
View File

@ -95,7 +95,7 @@ val parse_contract :
context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->
(context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t
val hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (string * context) tzresult Lwt.t
val hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (Script_expr_hash.t * context) tzresult Lwt.t
val extract_big_map :
'a Script_typed_ir.ty -> 'a -> Script_typed_ir.ex_big_map option

4
src/proto_alpha/lib_protocol/src/script_typed_ir.ml
View File

@ -336,11 +336,11 @@ and ('bef, 'aft) instr =
| Balance :
('rest, Tez.t * 'rest) instr
| Check_signature :
(public_key * (signature * (string * 'rest)), bool * 'rest) instr
(public_key * (signature * (MBytes.t * 'rest)), bool * 'rest) instr
| Hash_key :
(public_key * 'rest, public_key_hash * 'rest) instr
| Blake2b : 'a ty ->
('a * 'rest, string * 'rest) instr
('a * 'rest, MBytes.t * 'rest) instr
| Steps_to_quota : (* TODO: check that it always returns a nat *)
('rest, n num * 'rest) instr
| Source :

17
src/proto_alpha/lib_protocol/src/storage.ml
View File

@ -41,21 +41,6 @@ module Int_index = struct
}
end
module String_index = struct
type t = string
let path_length = 1
let to_path c l = c :: l
let of_path = function
| [ c ] -> Some c
| [] | _ :: _ :: _ -> None
type 'a ipath = 'a * t
let args = Storage_description.One {
rpc_arg = RPC_arg.string ;
encoding = Data_encoding.string ;
compare = Compare.String.compare ;
}
end
module Make_index(H : Storage_description.INDEX)
: INDEX with type t = H.t and type 'a ipath = 'a * H.t = struct
include H
@ -183,7 +168,7 @@ module Contract = struct
(Make_subcontext
(Indexed_context.Raw_context)
(struct let name = ["big_map"] end))
(String_index)
(Make_index(Script_expr_hash))
(struct
type t = Script_repr.expr
let encoding = Script_repr.expr_encoding

2
src/proto_alpha/lib_protocol/src/storage.mli
View File

@ -188,7 +188,7 @@ module Contract : sig
type bigmap_key = Raw_context.t * Contract_repr.t
module Big_map : Non_iterable_indexed_carbonated_data_storage
with type key = string
with type key = Script_expr_hash.t
and type value = Script_repr.expr
and type t := bigmap_key