Michelson: bytes are now comparable
This commit is contained in:
parent
af7a64123f
commit
e77edb7964
7
src/bin_client/test/contracts/reveal_signed_preimage.tz
Normal file
7
src/bin_client/test/contracts/reveal_signed_preimage.tz
Normal 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 }
|
@ -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'
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)) ->
|
||||
|
@ -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, _) ->
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user