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
* `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`:
Apply a function on a set passing the result of each
application to the next one and return the last.
@ -896,6 +905,9 @@ VI - Domain specific data types
* `key`:
A public cryptography key.
* `key_hash`:
The hash of a public cryptography key.
* `signature`:
A cryptographic signature.
@ -970,13 +982,13 @@ for under/overflows.
* `MANAGER`:
Access the manager of a contract.
:: contract 'p 'r : 'S -> key : 'S
:: contract 'p 'r : 'S -> key_hash : 'S
* `CREATE_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
As with non code-emitted originations the
@ -995,7 +1007,7 @@ for under/overflows.
* `CREATE_ACCOUNT`:
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
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
and will always exist on the blockchain.
:: key : 'S -> contract unit unit :: 'S
:: key_hash : 'S -> contract unit unit :: 'S
### Special operations
@ -1067,6 +1079,11 @@ for under/overflows.
### Cryptographic primitives
* `HASH_KEY`:
Compute the b58check of a public key.
:: key : 'S -> key_hash : 'S
* `H`:
Compute a cryptographic hash of the value contents using the
Sha256 cryptographic algorithm.
@ -1080,7 +1097,7 @@ for under/overflows.
* `COMPARE`:
:: key : key : 'S -> int : 'S
:: key_hash : key_hash : 'S -> int : 'S
VIII - Macros
-------------
@ -1777,6 +1794,7 @@ X - Full grammar
| <timestamp string constant>
| <signature string constant>
| <key string constant>
| <key_hash string constant>
| <tez string constant>
| <contract string constant>
| Unit
@ -1844,29 +1862,19 @@ X - Full grammar
| GT
| LE
| GE
| CAST
| CHECKED_ABS
| CHECKED_NEG
| CHECKED_ADD
| CHECKED_SUB
| CHECKED_MUL
| CHECKED_CAST
| FLOOR
| CEIL
| INF
| NAN
| ISNAN
| NANAN
| INT
| MANAGER
| SELF
| TRANSFER_TOKENS
| CREATE_ACCOUNT
| CREATE_CONTRACT
| DEFAULT_ACCOUNT
| NOW
| AMOUNT
| BALANCE
| CHECK_SIGNATURE
| H
| HASH_KEY
| STEPS_TO_QUOTA
| SOURCE <type> <type>
<type> ::=
@ -1877,6 +1885,7 @@ X - Full grammar
| tez
| bool
| key
| key_hash
| timestamp
| signature
| option <type>
@ -1893,7 +1902,7 @@ X - Full grammar
| string
| tez
| bool
| key
| key_hash
| timestamp
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.of_int cmpres in
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 = Script_int.of_int cmpres in
logged_return (Item (cmpres, rest), qta - 1, ctxt)
@ -540,10 +540,11 @@ let rec interp
let now = Timestamp.current ctxt in
logged_return (Item (now, rest), qta - 1, ctxt)
| Check_signature, Item (key, Item ((signature, message), rest)) ->
Public_key.get ctxt key >>=? fun key ->
let message = MBytes.of_string message in
let res = Ed25519.Signature.check key signature message in
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) ->
let hash = Script.hash_expr (unparse_data ty v) in
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
| Bool_key -> Compare.Bool.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 ->
let res = (Script_int.compare x y) in
if Compare.Int.(res = 0) then 0
@ -236,7 +236,7 @@ let ty_of_comparable_ty
| String_key -> String_t
| Tez_key -> Tez_t
| Bool_key -> Bool_t
| Key_key -> Key_t
| Key_hash_key -> Key_hash_t
| Timestamp_key -> Timestamp_t
let unparse_comparable_ty
@ -246,7 +246,7 @@ let unparse_comparable_ty
| String_key -> Prim (-1, "string", [], None)
| Tez_key -> Prim (-1, "tez", [], 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)
let rec unparse_ty
@ -257,6 +257,7 @@ let rec unparse_ty
| String_t -> Prim (-1, "string", [], None)
| Tez_t -> Prim (-1, "tez", [], None)
| Bool_t -> Prim (-1, "bool", [], None)
| Key_hash_t -> Prim (-1, "key_hash", [], None)
| Key_t -> Prim (-1, "key", [], None)
| Timestamp_t -> Prim (-1, "timestamp", [], None)
| Signature_t -> Prim (-1, "signature", [], None)
@ -317,6 +318,8 @@ let rec unparse_data
| Tez_t, v ->
String (-1, Tez.to_string v)
| Key_t, k ->
String (-1, Ed25519.Public_key.to_b58check k)
| Key_hash_t, k ->
String (-1, Ed25519.Public_key_hash.to_b58check k)
| Pair_t (tl, tr), (l, r) ->
let l = unparse_data tl l in
@ -377,7 +380,7 @@ let comparable_ty_eq
| String_key, String_key -> eq ta tb
| Tez_key, Tez_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
| _, _ -> 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
| Nat_t, Nat_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
| Signature_t, Signature_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 (_, "tez", [], _) -> ok (Ex_comparable_ty Tez_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 (loc, ("int" | "nat"
| "string" | "tez" | "bool"
@ -501,7 +505,7 @@ let rec parse_comparable_ty : Script.expr -> ex_comparable_ty tzresult = functio
error @@ unexpected expr [] Type_namespace
[ "int" ; "nat" ;
"string" ; "tez" ; "bool" ;
"key" ; "timestamp" ]
"key" ; "key_hash" ; "timestamp" ]
and parse_ty : Script.expr -> ex_ty tzresult = function
| 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 (_, "bool", [], _) -> ok (Ex_ty Bool_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 (_, "signature", [], _) -> ok (Ex_ty Signature_t)
| Prim (_, "contract", [ utl; utr ], _) ->
@ -547,7 +552,7 @@ and parse_ty : Script.expr -> ex_ty tzresult = function
| "unit" | "signature" | "contract"
| "int" | "nat"
| "string" | "tez" | "bool"
| "key" | "timestamp" as prim), l, _) ->
| "key" | "key_hash" | "timestamp" as prim), l, _) ->
error (Invalid_arity (loc, prim, 0, List.length l))
| expr ->
error @@ unexpected expr [] Type_namespace
@ -556,7 +561,7 @@ and parse_ty : Script.expr -> ex_ty tzresult = function
"unit" ; "signature" ; "contract" ;
"int" ; "nat" ;
"string" ; "tez" ; "bool" ;
"key" ; "timestamp" ]
"key" ; "key_hash" ; "timestamp" ]
let comparable_ty_of_ty
: type a. int -> a ty -> a comparable_ty tzresult
@ -566,7 +571,7 @@ let comparable_ty_of_ty
| String_t -> ok String_key
| Tez_t -> ok Tez_key
| Bool_t -> ok Bool_key
| Key_t -> ok Key_key
| Key_hash_t -> ok Key_hash_key
| Timestamp_t -> ok Timestamp_key
| ty -> error (Comparable_type_expected (loc, ty))
@ -646,12 +651,21 @@ let rec parse_data
| Timestamp_t, expr ->
traced (fail (Invalid_kind (location expr, [ String_kind ; Int_kind ], kind expr)))
(* IDs *)
| Key_t, String (_, s) -> begin try
return (Ed25519.Public_key_hash.of_b58check_exn s)
with _ -> fail (error ())
end
| Key_t, String (_, s) ->
begin
try
return (Ed25519.Public_key.of_b58check_exn s)
with _ -> fail (error ())
end
| Key_t, 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 *)
| Signature_t, String (_, s) -> begin try
match Data_encoding.Binary.of_bytes
@ -1210,8 +1224,8 @@ and parse_instr
Item_t (Tez_t, Item_t (Tez_t, rest)) ->
return (typed loc annot (Compare Tez_key, Item_t (Int_t, rest)))
| Prim (loc, "COMPARE", [], annot),
Item_t (Key_t, Item_t (Key_t, rest)) ->
return (typed loc annot (Compare Key_key, Item_t (Int_t, rest)))
Item_t (Key_hash_t, Item_t (Key_hash_t, rest)) ->
return (typed loc annot (Compare Key_hash_key, Item_t (Int_t, rest)))
| Prim (loc, "COMPARE", [], annot),
Item_t (Timestamp_t, Item_t (Timestamp_t, rest)) ->
return (typed loc annot (Compare Timestamp_key, Item_t (Int_t, rest)))
@ -1237,7 +1251,7 @@ and parse_instr
(* protocol *)
| Prim (loc, "MANAGER", [], annot),
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),
Item_t (p, Item_t
(Tez_t, Item_t
@ -1254,20 +1268,20 @@ and parse_instr
end
| Prim (loc, "CREATE_ACCOUNT", [], annot),
Item_t
(Key_t, Item_t
(Option_t Key_t, Item_t
(Key_hash_t, Item_t
(Option_t Key_hash_t, Item_t
(Bool_t, Item_t
(Tez_t, rest)))) ->
return (typed loc annot (Create_account,
Item_t (Contract_t (Unit_t, Unit_t), rest)))
| Prim (loc, "DEFAULT_ACCOUNT", [], annot),
Item_t (Key_t, rest) ->
Item_t (Key_hash_t, rest) ->
return
(typed loc annot (Default_account, Item_t (Contract_t (Unit_t, Unit_t), rest)))
| Prim (loc, "CREATE_CONTRACT", [], annot),
Item_t
(Key_t, Item_t
(Option_t Key_t, Item_t
(Key_hash_t, Item_t
(Option_t Key_hash_t, Item_t
(Bool_t, Item_t
(Bool_t, Item_t
(Tez_t, Item_t
@ -1287,6 +1301,9 @@ and parse_instr
| Prim (loc, "BALANCE", [], annot),
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),
Item_t (Key_t, Item_t (Pair_t (Signature_t, String_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"
| "CREATE_CONTRACT" | "NOW"
| "DEFAULT_ACCOUNT" | "AMOUNT" | "BALANCE"
| "CHECK_SIGNATURE" | "H" | "STEPS_TO_QUOTA"
| "CHECK_SIGNATURE" | "HASH_KEY"
| "H" | "STEPS_TO_QUOTA"
as name), (_ :: _ as l), _), _ ->
fail (Invalid_arity (loc, name, 0, List.length l))
| Prim (loc, ("NONE" | "LEFT" | "RIGHT" | "NIL"
@ -1383,7 +1401,8 @@ and parse_instr
"LT" ; "GT" ; "LE" ; "GE" ;
"MANAGER" ; "TRANSFER_TOKENS" ; "CREATE_ACCOUNT" ;
"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" ;
"EMPTY_SET" ; "DIP" ; "LOOP" ;
"IF_NONE" ; "IF_LEFT" ; "IF_CONS" ;
@ -1508,6 +1527,7 @@ let type_map descr =
| String_t, _ -> acc
| Tez_t, _ -> acc
| Key_t, _ -> acc
| Key_hash_t, _ -> acc
| Timestamp_t, _ -> acc
| Bool_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
| Tez_key : Tez.t 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
module type Boxed_set = sig
@ -66,7 +66,8 @@ and 'ty ty =
| Signature_t : signature ty
| String_t : string 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
| Bool_t : bool ty
| Pair_t : 'a ty * 'b ty -> ('a, 'b) pair ty
@ -298,7 +299,9 @@ and ('bef, 'aft) instr =
| Balance :
('rest, Tez.t * 'rest) instr
| 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 ->
('a * 'rest, string * 'rest) instr
| 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;
storage (pair signature string);
return bool;
code {DUP; DUP; DIP{CDR; DUP; CAR; DIP{CDR; H}; PAIR};
CAR; CHECK_SIGNATURE; DIP{CDR}; PAIR};
code { DUP; DUP;
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;
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};

22
test/contracts/create_contract.tz
View File

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

2
test/contracts/default_account.tz
View File

@ -1,4 +1,4 @@
parameter key;
parameter key_hash;
return unit;
storage unit;
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
{ PUSH tez "5.00" ;
PUSH bool True ; # delegatable
NONE key ; # delegate
PUSH key "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager
NONE key_hash ; # delegate
PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager
CREATE_ACCOUNT ;
SWAP ; DIP { CONS } ;
PUSH nat 1 ; SWAP ; SUB ;
PUSH nat 1 ; SWAP ; SUB ; ABS ;
DUP ; PUSH nat 0 ; CMPNEQ } ;
DROP ;
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)
assert_output $CONTRACT_PATH/check_signature.tz \
'(Pair "26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309" "hello")' \
'"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' True
'"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' True
assert_output $CONTRACT_PATH/check_signature.tz \
'(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 2000 from bootstrap1 to $key2