From c2e4f2f36dbb0f9ae167ec0156bbcf6673029507 Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Wed, 27 May 2020 16:13:27 +0200 Subject: [PATCH 1/3] Add pp can assert_value_eq for Literal_op --- src/stages/3-ast_core/misc.ml | 56 ++++++++++++++++++++++++++++++++++- src/stages/common/PP.ml | 53 ++++++++++++++++++++++++++++++++- 2 files changed, 107 insertions(+), 2 deletions(-) diff --git a/src/stages/3-ast_core/misc.ml b/src/stages/3-ast_core/misc.ml index ca6519052..239e08c35 100644 --- a/src/stages/3-ast_core/misc.ml +++ b/src/stages/3-ast_core/misc.ml @@ -1,5 +1,59 @@ open Types +open Memory_proto_alpha.Protocol.Alpha_context +let assert_operation_eq (a: packed_internal_operation) (b: packed_internal_operation): unit option = + let Internal_operation {source=sa; operation=oa; nonce=na} = a in + let Internal_operation {source=sb; operation=ob; nonce=nb} = b in + let assert_source_eq sa sb = + let sa = Contract.to_b58check sa in + let sb = Contract.to_b58check sb in + if String.equal sa sb then Some () else None + in + let rec assert_param_eq (pa,pb) = + let open Tezos_micheline.Micheline in + match (pa, pb) with + | Int (la, ia), Int (lb, ib) when la = lb && ia = ib -> Some () + | String (la, sa), String (lb, sb) when la = lb && sa = sb -> Some () + | Bytes (la, ba), Bytes (lb, bb) when la = lb && ba = bb -> Some () + | Prim (la, pa, nla, aa), Prim (lb, pb, nlb, ab) when la = lb && pa = pb -> + let la = List.map assert_param_eq @@ List.combine nla nlb in + let lb = List.map ( fun (sa,sb) -> + if String.equal sa sb then Some () else None) @@ + List.combine aa ab + in + Option.map (fun _ -> ()) @@ Option.bind_list @@ la @ lb + | Seq (la, nla), Seq (lb, nlb) when la = lb -> + Option.map (fun _ -> ()) @@ Option.bind_list @@ List.map assert_param_eq @@ + List.combine nla nlb + | _ -> None + in + let assert_operation_eq (type a b) (oa: a manager_operation) (ob: b manager_operation) = + match (oa, ob) with + | Reveal sa, Reveal sb when sa = sb -> Some () + | Reveal _, _ -> None + | Transaction ta, Transaction tb -> + let aa,pa,ea,da = ta.amount,ta.parameters,ta.entrypoint,ta.destination in + let ab,pb,eb,db = tb.amount,tb.parameters,tb.entrypoint,tb.destination in + Format.printf "amount : %b; p : %b, e: %b, d : %b\n" (aa=ab) (pa=pb) (ea=eb) (da=db) ; + let (pa,pb) = Tezos_data_encoding.Data_encoding.(force_decode pa, force_decode pb) in + Option.bind (fun _ -> Some ()) @@ + Option.bind_list [ + Option.bind (fun (pa,pb) -> assert_param_eq Tezos_micheline.Micheline.(root pa, root pb)) @@ + Option.bind_pair (pa,pb); + if aa = ab && ea = eb && da = db then Some () else None ] + | Transaction _, _ -> None + | Origination _oa, Origination _ob -> Some () + | Origination _, _ -> None + | Delegation da, Delegation db when da = db -> Some () + | Delegation _, _ -> None + in + let assert_nonce_eq na nb = if na = nb then Some () else None in + Option.bind (fun _ -> Some ()) @@ + Option.bind_list [ + assert_source_eq sa sb; + assert_operation_eq oa ob; + assert_nonce_eq na nb] + let assert_literal_eq (a, b : literal * literal) : unit option = match (a, b) with | Literal_int a, Literal_int b when a = b -> Some () @@ -27,7 +81,7 @@ let assert_literal_eq (a, b : literal * literal) : unit option = | Literal_address a, Literal_address b when a = b -> Some () | Literal_address _, Literal_address _ -> None | Literal_address _, _ -> None - | Literal_operation _, Literal_operation _ -> None + | Literal_operation opa, Literal_operation opb -> assert_operation_eq opa opb | Literal_operation _, _ -> None | Literal_signature a, Literal_signature b when a = b -> Some () | Literal_signature _, Literal_signature _ -> None diff --git a/src/stages/common/PP.ml b/src/stages/common/PP.ml index 2a02fa4e0..7123a1c86 100644 --- a/src/stages/common/PP.ml +++ b/src/stages/common/PP.ml @@ -130,6 +130,57 @@ let constant ppf : constant' -> unit = function | C_CONVERT_FROM_RIGHT_COMB -> fprintf ppf "CONVERT_FROM_RIGHT_COMB" | C_CONVERT_FROM_LEFT_COMB -> fprintf ppf "CONVERT_FROM_LEFT_COMB" +let operation ppf (o : Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation) : unit = + let print_option f ppf o = + match o with + Some (s) -> fprintf ppf "%a" f s + | None -> fprintf ppf "None" + in + let open Tezos_micheline.Micheline in + let rec prim ppf (node : (_,Memory_proto_alpha.Protocol.Alpha_context.Script.prim) node)= match node with + | Int (l , i) -> fprintf ppf "Int (%i, %a)" l Z.pp_print i + | String (l , s) -> fprintf ppf "String (%i, %s)" l s + | Bytes (l, b) -> fprintf ppf "B (%i, %s)" l (Bytes.to_string b) + | Prim (l , p , nl, a) -> fprintf ppf "P (%i, %s, %a, %a)" l + (Memory_proto_alpha.Protocol.Michelson_v1_primitives.string_of_prim p) + (list_sep_d prim) nl + (list_sep_d (fun ppf s -> fprintf ppf "%s" s)) a + | Seq (l, nl) -> fprintf ppf "S (%i, %a)" l + (list_sep_d prim) nl + in + let l ppf (l: Memory_proto_alpha.Protocol.Alpha_context.Script.lazy_expr) = + let oo = Tezos_data_encoding.Data_encoding.force_decode l in + match oo with + Some o -> fprintf ppf "%a" prim (Tezos_micheline.Micheline.root o) + | None -> fprintf ppf "Fail decoding" + in + + let op ppf (type a) : a Memory_proto_alpha.Protocol.Alpha_context.manager_operation -> unit = function + | Reveal (s: Tezos_protocol_environment_006_PsCARTHA__Environment.Signature.Public_key.t) -> + fprintf ppf "R %a" Tezos_protocol_environment_006_PsCARTHA__Environment.Signature.Public_key.pp s + | Transaction {amount; parameters; entrypoint; destination} -> + fprintf ppf "T {%a; %a; %s; %a}" + Memory_proto_alpha.Protocol.Alpha_context.Tez.pp amount + l parameters + entrypoint + Memory_proto_alpha.Protocol.Alpha_context.Contract.pp destination + + | Origination {delegate; script; credit; preorigination} -> + fprintf ppf "O {%a; %a; %a; %a}" + (print_option Tezos_protocol_environment_006_PsCARTHA__Environment.Signature.Public_key_hash.pp) delegate + l script.code + Memory_proto_alpha.Protocol.Alpha_context.Tez.pp credit + (print_option Memory_proto_alpha.Protocol.Alpha_context.Contract.pp) preorigination + + | Delegation so -> + fprintf ppf "D %a" (print_option Tezos_protocol_environment_006_PsCARTHA__Environment.Signature.Public_key_hash.pp) so + in + let Internal_operation {source;operation;nonce} = o in + fprintf ppf "{source: %s; operation: %a; nonce: %i" + (Memory_proto_alpha.Protocol.Alpha_context.Contract.to_b58check source) + op operation + nonce + let literal ppf (l : literal) = match l with | Literal_unit -> fprintf ppf "unit" @@ -141,7 +192,7 @@ let literal ppf (l : literal) = | Literal_string s -> fprintf ppf "%a" Ligo_string.pp s | Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b) | Literal_address s -> fprintf ppf "@%S" s - | Literal_operation _ -> fprintf ppf "Operation(...bytes)" + | Literal_operation o -> fprintf ppf "Operation(%a)" operation o | Literal_key s -> fprintf ppf "key %s" s | Literal_key_hash s -> fprintf ppf "key_hash %s" s | Literal_signature s -> fprintf ppf "Signature %s" s From 98487d8bb7d76c3c85bd0df9d91f9214ed9eb038 Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Wed, 27 May 2020 16:19:29 +0200 Subject: [PATCH 2/3] Add a basic multisig contract --- src/test/basic_multisig_tests.ml | 208 ++++++++++++++++++ src/test/contracts/basic_multisig/config.ligo | 5 + .../contracts/basic_multisig/config.mligo | 5 + .../contracts/basic_multisig/multisig.ligo | 71 ++++++ .../contracts/basic_multisig/multisig.mligo | 65 ++++++ .../contracts/basic_multisig/multisig.religo | 74 +++++++ src/test/dune | 1 + src/test/test.ml | 1 + 8 files changed, 430 insertions(+) create mode 100644 src/test/basic_multisig_tests.ml create mode 100644 src/test/contracts/basic_multisig/config.ligo create mode 100644 src/test/contracts/basic_multisig/config.mligo create mode 100644 src/test/contracts/basic_multisig/multisig.ligo create mode 100644 src/test/contracts/basic_multisig/multisig.mligo create mode 100644 src/test/contracts/basic_multisig/multisig.religo diff --git a/src/test/basic_multisig_tests.ml b/src/test/basic_multisig_tests.ml new file mode 100644 index 000000000..61a205e54 --- /dev/null +++ b/src/test/basic_multisig_tests.ml @@ -0,0 +1,208 @@ +open Trace +open Test_helpers + +let file = "./contracts/basic_multisig/multisig.ligo" +let mfile = "./contracts/basic_multisig/multisig.mligo" +let refile = "./contracts/basic_multisig/multisig.religo" + +let type_file f s = + let%bind typed,state = Ligo.Compile.Utils.type_file f s (Contract "main") in + ok @@ (typed,state) + +let get_program f st = + let s = ref None in + fun () -> match !s with + | Some s -> ok s + | None -> ( + let%bind program = type_file f st in + s := Some program ; + ok program + ) + +let compile_main f s () = + let%bind typed_prg,_ = type_file f s in + let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in + let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in + let%bind (_contract: Tezos_utils.Michelson.michelson) = + (* fails if the given entry point is not a valid contract *) + Ligo.Compile.Of_michelson.build_contract michelson_prg in + ok () + +open Ast_imperative + +let init_storage threshold counter pkeys = + let keys = List.map + (fun el -> + let (_,pk_str,_) = str_keys el in + e_key @@ pk_str) + pkeys in + e_record_ez [ + ("id" , e_string "MULTISIG" ) ; + ("counter" , e_nat counter ) ; + ("threshold" , e_nat threshold) ; + ("auth" , e_typed_list keys (t_key ())) ; + ] + +let (first_owner , first_contract) = + let open Proto_alpha_utils.Memory_proto_alpha in + let id = List.nth dummy_environment.identities 0 in + let kt = id.implicit_contract in + Protocol.Alpha_context.Contract.to_b58check kt , kt + + let bad_contract () = + let title = (thunk ("Not a contract")) in + let message () = Format.asprintf "" in + let data = [ + ] in + error ~data title message () + +let op_list = + let open Memory_proto_alpha.Protocol.Alpha_context in + let source : Contract.t = first_contract in + let%bind operation = + let parameters : Script.lazy_expr = Script.unit_parameter in + let entrypoint = "default" in + let open Proto_alpha_utils in + let%bind destination = Trace.trace_alpha_tzresult (bad_contract) @@ + Contract.of_b58check "tz1PpDGHRXFQq3sYDuH8EpLWzPm5PFpe1sLE" + in + ok @@ Transaction {amount=Tez.zero; parameters; entrypoint; destination} in + ok @@ (e_typed_list [e_literal (Literal_operation (Internal_operation {source;operation;nonce=0}))] (t_operation ())) +let empty_payload = e_unit () + +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 message 'msg' with 'keys', if 'is_valid'=false the providid signature will be incorrect *) +let params counter payload keys is_validl f s = + let%bind program,_ = get_program f s () in + let aux = fun acc (key,is_valid) -> + let (_,_pk,sk) = key in + let (pkh,_,_) = str_keys key in + let msg = e_tuple + [ payload ; + e_nat counter ; + e_string (if is_valid then "MULTISIG" else "XX") ; + chain_id_zero ] in + let%bind signature = sign_message program msg 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_record_ez [ + ("counter" , e_nat counter ) ; + ("payload" , payload) ; + ("signatures" , e_typed_list signed_msgs (t_pair (t_key_hash (),t_signature ())) ) ; + ] + +(* Provide one valid signature when the threshold is two of two keys *) +let not_enough_1_of_2 f s () = + let%bind program = get_program f s () in + let exp_failwith = "Not enough signatures passed the check" in + let keys = gen_keys () in + let%bind test_params = params 0 empty_payload [keys] [true] f s in + let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~sender:first_contract () in + let%bind () = expect_string_failwith + program ~options "main" (e_pair test_params (init_storage 2 0 [keys;gen_keys()])) exp_failwith in + ok () + +let unmatching_counter f s () = + let%bind program = get_program f s () in + let exp_failwith = "Counters does not match" in + let keys = gen_keys () in + let%bind test_params = params 1 empty_payload [keys] [true] f s 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 (correct key but incorrect signature) + when the threshold is one of one key *) +let invalid_1_of_1 f s () = + let%bind program = get_program f s () in + let exp_failwith = "Invalid signature" in + let keys = [gen_keys ()] in + let%bind test_params = params 0 empty_payload keys [false] f s in + let%bind () = expect_string_failwith + 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 *) +let valid_1_of_1 f s () = + let%bind program = get_program f s () in + let%bind op_list = op_list 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_payload [keys] [true] f s in + ok @@ e_pair params (init_storage 1 n [keys]) + ) + (fun n -> + ok @@ e_pair 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 f s () = + let%bind program = get_program f s () in + let%bind op_list = op_list 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_payload param_keys [true;true] f s in + ok @@ e_pair params (init_storage 2 n st_keys) + ) + (fun n -> + ok @@ e_pair 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_3 f s () = + let%bind program = get_program f s () in + let valid_keys = [gen_keys() ; gen_keys()] in + let invalid_key = gen_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_payload param_keys [false;true;true] f s 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 f s () = + let%bind program = get_program f s() in + let valid_keys = [gen_keys() ; gen_keys()] in + let st_keys = gen_keys () :: valid_keys in + let%bind test_params = params 0 empty_payload (valid_keys) [true;true] f s 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 "Basic Multisig" [ + test "compile" (compile_main file "pascaligo"); + test "unmatching_counter" (unmatching_counter file "pascaligo"); + test "valid_1_of_1" (valid_1_of_1 file "pascaligo"); + test "invalid_1_of_1" (invalid_1_of_1 file "pascaligo"); + test "not_enough_signature" (not_enough_1_of_2 file "pascaligo"); + test "valid_2_of_3" (valid_2_of_3 file "pascaligo"); + test "invalid_3_of_3" (invalid_3_of_3 file "pascaligo"); + test "not_enough_2_of_3" (not_enough_2_of_3 file "pascaligo"); + test "compile (mligo)" (compile_main mfile "cameligo"); + test "unmatching_counter (mligo)" (unmatching_counter mfile "cameligo"); + test "valid_1_of_1 (mligo)" (valid_1_of_1 mfile "cameligo"); + test "invalid_1_of_1 (mligo)" (invalid_1_of_1 mfile "cameligo"); + test "not_enough_signature (mligo)" (not_enough_1_of_2 mfile "cameligo"); + test "valid_2_of_3 (mligo)" (valid_2_of_3 mfile "cameligo"); + test "invalid_3_of_3 (mligo)" (invalid_3_of_3 mfile "cameligo"); + test "not_enough_2_of_3 (mligo)" (not_enough_2_of_3 mfile "cameligo"); + test "compile (religo)" (compile_main refile "reasonligo"); + test "unmatching_counter (religo)" (unmatching_counter refile "reasonligo"); + test "valid_1_of_1 (religo)" (valid_1_of_1 refile "reasonligo"); + test "invalid_1_of_1 (religo)" (invalid_1_of_1 refile "reasonligo"); + test "not_enough_signature (religo)" (not_enough_1_of_2 refile "reasonligo"); + test "valid_2_of_3 (religo)" (valid_2_of_3 refile "reasonligo"); + test "invalid_3_of_3 (religo)" (invalid_3_of_3 refile "reasonligo"); + test "not_enough_2_of_3 (religo)" (not_enough_2_of_3 refile "reasonligo"); + ] diff --git a/src/test/contracts/basic_multisig/config.ligo b/src/test/contracts/basic_multisig/config.ligo new file mode 100644 index 000000000..1cee7a1cc --- /dev/null +++ b/src/test/contracts/basic_multisig/config.ligo @@ -0,0 +1,5 @@ +type c_counter_type is nat +type c_payload_type is unit + +const c_address : address = + ("tz1PpDGHRXFQq3sYDuH8EpLWzPm5PFpe1sLE": address) diff --git a/src/test/contracts/basic_multisig/config.mligo b/src/test/contracts/basic_multisig/config.mligo new file mode 100644 index 000000000..81b6ef584 --- /dev/null +++ b/src/test/contracts/basic_multisig/config.mligo @@ -0,0 +1,5 @@ +type c_counter_type = nat +type c_payload_type = unit + +let c_address : address = + ("tz1PpDGHRXFQq3sYDuH8EpLWzPm5PFpe1sLE": address) diff --git a/src/test/contracts/basic_multisig/multisig.ligo b/src/test/contracts/basic_multisig/multisig.ligo new file mode 100644 index 000000000..10088213a --- /dev/null +++ b/src/test/contracts/basic_multisig/multisig.ligo @@ -0,0 +1,71 @@ +#include "config.ligo" + +// storage type + +type counter is c_counter_type +type threshold is c_counter_type +type authorized_keys is list (key) + +type storage is + record [ + id : string; + counter : counter; + threshold : threshold; + auth : authorized_keys + ] + +// I/O types + +type payload is c_payload_type +type signatures is list (key_hash * signature) + +type parameter is + record [ + counter : counter; + payload : payload; + signatures : signatures + ] + +type return is list (operation) * storage + + +function main (const p : parameter; const s : storage) : return is +block { + + var payload: payload := p.payload; + + + if p.counter =/= s.counter then + failwith ("Counters does not match") + else { + const packed_payload : bytes = + Bytes.pack ((payload, p.counter, s.id, Tezos.chain_id)); + var valid : nat := 0n; + + var pkh_sigs : signatures := p.signatures; + for key in list s.auth block { + case pkh_sigs of + nil -> skip + | pkh_sig # tl -> block { + if pkh_sig.0 = Crypto.hash_key (key) then block { + pkh_sigs := tl; + if Crypto.check (key, pkh_sig.1, packed_payload) + then valid := valid + 1n + else failwith ("Invalid signature") + } + else skip + } + end + }; + + if valid < s.threshold then + failwith ("Not enough signatures passed the check") + else s.counter := s.counter + 1n + }; + const contract_opt : option (contract(payload)) = Tezos.get_contract_opt(c_address); + var op : list(operation) := nil; + case contract_opt of + | Some (c) -> op := list [Tezos.transaction (payload, 0tez, c)] + | None -> failwith ("Contract not found") + end; +} with (op, s) diff --git a/src/test/contracts/basic_multisig/multisig.mligo b/src/test/contracts/basic_multisig/multisig.mligo new file mode 100644 index 000000000..747cd0419 --- /dev/null +++ b/src/test/contracts/basic_multisig/multisig.mligo @@ -0,0 +1,65 @@ +#include "config.mligo" + +// storage type + +type counter = c_counter_type +type threshold = c_counter_type +type authorized_keys = key list + +type storage = { + id : string; + counter : counter; + threshold : threshold; + auth : authorized_keys +} + +// I/O types + +type payload = c_payload_type +type signatures = (key_hash * signature) list + +type parameter = { + counter : counter; + payload : payload; + signatures : signatures +} + +type return = operation list * storage + + +let main (p, s : parameter * storage) : return = + let payload : payload = p.payload in + let s = + if p.counter <> s.counter then + (failwith "Counters does not match" : storage) + else + let packed_payload : bytes = + Bytes.pack (payload, p.counter, s.id, Tezos.chain_id) in + let valid : nat = 0n in + let keys : authorized_keys = s.auth in + let aux = + fun (vk, pkh_sig: (nat * authorized_keys)*(key_hash * signature)) -> + let valid, keys = vk in + match keys with + | [] -> vk + | key::keys -> + if pkh_sig.0 = Crypto.hash_key key + then + let valid = + if Crypto.check key pkh_sig.1 packed_payload + then valid + 1n + else (failwith "Invalid signature" : nat) + in valid, keys + else valid, keys in + let valid, keys = + List.fold aux p.signatures (valid, keys) in + if valid < s.threshold then + (failwith ("Not enough signatures passed the check") : storage) + else {s with counter = s.counter + 1n} + in + let contract_opt : payload contract option = Tezos.get_contract_opt(c_address) in + let op = match contract_opt with + Some (c) -> [Tezos.transaction payload 0tez c] + | None -> (failwith ("Contract not found") : operation list) + in + op, s diff --git a/src/test/contracts/basic_multisig/multisig.religo b/src/test/contracts/basic_multisig/multisig.religo new file mode 100644 index 000000000..fbdc22899 --- /dev/null +++ b/src/test/contracts/basic_multisig/multisig.religo @@ -0,0 +1,74 @@ +#include "config.mligo" + +// storage type + +type counter = c_counter_type +type threshold = c_counter_type +type authorized_keys = list (key); + +type storage = { + id : string, + counter : counter, + threshold : threshold, + auth : authorized_keys +}; + +// I/O types + +type payload = c_payload_type +type dummy = (key_hash,signature); +type signatures = list ((key_hash,signature)); /* Waiting to be fixed */ + +type parameter = { + counter : counter, + payload : payload, + signatures : signatures +}; + +type return = (list (operation),storage); + +let main = ((p, s): (parameter, storage)) : return => +{ + let payload : payload = p.payload; + let s = + if (p.counter != s.counter) { + (failwith ("Counters does not match") : storage); + } else { + let packed_payload : bytes = + Bytes.pack ((payload, p.counter, s.id, Tezos.chain_id)); + let valid : nat = 0n; + let keys : authorized_keys = s.auth; + let aux = ((vk, pkh_sig) : + ((nat, authorized_keys), (key_hash, signature))) + : (nat, authorized_keys) => { + let (valid, keys) = vk; + switch (keys) { + | [] => vk; + | [key, ...keys] => + if (pkh_sig[0] == Crypto.hash_key (key)) { + let valid = + if (Crypto.check (key, pkh_sig[1], packed_payload)) { + valid + 1n; + } + else { (failwith ("Invalid signature") : nat) }; + (valid, keys); + } + else { (valid, keys); }; + }; + }; + let (valid, keys) = + List.fold (aux, p.signatures, (valid, keys)); + if (valid < s.threshold) { + (failwith ("Not enough signatures passed the check") : storage); + } + else { + {...s,counter : s.counter + 1n}; + }; + }; + let contract_opt : option (contract (payload)) = Tezos.get_contract_opt(c_address); + let op = switch (contract_opt) { + | Some (c) => [Tezos.transaction(payload, 0tez, c)] + | None => (failwith ("Contract not found") : list (operation)) + }; + (op,s) +}; diff --git a/src/test/dune b/src/test/dune index cc571bfdf..5625b81e6 100644 --- a/src/test/dune +++ b/src/test/dune @@ -6,6 +6,7 @@ simple-utils ligo alcotest + tezos-utils tezos-crypto ) (preprocess diff --git a/src/test/test.ml b/src/test/test.ml index b6a9a9c41..9e6d3a927 100644 --- a/src/test/test.ml +++ b/src/test/test.ml @@ -13,6 +13,7 @@ let () = Id_tests.main ; Id_tests_p.main ; Id_tests_r.main ; + Basic_multisig_tests.main; Multisig_tests.main ; Multisig_v2_tests.main ; Replaceable_id_tests.main ; From 36df068dfca0ec8651b572c70f1e36d23d80d62c Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Thu, 18 Jun 2020 18:27:37 +0200 Subject: [PATCH 3/3] wip: new error monad --- src/test/basic_multisig_tests.ml | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/test/basic_multisig_tests.ml b/src/test/basic_multisig_tests.ml index 61a205e54..9efc9ea86 100644 --- a/src/test/basic_multisig_tests.ml +++ b/src/test/basic_multisig_tests.ml @@ -49,12 +49,6 @@ let (first_owner , first_contract) = let kt = id.implicit_contract in Protocol.Alpha_context.Contract.to_b58check kt , kt - let bad_contract () = - let title = (thunk ("Not a contract")) in - let message () = Format.asprintf "" in - let data = [ - ] in - error ~data title message () let op_list = let open Memory_proto_alpha.Protocol.Alpha_context in @@ -63,7 +57,8 @@ let op_list = let parameters : Script.lazy_expr = Script.unit_parameter in let entrypoint = "default" in let open Proto_alpha_utils in - let%bind destination = Trace.trace_alpha_tzresult (bad_contract) @@ + let%bind destination = + Trace.trace_alpha_tzresult (fun _ -> Main_errors.test_internal __LOC__) @@ Contract.of_b58check "tz1PpDGHRXFQq3sYDuH8EpLWzPm5PFpe1sLE" in ok @@ Transaction {amount=Tez.zero; parameters; entrypoint; destination} in