Merge branch 'contract/basic_multisig' into 'dev'

Add a basic multisig contrat

See merge request ligolang/ligo!643
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-06-19 11:24:28 +00:00
commit 46bd0315e2
10 changed files with 532 additions and 2 deletions

View File

@ -1,5 +1,59 @@
open Types 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 = let assert_literal_eq (a, b : literal * literal) : unit option =
match (a, b) with match (a, b) with
| Literal_int a, Literal_int b when a = b -> Some () | 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 a, Literal_address b when a = b -> Some ()
| Literal_address _, Literal_address _ -> None | Literal_address _, Literal_address _ -> None
| 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_operation _, _ -> None
| Literal_signature a, Literal_signature b when a = b -> Some () | Literal_signature a, Literal_signature b when a = b -> Some ()
| Literal_signature _, Literal_signature _ -> None | Literal_signature _, Literal_signature _ -> None

View File

@ -130,6 +130,57 @@ let constant ppf : constant' -> unit = function
| C_CONVERT_FROM_RIGHT_COMB -> fprintf ppf "CONVERT_FROM_RIGHT_COMB" | C_CONVERT_FROM_RIGHT_COMB -> fprintf ppf "CONVERT_FROM_RIGHT_COMB"
| C_CONVERT_FROM_LEFT_COMB -> fprintf ppf "CONVERT_FROM_LEFT_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) = let literal ppf (l : literal) =
match l with match l with
| Literal_unit -> fprintf ppf "unit" | 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_string s -> fprintf ppf "%a" Ligo_string.pp s
| Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b) | Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
| Literal_address s -> fprintf ppf "@%S" s | 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 s -> fprintf ppf "key %s" s
| Literal_key_hash s -> fprintf ppf "key_hash %s" s | Literal_key_hash s -> fprintf ppf "key_hash %s" s
| Literal_signature s -> fprintf ppf "Signature %s" s | Literal_signature s -> fprintf ppf "Signature %s" s

View File

@ -0,0 +1,203 @@
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 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 (fun _ -> Main_errors.test_internal __LOC__) @@
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");
]

View File

@ -0,0 +1,5 @@
type c_counter_type is nat
type c_payload_type is unit
const c_address : address =
("tz1PpDGHRXFQq3sYDuH8EpLWzPm5PFpe1sLE": address)

View File

@ -0,0 +1,5 @@
type c_counter_type = nat
type c_payload_type = unit
let c_address : address =
("tz1PpDGHRXFQq3sYDuH8EpLWzPm5PFpe1sLE": address)

View File

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

View File

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

View File

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

View File

@ -6,6 +6,7 @@
simple-utils simple-utils
ligo ligo
alcotest alcotest
tezos-utils
tezos-crypto tezos-crypto
) )
(preprocess (preprocess

View File

@ -13,6 +13,7 @@ let () =
Id_tests.main ; Id_tests.main ;
Id_tests_p.main ; Id_tests_p.main ;
Id_tests_r.main ; Id_tests_r.main ;
Basic_multisig_tests.main;
Multisig_tests.main ; Multisig_tests.main ;
Multisig_v2_tests.main ; Multisig_v2_tests.main ;
Replaceable_id_tests.main ; Replaceable_id_tests.main ;