Merge branch 'contract-multisigv2' into 'dev'

Multisig v2

See merge request ligolang/ligo!218

src/stages/ast_simplified/combinators.ml

@@ -75,6 +75,8 @@ let e'_bytes b : expression' result =
 let e_bytes ?loc b : expression result =
   let%bind e' = e'_bytes b in
   ok @@ location_wrap ?loc e'
+let e_bytes_ofbytes ?loc (b: bytes) : expression result =
+  ok @@ location_wrap ?loc @@ E_literal (Literal_bytes b)
 let e_big_map ?loc lst : expression = location_wrap ?loc @@ E_big_map lst
 let e_record ?loc map : expression = location_wrap ?loc @@ E_record map
 let e_tuple ?loc lst : expression = location_wrap ?loc @@ E_tuple lst

src/stages/ast_simplified/combinators.mli

@@ -39,8 +39,8 @@ val ez_t_sum : ( string * type_expression ) list -> type_expression
 
 val t_function : type_expression -> type_expression -> type_expression
 val t_map : type_expression -> type_expression -> type_expression
-(*
 val t_set : type_expression -> type_expression
+(*
 
 val make_name : string -> name
 
@@ -61,6 +61,7 @@ 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
+val e_bytes_ofbytes : ?loc:Location.t -> bytes -> expression result
 val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
 (*
 val e_record  : ?loc:Location.t -> ( expr * expr ) list -> expression

src/test/contracts/multisig-v2.ligo

@@ -0,0 +1,46 @@
+// storage type
+type threshold_t is nat
+type addr_set_t is set(address)
+type message_store_t is big_map(bytes,addr_set_t)
+
+type storage_t is record
+  threshold : threshold_t ;
+  auth : addr_set_t ;
+  message_store : message_store_t ;
+end
+
+// I/O types
+type message_t is (unit -> list(operation))
+type send_pt is message_t
+
+type contract_return_t is (list(operation) * storage_t)
+
+type entry_point_t is
+| Send of send_pt
+
+function send (const param : send_pt; const s : storage_t) : contract_return_t is block {
+
+  if not set_mem(sender,s.auth) then failwith("Unauthorized address") else skip ;
+  
+  var message : message_t := param ;
+  const packed_msg : bytes = bytes_pack(message) ;
+  var ret_ops : list(operation) := (nil : list(operation)) ;
+
+  var new_store : addr_set_t :=
+    case map_get(packed_msg, s.message_store) of
+    | Some(voters) -> set_add(sender,voters)
+    | None         -> (set_empty : addr_set_t) end
+  ;
+
+  if size(new_store) >= s.threshold then block {
+    remove packed_msg from map s.message_store ;
+    ret_ops := message(unit) ;
+  } else
+    s.message_store[packed_msg] := new_store
+
+} with ( ret_ops , s)
+
+function main(const param : entry_point_t; const s : storage_t) : contract_return_t is 
+  case param of
+  | Send (p) -> send(p,s)
+end

src/test/multisig_tests.ml

@@ -34,21 +34,6 @@ let str_keys (raw_pkh, raw_pk, raw_sk) =
   let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh in
   (pkh_str,pk_str,sk_str)
 
-let sign_message (payload : expression) sk : string result =
-  let open Tezos_crypto in
-  let%bind program,_ = get_program () in
-  let%bind code =
-    let env = Ast_typed.program_environment program 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 ->
@@ -73,6 +58,7 @@ let chain_id_zero = e_chain_id @@ Tezos_crypto.Base58.simple_encode
 
 (* sign the message 'msg' with 'keys', if 'is_valid'=false the providid signature will be incorrect *)
 let params counter msg keys is_validl  = 
+  let%bind program,_ = get_program () in
   let aux = fun acc (key,is_valid) ->
     let (_,_pk,sk) = key in
     let (pkh,_,_) = str_keys key in
@@ -81,7 +67,7 @@ let params counter msg keys is_validl  =
         e_nat counter ; 
         e_string (if is_valid then "MULTISIG" else "XX") ; 
         chain_id_zero ] in
-    let%bind signature = sign_message payload sk in
+    let%bind signature = sign_message program 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
@@ -92,7 +78,6 @@ let params counter msg keys is_validl  =
       ("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 () =
   let%bind program,_ = get_program () in

src/test/multisig_v2_tests.ml

@@ -0,0 +1,106 @@
+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-v2.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 contract id = 
+  let open Proto_alpha_utils.Memory_proto_alpha in
+  let id = List.nth dummy_environment.identities id in
+  id.implicit_contract
+let addr id =
+  let open Proto_alpha_utils.Memory_proto_alpha in
+  Protocol.Alpha_context.Contract.to_b58check @@ contract id
+
+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
+
+let param = e_constructor "Send" empty_message
+
+let storage threshold id_list store_list = e_ez_record [
+  ("threshold", e_nat threshold) ;
+  ("auth"     , e_typed_set
+    (List.fold_left (fun acc el -> (e_address @@ addr el)::acc) [] id_list) 
+    t_address) ;
+  ("message_store" , e_typed_big_map store_list t_bytes (t_set t_address))
+]
+
+(* sender not stored in the authorized set *)
+let wrong_addr () =
+  let%bind program,_ = get_program () in
+  let init_storage = storage 1 [1;2] [] in
+  let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in
+  let source = contract 3 in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount ~source () in
+  let%bind () =
+    let exp_failwith = "Unauthorized address" in
+    expect_string_failwith ~options program "main"
+    (e_pair param init_storage) exp_failwith in
+  ok ()
+
+(* sender message is already stored in the message store *)
+let already_accounted () =
+  let%bind program,_ = get_program () in
+  let%bind packed_payload = pack_payload program empty_message in
+  let%bind bytes = e_bytes_ofbytes packed_payload in
+  let init_storage = storage 2 [1;2]
+    [(bytes, e_set [e_address@@ addr 1])] in
+  let options =
+    let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in
+    let source = contract 1 in
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~amount ~source () in
+  expect_eq ~options program "main"
+    (e_pair param init_storage) (e_pair empty_op_list init_storage)
+
+(* successful storing in the message store *)
+let succeeded_storing () =
+  let%bind program,_ = get_program () in
+  let%bind packed_payload = pack_payload program empty_message in
+  let%bind bytes = e_bytes_ofbytes packed_payload in
+  let options =
+    let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in
+    let source = contract 1 in
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~amount ~source () in
+  let%bind () = expect_eq_n_trace_aux ~options [1;2] program "main"
+      (fun th ->
+        let init_storage = storage th [1;2;3]
+        [(bytes, e_typed_set [] t_address)] in
+        ok @@ e_pair param init_storage
+      )
+      (fun th ->
+        let final_msg_store, ret = match th with
+        | 1 -> [] , empty_op_list
+        | 2 -> [(bytes, e_set [e_address@@ addr 1])] , empty_op_list
+        | _ -> failwith "impossible" in
+        let final_storage = storage th [1;2;3] final_msg_store in
+        ok @@ e_pair ret final_storage
+      ) in
+  ok ()
+
+let main = test_suite "Multisig v2" [
+    test "compile"           compile_main      ;
+    test "wrong_addr"        wrong_addr        ;
+    test "already_accounted" already_accounted ;
+    test "succeeded_storing" succeeded_storing ;
+  ]

src/test/test.ml

@@ -11,7 +11,8 @@ let () =
     Heap_tests.main ;
     Coase_tests.main ;
     Vote_tests.main ;
-    Multisig_tests.main ;
     Bin_tests.main ;
+    Multisig_tests.main ;
+    Multisig_v2_tests.main ;
   ] ;
   ()

src/test/test_helpers.ml

@@ -29,6 +29,26 @@ let test name f =
 
 let test_suite name lst = Test_suite (name , lst)
 
+
+open Ast_simplified
+
+let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result =
+  let%bind code =
+    let env = Ast_typed.program_environment program 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
+  Ligo.Run.Of_michelson.pack_payload payload payload_ty
+
+let sign_message (program:Ast_typed.program) (payload : expression) sk : string result =
+  let open Tezos_crypto in
+  let%bind packed_payload = pack_payload program payload in
+  let signed_data = Signature.sign sk packed_payload in
+  let signature_str = Signature.to_b58check signed_data in
+  ok signature_str
+
 open Ast_simplified.Combinators
 
 let expect ?options program entry_point input expecter =