Michelson: bytes are now comparable

This commit is contained in:
Benjamin Canou 2018-06-17 03:01:36 +02:00
parent af7a64123f
commit e77edb7964
7 changed files with 34 additions and 0 deletions

View File

@ -0,0 +1,7 @@
parameter (pair bytes signature) ;
storage (pair bytes key) ;
code { DUP ; UNPAIR ; CAR ; SHA256 ; DIP { CAR } ; ASSERT_CMPEQ ;
DUP ; UNPAIR ; SWAP ; DIP { UNPAIR ; SWAP } ; CDR ; CHECK_SIGNATURE ; ASSERT ;
CDR ; DUP ; CDR ; HASH_KEY ; IMPLICIT_ACCOUNT ;
BALANCE ; UNIT ; TRANSFER_TOKENS ;
NIL operation ; SWAP ; CONS ; PAIR }

View File

@ -421,6 +421,17 @@ init_with_transfer $contract_dir/self.tz $key1 \
bake_after $client transfer 0 from bootstrap1 to self
assert_storage_contains self "\"$(get_contract_addr self)\""
# Test bytes, SHA256, CHECK_SIGNATURE
init_with_transfer $contract_dir/reveal_signed_preimage.tz bootstrap1 \
'(Pair 0x9995c2ef7bcc7ae3bd15bdd9b02dc6e877c27b26732340d641a4cbc6524813bb "p2pk66uq221795tFxT7jfNmXtBMdjMf6RAaxRTwv1dbuSHbH6yfqGwz")' 1,000 bootstrap1
assert_fails $client transfer 0 from bootstrap1 to reveal_signed_preimage -arg \
'(Pair 0x050100000027566f756c657a2d766f757320636f75636865722061766563206d6f692c20636520736f6972 "p2sigvgDSBnN1bUsfwyMvqpJA1cFhE5s5oi7SetJVQ6LJsbFrU2idPvnvwJhf5v9DhM9ZTX1euS9DgWozVw6BTHiK9VcQVpAU8")'
assert_fails $client transfer 0 from bootstrap1 to reveal_signed_preimage -arg \
'(Pair 0x050100000027566f756c657a2d766f757320636f75636865722061766563206d6f692c20636520736f6972203f "p2sigvgDSBnN1bUsfwyMvqpJA1cFhE5s5oi7SetJVQ6LJsbFrU2idPvnvwJhf5v9DhM9ZTX1euS9DgWozVw6BTHiK9VcQVpAU8")'
assert_success $client transfer 0 from bootstrap1 to reveal_signed_preimage -arg \
'(Pair 0x050100000027566f756c657a2d766f757320636f75636865722061766563206d6f692c20636520736f6972203f "p2sigsceCzcDw2AeYDzUonj4JT341WC9Px4wdhHBxbZcG1FhfqFVuG7f2fGCzrEHSAZgrsrQWpxduDPk9qZRgrpzwJnSHC3gZJ")'
bake
# Test SET_DELEGATE
b2='tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN'
b3='tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU'

View File

@ -193,6 +193,8 @@ module Cost_of = struct
let compare_bool _ _ = step_cost 1
let compare_string s1 s2 =
step_cost (Compare.Int.max (String.length s1) (String.length s2) / 8) +@ step_cost 1
let compare_bytes s1 s2 =
step_cost (Compare.Int.max (MBytes.length s1) (MBytes.length s2) / 8) +@ step_cost 1
let compare_tez _ _ = step_cost 1
let compare_zint n1 n2 = step_cost (Compare.Int.max (Z.numbits n1) (Z.numbits n2) / 8) +@ step_cost 1
let compare_int n1 n2 = compare_zint (Script_int.to_zint n1) (Script_int.to_zint n2)

View File

@ -86,6 +86,7 @@ module Cost_of : sig
val wrap : Gas.cost
val compare_bool : 'a -> 'b -> Gas.cost
val compare_string : string -> string -> Gas.cost
val compare_bytes : MBytes.t -> MBytes.t -> Gas.cost
val compare_tez : 'a -> 'b -> Gas.cost
val compare_int : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
val compare_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

View File

@ -554,6 +554,8 @@ let rec interp
consume_gaz_comparison descr Compare.Bool.compare Interp_costs.compare_bool a b rest
| Compare (String_key _), Item (a, Item (b, rest)) ->
consume_gaz_comparison descr Compare.String.compare Interp_costs.compare_string a b rest
| Compare (Bytes_key _), Item (a, Item (b, rest)) ->
consume_gaz_comparison descr MBytes.compare Interp_costs.compare_bytes a b rest
| Compare (Mutez_key _), Item (a, Item (b, rest)) ->
consume_gaz_comparison descr Tez.compare Interp_costs.compare_tez a b rest
| Compare (Int_key _), Item (a, Item (b, rest)) ->

View File

@ -42,6 +42,7 @@ let comparable_type_size : type t. t comparable_ty -> int = fun ty ->
| Int_key _ -> 1
| Nat_key _ -> 1
| String_key _ -> 1
| Bytes_key _ -> 1
| Mutez_key _ -> 1
| Bool_key _ -> 1
| Key_hash_key _ -> 1
@ -388,6 +389,7 @@ let compare_comparable
else -1
| Timestamp_key _ -> Script_timestamp.compare x y
| Address_key _ -> Contract.compare x y
| Bytes_key _ -> MBytes.compare x y
let empty_set
: type a. a comparable_ty -> a set
@ -511,6 +513,7 @@ let ty_of_comparable_ty
| Int_key tname -> Int_t tname
| Nat_key tname -> Nat_t tname
| String_key tname -> String_t tname
| Bytes_key tname -> Bytes_t tname
| Mutez_key tname -> Mutez_t tname
| Bool_key tname -> Bool_t tname
| Key_hash_key tname -> Key_hash_t tname
@ -523,6 +526,7 @@ let unparse_comparable_ty
| Int_key tname -> Prim (-1, T_int, [], unparse_type_annot tname)
| Nat_key tname -> Prim (-1, T_nat, [], unparse_type_annot tname)
| String_key tname -> Prim (-1, T_string, [], unparse_type_annot tname)
| Bytes_key tname -> Prim (-1, T_bytes, [], unparse_type_annot tname)
| Mutez_key tname -> Prim (-1, T_mutez, [], unparse_type_annot tname)
| Bool_key tname -> Prim (-1, T_bool, [], unparse_type_annot tname)
| Key_hash_key tname -> Prim (-1, T_key_hash, [], unparse_type_annot tname)
@ -2233,6 +2237,12 @@ and parse_instr
Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
typed ctxt loc (Compare (Address_key tname))
(Item_t (Int_t None, rest, annot))
| Prim (loc, I_COMPARE, [], annot),
Item_t (Bytes_t tn1, Item_t (Bytes_t tn2, rest, _), _) ->
parse_var_annot loc annot >>=? fun annot ->
Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
typed ctxt loc (Compare (Bytes_key tname))
(Item_t (Int_t None, rest, annot))
(* comparators *)
| Prim (loc, I_EQ, [], annot),
Item_t (Int_t _, rest, _) ->

View File

@ -22,6 +22,7 @@ type 'ty comparable_ty =
| Int_key : type_annot option -> (z num) comparable_ty
| Nat_key : type_annot option -> (n num) comparable_ty
| String_key : type_annot option -> string comparable_ty
| Bytes_key : type_annot option -> MBytes.t comparable_ty
| Mutez_key : type_annot option -> Tez.t comparable_ty
| Bool_key : type_annot option -> bool comparable_ty
| Key_hash_key : type_annot option -> public_key_hash comparable_ty