From 2fa78bd0bd13d59c7aae2db2df8a56bada764b8d Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 19 Nov 2019 15:12:58 +0100 Subject: [PATCH 1/8] add key and signature types --- src/passes/4-typer-new/typer.ml | 8 ++++++++ src/passes/4-typer-old/typer.ml | 6 ++++++ src/passes/6-transpiler/transpiler.ml | 3 +++ src/passes/6-transpiler/untranspiler.ml | 6 ++++++ src/passes/8-compiler/compiler_type.ml | 3 +++ src/passes/8-compiler/uncompiler.ml | 6 ++++++ src/stages/ast_simplified/PP.ml | 2 ++ src/stages/ast_simplified/combinators.ml | 4 ++++ src/stages/ast_simplified/combinators.mli | 4 ++++ src/stages/ast_simplified/misc.ml | 6 ++++++ src/stages/ast_simplified/types.ml | 2 ++ src/stages/ast_typed/PP.ml | 2 ++ src/stages/ast_typed/combinators.ml | 3 +++ src/stages/ast_typed/combinators.mli | 3 +++ src/stages/ast_typed/misc.ml | 6 ++++++ src/stages/ast_typed/types.ml | 2 ++ src/stages/mini_c/PP.ml | 1 + src/stages/mini_c/types.ml | 2 +- src/stages/typesystem/misc.ml | 2 ++ 19 files changed, 70 insertions(+), 1 deletion(-) diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml index ad7edacf9..c281ec12d 100644 --- a/src/passes/4-typer-new/typer.ml +++ b/src/passes/4-typer-new/typer.ml @@ -432,6 +432,12 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e | E_literal (Literal_string s) -> ( return_wrapped (e_string s) state @@ Wrap.literal (t_string ()) ) + | E_literal (Literal_signature s) -> ( + return_wrapped (e_signature s) state @@ Wrap.literal (t_signature ()) + ) + | E_literal (Literal_key s) -> ( + return_wrapped (e_key s) state @@ Wrap.literal (t_key ()) + ) | E_literal (Literal_bytes b) -> ( return_wrapped (e_bytes b) state @@ Wrap.literal (t_bytes ()) ) @@ -1000,6 +1006,8 @@ let untype_literal (l:O.literal) : I.literal result = | Literal_mutez n -> ok (Literal_mutez n) | Literal_int n -> ok (Literal_int n) | Literal_string s -> ok (Literal_string s) + | Literal_key s -> ok (Literal_key s) + | Literal_signature s -> ok (Literal_signature s) | Literal_bytes b -> ok (Literal_bytes b) | Literal_address s -> ok (Literal_address s) | Literal_operation s -> ok (Literal_operation s) diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml index e2b3aaecd..f5e4e89dd 100644 --- a/src/passes/4-typer-old/typer.ml +++ b/src/passes/4-typer-old/typer.ml @@ -404,6 +404,10 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O. return (E_literal (Literal_unit)) (t_unit ()) | E_literal (Literal_string s) -> return (E_literal (Literal_string s)) (t_string ()) + | E_literal (Literal_key s) -> + return (E_literal (Literal_key s)) (t_key ()) + | E_literal (Literal_signature s) -> + return (E_literal (Literal_signature s)) (t_signature ()) | E_literal (Literal_bytes s) -> return (E_literal (Literal_bytes s)) (t_bytes ()) | E_literal (Literal_int n) -> @@ -808,6 +812,8 @@ let untype_literal (l:O.literal) : I.literal result = | Literal_mutez n -> ok (Literal_mutez n) | Literal_int n -> ok (Literal_int n) | Literal_string s -> ok (Literal_string s) + | Literal_signature s -> ok (Literal_signature s) + | Literal_key s -> ok (Literal_key s) | Literal_bytes b -> ok (Literal_bytes b) | Literal_address s -> ok (Literal_address s) | Literal_operation s -> ok (Literal_operation s) diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index 8ddca53c9..aacd50e0d 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", []) -> ok (T_base Base_key) | T_constant (Type_name "contract", [x]) -> let%bind x' = transpile_type x in ok (T_contract x') @@ -237,6 +238,8 @@ let rec transpile_literal : AST.literal -> value = fun l -> match l with | Literal_bytes s -> D_bytes s | Literal_string s -> D_string s | Literal_address s -> D_string s + | Literal_signature s -> D_string s + | Literal_key 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 86b2964e2..70d2933c5 100644 --- a/src/passes/6-transpiler/untranspiler.ml +++ b/src/passes/6-transpiler/untranspiler.ml @@ -150,6 +150,12 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression bind_map_list aux lst in return (E_list lst') ) + | T_constant (Type_name "key", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "key" v) @@ + get_string v in + return (E_literal (Literal_key n)) + ) | T_constant (Type_name "set", [ty]) -> ( let%bind lst = trace_strong (wrong_mini_c_value "set" v) @@ diff --git a/src/passes/8-compiler/compiler_type.ml b/src/passes/8-compiler/compiler_type.ml index d87132b08..03754c03e 100644 --- a/src/passes/8-compiler/compiler_type.ml +++ b/src/passes/8-compiler/compiler_type.ml @@ -69,6 +69,7 @@ module Ty = struct | Base_bytes -> return bytes_k | Base_operation -> fail (not_comparable "operation") | Base_signature -> fail (not_comparable "signature") + | Base_key -> fail (not_comparable "key") let comparable_type : type_value -> ex_comparable_ty result = fun tv -> match tv with @@ -98,6 +99,7 @@ module Ty = struct | Base_bytes -> return bytes | Base_operation -> return operation | Base_signature -> return signature + | Base_key -> return key let rec type_ : type_value -> ex_ty result = function @@ -180,6 +182,7 @@ let base_type : type_base -> O.michelson result = | Base_bytes -> ok @@ O.prim T_bytes | Base_operation -> ok @@ O.prim T_operation | Base_signature -> ok @@ O.prim T_signature + | Base_key -> ok @@ O.prim T_key let rec type_ : type_value -> O.michelson result = function diff --git a/src/passes/8-compiler/uncompiler.ml b/src/passes/8-compiler/uncompiler.ml index ee5a45b96..62adefd48 100644 --- a/src/passes/8-compiler/uncompiler.ml +++ b/src/passes/8-compiler/uncompiler.ml @@ -31,6 +31,12 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result = trace_option (simple_error "too big to fit an int") @@ Alpha_context.Script_int.to_int n in ok @@ D_nat 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 | (Timestamp_t _), n -> let n = Z.to_int @@ diff --git a/src/stages/ast_simplified/PP.ml b/src/stages/ast_simplified/PP.ml index d69dff9ae..3a8101c12 100644 --- a/src/stages/ast_simplified/PP.ml +++ b/src/stages/ast_simplified/PP.ml @@ -29,6 +29,8 @@ let literal ppf (l:literal) = match l with | Literal_string s -> fprintf ppf "%S" s | Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b | Literal_address s -> fprintf ppf "@%S" s + | Literal_signature s -> fprintf ppf "@%S" s + | Literal_key s -> fprintf ppf "@%S" s | Literal_operation _ -> fprintf ppf "Operation(...bytes)" let rec expression ppf (e:expression) = match e.expression with diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml index 48bdbca08..21b2e570c 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/src/stages/ast_simplified/combinators.ml @@ -24,6 +24,8 @@ let t_nat : type_expression = T_constant ("nat", []) let t_tez : type_expression = T_constant ("tez", []) 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_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 @@ -62,6 +64,8 @@ let e_bool ?loc b : expression = location_wrap ?loc @@ E_literal (Literal_bool let e_string ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_string s) let e_address ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_address s) 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'_bytes b : expression' result = let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in ok @@ E_literal (Literal_bytes bytes) diff --git a/src/stages/ast_simplified/combinators.mli b/src/stages/ast_simplified/combinators.mli index 764b7ca16..beff41532 100644 --- a/src/stages/ast_simplified/combinators.mli +++ b/src/stages/ast_simplified/combinators.mli @@ -18,6 +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_signature : type_expression (* val t_option : type_expression -> type_expression *) @@ -51,6 +53,8 @@ val e_timestamp : ?loc:Location.t -> int -> expression val e_bool : ?loc:Location.t -> bool -> expression 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_mutez : ?loc:Location.t -> int -> expression val e'_bytes : string -> expression' result val e_bytes : ?loc:Location.t -> string -> expression result diff --git a/src/stages/ast_simplified/misc.ml b/src/stages/ast_simplified/misc.ml index 3f5ec705d..3e088906f 100644 --- a/src/stages/ast_simplified/misc.ml +++ b/src/stages/ast_simplified/misc.ml @@ -61,6 +61,12 @@ let assert_literal_eq (a, b : literal * literal) : unit result = | Literal_address _, _ -> fail @@ different_literals_because_different_types "address vs non-address" a b | Literal_operation _, Literal_operation _ -> fail @@ error_uncomparable_literals "can't compare operations" a b | Literal_operation _, _ -> fail @@ different_literals_because_different_types "operation vs non-operation" a b + | Literal_signature a, Literal_signature b when a = b -> ok () + | Literal_signature _, Literal_signature _ -> fail @@ different_literals "different signature" a b + | Literal_signature _, _ -> fail @@ different_literals_because_different_types "signature vs non-signature" a b + | 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 let rec assert_value_eq (a, b: (expression * expression )) : unit result = let error_content () = diff --git a/src/stages/ast_simplified/types.ml b/src/stages/ast_simplified/types.ml index 43302e44d..306998361 100644 --- a/src/stages/ast_simplified/types.ml +++ b/src/stages/ast_simplified/types.ml @@ -95,6 +95,8 @@ and literal = | Literal_bytes of bytes | Literal_address of string | Literal_timestamp of int + | Literal_signature of string + | Literal_key of string | Literal_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation and 'a matching = diff --git a/src/stages/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml index 930fba72b..1e0adc57f 100644 --- a/src/stages/ast_typed/PP.ml +++ b/src/stages/ast_typed/PP.ml @@ -74,6 +74,8 @@ and literal ppf (l:literal) : unit = | Literal_string s -> fprintf ppf "%s" s | Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b | Literal_address s -> fprintf ppf "@%s" s + | Literal_signature s -> fprintf ppf "@%s" s + | Literal_key s -> fprintf ppf "@%s" s | Literal_operation _ -> fprintf ppf "Operation(...bytes)" and single_record_patch ppf ((s, ae) : string * ae) = diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml index d2f562e47..252532542 100644 --- a/src/stages/ast_typed/combinators.ml +++ b/src/stages/ast_typed/combinators.ml @@ -16,6 +16,7 @@ let t_string ?s () : type_value = make_t (T_constant (Type_name "string", [])) s let t_bytes ?s () : type_value = make_t (T_constant (Type_name "bytes", [])) s let t_key ?s () : type_value = make_t (T_constant (Type_name "key", [])) s let t_key_hash ?s () : type_value = make_t (T_constant (Type_name "key_hash", [])) s +let t_signature ?s () : type_value = make_t (T_constant (Type_name "signature", [])) s let t_int ?s () : type_value = make_t (T_constant (Type_name "int", [])) s let t_address ?s () : type_value = make_t (T_constant (Type_name "address", [])) s let t_operation ?s () : type_value = make_t (T_constant (Type_name "operation", [])) s @@ -238,6 +239,8 @@ let e_string s : expression = E_literal (Literal_string s) let e_bytes s : expression = E_literal (Literal_bytes s) 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_operation s : expression = E_literal (Literal_operation s) let e_lambda l : expression = E_lambda l let e_pair a b : expression = E_tuple [a; b] diff --git a/src/stages/ast_typed/combinators.mli b/src/stages/ast_typed/combinators.mli index 518f96012..14cfcb52e 100644 --- a/src/stages/ast_typed/combinators.mli +++ b/src/stages/ast_typed/combinators.mli @@ -19,6 +19,7 @@ val t_int : ?s:S.type_expression -> unit -> type_value val t_nat : ?s:S.type_expression -> unit -> type_value val t_mutez : ?s:S.type_expression -> unit -> type_value val t_address : ?s:S.type_expression -> unit -> type_value +val t_signature : ?s:S.type_expression -> unit -> type_value val t_unit : ?s:S.type_expression -> unit -> type_value val t_option : type_value -> ?s:S.type_expression -> unit -> type_value val t_pair : type_value -> type_value -> ?s:S.type_expression -> unit -> type_value @@ -118,6 +119,8 @@ val e_string : string -> expression val e_bytes : bytes -> expression val e_timestamp : int -> expression val e_address : string -> expression +val e_signature : string -> expression +val e_key : string -> expression val e_operation : Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation -> expression val e_lambda : lambda -> expression val e_pair : value -> value -> expression diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index fe21ea7e7..4626ad6a3 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -380,6 +380,12 @@ let assert_literal_eq (a, b : literal * literal) : unit result = | Literal_address a, Literal_address b when a = b -> ok () | Literal_address _, Literal_address _ -> fail @@ different_literals "different addresss" a b | Literal_address _, _ -> fail @@ different_literals_because_different_types "address vs non-address" a b + | Literal_signature a, Literal_signature b when a = b -> ok () + | Literal_signature _, Literal_signature _ -> fail @@ different_literals "different signature" a b + | Literal_signature _, _ -> fail @@ different_literals_because_different_types "signature vs non-signature" a b + | 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_operation _, Literal_operation _ -> fail @@ error_uncomparable_literals "can't compare operations" a b | Literal_operation _, _ -> fail @@ different_literals_because_different_types "operation vs non-operation" a b diff --git a/src/stages/ast_typed/types.ml b/src/stages/ast_typed/types.ml index a818463f3..c4f23521e 100644 --- a/src/stages/ast_typed/types.ml +++ b/src/stages/ast_typed/types.ml @@ -126,6 +126,8 @@ and literal = | Literal_string of string | Literal_bytes of bytes | Literal_address of string + | Literal_signature of string + | Literal_key of string | Literal_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation and access = diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index 1fcf8479b..df06324f8 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -21,6 +21,7 @@ let type_base ppf : type_base -> _ = function | Base_bytes -> fprintf ppf "bytes" | Base_operation -> fprintf ppf "operation" | Base_signature -> fprintf ppf "signature" + | Base_key -> fprintf ppf "key" let rec type_ ppf : type_value -> _ = function | T_or(a, b) -> fprintf ppf "(%a) | (%a)" annotated a annotated b diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index 56259d152..d171d8f19 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -5,7 +5,7 @@ type type_base = | Base_bool | Base_int | Base_nat | Base_tez | Base_timestamp - | Base_string | Base_bytes | Base_address + | Base_string | Base_bytes | Base_address | Base_key | Base_operation | Base_signature type 'a annotated = string option * 'a diff --git a/src/stages/typesystem/misc.ml b/src/stages/typesystem/misc.ml index 9d64dc372..916e6d60a 100644 --- a/src/stages/typesystem/misc.ml +++ b/src/stages/typesystem/misc.ml @@ -101,6 +101,8 @@ module Substitution = struct | (T.Literal_string _ as x) | (T.Literal_bytes _ as x) | (T.Literal_address _ as x) + | (T.Literal_signature _ as x) + | (T.Literal_key _ as x) | (T.Literal_operation _ as x) -> ok @@ x and s_matching_expr ~v ~expr : T.matching_expr w = fun _ -> From edb1e3d6077016cb9e15a907e0bcc34fbbd85028 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 19 Nov 2019 15:34:13 +0100 Subject: [PATCH 2/8] add crypto_check function to pascaligo --- src/passes/operators/operators.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index e1bfb0417..b19d1724a 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -77,6 +77,7 @@ module Simplify = struct ("bitwise_xor" , "XOR") ; ("string_concat" , "CONCAT") ; ("string_slice" , "SLICE") ; + ("crypto_check", "CHECK_SIGNATURE") ; ("bytes_concat" , "CONCAT") ; ("bytes_slice" , "SLICE") ; ("bytes_pack" , "PACK") ; From beeba317d6b20db1a038cbc35530b9939c9ee9a7 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 19 Nov 2019 15:34:59 +0100 Subject: [PATCH 3/8] multisig contract --- src/test/contracts/multisig.ligo | 54 ++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 src/test/contracts/multisig.ligo diff --git a/src/test/contracts/multisig.ligo b/src/test/contracts/multisig.ligo new file mode 100644 index 000000000..31f42836f --- /dev/null +++ b/src/test/contracts/multisig.ligo @@ -0,0 +1,54 @@ +// storage type +type counter_t is nat +type threshold_t is nat +type authorized_keys_t is list(key) + +type storage_t is record + counter : counter_t ; + threshold : threshold_t ; + auth : authorized_keys_t ; +end + +// I/O types +type check_message_pt is record + counter : counter_t ; + message : (unit -> list(operation)) ; + signatures : list(signature) ; +end + +type contract_return_t is (list(operation) * storage_t) + +type entry_point_t is +| CheckMessage of check_message_pt + +function check_message (const param : check_message_pt; + const s : storage_t) : contract_return_t is block { + var message : (unit -> list(operation)) := param.message ; + + if param.counter =/= s.counter then + failwith ("Counters does not match") + else block { + var packed_msg : bytes := bytes_pack(message) ; + var valid : nat := 0n ; + + for sig in list param.signatures block { + var is_valid : bool := False ; + + for pk in list s.auth block { + if crypto_check(pk,sig,packed_msg) then is_valid := True + else skip; + }; + + if is_valid then valid := valid + 1n + else failwith ("Invalid signature") + }; + if valid < s.threshold then + failwith ("Not enough signatures passed the check") + else s.counter := s.counter + 1n ; + } +} with (message(unit), s) + +function main(const param : entry_point_t; const s : storage_t) : contract_return_t is + case param of + | CheckMessage (p) -> check_message(p,s) +end \ No newline at end of file From 4edf58726ad3615d43ea1f244590f0e3e0e04339 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 19 Nov 2019 15:36:48 +0100 Subject: [PATCH 4/8] multisig tests --- src/main/run/of_simplified.ml | 8 ++ src/test/dune | 1 + src/test/multisig_tests.ml | 169 ++++++++++++++++++++++++++++++++++ src/test/test.ml | 1 + src/test/test_helpers.ml | 11 +++ 5 files changed, 190 insertions(+) create mode 100644 src/test/multisig_tests.ml diff --git a/src/main/run/of_simplified.ml b/src/main/run/of_simplified.ml index b022ed98b..561a94af8 100644 --- a/src/main/run/of_simplified.ml +++ b/src/main/run/of_simplified.ml @@ -35,3 +35,11 @@ let evaluate_typed_program_entry let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry in let%bind ex_ty_value = Of_michelson.evaluate ?options code in Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry ex_ty_value + +let compile_program + ?options + (program : Ast_typed.program) (entry : string) + : unit result = + let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry in + let%bind _ex_ty_value = Of_michelson.evaluate ?options code in + ok () \ No newline at end of file diff --git a/src/test/dune b/src/test/dune index dda46f5e8..8d32a8624 100644 --- a/src/test/dune +++ b/src/test/dune @@ -4,6 +4,7 @@ simple-utils ligo alcotest + tezos-crypto ) (preprocess (pps ppx_let) diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml new file mode 100644 index 000000000..7c38899a5 --- /dev/null +++ b/src/test/multisig_tests.ml @@ -0,0 +1,169 @@ +open Trace +open Test_helpers + +let type_file = Ligo.Compile.Of_source.type_file (Syntax_name "pascaligo") + +let get_program = + let s = ref None in + fun () -> match !s with + | Some s -> ok s + | None -> ( + let%bind program = type_file "./contracts/multisig.ligo" in + s := Some program ; + ok program + ) + +let compile_main () = + let%bind program,_ = get_program () in + let%bind () = + Ligo.Run.Of_simplified.compile_program + program "main" in + ok () + +open Ast_simplified + +let gen_keys = fun () -> + let open Tezos_crypto in + let (_,raw_pk,raw_sk) = Ed25519.generate_key () in + (raw_pk,raw_sk) + +let str_keys (raw_pk, raw_sk) = + let open Tezos_crypto in + let (pk_str:string) = Base58.simple_encode (Ed25519.Public_key.b58check_encoding) raw_pk in + let (sk_str:string) = Base58.simple_encode (Ed25519.Secret_key.b58check_encoding) raw_sk in + (pk_str,sk_str) + +let sign_message (msg : expression) raw_sk : string result = + let open Tezos_crypto in + let (sk : Signature.secret_key) = Signature.Ed25519 raw_sk in + let%bind program,_ = get_program () in + let%bind (msg : Tezos_utils.Michelson.michelson) = + let env = Ast_typed.program_environment program in + Ligo.Run.Of_simplified.compile_expression ~env ~state:(Typer.Solver.initial_state) msg + in + let%bind msg' = Ligo.Run.Of_michelson.pack_message_lambda msg in + let (signed_data:Signature.t) = Signature.sign sk msg' in + let signature_str = Signature.to_b58check signed_data in + ok signature_str + +let init_storage threshold counter pkeys = + let keys = List.map (fun el -> e_key @@ fst @@ str_keys el) pkeys in + ez_e_record [ + ("counter" , e_nat counter ) ; + ("threshold" , e_nat threshold) ; + ("auth" , e_typed_list keys t_key ) ; + ] + +let empty_op_list = + (e_typed_list [] t_operation) +let empty_message = e_lambda "arguments" + (Some t_unit) (Some (t_list t_operation)) + empty_op_list + +(* sign the same message 'msg' with the secret keys of 'keys' *) +let params counter msg keys = + let aux = fun acc sk -> + let%bind signature = sign_message msg (snd sk) in + ok @@ (e_signature signature)::acc in + let%bind signed_msgs = Trace.bind_fold_list aux [] keys in + ok @@ e_constructor + "CheckMessage" + (ez_e_record [ + ("counter" , e_nat counter ) ; + ("message" , msg) ; + ("signatures" , e_typed_list signed_msgs t_signature ) ; + ]) + + +(* Provide one valid signature when the threshold is two of two keys *) +let not_enough_1_of_2 () = + let%bind program,_ = get_program () in + let exp_failwith = "Not enough signatures passed the check" in + let keys = gen_keys () in + let%bind test_params = params 0 empty_message [keys] in + let%bind () = expect_string_failwith + program "main" (e_pair test_params (init_storage 2 0 [keys;gen_keys()])) exp_failwith in + ok () + +let unmatching_counter () = + let%bind program,_ = get_program () in + let exp_failwith = "Counters does not match" in + let keys = gen_keys () in + let%bind test_params = params 1 empty_message [keys] in + let%bind () = expect_string_failwith + program "main" (e_pair test_params (init_storage 1 0 [keys])) exp_failwith in + ok () + +(* Provide one invalid signature when the threshold is one of one key *) +let invalid_1_of_1 () = + let%bind program,_ = get_program () in + let exp_failwith = "Invalid signature" in + let keys = gen_keys () in + let invalid_keys = gen_keys () in + let%bind test_params = params 0 empty_message [keys] in + let%bind () = expect_string_failwith + program "main" (e_pair test_params (init_storage 1 0 [invalid_keys])) exp_failwith in + ok () + +(* Provide one valid signature when the threshold is one of one key *) +let valid_1_of_1 () = + let%bind program,_ = get_program () in + let keys = gen_keys () in + let%bind () = expect_eq_n_trace_aux [0;1;2] program "main" + (fun n -> + let%bind params = params n empty_message [keys] in + ok @@ e_pair params (init_storage 1 n [keys]) + ) + (fun n -> + ok @@ e_pair empty_op_list (init_storage 1 (n+1) [keys]) + ) in + ok () + +(* Provive two valid signatures when the threshold is two of three keys *) +let valid_2_of_3 () = + let%bind program,_ = get_program () in + let keys = [gen_keys (); gen_keys ()] in + let st_keys = gen_keys() :: keys in + let%bind () = expect_eq_n_trace_aux [0;1;2] program "main" + (fun n -> + let%bind params = params n empty_message keys in + ok @@ e_pair params (init_storage 2 n st_keys) + ) + (fun n -> + ok @@ e_pair empty_op_list (init_storage 2 (n+1) st_keys) + ) in + ok () + +(* Provide one invalid signature and two valid signatures when the threshold is two of three keys *) +let invalid_3_of_2 () = + let%bind program,_ = get_program () in + let valid_keys = [gen_keys() ; gen_keys()] in + let invalid_key = gen_keys () in + let st_keys = gen_keys () :: valid_keys in + let%bind test_params = params 0 empty_message (invalid_key::valid_keys) in + let exp_failwith = "Invalid signature" in + let%bind () = expect_string_failwith + program "main" (e_pair test_params (init_storage 2 0 st_keys)) exp_failwith in + ok () + +(* Provide two valid signatures when the threshold is three of three keys *) +let not_enough_2_of_3 () = + let%bind program,_ = get_program () in + let valid_keys = [gen_keys() ; gen_keys()] in + let st_keys = gen_keys () :: valid_keys in + let%bind test_params = params 0 empty_message (valid_keys) in + let exp_failwith = "Not enough signatures passed the check" in + let%bind () = expect_string_failwith + program "main" (e_pair test_params (init_storage 3 0 st_keys)) exp_failwith in + ok () + +let main = test_suite "Multisig" [ + test "compile" compile_main ; + test "unmatching_counter" unmatching_counter ; + test "valid_1_of_1" valid_1_of_1 ; + test "invalid_1_of_1" invalid_1_of_1 ; + test "not_enough_signature" not_enough_1_of_2 ; + test "valid_2_of_3" valid_2_of_3 ; + test "invalid_3_of_3" invalid_3_of_2 ; + test "not_enough_2_of_3" not_enough_2_of_3 ; + ] diff --git a/src/test/test.ml b/src/test/test.ml index 40969bd45..bf1c26dfa 100644 --- a/src/test/test.ml +++ b/src/test/test.ml @@ -11,6 +11,7 @@ let () = Heap_tests.main ; Coase_tests.main ; Vote_tests.main ; + Multisig_tests.main ; Bin_tests.main ; ] ; () diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 0fc77fca9..cedef0e4e 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -95,6 +95,17 @@ let expect_n_aux ?options lst program entry_point make_input make_expecter = let%bind _ = bind_map_list aux lst in ok () +let expect_eq_n_trace_aux ?options lst program entry_point make_input make_expected = + let aux n = + let%bind input = make_input n in + let%bind expected = make_expected n in + trace (simple_error ("expect_eq_n " ^ (string_of_int n))) @@ + let result = expect_eq ?options program entry_point input expected in + result + in + let%bind _ = bind_map_list_seq aux lst in + ok () + let expect_eq_n_aux ?options lst program entry_point make_input make_expected = let aux n = let input = make_input n in From 1185b8abda7f48fdd6926591ec24d127ffdca4df Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Wed, 20 Nov 2019 15:01:04 +0100 Subject: [PATCH 5/8] add chain_id type and operator --- src/main/run/of_michelson.ml | 6 +++++- src/passes/4-typer-new/typer.ml | 4 ++++ src/passes/4-typer-old/typer.ml | 3 +++ src/passes/6-transpiler/transpiler.ml | 2 ++ src/passes/6-transpiler/untranspiler.ml | 6 ++++++ src/passes/8-compiler/compiler_type.ml | 4 ++++ src/passes/8-compiler/uncompiler.ml | 5 +++++ src/passes/operators/operators.ml | 13 ++++++++++--- src/stages/ast_simplified/PP.ml | 1 + src/stages/ast_simplified/combinators.ml | 1 + src/stages/ast_simplified/combinators.mli | 1 + src/stages/ast_simplified/misc.ml | 3 +++ src/stages/ast_simplified/types.ml | 1 + src/stages/ast_typed/PP.ml | 1 + src/stages/ast_typed/combinators.ml | 6 ++++++ src/stages/ast_typed/combinators.mli | 3 +++ src/stages/ast_typed/misc.ml | 3 +++ src/stages/ast_typed/types.ml | 1 + src/stages/mini_c/PP.ml | 1 + src/stages/mini_c/types.ml | 1 + src/stages/typesystem/misc.ml | 1 + src/test/contracts/chain_id.ligo | 5 +++++ src/test/integration_tests.ml | 11 +++++++++++ 23 files changed, 79 insertions(+), 4 deletions(-) create mode 100644 src/test/contracts/chain_id.ligo diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index 20624230c..ad7bb28f5 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -24,9 +24,13 @@ let run ?options (* ?(is_input_value = false) *) (program:compiled_program) (inp Trace.trace_tzresult_lwt (simple_error "error parsing input") @@ Memory_proto_alpha.parse_michelson_data input_michelson input_ty in + let body = Michelson.strip_annots body in + let open! Memory_proto_alpha.Protocol.Script_ir_translator in + let top_level = Toplevel { storage_type = output_ty ; param_type = input_ty ; + root_name = None ; legacy_create_contract_literal = false } in let%bind descr = Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ - Memory_proto_alpha.parse_michelson body + Memory_proto_alpha.parse_michelson ~top_level body (Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in let open! Memory_proto_alpha.Protocol.Script_interpreter in let%bind (Item(output, Empty)) = diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml index c281ec12d..4581d916c 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_chain_id s) -> ( + return_wrapped (e_chain_id s) state @@ Wrap.literal (t_chain_id ()) + ) | E_literal (Literal_bytes b) -> ( return_wrapped (e_bytes b) state @@ Wrap.literal (t_bytes ()) ) @@ -1007,6 +1010,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_chain_id s -> ok (Literal_chain_id s) | Literal_signature s -> ok (Literal_signature s) | Literal_bytes b -> ok (Literal_bytes b) | Literal_address s -> ok (Literal_address s) diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml index f5e4e89dd..89f92ec76 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_chain_id s) -> + return (E_literal (Literal_chain_id s)) (t_chain_id ()) | E_literal (Literal_signature s) -> return (E_literal (Literal_signature s)) (t_signature ()) | E_literal (Literal_bytes s) -> @@ -814,6 +816,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_chain_id s -> ok (Literal_chain_id s) | Literal_bytes b -> ok (Literal_bytes b) | Literal_address s -> ok (Literal_address s) | Literal_operation s -> ok (Literal_operation s) diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index aacd50e0d..6bf94ca27 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -131,6 +131,7 @@ let rec transpile_type (t:AST.type_value) : type_value result = | 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", []) -> ok (T_base Base_key) + | T_constant (Type_name "chain_id", []) -> ok (T_base Base_chain_id) | T_constant (Type_name "contract", [x]) -> let%bind x' = transpile_type x in ok (T_contract x') @@ -240,6 +241,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_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 70d2933c5..e8fd27683 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 "chain_id", []) -> ( + let%bind n = + trace_strong (wrong_mini_c_value "chain_id" v) @@ + get_string v in + return (E_literal (Literal_chain_id n)) + ) | T_constant (Type_name "set", [ty]) -> ( let%bind lst = trace_strong (wrong_mini_c_value "set" v) @@ diff --git a/src/passes/8-compiler/compiler_type.ml b/src/passes/8-compiler/compiler_type.ml index 03754c03e..bef509a45 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 chain_id = Chain_id_t None let list a = List_t (a, None , has_big_map a) let set a = Set_t (a, None) let address = Address_t None @@ -70,6 +71,7 @@ module Ty = struct | Base_operation -> fail (not_comparable "operation") | Base_signature -> fail (not_comparable "signature") | Base_key -> fail (not_comparable "key") + | Base_chain_id -> fail (not_comparable "chain_id") let comparable_type : type_value -> ex_comparable_ty result = fun tv -> match tv with @@ -100,6 +102,7 @@ module Ty = struct | Base_operation -> return operation | Base_signature -> return signature | Base_key -> return key + | Base_chain_id -> return chain_id let rec type_ : type_value -> ex_ty result = function @@ -183,6 +186,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_chain_id -> ok @@ O.prim T_chain_id let rec type_ : type_value -> O.michelson result = function diff --git a/src/passes/8-compiler/uncompiler.ml b/src/passes/8-compiler/uncompiler.ml index 62adefd48..5440ac92a 100644 --- a/src/passes/8-compiler/uncompiler.ml +++ b/src/passes/8-compiler/uncompiler.ml @@ -31,6 +31,11 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result = trace_option (simple_error "too big to fit an int") @@ Alpha_context.Script_int.to_int n in ok @@ D_nat n + | (Chain_id_t _), id -> + let str = Tezos_crypto.Base58.simple_encode + (Tezos_base__TzPervasives.Chain_id.b58check_encoding) + id in + ok @@ D_string str | (Key_t _ ), n -> let%bind s = match n with | Ed25519 x -> ok @@ TP.Base58.simple_encode (TP.Ed25519.Public_key.b58check_encoding) x diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index b19d1724a..2d4b20646 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -52,12 +52,14 @@ module Simplify = struct ("set" , "set") ; ("map" , "map") ; ("big_map" , "big_map") ; + ("chain_id" , "chain_id") ; ] module Pascaligo = struct let constants = [ ("get_force" , "MAP_GET_FORCE") ; + ("get_chain_id", "CHAIN_ID"); ("transaction" , "CALL") ; ("get_contract" , "CONTRACT") ; ("get_entrypoint" , "CONTRACT_ENTRYPOINT") ; @@ -90,7 +92,6 @@ module Simplify = struct ("list_iter" , "LIST_ITER") ; ("list_fold" , "LIST_FOLD") ; ("list_map" , "LIST_MAP") ; - (*ici*) ("map_iter" , "MAP_ITER") ; ("map_map" , "MAP_MAP") ; ("map_fold" , "MAP_FOLD") ; @@ -459,7 +460,11 @@ module Typer = struct let balance = constant "BALANCE" @@ t_mutez () - let address = constant "ADDRESS" @@ t_address () + let chain_id = constant "CHAIN_ID" @@ t_chain_id () + + let address = typer_1 "ADDRESS" @@ fun contract -> + let%bind () = assert_t_contract contract in + ok @@ t_address () let now = constant "NOW" @@ t_timestamp () @@ -775,6 +780,7 @@ module Typer = struct check_signature ; sender ; source ; + chain_id ; unit ; balance ; amount ; @@ -858,7 +864,7 @@ module Compiler = struct ("UNIT" , simple_constant @@ prim I_UNIT) ; ("BALANCE" , simple_constant @@ prim I_BALANCE) ; ("AMOUNT" , simple_constant @@ prim I_AMOUNT) ; - ("ADDRESS" , simple_constant @@ prim I_ADDRESS) ; + ("ADDRESS" , simple_unary @@ prim I_ADDRESS) ; ("NOW" , simple_constant @@ prim I_NOW) ; ("CALL" , simple_ternary @@ prim I_TRANSFER_TOKENS) ; ("SOURCE" , simple_constant @@ prim I_SOURCE) ; @@ -875,6 +881,7 @@ module Compiler = struct ("PACK" , simple_unary @@ prim I_PACK) ; ("CONCAT" , simple_binary @@ prim I_CONCAT) ; ("CONS" , simple_binary @@ prim I_CONS) ; + ("CHAIN_ID", simple_constant @@ prim I_CHAIN_ID ) ; ] (* diff --git a/src/stages/ast_simplified/PP.ml b/src/stages/ast_simplified/PP.ml index 3a8101c12..a17b93c61 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_chain_id s -> fprintf ppf "@%S" s | Literal_operation _ -> fprintf ppf "Operation(...bytes)" let rec expression ppf (e:expression) = match e.expression with diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml index 21b2e570c..86ce9aee5 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/src/stages/ast_simplified/combinators.ml @@ -66,6 +66,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_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 ok @@ E_literal (Literal_bytes bytes) diff --git a/src/stages/ast_simplified/combinators.mli b/src/stages/ast_simplified/combinators.mli index beff41532..9e8761e1d 100644 --- a/src/stages/ast_simplified/combinators.mli +++ b/src/stages/ast_simplified/combinators.mli @@ -55,6 +55,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_chain_id : ?loc:Location.t -> string -> expression val e_mutez : ?loc:Location.t -> int -> expression val e'_bytes : string -> expression' result val e_bytes : ?loc:Location.t -> string -> expression result diff --git a/src/stages/ast_simplified/misc.ml b/src/stages/ast_simplified/misc.ml index 3e088906f..5969d4732 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_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 let rec assert_value_eq (a, b: (expression * expression )) : unit result = let error_content () = diff --git a/src/stages/ast_simplified/types.ml b/src/stages/ast_simplified/types.ml index 306998361..185d23b23 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_chain_id of string | Literal_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation and 'a matching = diff --git a/src/stages/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml index 1e0adc57f..5fdf5e849 100644 --- a/src/stages/ast_typed/PP.ml +++ b/src/stages/ast_typed/PP.ml @@ -77,6 +77,7 @@ and literal ppf (l:literal) : unit = | Literal_signature s -> fprintf ppf "@%s" s | Literal_key s -> fprintf ppf "@%s" s | Literal_operation _ -> fprintf ppf "Operation(...bytes)" + | Literal_chain_id s -> fprintf ppf "@%s" s and single_record_patch ppf ((s, ae) : string * ae) = fprintf ppf "%s <- %a" s annotated_expression ae diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml index 252532542..d32edf170 100644 --- a/src/stages/ast_typed/combinators.ml +++ b/src/stages/ast_typed/combinators.ml @@ -19,6 +19,7 @@ let t_key_hash ?s () : type_value = make_t (T_constant (Type_name "key_hash", [] let t_signature ?s () : type_value = make_t (T_constant (Type_name "signature", [])) s let t_int ?s () : type_value = make_t (T_constant (Type_name "int", [])) s let t_address ?s () : type_value = make_t (T_constant (Type_name "address", [])) s +let t_chain_id ?s () : type_value = make_t (T_constant (Type_name "chain_id", [])) s let t_operation ?s () : type_value = make_t (T_constant (Type_name "operation", [])) s let t_nat ?s () : type_value = make_t (T_constant (Type_name "nat", [])) s let t_mutez ?s () : type_value = make_t (T_constant (Type_name "tez", [])) s @@ -185,6 +186,10 @@ let assert_t_key = get_t_key let assert_t_signature = get_t_signature let assert_t_key_hash = get_t_key_hash +let assert_t_contract (t:type_value) : unit result = match t.type_value' with + | T_constant (Type_name "contract", _) -> ok () + | _ -> simple_fail "not a contract" + let assert_t_list t = let%bind _ = get_t_list t in ok () @@ -241,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_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 let e_pair a b : expression = E_tuple [a; b] diff --git a/src/stages/ast_typed/combinators.mli b/src/stages/ast_typed/combinators.mli index 14cfcb52e..12b84f779 100644 --- a/src/stages/ast_typed/combinators.mli +++ b/src/stages/ast_typed/combinators.mli @@ -19,6 +19,7 @@ val t_int : ?s:S.type_expression -> unit -> type_value val t_nat : ?s:S.type_expression -> unit -> type_value val t_mutez : ?s:S.type_expression -> unit -> type_value val t_address : ?s:S.type_expression -> unit -> type_value +val t_chain_id : ?s:S.type_expression -> unit -> type_value val t_signature : ?s:S.type_expression -> unit -> type_value val t_unit : ?s:S.type_expression -> unit -> type_value val t_option : type_value -> ?s:S.type_expression -> unit -> type_value @@ -102,6 +103,7 @@ val assert_t_int : type_value -> unit result val assert_t_nat : type_value -> unit result val assert_t_bool : type_value -> unit result val assert_t_unit : type_value -> unit result +val assert_t_contract : type_value -> unit result (* val e_record : ae_map -> expression val ez_e_record : ( string * annotated_expression ) list -> expression @@ -121,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_chain_id : string -> expression val e_operation : Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation -> expression val e_lambda : lambda -> expression val e_pair : value -> value -> expression diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index 4626ad6a3..f315d9af2 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_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 | Literal_operation _, Literal_operation _ -> fail @@ error_uncomparable_literals "can't compare operations" a b | Literal_operation _, _ -> fail @@ different_literals_because_different_types "operation vs non-operation" a b diff --git a/src/stages/ast_typed/types.ml b/src/stages/ast_typed/types.ml index c4f23521e..4615f156a 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_chain_id of string | Literal_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation and access = diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index df06324f8..62b7bec2a 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_chain_id -> fprintf ppf "chain_id" let rec type_ ppf : type_value -> _ = function | T_or(a, b) -> fprintf ppf "(%a) | (%a)" annotated a annotated b diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index d171d8f19..c109fc525 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -7,6 +7,7 @@ type type_base = | Base_timestamp | Base_string | Base_bytes | Base_address | Base_key | Base_operation | Base_signature + | Base_chain_id type 'a annotated = string option * 'a diff --git a/src/stages/typesystem/misc.ml b/src/stages/typesystem/misc.ml index 916e6d60a..96f6c472f 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_chain_id _ as x) | (T.Literal_operation _ as x) -> ok @@ x and s_matching_expr ~v ~expr : T.matching_expr w = fun _ -> diff --git a/src/test/contracts/chain_id.ligo b/src/test/contracts/chain_id.ligo new file mode 100644 index 000000000..e7283adf2 --- /dev/null +++ b/src/test/contracts/chain_id.ligo @@ -0,0 +1,5 @@ + +function get_chain_id (const tt : chain_id) : chain_id is + block { + var toto : chain_id := get_chain_id ; + } with ( toto ) \ No newline at end of file diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 5eb3281ea..a6f79b7ee 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1267,7 +1267,18 @@ let entrypoints_ligo () : unit result = (* hmm... *) ok () +let chain_id () : unit result = + let%bind program = type_file "./contracts/chain_id.ligo" in + let pouet = Tezos_crypto.Base58.simple_encode + Tezos_base__TzPervasives.Chain_id.b58check_encoding + Tezos_base__TzPervasives.Chain_id.zero in + let make_input = e_chain_id pouet in + let make_expected = e_chain_id pouet in + let%bind () = expect_eq program "get_chain_id" make_input make_expected in + ok () + let main = test_suite "Integration (End to End)" [ + test "chain id" chain_id ; test "type alias" type_alias ; test "function" function_ ; test "blockless function" blockless; From 87d00641134ca7ed6a37d70847a057b27ac5c730 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Wed, 20 Nov 2019 18:17:35 +0100 Subject: [PATCH 6/8] Multisig made robust to replay attack --- src/main/run/of_michelson.ml | 10 ++++------ src/test/contracts/multisig.ligo | 7 +++++-- src/test/multisig_tests.ml | 26 +++++++++++++++++++------- 3 files changed, 28 insertions(+), 15 deletions(-) diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index ad7bb28f5..012e928ea 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -83,13 +83,11 @@ let evaluate_michelson ?options program = let%bind etv = evaluate ?options program in ex_value_ty_to_michelson etv -let pack_message_lambda (lambda:Michelson.t) = - let open Memory_proto_alpha.Protocol.Script_typed_ir in - let input_ty = Lambda_t (Unit_t None , List_t ((Operation_t None),None,false) , None) in - let%bind lambda = +let pack_payload (payload:Michelson.t) ty = + let%bind payload = Trace.trace_tzresult_lwt (simple_error "error parsing message") @@ - Memory_proto_alpha.parse_michelson_data lambda input_ty in + Memory_proto_alpha.parse_michelson_data payload ty in let%bind data = Trace.trace_tzresult_lwt (simple_error "error packing message") @@ - Memory_proto_alpha.pack input_ty lambda in + Memory_proto_alpha.pack ty payload in ok @@ data diff --git a/src/test/contracts/multisig.ligo b/src/test/contracts/multisig.ligo index 31f42836f..e252ba335 100644 --- a/src/test/contracts/multisig.ligo +++ b/src/test/contracts/multisig.ligo @@ -2,8 +2,10 @@ type counter_t is nat type threshold_t is nat type authorized_keys_t is list(key) +type id_t is string type storage_t is record + id : id_t ; counter : counter_t ; threshold : threshold_t ; auth : authorized_keys_t ; @@ -28,14 +30,15 @@ function check_message (const param : check_message_pt; if param.counter =/= s.counter then failwith ("Counters does not match") else block { - var packed_msg : bytes := bytes_pack(message) ; + const packed_payload : bytes = + bytes_pack((message , param.counter , s.id , get_chain_id)); var valid : nat := 0n ; for sig in list param.signatures block { var is_valid : bool := False ; for pk in list s.auth block { - if crypto_check(pk,sig,packed_msg) then is_valid := True + if crypto_check(pk,sig,packed_payload) then is_valid := True else skip; }; diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml index 7c38899a5..ef3ba594e 100644 --- a/src/test/multisig_tests.ml +++ b/src/test/multisig_tests.ml @@ -33,22 +33,26 @@ let str_keys (raw_pk, raw_sk) = let (sk_str:string) = Base58.simple_encode (Ed25519.Secret_key.b58check_encoding) raw_sk in (pk_str,sk_str) -let sign_message (msg : expression) raw_sk : string result = +let sign_message (payload : expression) raw_sk : string result = let open Tezos_crypto in let (sk : Signature.secret_key) = Signature.Ed25519 raw_sk in let%bind program,_ = get_program () in - let%bind (msg : Tezos_utils.Michelson.michelson) = + let%bind code = let env = Ast_typed.program_environment program in - Ligo.Run.Of_simplified.compile_expression ~env ~state:(Typer.Solver.initial_state) msg - in - let%bind msg' = Ligo.Run.Of_michelson.pack_message_lambda msg in - let (signed_data:Signature.t) = Signature.sign sk msg' in + Compile.Of_simplified.compile_expression_as_function + ~env ~state:(Typer.Solver.initial_state) payload in + let Compiler.Program.{input=_;output=(Ex_ty payload_ty);body=_} = code in + let%bind (payload: Tezos_utils.Michelson.michelson) = + Ligo.Run.Of_michelson.evaluate_michelson code in + let%bind packed_payload = Ligo.Run.Of_michelson.pack_payload payload payload_ty in + let (signed_data:Signature.t) = Signature.sign sk packed_payload in let signature_str = Signature.to_b58check signed_data in ok signature_str let init_storage threshold counter pkeys = let keys = List.map (fun el -> e_key @@ fst @@ str_keys el) pkeys in ez_e_record [ + ("id" , e_string "MULTISIG" ) ; ("counter" , e_nat counter ) ; ("threshold" , e_nat threshold) ; ("auth" , e_typed_list keys t_key ) ; @@ -59,11 +63,19 @@ let empty_op_list = let empty_message = e_lambda "arguments" (Some t_unit) (Some (t_list t_operation)) empty_op_list +let chain_id_zero = e_chain_id @@ Tezos_crypto.Base58.simple_encode + Tezos_base__TzPervasives.Chain_id.b58check_encoding + Tezos_base__TzPervasives.Chain_id.zero (* sign the same message 'msg' with the secret keys of 'keys' *) let params counter msg keys = let aux = fun acc sk -> - let%bind signature = sign_message msg (snd sk) in + let payload = e_tuple + [ msg ; + e_nat counter ; + e_string "MULTISIG" ; + chain_id_zero ] in + let%bind signature = sign_message payload (snd sk) in ok @@ (e_signature signature)::acc in let%bind signed_msgs = Trace.bind_fold_list aux [] keys in ok @@ e_constructor From 88a0f33fca024351b1c6e97910ab28abe6882b8a Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Thu, 21 Nov 2019 13:12:52 +0100 Subject: [PATCH 7/8] add key_hash type and crypto_key_hash operator to pascaligo --- src/passes/4-typer-new/typer.ml | 4 ++++ src/passes/4-typer-old/typer.ml | 3 +++ src/passes/6-transpiler/transpiler.ml | 2 ++ src/passes/6-transpiler/untranspiler.ml | 6 ++++++ src/passes/8-compiler/compiler_type.ml | 6 +++++- src/passes/8-compiler/uncompiler.ml | 8 +++----- src/passes/operators/helpers.ml | 1 + src/passes/operators/operators.ml | 1 + src/stages/ast_simplified/PP.ml | 1 + src/stages/ast_simplified/combinators.ml | 2 ++ src/stages/ast_simplified/combinators.mli | 4 +++- src/stages/ast_simplified/misc.ml | 3 +++ src/stages/ast_simplified/types.ml | 1 + src/stages/ast_typed/PP.ml | 1 + src/stages/ast_typed/combinators.ml | 1 + src/stages/ast_typed/combinators.mli | 1 + src/stages/ast_typed/misc.ml | 3 +++ src/stages/ast_typed/types.ml | 1 + src/stages/mini_c/PP.ml | 1 + src/stages/mini_c/types.ml | 2 +- src/stages/typesystem/misc.ml | 1 + src/test/contracts/key_hash.ligo | 5 +++++ src/test/integration_tests.ml | 12 ++++++++++++ 23 files changed, 62 insertions(+), 8 deletions(-) create mode 100644 src/test/contracts/key_hash.ligo 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_ ; From 17ecf12fa377e6ff2b97a14814ef694e2501c467 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Thu, 21 Nov 2019 17:11:04 +0100 Subject: [PATCH 8/8] multisig : non quadratic signature check --- src/test/contracts/multisig.ligo | 29 +++++++------ src/test/multisig_tests.ml | 73 +++++++++++++++++--------------- 2 files changed, 57 insertions(+), 45 deletions(-) diff --git a/src/test/contracts/multisig.ligo b/src/test/contracts/multisig.ligo index e252ba335..90e7e30d7 100644 --- a/src/test/contracts/multisig.ligo +++ b/src/test/contracts/multisig.ligo @@ -12,10 +12,12 @@ type storage_t is record end // I/O types +type message_t is (unit -> list(operation)) +type signatures_t is list(key_hash * signature) type check_message_pt is record counter : counter_t ; - message : (unit -> list(operation)) ; - signatures : list(signature) ; + message : message_t ; + signatures : signatures_t ; end type contract_return_t is (list(operation) * storage_t) @@ -25,7 +27,7 @@ type entry_point_t is function check_message (const param : check_message_pt; const s : storage_t) : contract_return_t is block { - var message : (unit -> list(operation)) := param.message ; + var message : message_t := param.message ; if param.counter =/= s.counter then failwith ("Counters does not match") @@ -34,17 +36,20 @@ function check_message (const param : check_message_pt; bytes_pack((message , param.counter , s.id , get_chain_id)); var valid : nat := 0n ; - for sig in list param.signatures block { - var is_valid : bool := False ; - - for pk in list s.auth block { - if crypto_check(pk,sig,packed_payload) then is_valid := True + var keys : authorized_keys_t := s.auth ; + for pkh_sig in list param.signatures block { + case keys of + | nil -> skip + | key # tl -> block { + keys := tl ; + if pkh_sig.0 = crypto_hash_key(key) then + if crypto_check(key,pkh_sig.1,packed_payload) then valid := valid + 1n ; + else failwith ("Invalid signature") else skip; - }; - - if is_valid then valid := valid + 1n - else failwith ("Invalid signature") + } + end }; + if valid < s.threshold then failwith ("Not enough signatures passed the check") else s.counter := s.counter + 1n ; diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml index ef3ba594e..af0a1a2da 100644 --- a/src/test/multisig_tests.ml +++ b/src/test/multisig_tests.ml @@ -24,18 +24,18 @@ open Ast_simplified let gen_keys = fun () -> let open Tezos_crypto in - let (_,raw_pk,raw_sk) = Ed25519.generate_key () in - (raw_pk,raw_sk) + let (raw_pkh,raw_pk,raw_sk) = Signature.generate_key () in + (raw_pkh,raw_pk,raw_sk) -let str_keys (raw_pk, raw_sk) = +let str_keys (raw_pkh, raw_pk, raw_sk) = let open Tezos_crypto in - let (pk_str:string) = Base58.simple_encode (Ed25519.Public_key.b58check_encoding) raw_pk in - let (sk_str:string) = Base58.simple_encode (Ed25519.Secret_key.b58check_encoding) raw_sk in - (pk_str,sk_str) + let sk_str = Signature.Secret_key.to_b58check raw_sk in + let pk_str = Signature.Public_key.to_b58check raw_pk in + let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh in + (pkh_str,pk_str,sk_str) -let sign_message (payload : expression) raw_sk : string result = +let sign_message (payload : expression) sk : string result = let open Tezos_crypto in - let (sk : Signature.secret_key) = Signature.Ed25519 raw_sk in let%bind program,_ = get_program () in let%bind code = let env = Ast_typed.program_environment program in @@ -50,7 +50,11 @@ let sign_message (payload : expression) raw_sk : string result = ok signature_str let init_storage threshold counter pkeys = - let keys = List.map (fun el -> e_key @@ fst @@ str_keys el) pkeys in + let keys = List.map + (fun el -> + let (_,pk_str,_) = str_keys el in + e_key @@ pk_str) + pkeys in ez_e_record [ ("id" , e_string "MULTISIG" ) ; ("counter" , e_nat counter ) ; @@ -67,23 +71,25 @@ let chain_id_zero = e_chain_id @@ Tezos_crypto.Base58.simple_encode Tezos_base__TzPervasives.Chain_id.b58check_encoding Tezos_base__TzPervasives.Chain_id.zero -(* sign the same message 'msg' with the secret keys of 'keys' *) -let params counter msg keys = - let aux = fun acc sk -> +(* sign the message 'msg' with 'keys', if 'is_valid'=false the providid signature will be incorrect *) +let params counter msg keys is_validl = + let aux = fun acc (key,is_valid) -> + let (_,_pk,sk) = key in + let (pkh,_,_) = str_keys key in let payload = e_tuple [ msg ; e_nat counter ; - e_string "MULTISIG" ; + e_string (if is_valid then "MULTISIG" else "XX") ; chain_id_zero ] in - let%bind signature = sign_message payload (snd sk) in - ok @@ (e_signature signature)::acc in - let%bind signed_msgs = Trace.bind_fold_list aux [] keys in + let%bind signature = sign_message payload sk in + ok @@ (e_pair (e_key_hash pkh) (e_signature signature))::acc in + let%bind signed_msgs = Trace.bind_fold_list aux [] (List.rev @@ List.combine keys is_validl) in ok @@ e_constructor "CheckMessage" (ez_e_record [ ("counter" , e_nat counter ) ; ("message" , msg) ; - ("signatures" , e_typed_list signed_msgs t_signature ) ; + ("signatures" , e_typed_list signed_msgs (t_pair (t_key_hash,t_signature)) ) ; ]) @@ -92,7 +98,7 @@ let not_enough_1_of_2 () = let%bind program,_ = get_program () in let exp_failwith = "Not enough signatures passed the check" in let keys = gen_keys () in - let%bind test_params = params 0 empty_message [keys] in + let%bind test_params = params 0 empty_message [keys] [true] in let%bind () = expect_string_failwith program "main" (e_pair test_params (init_storage 2 0 [keys;gen_keys()])) exp_failwith in ok () @@ -101,20 +107,20 @@ let unmatching_counter () = let%bind program,_ = get_program () in let exp_failwith = "Counters does not match" in let keys = gen_keys () in - let%bind test_params = params 1 empty_message [keys] in + let%bind test_params = params 1 empty_message [keys] [true] in let%bind () = expect_string_failwith program "main" (e_pair test_params (init_storage 1 0 [keys])) exp_failwith in ok () -(* Provide one invalid signature when the threshold is one of one key *) +(* Provide one invalid signature (correct key but incorrect signature) + when the threshold is one of one key *) let invalid_1_of_1 () = let%bind program,_ = get_program () in let exp_failwith = "Invalid signature" in - let keys = gen_keys () in - let invalid_keys = gen_keys () in - let%bind test_params = params 0 empty_message [keys] in + let keys = [gen_keys ()] in + let%bind test_params = params 0 empty_message keys [false] in let%bind () = expect_string_failwith - program "main" (e_pair test_params (init_storage 1 0 [invalid_keys])) exp_failwith in + program "main" (e_pair test_params (init_storage 1 0 keys)) exp_failwith in ok () (* Provide one valid signature when the threshold is one of one key *) @@ -123,7 +129,7 @@ let valid_1_of_1 () = let keys = gen_keys () in let%bind () = expect_eq_n_trace_aux [0;1;2] program "main" (fun n -> - let%bind params = params n empty_message [keys] in + let%bind params = params n empty_message [keys] [true] in ok @@ e_pair params (init_storage 1 n [keys]) ) (fun n -> @@ -134,11 +140,11 @@ let valid_1_of_1 () = (* Provive two valid signatures when the threshold is two of three keys *) let valid_2_of_3 () = let%bind program,_ = get_program () in - let keys = [gen_keys (); gen_keys ()] in - let st_keys = gen_keys() :: keys in + let param_keys = [gen_keys (); gen_keys ()] in + let st_keys = param_keys @ [gen_keys ()] in let%bind () = expect_eq_n_trace_aux [0;1;2] program "main" (fun n -> - let%bind params = params n empty_message keys in + let%bind params = params n empty_message param_keys [true;true] in ok @@ e_pair params (init_storage 2 n st_keys) ) (fun n -> @@ -147,12 +153,13 @@ let valid_2_of_3 () = ok () (* Provide one invalid signature and two valid signatures when the threshold is two of three keys *) -let invalid_3_of_2 () = +let invalid_3_of_3 () = let%bind program,_ = get_program () in let valid_keys = [gen_keys() ; gen_keys()] in let invalid_key = gen_keys () in - let st_keys = gen_keys () :: valid_keys in - let%bind test_params = params 0 empty_message (invalid_key::valid_keys) in + let param_keys = valid_keys @ [invalid_key] in + let st_keys = valid_keys @ [gen_keys ()] in + let%bind test_params = params 0 empty_message param_keys [false;true;true] in let exp_failwith = "Invalid signature" in let%bind () = expect_string_failwith program "main" (e_pair test_params (init_storage 2 0 st_keys)) exp_failwith in @@ -163,7 +170,7 @@ let not_enough_2_of_3 () = let%bind program,_ = get_program () in let valid_keys = [gen_keys() ; gen_keys()] in let st_keys = gen_keys () :: valid_keys in - let%bind test_params = params 0 empty_message (valid_keys) in + let%bind test_params = params 0 empty_message (valid_keys) [true;true] in let exp_failwith = "Not enough signatures passed the check" in let%bind () = expect_string_failwith program "main" (e_pair test_params (init_storage 3 0 st_keys)) exp_failwith in @@ -176,6 +183,6 @@ let main = test_suite "Multisig" [ test "invalid_1_of_1" invalid_1_of_1 ; test "not_enough_signature" not_enough_1_of_2 ; test "valid_2_of_3" valid_2_of_3 ; - test "invalid_3_of_3" invalid_3_of_2 ; + test "invalid_3_of_3" invalid_3_of_3 ; test "not_enough_2_of_3" not_enough_2_of_3 ; ]