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

Michelson: adds key_hash type

Browse Source
This commit is contained in:
Milo Davis 2017-09-15 16:32:50 +02:00 committed by Benjamin Canou
parent 46cec6fe76
commit e440dfea18
11 changed files with 111 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/proto/alpha/docs/language.md
View File

@ -724,6 +724,15 @@ constants as is, concatenate them and use them as keys.
:: 'elt : bool : set 'elt : 'S -> set 'elt : 'S :: 'elt : bool : set 'elt : 'S -> set 'elt : 'S
* `MAP`:
Apply a function on a map and return the map of results under
the same bindings.
The `'b` type must be comparable (the `COMPARE` primitive must be
defined over it).
:: lambda 'elt 'b : set 'elt : 'S -> set 'b : 'S
* `REDUCE`: * `REDUCE`:
Apply a function on a set passing the result of each Apply a function on a set passing the result of each
application to the next one and return the last. application to the next one and return the last.
@ -896,6 +905,9 @@ VI - Domain specific data types
* `key`: * `key`:
A public cryptography key. A public cryptography key.
* `key_hash`:
The hash of a public cryptography key.
* `signature`: * `signature`:
A cryptographic signature. A cryptographic signature.
@ -970,13 +982,13 @@ for under/overflows.
* `MANAGER`: * `MANAGER`:
Access the manager of a contract. Access the manager of a contract.
:: contract 'p 'r : 'S -> key : 'S :: contract 'p 'r : 'S -> key_hash : 'S
* `CREATE_CONTRACT`: * `CREATE_CONTRACT`:
Forge a new contract. Forge a new contract.
:: key : key? : bool : bool : tez : lambda (pair 'p 'g) (pair 'r 'g) : 'g : 'S :: key_hash : key_hash? : bool : bool : tez : lambda (pair 'p 'g) (pair 'r 'g) : 'g : 'S
-> contract 'p 'r : 'S -> contract 'p 'r : 'S
As with non code-emitted originations the As with non code-emitted originations the
@ -995,7 +1007,7 @@ for under/overflows.
* `CREATE_ACCOUNT`: * `CREATE_ACCOUNT`:
Forge an account (a contract without code). Forge an account (a contract without code).
:: key : key? : bool : tez : 'S -> contract unit unit : 'S :: key_hash : key_hash? : bool : tez : 'S -> contract unit unit : 'S
Take as argument the manager, optional delegate, the delegatable Take as argument the manager, optional delegate, the delegatable
flag and finally the initial amount taken from the currently flag and finally the initial amount taken from the currently
@ -1050,7 +1062,7 @@ for under/overflows.
holder of the private key. This contract cannot execute Michelson code holder of the private key. This contract cannot execute Michelson code
and will always exist on the blockchain. and will always exist on the blockchain.
:: key : 'S -> contract unit unit :: 'S :: key_hash : 'S -> contract unit unit :: 'S
### Special operations ### Special operations
@ -1067,6 +1079,11 @@ for under/overflows.
### Cryptographic primitives ### Cryptographic primitives
* `HASH_KEY`:
Compute the b58check of a public key.
:: key : 'S -> key_hash : 'S
* `H`: * `H`:
Compute a cryptographic hash of the value contents using the Compute a cryptographic hash of the value contents using the
Sha256 cryptographic algorithm. Sha256 cryptographic algorithm.
@ -1080,7 +1097,7 @@ for under/overflows.
* `COMPARE`: * `COMPARE`:
:: key : key : 'S -> int : 'S :: key_hash : key_hash : 'S -> int : 'S
VIII - Macros VIII - Macros
------------- -------------
@ -1777,6 +1794,7 @@ X - Full grammar
| <timestamp string constant> | <timestamp string constant>
| <signature string constant> | <signature string constant>
| <key string constant> | <key string constant>
| <key_hash string constant>
| <tez string constant> | <tez string constant>
| <contract string constant> | <contract string constant>
| Unit | Unit
@ -1844,29 +1862,19 @@ X - Full grammar
| GT | GT
| LE | LE
| GE | GE
| CAST | INT
| CHECKED_ABS
| CHECKED_NEG
| CHECKED_ADD
| CHECKED_SUB
| CHECKED_MUL
| CHECKED_CAST
| FLOOR
| CEIL
| INF
| NAN
| ISNAN
| NANAN
| MANAGER | MANAGER
| SELF | SELF
| TRANSFER_TOKENS | TRANSFER_TOKENS
| CREATE_ACCOUNT | CREATE_ACCOUNT
| CREATE_CONTRACT | CREATE_CONTRACT
| DEFAULT_ACCOUNT
| NOW | NOW
| AMOUNT | AMOUNT
| BALANCE | BALANCE
| CHECK_SIGNATURE | CHECK_SIGNATURE
| H | H
| HASH_KEY
| STEPS_TO_QUOTA | STEPS_TO_QUOTA
| SOURCE <type> <type> | SOURCE <type> <type>
<type> ::= <type> ::=
@ -1877,6 +1885,7 @@ X - Full grammar
| tez | tez
| bool | bool
| key | key
| key_hash
| timestamp | timestamp
| signature | signature
| option <type> | option <type>
@ -1893,7 +1902,7 @@ X - Full grammar
| string | string
| tez | tez
| bool | bool
| key | key_hash
| timestamp | timestamp
XII - Reference implementation XII - Reference implementation

5
src/proto/alpha/script_interpreter.ml
View File

@ -418,7 +418,7 @@ let rec interp
let cmpres = Script_int.compare a b in let cmpres = Script_int.compare a b in
let cmpres = Script_int.of_int cmpres in let cmpres = Script_int.of_int cmpres in
logged_return (Item (cmpres, rest), qta - 1, ctxt) logged_return (Item (cmpres, rest), qta - 1, ctxt)
| Compare Key_key, Item (a, Item (b, rest)) -> | Compare Key_hash_key, Item (a, Item (b, rest)) ->
let cmpres = Ed25519.Public_key_hash.compare a b in let cmpres = Ed25519.Public_key_hash.compare a b in
let cmpres = Script_int.of_int cmpres in let cmpres = Script_int.of_int cmpres in
logged_return (Item (cmpres, rest), qta - 1, ctxt) logged_return (Item (cmpres, rest), qta - 1, ctxt)
@ -540,10 +540,11 @@ let rec interp
let now = Timestamp.current ctxt in let now = Timestamp.current ctxt in
logged_return (Item (now, rest), qta - 1, ctxt) logged_return (Item (now, rest), qta - 1, ctxt)
| Check_signature, Item (key, Item ((signature, message), rest)) -> | Check_signature, Item (key, Item ((signature, message), rest)) ->
Public_key.get ctxt key >>=? fun key ->
let message = MBytes.of_string message in let message = MBytes.of_string message in
let res = Ed25519.Signature.check key signature message in let res = Ed25519.Signature.check key signature message in
logged_return (Item (res, rest), qta - 1, ctxt) logged_return (Item (res, rest), qta - 1, ctxt)
| Hash_key, Item (key, rest) ->
logged_return (Item (Ed25519.Public_key.hash key, rest), qta -1, ctxt)
| H ty, Item (v, rest) -> | H ty, Item (v, rest) ->
let hash = Script.hash_expr (unparse_data ty v) in let hash = Script.hash_expr (unparse_data ty v) in
logged_return (Item (hash, rest), qta - 1, ctxt) logged_return (Item (hash, rest), qta - 1, ctxt)

66
src/proto/alpha/script_ir_translator.ml
View File

@ -118,7 +118,7 @@ let compare_comparable
| String_key -> Compare.String.compare x y | String_key -> Compare.String.compare x y
| Bool_key -> Compare.Bool.compare x y | Bool_key -> Compare.Bool.compare x y
| Tez_key -> Tez.compare x y | Tez_key -> Tez.compare x y
| Key_key -> Ed25519.Public_key_hash.compare x y | Key_hash_key -> Ed25519.Public_key_hash.compare x y
| Int_key -> | Int_key ->
let res = (Script_int.compare x y) in let res = (Script_int.compare x y) in
if Compare.Int.(res = 0) then 0 if Compare.Int.(res = 0) then 0
@ -236,7 +236,7 @@ let ty_of_comparable_ty
| String_key -> String_t | String_key -> String_t
| Tez_key -> Tez_t | Tez_key -> Tez_t
| Bool_key -> Bool_t | Bool_key -> Bool_t
| Key_key -> Key_t | Key_hash_key -> Key_hash_t
| Timestamp_key -> Timestamp_t | Timestamp_key -> Timestamp_t
let unparse_comparable_ty let unparse_comparable_ty
@ -246,7 +246,7 @@ let unparse_comparable_ty
| String_key -> Prim (-1, "string", [], None) | String_key -> Prim (-1, "string", [], None)
| Tez_key -> Prim (-1, "tez", [], None) | Tez_key -> Prim (-1, "tez", [], None)
| Bool_key -> Prim (-1, "bool", [], None) | Bool_key -> Prim (-1, "bool", [], None)
| Key_key -> Prim (-1, "key", [], None) | Key_hash_key -> Prim (-1, "key_hash", [], None)
| Timestamp_key -> Prim (-1, "timestamp", [], None) | Timestamp_key -> Prim (-1, "timestamp", [], None)
let rec unparse_ty let rec unparse_ty
@ -257,6 +257,7 @@ let rec unparse_ty
| String_t -> Prim (-1, "string", [], None) | String_t -> Prim (-1, "string", [], None)
| Tez_t -> Prim (-1, "tez", [], None) | Tez_t -> Prim (-1, "tez", [], None)
| Bool_t -> Prim (-1, "bool", [], None) | Bool_t -> Prim (-1, "bool", [], None)
| Key_hash_t -> Prim (-1, "key_hash", [], None)
| Key_t -> Prim (-1, "key", [], None) | Key_t -> Prim (-1, "key", [], None)
| Timestamp_t -> Prim (-1, "timestamp", [], None) | Timestamp_t -> Prim (-1, "timestamp", [], None)
| Signature_t -> Prim (-1, "signature", [], None) | Signature_t -> Prim (-1, "signature", [], None)
@ -317,6 +318,8 @@ let rec unparse_data
| Tez_t, v -> | Tez_t, v ->
String (-1, Tez.to_string v) String (-1, Tez.to_string v)
| Key_t, k -> | Key_t, k ->
String (-1, Ed25519.Public_key.to_b58check k)
| Key_hash_t, k ->
String (-1, Ed25519.Public_key_hash.to_b58check k) String (-1, Ed25519.Public_key_hash.to_b58check k)
| Pair_t (tl, tr), (l, r) -> | Pair_t (tl, tr), (l, r) ->
let l = unparse_data tl l in let l = unparse_data tl l in
@ -377,7 +380,7 @@ let comparable_ty_eq
| String_key, String_key -> eq ta tb | String_key, String_key -> eq ta tb
| Tez_key, Tez_key -> eq ta tb | Tez_key, Tez_key -> eq ta tb
| Bool_key, Bool_key -> eq ta tb | Bool_key, Bool_key -> eq ta tb
| Key_key, Key_key -> eq ta tb | Key_hash_key, Key_hash_key -> eq ta tb
| Timestamp_key, Timestamp_key -> eq ta tb | Timestamp_key, Timestamp_key -> eq ta tb
| _, _ -> error (Inconsistent_types (ty_of_comparable_ty ta, ty_of_comparable_ty tb)) | _, _ -> error (Inconsistent_types (ty_of_comparable_ty ta, ty_of_comparable_ty tb))
@ -389,6 +392,7 @@ let rec ty_eq
| Int_t, Int_t -> eq ta tb | Int_t, Int_t -> eq ta tb
| Nat_t, Nat_t -> eq ta tb | Nat_t, Nat_t -> eq ta tb
| Key_t, Key_t -> eq ta tb | Key_t, Key_t -> eq ta tb
| Key_hash_t, Key_hash_t -> eq ta tb
| String_t, String_t -> eq ta tb | String_t, String_t -> eq ta tb
| Signature_t, Signature_t -> eq ta tb | Signature_t, Signature_t -> eq ta tb
| Tez_t, Tez_t -> eq ta tb | Tez_t, Tez_t -> eq ta tb
@ -486,7 +490,7 @@ let rec parse_comparable_ty : Script.expr -> ex_comparable_ty tzresult = functio
| Prim (_, "string", [], _) -> ok (Ex_comparable_ty String_key) | Prim (_, "string", [], _) -> ok (Ex_comparable_ty String_key)
| Prim (_, "tez", [], _) -> ok (Ex_comparable_ty Tez_key) | Prim (_, "tez", [], _) -> ok (Ex_comparable_ty Tez_key)
| Prim (_, "bool", [], _) -> ok (Ex_comparable_ty Bool_key) | Prim (_, "bool", [], _) -> ok (Ex_comparable_ty Bool_key)
| Prim (_, "key", [], _) -> ok (Ex_comparable_ty Key_key) | Prim (_, "key_hash", [], _) -> ok (Ex_comparable_ty Key_hash_key)
| Prim (_, "timestamp", [], _) -> ok (Ex_comparable_ty Timestamp_key) | Prim (_, "timestamp", [], _) -> ok (Ex_comparable_ty Timestamp_key)
| Prim (loc, ("int" | "nat" | Prim (loc, ("int" | "nat"
| "string" | "tez" | "bool" | "string" | "tez" | "bool"
@ -501,7 +505,7 @@ let rec parse_comparable_ty : Script.expr -> ex_comparable_ty tzresult = functio
error @@ unexpected expr [] Type_namespace error @@ unexpected expr [] Type_namespace
[ "int" ; "nat" ; [ "int" ; "nat" ;
"string" ; "tez" ; "bool" ; "string" ; "tez" ; "bool" ;
"key" ; "timestamp" ] "key" ; "key_hash" ; "timestamp" ]
and parse_ty : Script.expr -> ex_ty tzresult = function and parse_ty : Script.expr -> ex_ty tzresult = function
| Prim (_, "unit", [], _) -> ok (Ex_ty Unit_t) | Prim (_, "unit", [], _) -> ok (Ex_ty Unit_t)
@ -511,6 +515,7 @@ and parse_ty : Script.expr -> ex_ty tzresult = function
| Prim (_, "tez", [], _) -> ok (Ex_ty Tez_t) | Prim (_, "tez", [], _) -> ok (Ex_ty Tez_t)
| Prim (_, "bool", [], _) -> ok (Ex_ty Bool_t) | Prim (_, "bool", [], _) -> ok (Ex_ty Bool_t)
| Prim (_, "key", [], _) -> ok (Ex_ty Key_t) | Prim (_, "key", [], _) -> ok (Ex_ty Key_t)
| Prim (_, "key_hash", [], _) -> ok (Ex_ty Key_hash_t)
| Prim (_, "timestamp", [], _) -> ok (Ex_ty Timestamp_t) | Prim (_, "timestamp", [], _) -> ok (Ex_ty Timestamp_t)
| Prim (_, "signature", [], _) -> ok (Ex_ty Signature_t) | Prim (_, "signature", [], _) -> ok (Ex_ty Signature_t)
| Prim (_, "contract", [ utl; utr ], _) -> | Prim (_, "contract", [ utl; utr ], _) ->
@ -547,7 +552,7 @@ and parse_ty : Script.expr -> ex_ty tzresult = function
| "unit" | "signature" | "contract" | "unit" | "signature" | "contract"
| "int" | "nat" | "int" | "nat"
| "string" | "tez" | "bool" | "string" | "tez" | "bool"
| "key" | "timestamp" as prim), l, _) -> | "key" | "key_hash" | "timestamp" as prim), l, _) ->
error (Invalid_arity (loc, prim, 0, List.length l)) error (Invalid_arity (loc, prim, 0, List.length l))
| expr -> | expr ->
error @@ unexpected expr [] Type_namespace error @@ unexpected expr [] Type_namespace
@ -556,7 +561,7 @@ and parse_ty : Script.expr -> ex_ty tzresult = function
"unit" ; "signature" ; "contract" ; "unit" ; "signature" ; "contract" ;
"int" ; "nat" ; "int" ; "nat" ;
"string" ; "tez" ; "bool" ; "string" ; "tez" ; "bool" ;
"key" ; "timestamp" ] "key" ; "key_hash" ; "timestamp" ]
let comparable_ty_of_ty let comparable_ty_of_ty
: type a. int -> a ty -> a comparable_ty tzresult : type a. int -> a ty -> a comparable_ty tzresult
@ -566,7 +571,7 @@ let comparable_ty_of_ty
| String_t -> ok String_key | String_t -> ok String_key
| Tez_t -> ok Tez_key | Tez_t -> ok Tez_key
| Bool_t -> ok Bool_key | Bool_t -> ok Bool_key
| Key_t -> ok Key_key | Key_hash_t -> ok Key_hash_key
| Timestamp_t -> ok Timestamp_key | Timestamp_t -> ok Timestamp_key
| ty -> error (Comparable_type_expected (loc, ty)) | ty -> error (Comparable_type_expected (loc, ty))
@ -646,12 +651,21 @@ 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, String (_, s) -> begin try | Key_t, String (_, s) ->
return (Ed25519.Public_key_hash.of_b58check_exn s) begin
with _ -> fail (error ()) try
end return (Ed25519.Public_key.of_b58check_exn s)
with _ -> fail (error ())
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 ], kind expr)))
| Key_hash_t, String (_, s) ->
begin
try
return (Ed25519.Public_key_hash.of_b58check_exn s)
with _ -> fail (error ()) end
| Key_hash_t, expr ->
traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr)))
(* Signatures *) (* Signatures *)
| Signature_t, String (_, s) -> begin try | Signature_t, String (_, s) -> begin try
match Data_encoding.Binary.of_bytes match Data_encoding.Binary.of_bytes
@ -1210,8 +1224,8 @@ and parse_instr
Item_t (Tez_t, Item_t (Tez_t, rest)) -> Item_t (Tez_t, Item_t (Tez_t, rest)) ->
return (typed loc annot (Compare Tez_key, Item_t (Int_t, rest))) return (typed loc annot (Compare Tez_key, Item_t (Int_t, rest)))
| Prim (loc, "COMPARE", [], annot), | Prim (loc, "COMPARE", [], annot),
Item_t (Key_t, Item_t (Key_t, rest)) -> Item_t (Key_hash_t, Item_t (Key_hash_t, rest)) ->
return (typed loc annot (Compare Key_key, Item_t (Int_t, rest))) return (typed loc annot (Compare Key_hash_key, Item_t (Int_t, rest)))
| Prim (loc, "COMPARE", [], annot), | Prim (loc, "COMPARE", [], annot),
Item_t (Timestamp_t, Item_t (Timestamp_t, rest)) -> Item_t (Timestamp_t, Item_t (Timestamp_t, rest)) ->
return (typed loc annot (Compare Timestamp_key, Item_t (Int_t, rest))) return (typed loc annot (Compare Timestamp_key, Item_t (Int_t, rest)))
@ -1237,7 +1251,7 @@ and parse_instr
(* protocol *) (* protocol *)
| Prim (loc, "MANAGER", [], annot), | Prim (loc, "MANAGER", [], annot),
Item_t (Contract_t _, rest) -> Item_t (Contract_t _, rest) ->
return (typed loc annot (Manager, Item_t (Key_t, rest))) return (typed loc annot (Manager, Item_t (Key_hash_t, rest)))
| Prim (loc, "TRANSFER_TOKENS", [], annot), | Prim (loc, "TRANSFER_TOKENS", [], annot),
Item_t (p, Item_t Item_t (p, Item_t
(Tez_t, Item_t (Tez_t, Item_t
@ -1254,20 +1268,20 @@ and parse_instr
end end
| Prim (loc, "CREATE_ACCOUNT", [], annot), | Prim (loc, "CREATE_ACCOUNT", [], annot),
Item_t Item_t
(Key_t, Item_t (Key_hash_t, Item_t
(Option_t Key_t, Item_t (Option_t Key_hash_t, Item_t
(Bool_t, Item_t (Bool_t, Item_t
(Tez_t, rest)))) -> (Tez_t, rest)))) ->
return (typed loc annot (Create_account, return (typed loc annot (Create_account,
Item_t (Contract_t (Unit_t, Unit_t), rest))) Item_t (Contract_t (Unit_t, Unit_t), rest)))
| Prim (loc, "DEFAULT_ACCOUNT", [], annot), | Prim (loc, "DEFAULT_ACCOUNT", [], annot),
Item_t (Key_t, rest) -> Item_t (Key_hash_t, rest) ->
return return
(typed loc annot (Default_account, Item_t (Contract_t (Unit_t, Unit_t), rest))) (typed loc annot (Default_account, Item_t (Contract_t (Unit_t, Unit_t), rest)))
| Prim (loc, "CREATE_CONTRACT", [], annot), | Prim (loc, "CREATE_CONTRACT", [], annot),
Item_t Item_t
(Key_t, Item_t (Key_hash_t, Item_t
(Option_t Key_t, Item_t (Option_t Key_hash_t, Item_t
(Bool_t, Item_t (Bool_t, Item_t
(Bool_t, Item_t (Bool_t, Item_t
(Tez_t, Item_t (Tez_t, Item_t
@ -1287,6 +1301,9 @@ and parse_instr
| Prim (loc, "BALANCE", [], annot), | Prim (loc, "BALANCE", [], annot),
stack -> stack ->
return (typed loc annot (Balance, Item_t (Tez_t, stack))) return (typed loc annot (Balance, Item_t (Tez_t, stack)))
| Prim (loc, "HASH_KEY", [], annot),
Item_t (Key_t, rest) ->
return (typed loc annot (Hash_key, Item_t (Key_hash_t, rest)))
| Prim (loc, "CHECK_SIGNATURE", [], annot), | Prim (loc, "CHECK_SIGNATURE", [], annot),
Item_t (Key_t, Item_t (Pair_t (Signature_t, String_t), rest)) -> Item_t (Key_t, Item_t (Pair_t (Signature_t, String_t), rest)) ->
return (typed loc annot (Check_signature, Item_t (Bool_t, rest))) return (typed loc annot (Check_signature, Item_t (Bool_t, rest)))
@ -1315,7 +1332,8 @@ and parse_instr
| "MANAGER" | "TRANSFER_TOKENS" | "CREATE_ACCOUNT" | "MANAGER" | "TRANSFER_TOKENS" | "CREATE_ACCOUNT"
| "CREATE_CONTRACT" | "NOW" | "CREATE_CONTRACT" | "NOW"
| "DEFAULT_ACCOUNT" | "AMOUNT" | "BALANCE" | "DEFAULT_ACCOUNT" | "AMOUNT" | "BALANCE"
| "CHECK_SIGNATURE" | "H" | "STEPS_TO_QUOTA" | "CHECK_SIGNATURE" | "HASH_KEY"
| "H" | "STEPS_TO_QUOTA"
as name), (_ :: _ as l), _), _ -> as name), (_ :: _ as l), _), _ ->
fail (Invalid_arity (loc, name, 0, List.length l)) fail (Invalid_arity (loc, name, 0, List.length l))
| Prim (loc, ("NONE" | "LEFT" | "RIGHT" | "NIL" | Prim (loc, ("NONE" | "LEFT" | "RIGHT" | "NIL"
@ -1383,7 +1401,8 @@ and parse_instr
"LT" ; "GT" ; "LE" ; "GE" ; "LT" ; "GT" ; "LE" ; "GE" ;
"MANAGER" ; "TRANSFER_TOKENS" ; "CREATE_ACCOUNT" ; "MANAGER" ; "TRANSFER_TOKENS" ; "CREATE_ACCOUNT" ;
"CREATE_CONTRACT" ; "NOW" ; "AMOUNT" ; "BALANCE" ; "CREATE_CONTRACT" ; "NOW" ; "AMOUNT" ; "BALANCE" ;
"DEFAULT_ACCOUNT" ; "CHECK_SIGNATURE" ; "H" ; "STEPS_TO_QUOTA" ; "DEFAULT_ACCOUNT" ; "CHECK_SIGNATURE" ; "H" ; "HASH_KEY" ;
"STEPS_TO_QUOTA" ;
"PUSH" ; "NONE" ; "LEFT" ; "RIGHT" ; "NIL" ; "PUSH" ; "NONE" ; "LEFT" ; "RIGHT" ; "NIL" ;
"EMPTY_SET" ; "DIP" ; "LOOP" ; "EMPTY_SET" ; "DIP" ; "LOOP" ;
"IF_NONE" ; "IF_LEFT" ; "IF_CONS" ; "IF_NONE" ; "IF_LEFT" ; "IF_CONS" ;
@ -1508,6 +1527,7 @@ let type_map descr =
| String_t, _ -> acc | String_t, _ -> acc
| Tez_t, _ -> acc | Tez_t, _ -> acc
| Key_t, _ -> acc | Key_t, _ -> acc
| Key_hash_t, _ -> acc
| Timestamp_t, _ -> acc | Timestamp_t, _ -> acc
| Bool_t, _ -> acc | Bool_t, _ -> acc
| Contract_t _,_ -> acc | Contract_t _,_ -> acc

9
src/proto/alpha/script_typed_ir.ml
View File

@ -19,7 +19,7 @@ type 'ty comparable_ty =
| String_key : string comparable_ty | String_key : string comparable_ty
| Tez_key : Tez.t comparable_ty | Tez_key : Tez.t comparable_ty
| Bool_key : bool comparable_ty | Bool_key : bool comparable_ty
| Key_key : public_key_hash comparable_ty | Key_hash_key : public_key_hash comparable_ty
| Timestamp_key : Timestamp.t comparable_ty | Timestamp_key : Timestamp.t comparable_ty
module type Boxed_set = sig module type Boxed_set = sig
@ -66,7 +66,8 @@ and 'ty ty =
| Signature_t : signature ty | Signature_t : signature ty
| String_t : string ty | String_t : string ty
| Tez_t : Tez.t ty | Tez_t : Tez.t ty
| Key_t : public_key_hash ty | Key_hash_t : public_key_hash ty
| Key_t : public_key ty
| Timestamp_t : Timestamp.t ty | Timestamp_t : Timestamp.t ty
| Bool_t : bool ty | Bool_t : bool ty
| Pair_t : 'a ty * 'b ty -> ('a, 'b) pair ty | Pair_t : 'a ty * 'b ty -> ('a, 'b) pair ty
@ -298,7 +299,9 @@ and ('bef, 'aft) instr =
| Balance : | Balance :
('rest, Tez.t * 'rest) instr ('rest, Tez.t * 'rest) instr
| Check_signature : | Check_signature :
(public_key_hash * ((signature * string) * 'rest), bool * 'rest) instr (public_key * ((signature * string) * 'rest), bool * 'rest) instr
| Hash_key :
(public_key * 'rest, public_key_hash * 'rest) instr
| H : 'a ty -> | H : 'a ty ->
('a * 'rest, string * 'rest) instr ('a * 'rest, string * 'rest) instr
| Steps_to_quota : (* TODO: check that it always returns a nat *) | Steps_to_quota : (* TODO: check that it always returns a nat *)

6
test/contracts/check_signature.tz
View File

@ -1,5 +1,7 @@
parameter key; parameter key;
storage (pair signature string); storage (pair signature string);
return bool; return bool;
code {DUP; DUP; DIP{CDR; DUP; CAR; DIP{CDR; H}; PAIR}; code { DUP; DUP;
CAR; CHECK_SIGNATURE; DIP{CDR}; PAIR}; DIP{ CDR; DUP; CAR;
DIP{CDR; H}; PAIR};
CAR; CHECK_SIGNATURE; DIP{CDR}; PAIR};

4
test/contracts/create_account.tz
View File

@ -1,5 +1,5 @@
parameter key; parameter key_hash;
return unit; return unit;
storage (contract unit unit); storage (contract unit unit);
code {CAR; DIP{PUSH tez "100.00"; PUSH bool False; NONE key}; code {CAR; DIP{PUSH tez "100.00"; PUSH bool False; NONE key_hash};
CREATE_ACCOUNT; UNIT; PAIR}; CREATE_ACCOUNT; UNIT; PAIR};

22
test/contracts/create_contract.tz
View File

@ -1,13 +1,13 @@
parameter key; parameter key_hash;
storage string; storage string;
return unit; return unit;
code { CAR; code {CAR;
DIP { UNIT; DIP{UNIT;
LAMBDA LAMBDA (pair string unit)
(pair string unit) (pair string unit) (pair string unit)
{ CAR; UNIT; SWAP; PAIR }; {CAR; UNIT; SWAP; PAIR};
PUSH tez "100.00"; PUSH bool False; PUSH tez "100.00"; PUSH bool False;
PUSH bool False; NONE key }; PUSH bool False; NONE key_hash};
CREATE_CONTRACT; DIP { PUSH string "" }; PUSH tez "0.00"; CREATE_CONTRACT; DIP{PUSH string ""}; PUSH tez "0.00";
PUSH string "abcdefg"; TRANSFER_TOKENS; PUSH string "abcdefg"; TRANSFER_TOKENS;
DIP { DROP }; UNIT; PAIR } DIP{DROP}; UNIT; PAIR};

2
test/contracts/default_account.tz
View File

@ -1,4 +1,4 @@
parameter key; parameter key_hash;
return unit; return unit;
storage unit; storage unit;
code {DIP{UNIT}; CAR; DEFAULT_ACCOUNT; code {DIP{UNIT}; CAR; DEFAULT_ACCOUNT;

4
test/contracts/hash_key.tz Normal file
View File

@ -0,0 +1,4 @@
parameter key;
return key_hash;
storage unit;
code {CAR; HASH_KEY; DIP{UNIT}; PAIR}

6
test/contracts/originator.tz
View File

@ -7,11 +7,11 @@ code
LOOP LOOP
{ PUSH tez "5.00" ; { PUSH tez "5.00" ;
PUSH bool True ; # delegatable PUSH bool True ; # delegatable
NONE key ; # delegate NONE key_hash ; # delegate
PUSH key "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager
CREATE_ACCOUNT ; CREATE_ACCOUNT ;
SWAP ; DIP { CONS } ; SWAP ; DIP { CONS } ;
PUSH nat 1 ; SWAP ; SUB ; PUSH nat 1 ; SWAP ; SUB ; ABS ;
DUP ; PUSH nat 0 ; CMPNEQ } ; DUP ; PUSH nat 0 ; CMPNEQ } ;
DROP ; DROP ;
UNIT ; SWAP ; PAIR } UNIT ; SWAP ; PAIR }

8
test/test_contracts.sh
View File

@ -278,11 +278,15 @@ assert_storage $CONTRACT_PATH/map_caddaadr.tz \
# Did the given key sign the string? (key is bootstrap1) # Did the given key sign the string? (key is bootstrap1)
assert_output $CONTRACT_PATH/check_signature.tz \ assert_output $CONTRACT_PATH/check_signature.tz \
'(Pair "26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309" "hello")' \ '(Pair "26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309" "hello")' \
'"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' True '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' True
assert_output $CONTRACT_PATH/check_signature.tz \ assert_output $CONTRACT_PATH/check_signature.tz \
'(Pair "26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309" "abcd")' \ '(Pair "26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309" "abcd")' \
'"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' False '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' False
# Convert a public key to a public key hash
assert_output $CONTRACT_PATH/hash_key.tz Unit '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"'
assert_output $CONTRACT_PATH/hash_key.tz Unit '"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES"' '"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k"'
$client transfer 1000 from bootstrap1 to $key1 $client transfer 1000 from bootstrap1 to $key1
$client transfer 2000 from bootstrap1 to $key2 $client transfer 2000 from bootstrap1 to $key2