diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml index 4581d916c..4af8da92d 100644 --- a/src/passes/4-typer-new/typer.ml +++ b/src/passes/4-typer-new/typer.ml @@ -438,6 +438,9 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e | E_literal (Literal_key s) -> ( return_wrapped (e_key s) state @@ Wrap.literal (t_key ()) ) + | E_literal (Literal_key_hash s) -> ( + return_wrapped (e_key_hash s) state @@ Wrap.literal (t_key_hash ()) + ) | E_literal (Literal_chain_id s) -> ( return_wrapped (e_chain_id s) state @@ Wrap.literal (t_chain_id ()) ) @@ -1010,6 +1013,7 @@ let untype_literal (l:O.literal) : I.literal result = | Literal_int n -> ok (Literal_int n) | Literal_string s -> ok (Literal_string s) | Literal_key s -> ok (Literal_key s) + | Literal_key_hash s -> ok (Literal_key_hash s) | Literal_chain_id s -> ok (Literal_chain_id s) | Literal_signature s -> ok (Literal_signature s) | Literal_bytes b -> ok (Literal_bytes b) diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml index 89f92ec76..b5aed38d9 100644 --- a/src/passes/4-typer-old/typer.ml +++ b/src/passes/4-typer-old/typer.ml @@ -406,6 +406,8 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O. return (E_literal (Literal_string s)) (t_string ()) | E_literal (Literal_key s) -> return (E_literal (Literal_key s)) (t_key ()) + | E_literal (Literal_key_hash s) -> + return (E_literal (Literal_key_hash s)) (t_key_hash ()) | E_literal (Literal_chain_id s) -> return (E_literal (Literal_chain_id s)) (t_chain_id ()) | E_literal (Literal_signature s) -> @@ -816,6 +818,7 @@ let untype_literal (l:O.literal) : I.literal result = | Literal_string s -> ok (Literal_string s) | Literal_signature s -> ok (Literal_signature s) | Literal_key s -> ok (Literal_key s) + | Literal_key_hash s -> ok (Literal_key_hash s) | Literal_chain_id s -> ok (Literal_chain_id s) | Literal_bytes b -> ok (Literal_bytes b) | Literal_address s -> ok (Literal_address s) diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index 6bf94ca27..521d531fa 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -130,6 +130,7 @@ let rec transpile_type (t:AST.type_value) : type_value result = | T_constant (Type_name "unit", []) -> ok (T_base Base_unit) | T_constant (Type_name "operation", []) -> ok (T_base Base_operation) | T_constant (Type_name "signature", []) -> ok (T_base Base_signature) + | T_constant (Type_name "key_hash", []) -> ok (T_base Base_key_hash) | T_constant (Type_name "key", []) -> ok (T_base Base_key) | T_constant (Type_name "chain_id", []) -> ok (T_base Base_chain_id) | T_constant (Type_name "contract", [x]) -> @@ -241,6 +242,7 @@ let rec transpile_literal : AST.literal -> value = fun l -> match l with | Literal_address s -> D_string s | Literal_signature s -> D_string s | Literal_key s -> D_string s + | Literal_key_hash s -> D_string s | Literal_chain_id s -> D_string s | Literal_operation op -> D_operation op | Literal_unit -> D_unit diff --git a/src/passes/6-transpiler/untranspiler.ml b/src/passes/6-transpiler/untranspiler.ml index e8fd27683..2ebe2ac1f 100644 --- a/src/passes/6-transpiler/untranspiler.ml +++ b/src/passes/6-transpiler/untranspiler.ml @@ -156,6 +156,12 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression get_string v in return (E_literal (Literal_key n)) ) + | T_constant (Type_name "key_hash", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "key_hash" v) @@ + get_string v in + return (E_literal (Literal_key_hash n)) + ) | T_constant (Type_name "chain_id", []) -> ( let%bind n = trace_strong (wrong_mini_c_value "chain_id" v) @@ diff --git a/src/passes/8-compiler/compiler_type.ml b/src/passes/8-compiler/compiler_type.ml index bef509a45..a9380e5de 100644 --- a/src/passes/8-compiler/compiler_type.ml +++ b/src/passes/8-compiler/compiler_type.ml @@ -32,6 +32,7 @@ module Ty = struct let mutez = Mutez_t None let string = String_t None let key = Key_t None + let key_hash = Key_hash_t None let chain_id = Chain_id_t None let list a = List_t (a, None , has_big_map a) let set a = Set_t (a, None) @@ -71,6 +72,7 @@ module Ty = struct | Base_operation -> fail (not_comparable "operation") | Base_signature -> fail (not_comparable "signature") | Base_key -> fail (not_comparable "key") + | Base_key_hash -> fail (not_comparable "key_hash") | Base_chain_id -> fail (not_comparable "chain_id") let comparable_type : type_value -> ex_comparable_ty result = fun tv -> @@ -88,7 +90,7 @@ module Ty = struct let base_type : type_base -> ex_ty result = fun b -> let return x = ok @@ Ex_ty x in - match b with + match b with | Base_unit -> return unit | Base_void -> fail (not_compilable_type "void") | Base_bool -> return bool @@ -102,6 +104,7 @@ module Ty = struct | Base_operation -> return operation | Base_signature -> return signature | Base_key -> return key + | Base_key_hash -> return key_hash | Base_chain_id -> return chain_id let rec type_ : type_value -> ex_ty result = @@ -186,6 +189,7 @@ let base_type : type_base -> O.michelson result = | Base_operation -> ok @@ O.prim T_operation | Base_signature -> ok @@ O.prim T_signature | Base_key -> ok @@ O.prim T_key + | Base_key_hash -> ok @@ O.prim T_key_hash | Base_chain_id -> ok @@ O.prim T_chain_id let rec type_ : type_value -> O.michelson result = diff --git a/src/passes/8-compiler/uncompiler.ml b/src/passes/8-compiler/uncompiler.ml index 5440ac92a..44763e23e 100644 --- a/src/passes/8-compiler/uncompiler.ml +++ b/src/passes/8-compiler/uncompiler.ml @@ -36,12 +36,10 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result = (Tezos_base__TzPervasives.Chain_id.b58check_encoding) id in ok @@ D_string str + | (Key_hash_t _ ), n -> + ok @@ D_string (Signature.Public_key_hash.to_b58check n) | (Key_t _ ), n -> - let%bind s = match n with - | Ed25519 x -> ok @@ TP.Base58.simple_encode (TP.Ed25519.Public_key.b58check_encoding) x - | Secp256k1 x -> ok @@ TP.Base58.simple_encode (TP.Secp256k1.Public_key.b58check_encoding) x - | P256 x -> ok @@ TP.Base58.simple_encode (TP.P256.Public_key.b58check_encoding) x in - ok @@ D_string s + ok @@ D_string (Signature.Public_key.to_b58check n) | (Timestamp_t _), n -> let n = Z.to_int @@ diff --git a/src/passes/operators/helpers.ml b/src/passes/operators/helpers.ml index 28b6fb20e..edcf6a6c0 100644 --- a/src/passes/operators/helpers.ml +++ b/src/passes/operators/helpers.ml @@ -127,6 +127,7 @@ module Typer = struct t_bytes () ; t_address () ; t_timestamp () ; + t_key_hash () ; ] in ok @@ t_bool () diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 2d4b20646..956b8e6ed 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -80,6 +80,7 @@ module Simplify = struct ("string_concat" , "CONCAT") ; ("string_slice" , "SLICE") ; ("crypto_check", "CHECK_SIGNATURE") ; + ("crypto_hash_key", "HASH_KEY") ; ("bytes_concat" , "CONCAT") ; ("bytes_slice" , "SLICE") ; ("bytes_pack" , "PACK") ; diff --git a/src/stages/ast_simplified/PP.ml b/src/stages/ast_simplified/PP.ml index a17b93c61..4368af56c 100644 --- a/src/stages/ast_simplified/PP.ml +++ b/src/stages/ast_simplified/PP.ml @@ -31,6 +31,7 @@ let literal ppf (l:literal) = match l with | Literal_address s -> fprintf ppf "@%S" s | Literal_signature s -> fprintf ppf "@%S" s | Literal_key s -> fprintf ppf "@%S" s + | Literal_key_hash s -> fprintf ppf "@%S" s | Literal_chain_id s -> fprintf ppf "@%S" s | Literal_operation _ -> fprintf ppf "Operation(...bytes)" diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml index 86ce9aee5..ddcb1952b 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/src/stages/ast_simplified/combinators.ml @@ -26,6 +26,7 @@ let t_unit : type_expression = T_constant ("unit", []) let t_address : type_expression = T_constant ("address", []) let t_signature : type_expression = T_constant ("signature", []) let t_key : type_expression = T_constant ("key", []) +let t_key_hash : type_expression = T_constant ("key_hash", []) let t_option o : type_expression = T_constant ("option", [o]) let t_list t : type_expression = T_constant ("list", [t]) let t_variable n : type_expression = T_variable n @@ -66,6 +67,7 @@ let e_address ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_add let e_mutez ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_mutez s) let e_signature ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_signature s) let e_key ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_key s) +let e_key_hash ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_key_hash s) let e_chain_id ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_chain_id s) let e'_bytes b : expression' result = let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in diff --git a/src/stages/ast_simplified/combinators.mli b/src/stages/ast_simplified/combinators.mli index 9e8761e1d..4ae1bb89b 100644 --- a/src/stages/ast_simplified/combinators.mli +++ b/src/stages/ast_simplified/combinators.mli @@ -18,7 +18,8 @@ val t_nat : type_expression val t_tez : type_expression val t_unit : type_expression val t_address : type_expression -val t_key : type_expression +val t_key : type_expression +val t_key_hash : type_expression val t_signature : type_expression (* val t_option : type_expression -> type_expression @@ -55,6 +56,7 @@ val e_string : ?loc:Location.t -> string -> expression val e_address : ?loc:Location.t -> string -> expression val e_signature : ?loc:Location.t -> string -> expression val e_key : ?loc:Location.t -> string -> expression +val e_key_hash : ?loc:Location.t -> string -> expression val e_chain_id : ?loc:Location.t -> string -> expression val e_mutez : ?loc:Location.t -> int -> expression val e'_bytes : string -> expression' result diff --git a/src/stages/ast_simplified/misc.ml b/src/stages/ast_simplified/misc.ml index 5969d4732..f59cbdb4f 100644 --- a/src/stages/ast_simplified/misc.ml +++ b/src/stages/ast_simplified/misc.ml @@ -67,6 +67,9 @@ let assert_literal_eq (a, b : literal * literal) : unit result = | Literal_key a, Literal_key b when a = b -> ok () | Literal_key _, Literal_key _ -> fail @@ different_literals "different key" a b | Literal_key _, _ -> fail @@ different_literals_because_different_types "key vs non-key" a b + | Literal_key_hash a, Literal_key_hash b when a = b -> ok () + | Literal_key_hash _, Literal_key_hash _ -> fail @@ different_literals "different key_hash" a b + | Literal_key_hash _, _ -> fail @@ different_literals_because_different_types "key_hash vs non-key_hash" a b | Literal_chain_id a, Literal_chain_id b when a = b -> ok () | Literal_chain_id _, Literal_chain_id _ -> fail @@ different_literals "different chain_id" a b | Literal_chain_id _, _ -> fail @@ different_literals_because_different_types "chain_id vs non-chain_id" a b diff --git a/src/stages/ast_simplified/types.ml b/src/stages/ast_simplified/types.ml index 185d23b23..17c9ac5f0 100644 --- a/src/stages/ast_simplified/types.ml +++ b/src/stages/ast_simplified/types.ml @@ -97,6 +97,7 @@ and literal = | Literal_timestamp of int | Literal_signature of string | Literal_key of string + | Literal_key_hash of string | Literal_chain_id of string | Literal_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation diff --git a/src/stages/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml index 5fdf5e849..4b97a9f2c 100644 --- a/src/stages/ast_typed/PP.ml +++ b/src/stages/ast_typed/PP.ml @@ -76,6 +76,7 @@ and literal ppf (l:literal) : unit = | Literal_address s -> fprintf ppf "@%s" s | Literal_signature s -> fprintf ppf "@%s" s | Literal_key s -> fprintf ppf "@%s" s + | Literal_key_hash s -> fprintf ppf "@%s" s | Literal_operation _ -> fprintf ppf "Operation(...bytes)" | Literal_chain_id s -> fprintf ppf "@%s" s diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml index d32edf170..038c0f226 100644 --- a/src/stages/ast_typed/combinators.ml +++ b/src/stages/ast_typed/combinators.ml @@ -246,6 +246,7 @@ let e_timestamp s : expression = E_literal (Literal_timestamp s) let e_address s : expression = E_literal (Literal_address s) let e_signature s : expression = E_literal (Literal_signature s) let e_key s : expression = E_literal (Literal_key s) +let e_key_hash s : expression = E_literal (Literal_key_hash s) let e_chain_id s : expression = E_literal (Literal_chain_id s) let e_operation s : expression = E_literal (Literal_operation s) let e_lambda l : expression = E_lambda l diff --git a/src/stages/ast_typed/combinators.mli b/src/stages/ast_typed/combinators.mli index 12b84f779..943470012 100644 --- a/src/stages/ast_typed/combinators.mli +++ b/src/stages/ast_typed/combinators.mli @@ -123,6 +123,7 @@ val e_timestamp : int -> expression val e_address : string -> expression val e_signature : string -> expression val e_key : string -> expression +val e_key_hash : string -> expression val e_chain_id : string -> expression val e_operation : Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation -> expression val e_lambda : lambda -> expression diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index f315d9af2..ebb193ebf 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -386,6 +386,9 @@ let assert_literal_eq (a, b : literal * literal) : unit result = | Literal_key a, Literal_key b when a = b -> ok () | Literal_key _, Literal_key _ -> fail @@ different_literals "different key" a b | Literal_key _, _ -> fail @@ different_literals_because_different_types "key vs non-key" a b + | Literal_key_hash a, Literal_key_hash b when a = b -> ok () + | Literal_key_hash _, Literal_key_hash _ -> fail @@ different_literals "different key_hash" a b + | Literal_key_hash _, _ -> fail @@ different_literals_because_different_types "key_hash vs non-key_hash" a b | Literal_chain_id a, Literal_chain_id b when a = b -> ok () | Literal_chain_id _, Literal_chain_id _ -> fail @@ different_literals "different chain_id" a b | Literal_chain_id _, _ -> fail @@ different_literals_because_different_types "chain_id vs non-chain_id" a b diff --git a/src/stages/ast_typed/types.ml b/src/stages/ast_typed/types.ml index 4615f156a..4843b2f33 100644 --- a/src/stages/ast_typed/types.ml +++ b/src/stages/ast_typed/types.ml @@ -128,6 +128,7 @@ and literal = | Literal_address of string | Literal_signature of string | Literal_key of string + | Literal_key_hash of string | Literal_chain_id of string | Literal_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index 62b7bec2a..c3db61cb5 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -22,6 +22,7 @@ let type_base ppf : type_base -> _ = function | Base_operation -> fprintf ppf "operation" | Base_signature -> fprintf ppf "signature" | Base_key -> fprintf ppf "key" + | Base_key_hash -> fprintf ppf "key_hash" | Base_chain_id -> fprintf ppf "chain_id" let rec type_ ppf : type_value -> _ = function diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index c109fc525..ec4f043e3 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -7,7 +7,7 @@ type type_base = | Base_timestamp | Base_string | Base_bytes | Base_address | Base_key | Base_operation | Base_signature - | Base_chain_id + | Base_chain_id | Base_key_hash type 'a annotated = string option * 'a diff --git a/src/stages/typesystem/misc.ml b/src/stages/typesystem/misc.ml index 96f6c472f..62b14c9a2 100644 --- a/src/stages/typesystem/misc.ml +++ b/src/stages/typesystem/misc.ml @@ -103,6 +103,7 @@ module Substitution = struct | (T.Literal_address _ as x) | (T.Literal_signature _ as x) | (T.Literal_key _ as x) + | (T.Literal_key_hash _ as x) | (T.Literal_chain_id _ as x) | (T.Literal_operation _ as x) -> ok @@ x diff --git a/src/test/contracts/key_hash.ligo b/src/test/contracts/key_hash.ligo new file mode 100644 index 000000000..38b72366a --- /dev/null +++ b/src/test/contracts/key_hash.ligo @@ -0,0 +1,5 @@ +function check_hash_key (const kh1 : key_hash; const k2 : key) : bool*key_hash is block { + var ret : bool := False ; + var kh2 : key_hash := crypto_hash_key(k2) ; + if kh1 = kh2 then ret := True else skip; +} with (ret, kh2) \ No newline at end of file diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index a6f79b7ee..3217642e9 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1277,7 +1277,19 @@ let chain_id () : unit result = let%bind () = expect_eq program "get_chain_id" make_input make_expected in ok () +let key_hash () : unit result = + let open Tezos_crypto in + let (raw_pkh,raw_pk,_) = Signature.generate_key () in + let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh in + let pk_str = Signature.Public_key.to_b58check raw_pk in + let%bind program = type_file "./contracts/key_hash.ligo" in + let make_input = e_pair (e_key_hash pkh_str) (e_key pk_str) in + let make_expected = e_pair (e_bool true) (e_key_hash pkh_str) in + let%bind () = expect_eq program "check_hash_key" make_input make_expected in + ok () + let main = test_suite "Integration (End to End)" [ + test "key hash" key_hash ; test "chain id" chain_id ; test "type alias" type_alias ; test "function" function_ ;