Commit 00b415f2 authored by Seb Mondet's avatar Seb Mondet

Merge branch 'mnichols-multisig-rpc' into 'master'

multisig via rpc

See merge request !33
parents fc946442 eda20ce7
Pipeline #211753837 passed with stages
in 57 minutes and 55 seconds
......@@ -176,8 +176,8 @@ let run_wait_level protocol state nodes opt lvl =
let run state ~protocol ~size ~base_port ~clear_root ~no_daemons_for ?hard_fork
~genesis_block_choice ?external_peer_ports ~nodes_history_mode_edits
~with_baking ?generate_kiln_config node_exec client_exec baker_exec
endorser_exec accuser_exec test_kind () =
?generate_kiln_config node_exec client_exec baker_exec endorser_exec
accuser_exec test_kind () =
( if clear_root then
Console.say state EF.(wf "Clearing root: `%s`" (Paths.root state))
>>= fun () -> Helpers.clear_root state
......@@ -189,7 +189,8 @@ let run state ~protocol ~size ~base_port ~clear_root ~no_daemons_for ?hard_fork
Helpers.System_dependencies.precheck state `Or_fail
~executables:
( [node_exec; client_exec]
@ (if with_baking then [baker_exec; endorser_exec; accuser_exec] else [])
@ ( if state#test_baking then [baker_exec; endorser_exec; accuser_exec]
else [] )
@ Option.value_map hard_fork ~default:[] ~f:Hard_fork.executables )
>>= fun () ->
Console.say state EF.(wf "Starting up the network.")
......@@ -263,7 +264,7 @@ let run state ~protocol ~size ~base_port ~clear_root ~no_daemons_for ?hard_fork
[ generate_traffic_command state
~clients:(List.map keys_and_daemons ~f:(fun (_, _, kc, _) -> kc))
~nodes ] ;
( if with_baking then
( if state#test_baking then
let accusers =
List.map nodes ~f:(fun node ->
let client = Tezos_client.of_node node ~exec:client_exec in
......@@ -330,12 +331,12 @@ let run state ~protocol ~size ~base_port ~clear_root ~no_daemons_for ?hard_fork
@ arbitrary_commands_for_each_and_all_clients state ~clients) ;
match test_kind with
| `Interactive ->
Interactive_test.Pauser.generic ~force:true state
Interactive_test.Pauser.generic state ~force:true
EF.[haf "Sandbox is READY \\o/"]
| `Dsl_traffic (`Dsl_command dsl_command, `After `Interactive) ->
run_dsl_cmd state keyed_clients nodes dsl_command
>>= fun () ->
Interactive_test.Pauser.generic ~force:true state
Interactive_test.Pauser.generic state ~force:true
EF.[haf "Sandbox is READY \\o/"]
| `Dsl_traffic (`Dsl_command dsl_command, `After (`Until lvl)) ->
run_dsl_cmd state keyed_clients nodes dsl_command
......@@ -366,7 +367,6 @@ let cmd () =
base_port
(`External_peers external_peer_ports)
(`No_daemons_for no_daemons_for)
(`With_baking with_baking)
protocol
bnod
bcli
......@@ -381,7 +381,7 @@ let cmd () =
->
let actual_test =
run state ~size ~base_port ~protocol bnod bcli bak endo accu
?hard_fork ~clear_root ~nodes_history_mode_edits ~with_baking
?hard_fork ~clear_root ~nodes_history_mode_edits
?generate_kiln_config ~external_peer_ports ~no_daemons_for
~genesis_block_choice test_kind in
Test_command_line.Run_command.or_hard_fail state ~pp_error
......@@ -459,14 +459,6 @@ let cmd () =
(opt_all string []
(info ["no-daemons-for"] ~docv:"ACCOUNT-NAME" ~docs
~doc:"Do not start daemons for $(docv).")))
$ Arg.(
pure (fun x -> `With_baking (not x))
$ value
(flag
(info ["no-baking"] ~docs
~doc:
"Completely disable baking/endorsing/accusing (you need \
to bake manually to make the chain advance).")))
$ Tezos_protocol.cli_term base_state
$ Tezos_executable.cli_term base_state `Node "tezos"
$ Tezos_executable.cli_term base_state `Client "tezos"
......
......@@ -36,7 +36,7 @@ module Commands = struct
let all = flag "all" sxp in
Console.say state (Running_processes.ef ~all state))
let curl_rpc state ~port ~path =
let curl_rpc_cmd state ~port ~path =
Running_processes.run_cmdf state "curl http://localhost:%d/%s" port path
>>= fun curl_res ->
Console.display_errors_of_command state curl_res ~should_output:true
......@@ -82,7 +82,7 @@ module Commands = struct
>>= fun port ->
get_pp_json state sexps
>>= fun pp_json ->
curl_rpc state ~port ~path
curl_rpc_cmd state ~port ~path
>>= fun json_opt ->
do_jq ~msg:doc state json_opt ~f:jq
>>= fun processed_json ->
......@@ -202,11 +202,12 @@ module Commands = struct
(fun sexps ->
Sexp_options.port_number state sexps ~default_port
>>= fun port ->
curl_rpc state ~port ~path:"/chains/main/blocks/head/context/contracts"
curl_rpc_cmd state ~port
~path:"/chains/main/blocks/head/context/contracts"
>>= fun json_opt ->
do_jq state ~msg:"Getting contract list" ~f:Jqo.get_strings json_opt
>>= fun contracts ->
curl_rpc state ~port ~path:"/chains/main/checkpoint"
curl_rpc_cmd state ~port ~path:"/chains/main/checkpoint"
>>= fun chkpto ->
do_jq state chkpto ~msg:"Getting checkpoint"
~f:
......@@ -222,7 +223,7 @@ module Commands = struct
let path =
sprintf "/chains/main/blocks/%s/context/contracts/%s/balance" block
contract in
curl_rpc state ~port ~path
curl_rpc_cmd state ~port ~path
>>= fun jo ->
do_jq state jo ~msg:"Getting balance" ~f:(fun j ->
Jqo.get_string j |> Int.of_string) in
......@@ -257,7 +258,8 @@ module Commands = struct
(fun sexps ->
Sexp_options.port_number state sexps ~default_port
>>= fun port ->
curl_rpc state ~port ~path:"/chains/main/blocks/head/context/contracts"
curl_rpc_cmd state ~port
~path:"/chains/main/blocks/head/context/contracts"
>>= fun json_opt ->
do_jq state ~msg:"Getting contract list" ~f:Jqo.get_strings json_opt
>>= fun contracts ->
......@@ -493,7 +495,7 @@ module Commands = struct
| _ -> Fmt.kstrf failwith "Wrong command line: %a" pp (List sexps)
in
protect_with_keyed_client "manual-forge" ~client ~f:(fun () ->
Traffic_generation.Commands.branch state client
Traffic_generation.branch state client
>>= fun branch ->
Tezos_client.get_account state ~client:client.client
~name:client.key_name
......@@ -597,7 +599,7 @@ module Commands = struct
cut ppf () ;
Sexp_options.pp_options options ppf ()) in
fun ppf () ->
pf ppf "Generating traffic: TODO" ;
pf ppf "Generating traffic:" ;
cmd ppf "batch"
(const text "Make a batch operation (simple transfers).")
[counter_option; size_option; fee_option] ;
......@@ -619,7 +621,7 @@ module Commands = struct
[level_option])
| Atom "endorsement" :: more_args ->
protect_with_keyed_client "forge-and-inject" ~client ~f:(fun () ->
branch state client
Traffic_generation.branch state client
>>= fun branch ->
Sexp_options.get level_option more_args
~f:Sexp_options.get_int_exn ~default:(fun () -> return 42)
......@@ -630,19 +632,13 @@ module Commands = struct
Console.sayf state
More_fmt.(fun ppf () -> json ppf json_result))
| Atom "batch" :: more_args ->
Tezos_client.get_account state ~client:client.client
~name:client.key_name
>>= fun acct ->
( match acct with
| Some a -> get_batch_args state ~client all_opts a more_args
| None -> Fmt.kstr failwith "to_action - failed to parse account."
)
get_batch_args state ~client all_opts more_args
>>= fun ba ->
run_actions state ~client ~nodes ~actions:[ba] ~counter:1
run_actions state ~client ~nodes ~actions:[ba] ~rep_counter:1
| Atom "multisig-batch" :: more_args ->
get_multisig_args state ~client all_opts more_args
>>= fun ma ->
run_actions state ~client ~nodes ~actions:[ma] ~counter:1
run_actions state ~client ~nodes ~actions:[ma] ~rep_counter:1
| Atom "dsl" :: dsl_sexp ->
Traffic_generation.Dsl.process_dsl state ~client ~nodes all_opts
(Sexp.List dsl_sexp)
......
......@@ -34,7 +34,7 @@ module Commands : sig
; .. >
-> Console.Prompt.item
val curl_rpc :
val curl_rpc_cmd :
< application_name: string
; console: Console.t
; paths: Paths.t
......@@ -211,6 +211,7 @@ module Commands : sig
; env_config: Environment_configuration.t
; paths: Paths.t
; runner: Running_processes.State.t
; test_baking: bool
; .. >
-> clients:Tezos_client.Keyed.t list
-> nodes:Tezos_node.t list
......@@ -230,6 +231,7 @@ end
(** Configurable (through {!Cmdliner.Term.t}) interactivity of
test-scenarios. *)
module Interactivity : sig
type t = [`Full | `None | `On_error | `At_end]
......@@ -272,6 +274,7 @@ module Pauser : sig
; pauser: t
; runner: Running_processes.State.t
; test_interactivity: Interactivity.t
; test_baking: bool
; .. >
-> (unit -> (unit, ([> System_error.t] as 'errors)) Asynchronous_result.t)
-> pp_error:(Caml.Format.formatter -> 'errors -> unit)
......
......@@ -311,6 +311,13 @@ module Asynchronous_result = struct
| n when n <= 0 -> return ()
| n -> f (1 + times - n) >>= fun () -> loop (n - 1) in
loop times
let n_times_fold times initial_arg f =
let rec loop n arg =
match n with
| n when n <= 0 -> return ()
| n -> f (1 + times - n) arg >>= fun x -> loop (n - 1) x in
loop times initial_arg
end
module Stream = struct
......@@ -556,10 +563,31 @@ module Jqo = struct
let to_string j = Ezjsonm.(to_string (wrap j))
let of_lines l = Ezjsonm.value_from_string (String.concat ~sep:"\n" l)
let to_string_hum (json : Ezjsonm.value) =
match json with `String s -> s | _ -> to_string json
let field_from_list ~k json_list =
match json_list with
| `A val_list ->
let foldf acc x =
match x with
| `O obj -> (
match List.Assoc.find obj ~equal:String.equal k with
| Some z -> z :: acc
| None -> acc )
| _ -> acc
(*expecting an object here*) in
List.fold val_list ~init:[] ~f:foldf
| _ -> []
let field ~k = function
| `O l -> List.Assoc.find_exn l ~equal:String.equal k
| other -> ksprintf failwith "Jqo.field (%S) in %s" k (to_string other)
let field_opt ~k = function
| `O l -> List.Assoc.find l ~equal:String.equal k
| other -> ksprintf failwith "Jqo.field_opt (%S) in %s" k (to_string other)
let list_find ~f = function
| `O l ->
List.find_map_exn ~f:(fun (_, j) -> if f j then Some j else None) l
......@@ -576,8 +604,45 @@ module Jqo = struct
ksprintf failwith "Jqo.remove_field %S: No an object: %s" name
(to_string other)
let match_in_array match_key match_val target_key json_arr =
let foldf match_k match_v target_k (x : Ezjsonm.value)
(r : Ezjsonm.value list) : Ezjsonm.value list =
match field_opt ~k:match_k x with
| None -> r
| Some (`String s) ->
if String.equal s match_v then
let target_val = field ~k:target_k x in
target_val :: r
else r
| Some _ -> r in
match json_arr with
| `A l ->
List.fold_right l ~init:[] ~f:(foldf match_key match_val target_key)
| _ -> []
let match_in_array_first (match_key : string) (match_val : string)
(target_key : string) (json_arr : Ezjsonm.value) : Ezjsonm.value =
let xs = match_in_array match_key match_val target_key json_arr in
match xs with
| [] ->
ksprintf failwith
"Jqo.match_in_array_first - empty result list for match_key:%s, \
match_val:%s, target_key:%s"
match_key match_val target_key
| x :: _ -> x
let get_string = Ezjsonm.get_string
let get_strings = Ezjsonm.get_strings
let get_int = Ezjsonm.get_int
let get_list = Ezjsonm.get_list (fun e -> e)
let get_list_element v index =
match v with
| `A l ->
if List.length l < index then
ksprintf failwith "Jqo.get_list_element - invalid index: %d" index
else List.nth_exn l index
| other ->
ksprintf failwith "Jqo.get_list_element - Not a list: %s"
(to_string other)
end
......@@ -88,7 +88,7 @@ module Full_default_state = struct
let default_root = sprintf "/tmp/%s-test" base_state#command_name in
let pauser = Interactive_test.Pauser.make [] in
let ops = Log_recorder.Operations.make () in
let state console paths interactivity =
let state console paths interactivity (`With_baking baking) =
object
method paths = paths
......@@ -100,6 +100,8 @@ module Full_default_state = struct
method test_interactivity = interactivity
method test_baking = baking
method pauser = pauser
method operations_log = ops
......@@ -107,14 +109,22 @@ module Full_default_state = struct
method env_config = base_state#env_config
end in
let open Cmdliner in
let docs = Manpage_builder.section_test_scenario base_state in
Term.(
pure state $ Console.cli_term ()
$ Paths.cli_term ~default_root ()
$
if disable_interactivity then pure `None
else
Interactive_test.Interactivity.cli_term ?default:default_interactivity
())
$ ( if disable_interactivity then pure `None
else
Interactive_test.Interactivity.cli_term
?default:default_interactivity () )
$ Arg.(
pure (fun x -> `With_baking (not x))
$ value
(flag
(info ["no-baking"] ~docs
~doc:
"Completely disable baking/endorsing/accusing (you need \
to bake manually to make the chain advance)."))))
end
let cli_state ?default_interactivity ?disable_interactivity ~name () =
......
......@@ -34,6 +34,8 @@ module Command_making_state : sig
; command_name: string
; env_config: Environment_configuration.t
; manpager: Manpage_builder.State.t >
(* ; test_baking: bool > *)
end
(** Make {!Cmdliner} commands from {!Asynchronous_result} functions. *)
......@@ -66,7 +68,8 @@ module Full_default_state : sig
; paths: Paths.t
; pauser: Interactive_test.Pauser.t
; runner: Running_processes.State.t
; test_interactivity: Interactive_test.Interactivity.t >
; test_interactivity: Interactive_test.Interactivity.t
; test_baking: bool >
Cmdliner.Term.t
end
......@@ -83,6 +86,7 @@ val cli_state :
; paths: Paths.t
; pauser: Interactive_test.Pauser.t
; runner: Running_processes.State.t
; test_interactivity: Interactive_test.Interactivity.t >
; test_interactivity: Interactive_test.Interactivity.t
; test_baking: bool >
Cmdliner.Term.t
(** Create a full [state] value for test-scenarios. *)
......@@ -266,34 +266,71 @@ let show_known_contract state client ~name =
successful_client_cmd state ~client ["show"; "known"; "contract"; name]
>>= fun res -> return (String.concat res#out)
let deploy_multisig state client ~name ~amt ~from_acct ~threshold ~signer_names
~burn_cap =
let deploy_multisig ?counter state client ~name ~amt ~from_acct ~threshold
~signer_names ~burn_cap =
let counter_args =
match counter with Some c -> ["--counter"; Int.to_string c] | None -> []
in
client_cmd state ~client
(List.concat
[ [ "deploy"; "multisig"; name; "transferring"; sprintf "%f" amt; "from"
; from_acct; "with"; "threshold"; Int.to_string threshold; "on"
; "public"; "keys" ]
; signer_names
; ["--burn-cap"; sprintf "%f" burn_cap; "--force"] ])
; ["--burn-cap"; sprintf "%f" burn_cap; "--force"]
; counter_args ])
>>= fun _ -> return ()
let sign_multisig state client ~name ~amt ~to_acct ~signer_name =
client_cmd state ~client
[ "sign"; "multisig"; "transaction"; "on"; name; "transferring"
let sign_multisig state client ~contract ~amt ~to_acct ~signer_name =
let params =
[ "sign"; "multisig"; "transaction"; "on"; contract; "transferring"
; sprintf "%f" amt; "to"; to_acct; "using"; "secret"; "key"; signer_name ]
in
client_cmd state ~client params
>>= fun (_, sign_res) -> return (String.concat ~sep:"" sign_res#out)
let transfer_from_multisig state client ~name ~amt ~to_acct ~on_behalf_acct
~signatures ~burn_cap =
let transfer_from_multisig ?counter state client ~name ~amt ~to_acct
~on_behalf_acct ~signatures ~burn_cap =
let counter_args =
match counter with Some c -> ["--counter"; Int.to_string c] | None -> []
in
client_cmd state ~client
(List.concat
[ [ "from"; "multisig"; "contract"; name; "transfer"; sprintf "%f" amt
; "to"; to_acct; "on"; "behalf"; "of"; on_behalf_acct; "with"
; "signatures" ]
; signatures
; ["--burn-cap"; sprintf "%f" burn_cap] ])
; ["--burn-cap"; sprintf "%f" burn_cap]
; counter_args ])
>>= fun _ -> return ()
let hash_data state ?gas client ~data_to_hash ~data_type =
let the_list = ["hash"; "data"; data_to_hash; "of"; "type"; data_type] in
let the_list' =
match gas with
| None -> the_list
| Some g -> the_list @ ["--gas"; Int.to_string g] in
successful_client_cmd state ~client the_list'
>>= fun res ->
let res_out = List.hd_exn res#out in
let cleaned =
match String.chop_prefix res_out ~prefix:"Raw packed data: " with
| Some s -> s
| None -> res_out in
return cleaned
let multisig_storage_counter state client contract_id =
let path =
sprintf "/chains/main/blocks/head/context/contracts/%s/storage" contract_id
in
rpc state ~client `Get ~path
>>= fun sto ->
let args_array = Jqo.field ~k:"args" sto in
let fst_arg = Jqo.get_list_element args_array 0 in
let counter_val = Jqo.field ~k:"int" fst_arg in
try return (Int.of_string (Jqo.get_string counter_val))
with e -> System_error.fail_fatalf "Exception getting counter: %a" Exn.pp e
module Ledger = struct
type hwm = {main: int; test: int; chain: Tezos_crypto.Chain_id.t option}
......@@ -427,21 +464,25 @@ module Keyed = struct
["generate"; "nonce"; "hash"; "for"; key_name; "from"; data]
>>= fun res -> return (List.hd_exn res#out)
let forge_and_inject state {client; key_name; _} ~json =
rpc state ~client ~path:"/chains/main/blocks/head/helpers/forge/operations"
let sign_bytes state client ~bytes ~key_name =
successful_client_cmd state ~client:client.client
["sign"; "bytes"; bytes; "for"; key_name]
>>= fun sign_res -> return (List.hd_exn sign_res#out)
let forge_and_inject state keyed_client ~json =
rpc state ~client:keyed_client.client
~path:"/chains/main/blocks/head/helpers/forge/operations"
(`Post (Ezjsonm.value_to_string json))
>>= fun res ->
let operation_bytes = match res with `String s -> s | _ -> assert false in
let bytes_to_sign = "0x03" ^ operation_bytes in
successful_client_cmd state ~client
["sign"; "bytes"; bytes_to_sign; "for"; key_name]
sign_bytes state keyed_client ~bytes:bytes_to_sign (*operation_bytes*)
~key_name:keyed_client.key_name
>>= fun sign_res ->
let to_decode =
List.hd_exn sign_res#out
|> String.chop_prefix_exn ~prefix:"Signature:"
|> String.strip in
say state EF.(desc (shout "TO DECODE:") (af "%S" to_decode))
>>= fun () ->
String.chop_prefix_exn ~prefix:"Signature:" sign_res |> String.strip
in
Dbg.e EF.(af "To Decode: %s" to_decode) ;
let decoded =
Option.value_exn ~message:"base58 dec"
(Tezos_crypto.Base58.safe_decode to_decode)
......@@ -460,6 +501,84 @@ module Keyed = struct
(af "%d: %S" (String.length actual_signature) actual_signature)
])
>>= fun () ->
rpc state ~client ~path:"/injection/operation?chain=main"
rpc state ~client:keyed_client.client
~path:"/injection/operation?chain=main"
(`Post (sprintf "\"%s%s\"" operation_bytes actual_signature))
let find_mempool_counter_exn (json : Ezjsonm.value) hash_key : int =
match json with
| `O _ -> (
let z = Jqo.field ~k:"applied" json in
match z with
| `A trans_list ->
let foldf acc x =
let contents_list = Jqo.field ~k:"contents" x in
let more_counters =
Jqo.match_in_array "source" hash_key "counter" contents_list
in
more_counters @ acc in
let to_ints (strs : string list) : int list =
List.map strs ~f:(fun s -> Int.of_string s) in
let to_max_int (ints : int list) : int =
List.fold ints ~init:0 ~f:(fun acc x -> Int.max acc x) in
let counters = List.fold trans_list ~init:[] ~f:foldf in
let counter_strs =
List.map ~f:(fun v -> Jqo.get_string v) counters in
let max_int = to_max_int (to_ints counter_strs) in
max_int
| _ -> 0 )
| _ -> 0
let operations_from_chain state keyed_client =
rpc state ~client:keyed_client.client `Get
~path:(Fmt.str "/chains/main/blocks/head/operations")
>>= fun ops_json -> return ops_json
let find_contract_id_exn (json : Ezjsonm.value) (orig_hash : string) =
let ops = Jqo.get_list_element json 3 in
let op = Jqo.match_in_array_first "hash" orig_hash "contents" ops in
let meta = Jqo.match_in_array_first "kind" "origination" "metadata" op in
let res = Jqo.field ~k:"operation_result" meta in
let orig_list = Jqo.field ~k:"originated_contracts" res in
Jqo.get_string (Jqo.get_list_element orig_list 0)
let get_contract_id state client origination_hash =
operations_from_chain state client
>>= fun ops_json ->
try return (find_contract_id_exn ops_json origination_hash)
with e ->
System_error.fail_fatalf "Exception getting contract_id: %a" Exn.pp e
let counter_from_chain state keyed_client =
get_account state ~client:keyed_client.client ~name:keyed_client.key_name
>>= fun acct ->
match acct with
| None ->
System_error.fail_fatalf
"counter_from_chain - failed to parse account."
| Some a ->
let src = Tezos_protocol.Account.pubkey_hash a in
rpc state ~client:keyed_client.client `Get
~path:
(Fmt.str "/chains/main/blocks/head/context/contracts/%s/counter"
src)
>>= fun counter_json ->
return (Jqo.get_string counter_json |> Int.of_string)
let update_counter ?current_counter_override state client _dbg_str =
let the_match =
match current_counter_override with
| None -> counter_from_chain state client
| Some c -> return (Int.max (c - 1) 0) in
the_match
>>= fun current_counter ->
rpc state ~client:client.client `Get
~path:"/chains/main/mempool/pending_operations"
>>= fun json ->
let pubkey_hash = Tezos_protocol.Key.Of_name.pubkey_hash client.key_name in
let new_counter =
try find_mempool_counter_exn json pubkey_hash with _ -> current_counter
in
let max = Int.max current_counter new_counter + 1 in
return max
end
......@@ -227,7 +227,8 @@ val show_known_contract :
Asynchronous_result.t
val deploy_multisig :
< application_name: string
?counter:int
-> < application_name: string
; console: Console.t
; paths: Paths.t
; env_config: Environment_configuration.t
......@@ -252,7 +253,7 @@ val sign_multisig :
; runner: Running_processes.State.t
; .. >