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

Michelson: use new Micheline Bytes case for optimized representation

Browse Source
This commit is contained in:
Benjamin Canou 2018-06-14 13:53:52 +02:00
parent 0279f86e77
commit 45d8fd11ae
5 changed files with 31 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -314,13 +314,13 @@ assert_storage $contract_dir/map_caddaadr.tz \
'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 1000000) 4) 5))) 6)' '(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 1000000) 4) 5))) 6)'
# Did the given key sign the string? (key is bootstrap1) # Did the given key sign the string? (key is bootstrap1)
#assert_success $client run script $contract_dir/check_signature.tz \ assert_success $client run script $contract_dir/check_signature.tz \
# on storage '(Pair 0x011eb640b67c1859228a72730fae1a006bb94a999395dfb569e2776e9c1ae546376247f001343a1042f92082690f6aa#2e6ed230df319b09767d9807ef3f8191f "hello")' \ on storage '(Pair 0x1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01 "hello")' \
# and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"'
#assert_fails $client run script $contract_dir/check_signature.tz \ assert_fails $client run script $contract_dir/check_signature.tz \
# on storage '(Pair 0x011eb640b67c1859228a72730fae1a006bb94a999395dfb569e2776e9c1ae546376247f001343a1042f92082690f6aa2e#6ed230df319b09767d9807ef3f8191f "abcd")' \ on storage '(Pair 0x1f19f8f37e80d96797b019f30d23ede6a26a0f698220f942103a3401f047623746e51a9c6e77e269b5df9593994ab96b001aae0f73728a2259187cb640b61e01 "abcd")' \
# and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"'
# Convert a public key to a public key hash # Convert a public key to a public key hash

1
src/lib_micheline/micheline.ml
View File

@ -180,6 +180,7 @@ let canonical_encoding ~variant prim_encoding =
~json:(union ~tag_size:`Uint8 ~json:(union ~tag_size:`Uint8
[ int_encoding Json_only; [ int_encoding Json_only;
string_encoding Json_only ; string_encoding Json_only ;
bytes_encoding Json_only ;
seq_encoding Json_only expr_encoding ; seq_encoding Json_only expr_encoding ;
application_encoding Json_only expr_encoding ]) application_encoding Json_only expr_encoding ])
~binary:(union ~tag_size:`Uint8 ~binary:(union ~tag_size:`Uint8

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

@ -224,9 +224,9 @@ module Cost_of = struct
let primitive_type = alloc_cost 1 let primitive_type = alloc_cost 1
let one_arg_type = alloc_cost 2 let one_arg_type = alloc_cost 2
let two_arg_type = alloc_cost 3 let two_arg_type = alloc_cost 3
let operation s = let operation b =
(* TODO: proper handling of (de)serialization costs *) (* TODO: proper handling of (de)serialization costs *)
let len = String.length s in let len = MBytes.length b in
alloc_cost len +@ step_cost (len * 10) alloc_cost len +@ step_cost (len * 10)
end end

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

@ -128,7 +128,7 @@ module Cost_of : sig
val one_arg_type : Gas.cost val one_arg_type : Gas.cost
val two_arg_type : Gas.cost val two_arg_type : Gas.cost
val operation : string -> Gas.cost val operation : MBytes.t -> Gas.cost
end end
module Unparse : sig module Unparse : sig

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

@ -1058,21 +1058,6 @@ let rec unparse_stack
type ex_script = Ex_script : ('a, 'c) script -> ex_script type ex_script = Ex_script : ('a, 'c) script -> ex_script
let public_key_hash_size =
match Data_encoding.Binary.fixed_length Signature.Public_key_hash.encoding with
| None -> assert false
| Some size -> size
let signature_size =
match Data_encoding.Binary.fixed_length Signature.encoding with
| None -> assert false
| Some size -> size
let address_size =
match Data_encoding.Binary.fixed_length Contract.encoding with
| None -> assert false
| Some size -> size
(* Lwt versions *) (* Lwt versions *)
let parse_var_annot loc ?default annot = let parse_var_annot loc ?default annot =
Lwt.return (parse_var_annot loc ?default annot) Lwt.return (parse_var_annot loc ?default annot)
@ -1122,14 +1107,6 @@ let rec parse_data
fail (error ())) fail (error ()))
(None, empty_map key_type, ctxt) items |> traced >>|? fun (_, items, ctxt) -> (None, empty_map key_type, ctxt) items |> traced >>|? fun (_, items, ctxt) ->
(items, ctxt) in (items, ctxt) in
let bytes_of_padded_z z =
let bytes = Z.to_bits z in
let len = MBytes.length bytes in
if Compare.Int.(MBytes.length bytes = 0)
|| Compare.Char.(MBytes.get_char bytes (MBytes.length bytes - 1) <> '\xFF') then
fail (error ())
else
return (MBytes.sub bytes 0 (len - 1)) in
match ty, script_data with match ty, script_data with
(* Unit *) (* Unit *)
| Unit_t ty_name, Prim (loc, D_Unit, [], annot) -> | Unit_t ty_name, Prim (loc, D_Unit, [], annot) ->
@ -1190,7 +1167,7 @@ let rec parse_data
fail @@ error () fail @@ error ()
end end
| Mutez_t _, expr -> | Mutez_t _, expr ->
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))
(* Timestamps *) (* Timestamps *)
| Timestamp_t _, (Int (_, v)) (* As unparsed with [Optimized] or out of bounds [Readable]. *) -> | Timestamp_t _, (Int (_, v)) (* As unparsed with [Optimized] or out of bounds [Readable]. *) ->
return (Script_timestamp.of_zint v, ctxt) return (Script_timestamp.of_zint v, ctxt)
@ -1205,9 +1182,8 @@ let rec parse_data
| Timestamp_t _, expr -> | Timestamp_t _, expr ->
traced (fail (Invalid_kind (location expr, [ String_kind ; Int_kind ], kind expr))) traced (fail (Invalid_kind (location expr, [ String_kind ; Int_kind ], kind expr)))
(* IDs *) (* IDs *)
| Key_t _, Int (_, z) -> (* As unparsed with [Optimized]. *) | Key_t _, Bytes (_, bytes) -> (* As unparsed with [Optimized]. *)
Lwt.return (Gas.consume ctxt Typecheck_costs.key) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Typecheck_costs.key) >>=? fun ctxt ->
bytes_of_padded_z z >>=? fun bytes ->
begin match Data_encoding.Binary.of_bytes Signature.Public_key.encoding bytes with begin match Data_encoding.Binary.of_bytes Signature.Public_key.encoding bytes with
| Some k -> return (k, ctxt) | Some k -> return (k, ctxt)
| None -> fail (error ()) | None -> fail (error ())
@ -1220,11 +1196,10 @@ let rec parse_data
with _ -> fail (error ()) with _ -> fail (error ())
end end
| Key_t _, expr -> | Key_t _, expr ->
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))
| Key_hash_t _, Int (_, z) -> (* As unparsed with [Optimized]. *) | Key_hash_t _, Bytes (_, bytes) -> (* As unparsed with [Optimized]. *)
Lwt.return (Gas.consume ctxt Typecheck_costs.key_hash) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Typecheck_costs.key_hash) >>=? fun ctxt ->
begin begin
let bytes = Z.to_bits ~pad_to:public_key_hash_size z in
match Data_encoding.Binary.of_bytes Signature.Public_key_hash.encoding bytes with match Data_encoding.Binary.of_bytes Signature.Public_key_hash.encoding bytes with
| Some k -> return (k, ctxt) | Some k -> return (k, ctxt)
| None -> fail (error ()) | None -> fail (error ())
@ -1237,12 +1212,11 @@ let rec parse_data
with _ -> fail (error ()) with _ -> fail (error ())
end end
| Key_hash_t _, expr -> | Key_hash_t _, expr ->
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))
(* Signatures *) (* Signatures *)
| Signature_t _, Int (_, z) (* As unparsed with [Optimized]. *) -> | Signature_t _, Bytes (_, bytes) (* As unparsed with [Optimized]. *) ->
Lwt.return (Gas.consume ctxt Typecheck_costs.signature) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Typecheck_costs.signature) >>=? fun ctxt ->
begin begin
let bytes = Z.to_bits ~pad_to:signature_size z in
match Data_encoding.Binary.of_bytes Signature.encoding bytes with match Data_encoding.Binary.of_bytes Signature.encoding bytes with
| Some k -> return (k, ctxt) | Some k -> return (k, ctxt)
| None -> fail (error ()) | None -> fail (error ())
@ -1255,25 +1229,24 @@ let rec parse_data
with _ -> fail (error ()) with _ -> fail (error ())
end end
| Signature_t _, expr -> | Signature_t _, expr ->
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))
(* Operations *) (* Operations *)
| Operation_t _, String (_, s) -> begin try | Operation_t _, Bytes (_, bytes) -> begin try
Lwt.return (Gas.consume ctxt (Typecheck_costs.operation s)) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt (Typecheck_costs.operation bytes)) >>=? fun ctxt ->
match Data_encoding.Binary.of_bytes match Data_encoding.Binary.of_bytes
Operation.internal_operation_encoding Operation.internal_operation_encoding
(MBytes.of_hex (`Hex s)) with bytes with
| Some op -> return (op, ctxt) | Some op -> return (op, ctxt)
| None -> raise Not_found | None -> raise Not_found
with _ -> with _ ->
fail (error ()) fail (error ())
end end
| Operation_t _, expr -> | Operation_t _, expr ->
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) traced (fail (Invalid_kind (location expr, [ Bytes_kind ], kind expr)))
(* Addresses *) (* Addresses *)
| Address_t _, Int (_, z) (* As unparsed with [O[ptimized]. *) -> | Address_t _, Bytes (_, bytes) (* As unparsed with [O[ptimized]. *) ->
Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt ->
begin begin
let bytes = Z.to_bits ~pad_to:address_size z in
match Data_encoding.Binary.of_bytes Contract.encoding bytes with match Data_encoding.Binary.of_bytes Contract.encoding bytes with
| Some c -> return (c, ctxt) | Some c -> return (c, ctxt)
| None -> fail (error ()) | None -> fail (error ())
@ -1283,12 +1256,11 @@ let rec parse_data
traced (Lwt.return (Contract.of_b58check s)) >>=? fun c -> traced (Lwt.return (Contract.of_b58check s)) >>=? fun c ->
return (c, ctxt) return (c, ctxt)
| Address_t _, expr -> | Address_t _, expr ->
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))
(* Contracts *) (* Contracts *)
| Contract_t (ty, _), Int (loc, z) (* As unparsed with [Optimized]. *) -> | Contract_t (ty, _), Bytes (loc, bytes) (* As unparsed with [Optimized]. *) ->
Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt ->
begin begin
let bytes = Z.to_bits ~pad_to:address_size z in
match Data_encoding.Binary.of_bytes Contract.encoding bytes with match Data_encoding.Binary.of_bytes Contract.encoding bytes with
| Some c -> | Some c ->
traced (parse_contract ctxt loc ty c) >>=? fun (ctxt, _) -> traced (parse_contract ctxt loc ty c) >>=? fun (ctxt, _) ->
@ -1302,7 +1274,7 @@ let rec parse_data
parse_contract ctxt loc ty c >>=? fun (ctxt, _) -> parse_contract ctxt loc ty c >>=? fun (ctxt, _) ->
return ((ty, c), ctxt) return ((ty, c), ctxt)
| Contract_t _, expr -> | Contract_t _, expr ->
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))
(* Pairs *) (* Pairs *)
| Pair_t ((ta, af, _), (tb, bf, _), ty_name), Prim (loc, D_Pair, [ va; vb ], annot) -> | Pair_t ((ta, af, _), (tb, bf, _), ty_name), Prim (loc, D_Pair, [ va; vb ], annot) ->
check_const_type_annot loc annot ty_name [af; bf] >>=? fun () -> check_const_type_annot loc annot ty_name [af; bf] >>=? fun () ->
@ -2634,9 +2606,6 @@ module Unparse_costs = Michelson_v1_gas.Cost_of.Unparse
let rec unparse_data let rec unparse_data
: type a. context -> unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t : type a. context -> unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t
= fun ctxt mode ty a -> = fun ctxt mode ty a ->
let padded_z_of_bytes bytes =
let bytes = MBytes.concat "" [ bytes ; MBytes.of_string "\xFF" ] in
Z.of_bits bytes in
Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt ->
match ty, a with match ty, a with
| Unit_t _, () -> | Unit_t _, () ->
@ -2673,7 +2642,7 @@ let rec unparse_data
match mode with match mode with
| Optimized -> | Optimized ->
let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
return (Int (-1, Z.of_bits bytes), ctxt) return (Bytes (-1, bytes), ctxt)
| Readable -> return (String (-1, Contract.to_b58check c), ctxt) | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
end end
| Contract_t _, (_, c) -> | Contract_t _, (_, c) ->
@ -2682,7 +2651,7 @@ let rec unparse_data
match mode with match mode with
| Optimized -> | Optimized ->
let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
return (Int (-1, Z.of_bits bytes), ctxt) return (Bytes (-1, bytes), ctxt)
| Readable -> return (String (-1, Contract.to_b58check c), ctxt) | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
end end
| Signature_t _, s -> | Signature_t _, s ->
@ -2691,7 +2660,7 @@ let rec unparse_data
match mode with match mode with
| Optimized -> | Optimized ->
let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in
return (Int (-1, Z.of_bits bytes), ctxt) return (Bytes (-1, bytes), ctxt)
| Readable -> | Readable ->
return (String (-1, Signature.to_b58check s), ctxt) return (String (-1, Signature.to_b58check s), ctxt)
end end
@ -2704,7 +2673,7 @@ let rec unparse_data
match mode with match mode with
| Optimized -> | Optimized ->
let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in
return (Int (-1, padded_z_of_bytes bytes), ctxt) return (Bytes (-1, bytes), ctxt)
| Readable -> | Readable ->
return (String (-1, Signature.Public_key.to_b58check k), ctxt) return (String (-1, Signature.Public_key.to_b58check k), ctxt)
end end
@ -2714,15 +2683,14 @@ let rec unparse_data
match mode with match mode with
| Optimized -> | Optimized ->
let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in
return (Int (-1, Z.of_bits bytes), ctxt) return (Bytes (-1, bytes), ctxt)
| Readable -> | Readable ->
return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt) return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt)
end end
| Operation_t _, op -> | Operation_t _, op ->
let bytes = Data_encoding.Binary.to_bytes_exn Operation.internal_operation_encoding op in let bytes = Data_encoding.Binary.to_bytes_exn Operation.internal_operation_encoding op in
let `Hex text = MBytes.to_hex bytes in
Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt ->
return (String (-1, text), ctxt) return (Bytes (-1, bytes), ctxt)
| Pair_t ((tl, _, _), (tr, _, _), _), (l, r) -> | Pair_t ((tl, _, _), (tr, _, _), _), (l, r) ->
Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt ->
unparse_data ctxt mode tl l >>=? fun (l, ctxt) -> unparse_data ctxt mode tl l >>=? fun (l, ctxt) ->