Michelson: adds key_hash type

src/proto/alpha/docs/language.md

@@ -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
+      | INT
-      | CHECKED_ABS
-      | CHECKED_NEG
-      | CHECKED_ADD
-      | CHECKED_SUB
-      | CHECKED_MUL
-      | CHECKED_CAST
-      | FLOOR
-      | CEIL
-      | INF
-      | NAN
-      | ISNAN
-      | NANAN
       | 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

src/proto/alpha/script_interpreter.ml

@@ -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)

src/proto/alpha/script_ir_translator.ml

@@ -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
+    | Key_t, String (_, s) ->
-          return (Ed25519.Public_key_hash.of_b58check_exn 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)) ->
+      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),
       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
+        (Key_hash_t, Item_t
-           (Option_t Key_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
+        (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, 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

src/proto/alpha/script_typed_ir.ml

@@ -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 *)

test/contracts/check_signature.tz

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

test/contracts/create_account.tz

@@ -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};

test/contracts/create_contract.tz

@@ -1,13 +1,13 @@
-parameter key;
+parameter key_hash;
 storage string;
 return unit;
 code {CAR;
       DIP{UNIT;
-             LAMBDA
+          LAMBDA (pair string unit)
-               (pair string unit) (pair string unit)
+                 (pair string unit)
                  {CAR; UNIT; SWAP; PAIR};
           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";
       PUSH string "abcdefg"; TRANSFER_TOKENS;
-       DIP { DROP }; UNIT; PAIR }
+      DIP{DROP}; UNIT; PAIR};

test/contracts/default_account.tz

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

test/contracts/hash_key.tz

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

test/contracts/originator.tz

@@ -7,11 +7,11 @@ code
     LOOP
       { PUSH tez "5.00" ;
         PUSH bool True ; # delegatable
-        NONE key ; # delegate
+        NONE key_hash ; # delegate
-        PUSH key "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager
+        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 }

test/test_contracts.sh

@@ -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