mulisig contract v2 and test

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,50 @@
+// storage type
+type threshold_t is nat
+type addr_set_t is set(address)
+type message_store_t is 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 {
+  var message : message_t := param ;
+  var ret_ops : list(operation) := (nil : list(operation)) ;
+
+  if set_mem(source,s.auth) then block {
+    const packed_msg : bytes = bytes_pack(message) ;
+    var store_patch : addr_set_t := set_empty ;
+
+    case map_get(packed_msg, s.message_store) of
+    | Some(voters) ->
+      if set_mem(source,voters) then failwith("Already accounted message")
+      else store_patch := set_add(source,voters)
+    | None -> store_patch := set source end
+    end;
+
+    if size(store_patch) >= s.threshold then block {
+      remove packed_msg from map s.message_store ;
+      ret_ops := message(unit) ;
+    } else
+      patch s.message_store with map [packed_msg -> store_patch]
+  }
+  else
+    failwith("Unauthorized address");
+
+} 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

@@ -42,10 +42,10 @@ let sign_message (payload : expression) sk : string result =
     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) =
+  let%bind payload =
     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 signed_data = Signature.sign sk packed_payload in
   let signature_str = Signature.to_b58check signed_data in
   ok signature_str
 

src/test/multisig_v2_tests.ml

@@ -0,0 +1,120 @@
+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 pack_payload (payload:expression) : bytes result =
+  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
+  Ligo.Run.Of_michelson.pack_payload payload payload_ty
+
+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_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 payer = contract 3 in
+  let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount ~payer () 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 empty_message in
+  let%bind bytes = e_bytes_ofbytes packed_payload in
+  let init_storage = storage 1 [1;2]
+    [(bytes, e_set [e_address@@ addr 1])] in
+  let%bind () =
+  let options =
+    let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in
+    let payer = contract 1 in
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~amount ~payer () in
+  let exp_failwith = "Already accounted message" in
+  expect_string_failwith ~options program "main"
+    (e_pair param init_storage) exp_failwith in
+  ok ()
+
+(* successful storing in the message store *)
+let succeeded_storing () =
+  let%bind program,_ = get_program () in
+  let%bind packed_payload = pack_payload 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 payer = contract 1 in
+    Proto_alpha_utils.Memory_proto_alpha.make_options ~amount ~payer () 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 ;
   ] ;
   ()