From 24b28fcac5a1f3b7cee9fd3e3e023dc2fc30e6a1 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Wed, 27 Feb 2019 17:27:56 -0500 Subject: [PATCH 01/49] =?UTF-8?q?Flextesa:=20rename=20`Tezos=5Fexecutable.?= =?UTF-8?q?node=20=E2=86=92=20make`?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/lib_network_sandbox/tezos_executable.ml | 4 ++-- src/lib_network_sandbox/tezos_executable.mli | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/lib_network_sandbox/tezos_executable.ml b/src/lib_network_sandbox/tezos_executable.ml index 6531f7dfc35a..08424a7078d0 100644 --- a/src/lib_network_sandbox/tezos_executable.ml +++ b/src/lib_network_sandbox/tezos_executable.ml @@ -23,8 +23,8 @@ type 'kind t = ; unix_files_sink: Unix_files_sink.t option ; environment: (string * string) list } -let node ?binary ?unix_files_sink ?(environment = []) () = - {kind= `Node; binary; unix_files_sink; environment} +let make ?binary ?unix_files_sink ?(environment = []) (kind : [< kind]) = + {kind; binary; unix_files_sink; environment} let kind_string (kind : [< kind]) = match kind with diff --git a/src/lib_network_sandbox/tezos_executable.mli b/src/lib_network_sandbox/tezos_executable.mli index 16b3c32cd0b4..1e5a45e8a0c6 100644 --- a/src/lib_network_sandbox/tezos_executable.mli +++ b/src/lib_network_sandbox/tezos_executable.mli @@ -27,12 +27,12 @@ type 'kind t = private ; unix_files_sink: Unix_files_sink.t option ; environment: (string * string) list } -val node : +val make : ?binary:string -> ?unix_files_sink:Unix_files_sink.t -> ?environment:(string * string) list - -> unit - -> [> `Node] t + -> ([< kind] as 'a) + -> 'a t (** Create a ["tezos-node"] executable. *) val kind_string : [< kind] -> string -- GitLab From f2300c7a746918d6995b36b74991ea41ad813930 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Thu, 28 Feb 2019 17:54:04 -0500 Subject: [PATCH 02/49] Flextesa: make protocol switch happen in voting --- src/bin_flextesa/command_voting.ml | 170 +++++++++++++++++------ src/lib_network_sandbox/tezos_client.mli | 2 +- 2 files changed, 132 insertions(+), 40 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 41e6fb88e834..f70f9979eda4 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -87,7 +87,8 @@ let bake_until_voting_period ?keep_alive_delegate state ~baker ~attempts period >>= fun () -> return (`Not_done (sprintf "Waiting for %S period" period_name)) ) -let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port +let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec + ~clueless_winner ~admin_exec ~winner_client_exec ~size ~base_port ~serialize_proposals ?with_ledger () = let default_attempts = 35 in Helpers.clear_root state @@ -99,8 +100,10 @@ let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port let open Tezos_protocol in let d = default () in let baker = List.nth_exn d.bootstrap_accounts 0 in + let hash = current_hash in ( { d with - time_between_blocks= [1; 0] + hash + ; time_between_blocks= [1; 0] ; bootstrap_accounts= List.map d.bootstrap_accounts ~f:(fun (n, v) -> if fst baker = n then (n, v) else (n, 1_000L) ) } @@ -225,21 +228,42 @@ let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port Tezos_admin_client.successful_command admin_0 state ["list"; "protocols"] >>= fun res -> let default_protocols = res#out in - let make_and_inject_protocol name = + let make_and_inject_protocol name path = let tmpdir = Paths.root state // sprintf "protocol-%s" name in Console.say state EF.(wf "Injecting protocol from %s" tmpdir) >>= fun () -> - Running_processes.run_successful_cmdf state - "cp -L -r %s %s && echo '(* Protocol %s *)' >> %s/main.mli" - (Filename.quote (Filename.dirname demo_path)) (Filename.quote tmpdir) name + (* +Running_processes.run_successful_cmdf state + "cp -r %s %s && echo '(* Protocol %s *)' >> %s/main.mli" + (Filename.quote demo_path) (Filename.quote tmpdir) name (Filename.quote tmpdir) + *) + Running_processes.run_successful_cmdf state "cp -r %s %s" + (Filename.quote path) (Filename.quote tmpdir) >>= fun _ -> Tezos_admin_client.successful_command admin_0 state ["inject"; "protocol"; tmpdir] - >>= fun res -> return () + >>= fun res -> + String.concat ~sep:" " res#out + |> String.split ~on:' ' |> List.map ~f:String.strip + |> (function + | _ :: _ :: hash :: _ when hash.[0] = 'P' -> return hash + | _ -> + failf "inject protocol: cannot parse hash of protocol: %s" + (String.concat ~sep:", " (List.map ~f:(sprintf "%S") res#out))) + >>= fun hash -> + Interactive_test.Pauser.generic state + EF. + [ af "Just injected %s (%s): %s" name path hash + ; markdown_verbatim (String.concat ~sep:"\n" res#out) ] + >>= fun () -> return hash in - Loop.n_times 3 (fun nth -> make_and_inject_protocol (sprintf "The%dth" nth)) - >>= fun () -> + make_and_inject_protocol "winner" winner_path + >>= fun winner_hash -> + make_and_inject_protocol "demo" demo_path + >>= fun demo_hash -> + (* Loop.n_times 3 (fun nth -> make_and_inject_protocol (sprintf "The%dth" nth)) + * >>= fun () -> *) Tezos_admin_client.successful_command admin_0 state ["list"; "protocols"] >>= fun res -> let after_injections_protocols = res#out in @@ -252,7 +276,11 @@ let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port af "`%s` (%s)" p ( if List.mem default_protocols p ~equal:String.equal then "previously known" - else "injected" ) )) ] + else + match p with + | _ when p = winner_hash -> "injected winner" + | _ when p = demo_hash -> "injected demo" + | _ -> "injected unknown" ) )) ] >>= fun () -> let new_protocols = List.filter after_injections_protocols ~f:(fun ph -> @@ -285,9 +313,10 @@ let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port List_sequential.iter new_protocols ~f:(fun one -> submit_proposals special_baker [one] ) ) >>= fun () -> - let winner = List.hd_exn new_protocols in + (* let winner = "Psd1ynUBhMZAeajwcZJAeq5NrxorM6UCU4GJqxZ7Bx2e9vUWB6z" in *) + (* let winner = "Pt24m4xiPbLDhVgVfABUjirbmda3yohdN82Sp9FeuAXJ4eV9otd" in *) Tezos_client.successful_client_cmd state ~client:baker_0.client - ["submit"; "proposals"; "for"; baker_0.key_name; winner] + ["submit"; "proposals"; "for"; baker_0.key_name; winner_hash] >>= fun res -> bake_until_voting_period state ~baker:baker_0 ~attempts:protocol.blocks_per_voting_period Testing_vote @@ -303,22 +332,23 @@ let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port Tezos_client.rpc state ~client:(client 1) `Get ~path:"/chains/main/blocks/head/votes/current_proposal" >>= fun current_proposal_json -> - if current_proposal_json <> `String winner then + if current_proposal_json <> `String winner_hash then return (`Not_done - (sprintf "Waiting for current_proposal_json to be %s (%s)" winner + (sprintf "Waiting for current_proposal_json to be %s (%s)" + winner_hash Ezjsonm.(to_string (wrap current_proposal_json)))) else return (`Done ()) ) >>= fun () -> Tezos_client.successful_client_cmd state ~client:baker_0.client - ["submit"; "ballot"; "for"; baker_0.key_name; winner; "yay"] + ["submit"; "ballot"; "for"; baker_0.key_name; winner_hash; "yay"] >>= fun _ -> Asynchronous_result.map_option with_ledger ~f:(fun _ -> ledger_prompt_notice state - EF.(wf "Submitting “Yes” ballot for %S" winner) ) + EF.(wf "Submitting “Yes” ballot for %S" winner_hash) ) >>= fun (_ : unit option) -> Tezos_client.successful_client_cmd state ~client:special_baker.client - ["submit"; "ballot"; "for"; special_baker.key_name; winner; "yay"] + ["submit"; "ballot"; "for"; special_baker.key_name; winner_hash; "yay"] >>= fun _ -> Interactive_test.Pauser.generic state EF.[af "Ballots are in (not baked though)"] @@ -342,7 +372,7 @@ let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port Jqo.field metadata_json ~k:"test_chain_status" |> Jqo.field ~k:"protocol" with - | `String s when s = winner -> return (`Done ()) + | `String s when s = winner_hash -> return (`Done ()) | other -> return (`Not_done @@ -367,14 +397,14 @@ let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port Interactive_test.Pauser.generic state EF.[haf "Before ballots"] >>= fun () -> Tezos_client.successful_client_cmd state ~client:baker_0.client - ["submit"; "ballot"; "for"; baker_0.key_name; winner; "yay"] + ["submit"; "ballot"; "for"; baker_0.key_name; winner_hash; "yay"] >>= fun _ -> Asynchronous_result.map_option with_ledger ~f:(fun _ -> ledger_prompt_notice state - EF.(wf "Submitting “Yes” ballot for %S" winner) ) + EF.(wf "Submitting “Yes” ballot for %S" winner_hash) ) >>= fun (_ : unit option) -> Tezos_client.successful_client_cmd state ~client:special_baker.client - ["submit"; "ballot"; "for"; special_baker.key_name; winner; "yay"] + ["submit"; "ballot"; "for"; special_baker.key_name; winner_hash; "yay"] >>= fun _ -> Interactive_test.Pauser.generic state EF.[af "Final ballot(s) are in (not baked though)"] @@ -398,6 +428,17 @@ let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port client_exec.binary) (String.concat ~sep:", " client_protocols_result#out) ] >>= fun () -> + let new_baker = + let open Tezos_client.Keyed in + {baker_0 with client= {baker_0.client with exec= winner_client_exec}} + in + Interactive_test.Pauser.add_commands state + Interactive_test.Commands. + [ arbitrary_command_on_clients state ~command_names:["nc"; "new-client"] + ~make_admin ~clients:[new_baker.client] ] ; + Interactive_test.Pauser.generic state ~force:true + EF.[wf "You can now try the new-client"] + >>= fun () -> Helpers.wait_for state ~seconds:0.5 ~attempts:(1 + protocol.blocks_per_voting_period) (fun nth -> let client = baker_0.client in @@ -407,7 +448,7 @@ let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port let json_string = curl_res#out |> String.concat ~sep:"\n" in let json_metadata = Ezjsonm.from_string json_string in match Jqo.field json_metadata ~k:"next_protocol" with - | `String p when p = winner -> return (`Done (nth - 1)) + | `String p when p = winner_hash -> return (`Done (nth - 1)) | other -> transfer state ~client ~amount:1L ~src:baker_0.Tezos_client.Keyed.key_name @@ -416,33 +457,53 @@ let run state ~demo_path ~node_exec ~client_exec ~admin_exec ~size ~base_port ksprintf (Tezos_client.Keyed.bake state baker_0) "Baker %s bakes %d/%d waiting for next protocol: %S" client.id nth - attempts winner + attempts winner_hash >>= fun () -> return (`Not_done - (sprintf "Waiting for next_protocol: %S (≠ %s)" winner + (sprintf "Waiting for next_protocol: %S (≠ %s)" winner_hash Ezjsonm.(to_string (wrap other)))) ) >>= fun extra_bakes_waiting_for_next_protocol -> Counter_log.add level_counter "wait-for-next-protocol" extra_bakes_waiting_for_next_protocol ; + Tezos_client.successful_client_cmd state ~client:new_baker.client + ["list"; "understood"; "protocols"] + >>= fun winner_client_protocols_result -> ( match - List.find client_protocols_result#out ~f:(fun prefix -> - String.is_prefix winner ~prefix ) + List.find winner_client_protocols_result#out ~f:(fun prefix -> + String.is_prefix winner_hash ~prefix ) with - | Some p -> Console.say state EF.(wf "The client knows about %s" winner) + | Some p -> ( + Console.say state EF.(wf "The client knows about %s" winner_hash) + >>= fun () -> + Tezos_client.successful_client_cmd state ~client:new_baker.client + ["upgrade"; "baking"; "state"] + >>= fun _ -> + Tezos_client.Keyed.bake state new_baker "First bake on new protocol !!" + >>= fun () -> + Counter_log.incr level_counter "bake-on-new-protocol" ; + Tezos_client.rpc state ~client:new_baker.client `Get + ~path:"/chains/main/blocks/head/metadata" + >>= fun json_metadata -> + match Jqo.field json_metadata ~k:"protocol" with + | `String p when p = winner_hash -> return () + | other -> + failf "Protocol is not `%s` but `%s`" winner_hash + Ezjsonm.(to_string (wrap other)) ) (* TODO: - - make winner a protocol that the client knows - bake on test chain - - test protocol switch - test ≠ not-enough-votes “failures” *) | None -> - Console.say state EF.(wf "The client does not know about %s" winner) ) + if clueless_winner then + Console.say state + EF.(wf "As expected, the client does not know about %s" winner_hash) + else failf "The winner-client does not know about `%s`" winner_hash ) >>= fun () -> Interactive_test.Pauser.generic state EF. - [ haf "End of Current WIP of the Voting test: SUCCESS \\o/" + [ haf "End of the Voting test: SUCCESS \\o/" ; desc (af "Estimated level: %d" (Counter_log.sum level_counter)) (markdown_verbatim (Counter_log.to_table_string level_counter)) ] @@ -453,11 +514,15 @@ let cmd ~pp_error () = let open Term in Test_command_line.Run_command.make ~pp_error ( pure - (fun demo_path + (fun winner_path + demo_path node_exec client_exec admin_exec + winner_client_exec size + (`Clueless_winner clueless_winner) + (`Hash current_hash) (`Base_port base_port) (`With_ledger with_ledger) (`Serialize_proposals serialize_proposals) @@ -465,18 +530,45 @@ let cmd ~pp_error () = -> ( state , Interactive_test.Pauser.run_test state ~pp_error - (run state ~serialize_proposals ~demo_path ~node_exec ~size - ~admin_exec ~base_port ~client_exec ?with_ledger) ) ) + (run state ~serialize_proposals ~current_hash ~winner_path + ~clueless_winner ~demo_path ~node_exec ~size ~admin_exec + ~base_port ~client_exec ~winner_client_exec ?with_ledger) ) ) $ Arg.( required (pos 0 (some string) None - (info [] ~docv:"PROTOCOL-PATH" + (info [] ~docv:"WINNER-PROTOCOL-PATH" ~doc: - "The protocol to inject, e.g. `./src/bin_client/test/demo/`."))) - $ Tezos_executable.cli_term `Node "tezos" - $ Tezos_executable.cli_term `Client "tezos" - $ Tezos_executable.cli_term `Admin "tezos" + "The protocol to inject and make win the election, e.g. \ + `src/proto_004_Pt24m4xi/lib_protocol/src`."))) + $ Arg.( + required + (pos 1 (some string) None + (info [] ~docv:"LOOSER-PROTOCOL-PATH" + ~doc: + "The protocol to inject and down-vote, e.g. \ + `./src/bin_client/test/demo/`."))) + $ Tezos_executable.cli_term `Node "current" + $ Tezos_executable.cli_term `Client "current" + $ Tezos_executable.cli_term `Admin "current" + $ Tezos_executable.cli_term `Client "winner" $ Arg.(value (opt int 5 (info ["size"; "S"] ~doc:"Size of the Network."))) + $ Arg.( + pure (fun b -> `Clueless_winner b) + $ value + (flag + (info + ["winning-client-is-clueless"] + ~doc: + "Do not fail if the client does not know about “next” \ + protocol."))) + $ Arg.( + pure (fun p -> `Hash p) + $ value + (opt string "PsddFKi32cMJ2qPjf43Qv5GDWLDPZb3T3bF6fLKiF5HtvHNU7aP" + (info ["current-hash"] + ~doc: + "The hash to advertise as the current protocol, the \ + default is `proto_003_PsddFki3`."))) $ Arg.( pure (fun p -> `Base_port p) $ value diff --git a/src/lib_network_sandbox/tezos_client.mli b/src/lib_network_sandbox/tezos_client.mli index 49c8b679baa3..1d6250b56caf 100644 --- a/src/lib_network_sandbox/tezos_client.mli +++ b/src/lib_network_sandbox/tezos_client.mli @@ -1,7 +1,7 @@ (** Wrapper around the main ["tezos-client"] application. *) open Internal_pervasives -type t = private {id: string; port: int; exec: [`Client] Tezos_executable.t} +type t = {id: string; port: int; exec: [`Client] Tezos_executable.t} type client = t val of_node : exec:[`Client] Tezos_executable.t -> Tezos_node.t -> t -- GitLab From ecfcc6676f20fff3d7e589c114e9632143600040 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Thu, 28 Feb 2019 18:10:19 -0500 Subject: [PATCH 03/49] Flextesa: fix interactivity of a pause --- src/bin_flextesa/command_voting.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index f70f9979eda4..abd8f0e1c321 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -436,7 +436,7 @@ Running_processes.run_successful_cmdf state Interactive_test.Commands. [ arbitrary_command_on_clients state ~command_names:["nc"; "new-client"] ~make_admin ~clients:[new_baker.client] ] ; - Interactive_test.Pauser.generic state ~force:true + Interactive_test.Pauser.generic state EF.[wf "You can now try the new-client"] >>= fun () -> Helpers.wait_for state ~seconds:0.5 -- GitLab From 3bac7165129c7d08474f75027ba8aff383a179c4 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Thu, 28 Feb 2019 18:10:41 -0500 Subject: [PATCH 04/49] Flextesa: fix `@runtest_sandbox_voting_demo` --- src/bin_flextesa/command_voting.ml | 19 ++++++++++++------- src/bin_flextesa/dune | 9 ++++++--- .../internal_pervasives.ml | 13 ++++++++++--- 3 files changed, 28 insertions(+), 13 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index abd8f0e1c321..870bab0454a6 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -100,7 +100,7 @@ let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec let open Tezos_protocol in let d = default () in let baker = List.nth_exn d.bootstrap_accounts 0 in - let hash = current_hash in + let hash = Option.value ~default:d.hash current_hash in ( { d with hash ; time_between_blocks= [1; 0] @@ -228,7 +228,7 @@ let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec Tezos_admin_client.successful_command admin_0 state ["list"; "protocols"] >>= fun res -> let default_protocols = res#out in - let make_and_inject_protocol name path = + let make_and_inject_protocol ?(make_different = false) name path = let tmpdir = Paths.root state // sprintf "protocol-%s" name in Console.say state EF.(wf "Injecting protocol from %s" tmpdir) >>= fun () -> @@ -241,6 +241,12 @@ Running_processes.run_successful_cmdf state Running_processes.run_successful_cmdf state "cp -r %s %s" (Filename.quote path) (Filename.quote tmpdir) >>= fun _ -> + ( if make_different then + Running_processes.run_successful_cmdf state + "echo '(* Protocol %s *)' >> %s/main.mli" name (Filename.quote tmpdir) + >>= fun _ -> return () + else return () ) + >>= fun () -> Tezos_admin_client.successful_command admin_0 state ["inject"; "protocol"; tmpdir] >>= fun res -> @@ -260,7 +266,8 @@ Running_processes.run_successful_cmdf state in make_and_inject_protocol "winner" winner_path >>= fun winner_hash -> - make_and_inject_protocol "demo" demo_path + make_and_inject_protocol ~make_different:(winner_path = demo_path) "demo" + demo_path >>= fun demo_hash -> (* Loop.n_times 3 (fun nth -> make_and_inject_protocol (sprintf "The%dth" nth)) * >>= fun () -> *) @@ -564,11 +571,9 @@ let cmd ~pp_error () = $ Arg.( pure (fun p -> `Hash p) $ value - (opt string "PsddFKi32cMJ2qPjf43Qv5GDWLDPZb3T3bF6fLKiF5HtvHNU7aP" + (opt (some string) None (info ["current-hash"] - ~doc: - "The hash to advertise as the current protocol, the \ - default is `proto_003_PsddFki3`."))) + ~doc:"The hash to advertise as the current protocol."))) $ Arg.( pure (fun p -> `Base_port p) $ value diff --git a/src/bin_flextesa/dune b/src/bin_flextesa/dune index da1155372072..32af162a23f5 100644 --- a/src/bin_flextesa/dune +++ b/src/bin_flextesa/dune @@ -31,14 +31,17 @@ (locks /tcp-port/30000_range) (action (run %{exe:main.exe} voting + %{lib:tezos-embedded-protocol-demo:raw/TEZOS_PROTOCOL} %{lib:tezos-embedded-protocol-demo:raw/TEZOS_PROTOCOL} --root-path %{env:ROOT_PATH=/tmp/flextesa-voting-demo/} --base-port 30_000 --size 3 --with-timestamp - --tezos-client-binary %{bin:tezos-client} - --tezos-admin-client-binary %{bin:tezos-admin-client} - --tezos-node-binary %{bin:tezos-node} + --winning-client-is-clueless + --winner-client-binary %{bin:tezos-client} + --current-client-binary %{bin:tezos-client} + --current-admin-client-binary %{bin:tezos-admin-client} + --current-node-binary %{bin:tezos-node} ))) (alias diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index 0354af42da3b..2893f6b319fd 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -222,9 +222,16 @@ module Process_result = struct let pp fmt = function | (`Wrong_status (res, msg) : [< t]) -> - Format.fprintf fmt "Process-error, wrong status: '%s': %s" - (status_to_string res#status) - msg + Format.( + fprintf fmt "Process-error, wrong status:@ '%s':@ %s" + (status_to_string res#status) + msg ; + fprintf fmt "@.```out@." ; + List.iter res#out ~f:(fprintf fmt " | %s@.") ; + fprintf fmt "@.```@." ; + fprintf fmt "@.```err@." ; + List.iter res#err ~f:(fprintf fmt " | %s@.") ; + fprintf fmt "@.```@.") let fail_if_non_zero (res : output) msg = if res#status <> Unix.WEXITED 0 then -- GitLab From 100c7b21e895a8170cb4ae9b6a886c6c0280fd28 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 1 Mar 2019 10:28:34 -0500 Subject: [PATCH 05/49] Flextesa: fix test for clueless client --- src/bin_flextesa/command_voting.ml | 41 ++++++++++++------- .../internal_pervasives.ml | 2 + 2 files changed, 29 insertions(+), 14 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 870bab0454a6..52cbd84f92f8 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -473,14 +473,31 @@ Running_processes.run_successful_cmdf state >>= fun extra_bakes_waiting_for_next_protocol -> Counter_log.add level_counter "wait-for-next-protocol" extra_bakes_waiting_for_next_protocol ; - Tezos_client.successful_client_cmd state ~client:new_baker.client - ["list"; "understood"; "protocols"] - >>= fun winner_client_protocols_result -> - ( match - List.find winner_client_protocols_result#out ~f:(fun prefix -> - String.is_prefix winner_hash ~prefix ) - with - | Some p -> ( + Asynchronous_result.bind_on_result + (Tezos_client.successful_client_cmd state ~client:new_baker.client + ["list"; "understood"; "protocols"]) + ~f:(function + | Ok winner_client_protocols_result -> + ( + match List.find winner_client_protocols_result#out ~f:(fun prefix -> + String.is_prefix winner_hash ~prefix ) + with + | Some p -> + return `Continue + | None when clueless_winner -> + return `End_with_success + | None -> return `End_with_failure + ) + | Error Error.{error_value = `Client_command_error _ ; _ } when clueless_winner -> + return `End_with_success + | Error e -> Asynchronous_result.error e) + >>= (function + | `End_with_success -> + Console.say state + EF.(wf "As expected, the client does not know about %s" winner_hash) + | `End_with_failure -> + failf "The winner-client does not know about `%s`" winner_hash + | `Continue -> Console.say state EF.(wf "The client knows about %s" winner_hash) >>= fun () -> Tezos_client.successful_client_cmd state ~client:new_baker.client @@ -497,17 +514,13 @@ Running_processes.run_successful_cmdf state | other -> failf "Protocol is not `%s` but `%s`" winner_hash Ezjsonm.(to_string (wrap other)) ) + >>= fun () -> (* + TODO: - bake on test chain - test ≠ not-enough-votes “failures” *) - | None -> - if clueless_winner then - Console.say state - EF.(wf "As expected, the client does not know about %s" winner_hash) - else failf "The winner-client does not know about `%s`" winner_hash ) - >>= fun () -> Interactive_test.Pauser.generic state EF. [ haf "End of the Voting test: SUCCESS \\o/" diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index 2893f6b319fd..3302df7535ce 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -116,6 +116,8 @@ module Asynchronous_result = struct let fail ?attach error_value : (_, _) t = Lwt.return (Error (Error.make ?attach error_value)) + let error e : (_, _) t = Lwt.return (Error e) + let bind (o : (_, _) t) f : (_, _) t = let open Lwt.Infix in o -- GitLab From 149aced004839fce0c77631d4e9f4cba7a9addd8 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 1 Mar 2019 17:18:33 -0500 Subject: [PATCH 06/49] Flextesa: improve reliability --- src/bin_flextesa/command_voting.ml | 113 ++++++++++++++++------------- 1 file changed, 64 insertions(+), 49 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 52cbd84f92f8..919f5ed1c8df 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -134,6 +134,18 @@ let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec in Tezos_client.Keyed.initialize state baker_0 >>= fun _ -> + let winner_baker = + let open Tezos_client.Keyed in + {baker_0 with client= {baker_0.client with exec= winner_client_exec}} + in + Interactive_test.Pauser.add_commands state + Interactive_test.Commands. + [ arbitrary_command_on_clients state + ~command_names:["wc"; "winner-client"] ?make_admin:None + ~clients:[winner_baker.client] ] ; + Interactive_test.Pauser.generic state + EF.[wf "You can now try the new-client"] + >>= fun () -> let level_counter = Counter_log.create () in let first_bakes = 5 in Loop.n_times first_bakes (fun nth -> @@ -370,6 +382,8 @@ Running_processes.run_successful_cmdf state ~attempts:default_attempts ~seconds:8. nodes (`At_least (Counter_log.sum level_counter)) >>= fun () -> + Interactive_test.Pauser.generic state EF.[wf "Testing period, have fun."] + >>= fun () -> Helpers.wait_for state ~attempts:default_attempts ~seconds:0.3 (fun nth -> Tezos_client.rpc state ~client:(client 1) `Get ~path:"/chains/main/blocks/head/metadata" @@ -435,17 +449,6 @@ Running_processes.run_successful_cmdf state client_exec.binary) (String.concat ~sep:", " client_protocols_result#out) ] >>= fun () -> - let new_baker = - let open Tezos_client.Keyed in - {baker_0 with client= {baker_0.client with exec= winner_client_exec}} - in - Interactive_test.Pauser.add_commands state - Interactive_test.Commands. - [ arbitrary_command_on_clients state ~command_names:["nc"; "new-client"] - ~make_admin ~clients:[new_baker.client] ] ; - Interactive_test.Pauser.generic state - EF.[wf "You can now try the new-client"] - >>= fun () -> Helpers.wait_for state ~seconds:0.5 ~attempts:(1 + protocol.blocks_per_voting_period) (fun nth -> let client = baker_0.client in @@ -474,46 +477,58 @@ Running_processes.run_successful_cmdf state Counter_log.add level_counter "wait-for-next-protocol" extra_bakes_waiting_for_next_protocol ; Asynchronous_result.bind_on_result - (Tezos_client.successful_client_cmd state ~client:new_baker.client - ["list"; "understood"; "protocols"]) + (Tezos_client.successful_client_cmd state ~client:winner_baker.client + ["list"; "understood"; "protocols"]) ~f:(function - | Ok winner_client_protocols_result -> - ( - match List.find winner_client_protocols_result#out ~f:(fun prefix -> - String.is_prefix winner_hash ~prefix ) - with - | Some p -> - return `Continue - | None when clueless_winner -> - return `End_with_success - | None -> return `End_with_failure - ) - | Error Error.{error_value = `Client_command_error _ ; _ } when clueless_winner -> - return `End_with_success - | Error e -> Asynchronous_result.error e) + | Ok winner_client_protocols_result -> ( + match + List.find winner_client_protocols_result#out ~f:(fun prefix -> + String.is_prefix winner_hash ~prefix ) + with + | Some p -> return `Continue + | None when clueless_winner -> return `End_with_success + | None -> return `End_with_failure ) + | Error Error.{error_value= `Client_command_error _; _} + when clueless_winner -> + return `End_with_success + | Error e -> Asynchronous_result.error e) >>= (function - | `End_with_success -> - Console.say state - EF.(wf "As expected, the client does not know about %s" winner_hash) - | `End_with_failure -> - failf "The winner-client does not know about `%s`" winner_hash - | `Continue -> - Console.say state EF.(wf "The client knows about %s" winner_hash) - >>= fun () -> - Tezos_client.successful_client_cmd state ~client:new_baker.client - ["upgrade"; "baking"; "state"] - >>= fun _ -> - Tezos_client.Keyed.bake state new_baker "First bake on new protocol !!" - >>= fun () -> - Counter_log.incr level_counter "bake-on-new-protocol" ; - Tezos_client.rpc state ~client:new_baker.client `Get - ~path:"/chains/main/blocks/head/metadata" - >>= fun json_metadata -> - match Jqo.field json_metadata ~k:"protocol" with - | `String p when p = winner_hash -> return () - | other -> - failf "Protocol is not `%s` but `%s`" winner_hash - Ezjsonm.(to_string (wrap other)) ) + | `End_with_success -> + Console.say state + EF.( + wf "As expected, the client does not know about %s" winner_hash) + | `End_with_failure -> + failf "The winner-client does not know about `%s`" winner_hash + | `Continue -> ( + Console.say state EF.(wf "The client knows about %s" winner_hash) + >>= fun () -> + (* This actually depends on the protocol upgrade. *) + Asynchronous_result.bind_on_result + (Tezos_client.successful_client_cmd state + ~client:winner_baker.client + ["upgrade"; "baking"; "state"]) + ~f:(function + | Ok _ -> return () + | Error _ -> + Console.say state + EF.( + desc (shout "Warning") + (wf + "Command `upgrade baking state` failed, but we \ + keep going with the baking."))) + >>= fun () -> + Tezos_client.Keyed.bake state winner_baker + "First bake on new protocol !!" + >>= fun () -> + Counter_log.incr level_counter "bake-on-new-protocol" ; + Tezos_client.rpc state ~client:winner_baker.client `Get + ~path:"/chains/main/blocks/head/metadata" + >>= fun json_metadata -> + match Jqo.field json_metadata ~k:"protocol" with + | `String p when p = winner_hash -> return () + | other -> + failf "Protocol is not `%s` but `%s`" winner_hash + Ezjsonm.(to_string (wrap other)) )) >>= fun () -> (* -- GitLab From 7a9c9c84eed222ad14787b5c09b6fa980e637b45 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 1 Mar 2019 18:12:02 -0500 Subject: [PATCH 07/49] Flextesa: experiment with new `Asynchronous_result` --- src/bin_flextesa/command_voting.ml | 5 +- src/lib_network_sandbox/console.ml | 8 +- src/lib_network_sandbox/interactive_test.ml | 4 +- .../internal_pervasives.ml | 128 +++++++++++++----- src/lib_network_sandbox/running_processes.ml | 2 +- src/lib_network_sandbox/test_command_line.ml | 7 +- src/lib_network_sandbox/test_scenario.mli | 5 +- src/lib_network_sandbox/tezos_protocol.ml | 2 +- 8 files changed, 112 insertions(+), 49 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 919f5ed1c8df..5059ba36a2e4 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -488,10 +488,9 @@ Running_processes.run_successful_cmdf state | Some p -> return `Continue | None when clueless_winner -> return `End_with_success | None -> return `End_with_failure ) - | Error Error.{error_value= `Client_command_error _; _} - when clueless_winner -> + | Error (`Client_command_error _) when clueless_winner -> return `End_with_success - | Error e -> Asynchronous_result.error e) + | Error e -> fail e) >>= (function | `End_with_success -> Console.say state diff --git a/src/lib_network_sandbox/console.ml b/src/lib_network_sandbox/console.ml index 3516438d0874..8eb5400bf29a 100644 --- a/src/lib_network_sandbox/console.ml +++ b/src/lib_network_sandbox/console.ml @@ -153,12 +153,14 @@ module Prompt = struct List.mem m.commands c ~equal:String.equal ) with | Some {action; _} -> ( - Asynchronous_result.bind_on_error (action more) ~f:(fun err -> + Asynchronous_result.bind_on_error (action more) + ~f:(fun ~result _ -> say state EF.( desc (shout "Error in action:") - (custom (fun fmt -> - Error.pp fmt err ~error:(fun fmt -> function + (custom (fun ppf -> + Attached_result.pp ppf result (* Error.pp ppf err *) + ~pp_error:(fun fmt -> function | `Lwt_exn _ as e -> Lwt_exception.pp fmt e | `Command_line s -> Format.fprintf fmt "Wrong command line: %s" s diff --git a/src/lib_network_sandbox/interactive_test.ml b/src/lib_network_sandbox/interactive_test.ml index 3d304c21b523..a43d77a50ed0 100644 --- a/src/lib_network_sandbox/interactive_test.ml +++ b/src/lib_network_sandbox/interactive_test.ml @@ -481,12 +481,12 @@ module Pauser = struct say state EF.(wf "Test done, sleeping %.02f seconds" n) >>= fun () -> System.sleep n ) >>= fun () -> finish () ) - ~f:(fun {error_value; attachments} -> + ~f:(fun ~result error_value (* {error_value; attachments} *) -> generic state ~force:(Interactivity.pause_on_error state) EF. [ haf "Last pause before the test will Kill 'Em All and Quit." ; desc (shout "Error:") (af "%a" pp_error error_value) ] >>= fun () -> - finish () >>= fun () -> fail error_value ~attach:attachments ) + finish () >>= fun () -> fail error_value ~attach:result.attachments ) end diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index 3302df7535ce..48dffb310233 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -84,59 +84,121 @@ module Dbg = struct let pp_any fmt v = Dum.to_formatter fmt v end -(** An “typed error type” based on polymorphic variants *) -module Error = struct - type +'a t = - {error_value: 'a; attachments: (string * string) list} - constraint 'a = [> ] - - let make ?(attach = []) error_value = {error_value; attachments= attach} - - let pp ~error fmt {error_value; attachments} = - EF.( - label (shout "Error: ") - (list - [ custom (fun fmt -> error fmt error_value) - ; ocaml_list - (List.map attachments ~f:(fun (k, v) -> - ocaml_tuple [atom k; atom v] )) ]) - |> Easy_format.Pretty.to_formatter fmt) +(** An “decorated result type” based on polymorphic variants *) +module Attached_result = struct + type content = [`Text of string | `String_value of string] + + type ('ok, 'error) t = + {result: ('ok, 'error) result; attachments: (string * content) list} + constraint 'error = [> ] + + let ok ?(attachments = []) o = {result= Ok o; attachments} + let error ?(attachments = []) o = {result= Error o; attachments} + + let pp ppf ?pp_ok ?pp_error {result; attachments} = + let open Format in + ( match result with + | Ok o -> + pp_open_hvbox ppf 2 ; + pp_open_tag ppf "success" ; + pp_print_string ppf "OK" ; + pp_close_tag ppf () ; + Option.iter pp_ok ~f:(fun pp -> pp ppf o) ; + pp_close_box ppf () ; + () + | Error e -> + pp_open_hvbox ppf 2 ; + pp_open_tag ppf "shout" ; + pp_print_string ppf "ERROR" ; + pp_close_tag ppf () ; + Option.iter pp_error ~f:(fun pp -> pp ppf e) ; + pp_close_box ppf () ) ; + match attachments with + | [] -> () + | more -> + pp_print_newline ppf () ; + pp_open_hovbox ppf 4 ; + List.iter more ~f:(fun (k, v) -> + pp_print_if_newline ppf () ; + pp_print_string ppf "* " ; + fprintf ppf "%s:@ " k ; + match v with + | `Text s -> pp_print_text ppf s + | `String_value s -> fprintf ppf "%S" s ) end (** A wrapper around [('ok, 'a Error.t) result Lwt.t]. *) module Asynchronous_result = struct - type ('ok, 'a) t = ('ok, 'a Error.t) result Lwt.t + open Attached_result - let return o : (_, _) t = Lwt.return (Ok o) + type ('ok, 'error) t = ('ok, 'error) Attached_result.t Lwt.t + + let return o : (_, _) t = Lwt.return (ok o) let yield () = (* https://github.com/ocsigen/lwt/issues/631 *) if false then Lwt_unix.auto_yield 0.005 () else Lwt_main.yield () let fail ?attach error_value : (_, _) t = - Lwt.return (Error (Error.make ?attach error_value)) + Lwt.return (error ?attachments:attach error_value) - let error e : (_, _) t = Lwt.return (Error e) + (* let error e : (_, _) t = Lwt.return (error e) *) let bind (o : (_, _) t) f : (_, _) t = let open Lwt.Infix in o >>= function - | Ok o -> yield () >>= fun () -> f o | Error _ as e -> Lwt.return e - - let bind_on_error (o : (_, _) t) ~f : (_, _) t = - Lwt.bind o (function Ok o -> return o | Error e -> f e) + | {result= Ok o; attachments= attach} -> + yield () + >>= fun () -> + f o + >>= fun {result; attachments} -> + Lwt.return {result; attachments= attachments @ attach} + | {result= Error _; _} as e -> Lwt.return e + + let bind_on_error : + ('a, 'b) t + -> f:( result:('c, 'b) Attached_result.t + -> 'b + -> ('a, 'd) Attached_result.t Lwt.t) + -> ('a, 'd) t = + fun o ~f -> + let open Lwt.Infix in + o + >>= function + | {result= Ok _; _} as o -> Lwt.return o + | {result= Error e; attachments= attach} as res -> + f ~result:res e + >>= fun {result; attachments} -> + Lwt.return {result; attachments= attachments @ attach} let transform_error o ~f = - Lwt.bind o (function - | Ok o -> return o - | Error {Error.error_value; attachments} -> f error_value attachments ) + let open Lwt.Infix in + o + >>= function + | {result= Ok _; _} as o -> Lwt.return o + | {result= Error e; attachments} -> + Lwt.return {result= Error (f e); attachments} + + let bind_all : + ('ok, 'error) t + -> f:(('ok, 'error) Attached_result.t -> ('ok2, 'error2) t) + -> ('ok2, 'error2) t = + fun o ~f -> + let open Lwt.Infix in + o >>= fun res -> f res let bind_on_result : ('ok, 'error) t - -> f:(('ok, 'error Error.t) result -> ('ok2, 'error2) t) + -> f:(('ok, 'error) result -> ('ok2, 'error2) t) -> ('ok2, 'error2) t = - fun o ~f -> Lwt.bind o f + fun o ~f -> + let open Lwt.Infix in + o + >>= fun {result; attachments= attach} -> + f result + >>= fun {result; attachments} -> + Lwt.return {result; attachments= attachments @ attach} (** The module opened everywhere. *) module Std = struct let ( >>= ) = bind let return = return let fail = fail @@ -176,9 +238,9 @@ module Asynchronous_result = struct end let run_application r = - match Lwt_main.run (r ()) with - | Ok () -> exit 0 - | Error {Error.error_value= `Die ret; _} -> exit ret + match Lwt_main.run (r () : (_, _) t) with + | {result= Ok (); _} -> exit 0 + | {result= Error (`Die ret); _} -> exit ret end include Asynchronous_result.Std diff --git a/src/lib_network_sandbox/running_processes.ml b/src/lib_network_sandbox/running_processes.ml index 261a8458d36d..1e102a20f94a 100644 --- a/src/lib_network_sandbox/running_processes.ml +++ b/src/lib_network_sandbox/running_processes.ml @@ -109,7 +109,7 @@ let start t process = let date = Tezos_stdlib_unix.Systime_os.now () |> Tezos_base.Time.System.to_notation in let open_file f = - Lwt_exception.catch ~attach:[("open_file", f)] + Lwt_exception.catch ~attach:[("open_file", `String_value f)] Lwt.Infix.( fun () -> Tezos_stdlib_unix.Lwt_utils_unix.create_dir ~perm:0o700 diff --git a/src/lib_network_sandbox/test_command_line.ml b/src/lib_network_sandbox/test_command_line.ml index 7c985b564681..18c1053e2240 100644 --- a/src/lib_network_sandbox/test_command_line.ml +++ b/src/lib_network_sandbox/test_command_line.ml @@ -4,11 +4,12 @@ module Run_command = struct let or_hard_fail state main ~pp_error : unit = let open Asynchronous_result in run_application (fun () -> - bind_on_error (main ()) ~f:(fun e -> + bind_on_error (main ()) ~f:(fun ~result _ -> transform_error - ~f:(fun (`Lwt_exn _) _ -> die 3) + ~f:(fun (`Lwt_exn _) -> `Die 3) (Console.say state - EF.(custom (fun fmt -> (Error.pp ~error:pp_error) fmt e))) + EF.(custom (fun ppf -> + Attached_result.pp ppf result ~pp_error))) >>= fun () -> die 2 ) ) let term ~pp_error () = diff --git a/src/lib_network_sandbox/test_scenario.mli b/src/lib_network_sandbox/test_scenario.mli index 1cc7fbd8383e..01119c874604 100644 --- a/src/lib_network_sandbox/test_scenario.mli +++ b/src/lib_network_sandbox/test_scenario.mli @@ -8,9 +8,8 @@ module Inconsistency_error : sig val should_be_one_protocol : 'a list -> ( 'a - , [> `Empty_protocol_list | `Too_many_protocols of 'a list] Error.t ) - result - Lwt.t + , [> `Empty_protocol_list | `Too_many_protocols of 'a list] ) + Asynchronous_result.t val pp : Format.formatter diff --git a/src/lib_network_sandbox/tezos_protocol.ml b/src/lib_network_sandbox/tezos_protocol.ml index 3b86c71f4f69..cb6d4e68a81c 100644 --- a/src/lib_network_sandbox/tezos_protocol.ml +++ b/src/lib_network_sandbox/tezos_protocol.ml @@ -289,7 +289,7 @@ let ensure t ~config = | 0 -> return () | _other -> Lwt_exception.fail (Failure "sys.command non-zero") - ~attach:[("location", "Tezos_protocol.ensure")] + ~attach:[("location", `String_value "Tezos_protocol.ensure")] let cli_term () = let open Cmdliner in -- GitLab From 6d80548b492d06329f4cdc755aa9d3c6b1f05852 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Mon, 4 Mar 2019 11:43:05 -0500 Subject: [PATCH 08/49] Flextesa: make voting test bake on test chain --- src/bin_flextesa/command_voting.ml | 67 ++++++++++++++++------- src/lib_network_sandbox/test_scenario.ml | 15 ++--- src/lib_network_sandbox/test_scenario.mli | 6 +- src/lib_network_sandbox/tezos_client.ml | 8 ++- src/lib_network_sandbox/tezos_client.mli | 3 +- 5 files changed, 67 insertions(+), 32 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 5059ba36a2e4..7a1e0c609573 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -87,6 +87,24 @@ let bake_until_voting_period ?keep_alive_delegate state ~baker ~attempts period >>= fun () -> return (`Not_done (sprintf "Waiting for %S period" period_name)) ) +let check_understood_protocols state ~chain ~client ~protocol_hash + ~expect_clueless_client = + Asynchronous_result.bind_on_result + (Tezos_client.successful_client_cmd state ~client + ["--chain"; chain; "list"; "understood"; "protocols"]) + ~f:(function + | Ok client_protocols_result -> ( + match + List.find client_protocols_result#out ~f:(fun prefix -> + String.is_prefix protocol_hash ~prefix ) + with + | Some p -> return `Proper_understanding + | None when expect_clueless_client -> return `Expected_misunderstanding + | None -> return `Failure_to_understand ) + | Error (`Client_command_error _) when expect_clueless_client -> + return `Expected_misunderstanding + | Error e -> fail e) + let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec ~clueless_winner ~admin_exec ~winner_client_exec ~size ~base_port ~serialize_proposals ?with_ledger () = @@ -382,7 +400,30 @@ Running_processes.run_successful_cmdf state ~attempts:default_attempts ~seconds:8. nodes (`At_least (Counter_log.sum level_counter)) >>= fun () -> - Interactive_test.Pauser.generic state EF.[wf "Testing period, have fun."] + check_understood_protocols state ~client:winner_baker.client ~chain:"main" + ~protocol_hash:winner_hash ~expect_clueless_client:clueless_winner + >>= (function + | `Proper_understanding -> + let chain = "test" in + (* TODO: bake on test chain, but with both bakers. *) + let testing_bakes = 5 in + Loop.n_times testing_bakes (fun ith -> + Tezos_client.Keyed.bake ~chain state winner_baker + (sprintf "Baking on the test chain [%d/%d]" (ith + 1) + testing_bakes) ) + >>= fun () -> + Test_scenario.Queries.wait_for_all_levels_to_be state ~chain + ~attempts:default_attempts ~seconds:8. nodes + (`At_least (Counter_log.sum level_counter + testing_bakes)) + >>= fun () -> + Interactive_test.Pauser.generic state + EF.[wf "Testing period, with proper winner-client, have fun."] + >>= fun () -> return () + | `Expected_misunderstanding -> + Console.say state + EF.(wf "Winner-Client cannot bake on test chain (expected)") + | `Failure_to_understand -> + failf "Winner-Client cannot bake on test chain!") >>= fun () -> Helpers.wait_for state ~attempts:default_attempts ~seconds:0.3 (fun nth -> Tezos_client.rpc state ~client:(client 1) `Get @@ -476,29 +517,16 @@ Running_processes.run_successful_cmdf state >>= fun extra_bakes_waiting_for_next_protocol -> Counter_log.add level_counter "wait-for-next-protocol" extra_bakes_waiting_for_next_protocol ; - Asynchronous_result.bind_on_result - (Tezos_client.successful_client_cmd state ~client:winner_baker.client - ["list"; "understood"; "protocols"]) - ~f:(function - | Ok winner_client_protocols_result -> ( - match - List.find winner_client_protocols_result#out ~f:(fun prefix -> - String.is_prefix winner_hash ~prefix ) - with - | Some p -> return `Continue - | None when clueless_winner -> return `End_with_success - | None -> return `End_with_failure ) - | Error (`Client_command_error _) when clueless_winner -> - return `End_with_success - | Error e -> fail e) + check_understood_protocols state ~client:winner_baker.client ~chain:"main" + ~protocol_hash:winner_hash ~expect_clueless_client:clueless_winner >>= (function - | `End_with_success -> + | `Expected_misunderstanding -> Console.say state EF.( wf "As expected, the client does not know about %s" winner_hash) - | `End_with_failure -> + | `Failure_to_understand -> failf "The winner-client does not know about `%s`" winner_hash - | `Continue -> ( + | `Proper_understanding -> ( Console.say state EF.(wf "The client knows about %s" winner_hash) >>= fun () -> (* This actually depends on the protocol upgrade. *) @@ -532,7 +560,6 @@ Running_processes.run_successful_cmdf state (* TODO: - - bake on test chain - test ≠ not-enough-votes “failures” *) Interactive_test.Pauser.generic state diff --git a/src/lib_network_sandbox/test_scenario.ml b/src/lib_network_sandbox/test_scenario.ml index 817e5c9fd0c3..e77b2e070435 100644 --- a/src/lib_network_sandbox/test_scenario.ml +++ b/src/lib_network_sandbox/test_scenario.ml @@ -253,15 +253,15 @@ let network_with_protocol ?base_port ?(size = 5) ?protocol state ~node_exec >>= fun () -> return (nodes, protocol) module Queries = struct - let all_levels state ~nodes = + let all_levels ?(chain = "main") state ~nodes = List.fold nodes ~init:(return []) ~f:(fun prevm {Tezos_node.id; rpc_port; _} -> prevm >>= fun prev -> Running_processes.run_cmdf state - "curl http://localhost:%d/chains/main/blocks/head/metadata | jq \ + "curl http://localhost:%d/chains/%s/blocks/head/metadata | jq \ .level.level" - rpc_port + rpc_port chain >>= fun lvl -> Console.display_errors_of_command state lvl ~should_output:true >>= function @@ -281,7 +281,7 @@ module Queries = struct in return sorted - let wait_for_all_levels_to_be state ~attempts ~seconds nodes level = + let wait_for_all_levels_to_be ?chain state ~attempts ~seconds nodes level = let check_level = match level with | `Equal_to l -> ( = ) l @@ -307,12 +307,13 @@ module Queries = struct in Console.say state EF.( - wf "Checking for all levels to be %s (nodes: %s)" level_string + wf "Checking for all levels to be %s (nodes: %s%s)" level_string (String.concat ~sep:", " - (List.map nodes ~f:(fun n -> n.Tezos_node.id)))) + (List.map nodes ~f:(fun n -> n.Tezos_node.id))) + (Option.value_map chain ~default:"" ~f:(sprintf ", chain: %s"))) >>= fun () -> Helpers.wait_for state ~attempts ~seconds (fun _nth -> - all_levels state ~nodes + all_levels state ~nodes ?chain >>= fun results -> let not_readys = List.filter_map results ~f:(function diff --git a/src/lib_network_sandbox/test_scenario.mli b/src/lib_network_sandbox/test_scenario.mli index 01119c874604..7954c1075f26 100644 --- a/src/lib_network_sandbox/test_scenario.mli +++ b/src/lib_network_sandbox/test_scenario.mli @@ -103,7 +103,8 @@ val network_with_protocol : (** Run queries on running networks. *) module Queries : sig val all_levels : - < application_name: string + ?chain:string + -> < application_name: string ; console: Console.t ; paths: Paths.t ; runner: Running_processes.State.t @@ -117,7 +118,8 @@ module Queries : sig node-ID × level } values. *) val wait_for_all_levels_to_be : - < application_name: string + ?chain:string + -> < application_name: string ; console: Console.t ; paths: Paths.t ; runner: Running_processes.State.t diff --git a/src/lib_network_sandbox/tezos_client.ml b/src/lib_network_sandbox/tezos_client.ml index c1a8a8940ae3..3b37f879cefe 100644 --- a/src/lib_network_sandbox/tezos_client.ml +++ b/src/lib_network_sandbox/tezos_client.ml @@ -209,9 +209,13 @@ module Keyed = struct successful_client_cmd state ~client ["import"; "secret"; "key"; key_name; secret_key; "--force"] - let bake state baker msg = + let bake ?chain state baker msg = + let chain_arg = + Option.value_map chain ~default:[] ~f:(fun c -> ["--chain"; c]) + in successful_client_cmd state ~client:baker.client - ["bake"; "for"; baker.key_name; "--force"; "--minimal-timestamp"] + ( chain_arg + @ ["bake"; "for"; baker.key_name; "--force"; "--minimal-timestamp"] ) >>= fun res -> Log_recorder.Operations.bake state ~client:baker.client.id ~output:res#out msg ; diff --git a/src/lib_network_sandbox/tezos_client.mli b/src/lib_network_sandbox/tezos_client.mli index 1d6250b56caf..efc2dc1427ee 100644 --- a/src/lib_network_sandbox/tezos_client.mli +++ b/src/lib_network_sandbox/tezos_client.mli @@ -152,7 +152,8 @@ module Keyed : sig Asynchronous_result.t val bake : - < application_name: string + ?chain:string + -> < application_name: string ; console: Console.t ; operations_log: Log_recorder.Operations.t ; paths: Paths.t -- GitLab From baf186cbc2f2cdaef57a3baf5d6ed323d0d102b0 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Mon, 4 Mar 2019 12:30:32 -0500 Subject: [PATCH 09/49] Flextesa: use more both bakers in voting test --- src/bin_flextesa/command_voting.ml | 58 +++++++++++++++++------------- 1 file changed, 34 insertions(+), 24 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 7a1e0c609573..93c8ef084c65 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -108,7 +108,7 @@ let check_understood_protocols state ~chain ~client ~protocol_hash let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec ~clueless_winner ~admin_exec ~winner_client_exec ~size ~base_port ~serialize_proposals ?with_ledger () = - let default_attempts = 35 in + let default_attempts = 50 in Helpers.clear_root state >>= fun () -> Interactive_test.Pauser.generic state @@ -152,18 +152,6 @@ let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec in Tezos_client.Keyed.initialize state baker_0 >>= fun _ -> - let winner_baker = - let open Tezos_client.Keyed in - {baker_0 with client= {baker_0.client with exec= winner_client_exec}} - in - Interactive_test.Pauser.add_commands state - Interactive_test.Commands. - [ arbitrary_command_on_clients state - ~command_names:["wc"; "winner-client"] ?make_admin:None - ~clients:[winner_baker.client] ] ; - Interactive_test.Pauser.generic state - EF.[wf "You can now try the new-client"] - >>= fun () -> let level_counter = Counter_log.create () in let first_bakes = 5 in Loop.n_times first_bakes (fun nth -> @@ -184,6 +172,23 @@ let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec Tezos_client.Keyed.initialize state baker >>= fun _ -> return baker | Some uri -> setup_baking_ledger state ~client:(client 0) uri ) >>= fun special_baker -> + let winner_client = {baker_0.client with exec= winner_client_exec} in + let winner_baker_0 = + let open Tezos_client.Keyed in + {baker_0 with client= winner_client} + in + let winner_special_baker = + let open Tezos_client.Keyed in + {special_baker with client= winner_client} + in + Interactive_test.Pauser.add_commands state + Interactive_test.Commands. + [ arbitrary_command_on_clients state + ~command_names:["wc"; "winner-client"] ?make_admin:None + ~clients:[winner_client] ] ; + Interactive_test.Pauser.generic state + EF.[wf "You can now try the new-client"] + >>= fun () -> Interactive_test.Pauser.add_commands state Interactive_test.Commands. [ arbitrary_command_on_clients state ~command_names:["baker"] ~make_admin @@ -350,8 +355,6 @@ Running_processes.run_successful_cmdf state List_sequential.iter new_protocols ~f:(fun one -> submit_proposals special_baker [one] ) ) >>= fun () -> - (* let winner = "Psd1ynUBhMZAeajwcZJAeq5NrxorM6UCU4GJqxZ7Bx2e9vUWB6z" in *) - (* let winner = "Pt24m4xiPbLDhVgVfABUjirbmda3yohdN82Sp9FeuAXJ4eV9otd" in *) Tezos_client.successful_client_cmd state ~client:baker_0.client ["submit"; "proposals"; "for"; baker_0.key_name; winner_hash] >>= fun res -> @@ -400,7 +403,7 @@ Running_processes.run_successful_cmdf state ~attempts:default_attempts ~seconds:8. nodes (`At_least (Counter_log.sum level_counter)) >>= fun () -> - check_understood_protocols state ~client:winner_baker.client ~chain:"main" + check_understood_protocols state ~client:winner_client ~chain:"main" ~protocol_hash:winner_hash ~expect_clueless_client:clueless_winner >>= (function | `Proper_understanding -> @@ -408,7 +411,11 @@ Running_processes.run_successful_cmdf state (* TODO: bake on test chain, but with both bakers. *) let testing_bakes = 5 in Loop.n_times testing_bakes (fun ith -> - Tezos_client.Keyed.bake ~chain state winner_baker + let baker = + if ith mod 2 = 0 then winner_baker_0 + else winner_special_baker + in + Tezos_client.Keyed.bake ~chain state baker (sprintf "Baking on the test chain [%d/%d]" (ith + 1) testing_bakes) ) >>= fun () -> @@ -517,7 +524,7 @@ Running_processes.run_successful_cmdf state >>= fun extra_bakes_waiting_for_next_protocol -> Counter_log.add level_counter "wait-for-next-protocol" extra_bakes_waiting_for_next_protocol ; - check_understood_protocols state ~client:winner_baker.client ~chain:"main" + check_understood_protocols state ~client:winner_client ~chain:"main" ~protocol_hash:winner_hash ~expect_clueless_client:clueless_winner >>= (function | `Expected_misunderstanding -> @@ -531,8 +538,7 @@ Running_processes.run_successful_cmdf state >>= fun () -> (* This actually depends on the protocol upgrade. *) Asynchronous_result.bind_on_result - (Tezos_client.successful_client_cmd state - ~client:winner_baker.client + (Tezos_client.successful_client_cmd state ~client:winner_client ["upgrade"; "baking"; "state"]) ~f:(function | Ok _ -> return () @@ -544,11 +550,16 @@ Running_processes.run_successful_cmdf state "Command `upgrade baking state` failed, but we \ keep going with the baking."))) >>= fun () -> - Tezos_client.Keyed.bake state winner_baker + Tezos_client.Keyed.bake state winner_baker_0 "First bake on new protocol !!" >>= fun () -> - Counter_log.incr level_counter "bake-on-new-protocol" ; - Tezos_client.rpc state ~client:winner_baker.client `Get + Counter_log.incr level_counter "baker-0-bakes-on-new-protocol" ; + Tezos_client.Keyed.bake state winner_special_baker + "Second bake on new protocol !!" + >>= fun () -> + Counter_log.incr level_counter + "special-baker-bakes-on-new-protocol" ; + Tezos_client.rpc state ~client:winner_client `Get ~path:"/chains/main/blocks/head/metadata" >>= fun json_metadata -> match Jqo.field json_metadata ~k:"protocol" with @@ -558,7 +569,6 @@ Running_processes.run_successful_cmdf state Ezjsonm.(to_string (wrap other)) )) >>= fun () -> (* - TODO: - test ≠ not-enough-votes “failures” *) -- GitLab From 20ba7f341dbc013e45f35b83ca9bdf4386d60152 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Mon, 4 Mar 2019 13:03:10 -0500 Subject: [PATCH 10/49] Flextesa: try smaller network in CI-test --- src/bin_flextesa/dune | 1 + 1 file changed, 1 insertion(+) diff --git a/src/bin_flextesa/dune b/src/bin_flextesa/dune index 32af162a23f5..364940e72faf 100644 --- a/src/bin_flextesa/dune +++ b/src/bin_flextesa/dune @@ -37,6 +37,7 @@ --base-port 30_000 --size 3 --with-timestamp + --size 3 --winning-client-is-clueless --winner-client-binary %{bin:tezos-client} --current-client-binary %{bin:tezos-client} -- GitLab From 3af72de1bbe97914e8bd96af602ebd7ca6cd4c5b Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Mon, 4 Mar 2019 13:29:40 -0500 Subject: [PATCH 11/49] Flextesa: fix display of netstat thing --- src/bin_flextesa/main.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/bin_flextesa/main.ml b/src/bin_flextesa/main.ml index cc4763706fce..5515e2e01b78 100644 --- a/src/bin_flextesa/main.ml +++ b/src/bin_flextesa/main.ml @@ -34,6 +34,10 @@ module Small_utilities = struct , fun () -> Test_scenario.Network.netstat_listening_ports state >>= fun ports -> + let to_display = + List.map ports ~f:(fun (p, _) -> p) + |> List.sort ~compare:Int.compare + in Console.sayf state Fmt.( hvbox ~indent:2 (fun ppf () -> @@ -42,8 +46,8 @@ module Small_utilities = struct box (list ~sep:(fun ppf () -> string ppf "," ; sp ppf ()) - (fun ppf (p, _) -> fmt "%d" ppf p)) - ppf ports )) ) ) + (fun ppf p -> fmt "%d" ppf p)) + ppf to_display )) ) ) $ Test_command_line.cli_state ~disable_interactivity:true ~name:"netstat-ports" () ) (info "netstat-listening-ports" -- GitLab From baf83909468ec9895ff6e3cde90365ed0a2f845e Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Mon, 4 Mar 2019 13:30:05 -0500 Subject: [PATCH 12/49] Flextesa: update ledger version of the voting test --- src/bin_flextesa/command_voting.ml | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 93c8ef084c65..91cbf78a20cc 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -409,6 +409,15 @@ Running_processes.run_successful_cmdf state | `Proper_understanding -> let chain = "test" in (* TODO: bake on test chain, but with both bakers. *) + Asynchronous_result.map_option with_ledger ~f:(fun _ -> + Interactive_test.Pauser.generic state + EF. + [ af "About to bake on the test chain." + ; haf + "Please switch back to the Baking app and quit (`q`) \ + this prompt." ] + ~force:true ) + >>= fun (_ : unit option) -> let testing_bakes = 5 in Loop.n_times testing_bakes (fun ith -> let baker = @@ -469,6 +478,14 @@ Running_processes.run_successful_cmdf state ["submit"; "ballot"; "for"; baker_0.key_name; winner_hash; "yay"] >>= fun _ -> Asynchronous_result.map_option with_ledger ~f:(fun _ -> + Interactive_test.Pauser.generic state + EF. + [ af "About to cast approval ballot." + ; haf + "Please switch back to the Wallet app and quit (`q`) this prompt." + ] + ~force:true + >>= fun () -> ledger_prompt_notice state EF.(wf "Submitting “Yes” ballot for %S" winner_hash) ) >>= fun (_ : unit option) -> @@ -550,6 +567,19 @@ Running_processes.run_successful_cmdf state "Command `upgrade baking state` failed, but we \ keep going with the baking."))) >>= fun () -> + Asynchronous_result.map_option with_ledger ~f:(fun _ -> + Interactive_test.Pauser.generic state + EF. + [ af "About to bake on the new winning protocol." + ; haf + "Please switch to the Baking app and quit (`q`) this \ + prompt." ] + ~force:true + >>= fun () -> + Console.say state EF.(wf "Sleeping for a couple of seconds…") + >>= fun () -> System.sleep 4. + (* USB thing is often slower than humans hitting `q` *) ) + >>= fun (_ : unit option) -> Tezos_client.Keyed.bake state winner_baker_0 "First bake on new protocol !!" >>= fun () -> -- GitLab From af3e04be5754829c6d5ba95808a78105d46f3833 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Mon, 4 Mar 2019 14:53:49 -0500 Subject: [PATCH 13/49] Flextesa: update documentation of the voting test --- src/bin_flextesa/command_voting.ml | 40 +++++++++++++++++++++--------- 1 file changed, 28 insertions(+), 12 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 91cbf78a20cc..a6bd9eeedbfe 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -408,7 +408,6 @@ Running_processes.run_successful_cmdf state >>= (function | `Proper_understanding -> let chain = "test" in - (* TODO: bake on test chain, but with both bakers. *) Asynchronous_result.map_option with_ledger ~f:(fun _ -> Interactive_test.Pauser.generic state EF. @@ -598,10 +597,6 @@ Running_processes.run_successful_cmdf state failf "Protocol is not `%s` but `%s`" winner_hash Ezjsonm.(to_string (wrap other)) )) >>= fun () -> - (* - TODO: - - test ≠ not-enough-votes “failures” - *) Interactive_test.Pauser.generic state EF. [ haf "End of the Voting test: SUCCESS \\o/" @@ -692,16 +687,37 @@ let cmd ~pp_error () = $ Test_command_line.cli_state ~name:"voting" () ) (let doc = "Sandbox network with a full round of voting." in let man : Manpage.block list = - let pf fmt = ksprintf (fun s -> `P s) fmt in [ `S "VOTING TEST" - ; pf + ; `P "This command provides a test which uses a network sandbox to \ - perform a full round of protocol vote and upgrade. For now, it \ - goes up to the last block before the protocol switch, baking on \ - the test chain, and with the new protocol is future work." - ; pf + perform a full round of protocol vote and upgrade, including \ + voting and baking on the test chain with or without a Ledger Nano \ + S."; `P "There are two main test behaviors:" + ; `P + "* $(b,SIMPLE:) The simple one does as much as possible with any \ + dummy protocol candidates and a Tezos code-base which doesn't \ + handle them: it tests all the voting periods until baking the \ + last block of the currently understood protocol."; `Noblank + ; `P + "To allow the test to succeed in this case, the option \ + `--winning-client-is-clueless` is required; it is meant to signal \ + that the “winner” `tezos-client` executable (from the \ + `--winner-client-binary` option) is expected to not understand \ + the winning protocol."; `Noblank + ; `P + "This is the version running in Gitlab-CI, see `bin_flextesa/dune`." + ; `P + "* $(b,FULL:) Without the `--winning-client-is-clueless` option, \ + the test will try to bake on the test chain as well as after the \ + protocol switch (with the winner-client). This requires the \ + winning protocol to be a working one and, of course, the \ + winning-client to understand it." + ; `P "The test can run fully automated unless one uses the \ `\"--with-ledger=ledger://...\"` option in which case some steps \ - have to be interactive." ] + have to be interactive. In this case, the option \ + `--serialize-proposals` is recommended, because if it is not \ + provided, the proposal vote will be a “Sign Unverfied” \ + operation." ] in info ~doc ~man "voting") -- GitLab From cd6aa66364c5b1b1ec286aeccb2136368af3710d Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Thu, 7 Mar 2019 14:55:57 -0500 Subject: [PATCH 14/49] Flextesa: fix rebase error --- src/bin_flextesa/dune | 1 - 1 file changed, 1 deletion(-) diff --git a/src/bin_flextesa/dune b/src/bin_flextesa/dune index 364940e72faf..c1b94e033f19 100644 --- a/src/bin_flextesa/dune +++ b/src/bin_flextesa/dune @@ -35,7 +35,6 @@ %{lib:tezos-embedded-protocol-demo:raw/TEZOS_PROTOCOL} --root-path %{env:ROOT_PATH=/tmp/flextesa-voting-demo/} --base-port 30_000 - --size 3 --with-timestamp --size 3 --winning-client-is-clueless -- GitLab From 1395d9cc609e8dae9600c8cee21e9de438940a43 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 8 Mar 2019 12:42:58 -0500 Subject: [PATCH 15/49] Flextesa: Remove type parameter from executables --- src/lib_network_sandbox/test_scenario.mli | 8 ++++---- src/lib_network_sandbox/tezos_admin_client.ml | 2 +- .../tezos_admin_client.mli | 6 +++--- src/lib_network_sandbox/tezos_client.ml | 2 +- src/lib_network_sandbox/tezos_client.mli | 4 ++-- src/lib_network_sandbox/tezos_daemon.ml | 4 +--- src/lib_network_sandbox/tezos_daemon.mli | 16 +++++----------- src/lib_network_sandbox/tezos_executable.ml | 11 +++++------ src/lib_network_sandbox/tezos_executable.mli | 19 +++++++++++-------- src/lib_network_sandbox/tezos_node.ml | 2 +- src/lib_network_sandbox/tezos_node.mli | 4 ++-- 11 files changed, 36 insertions(+), 42 deletions(-) diff --git a/src/lib_network_sandbox/test_scenario.mli b/src/lib_network_sandbox/test_scenario.mli index 7954c1075f26..12222810966d 100644 --- a/src/lib_network_sandbox/test_scenario.mli +++ b/src/lib_network_sandbox/test_scenario.mli @@ -51,7 +51,7 @@ module Topology : sig val build : ?protocol:Tezos_protocol.t -> ?base_port:int - -> exec:[`Node] Tezos_executable.t + -> exec:Tezos_executable.t -> 'a network -> 'a end @@ -72,7 +72,7 @@ module Network : sig val start_up : ?check_ports:bool -> < paths: Paths.t ; runner: Running_processes.State.t ; .. > - -> client_exec:[`Client] Tezos_executable.t + -> client_exec:Tezos_executable.t -> t -> ( unit , [> `Empty_protocol_list @@ -88,8 +88,8 @@ val network_with_protocol : -> ?size:int -> ?protocol:Tezos_protocol.t -> < paths: Paths.t ; runner: Running_processes.State.t ; .. > - -> node_exec:[`Node] Tezos_executable.t - -> client_exec:[`Client] Tezos_executable.t + -> node_exec:Tezos_executable.t + -> client_exec:Tezos_executable.t -> ( Tezos_node.t list * Tezos_protocol.t , [> `Empty_protocol_list | `Lwt_exn of exn diff --git a/src/lib_network_sandbox/tezos_admin_client.ml b/src/lib_network_sandbox/tezos_admin_client.ml index 7c7154d8b758..d58cf9092b86 100644 --- a/src/lib_network_sandbox/tezos_admin_client.ml +++ b/src/lib_network_sandbox/tezos_admin_client.ml @@ -1,6 +1,6 @@ open Internal_pervasives -type t = {id: string; port: int; exec: [`Admin] Tezos_executable.t} +type t = {id: string; port: int; exec: Tezos_executable.t} let base_dir t ~state = Paths.root state // sprintf "Admin-client-base-%s" t.id diff --git a/src/lib_network_sandbox/tezos_admin_client.mli b/src/lib_network_sandbox/tezos_admin_client.mli index b5bd1f32310f..736adb813228 100644 --- a/src/lib_network_sandbox/tezos_admin_client.mli +++ b/src/lib_network_sandbox/tezos_admin_client.mli @@ -2,10 +2,10 @@ open Internal_pervasives (** [t] is very similar to {!Tezos_client.t}. *) -type t = private {id: string; port: int; exec: [`Admin] Tezos_executable.t} +type t = private {id: string; port: int; exec: Tezos_executable.t} -val of_client : exec:[`Admin] Tezos_executable.t -> Tezos_client.t -> t -val of_node : exec:[`Admin] Tezos_executable.t -> Tezos_node.t -> t +val of_client : exec:Tezos_executable.t -> Tezos_client.t -> t +val of_node : exec:Tezos_executable.t -> Tezos_node.t -> t val make_command : t -> < paths: Paths.t ; .. > -> string list -> unit Genspio.EDSL.t diff --git a/src/lib_network_sandbox/tezos_client.ml b/src/lib_network_sandbox/tezos_client.ml index 3b37f879cefe..dfba196cb642 100644 --- a/src/lib_network_sandbox/tezos_client.ml +++ b/src/lib_network_sandbox/tezos_client.ml @@ -1,6 +1,6 @@ open Internal_pervasives -type t = {id: string; port: int; exec: [`Client] Tezos_executable.t} +type t = {id: string; port: int; exec: Tezos_executable.t} type client = t let of_node ~exec n = diff --git a/src/lib_network_sandbox/tezos_client.mli b/src/lib_network_sandbox/tezos_client.mli index efc2dc1427ee..8202de29e835 100644 --- a/src/lib_network_sandbox/tezos_client.mli +++ b/src/lib_network_sandbox/tezos_client.mli @@ -1,10 +1,10 @@ (** Wrapper around the main ["tezos-client"] application. *) open Internal_pervasives -type t = {id: string; port: int; exec: [`Client] Tezos_executable.t} +type t = {id: string; port: int; exec: Tezos_executable.t} type client = t -val of_node : exec:[`Client] Tezos_executable.t -> Tezos_node.t -> t +val of_node : exec: Tezos_executable.t -> Tezos_node.t -> t (** Create a client which is meant to communicate with a given node. *) val base_dir : t -> state:< paths: Paths.t ; .. > -> string diff --git a/src/lib_network_sandbox/tezos_daemon.ml b/src/lib_network_sandbox/tezos_daemon.ml index e7c2bbef0d57..3a803ef1036c 100644 --- a/src/lib_network_sandbox/tezos_daemon.ml +++ b/src/lib_network_sandbox/tezos_daemon.ml @@ -1,7 +1,5 @@ open Internal_pervasives -type kind = [`Baker | `Endorser | `Accuser] - type args = | Baker : string -> args | Endorser : string -> args @@ -10,7 +8,7 @@ type args = type t = { node: Tezos_node.t ; client: Tezos_client.t - ; exec: kind Tezos_executable.t + ; exec: Tezos_executable.t ; args: args } let of_node node args ~exec ~client = {node; exec; client; args} diff --git a/src/lib_network_sandbox/tezos_daemon.mli b/src/lib_network_sandbox/tezos_daemon.mli index ecacacce5d3a..4f37d39ccb9a 100644 --- a/src/lib_network_sandbox/tezos_daemon.mli +++ b/src/lib_network_sandbox/tezos_daemon.mli @@ -1,5 +1,3 @@ -type kind = [`Accuser | `Baker | `Endorser] - type args = private | Baker : string -> args | Endorser : string -> args @@ -8,32 +6,28 @@ type args = private type t = private { node: Tezos_node.t ; client: Tezos_client.t - ; exec: kind Tezos_executable.t + ; exec: Tezos_executable.t ; args: args } val of_node : - Tezos_node.t - -> args - -> exec:kind Tezos_executable.t - -> client:Tezos_client.t - -> t + Tezos_node.t -> args -> exec:Tezos_executable.t -> client:Tezos_client.t -> t val baker_of_node : Tezos_node.t -> key:string - -> exec:kind Tezos_executable.t + -> exec:Tezos_executable.t -> client:Tezos_client.t -> t val endorser_of_node : Tezos_node.t -> key:string - -> exec:kind Tezos_executable.t + -> exec:Tezos_executable.t -> client:Tezos_client.t -> t val accuser_of_node : - Tezos_node.t -> exec:kind Tezos_executable.t -> client:Tezos_client.t -> t + Tezos_node.t -> exec:Tezos_executable.t -> client:Tezos_client.t -> t val arg_to_string : args -> string val to_script : t -> state:< paths: Paths.t ; .. > -> unit Genspio.Language.t diff --git a/src/lib_network_sandbox/tezos_executable.ml b/src/lib_network_sandbox/tezos_executable.ml index 08424a7078d0..9f65f492228f 100644 --- a/src/lib_network_sandbox/tezos_executable.ml +++ b/src/lib_network_sandbox/tezos_executable.ml @@ -15,10 +15,8 @@ end type kind = [`Node | `Baker | `Endorser | `Accuser | `Client | `Admin] -type 'kind t = - { kind: - 'kind - (* if needed, it's easy to remove this overengineered type parameter. *) +type t = + { kind: kind ; binary: string option ; unix_files_sink: Unix_files_sink.t option ; environment: (string * string) list } @@ -36,8 +34,9 @@ let kind_string (kind : [< kind]) = | `Admin -> "admin-client" let default_binary t = sprintf "tezos-%s" (kind_string t.kind) +let get t = Option.value t.binary ~default:(default_binary t) -let call (t : [< kind] t) ~path args = +let call t ~path args = let open Genspio.EDSL in seq ( Option.value_map t.unix_files_sink ~default:[] ~f:(function @@ -51,7 +50,7 @@ let call (t : [< kind] t) ~path args = ; write_stdout ~path:(path // "last-cmd" |> str) (printf (str "ARGS: %s\\n") [str (String.concat ~sep:" " args)]) - ; exec (Option.value t.binary ~default:(default_binary t) :: args) ] ) + ; exec (get t :: args) ] ) let cli_term kind prefix = let open Cmdliner in diff --git a/src/lib_network_sandbox/tezos_executable.mli b/src/lib_network_sandbox/tezos_executable.mli index 1e5a45e8a0c6..ebb366e2d72b 100644 --- a/src/lib_network_sandbox/tezos_executable.mli +++ b/src/lib_network_sandbox/tezos_executable.mli @@ -21,8 +21,8 @@ end type kind = [`Node | `Baker | `Endorser | `Accuser | `Client | `Admin] (** The wrapper of the tezos-executable. *) -type 'kind t = private - { kind: 'kind +type t = private + { kind: kind ; binary: string option ; unix_files_sink: Unix_files_sink.t option ; environment: (string * string) list } @@ -31,24 +31,27 @@ val make : ?binary:string -> ?unix_files_sink:Unix_files_sink.t -> ?environment:(string * string) list - -> ([< kind] as 'a) - -> 'a t + -> kind + -> t (** Create a ["tezos-node"] executable. *) -val kind_string : [< kind] -> string +val kind_string : kind -> string (** Convert a [kind] to a [string]. *) -val default_binary : [< kind] t -> string +val default_binary : t -> string (** Get the path/name of the default binary for a given kind, e.g., ["tezos-admin-client"]. *) -val call : [< kind] t -> path:string -> string list -> unit Genspio.EDSL.t +val get : t -> string +(** The path to the executable. *) + +val call : t -> path:string -> string list -> unit Genspio.EDSL.t (** Build a [Genspio.EDSL.t] script to run a tezos command, the [~path] argument is used as a toplevel path for the unix-files event-sink (event-logging-framework) and for other local logging files. *) -val cli_term : ([< kind] as 'a) -> string -> 'a t Cmdliner.Term.t +val cli_term : kind -> string -> t Cmdliner.Term.t (** Build a [Cmdliner] term which creates tezos-executables, the second argument is a prefix of option names (e.g. ["tezos"] for the option ["--tezos-accuser-alpha-binary"]). *) diff --git a/src/lib_network_sandbox/tezos_node.ml b/src/lib_network_sandbox/tezos_node.ml index 1f9ecd914a4a..aeea2c6aaa5d 100644 --- a/src/lib_network_sandbox/tezos_node.ml +++ b/src/lib_network_sandbox/tezos_node.ml @@ -7,7 +7,7 @@ type t = ; p2p_port: int ; (* Ports: *) peers: int list - ; exec: [`Node] Tezos_executable.t + ; exec: Tezos_executable.t ; protocol: Tezos_protocol.t } let ef t = diff --git a/src/lib_network_sandbox/tezos_node.mli b/src/lib_network_sandbox/tezos_node.mli index 6b038b3d8110..0754d1571abd 100644 --- a/src/lib_network_sandbox/tezos_node.mli +++ b/src/lib_network_sandbox/tezos_node.mli @@ -4,14 +4,14 @@ type t = private ; rpc_port: int ; p2p_port: int ; peers: int list - ; exec: [`Node] Tezos_executable.t + ; exec: Tezos_executable.t ; protocol: Tezos_protocol.t } val ef : t -> Easy_format.t val pp : Format.formatter -> t -> unit val make : - exec:[`Node] Tezos_executable.t + exec:Tezos_executable.t -> ?protocol:Tezos_protocol.t -> string -> expected_connections:int -- GitLab From ae8b15c7507383ab49238925d1d0c218dfe3911d Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 8 Mar 2019 12:43:52 -0500 Subject: [PATCH 16/49] Flextesa: add module `System_dependencies` --- src/lib_network_sandbox/helpers.ml | 63 +++++++++++++++++++ src/lib_network_sandbox/helpers.mli | 23 ++++++- .../internal_pervasives.ml | 7 ++- 3 files changed, 90 insertions(+), 3 deletions(-) diff --git a/src/lib_network_sandbox/helpers.ml b/src/lib_network_sandbox/helpers.ml index ad8c324151c6..8e421f039c00 100644 --- a/src/lib_network_sandbox/helpers.ml +++ b/src/lib_network_sandbox/helpers.ml @@ -83,3 +83,66 @@ module Counter_log = struct n ) |> String.concat ~sep:"\n" end + +module System_dependencies = struct + module Error = struct + type t = [`Precheck_failure of string] + + let pp fmt (`Precheck_failure f) = + Format.fprintf fmt "Failed precheck: %S" f + + let failf fmt = Format.kasprintf (fun s -> fail (`Precheck_failure s)) fmt + end + + open Error + + let precheck ?(using_docker = false) ?(protocol_paths = []) + ?(executables : Tezos_executable.t list = []) state how_to_react = + let commands_to_check = + (if using_docker then ["docker"] else []) + @ ["jq"; "setsid"; "curl"; "netstat"] + @ List.map executables ~f:Tezos_executable.get + in + List.fold ~init:(return []) commands_to_check ~f:(fun prev_m cmd -> + prev_m + >>= fun prev -> + Running_processes.run_cmdf state "type %s" (Filename.quote cmd) + >>= fun result -> + match result#status with + | Unix.WEXITED 0 -> return prev + | _ -> return (`Missing_exec (cmd, result) :: prev) ) + >>= fun errors_or_warnings -> + List.fold protocol_paths ~init:(return errors_or_warnings) + ~f:(fun prev_m path -> + prev_m + >>= fun prev -> + Lwt_exception.catch Lwt_unix.file_exists (path // "TEZOS_PROTOCOL") + >>= function + | true -> return prev + | false -> return (`Not_a_protocol_path path :: prev) ) + >>= fun errors_or_warnings -> + match (errors_or_warnings, how_to_react) with + | [], _ -> return () + | more, `Or_fail -> + Console.sayf state + Format.( + fun ppf () -> + pp_print_string ppf "System dependencies failed precheck:" ; + pp_print_space ppf () ; + pp_open_hvbox ppf 0 ; + List.iter more ~f:(fun item -> + pp_print_if_newline ppf () ; + pp_print_string ppf "* " ; + pp_open_hovbox ppf 0 ; + ( match item with + | `Missing_exec (path, _) -> + (* pp_open_hovbox ppf 0 ; *) + pp_print_text ppf + (sprintf "Missing executable: `%s`." path) + | `Not_a_protocol_path path -> + pp_print_text ppf + (sprintf "Not a protocol path: `%s`." path) ) ; + pp_close_box ppf () ; pp_print_space ppf () ) ; + pp_close_box ppf ()) + >>= fun () -> failf "Error/Warnings were raised during precheck." +end diff --git a/src/lib_network_sandbox/helpers.mli b/src/lib_network_sandbox/helpers.mli index 281b8a2f9342..a6c003377c54 100644 --- a/src/lib_network_sandbox/helpers.mli +++ b/src/lib_network_sandbox/helpers.mli @@ -34,7 +34,7 @@ val kill_node : (** Kill a node's process. *) val restart_node : - client_exec:[`Client] Tezos_executable.t + client_exec:Tezos_executable.t -> < application_name: string ; console: Console.t ; paths: Paths.t @@ -56,3 +56,24 @@ module Counter_log : sig val sum : t -> int val to_table_string : t -> string end + +module System_dependencies : sig + module Error : sig + type t = [`Precheck_failure of string] + + val pp : Format.formatter -> [< `Precheck_failure of string] -> unit + + end + + val precheck : + ?using_docker:bool + -> ?protocol_paths:string list + -> ?executables:Tezos_executable.t list + -> < application_name: string + ; console: Console.t + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> [< `Or_fail] + -> (unit, [> Lwt_exception.t | Error.t ]) Asynchronous_result.t +end diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index 48dffb310233..3d8aca75121f 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -109,7 +109,8 @@ module Attached_result = struct | Error e -> pp_open_hvbox ppf 2 ; pp_open_tag ppf "shout" ; - pp_print_string ppf "ERROR" ; + pp_print_string ppf "ERROR:" ; + pp_print_space ppf () ; pp_close_tag ppf () ; Option.iter pp_error ~f:(fun pp -> pp ppf e) ; pp_close_box ppf () ) ; @@ -248,7 +249,9 @@ module List_sequential = Asynchronous_result.List_sequential module Loop = Asynchronous_result.Loop module Lwt_exception = struct - let fail ?attach (e : exn) = fail ?attach (`Lwt_exn e) + type t = [`Lwt_exn of exn] + + let fail ?attach (e : exn) = fail ?attach (`Lwt_exn e : [> t]) let catch ?attach f x = Lwt.catch -- GitLab From c7fb87a9c60dd72dc82950ef5631d231edab45f4 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 8 Mar 2019 12:44:14 -0500 Subject: [PATCH 17/49] Flextesa: add system-checks to the current tests --- src/bin_flextesa/command_accusations.ml | 21 +++++++++++++++++---- src/bin_flextesa/command_mini_network.ml | 5 +++++ src/bin_flextesa/command_voting.ml | 6 +++++- src/bin_flextesa/main.ml | 1 + 4 files changed, 28 insertions(+), 5 deletions(-) diff --git a/src/bin_flextesa/command_accusations.ml b/src/bin_flextesa/command_accusations.ml index c4ef738bfa5a..b5a364b52826 100644 --- a/src/bin_flextesa/command_accusations.ml +++ b/src/bin_flextesa/command_accusations.ml @@ -630,15 +630,28 @@ let cmd ~pp_error () = kiln state -> - let actual_test = + let checks () = + let acc = if test = `With_accusers then [accex] else [] in + Helpers.System_dependencies.precheck state `Or_fail + ~executables:(acc @ [bnod; bcli]) + ~using_docker:(kiln <> None) + in + let actual_test () = match test with - | `With_accusers -> with_accusers ~state bnod accex bcli ~base_port + | `With_accusers -> + checks () + >>= fun () -> + with_accusers ~state bnod accex bcli ~base_port () | `Simple_double_baking -> + checks () + >>= fun () -> simple_double_baking ~state bnod bcli ~base_port ?kiln - ~starting_level + ~starting_level () | `Simple_double_endorsing -> + checks () + >>= fun () -> simple_double_endorsement ~state bnod bcli ~base_port ?kiln - ~starting_level + ~starting_level () in (state, Interactive_test.Pauser.run_test ~pp_error state actual_test) ) diff --git a/src/bin_flextesa/command_mini_network.ml b/src/bin_flextesa/command_mini_network.ml index 8a8486a690fa..cc9f22510c27 100644 --- a/src/bin_flextesa/command_mini_network.ml +++ b/src/bin_flextesa/command_mini_network.ml @@ -4,6 +4,11 @@ open Console let run state ~protocol ~size ~base_port ?kiln node_exec client_exec baker_exec endorser_exec accuser_exec () = + Helpers.System_dependencies.precheck state `Or_fail + ~executables: + [node_exec; client_exec; baker_exec; endorser_exec; accuser_exec] + ~using_docker:(kiln <> None) + >>= fun () -> Test_scenario.network_with_protocol ~protocol ~size ~base_port state ~node_exec ~client_exec >>= fun (nodes, protocol) -> diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index a6bd9eeedbfe..19b325965b7e 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -111,7 +111,11 @@ let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec let default_attempts = 50 in Helpers.clear_root state >>= fun () -> - Interactive_test.Pauser.generic state + Helpers.System_dependencies.precheck state `Or_fail + ~executables:[node_exec; client_exec; admin_exec; winner_client_exec] + ~protocol_paths:[winner_path; demo_path] + >>= fun () -> + Interactive_test.Pauser.generic state ~force:true EF.[af "Ready to start"; af "Root path deleted."] >>= fun () -> let protocol, baker_0_account, baker_0_balance = diff --git a/src/bin_flextesa/main.ml b/src/bin_flextesa/main.ml index 5515e2e01b78..7a2e688cfc1b 100644 --- a/src/bin_flextesa/main.ml +++ b/src/bin_flextesa/main.ml @@ -71,6 +71,7 @@ let () = | `Admin_command_error _ as e -> Tezos_admin_client.Command_error.pp fmt e | `Waiting_for (msg, `Time_out) -> Format.fprintf fmt "WAITING-FOR “%s”: Time-out" msg + | `Precheck_failure _ as p -> Helpers.System_dependencies.Error.pp fmt p in Term.exit @@ Term.eval_choice -- GitLab From 1bb284485effe78650f48f60389d9db8ab5db97d Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 8 Mar 2019 15:23:02 -0500 Subject: [PATCH 18/49] Flextesa: Use Kiln's new `--bakers` option --- src/lib_network_sandbox/kiln.ml | 62 ++++++++++++++++++++------------ src/lib_network_sandbox/kiln.mli | 6 ++-- 2 files changed, 43 insertions(+), 25 deletions(-) diff --git a/src/lib_network_sandbox/kiln.ml b/src/lib_network_sandbox/kiln.ml index 38c5ca5e3220..41d7d2c45b98 100644 --- a/src/lib_network_sandbox/kiln.ml +++ b/src/lib_network_sandbox/kiln.ml @@ -1,15 +1,23 @@ open Internal_pervasives -type t = {run: [`Docker of string]; port: int; postgres_port: int} +type t = + { run: [`Docker of string] + ; port: int + ; postgres_port: int + ; pause_for_user: bool } + +let make ~run ~port ~postgres_port ~pause_for_user = + {run; port; postgres_port; pause_for_user} -let make ~run ~port ~postgres_port = {run; port; postgres_port} let default_docker_image = "obsidiansystems/tezos-bake-monitor:0.4.0" let default = make ~run:(`Docker default_docker_image) ~port:8086 ~postgres_port:4_532 + ~pause_for_user:false let start ?(network_id = "zeronet") state - {run= `Docker image; port; postgres_port} ~node_uris ~bakers = + {run= `Docker image; port; postgres_port; pause_for_user} ~node_uris + ~bakers = let name nonbase = sprintf "flxts-%s" nonbase in let pg_password = Tezos_protocol.Key.Of_name.pubkey "pg-password" in let pg_port = postgres_port in @@ -58,17 +66,22 @@ let start ?(network_id = "zeronet") state Running_processes.run_cmdf state " chmod -R 777 %s" tmp >>= fun _ -> let kiln = + let args = + [ sprintf + "--pg-connection=host=localhost port=%d dbname=postgres \ + user=postgres password=%s" + pg_port pg_password + ; "--nodes" + ; String.concat ~sep:"," node_uris + ; "--bakers" + ; String.concat ~sep:"," + (List.map bakers ~f:(fun (n, pkh) -> sprintf "%s@%s" pkh n)) + ; "--network"; network_id; "--"; "--port"; Int.to_string kiln_port ] + in Running_processes.Process.docker_run (name "kiln-backend") ~image ~options: ["--network"; "host"; "-v"; sprintf "%s:/var/run/bake-monitor" tmp] - ~args: - [ sprintf - "--pg-connection=host=localhost port=%d dbname=postgres \ - user=postgres password=%s" - pg_port pg_password - ; "--nodes" - ; String.concat ~sep:"," node_uris - ; "--network"; network_id; "--"; "--port"; Int.to_string kiln_port ] + ~args in Running_processes.start state kiln >>= fun kiln_process -> @@ -79,25 +92,21 @@ let start ?(network_id = "zeronet") state network_id) >>= fun () -> ( match bakers with - | [] -> return () + | ([] | _) when not pause_for_user -> return () | _ -> Interactive_test.Pauser.generic state ~force:true EF. - [ wf "Importing bakers in Kiln." - ; wf - "You should open and import the following \ - bakers:" - kiln_port - ; list - (List.map bakers ~f:(fun (n, pkh) -> af "Baker: `%s` -> %s" n pkh)) - ] ) + [ wf "Started Kiln with Nodes and Bakers." + ; wf "You may open and quit this prompt (`q`)." + kiln_port ] ) >>= fun () -> return (pg_process, kiln_process) let cli_term () = let open Cmdliner in Term.( - pure (fun run port postgres_port -> function - | true -> Some (make ~run ~postgres_port ~port) | false -> None ) + pure (fun run port postgres_port pause_for_user -> function + | true -> Some (make ~run ~postgres_port ~port ~pause_for_user) + | false -> None ) $ Arg.( let doc = "Set the Kiln docker image." in pure (fun docker_image -> `Docker docker_image) @@ -116,4 +125,11 @@ let cli_term () = (info ["with-kiln"] ~doc: "Add Kiln to the network (may make the test partially \ - interactive).")))) + interactive)."))) + $ Arg.( + value + (flag + (info ["pause-to-display-kiln"] + ~doc: + "Add an interactive pause to show the user the URI of \ + Kiln's GUI.")))) diff --git a/src/lib_network_sandbox/kiln.mli b/src/lib_network_sandbox/kiln.mli index d64cc29d8c7c..541349df84fb 100644 --- a/src/lib_network_sandbox/kiln.mli +++ b/src/lib_network_sandbox/kiln.mli @@ -4,9 +4,11 @@ open Internal_pervasives type t -val make : run:[`Docker of string] -> port:int -> postgres_port:int -> t +val make : run:[`Docker of string] -> port:int -> postgres_port:int -> pause_for_user:bool -> t (** Configure a Kiln process-to-be, running on port [~port] and - managing a PostgreSQL database on port [~postgres_port]. *) + managing a PostgreSQL database on port [~postgres_port]. If + [pause_for_user] is [true], !{start} will add an interactive pause + to show the user the URI of the WebUI. *) val default_docker_image : string val default : t -- GitLab From a8d2db2d1f58d93ef5f2a8680c91227c09ce29d8 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 8 Mar 2019 12:44:14 -0500 Subject: [PATCH 19/49] Flextesa: add system-checks to the current tests --- src/bin_flextesa/command_voting.ml | 2 +- src/lib_network_sandbox/kiln.ml | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 19b325965b7e..29023ec997f3 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -115,7 +115,7 @@ let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec ~executables:[node_exec; client_exec; admin_exec; winner_client_exec] ~protocol_paths:[winner_path; demo_path] >>= fun () -> - Interactive_test.Pauser.generic state ~force:true + Interactive_test.Pauser.generic state EF.[af "Ready to start"; af "Root path deleted."] >>= fun () -> let protocol, baker_0_account, baker_0_balance = diff --git a/src/lib_network_sandbox/kiln.ml b/src/lib_network_sandbox/kiln.ml index 41d7d2c45b98..16148c2aee06 100644 --- a/src/lib_network_sandbox/kiln.ml +++ b/src/lib_network_sandbox/kiln.ml @@ -122,14 +122,14 @@ let cli_term () = $ Arg.( value (flag - (info ["with-kiln"] + (info ["pause-to-display-kiln"] ~doc: - "Add Kiln to the network (may make the test partially \ - interactive)."))) + "Add an interactive pause to show the user the URI of \ + Kiln's GUI."))) $ Arg.( value (flag - (info ["pause-to-display-kiln"] + (info ["with-kiln"] ~doc: - "Add an interactive pause to show the user the URI of \ - Kiln's GUI.")))) + "Add Kiln to the network (may make the test partially \ + interactive).")))) -- GitLab From 9940f87da6ab83e794240c0295a356c34468afc9 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 15 Mar 2019 17:51:11 -0400 Subject: [PATCH 20/49] Flextesa: Run `ocamlformat` --- src/lib_network_sandbox/helpers.mli | 3 +-- src/lib_network_sandbox/kiln.mli | 7 ++++++- src/lib_network_sandbox/running_processes.ml | 3 ++- src/lib_network_sandbox/running_processes.mli | 5 +---- src/lib_network_sandbox/test_command_line.ml | 4 ++-- src/lib_network_sandbox/tezos_client.mli | 2 +- 6 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/lib_network_sandbox/helpers.mli b/src/lib_network_sandbox/helpers.mli index a6c003377c54..6163a50a2dea 100644 --- a/src/lib_network_sandbox/helpers.mli +++ b/src/lib_network_sandbox/helpers.mli @@ -62,7 +62,6 @@ module System_dependencies : sig type t = [`Precheck_failure of string] val pp : Format.formatter -> [< `Precheck_failure of string] -> unit - end val precheck : @@ -75,5 +74,5 @@ module System_dependencies : sig ; runner: Running_processes.State.t ; .. > -> [< `Or_fail] - -> (unit, [> Lwt_exception.t | Error.t ]) Asynchronous_result.t + -> (unit, [> Lwt_exception.t | Error.t]) Asynchronous_result.t end diff --git a/src/lib_network_sandbox/kiln.mli b/src/lib_network_sandbox/kiln.mli index 541349df84fb..ad10b2a782f3 100644 --- a/src/lib_network_sandbox/kiln.mli +++ b/src/lib_network_sandbox/kiln.mli @@ -4,7 +4,12 @@ open Internal_pervasives type t -val make : run:[`Docker of string] -> port:int -> postgres_port:int -> pause_for_user:bool -> t +val make : + run:[`Docker of string] + -> port:int + -> postgres_port:int + -> pause_for_user:bool + -> t (** Configure a Kiln process-to-be, running on port [~port] and managing a PostgreSQL database on port [~postgres_port]. If [pause_for_user] is [true], !{start} will add an interactive pause diff --git a/src/lib_network_sandbox/running_processes.ml b/src/lib_network_sandbox/running_processes.ml index 1e102a20f94a..f7e3a474da8f 100644 --- a/src/lib_network_sandbox/running_processes.ml +++ b/src/lib_network_sandbox/running_processes.ml @@ -109,7 +109,8 @@ let start t process = let date = Tezos_stdlib_unix.Systime_os.now () |> Tezos_base.Time.System.to_notation in let open_file f = - Lwt_exception.catch ~attach:[("open_file", `String_value f)] + Lwt_exception.catch + ~attach:[("open_file", `String_value f)] Lwt.Infix.( fun () -> Tezos_stdlib_unix.Lwt_utils_unix.create_dir ~perm:0o700 diff --git a/src/lib_network_sandbox/running_processes.mli b/src/lib_network_sandbox/running_processes.mli index 48a6b6897b13..1978025b3fcb 100644 --- a/src/lib_network_sandbox/running_processes.mli +++ b/src/lib_network_sandbox/running_processes.mli @@ -30,10 +30,7 @@ module State : sig end val output_path : - < paths: Paths.t ; .. > - -> Process.t - -> [ `Meta | `Stderr | `Stdout] - -> string + < paths: Paths.t ; .. > -> Process.t -> [`Meta | `Stderr | `Stdout] -> string (** Return the path (within {!Paths}'s root-path) where the process writes its output or metadata. *) diff --git a/src/lib_network_sandbox/test_command_line.ml b/src/lib_network_sandbox/test_command_line.ml index 18c1053e2240..52ea3392a7cc 100644 --- a/src/lib_network_sandbox/test_command_line.ml +++ b/src/lib_network_sandbox/test_command_line.ml @@ -8,8 +8,8 @@ module Run_command = struct transform_error ~f:(fun (`Lwt_exn _) -> `Die 3) (Console.say state - EF.(custom (fun ppf -> - Attached_result.pp ppf result ~pp_error))) + EF.( + custom (fun ppf -> Attached_result.pp ppf result ~pp_error))) >>= fun () -> die 2 ) ) let term ~pp_error () = diff --git a/src/lib_network_sandbox/tezos_client.mli b/src/lib_network_sandbox/tezos_client.mli index 8202de29e835..bec7f41d229c 100644 --- a/src/lib_network_sandbox/tezos_client.mli +++ b/src/lib_network_sandbox/tezos_client.mli @@ -4,7 +4,7 @@ open Internal_pervasives type t = {id: string; port: int; exec: Tezos_executable.t} type client = t -val of_node : exec: Tezos_executable.t -> Tezos_node.t -> t +val of_node : exec:Tezos_executable.t -> Tezos_node.t -> t (** Create a client which is meant to communicate with a given node. *) val base_dir : t -> state:< paths: Paths.t ; .. > -> string -- GitLab From c074a4eef8f06f9a4b6745e314abbc9c389e51eb Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Tue, 26 Mar 2019 14:51:00 -0400 Subject: [PATCH 21/49] Flextesa: allow running Kiln without Docker --- src/lib_network_sandbox/kiln.ml | 138 ++++++++++++++++++------------- src/lib_network_sandbox/kiln.mli | 13 +-- 2 files changed, 88 insertions(+), 63 deletions(-) diff --git a/src/lib_network_sandbox/kiln.ml b/src/lib_network_sandbox/kiln.ml index 16148c2aee06..90c5974f0171 100644 --- a/src/lib_network_sandbox/kiln.ml +++ b/src/lib_network_sandbox/kiln.ml @@ -1,51 +1,60 @@ open Internal_pervasives type t = - { run: [`Docker of string] + { run: [`Docker of string | `Dev_mode of string * string] ; port: int - ; postgres_port: int + ; postgres: [`Docker of int] option ; pause_for_user: bool } -let make ~run ~port ~postgres_port ~pause_for_user = - {run; port; postgres_port; pause_for_user} +let make ~run ~port ?postgres ~pause_for_user () = + {run; port; postgres; pause_for_user} let default_docker_image = "obsidiansystems/tezos-bake-monitor:0.4.0" +let default_postgres_port = 4_532 let default = - make ~run:(`Docker default_docker_image) ~port:8086 ~postgres_port:4_532 - ~pause_for_user:false + make ~run:(`Docker default_docker_image) ~port:8086 + ~postgres:(`Docker default_postgres_port) ~pause_for_user:false () -let start ?(network_id = "zeronet") state - {run= `Docker image; port; postgres_port; pause_for_user} ~node_uris - ~bakers = +let start ?(network_id = "zeronet") state {run; port; postgres; pause_for_user} + ~node_uris ~bakers = let name nonbase = sprintf "flxts-%s" nonbase in - let pg_password = Tezos_protocol.Key.Of_name.pubkey "pg-password" in - let pg_port = postgres_port in let kiln_port = port in - let pg = - Running_processes.Process.docker_run (name "kiln-postgres-db") - ~image:"postgres" - ~options: - [ "-p"; sprintf "%d:5432" pg_port; "-e" - ; sprintf "POSTGRES_PASSWORD=%s" pg_password ] - ~args:[] - in - Running_processes.start state pg - >>= fun pg_process -> - Helpers.wait_for state ~attempts:20 ~seconds:8. (fun attempt -> - Running_processes.run_cmdf state - "docker run --rm -e PGPASSWORD=%s --network host -it postgres psql -h \ - localhost -p %d -U postgres -w -c '\\l'" - pg_password pg_port - >>= fun res -> - Console.display_errors_of_command state res - >>= function - | true -> return (`Done ()) - | false -> - return - (`Not_done - (sprintf "Waiting for postgres to be ready (%d)" attempt)) ) - >>= fun () -> + ( match postgres with + | Some (`Docker pg_port) -> + let pg_password = Tezos_protocol.Key.Of_name.pubkey "pg-password" in + let pg = + Running_processes.Process.docker_run (name "kiln-postgres-db") + ~image:"postgres" + ~options: + [ "-p"; sprintf "%d:5432" pg_port; "-e" + ; sprintf "POSTGRES_PASSWORD=%s" pg_password ] + ~args:[] + in + let pg_cli_option = + sprintf + "--pg-connection=host=localhost port=%d dbname=postgres \ + user=postgres password=%s" + pg_port pg_password + in + Running_processes.start state pg + >>= fun pg_process -> + Helpers.wait_for state ~attempts:20 ~seconds:8. (fun attempt -> + Running_processes.run_cmdf state + "docker run --rm -e PGPASSWORD=%s --network host -it postgres \ + psql -h localhost -p %d -U postgres -w -c '\\l'" + pg_password pg_port + >>= fun res -> + Console.display_errors_of_command state res + >>= function + | true -> return (`Done ()) + | false -> + return + (`Not_done + (sprintf "Waiting for postgres to be ready (%d)" attempt)) ) + >>= fun () -> return (Some (pg_process, pg_cli_option)) + | None -> return None ) + >>= fun pg_opt -> (* We need to use /tmp and not the root-path because of Docker access rights. *) let tmp = "/tmp" // sprintf "kiln-config-%d" port in Running_processes.run_cmdf state @@ -57,8 +66,8 @@ let start ?(network_id = "zeronet") state (fun out -> Lwt_io.write out {json|[ -{ "logger":{"Stderr":{}} , "filters": { "SQL":"Error" , "":"Info"}}, -{ "logger":{"File":{"file":"/var/run/bake-monitor/kiln.log"}}, "filters": { "": "Debug" } } + { "logger":{"Stderr":{}} , "filters": { "SQL":"Error" , "":"Info"}}, + { "logger":{"File":{"file":"/var/run/bake-monitor/kiln.log"}}, "filters": { "": "Debug" } } ]|json} ) ) () @@ -67,21 +76,23 @@ let start ?(network_id = "zeronet") state >>= fun _ -> let kiln = let args = - [ sprintf - "--pg-connection=host=localhost port=%d dbname=postgres \ - user=postgres password=%s" - pg_port pg_password - ; "--nodes" - ; String.concat ~sep:"," node_uris - ; "--bakers" - ; String.concat ~sep:"," - (List.map bakers ~f:(fun (n, pkh) -> sprintf "%s@%s" pkh n)) - ; "--network"; network_id; "--"; "--port"; Int.to_string kiln_port ] + (match pg_opt with None -> [] | Some (_, cli) -> [cli]) + @ [ "--nodes" + ; String.concat ~sep:"," node_uris + ; "--bakers" + ; String.concat ~sep:"," + (List.map bakers ~f:(fun (n, pkh) -> sprintf "%s@%s" pkh n)) + ; "--network"; network_id; "--"; "--port"; Int.to_string kiln_port ] in - Running_processes.Process.docker_run (name "kiln-backend") ~image - ~options: - ["--network"; "host"; "-v"; sprintf "%s:/var/run/bake-monitor" tmp] - ~args + match run with + | `Docker image -> + Running_processes.Process.docker_run (name "kiln-backend") ~image + ~options: + ["--network"; "host"; "-v"; sprintf "%s:/var/run/bake-monitor" tmp] + ~args + | `Dev_mode (dir, cmd) -> + Running_processes.Process.genspio (name "kiln-dev-backend") + Genspio.EDSL.(seq [exec ["cd"; dir]; exec (cmd :: args)]) in Running_processes.start state kiln >>= fun kiln_process -> @@ -99,26 +110,39 @@ let start ?(network_id = "zeronet") state [ wf "Started Kiln with Nodes and Bakers." ; wf "You may open and quit this prompt (`q`)." kiln_port ] ) - >>= fun () -> return (pg_process, kiln_process) + >>= fun () -> return (Option.map ~f:fst pg_opt, kiln_process) let cli_term () = let open Cmdliner in Term.( - pure (fun run port postgres_port pause_for_user -> function - | true -> Some (make ~run ~postgres_port ~port ~pause_for_user) + pure (fun run_docker run_dev_opt port postgres pause_for_user -> function + | true -> + let run = Option.value run_dev_opt ~default:run_docker in + Some (make ~run ?postgres ~port ~pause_for_user ()) | false -> None ) $ Arg.( let doc = "Set the Kiln docker image." in pure (fun docker_image -> `Docker docker_image) $ value (opt string default_docker_image (info ["kiln-docker-image"] ~doc))) + $ Arg.( + let doc = "Set the Kiln docker image." in + pure (Option.map ~f:(fun dir -> `Dev_mode (dir, "./backend"))) + $ value (opt (some string) None (info ["kiln-dev-mode"] ~doc))) $ Arg.( value (opt int default.port (info ["kiln-port"] ~doc:"Set the kiln port."))) $ Arg.( - value - (opt int default.postgres_port - (info ["kiln-pg-port"] ~doc:"Set the Postgres port for Kiln."))) + pure (function + | false -> fun port -> Some (`Docker port) + | true -> fun _ -> None ) + $ value + (flag + (info ["kiln-without-postgres"] + ~doc:"Let Kiln run its own Postgres.")) + $ value + (opt int default_postgres_port + (info ["kiln-pg-port"] ~doc:"Set the Postgres port for Kiln."))) $ Arg.( value (flag diff --git a/src/lib_network_sandbox/kiln.mli b/src/lib_network_sandbox/kiln.mli index ad10b2a782f3..b4d431fd884e 100644 --- a/src/lib_network_sandbox/kiln.mli +++ b/src/lib_network_sandbox/kiln.mli @@ -5,15 +5,16 @@ open Internal_pervasives type t val make : - run:[`Docker of string] + run:[`Dev_mode of string * string | `Docker of string] -> port:int - -> postgres_port:int + -> ?postgres:[`Docker of int] -> pause_for_user:bool + -> unit -> t (** Configure a Kiln process-to-be, running on port [~port] and - managing a PostgreSQL database on port [~postgres_port]. If - [pause_for_user] is [true], !{start} will add an interactive pause - to show the user the URI of the WebUI. *) + managing a PostgreSQL database on port [~postgres:(`Docker + port)]. If [pause_for_user] is [true], !{start} will add an + interactive pause to show the user the URI of the WebUI. *) val default_docker_image : string val default : t @@ -30,7 +31,7 @@ val start : -> t -> node_uris:string list -> bakers:(string * string) list - -> ( Running_processes.State.process_state + -> ( Running_processes.State.process_state option * Running_processes.State.process_state , [> `Lwt_exn of exn | `Waiting_for of string * [`Time_out]] ) Asynchronous_result.t -- GitLab From 42a3f645386a3eb5e5bd6bc6b7d35c02a22ebaef Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Mon, 1 Apr 2019 17:37:45 -0400 Subject: [PATCH 22/49] Flextesa: fix voting test (proposals submission) --- src/bin_flextesa/command_voting.ml | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 29023ec997f3..40320efcf6cd 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -328,10 +328,6 @@ Running_processes.run_successful_cmdf state | _ when p = demo_hash -> "injected demo" | _ -> "injected unknown" ) )) ] >>= fun () -> - let new_protocols = - List.filter after_injections_protocols ~f:(fun ph -> - not (List.mem default_protocols ph ~equal:String.equal) ) - in Asynchronous_result.map_option with_ledger ~f:(fun _ -> Interactive_test.Pauser.generic state EF. @@ -353,10 +349,11 @@ Running_processes.run_successful_cmdf state (["submit"; "proposals"; "for"; baker.key_name] @ props) >>= fun _ -> return () in + let to_submit_first = [winner_hash; demo_hash] in ( match serialize_proposals with - | false -> submit_proposals special_baker new_protocols + | false -> submit_proposals special_baker to_submit_first | true -> - List_sequential.iter new_protocols ~f:(fun one -> + List_sequential.iter to_submit_first ~f:(fun one -> submit_proposals special_baker [one] ) ) >>= fun () -> Tezos_client.successful_client_cmd state ~client:baker_0.client -- GitLab From 12398bf0c8d620485e92a1d77827f914dc4d7801 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Wed, 3 Apr 2019 11:47:49 -0400 Subject: [PATCH 23/49] Flextesa: fix doc for `--kiln-dev-node` option --- src/lib_network_sandbox/kiln.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/lib_network_sandbox/kiln.ml b/src/lib_network_sandbox/kiln.ml index 90c5974f0171..7d8aa06dfc1e 100644 --- a/src/lib_network_sandbox/kiln.ml +++ b/src/lib_network_sandbox/kiln.ml @@ -126,7 +126,9 @@ let cli_term () = $ value (opt string default_docker_image (info ["kiln-docker-image"] ~doc))) $ Arg.( - let doc = "Set the Kiln docker image." in + let doc = + "Set the path to the directory containing Kiln's `./backend`." + in pure (Option.map ~f:(fun dir -> `Dev_mode (dir, "./backend"))) $ value (opt (some string) None (info ["kiln-dev-mode"] ~doc))) $ Arg.( -- GitLab From 502e3e1aea745cfb5a29b145c36b24dc15b63d69 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Mon, 22 Apr 2019 14:27:23 -0400 Subject: [PATCH 24/49] Flextesa: add `--no-daemons-for` option to mininet --- src/bin_flextesa/command_mini_network.ml | 40 ++++++++++++++++++------ 1 file changed, 31 insertions(+), 9 deletions(-) diff --git a/src/bin_flextesa/command_mini_network.ml b/src/bin_flextesa/command_mini_network.ml index cc9f22510c27..62a61a7e2d09 100644 --- a/src/bin_flextesa/command_mini_network.ml +++ b/src/bin_flextesa/command_mini_network.ml @@ -2,8 +2,8 @@ open Tezos_network_sandbox open Internal_pervasives open Console -let run state ~protocol ~size ~base_port ?kiln node_exec client_exec baker_exec - endorser_exec accuser_exec () = +let run state ~protocol ~size ~base_port ~no_daemons_for ?kiln node_exec + client_exec baker_exec endorser_exec accuser_exec () = Helpers.System_dependencies.precheck state `Or_fail ~executables: [node_exec; client_exec; baker_exec; endorser_exec; accuser_exec] @@ -46,14 +46,17 @@ let run state ~protocol ~size ~base_port ?kiln node_exec client_exec baker_exec | None -> assert false in Tezos_protocol.bootstrap_accounts protocol - |> List.mapi ~f:(fun idx acc -> + |> List.filter_mapi ~f:(fun idx acc -> let node, client = pick_a_node_and_client idx in let key = Tezos_protocol.Account.name acc in - ( acc - , client - , [ Tezos_daemon.baker_of_node ~exec:baker_exec ~client node ~key - ; Tezos_daemon.endorser_of_node ~exec:endorser_exec ~client node - ~key ] ) ) + if List.mem ~equal:String.equal no_daemons_for key then None + else + Some + ( acc + , client + , [ Tezos_daemon.baker_of_node ~exec:baker_exec ~client node ~key + ; Tezos_daemon.endorser_of_node ~exec:endorser_exec ~client + node ~key ] ) ) in List_sequential.iter keys_and_daemons ~f:(fun (acc, client, daemons) -> Tezos_client.bootstrapped ~state client @@ -95,9 +98,22 @@ let cmd ~pp_error () = let open Cmdliner in let open Term in Test_command_line.Run_command.make ~pp_error - ( pure (fun size base_port protocol bnod bcli bak endo accu kiln state -> + ( pure + (fun size + base_port + (`No_daemons_for no_daemons_for) + protocol + bnod + bcli + bak + endo + accu + kiln + state + -> let actual_test = run state ~size ~base_port ~protocol bnod bcli bak endo accu ?kiln + ~no_daemons_for in (state, Interactive_test.Pauser.run_test ~pp_error state actual_test) ) @@ -107,6 +123,12 @@ let cmd ~pp_error () = $ Arg.( value & opt int 20_000 & info ["base-port"; "P"] ~doc:"Base port number to build upon.") + $ Arg.( + pure (fun l -> `No_daemons_for l) + $ value + (opt_all string [] + (info ["no-daemons-for"] ~docv:"ACCOUNT-NAME" + ~doc:"Do not start daemons for $(docv)."))) $ Tezos_protocol.cli_term () $ Tezos_executable.cli_term `Node "tezos" $ Tezos_executable.cli_term `Client "tezos" -- GitLab From 42b6945a1d049a999b6cb1084b8c44b2fe6eaa2f Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Mon, 22 Apr 2019 18:16:22 -0400 Subject: [PATCH 25/49] Flextesa: add `--external-peers` and improve Kiln --- src/bin_flextesa/command_mini_network.ml | 18 ++++++--- .../internal_pervasives.ml | 27 +++++++++++-- src/lib_network_sandbox/kiln.ml | 40 +++++++++++++------ src/lib_network_sandbox/test_scenario.ml | 16 +++++--- src/lib_network_sandbox/test_scenario.mli | 6 ++- 5 files changed, 79 insertions(+), 28 deletions(-) diff --git a/src/bin_flextesa/command_mini_network.ml b/src/bin_flextesa/command_mini_network.ml index 62a61a7e2d09..fa323d542239 100644 --- a/src/bin_flextesa/command_mini_network.ml +++ b/src/bin_flextesa/command_mini_network.ml @@ -2,15 +2,16 @@ open Tezos_network_sandbox open Internal_pervasives open Console -let run state ~protocol ~size ~base_port ~no_daemons_for ?kiln node_exec - client_exec baker_exec endorser_exec accuser_exec () = +let run state ~protocol ~size ~base_port ~no_daemons_for ?kiln + ?external_peer_ports node_exec client_exec baker_exec endorser_exec + accuser_exec () = Helpers.System_dependencies.precheck state `Or_fail ~executables: [node_exec; client_exec; baker_exec; endorser_exec; accuser_exec] ~using_docker:(kiln <> None) >>= fun () -> - Test_scenario.network_with_protocol ~protocol ~size ~base_port state - ~node_exec ~client_exec + Test_scenario.network_with_protocol ?external_peer_ports ~protocol ~size + ~base_port state ~node_exec ~client_exec >>= fun (nodes, protocol) -> Tezos_client.rpc state ~client:(Tezos_client.of_node (List.hd_exn nodes) ~exec:client_exec) @@ -101,6 +102,7 @@ let cmd ~pp_error () = ( pure (fun size base_port + (`External_peers external_peer_ports) (`No_daemons_for no_daemons_for) protocol bnod @@ -113,7 +115,7 @@ let cmd ~pp_error () = -> let actual_test = run state ~size ~base_port ~protocol bnod bcli bak endo accu ?kiln - ~no_daemons_for + ~external_peer_ports ~no_daemons_for in (state, Interactive_test.Pauser.run_test ~pp_error state actual_test) ) @@ -123,6 +125,12 @@ let cmd ~pp_error () = $ Arg.( value & opt int 20_000 & info ["base-port"; "P"] ~doc:"Base port number to build upon.") + $ Arg.( + pure (fun l -> `External_peers l) + $ value + (opt_all int [] + (info ["add-external-peer-port"] ~docv:"PORT-NUMBER" + ~doc:"Add $(docv) to the peers of the network nodes."))) $ Arg.( pure (fun l -> `No_daemons_for l) $ value diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index 3d8aca75121f..a1422860f0f0 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -33,7 +33,8 @@ module EF = struct list ~delimiters:("(", ")") ~sep:"," ~param: { default_list with - space_after_opening= false; space_before_closing= false } + space_after_opening= false + ; space_before_closing= false } let shout = atom ~param:{atom_style= Some "shout"} let prompt = atom ~param:{atom_style= Some "prompt"} @@ -202,7 +203,8 @@ module Asynchronous_result = struct Lwt.return {result; attachments= attachments @ attach} (** The module opened everywhere. *) - module Std = struct let ( >>= ) = bind let return = return let fail = fail + module Std = struct + let ( >>= ) = bind let return = return let fail = fail end open Std @@ -316,7 +318,26 @@ module Base_state = struct end (** Some {!Lwt_unix} functions. *) -module System = struct let sleep f = Lwt_exception.catch Lwt_unix.sleep f +module System = struct + let sleep f = Lwt_exception.catch Lwt_unix.sleep f + + let write_file (_state : _ Base_state.t) ?perm path ~content = + Lwt_exception.catch + (fun () -> + Lwt_io.with_file ?perm ~mode:Lwt_io.output path (fun out -> + Lwt_io.write out content ) ) + () + + (* +{json|[ + { "logger":{"Stderr":{}} , "filters": { "SQL":"Error" , "":"Info"}} +]|json} + (* +{ "logger":{"File":{"file":"/var/run/bake-monitor/kiln.log"}}, "filters": { "": "Debug" } } + *) + ) ) + () + *) end (** WIP [jq]-like manipulation in pure OCaml. *) diff --git a/src/lib_network_sandbox/kiln.ml b/src/lib_network_sandbox/kiln.ml index 7d8aa06dfc1e..e83e1f11d7ee 100644 --- a/src/lib_network_sandbox/kiln.ml +++ b/src/lib_network_sandbox/kiln.ml @@ -60,17 +60,23 @@ let start ?(network_id = "zeronet") state {run; port; postgres; pause_for_user} Running_processes.run_cmdf state "rm -fr %s ; mkdir -p %s/config ; chmod -R 777 %s" tmp tmp tmp >>= fun _ -> - Lwt_exception.catch - (fun () -> - Lwt_io.with_file ~perm:0o777 ~mode:Lwt_io.output (tmp // "config/loggers") - (fun out -> - Lwt_io.write out - {json|[ - { "logger":{"Stderr":{}} , "filters": { "SQL":"Error" , "":"Info"}}, - { "logger":{"File":{"file":"/var/run/bake-monitor/kiln.log"}}, "filters": { "": "Debug" } } + System.write_file state ~perm:0o777 (tmp // "config/loggers") + ~content: + {json|[ + { "logger":{"Stderr":{}} , "filters": { "SQL":"Error" , "":"Info"}} ]|json} - ) ) - () + >>= fun () -> + System.write_file state ~perm:0o777 + (tmp // "config/kiln-node-custom-args") + ~content: + (sprintf + "--net-addr 0.0.0.0:10000 --private-mode --no-bootstrap-peers %s \ + --bootstrap-threshold 0 --connections 5 --sandbox \ + /home/smondet/tmp/metetests//0_mininet-test-data/protocol-default-and-command-line/sandbox.json" + ( List.map + (List.init 5 ~f:(fun i -> 20_001 + (2 * i))) + ~f:(sprintf "--peer 127.0.0.1:%d") + |> String.concat ~sep:" " )) >>= fun () -> Running_processes.run_cmdf state " chmod -R 777 %s" tmp >>= fun _ -> @@ -92,13 +98,23 @@ let start ?(network_id = "zeronet") state {run; port; postgres; pause_for_user} ~args | `Dev_mode (dir, cmd) -> Running_processes.Process.genspio (name "kiln-dev-backend") - Genspio.EDSL.(seq [exec ["cd"; dir]; exec (cmd :: args)]) + Genspio.EDSL.( + seq + [ exec ["cd"; tmp] + ; exec ["echo"; sprintf "tmp is %s" tmp] + ; call [str "echo"; getenv (str "PATH")] + ; exec ["sh"; "-c"; sprintf "ln -sf %s/* %s" dir tmp] + ; exec ["ls"; "-la"] + ; exec (cmd :: sprintf "--kiln-data-dir=%s" tmp :: args) ]) in Running_processes.start state kiln >>= fun kiln_process -> Console.say state EF.( - wf "Kiln was started with nodes: %s, and network-id: %s" + wf + "Kiln was started (cf. , Data-dir: %s) with \ + nodes: %s, and network-id: %s" + kiln_port tmp (List.map node_uris ~f:(sprintf "`%s`") |> String.concat ~sep:", ") network_id) >>= fun () -> diff --git a/src/lib_network_sandbox/test_scenario.ml b/src/lib_network_sandbox/test_scenario.ml index e77b2e070435..24689d301d55 100644 --- a/src/lib_network_sandbox/test_scenario.ml +++ b/src/lib_network_sandbox/test_scenario.ml @@ -71,7 +71,8 @@ module Topology = struct | Net_in_the_middle {left; right; middle} -> continue middle @ continue left @ continue right - let build ?protocol ?(base_port = 15_001) ~exec network = + let build ?(external_peer_ports = []) ?protocol ?(base_port = 15_001) ~exec + network = let all_ports = ref [] in let next_port = ref (base_port + (base_port mod 2)) in let rpc name = @@ -87,13 +88,16 @@ module Topology = struct let node peers id = let rpc_port = rpc id in let p2p_port = p2p id in - let expected_connections = List.length peers in + let expected_connections = + List.length peers + List.length external_peer_ports + in let peers = List.filter_map peers ~f:(fun p -> if p <> id then Some (p2p p) else None ) in Tezos_node.make ?protocol ~exec id ~expected_connections ~rpc_port - ~p2p_port peers + ~p2p_port + (external_peer_ports @ peers) in let dbgp prefx names = Printf.eprintf "%s:\n %s\n%!" prefx @@ -237,10 +241,10 @@ module Network = struct Tezos_client.bootstrapped client ~state ) end -let network_with_protocol ?base_port ?(size = 5) ?protocol state ~node_exec - ~client_exec = +let network_with_protocol ?external_peer_ports ?base_port ?(size = 5) ?protocol + state ~node_exec ~client_exec = let nodes = - Topology.build ?base_port ?protocol ~exec:node_exec + Topology.build ?base_port ?protocol ~exec:node_exec ?external_peer_ports (Topology.mesh "N" size) in let protocols = diff --git a/src/lib_network_sandbox/test_scenario.mli b/src/lib_network_sandbox/test_scenario.mli index 12222810966d..cd7931d30c3a 100644 --- a/src/lib_network_sandbox/test_scenario.mli +++ b/src/lib_network_sandbox/test_scenario.mli @@ -49,7 +49,8 @@ module Topology : sig string -> 'a network -> 'b network -> 'c network -> ('b * 'a * 'c) network val build : - ?protocol:Tezos_protocol.t + ?external_peer_ports:int list + -> ?protocol:Tezos_protocol.t -> ?base_port:int -> exec:Tezos_executable.t -> 'a network @@ -84,7 +85,8 @@ module Network : sig end val network_with_protocol : - ?base_port:int + ?external_peer_ports:int list + -> ?base_port:int -> ?size:int -> ?protocol:Tezos_protocol.t -> < paths: Paths.t ; runner: Running_processes.State.t ; .. > -- GitLab From ba64e67d5d3ad910819364ec89f901c1c6aba726 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 26 Apr 2019 13:08:06 -0400 Subject: [PATCH 26/49] Flextesa: add `Kiln.Configuration_directory` --- src/bin_flextesa/command_mini_network.ml | 24 +++++- src/lib_network_sandbox/kiln.ml | 102 +++++++++++++++++++++++ src/lib_network_sandbox/kiln.mli | 22 +++++ 3 files changed, 145 insertions(+), 3 deletions(-) diff --git a/src/bin_flextesa/command_mini_network.ml b/src/bin_flextesa/command_mini_network.ml index fa323d542239..ec7d5cfba575 100644 --- a/src/bin_flextesa/command_mini_network.ml +++ b/src/bin_flextesa/command_mini_network.ml @@ -3,8 +3,8 @@ open Internal_pervasives open Console let run state ~protocol ~size ~base_port ~no_daemons_for ?kiln - ?external_peer_ports node_exec client_exec baker_exec endorser_exec - accuser_exec () = + ?external_peer_ports ?generate_kiln_config node_exec client_exec baker_exec + endorser_exec accuser_exec () = Helpers.System_dependencies.precheck state `Or_fail ~executables: [node_exec; client_exec; baker_exec; endorser_exec; accuser_exec] @@ -31,6 +31,22 @@ let run state ~protocol ~size ~base_port ~no_daemons_for ?kiln sprintf "http://localhost:%d" rpc_port )) >>= fun (pg, kiln) -> return () ) >>= fun (_ : unit option) -> + Asynchronous_result.map_option generate_kiln_config ~f:(fun kiln_config -> + Kiln.Configuration_directory.generate state + kiln_config + ~peers:(List.map nodes ~f:(fun {Tezos_node.p2p_port; _} -> p2p_port)) + ~sandbox_json:(Tezos_protocol.sandbox_path ~config:state protocol) + ~nodes: + (List.map nodes ~f:(fun {Tezos_node.rpc_port; _} -> + sprintf "http://localhost:%d" rpc_port )) + ~bakers: + (List.map protocol.Tezos_protocol.bootstrap_accounts + ~f:(fun (account, _) -> + Tezos_protocol.Account.(name account, pubkey_hash account) )) + ~network_string:network_id ~node_exec ~client_exec + ~protocol_execs: + [(protocol.Tezos_protocol.hash, baker_exec, endorser_exec)] ) + >>= fun (_ : unit option) -> let accusers = List.map nodes ~f:(fun node -> let client = Tezos_client.of_node node ~exec:client_exec in @@ -111,11 +127,12 @@ let cmd ~pp_error () = endo accu kiln + generate_kiln_config state -> let actual_test = run state ~size ~base_port ~protocol bnod bcli bak endo accu ?kiln - ~external_peer_ports ~no_daemons_for + ?generate_kiln_config ~external_peer_ports ~no_daemons_for in (state, Interactive_test.Pauser.run_test ~pp_error state actual_test) ) @@ -144,6 +161,7 @@ let cmd ~pp_error () = $ Tezos_executable.cli_term `Endorser "tezos" $ Tezos_executable.cli_term `Accuser "tezos" $ Kiln.cli_term () + $ Kiln.Configuration_directory.cli_term () $ Test_command_line.cli_state ~name:"mininet" () ) (let doc = "Small network sandbox with bakers, endorsers, and accusers." in let man : Manpage.block list = diff --git a/src/lib_network_sandbox/kiln.ml b/src/lib_network_sandbox/kiln.ml index e83e1f11d7ee..b66a09eb6cf7 100644 --- a/src/lib_network_sandbox/kiln.ml +++ b/src/lib_network_sandbox/kiln.ml @@ -175,3 +175,105 @@ let cli_term () = ~doc: "Add Kiln to the network (may make the test partially \ interactive).")))) + +module Configuration_directory = struct + type t = {path: string; clean: bool; p2p_port: int} + + let generate state t ~peers ~sandbox_json ~nodes ~bakers ~network_string + ~node_exec ~client_exec ~protocol_execs = + (* For now, client-exec in Kiln is not protocol dependent, this + should be fixed soon. *) + let {path; clean; p2p_port} = t in + ( if clean then + Running_processes.run_cmdf state + "rm -fr %s ; mkdir -p %s ; chmod -R 777 %s" path path path + >>= fun _ -> return () + else return () ) + >>= fun _ -> + System.write_file state ~perm:0o777 (path // "loggers") + ~content: + Ezjsonm.( + `A + [ dict + [ ("logger", dict [("Stderr", dict [])]) + ; ( "filters" + , dict [("SQL", string "Error"); ("", string "Info")] ) ] ] + |> to_string) + (* {json|[{ "logger":{"Stderr":{}} , "filters": { "SQL":"Error" , "":"Info"}}]|json} *) + >>= fun () -> + let node_config = path // "node-config.json" in + System.write_file state ~perm:0o777 node_config + ~content: + Ezjsonm.( + dict + [ ("data-dir", string (path // "node-data-dir-unused")) + ; ("rpc", dict [("listen-addr", string "127.0.0.1")]) + ; ("p2p", dict [("expected-proof-of-work", int 1)]) ] + |> to_string) + >>= fun () -> + System.write_file state ~perm:0o777 + (path // "kiln-node-custom-args") + ~content: + (sprintf + "--config-file %s --net-addr 0.0.0.0:%d --private-mode \ + --no-bootstrap-peers %s --bootstrap-threshold 0 --connections %d \ + --sandbox %s" + node_config p2p_port + ( List.map peers ~f:(sprintf "--peer 127.0.0.1:%d") + |> String.concat ~sep:" " ) + (List.length peers - 1) + sandbox_json) + >>= fun () -> + System.write_file state ~perm:0o777 (path // "nodes") + ~content:(String.concat ~sep:"," nodes) + >>= fun () -> + System.write_file state ~perm:0o777 (path // "bakers") + ~content: + ( List.map bakers ~f:(fun (n, addr) -> sprintf "%s@%s" addr n) + |> String.concat ~sep:"," ) + >>= fun () -> + System.write_file state ~perm:0o777 (path // "network") + ~content:network_string + >>= fun () -> + let pwd = Sys.getenv "PWD" in + let absolutize exec = + let path = Tezos_executable.get exec in + if Filename.is_relative path then pwd // path else path + in + System.write_file state ~perm:0o777 (path // "binary-paths") + ~content: + Ezjsonm.( + dict + [ ("node-path", string (absolutize node_exec)) + ; ("client-path", string (absolutize client_exec)) + ; ( "baker-endorser-paths" + , list + (fun (p, bak, endo) -> + strings [p; absolutize bak; absolutize endo] ) + protocol_execs ) ] + |> to_string ~minify:false) + >>= fun () -> + Running_processes.run_cmdf state " chmod -R 777 %s" path + >>= fun _ -> return () + + let cli_term () = + let open Cmdliner in + Term.( + pure (fun x clean -> + Option.map x ~f:(fun (path, p2p_port) -> {path; p2p_port; clean}) ) + $ Arg.( + value + (opt + (some (pair ~sep:',' string int)) + None + (info + ["generate-kiln-configuration-path"] + ~docv:"PATH,PORT" + ~doc:"Generate a kiln configuration at $(docv)"))) + $ Arg.( + value + (flag + (info + ["clean-kiln-configuration"] + ~doc:"Delete configuration path before generating it")))) +end diff --git a/src/lib_network_sandbox/kiln.mli b/src/lib_network_sandbox/kiln.mli index b4d431fd884e..e8b0817db4ac 100644 --- a/src/lib_network_sandbox/kiln.mli +++ b/src/lib_network_sandbox/kiln.mli @@ -44,3 +44,25 @@ val start : val cli_term : unit -> t option Cmdliner.Term.t (** Build a {!Cmdliner.Term.t} which provides options like ["--with-kiln"] or ["--kiln-docker-image"]. *) + +module Configuration_directory : sig + type t = {path: string; clean: bool; p2p_port: int} + + val generate : + < application_name: string + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> t + -> peers:int list + -> sandbox_json:string + -> nodes:string list + -> bakers:(string * string) list + -> network_string:string + -> node_exec:Tezos_executable.t + -> client_exec:Tezos_executable.t + -> protocol_execs:(string * Tezos_executable.t * Tezos_executable.t) list + -> (unit, [> Lwt_exception.t]) Asynchronous_result.t + + val cli_term : unit -> t option Cmdliner.Term.t +end -- GitLab From df8450bc7c6a9eae5c61c96d495cc14065ffdc83 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 26 Apr 2019 16:00:58 -0400 Subject: [PATCH 27/49] Flextesa: add `daemons-upgrade` test --- .../command_daemons_protocol_change.ml | 326 ++++++++++++++++++ src/bin_flextesa/command_voting.ml | 40 +-- src/bin_flextesa/main.ml | 1 + .../internal_pervasives.ml | 9 + src/lib_network_sandbox/tezos_admin_client.ml | 12 + .../tezos_admin_client.mli | 12 + src/lib_network_sandbox/tezos_daemon.ml | 21 +- src/lib_network_sandbox/tezos_daemon.mli | 22 +- src/lib_network_sandbox/tezos_node.ml | 5 +- src/lib_network_sandbox/tezos_protocol.ml | 48 ++- src/lib_network_sandbox/tezos_protocol.mli | 10 + 11 files changed, 455 insertions(+), 51 deletions(-) create mode 100644 src/bin_flextesa/command_daemons_protocol_change.ml diff --git a/src/bin_flextesa/command_daemons_protocol_change.ml b/src/bin_flextesa/command_daemons_protocol_change.ml new file mode 100644 index 000000000000..f5ed6ab44db4 --- /dev/null +++ b/src/bin_flextesa/command_daemons_protocol_change.ml @@ -0,0 +1,326 @@ +open Tezos_network_sandbox +open Internal_pervasives +open Console + +let wait_for_voting_period state ~client ~attempts period = + let period_name = Tezos_protocol.Voting_period.to_string period in + Console.sayf state + Fmt.(fun ppf () -> pf ppf "Waiting for voting period: `%s`" period_name) + >>= fun () -> + Helpers.wait_for state ~attempts ~seconds:10. (fun nth -> + Tezos_client.rpc state ~client `Get + ~path:"/chains/main/blocks/head/votes/current_period_kind" + >>= function + | `String p when p = period_name -> return (`Done (nth - 1)) + | other -> + return (`Not_done (sprintf "Waiting for %S period" period_name)) ) + +let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt + +let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports + ?generate_kiln_config ~node_exec ~client_exec ~first_baker_exec + ~first_endorser_exec ~first_accuser_exec ~second_baker_exec + ~second_endorser_exec ~second_accuser_exec + ~(* ~baker_exec + * ~endorser_exec + * ~accuser_exec *) + admin_exec ~new_protocol_path () = + Helpers.System_dependencies.precheck state `Or_fail + ~executables: + [ node_exec; client_exec; first_baker_exec; first_endorser_exec + ; first_accuser_exec; second_baker_exec; second_endorser_exec + ; second_accuser_exec ] + >>= fun () -> + Test_scenario.network_with_protocol ?external_peer_ports ~protocol ~size + ~base_port state ~node_exec ~client_exec + >>= fun (nodes, protocol) -> + Tezos_client.rpc state + ~client:(Tezos_client.of_node (List.hd_exn nodes) ~exec:client_exec) + `Get ~path:"/chains/main/chain_id" + >>= fun chain_id_json -> + let network_id = + match chain_id_json with `String s -> s | _ -> assert false + in + let accusers = + List.concat_map nodes ~f:(fun node -> + let client = Tezos_client.of_node node ~exec:client_exec in + [ Tezos_daemon.accuser_of_node ~exec:first_accuser_exec ~client node + ~name_tag:"first" + ; Tezos_daemon.accuser_of_node ~exec:second_accuser_exec ~client node + ~name_tag:"second" ] ) + in + List_sequential.iter accusers ~f:(fun acc -> + Running_processes.start state (Tezos_daemon.process acc ~state) + >>= fun {process; lwt} -> return () ) + >>= fun () -> + let keys_and_daemons = + let pick_a_node_and_client idx = + match List.nth nodes ((1 + idx) mod List.length nodes) with + | Some node -> (node, Tezos_client.of_node node ~exec:client_exec) + | None -> assert false + in + Tezos_protocol.bootstrap_accounts protocol + |> List.filter_mapi ~f:(fun idx acc -> + let node, client = pick_a_node_and_client idx in + let key = Tezos_protocol.Account.name acc in + if List.mem ~equal:String.equal no_daemons_for key then None + else + Some + ( acc + , client + , [ Tezos_daemon.baker_of_node ~exec:first_baker_exec ~client + node ~key ~name_tag:"first" + ; Tezos_daemon.baker_of_node ~exec:second_baker_exec ~client + ~name_tag:"second" node ~key + ; Tezos_daemon.endorser_of_node ~exec:first_endorser_exec + ~name_tag:"first" ~client node ~key + ; Tezos_daemon.endorser_of_node ~exec:second_endorser_exec + ~name_tag:"second" ~client node ~key ] ) ) + in + List_sequential.iter keys_and_daemons ~f:(fun (acc, client, daemons) -> + Tezos_client.bootstrapped ~state client + >>= fun () -> + let key, priv = Tezos_protocol.Account.(name acc, private_key acc) in + Tezos_client.import_secret_key ~state client key priv + >>= fun () -> + say state + EF.( + desc_list + (haf "Registration-as-delegate:") + [ desc (af "Client:") (af "%S" client.Tezos_client.id) + ; desc (af "Key:") (af "%S" key) ]) + >>= fun () -> + Tezos_client.register_as_delegate ~state client key + >>= fun () -> + say state + EF.( + desc_list (haf "Starting daemons:") + [ desc (af "Client:") (af "%S" client.Tezos_client.id) + ; desc (af "Key:") (af "%S" key) ]) + >>= fun () -> + List_sequential.iter daemons ~f:(fun daemon -> + Running_processes.start state (Tezos_daemon.process daemon ~state) + >>= fun {process; lwt} -> return () ) ) + >>= fun () -> + let client_0 = + Tezos_client.of_node (List.nth_exn nodes 0) ~exec:client_exec + in + let make_admin = Tezos_admin_client.of_client ~exec:admin_exec in + Interactive_test.Pauser.add_commands state + Interactive_test.Commands.( + all_defaults state ~nodes + @ [ secret_keys state ~protocol + ; arbitrary_command_on_clients state + ~command_names:["all-clients"; "cc"] ~make_admin + ~clients: + (List.map nodes ~f:(Tezos_client.of_node ~exec:client_exec)) + ; arbitrary_command_on_clients state ~command_names:["c0"; "client-0"] + ~make_admin ~clients:[client_0] ]) ; + Test_scenario.Queries.wait_for_all_levels_to_be state ~attempts:50 + ~seconds:10. nodes + (* TODO: wait for /chains/main/blocks/head/votes/listings to be + non-empty instead of counting blocks *) + (`At_least protocol.Tezos_protocol.blocks_per_voting_period) + >>= fun () -> + (* + For each node we try to see if the node knows about the protocol, + if it does we're good, if not we inject it. + This is because `inject` fails when the node already knows a protocol. + *) + List.fold ~init:(return None) nodes ~f:(fun prevm nod -> + prevm + >>= fun _ -> + System.read_file state (new_protocol_path // "TEZOS_PROTOCOL") + >>= fun protocol -> + ( try return Jqo.(of_string protocol |> field ~k:"hash" |> get_string) + with e -> + failf "Cannot parse %s/TEZOS_PROTOCOL: %s" new_protocol_path + (Printexc.to_string e) ) + >>= fun hash -> + let client = Tezos_client.of_node ~exec:client_exec nod in + Tezos_client.rpc state ~client `Get ~path:"/protocols" + >>= fun protocols -> + match protocols with + | `A l + when List.exists l ~f:(function `String h -> h = hash | _ -> false) -> + Console.say state + EF.( + wf "Node `%s` already knows protocol `%s`." nod.Tezos_node.id + hash) + >>= fun () -> return (Some hash) + | _ -> + let admin = make_admin client in + Tezos_admin_client.inject_protocol admin state + ~path:new_protocol_path + >>= fun (_, new_protocol_hash) -> + ( if new_protocol_hash = hash then + Console.say state + EF.( + wf "Injected protocol `%s` in `%s`" new_protocol_hash + nod.Tezos_node.id) + else + failf "Injecting protocol %s failed (≠ %s)" new_protocol_hash + hash ) + >>= fun () -> return (Some hash) ) + >>= fun prot_opt -> + ( match prot_opt with + | Some s -> return s + | None -> failf "protocol injection problem?" ) + >>= fun new_protocol_hash -> + Asynchronous_result.map_option generate_kiln_config ~f:(fun kiln_config -> + Kiln.Configuration_directory.generate state kiln_config + ~peers:(List.map nodes ~f:(fun {Tezos_node.p2p_port; _} -> p2p_port)) + ~sandbox_json:(Tezos_protocol.sandbox_path ~config:state protocol) + ~nodes: + (List.map nodes ~f:(fun {Tezos_node.rpc_port; _} -> + sprintf "http://localhost:%d" rpc_port )) + ~bakers: + (List.map protocol.Tezos_protocol.bootstrap_accounts + ~f:(fun (account, _) -> + Tezos_protocol.Account.(name account, pubkey_hash account) )) + ~network_string:network_id ~node_exec ~client_exec + ~protocol_execs: + [ ( protocol.Tezos_protocol.hash + , first_baker_exec + , first_endorser_exec ) + ; (new_protocol_hash, second_baker_exec, second_endorser_exec) ] + >>= fun () -> + return EF.(wf "Kiln was configured at `%s`" kiln_config.path) ) + >>= fun kiln_info_opt -> + Interactive_test.Pauser.generic state + EF. + [ wf "Test becomes interactive." + ; Option.value kiln_info_opt ~default:(wf "") + ; wf "Please type `q` to start a voting/protocol-change period." ] + ~force:true + >>= fun () -> + wait_for_voting_period state ~client:client_0 ~attempts:10 Proposal + >>= fun _ -> + List_sequential.iter keys_and_daemons ~f:(fun (acc, client, _) -> + Tezos_client.successful_client_cmd state ~client + [ "submit"; "proposals"; "for" + ; Tezos_protocol.Account.name acc + ; new_protocol_hash ] + >>= fun _ -> + Console.sayf state + Fmt.( + fun ppf () -> + pf ppf "%s voted for %s" + (Tezos_protocol.Account.name acc) + new_protocol_hash) ) + >>= fun () -> + wait_for_voting_period state ~client:client_0 ~attempts:50 Testing_vote + >>= fun _ -> + List_sequential.iter keys_and_daemons ~f:(fun (acc, client, _) -> + Tezos_client.successful_client_cmd state ~client + [ "submit"; "ballot"; "for" + ; Tezos_protocol.Account.name acc + ; new_protocol_hash; "yea" ] + >>= fun _ -> + Console.sayf state + Fmt.( + fun ppf () -> + pf ppf "%s voted Yea to test %s" + (Tezos_protocol.Account.name acc) + new_protocol_hash) ) + >>= fun () -> + wait_for_voting_period state ~client:client_0 ~attempts:50 Promotion_vote + >>= fun _ -> + List_sequential.iter keys_and_daemons ~f:(fun (acc, client, _) -> + Tezos_client.successful_client_cmd state ~client + [ "submit"; "ballot"; "for" + ; Tezos_protocol.Account.name acc + ; new_protocol_hash; "yea" ] + >>= fun _ -> + Console.sayf state + Fmt.( + fun ppf () -> + pf ppf "%s voted Yea to promote %s" + (Tezos_protocol.Account.name acc) + new_protocol_hash) ) + >>= fun () -> + (* wait_for_voting_period state ~client:client_0 ~attempts:50 Proposal + * >>= fun _ -> *) + Tezos_client.successful_client_cmd state ~client:client_0 + ["show"; "voting"; "period"] + >>= fun res -> + Interactive_test.Pauser.generic state + EF. + [ wf "Test finished, but it should keep baking." + ; markdown_verbatim (String.concat ~sep:"\n" res#out) ] + ~force:true + +let cmd ~pp_error () = + let open Cmdliner in + let open Term in + Test_command_line.Run_command.make ~pp_error + ( pure + (fun size + base_port + (`External_peers external_peer_ports) + (`No_daemons_for no_daemons_for) + protocol + node_exec + client_exec + admin_exec + first_baker_exec + first_endorser_exec + first_accuser_exec + second_baker_exec + second_endorser_exec + second_accuser_exec + (`Protocol_path new_protocol_path) + generate_kiln_config + state + -> + let actual_test = + run state ~size ~base_port ~protocol ~node_exec ~client_exec + ~first_baker_exec ~first_endorser_exec ~first_accuser_exec + ~second_baker_exec ~second_endorser_exec ~second_accuser_exec + ~admin_exec ?generate_kiln_config ~external_peer_ports + ~no_daemons_for ~new_protocol_path + in + (state, Interactive_test.Pauser.run_test ~pp_error state actual_test) + ) + $ Arg.( + value & opt int 5 + & info ["size"; "S"] ~doc:"Set the size of the network.") + $ Arg.( + value & opt int 20_000 + & info ["base-port"; "P"] ~doc:"Base port number to build upon.") + $ Arg.( + pure (fun l -> `External_peers l) + $ value + (opt_all int [] + (info ["add-external-peer-port"] ~docv:"PORT-NUMBER" + ~doc:"Add $(docv) to the peers of the network nodes."))) + $ Arg.( + pure (fun l -> `No_daemons_for l) + $ value + (opt_all string [] + (info ["no-daemons-for"] ~docv:"ACCOUNT-NAME" + ~doc:"Do not start daemons for $(docv)."))) + $ Tezos_protocol.cli_term () + $ Tezos_executable.cli_term `Node "tezos" + $ Tezos_executable.cli_term `Client "tezos" + $ Tezos_executable.cli_term `Admin "tezos" + $ Tezos_executable.cli_term `Baker "first" + $ Tezos_executable.cli_term `Endorser "first" + $ Tezos_executable.cli_term `Accuser "first" + $ Tezos_executable.cli_term `Baker "second" + $ Tezos_executable.cli_term `Endorser "second" + $ Tezos_executable.cli_term `Accuser "second" + $ Arg.( + pure (fun p -> `Protocol_path p) + $ required + (pos 0 (some string) None + (info [] ~doc:"The protocol to inject and vote on." ~docv:"PATH"))) + $ Kiln.Configuration_directory.cli_term () + $ Test_command_line.cli_state ~name:"daemons-upgrade" () ) + (let doc = "Small network sandbox with bakers, endorsers, and accusers." in + let man : Manpage.block list = + [ `P + "This test builds a small sandbox network, start various daemons, \ + and then ... TODO ..." ] + in + info "daemons-upgrade" ~man ~doc) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 40320efcf6cd..867abdf81f35 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -43,23 +43,6 @@ let setup_baking_ledger state uri ~client = let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt -type voting_period = - Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period - .kind = - | Proposal - | Testing_vote - | Testing - | Promotion_vote - -let voting_period_to_string (p : voting_period) = - match - Tezos_data_encoding.Data_encoding.Json.construct - Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind_encoding - p - with - | `String s -> s - | other -> assert false - let transfer state ~client ~src ~dst ~amount = Tezos_client.successful_client_cmd state ~client [ "--wait"; "none"; "transfer"; sprintf "%Ld" amount; "from"; src; "to"; dst @@ -68,7 +51,7 @@ let transfer state ~client ~src ~dst ~amount = let bake_until_voting_period ?keep_alive_delegate state ~baker ~attempts period = let client = baker.Tezos_client.Keyed.client in - let period_name = voting_period_to_string period in + let period_name = Tezos_protocol.Voting_period.to_string period in Helpers.wait_for state ~attempts ~seconds:0.5 (fun nth -> Tezos_client.rpc state ~client `Get ~path:"/chains/main/blocks/head/votes/current_period_kind" @@ -103,7 +86,7 @@ let check_understood_protocols state ~chain ~client ~protocol_hash | None -> return `Failure_to_understand ) | Error (`Client_command_error _) when expect_clueless_client -> return `Expected_misunderstanding - | Error e -> fail e) + | Error e -> fail e ) let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec ~clueless_winner ~admin_exec ~winner_client_exec ~size ~base_port @@ -286,17 +269,8 @@ Running_processes.run_successful_cmdf state >>= fun _ -> return () else return () ) >>= fun () -> - Tezos_admin_client.successful_command admin_0 state - ["inject"; "protocol"; tmpdir] - >>= fun res -> - String.concat ~sep:" " res#out - |> String.split ~on:' ' |> List.map ~f:String.strip - |> (function - | _ :: _ :: hash :: _ when hash.[0] = 'P' -> return hash - | _ -> - failf "inject protocol: cannot parse hash of protocol: %s" - (String.concat ~sep:", " (List.map ~f:(sprintf "%S") res#out))) - >>= fun hash -> + Tezos_admin_client.inject_protocol admin_0 state ~path:tmpdir + >>= fun (res, hash) -> Interactive_test.Pauser.generic state EF. [ af "Just injected %s (%s): %s" name path hash @@ -439,7 +413,7 @@ Running_processes.run_successful_cmdf state Console.say state EF.(wf "Winner-Client cannot bake on test chain (expected)") | `Failure_to_understand -> - failf "Winner-Client cannot bake on test chain!") + failf "Winner-Client cannot bake on test chain!" ) >>= fun () -> Helpers.wait_for state ~attempts:default_attempts ~seconds:0.3 (fun nth -> Tezos_client.rpc state ~client:(client 1) `Get @@ -565,7 +539,7 @@ Running_processes.run_successful_cmdf state desc (shout "Warning") (wf "Command `upgrade baking state` failed, but we \ - keep going with the baking."))) + keep going with the baking.")) ) >>= fun () -> Asynchronous_result.map_option with_ledger ~f:(fun _ -> Interactive_test.Pauser.generic state @@ -596,7 +570,7 @@ Running_processes.run_successful_cmdf state | `String p when p = winner_hash -> return () | other -> failf "Protocol is not `%s` but `%s`" winner_hash - Ezjsonm.(to_string (wrap other)) )) + Ezjsonm.(to_string (wrap other)) ) ) >>= fun () -> Interactive_test.Pauser.generic state EF. diff --git a/src/bin_flextesa/main.ml b/src/bin_flextesa/main.ml index 7a2e688cfc1b..56a09925b1f6 100644 --- a/src/bin_flextesa/main.ml +++ b/src/bin_flextesa/main.ml @@ -78,6 +78,7 @@ let () = (help : unit Term.t * _) ( Small_utilities.all ~pp_error () @ [ Command_mini_network.cmd () ~pp_error + ; Command_daemons_protocol_change.cmd () ~pp_error ; Command_voting.cmd () ~pp_error ; Command_accusations.cmd () ~pp_error ; Command_prevalidation.cmd () ~pp_error ] ) diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index a1422860f0f0..53d6a21aa17b 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -328,6 +328,13 @@ module System = struct Lwt_io.write out content ) ) () + let read_file (_state : _ Base_state.t) path = + Lwt_exception.catch + (fun () -> + Lwt_io.with_file ~mode:Lwt_io.input path (fun out -> + Lwt_io.read out ) ) + () + (* {json|[ { "logger":{"Stderr":{}} , "filters": { "SQL":"Error" , "":"Info"}} @@ -364,4 +371,6 @@ module Jqo = struct | other -> ksprintf failwith "Jqo.remove_field %S: No an object: %s" name (to_string other) + + let get_string = Ezjsonm.get_string end diff --git a/src/lib_network_sandbox/tezos_admin_client.ml b/src/lib_network_sandbox/tezos_admin_client.ml index d58cf9092b86..fff5ad98d059 100644 --- a/src/lib_network_sandbox/tezos_admin_client.ml +++ b/src/lib_network_sandbox/tezos_admin_client.ml @@ -45,3 +45,15 @@ let successful_command admin state args = | true -> return res | false -> failf ~args "Admin-command failure: %s" (String.concat ~sep:" " args) + +let inject_protocol admin state ~path = + successful_command admin state ["inject"; "protocol"; path] + >>= fun res -> + String.concat ~sep:" " res#out + |> String.split ~on:' ' |> List.map ~f:String.strip + |> (function + | _ :: _ :: hash :: _ when hash.[0] = 'P' -> return hash + | _ -> + failf "inject protocol: cannot parse hash of protocol: %s" + (String.concat ~sep:", " (List.map ~f:(sprintf "%S") res#out)) ) + >>= fun hash -> return (res, hash) diff --git a/src/lib_network_sandbox/tezos_admin_client.mli b/src/lib_network_sandbox/tezos_admin_client.mli index 736adb813228..2a3a342df0a8 100644 --- a/src/lib_network_sandbox/tezos_admin_client.mli +++ b/src/lib_network_sandbox/tezos_admin_client.mli @@ -33,3 +33,15 @@ val successful_command : -> ( Process_result.t , [> Command_error.t | `Lwt_exn of exn] ) Asynchronous_result.t + +val inject_protocol : + t + -> < application_name: string + ; console: Console.t + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> path:string + -> ( Process_result.t * string + , [> Command_error.t | `Lwt_exn of exn] ) + Asynchronous_result.t diff --git a/src/lib_network_sandbox/tezos_daemon.ml b/src/lib_network_sandbox/tezos_daemon.ml index 3a803ef1036c..eb0611dd49a8 100644 --- a/src/lib_network_sandbox/tezos_daemon.ml +++ b/src/lib_network_sandbox/tezos_daemon.ml @@ -9,12 +9,15 @@ type t = { node: Tezos_node.t ; client: Tezos_client.t ; exec: Tezos_executable.t - ; args: args } + ; args: args + ; name_tag: string option } -let of_node node args ~exec ~client = {node; exec; client; args} -let baker_of_node nod ~key = of_node nod (Baker key) -let endorser_of_node nod ~key = of_node nod (Endorser key) -let accuser_of_node nod = of_node nod Accuser +let of_node ?name_tag node args ~exec ~client = + {node; exec; client; args; name_tag} + +let baker_of_node ?name_tag nod ~key = of_node nod ?name_tag (Baker key) +let endorser_of_node ?name_tag nod ~key = of_node nod ?name_tag (Endorser key) +let accuser_of_node ?name_tag nod = of_node ?name_tag nod Accuser let arg_to_string = function | Baker k -> sprintf "baker-%s" k @@ -27,8 +30,9 @@ let to_script (t : t) ~state = Tezos_executable.call t.exec ~path: ( base_dir - // sprintf "exec-%s-%d" (arg_to_string t.args) - t.node.Tezos_node.rpc_port ) + // sprintf "exec-%s-%d%s" (arg_to_string t.args) + t.node.Tezos_node.rpc_port + (Option.value_map t.name_tag ~default:"" ~f:(sprintf "-%s")) ) args in match t.args with @@ -52,5 +56,6 @@ let to_script (t : t) ~state = let process (t : t) ~state = Running_processes.Process.genspio - (sprintf "%s-for-%s" (arg_to_string t.args) t.node.Tezos_node.id) + (sprintf "%s-for-%s%s" (arg_to_string t.args) t.node.Tezos_node.id + (Option.value_map t.name_tag ~default:"" ~f:(sprintf "-%s"))) (to_script t ~state) diff --git a/src/lib_network_sandbox/tezos_daemon.mli b/src/lib_network_sandbox/tezos_daemon.mli index 4f37d39ccb9a..98d4567ce8ee 100644 --- a/src/lib_network_sandbox/tezos_daemon.mli +++ b/src/lib_network_sandbox/tezos_daemon.mli @@ -7,27 +7,39 @@ type t = private { node: Tezos_node.t ; client: Tezos_client.t ; exec: Tezos_executable.t - ; args: args } + ; args: args + ; name_tag: string option } val of_node : - Tezos_node.t -> args -> exec:Tezos_executable.t -> client:Tezos_client.t -> t + ?name_tag:string + -> Tezos_node.t + -> args + -> exec:Tezos_executable.t + -> client:Tezos_client.t + -> t val baker_of_node : - Tezos_node.t + ?name_tag:string + -> Tezos_node.t -> key:string -> exec:Tezos_executable.t -> client:Tezos_client.t -> t val endorser_of_node : - Tezos_node.t + ?name_tag:string + -> Tezos_node.t -> key:string -> exec:Tezos_executable.t -> client:Tezos_client.t -> t val accuser_of_node : - Tezos_node.t -> exec:Tezos_executable.t -> client:Tezos_client.t -> t + ?name_tag:string + -> Tezos_node.t + -> exec:Tezos_executable.t + -> client:Tezos_client.t + -> t val arg_to_string : args -> string val to_script : t -> state:< paths: Paths.t ; .. > -> unit Genspio.Language.t diff --git a/src/lib_network_sandbox/tezos_node.ml b/src/lib_network_sandbox/tezos_node.ml index aeea2c6aaa5d..56186a5cedc3 100644 --- a/src/lib_network_sandbox/tezos_node.ml +++ b/src/lib_network_sandbox/tezos_node.ml @@ -64,8 +64,7 @@ let start_script t ~config = [] in let tmp_config = tmp_file (config_file t ~config) in - check_sequence - ~verbosity:(`Announce (sprintf "Node-%s-start" t.id)) + check_sequence ~verbosity:`Output_all [ (let opts = config_options t ~config in ( "config-init" , if_seq @@ -77,7 +76,7 @@ let start_script t ~config = [ write_stdout ~path:tmp_config#path (exec [ "jq" - ; {jq|.p2p += { "limits" : { "connection-timeout" : 2, "swap-linger" : 2 } }|jq} + ; {jq|.p2p += { "limits" : { "maintenance-idle-time": 3, "connection-timeout" : 2, "swap-linger" : 2 } }|jq} ; config_file t ~config ]) ; call [str "mv"; tmp_config#path; str (config_file t ~config)] ] ) ; ( "ensure-identity" diff --git a/src/lib_network_sandbox/tezos_protocol.ml b/src/lib_network_sandbox/tezos_protocol.ml index cb6d4e68a81c..261f17d03295 100644 --- a/src/lib_network_sandbox/tezos_protocol.ml +++ b/src/lib_network_sandbox/tezos_protocol.ml @@ -192,6 +192,23 @@ module Account = struct | Key_pair k -> k.private_key end +module Voting_period = struct + type t = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + | Testing + | Promotion_vote + + let to_string (p : t) = + match + Tezos_data_encoding.Data_encoding.Json.construct + Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period + .kind_encoding p + with + | `String s -> s + | _other -> assert false +end + type t = { id: string ; bootstrap_accounts: (Account.t * Int64.t) list @@ -294,7 +311,13 @@ let ensure t ~config = let cli_term () = let open Cmdliner in let open Term in - pure (fun remove_default_bas (`Time_between_blocks tbb) add_bootstraps -> + pure + (fun remove_default_bas + (`Blocks_per_voting_period bpvp) + (`Protocol_hash hashopt) + (`Time_between_blocks tbb) + add_bootstraps + -> let d = default () in let id = if add_bootstraps = [] && remove_default_bas = false then d.id @@ -307,12 +330,33 @@ let cli_term () = add_bootstraps @ if remove_default_bas then [] else d.bootstrap_accounts in - {d with id; bootstrap_accounts; time_between_blocks} ) + let blocks_per_voting_period = + match bpvp with Some v -> v | None -> d.blocks_per_voting_period + in + let hash = Option.value hashopt ~default:d.hash in + { d with + id + ; hash + ; bootstrap_accounts + ; time_between_blocks + ; blocks_per_voting_period } ) $ Arg.( value (flag (info ~doc:"Do not create any of the default bootstrap accounts." ["remove-default-bootstrap-accounts"]))) + $ Arg.( + pure (fun x -> `Blocks_per_voting_period x) + $ value + (opt (some int) None + (info + ["blocks-per-voting-period"] + ~docs:"Set the length of voting periods"))) + $ Arg.( + pure (fun x -> `Protocol_hash x) + $ value + (opt (some string) None + (info ["protocol-hash"] ~docs:"Set the (starting) protocol hash."))) $ Arg.( pure (fun x -> `Time_between_blocks x) $ value diff --git a/src/lib_network_sandbox/tezos_protocol.mli b/src/lib_network_sandbox/tezos_protocol.mli index f6ac171de07d..4a7f54760898 100644 --- a/src/lib_network_sandbox/tezos_protocol.mli +++ b/src/lib_network_sandbox/tezos_protocol.mli @@ -64,6 +64,16 @@ module Account : sig val private_key : t -> string end +module Voting_period : sig + type t = Tezos_client_alpha.Proto_alpha.Alpha_context.Voting_period.kind = + | Proposal + | Testing_vote + | Testing + | Promotion_vote + + val to_string : t -> string +end + (** [t] wraps bootstrap parameters for sandboxed protocols. *) type t = { id: string -- GitLab From 8e41720e1d9e7a76b2bd97456f09337a8d5fb09a Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 26 Apr 2019 18:47:16 -0400 Subject: [PATCH 28/49] Flextesa: fix code typo --- src/bin_flextesa/command_daemons_protocol_change.ml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/bin_flextesa/command_daemons_protocol_change.ml b/src/bin_flextesa/command_daemons_protocol_change.ml index f5ed6ab44db4..a49d6ea90c93 100644 --- a/src/bin_flextesa/command_daemons_protocol_change.ml +++ b/src/bin_flextesa/command_daemons_protocol_change.ml @@ -21,10 +21,7 @@ let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports ?generate_kiln_config ~node_exec ~client_exec ~first_baker_exec ~first_endorser_exec ~first_accuser_exec ~second_baker_exec ~second_endorser_exec ~second_accuser_exec - ~(* ~baker_exec - * ~endorser_exec - * ~accuser_exec *) - admin_exec ~new_protocol_path () = + ~admin_exec ~new_protocol_path () = Helpers.System_dependencies.precheck state `Or_fail ~executables: [ node_exec; client_exec; first_baker_exec; first_endorser_exec -- GitLab From 038720cc6ff59e4b8e640203e5be6a21de1e8170 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Mon, 29 Apr 2019 18:34:50 -0400 Subject: [PATCH 29/49] Flextesa: improve Kiln module --- src/lib_network_sandbox/kiln.ml | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/src/lib_network_sandbox/kiln.ml b/src/lib_network_sandbox/kiln.ml index b66a09eb6cf7..56f3180d0a07 100644 --- a/src/lib_network_sandbox/kiln.ml +++ b/src/lib_network_sandbox/kiln.ml @@ -211,14 +211,21 @@ module Configuration_directory = struct ; ("p2p", dict [("expected-proof-of-work", int 1)]) ] |> to_string) >>= fun () -> + System.write_file state ~perm:0o777 + (path // "kiln-node-net-port") + ~content:(sprintf "%d" p2p_port) + >>= fun () -> + let pwd = Sys.getenv "PWD" in + let absolutize path = + if Filename.is_relative path then pwd // path else path + in System.write_file state ~perm:0o777 (path // "kiln-node-custom-args") ~content: (sprintf - "--config-file %s --net-addr 0.0.0.0:%d --private-mode \ - --no-bootstrap-peers %s --bootstrap-threshold 0 --connections %d \ - --sandbox %s" - node_config p2p_port + "--config-file %s --private-mode --no-bootstrap-peers %s \ + --bootstrap-threshold 0 --connections %d --sandbox %s" + (absolutize node_config) ( List.map peers ~f:(sprintf "--peer 127.0.0.1:%d") |> String.concat ~sep:" " ) (List.length peers - 1) @@ -235,14 +242,13 @@ module Configuration_directory = struct System.write_file state ~perm:0o777 (path // "network") ~content:network_string >>= fun () -> - let pwd = Sys.getenv "PWD" in - let absolutize exec = - let path = Tezos_executable.get exec in - if Filename.is_relative path then pwd // path else path - in System.write_file state ~perm:0o777 (path // "binary-paths") ~content: Ezjsonm.( + let absolutize exec = + let path = Tezos_executable.get exec in + absolutize path + in dict [ ("node-path", string (absolutize node_exec)) ; ("client-path", string (absolutize client_exec)) -- GitLab From 6181819bfdcf07917c3aa43f7fef098254bb5637 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Tue, 30 Apr 2019 11:34:22 -0400 Subject: [PATCH 30/49] Flextesa: import doc changes (lost in rebase) --- docs/developer/flextesa.rst | 77 +++++++++++++++++++++++++------------ 1 file changed, 52 insertions(+), 25 deletions(-) diff --git a/docs/developer/flextesa.rst b/docs/developer/flextesa.rst index 4d6ca9f74aa2..8a3853320201 100644 --- a/docs/developer/flextesa.rst +++ b/docs/developer/flextesa.rst @@ -82,25 +82,38 @@ alongside the *Ꜩ-sandbox*, for instance: See also the options ``--kiln-*`` for configuration, and the option ``--starting-level`` (since Kiln assumes a long-running blockchain -adding more, e.g. 40, bakes at the beginning of the test brings us to a +adding more, e.g. 40, bakes at the beginning of the test brings us to a more “normal” state). Voting With a Ledger Nano S ~~~~~~~~~~~~~~~~~~~~~~~~~~~ - **Note:** this requires a ``tezos-client`` with the changes from - https://gitlab.com/tezos/tezos/merge_requests/848. + **Note:** this requires a recent ``tezos-client`` with the changes + from `!848 `__ as + well as the 2.0.0 version of the ledger Baking app. -The voting test for now goes up to the last block before the protocol is -supposed to change to the election winner (see also -``./tezos-sandbox voting --help``). +The voting test tries to do a full round of voting and protocol switch, +including baking on the test-chain, see documentation in +``./tezos-sandbox voting --help``. -The test can use a Ledger Nano S as one of the voters (the test -automatically becomes **interactive** then because the user has to press -buttons on the device). +The test can run in a simpler-to-setup, or “degraded,” mode of operation +(cf. call in ``./src/bin_flextesa/dune`` for the version which +run in Gitlab-CI pipelines). In this example, we run instead a full test +with a Ledger Nano S as one of the bakers/voters. The test automatically +becomes **interactive** because the user has to press buttons on the +device, including for changing between apps. -Get an URI for your ledger (the test requires both the Wallet and Baking -apps): +To make the test work, you need to provide it with a ``tezos-client`` +which knows about the protocol which is tested and then wins the voting +period. + +One example is this branch: +```obsidian.systems/tezos#zeronet-with-proto042`` `__ +which allows one to build a Zeronet-like code base with an extra +protocol, lets assume this is built at path ``$zeronet_042``. + +Also, get an URI for your ledger (the test requires both the Wallet and +Baking apps): :: @@ -110,27 +123,41 @@ And use the URI (no need to import it) for the ``--with-ledger`` option: :: - rlwrap ./tezos-sandbox voting ./src/bin_client/test/demo/ \ + rlwrap ./tezos-sandbox voting \ + $zeronet_042/src/proto_042_Pt1GS1Zi/lib_protocol/src \ + ./src/bin_client/test/demo/ \ --with-ledger "ledger://crouching-tiger-hidden-dragon/ed25519/0'/0'" \ --serialize-proposals \ - --root $PWD/voting-test \ --base-port=20_000 \ - --tezos-client-binary ../mr848/tezos-client \ + --current-node-binary $zeronet_042/tezos-node \ + --current-client-binary $zeronet_042/tezos-client \ + --winner-client-binary $zeronet_042/tezos-client \ + --current-admin-client-binary $zeronet_042/tezos-admin-client \ --pause-on-error=true +- The first path argument has to be the path to a valid protocol which + can be switched to from the current (``proto_alpha``) one. +- The second protocol, the looser, only needs to be valid for the + protocol compilation. +- The option ``--serialize-proposals`` tells the test to call + ``tezos-client submit proposals for ...`` one proposal at a time + which is the only method the ledger Baking app can really understand. +- The ``*-binary`` options allow to set the paths to the executables + for the different protocols: ``current`` and ``winner``. + The test becomes interactive and guides you through the interactions with the ledger, e.g.: :: - Flextesa.voting: - Ledger-prompt - - Setting up "ledger://crouching-tiger-hidden-dragon/ed25519/0'/0'" for - baking. The ledger should be showing the setup parameters (Address, - Main chain, HWMs). - - Please hit “✔” on the ledger. + Flextesa.voting: + Ledger-prompt + + Setting up "ledger://crouching-tiger-hidden-dragon/ed25519/0'/0'" for + baking. The ledger should be showing the setup parameters (Address, + Main chain, HWMs). + + Please hit “✔” on the ledger. Implementation Considerations ----------------------------- @@ -161,8 +188,8 @@ See ``./src/lib_network_sandbox/internal_pervasives.ml``: ``@[<2,3>@{crazy}@ @EDSLs@n@]``). - Many standard modules are taken from Jane St Base (already a dependency of Tezos): List, String, Option, Int, Float. -- Error monad uses *more typed* errors (polymorphic variants), cf. - module ``Asynchronous_result`` (and note that ``bind`` also calls +- Error monad uses *more typed* errors (polymorphic variants), + cf. module ``Asynchronous_result`` (and note that ``bind`` also calls ``Lwt_unix.auto_yield 0.005 ()``). - All state is kept in a (*non-global*) value passed as argument everywhere needed. To simplify the dependency management the state @@ -170,4 +197,4 @@ See ``./src/lib_network_sandbox/internal_pervasives.ml``: ``Console``, etc). Also, everything uses OCamlFormat instead of ``ocp-indent`` (see -``./.ocamlformat``). +``./src/lib_network_sandbox/.ocamlformat``). -- GitLab From 706ca879bc254e29fee9090cc166051c33640c3e Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Tue, 30 Apr 2019 14:23:47 -0400 Subject: [PATCH 31/49] Flextesa: improve daemons-upgrade test --- .../command_daemons_protocol_change.ml | 79 ++++++++++++------- 1 file changed, 49 insertions(+), 30 deletions(-) diff --git a/src/bin_flextesa/command_daemons_protocol_change.ml b/src/bin_flextesa/command_daemons_protocol_change.ml index a49d6ea90c93..6dc9e8e576a0 100644 --- a/src/bin_flextesa/command_daemons_protocol_change.ml +++ b/src/bin_flextesa/command_daemons_protocol_change.ml @@ -13,6 +13,14 @@ let wait_for_voting_period state ~client ~attempts period = >>= function | `String p when p = period_name -> return (`Done (nth - 1)) | other -> + Tezos_client.successful_client_cmd state ~client + ["show"; "voting"; "period"] + >>= fun res -> + Console.say state + EF.( + desc_list (wf "Voting period:") + [markdown_verbatim (String.concat ~sep:"\n" res#out)]) + >>= fun () -> return (`Not_done (sprintf "Waiting for %S period" period_name)) ) let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt @@ -20,8 +28,8 @@ let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports ?generate_kiln_config ~node_exec ~client_exec ~first_baker_exec ~first_endorser_exec ~first_accuser_exec ~second_baker_exec - ~second_endorser_exec ~second_accuser_exec - ~admin_exec ~new_protocol_path () = + ~second_endorser_exec ~second_accuser_exec ~admin_exec ~new_protocol_path + () = Helpers.System_dependencies.precheck state `Or_fail ~executables: [ node_exec; client_exec; first_baker_exec; first_endorser_exec @@ -58,21 +66,21 @@ let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports in Tezos_protocol.bootstrap_accounts protocol |> List.filter_mapi ~f:(fun idx acc -> - let node, client = pick_a_node_and_client idx in - let key = Tezos_protocol.Account.name acc in - if List.mem ~equal:String.equal no_daemons_for key then None - else - Some - ( acc - , client - , [ Tezos_daemon.baker_of_node ~exec:first_baker_exec ~client - node ~key ~name_tag:"first" - ; Tezos_daemon.baker_of_node ~exec:second_baker_exec ~client - ~name_tag:"second" node ~key - ; Tezos_daemon.endorser_of_node ~exec:first_endorser_exec - ~name_tag:"first" ~client node ~key - ; Tezos_daemon.endorser_of_node ~exec:second_endorser_exec - ~name_tag:"second" ~client node ~key ] ) ) + let node, client = pick_a_node_and_client idx in + let key = Tezos_protocol.Account.name acc in + if List.mem ~equal:String.equal no_daemons_for key then None + else + Some + ( acc + , client + , [ Tezos_daemon.baker_of_node ~exec:first_baker_exec ~client + node ~key ~name_tag:"first" + ; Tezos_daemon.baker_of_node ~exec:second_baker_exec ~client + ~name_tag:"second" node ~key + ; Tezos_daemon.endorser_of_node ~exec:first_endorser_exec + ~name_tag:"first" ~client node ~key + ; Tezos_daemon.endorser_of_node ~exec:second_endorser_exec + ~name_tag:"second" ~client node ~key ] ) ) in List_sequential.iter keys_and_daemons ~f:(fun (acc, client, daemons) -> Tezos_client.bootstrapped ~state client @@ -151,18 +159,18 @@ let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports ~path:new_protocol_path >>= fun (_, new_protocol_hash) -> ( if new_protocol_hash = hash then - Console.say state - EF.( - wf "Injected protocol `%s` in `%s`" new_protocol_hash - nod.Tezos_node.id) - else - failf "Injecting protocol %s failed (≠ %s)" new_protocol_hash - hash ) + Console.say state + EF.( + wf "Injected protocol `%s` in `%s`" new_protocol_hash + nod.Tezos_node.id) + else + failf "Injecting protocol %s failed (≠ %s)" new_protocol_hash + hash ) >>= fun () -> return (Some hash) ) >>= fun prot_opt -> ( match prot_opt with - | Some s -> return s - | None -> failf "protocol injection problem?" ) + | Some s -> return s + | None -> failf "protocol injection problem?" ) >>= fun new_protocol_hash -> Asynchronous_result.map_option generate_kiln_config ~f:(fun kiln_config -> Kiln.Configuration_directory.generate state kiln_config @@ -174,7 +182,7 @@ let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports ~bakers: (List.map protocol.Tezos_protocol.bootstrap_accounts ~f:(fun (account, _) -> - Tezos_protocol.Account.(name account, pubkey_hash account) )) + Tezos_protocol.Account.(name account, pubkey_hash account) )) ~network_string:network_id ~node_exec ~client_exec ~protocol_execs: [ ( protocol.Tezos_protocol.hash @@ -236,14 +244,25 @@ let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports (Tezos_protocol.Account.name acc) new_protocol_hash) ) >>= fun () -> - (* wait_for_voting_period state ~client:client_0 ~attempts:50 Proposal - * >>= fun _ -> *) + wait_for_voting_period state ~client:client_0 ~attempts:50 Proposal + >>= fun _ -> + Tezos_client.rpc state ~client:client_0 `Get + ~path:"/chains/main/blocks/head/metadata" + >>= fun json -> + ( try Jqo.field ~k:"protocol" json |> Jqo.get_string |> return + with e -> failf "Cannot parse metadata: %s" (Printexc.to_string e) ) + >>= fun proto_hash -> + ( if proto_hash <> new_protocol_hash then + failf "Protocol transition failed? %s Vs %s" proto_hash new_protocol_hash + else return () ) + >>= fun () -> Tezos_client.successful_client_cmd state ~client:client_0 ["show"; "voting"; "period"] >>= fun res -> Interactive_test.Pauser.generic state EF. - [ wf "Test finished, but it should keep baking." + [ wf "Test finished, protocol is now %s, things should keep baking." + new_protocol_hash ; markdown_verbatim (String.concat ~sep:"\n" res#out) ] ~force:true -- GitLab From 4f82142a706fa9a7d3ce936b4650548e6949a19d Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Tue, 30 Apr 2019 18:12:31 -0400 Subject: [PATCH 32/49] Flextesa: improve `daemons-upgrade` scenario --- .../command_daemons_protocol_change.ml | 63 +++++++++++++------ .../internal_pervasives.ml | 1 + 2 files changed, 46 insertions(+), 18 deletions(-) diff --git a/src/bin_flextesa/command_daemons_protocol_change.ml b/src/bin_flextesa/command_daemons_protocol_change.ml index 6dc9e8e576a0..d43f804e4df6 100644 --- a/src/bin_flextesa/command_daemons_protocol_change.ml +++ b/src/bin_flextesa/command_daemons_protocol_change.ml @@ -2,16 +2,40 @@ open Tezos_network_sandbox open Internal_pervasives open Console -let wait_for_voting_period state ~client ~attempts period = +let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt + +let wait_for_voting_period ?level_withing_period state ~client ~attempts period + = let period_name = Tezos_protocol.Voting_period.to_string period in - Console.sayf state - Fmt.(fun ppf () -> pf ppf "Waiting for voting period: `%s`" period_name) + let message = + sprintf "Waiting for voting period: `%s`%s" period_name + (Option.value_map level_withing_period ~default:"" + ~f:(sprintf " (and level-within-period ≤ %d)")) + in + Console.sayf state Format.(fun ppf () -> pp_print_text ppf message) >>= fun () -> Helpers.wait_for state ~attempts ~seconds:10. (fun nth -> + Asynchronous_result.map_option level_withing_period ~f:(fun lvl -> + Tezos_client.rpc state ~client `Get + ~path:"/chains/main/blocks/head/metadata" + >>= fun json -> + try + let voting_period_position = + Jqo.field ~k:"level" json + |> Jqo.field ~k:"voting_period_position" + |> Jqo.get_int + in + return (voting_period_position <= lvl) + with e -> + failf "Cannot get level.voting_period_position: %s" + (Printexc.to_string e) ) + >>= fun lvl_ok -> Tezos_client.rpc state ~client `Get ~path:"/chains/main/blocks/head/votes/current_period_kind" >>= function - | `String p when p = period_name -> return (`Done (nth - 1)) + | `String p when p = period_name && (lvl_ok = None || lvl_ok = Some true) + -> + return (`Done (nth - 1)) | other -> Tezos_client.successful_client_cmd state ~client ["show"; "voting"; "period"] @@ -20,10 +44,7 @@ let wait_for_voting_period state ~client ~attempts period = EF.( desc_list (wf "Voting period:") [markdown_verbatim (String.concat ~sep:"\n" res#out)]) - >>= fun () -> - return (`Not_done (sprintf "Waiting for %S period" period_name)) ) - -let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt + >>= fun () -> return (`Not_done message) ) let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports ?generate_kiln_config ~node_exec ~client_exec ~first_baker_exec @@ -200,6 +221,7 @@ let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports ~force:true >>= fun () -> wait_for_voting_period state ~client:client_0 ~attempts:10 Proposal + ~level_withing_period:3 >>= fun _ -> List_sequential.iter keys_and_daemons ~f:(fun (acc, client, _) -> Tezos_client.successful_client_cmd state ~client @@ -246,19 +268,24 @@ let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports >>= fun () -> wait_for_voting_period state ~client:client_0 ~attempts:50 Proposal >>= fun _ -> - Tezos_client.rpc state ~client:client_0 `Get - ~path:"/chains/main/blocks/head/metadata" - >>= fun json -> - ( try Jqo.field ~k:"protocol" json |> Jqo.get_string |> return - with e -> failf "Cannot parse metadata: %s" (Printexc.to_string e) ) - >>= fun proto_hash -> - ( if proto_hash <> new_protocol_hash then - failf "Protocol transition failed? %s Vs %s" proto_hash new_protocol_hash - else return () ) - >>= fun () -> Tezos_client.successful_client_cmd state ~client:client_0 ["show"; "voting"; "period"] >>= fun res -> + Helpers.wait_for state ~attempts:3 ~seconds:4. (fun _ -> + Console.say state EF.(wf "Checking actual protocol transition") + >>= fun () -> + Tezos_client.rpc state ~client:client_0 `Get + ~path:"/chains/main/blocks/head/metadata" + >>= fun json -> + ( try Jqo.field ~k:"protocol" json |> Jqo.get_string |> return + with e -> failf "Cannot parse metadata: %s" (Printexc.to_string e) ) + >>= fun proto_hash -> + if proto_hash <> new_protocol_hash then + return + (`Not_done + (sprintf "Protocol not done: %s Vs %s" proto_hash new_protocol_hash)) + else return (`Done ()) ) + >>= fun () -> Interactive_test.Pauser.generic state EF. [ wf "Test finished, protocol is now %s, things should keep baking." diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index 53d6a21aa17b..e80c334c9e18 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -373,4 +373,5 @@ module Jqo = struct (to_string other) let get_string = Ezjsonm.get_string + let get_int = Ezjsonm.get_int end -- GitLab From d8c365dd34d9779d448f3630dfba66b25f424740 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Wed, 1 May 2019 13:04:42 -0400 Subject: [PATCH 33/49] Flextesa,doc: fix path to `proto_test_injection` --- docs/developer/flextesa.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/developer/flextesa.rst b/docs/developer/flextesa.rst index 8a3853320201..6afe879afa90 100644 --- a/docs/developer/flextesa.rst +++ b/docs/developer/flextesa.rst @@ -125,7 +125,7 @@ And use the URI (no need to import it) for the ``--with-ledger`` option: rlwrap ./tezos-sandbox voting \ $zeronet_042/src/proto_042_Pt1GS1Zi/lib_protocol/src \ - ./src/bin_client/test/demo/ \ + ./src/bin_client/test/proto_test_injection/ \ --with-ledger "ledger://crouching-tiger-hidden-dragon/ed25519/0'/0'" \ --serialize-proposals \ --base-port=20_000 \ -- GitLab From eae880dbded77048609442f7ef384dc1204f6c6b Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Tue, 7 May 2019 13:23:12 -0400 Subject: [PATCH 34/49] Flextesa: add Stream little module --- .../internal_pervasives.ml | 30 +++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index e80c334c9e18..c4cb278d6174 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -240,6 +240,32 @@ module Asynchronous_result = struct loop times end + module Stream = struct + let fold : + 'elt Lwt_stream.t + -> f:('b -> 'elt -> ('b, 'error) t) + -> init:'b + -> ('b, 'error) t = + fun stream ~f ~init -> + let error = ref None in + Lwt.catch + (fun () -> + Lwt_stream.fold_s + (fun elt prevm -> + match prevm.result with + | Ok x -> f x elt + | Error _ -> + error := Some prevm ; + Lwt.fail Not_found ) + stream (Attached_result.ok init) ) + (fun e -> + match !error with + | Some res -> Lwt.return res + | None -> + (* `f` threw a forbidden exception! *) + Lwt.fail e ) + end + let run_application r = match Lwt_main.run (r () : (_, _) t) with | {result= Ok (); _} -> exit 0 @@ -331,8 +357,8 @@ module System = struct let read_file (_state : _ Base_state.t) path = Lwt_exception.catch (fun () -> - Lwt_io.with_file ~mode:Lwt_io.input path (fun out -> - Lwt_io.read out ) ) + Lwt_io.with_file ~mode:Lwt_io.input path (fun out -> Lwt_io.read out) + ) () (* -- GitLab From 6a123907531e4350d06ce8e6d6ea1e9b305b50b2 Mon Sep 17 00:00:00 2001 From: Elliot Cameron Date: Fri, 8 Feb 2019 17:29:00 -0500 Subject: [PATCH 35/49] Flextesa: Add ledger baking tests --- src/bin_flextesa/command_ledger_baking.ml | 401 ++++++++++++++++++++++ src/bin_flextesa/main.ml | 3 +- src/lib_network_sandbox/tezos_client.ml | 118 +++++++ src/lib_network_sandbox/tezos_client.mli | 72 ++++ 4 files changed, 593 insertions(+), 1 deletion(-) create mode 100644 src/bin_flextesa/command_ledger_baking.ml diff --git a/src/bin_flextesa/command_ledger_baking.ml b/src/bin_flextesa/command_ledger_baking.ml new file mode 100644 index 000000000000..a1098ef7475e --- /dev/null +++ b/src/bin_flextesa/command_ledger_baking.ml @@ -0,0 +1,401 @@ +open Tezos_network_sandbox +open Internal_pervasives + +let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt + +let ledger_prompt_notice state ~ef ?(button = `Checkmark) () = + let button_str = + match button with + | `Checkmark -> "✔" + | `X -> "❌" + | `Both -> "❌ and ✔ at the same time" + in + Console.say state + EF.( + desc (shout "Ledger-prompt") + (list [ef; wf "Press %s on the ledger." button_str])) + +let assert_failure state msg f () = + Console.say state EF.(wf "Asserting %s" msg) + >>= fun () -> + Asynchronous_result.bind_on_error + (f () >>= fun _ -> return `Worked) + ~f:(fun _ -> return `Didn'tWork) + >>= function `Worked -> failf "%s" msg | `Didn'tWork -> return () + +let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt +let assert_ a = if a then return () else failf "Assertion failed" + +let assert_eq to_string ~expected ~actual = + if expected = actual then return () + else + failf "Assertion failed: expected %s but got %s" (to_string expected) + (to_string actual) + +let rec ask state ef = + Console.say state EF.(list [ef; wf " (y/n)?"]) + >>= fun () -> + Lwt_exception.catch Lwt_io.read_char Lwt_io.stdin + >>= function + | 'y' | 'Y' -> return true | 'n' | 'N' -> return false | _ -> ask state ef + +let ask_assert state ef () = ask state ef >>= fun b -> assert_ b + +let with_ledger_prompt state message expectation ~f = + ledger_prompt_notice state () + ~button:(match expectation with `Succeeds -> `Checkmark | `Fails -> `X) + ~ef: + EF.( + list + [ message; wf "\n\n" + ; wf + ( match expectation with + | `Succeeds -> ">> ACCEPT THIS <<" + | `Fails -> ">> REJECT THIS <<" ) ]) + >>= fun () -> + match expectation with + | `Succeeds -> + f () >>= fun _ -> Console.say state EF.(wf "> Got response: ACCEPTED") + | `Fails -> + assert_failure state "expected failure" f () + >>= fun () -> Console.say state EF.(wf "> Got response: REJECTED") + +let with_ledger_test_reject_and_succeed state ef f = + with_ledger_prompt state ef `Fails ~f + >>= fun () -> with_ledger_prompt state ef `Succeeds ~f + +let assert_hwms state ~client ~uri ~main ~test = + Console.say state + EF.(wf "Asserting main HWM = %d and test HWM = %d" main test) + >>= fun () -> + Tezos_client.Ledger.get_hwm state ~client ~uri + >>= fun {main= main_actual; test= test_actual; _} -> + assert_eq string_of_int ~actual:main_actual ~expected:main + >>= fun () -> assert_eq string_of_int ~actual:test_actual ~expected:test + +let get_chain_id state ~client = + Tezos_client.rpc state ~client `Get ~path:"/chains/main/chain_id" + >>= (function + | `String x -> return x + | _ -> failf "Failed to parse chain_id JSON from node") + >>= fun chain_id_string -> + return (Tezos_crypto.Chain_id.of_b58check_exn chain_id_string) + +let get_head_block_hash state ~client () = + Tezos_client.rpc state ~client `Get ~path:"/chains/main/blocks/head/hash" + >>= function + | `String x -> return x + | _ -> failf "Failed to parse block hash JSON from node" + +let forge_endorsement state ~client ~chain_id ~level () = + get_head_block_hash state ~client () + >>= fun branch -> + let json = + `O + [ ("branch", `String branch) + ; ( "contents" + , `A + [ `O + [ ("kind", `String "endorsement") + ; ("level", `Float (float_of_int level)) ] ] ) ] + in + Tezos_client.rpc state ~client + ~path:"/chains/main/blocks/head/helpers/forge/operations" + (`Post (Ezjsonm.to_string json)) + >>= function + | `String operation_bytes -> + let endorsement_magic_byte = "02" in + return + ( endorsement_magic_byte + ^ (chain_id |> Tezos_crypto.Chain_id.to_hex |> Hex.show) + ^ operation_bytes ) + | _ -> failf "Failed to forge operation or parse result" + +let forge_delegation state ~client ~src ~dest ?(fee = 0.00126) () = + get_head_block_hash state ~client () + >>= fun branch -> + let json = + `O + [ ("branch", `String branch) + ; ( "contents" + , `A + [ `O + [ ("kind", `String "delegation") + ; ("source", `String src) + ; ( "fee" + , `String (string_of_int (int_of_float (fee *. 1000000.))) ) + ; ("counter", `String (string_of_int 30713)) + ; ("gas_limit", `String (string_of_int 10100)) + ; ("delegate", `String dest) + ; ("storage_limit", `String (string_of_int 277)) ] ] ) ] + in + Tezos_client.rpc state ~client + ~path:"/chains/main/blocks/head/helpers/forge/operations" + (`Post (Ezjsonm.to_string json)) + >>= function + | `String operation_bytes -> + let magic_byte = "03" in + return (magic_byte ^ operation_bytes) + | _ -> failf "Failed to forge operation or parse result" + +let sign state ~client ~bytes () = + Tezos_client.successful_client_cmd state + ~client:client.Tezos_client.Keyed.client + ["sign"; "bytes"; "0x" ^ bytes; "for"; client.Tezos_client.Keyed.key_name] + >>= fun _ -> return () + +let originate_account_from state ~client ~account = + let orig_account_name = + Tezos_protocol.Account.name account ^ "-originated-account" + in + Tezos_client.successful_client_cmd state ~client + [ "originate"; "account"; orig_account_name; "for" + ; Tezos_protocol.Account.name account + ; "transferring"; string_of_int 1000; "from" + ; Tezos_protocol.Account.name account + ; "--burn-cap"; string_of_float 0.257 ] + >>= fun _ -> return orig_account_name + +let setup_baking_ledger state uri ~client ~protocol = + Console.say state EF.(wf "Setting up the ledger device %S" uri) + >>= fun () -> + let key_name = "ledgered" in + let baker = Tezos_client.Keyed.make client ~key_name ~secret_key:uri in + let assert_baking_key x () = + let to_string = function Some x -> x | None -> "" in + Console.say state + EF.(wf "Asserting that the authorized key is %s" (to_string x)) + >>= fun () -> + Tezos_client.Ledger.get_authorized_key state ~client ~uri + >>= fun auth_key -> assert_eq to_string ~expected:x ~actual:auth_key + in + Tezos_client.Ledger.deauthorize_baking state ~client ~uri + (* TODO: The following assertion doesn't confirm anything if the ledger was already not authorized to bake. *) + >>= assert_baking_key None + >>= fun () -> + Tezos_client.Ledger.show_ledger state ~client ~uri + >>= fun account -> + with_ledger_test_reject_and_succeed state + EF.( + wf + "Importing %S in client `%s`. The ledger should be prompting for \ + acknowledgment to provide the public key of %s" + uri client.Tezos_client.id + (Tezos_protocol.Account.pubkey_hash account)) + (fun () -> Tezos_client.Keyed.initialize state baker >>= fun _ -> return ()) + >>= assert_failure state "baking before setup should fail" (fun () -> + Tezos_client.Keyed.bake state baker "Baked by ledger" ) + >>= assert_failure state "endorsing before setup should fail" (fun () -> + Tezos_client.Keyed.endorse state baker "Endorsed by ledger" ) + >>= fun () -> + let test_invalid_delegations () = + let ledger_pkh = Tezos_protocol.Account.pubkey_hash account in + let other_pkh = + Tezos_protocol.Account.pubkey_hash + (fst (List.last_exn protocol.Tezos_protocol.bootstrap_accounts)) + in + let cases = + [ (ledger_pkh, other_pkh, "ledger to another account") + ; (other_pkh, ledger_pkh, "another account to ledger") + ; (other_pkh, other_pkh, "another account to another account") ] + in + List_sequential.iter cases ~f:(fun (src, dest, msg) -> + forge_delegation state ~client ~src ~dest () + >>= fun forged_delegation_bytes -> + assert_failure state + (sprintf "signing a delegation from %s (%s to %s) should fail" msg + src dest) + (sign state ~client:baker ~bytes:forged_delegation_bytes) + () ) + in + test_invalid_delegations () + >>= fun () -> + with_ledger_test_reject_and_succeed state + EF.( + wf + "Setting up %S for baking.\n\ + Address: %S\n\ + Chain: mainnet\n\ + Main HWM: 0\n\ + Test HWM: 0" + uri + (Tezos_protocol.Account.pubkey_hash account)) + (fun () -> + Tezos_client.successful_client_cmd state ~client + [ "setup"; "ledger"; "to"; "bake"; "for"; key_name; "--main-hwm"; "0" + ; "--test-hwm"; "0" ] ) + >>= assert_failure state + "signing a 'Withdraw delegate' operation in Baking App should fail" + (fun () -> + Tezos_client.successful_client_cmd state ~client + [ "--wait"; "none"; "withdraw"; "delegate"; "from" + ; Tezos_protocol.Account.pubkey_hash account ] ) + >>= assert_baking_key (Some uri) + >>= test_invalid_delegations + >>= fun () -> return (baker, account) + +let run state ~node_exec ~client_exec ~admin_exec ~size ~base_port ~uri () = + Helpers.clear_root state + >>= fun () -> + Interactive_test.Pauser.generic state + EF.[af "Ready to start"; af "Root path deleted."] + >>= fun () -> + let ledger_client = Tezos_client.no_node_client ~exec:client_exec in + Tezos_client.Ledger.show_ledger state ~client:ledger_client ~uri + >>= fun ledger_account -> + let protocol = + let open Tezos_protocol in + let d = default () in + { d with + time_between_blocks= [1; 2] + ; bootstrap_accounts= + (ledger_account, 1_000_000_000_000) + :: List.map ~f:(fun (a, _) -> (a, 1_000)) d.bootstrap_accounts } + in + Test_scenario.network_with_protocol ~protocol ~size ~base_port state + ~node_exec ~client_exec + >>= fun (nodes, protocol) -> + let make_admin = Tezos_admin_client.of_client ~exec:admin_exec in + Interactive_test.Pauser.add_commands state + Interactive_test.Commands.( + all_defaults state ~nodes + @ [ secret_keys state ~protocol + ; Log_recorder.Operations.show_all state + ; arbitrary_command_on_clients state ~command_names:["all-clients"] + ~make_admin + ~clients: + (List.map nodes ~f:(Tezos_client.of_node ~exec:client_exec)) ]) ; + Interactive_test.Pauser.generic state EF.[af "About to really start playing"] + >>= fun () -> + let client n = + Tezos_client.of_node ~exec:client_exec (List.nth_exn nodes n) + in + let assert_hwms_ ~main ~test () = + assert_hwms state ~client:(client 0) ~uri ~main ~test + in + let set_hwm_ level () = + with_ledger_prompt state + EF.(wf "Setting HWM to %d" level) + `Succeeds + ~f:(fun () -> + Tezos_client.Ledger.set_hwm state ~client:(client 0) ~uri ~level ) + in + get_chain_id state ~client:(client 0) + >>= fun chain_id -> + setup_baking_ledger state uri ~client:(client 0) ~protocol + >>= fun (baker, ledger_account) -> + Interactive_test.Pauser.add_commands state + Interactive_test.Commands. + [ arbitrary_command_on_clients state ~command_names:["baker"] ~make_admin + ~clients:[baker.Tezos_client.Keyed.client] ] ; + let bake () = Tezos_client.Keyed.bake state baker "Baked by ledger" in + let endorse () = + Tezos_client.Keyed.endorse state baker "Endorsed by ledger" + in + let ask_hwm ~main ~test () = + assert_hwms_ ~main ~test () + >>= ask_assert state + EF.(wf "Is 'Chain' = %S and 'Last Block Level' = %d" "mainnet" main) + in + assert_failure state + "originating an account from the Tezos Baking app should fail" + (fun () -> + originate_account_from state ~client:(client 0) ~account:ledger_account + >>= fun _ -> return () ) + () + >>= fun () -> + let fee = 0.00126 in + let ledger_pkh = Tezos_protocol.Account.pubkey_hash ledger_account in + forge_delegation state ~client:(client 0) () ~src:ledger_pkh ~dest:ledger_pkh + ~fee + >>= fun forged_delegation_bytes -> + with_ledger_test_reject_and_succeed state + EF.(wf "Self delegating address %s with fee %f" ledger_pkh fee) + (sign state ~client:baker ~bytes:forged_delegation_bytes) + >>= bake >>= ask_hwm ~main:2 ~test:0 + >>= fun () -> + (let level = 1 in + with_ledger_test_reject_and_succeed state + EF.(wf "Setting HWM to %d" level) + (fun () -> + Tezos_client.Ledger.set_hwm state ~client:(client 0) ~uri ~level )) + >>= assert_hwms_ ~main:1 ~test:1 + >>= bake + >>= assert_hwms_ ~main:3 ~test:1 + >>= set_hwm_ 4 + >>= assert_hwms_ ~main:4 ~test:4 + >>= assert_failure state "endorsing a level beneath HWM should fail" endorse + >>= assert_failure state "baking a level beneath HWM should fail" bake + >>= set_hwm_ 3 >>= bake + >>= assert_hwms_ ~main:4 ~test:3 + >>= endorse + >>= assert_failure state "endorsing same block twice should not work" endorse + >>= assert_hwms_ ~main:4 ~test:3 + >>= bake + >>= assert_hwms_ ~main:5 ~test:3 + >>= forge_endorsement state ~client:baker.client ~chain_id ~level:1 + >>= fun endorsement_at_low_level_bytes -> + assert_failure state "endorsing-after-baking a level beneath HWM should fail" + (sign state ~client:baker ~bytes:endorsement_at_low_level_bytes) + () + >>= assert_hwms_ ~main:5 ~test:3 + (* HWM has not changed *) + >>= endorse + (* HWM still has not changed *) + >>= assert_hwms_ ~main:5 ~test:3 + (* Forge an endorsement on a different chain *) + >>= fun () -> + let other_chain_id = "NetXSzLHKwSumh7" in + Console.say state + EF.( + wf "Signing a forged endorsement on a different chain: %s" other_chain_id) + >>= forge_endorsement state ~client:baker.client + ~chain_id:(Tezos_crypto.Chain_id.of_b58check_exn other_chain_id) + ~level:4 + >>= fun endorsement_on_different_chain_bytes -> + sign state ~client:baker ~bytes:endorsement_on_different_chain_bytes () + (* Only the test HWM has changed *) + >>= assert_hwms_ ~main:5 ~test:4 + >>= fun () -> + Loop.n_times 5 (fun _ -> bake ()) + >>= ask_hwm ~main:10 ~test:4 + >>= fun () -> + Tezos_client.Ledger.deauthorize_baking state ~client:(client 0) ~uri + >>= assert_failure state "baking after deauthorization should fail" bake + >>= assert_failure state "endorsing after deauthorization should fail" + endorse + +let cmd ~pp_error () = + let open Cmdliner in + let open Term in + Test_command_line.Run_command.make ~pp_error + ( pure + (fun uri + node_exec + client_exec + admin_exec + size + (`Base_port base_port) + state + -> + ( state + , Interactive_test.Pauser.run_test ~pp_error state + (run state ~node_exec ~size ~admin_exec ~base_port ~client_exec + ~uri) ) ) + $ Arg.( + required + (pos 0 (some string) None + (info [] ~docv:"LEDGER-URI" ~doc:"ledger:// URI"))) + $ Tezos_executable.cli_term `Node "tezos" + $ Tezos_executable.cli_term `Client "tezos" + $ Tezos_executable.cli_term `Admin "tezos" + $ Arg.(value (opt int 5 (info ["size"; "S"] ~doc:"Size of the Network"))) + $ Arg.( + pure (fun p -> `Base_port p) + $ value + (opt int 46_000 + (info ["base-port"; "P"] ~doc:"Base port number to build upon"))) + $ Test_command_line.cli_state ~name:"ledger-baking" () ) + (let doc = "Sandbox networks which record double-bakings" in + let man : Manpage.block list = [`S "LEDGER-BAKING TESTS"] in + info ~man ~doc "ledger-baking") diff --git a/src/bin_flextesa/main.ml b/src/bin_flextesa/main.ml index 56a09925b1f6..c08aa10fc011 100644 --- a/src/bin_flextesa/main.ml +++ b/src/bin_flextesa/main.ml @@ -81,4 +81,5 @@ let () = ; Command_daemons_protocol_change.cmd () ~pp_error ; Command_voting.cmd () ~pp_error ; Command_accusations.cmd () ~pp_error - ; Command_prevalidation.cmd () ~pp_error ] ) + ; Command_prevalidation.cmd () ~pp_error + ; Command_ledger_baking.cmd () ~pp_error ] ) diff --git a/src/lib_network_sandbox/tezos_client.ml b/src/lib_network_sandbox/tezos_client.ml index dfba196cb642..a1bef1875e3e 100644 --- a/src/lib_network_sandbox/tezos_client.ml +++ b/src/lib_network_sandbox/tezos_client.ml @@ -3,6 +3,8 @@ open Internal_pervasives type t = {id: string; port: int; exec: Tezos_executable.t} type client = t +let no_node_client ~exec = {id= "C-null"; port= 0; exec} + let of_node ~exec n = let id = sprintf "C-%s" n.Tezos_node.id in let port = n.Tezos_node.rpc_port in @@ -200,6 +202,122 @@ let get_block_header state ~client block = in rpc state ~client `Get ~path +let list_known_addresses state ~client = + successful_client_cmd state ~client ["list"; "known"; "addresses"] + >>= fun res -> + let re = + Re.( + compile + (seq + [ group (rep1 (alt [alnum; char '_'])) + ; str ": " + ; group (rep1 alnum) + ; Re.alt [space; eol; eos] ])) + in + return + (List.filter_map res#out + ~f: + Re.( + fun line -> + match exec_opt re line with + | None -> None + | Some matches -> Some (Group.get matches 1, Group.get matches 2))) + +module Ledger = struct + type hwm = {main: int; test: int; chain: Tezos_crypto.Chain_id.t option} + + let set_hwm state ~client ~uri ~level = + successful_client_cmd state ~client + [ "set"; "ledger"; "high"; "watermark"; "for"; uri; "to" + ; string_of_int level ] + >>= fun _ -> return () + + let get_hwm state ~client ~uri = + successful_client_cmd state ~client + [ "get"; "ledger"; "high"; "watermark"; "for"; uri + ; "--no-legacy-instructions" ] + (* TODO: Use --for-script when available *) + >>= fun res -> + (* e.g. The high water mark values for married-bison-ill-burmese/P-256 are + 0 for the main-chain (NetXH12Aer3be93) and + 0 for the test-chain. *) + let re = + Re.( + let num = rep1 digit in + compile + (seq + [ group num + ; str " for the main-chain (" + ; group (rep1 alnum) + ; str ") and "; group num; str " for the test-chain." ])) + in + let matches = Re.exec re (String.concat ~sep:" " res#out) in + try + return + { main= int_of_string (Re.Group.get matches 1) + ; chain= + (let v = Re.Group.get matches 2 in + if v = "'Unspecified'" then None + else Some (Tezos_crypto.Chain_id.of_b58check_exn v)) + ; test= int_of_string (Re.Group.get matches 3) } + with e -> + failf + "Couldn't understand result of 'get high watermark for %S': error %S: \ + from %S" + uri (Exn.to_string e) + (String.concat ~sep:"\n" res#out) + + let show_ledger state ~client ~uri = + successful_client_cmd state ~client ["show"; "ledger"; uri] + (* TODO: Use --for-script when available *) + >>= fun res -> + list_known_addresses state ~client + >>= fun known_addresses -> + (* e.g. Tezos address at this path/curve: tz3hY1a9NHmu94sc4mVhZU5M4DiUL3ZKFLf2 + Corresponding full public key: p2pk67Wym3JraxS3MAb3GQBq2cj7Tnbptp3uiEfnCYXf9HiCx6KsfN6 *) + let pk = Re.(rep1 alnum) in + let addr_re = Re.(compile (seq [str "path/curve: "; group pk])) in + let pubkey_re = Re.(compile (seq [str "full public key: "; group pk])) in + let out = String.concat ~sep:" " res#out in + try + let pubkey = Re.(Group.get (exec pubkey_re out) 1) in + let pubkey_hash = Re.(Group.get (exec addr_re out) 1) in + let name = + match + List.find known_addresses ~f:(fun (_, pkh) -> pkh = pubkey_hash) + with + | None -> "" + | Some (alias, _) -> alias + in + return + (Tezos_protocol.Account.key_pair name ~pubkey ~pubkey_hash + ~private_key:uri) + with e -> + failf "Couldn't understand result of 'show ledger %S': error %S: from %S" + uri (Exn.to_string e) + (String.concat ~sep:"\n" res#out) + + let deauthorize_baking state ~client ~uri = + successful_client_cmd state ~client + ["deauthorize"; "ledger"; "baking"; "for"; uri] + >>= fun _ -> return () + + let get_authorized_key state ~client ~uri = + successful_client_cmd state ~client + ["get"; "ledger"; "authorized"; "path"; "for"; uri] + >>= fun res -> + let re_uri = + Re.(compile (seq [str "Authorized baking URI: "; group (rep1 any); eol])) + in + let re_none = Re.(compile (str "No baking key authorized")) in + let out = String.concat ~sep:" " res#out in + return + Re.( + match exec_opt re_none out with + | Some _ -> None + | None -> Some (Group.get (exec re_uri out) 1)) +end + module Keyed = struct type t = {client: client; key_name: string; secret_key: string} diff --git a/src/lib_network_sandbox/tezos_client.mli b/src/lib_network_sandbox/tezos_client.mli index bec7f41d229c..175998f8323a 100644 --- a/src/lib_network_sandbox/tezos_client.mli +++ b/src/lib_network_sandbox/tezos_client.mli @@ -4,6 +4,8 @@ open Internal_pervasives type t = {id: string; port: int; exec: Tezos_executable.t} type client = t +val no_node_client : exec:Tezos_executable.t -> t + val of_node : exec:Tezos_executable.t -> Tezos_node.t -> t (** Create a client which is meant to communicate with a given node. *) @@ -135,6 +137,76 @@ val get_block_header : Asynchronous_result.t (** Call the RPC ["/chains/main/blocks//header"]. *) +val list_known_addresses : + < application_name: string + ; console: Console.t + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> client:t + -> ( (string * string) list + , [> Command_error.t | `Lwt_exn of exn] ) + Asynchronous_result.t + +module Ledger : sig + type hwm = {main: int; test: int; chain: Tezos_crypto.Chain_id.t option} + + val get_hwm : + < application_name: string + ; console: Console.t + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> client:t + -> uri:string + -> (hwm, [> Command_error.t | `Lwt_exn of exn]) Asynchronous_result.t + + val set_hwm : + < application_name: string + ; console: Console.t + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> client:t + -> uri:string + -> level:int + -> (unit, [> Command_error.t | `Lwt_exn of exn]) Asynchronous_result.t + + val show_ledger : + < application_name: string + ; console: Console.t + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> client:t + -> uri:string + -> ( Tezos_protocol.Account.t + , [> Command_error.t | `Lwt_exn of exn] ) + Asynchronous_result.t + + val deauthorize_baking : + < application_name: string + ; console: Console.t + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> client:t + -> uri:string + -> (unit, [> Command_error.t | `Lwt_exn of exn]) Asynchronous_result.t + + val get_authorized_key : + < application_name: string + ; console: Console.t + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> client:t + -> uri:string + -> ( string option + , [> Command_error.t | `Lwt_exn of exn] ) + Asynchronous_result.t +end + module Keyed : sig type t = {client: client; key_name: string; secret_key: string} -- GitLab From aaf1b4ccdb345d02d1a79902086d2ea16fe5cae2 Mon Sep 17 00:00:00 2001 From: Elliot Cameron Date: Mon, 18 Mar 2019 00:33:56 -0400 Subject: [PATCH 36/49] Flextesa: Add initial tests for Ledger Wallet app --- src/bin_flextesa/command_ledger_wallet.ml | 204 ++++++++++++++++++++++ src/bin_flextesa/main.ml | 3 +- 2 files changed, 206 insertions(+), 1 deletion(-) create mode 100644 src/bin_flextesa/command_ledger_wallet.ml diff --git a/src/bin_flextesa/command_ledger_wallet.ml b/src/bin_flextesa/command_ledger_wallet.ml new file mode 100644 index 000000000000..2ee18d729786 --- /dev/null +++ b/src/bin_flextesa/command_ledger_wallet.ml @@ -0,0 +1,204 @@ +open Tezos_network_sandbox +open Internal_pervasives + +let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt + +let ledger_prompt_notice state ~ef ?(button = `Checkmark) () = + let button_str = + match button with + | `Checkmark -> "✔" + | `X -> "❌" + | `Both -> "❌ and ✔ at the same time" + in + Console.say state + EF.( + desc (shout "Ledger-prompt") + (list [ef; wf "Press %s on the ledger." button_str])) + +let assert_failure state msg f () = + Console.say state EF.(wf "Asserting %s" msg) + >>= fun () -> + Asynchronous_result.bind_on_error + (f () >>= fun _ -> return `Worked) + ~f:(fun _ -> return `Didn'tWork) + >>= function `Worked -> failf "%s" msg | `Didn'tWork -> return () + +let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt +let assert_ a = if a then return () else failf "Assertion failed" + +let assert_eq to_string ~expected ~actual = + if expected = actual then return () + else + failf "Assertion failed: expected %s but got %s" (to_string expected) + (to_string actual) + +let rec ask state ef = + Console.say state EF.(list [ef; wf " (y/n)?"]) + >>= fun () -> + Lwt_exception.catch Lwt_io.read_char Lwt_io.stdin + >>= function + | 'y' | 'Y' -> return true | 'n' | 'N' -> return false | _ -> ask state ef + +let ask_assert state ef () = ask state ef >>= fun b -> assert_ b + +let with_ledger_prompt state message expectation ~f = + ledger_prompt_notice state () + ~button:(match expectation with `Succeeds -> `Checkmark | `Fails -> `X) + ~ef: + EF.( + list + [ message; wf "\n\n" + ; wf + ( match expectation with + | `Succeeds -> ">> ACCEPT THIS <<" + | `Fails -> ">> REJECT THIS <<" ) ]) + >>= fun () -> + match expectation with + | `Succeeds -> + f () >>= fun _ -> Console.say state EF.(wf "> Got response: ACCEPTED") + | `Fails -> + assert_failure state "expected failure" f () + >>= fun () -> Console.say state EF.(wf "> Got response: REJECTED") + +let with_ledger_test_reject_and_succeed state ef f = + with_ledger_prompt state ef `Fails ~f + >>= fun () -> with_ledger_prompt state ef `Succeeds ~f + +let get_chain_id state ~client = + Tezos_client.rpc state ~client `Get ~path:"/chains/main/chain_id" + >>= (function + | `String x -> return x + | _ -> failf "Failed to parse chain_id JSON from node") + >>= fun chain_id_string -> + return (Tezos_crypto.Chain_id.of_b58check_exn chain_id_string) + +let get_head_block_hash state ~client () = + Tezos_client.rpc state ~client `Get ~path:"/chains/main/blocks/head/hash" + >>= function + | `String x -> return x + | _ -> failf "Failed to parse block hash JSON from node" + +let forge_batch_transactions state ~client ~src ~dest ~n ?(fee = 0.00126) () = + get_head_block_hash state ~client () + >>= fun branch -> + let json = + `O + [ ("branch", `String branch) + ; ( "contents" + , `A + (List.map (List.range 0 n) ~f:(fun i -> + `O + [ ("kind", `String "transaction") + ; ("source", `String src) + ; ( "destination" + , `String "tz2KZPgf2rshxNUBXFcTaCemik1LH1v9qz3F" ) + ; ("amount", `String (string_of_int 100)) + ; ( "fee" + , `String (string_of_int (int_of_float (fee *. 1000000.))) + ) + ; ("counter", `String (string_of_int i)) + ; ("gas_limit", `String (string_of_int 127)) + ; ("storage_limit", `String (string_of_int 277)) ] )) ) ] + in + Tezos_client.rpc state ~client + ~path:"/chains/main/blocks/head/helpers/forge/operations" + (`Post (Ezjsonm.to_string json)) + >>= function + | `String operation_bytes -> + let magic_byte = "03" in + return (magic_byte ^ operation_bytes) + | _ -> failf "Failed to forge operation or parse result" + +let sign state ~client ~bytes () = + Tezos_client.successful_client_cmd state + ~client:client.Tezos_client.Keyed.client + ["sign"; "bytes"; "0x" ^ bytes; "for"; client.Tezos_client.Keyed.key_name] + >>= fun _ -> return () + +let run state ~node_exec ~client_exec ~admin_exec ~size ~base_port ~uri () = + Helpers.clear_root state + >>= fun () -> + Interactive_test.Pauser.generic state + EF.[af "Ready to start"; af "Root path deleted."] + >>= fun () -> + let ledger_client = Tezos_client.no_node_client ~exec:client_exec in + Tezos_client.Ledger.show_ledger state ~client:ledger_client ~uri + >>= fun ledger_account -> + Test_scenario.network_with_protocol + ~protocol:(Tezos_protocol.default ()) + ~size ~base_port state ~node_exec ~client_exec + >>= fun (nodes, protocol) -> + let make_admin = Tezos_admin_client.of_client ~exec:admin_exec in + Interactive_test.Pauser.add_commands state + Interactive_test.Commands.( + all_defaults state ~nodes + @ [ secret_keys state ~protocol + ; Log_recorder.Operations.show_all state + ; arbitrary_command_on_clients state ~command_names:["all-clients"] + ~make_admin + ~clients: + (List.map nodes ~f:(Tezos_client.of_node ~exec:client_exec)) ]) ; + Interactive_test.Pauser.generic state EF.[af "About to really start playing"] + >>= fun () -> + let client n = + Tezos_client.of_node ~exec:client_exec (List.nth_exn nodes n) + in + let signer = + Tezos_client.Keyed.make (client 0) ~key_name:"ledgered" ~secret_key:uri + in + Tezos_client.Ledger.show_ledger state ~client:(client 0) ~uri + >>= fun ledger_account -> + with_ledger_test_reject_and_succeed state + EF.( + wf + "Importing %S in client `%s`. The ledger should be prompting for \ + acknowledgment to provide the public key of %s" + uri (client 0).Tezos_client.id + (Tezos_protocol.Account.pubkey_hash ledger_account)) + (fun () -> + Tezos_client.Keyed.initialize state signer >>= fun _ -> return () ) + >>= fun _ -> + forge_batch_transactions state ~client:(client 0) + ~src:(Tezos_protocol.Account.pubkey_hash ledger_account) + ~dest:"tz2KZPgf2rshxNUBXFcTaCemik1LH1v9qz3F" ~n:50 () + >>= fun batch_transaction_bytes -> + with_ledger_test_reject_and_succeed state + EF.( + wf + "Signing batch of transaction: Unrecognized Operation - Sign Unverified") + (sign state ~client:signer ~bytes:batch_transaction_bytes) + +let cmd ~pp_error () = + let open Cmdliner in + let open Term in + Test_command_line.Run_command.make ~pp_error + ( pure + (fun uri + node_exec + client_exec + admin_exec + size + (`Base_port base_port) + state + -> + ( state + , Interactive_test.Pauser.run_test ~pp_error state + (run state ~node_exec ~size ~admin_exec ~base_port ~client_exec + ~uri) ) ) + $ Arg.( + required + (pos 0 (some string) None + (info [] ~docv:"LEDGER-URI" ~doc:"ledger:// URI"))) + $ Tezos_executable.cli_term `Node "tezos" + $ Tezos_executable.cli_term `Client "tezos" + $ Tezos_executable.cli_term `Admin "tezos" + $ Arg.(value (opt int 5 (info ["size"; "S"] ~doc:"Size of the Network"))) + $ Arg.( + pure (fun p -> `Base_port p) + $ value + (opt int 46_000 + (info ["base-port"; "P"] ~doc:"Base port number to build upon"))) + $ Test_command_line.cli_state ~name:"ledger-wallet" () ) + (let doc = "Sandbox networks which record double-bakings" in + let man : Manpage.block list = [`S "LEDGER-WALLET TESTS"] in + info ~man ~doc "ledger-wallet") diff --git a/src/bin_flextesa/main.ml b/src/bin_flextesa/main.ml index c08aa10fc011..cdacab276ea2 100644 --- a/src/bin_flextesa/main.ml +++ b/src/bin_flextesa/main.ml @@ -82,4 +82,5 @@ let () = ; Command_voting.cmd () ~pp_error ; Command_accusations.cmd () ~pp_error ; Command_prevalidation.cmd () ~pp_error - ; Command_ledger_baking.cmd () ~pp_error ] ) + ; Command_ledger_baking.cmd () ~pp_error + ; Command_ledger_wallet.cmd () ~pp_error ] ) -- GitLab From 7d3823a1a0617b83de59e10c487b3b9484d4d091 Mon Sep 17 00:00:00 2001 From: Elliot Cameron Date: Mon, 25 Mar 2019 19:21:34 -0400 Subject: [PATCH 37/49] Flextesa: test deterministic nonce generation --- src/bin_flextesa/command_ledger_baking.ml | 15 +++++++++++++++ src/lib_network_sandbox/tezos_client.ml | 5 +++++ src/lib_network_sandbox/tezos_client.mli | 11 +++++++++++ 3 files changed, 31 insertions(+) diff --git a/src/bin_flextesa/command_ledger_baking.ml b/src/bin_flextesa/command_ledger_baking.ml index a1098ef7475e..5eac2d00ec83 100644 --- a/src/bin_flextesa/command_ledger_baking.ml +++ b/src/bin_flextesa/command_ledger_baking.ml @@ -297,6 +297,21 @@ let run state ~node_exec ~client_exec ~admin_exec ~size ~base_port ~uri () = >>= ask_assert state EF.(wf "Is 'Chain' = %S and 'Last Block Level' = %d" "mainnet" main) in + (* Test determinism of nonces *) + Tezos_client.Keyed.generate_nonce state baker "this" + >>= fun thisNonce1 -> + Tezos_client.Keyed.generate_nonce state baker "that" + >>= fun thatNonce1 -> + Tezos_client.Keyed.generate_nonce state baker "this" + >>= fun thisNonce2 -> + Tezos_client.Keyed.generate_nonce state baker "that" + >>= fun thatNonce2 -> + assert_eq (fun x -> x) ~expected:thisNonce1 ~actual:thisNonce2 + >>= fun () -> + assert_eq (fun x -> x) ~expected:thatNonce1 ~actual:thatNonce2 + >>= fun () -> + assert_ (thisNonce1 <> thatNonce1) + >>= fun () -> assert_failure state "originating an account from the Tezos Baking app should fail" (fun () -> diff --git a/src/lib_network_sandbox/tezos_client.ml b/src/lib_network_sandbox/tezos_client.ml index a1bef1875e3e..493482c8ab1e 100644 --- a/src/lib_network_sandbox/tezos_client.ml +++ b/src/lib_network_sandbox/tezos_client.ml @@ -355,6 +355,11 @@ module Keyed = struct (af "Successful bake (%s: %s):" baker.client.id msg) (ocaml_string_list res#out)) + let generate_nonce state {client; key_name; _} data = + successful_client_cmd state ~client + ["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" (`Post (Ezjsonm.to_string json)) diff --git a/src/lib_network_sandbox/tezos_client.mli b/src/lib_network_sandbox/tezos_client.mli index 175998f8323a..cc741da648e2 100644 --- a/src/lib_network_sandbox/tezos_client.mli +++ b/src/lib_network_sandbox/tezos_client.mli @@ -246,6 +246,17 @@ module Keyed : sig -> string -> (unit, [> Command_error.t | `Lwt_exn of exn]) Asynchronous_result.t + val generate_nonce : + < application_name: string + ; console: Console.t + ; operations_log: Log_recorder.Operations.t + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> t + -> string + -> (string, [> Command_error.t | `Lwt_exn of exn]) Asynchronous_result.t + val forge_and_inject : < application_name: string ; console: Console.t -- GitLab From 228eb139b6848550a7641af991fe41ef5205f597 Mon Sep 17 00:00:00 2001 From: Elliot Cameron Date: Thu, 28 Mar 2019 13:16:42 -0400 Subject: [PATCH 38/49] Flextesa: Fix parsing of show ledger --- src/lib_network_sandbox/tezos_client.ml | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/lib_network_sandbox/tezos_client.ml b/src/lib_network_sandbox/tezos_client.ml index 493482c8ab1e..0f3d30753ccc 100644 --- a/src/lib_network_sandbox/tezos_client.ml +++ b/src/lib_network_sandbox/tezos_client.ml @@ -273,11 +273,9 @@ module Ledger = struct >>= fun res -> list_known_addresses state ~client >>= fun known_addresses -> - (* e.g. Tezos address at this path/curve: tz3hY1a9NHmu94sc4mVhZU5M4DiUL3ZKFLf2 - Corresponding full public key: p2pk67Wym3JraxS3MAb3GQBq2cj7Tnbptp3uiEfnCYXf9HiCx6KsfN6 *) let pk = Re.(rep1 alnum) in - let addr_re = Re.(compile (seq [str "path/curve: "; group pk])) in - let pubkey_re = Re.(compile (seq [str "full public key: "; group pk])) in + let addr_re = Re.(compile (seq [str "* Public Key Hash: "; group pk])) in + let pubkey_re = Re.(compile (seq [str "* Public Key: "; group pk])) in let out = String.concat ~sep:" " res#out in try let pubkey = Re.(Group.get (exec pubkey_re out) 1) in @@ -286,9 +284,8 @@ module Ledger = struct match List.find known_addresses ~f:(fun (_, pkh) -> pkh = pubkey_hash) with - | None -> "" - | Some (alias, _) -> alias - in + | None -> "" + | Some (alias, _) -> alias in return (Tezos_protocol.Account.key_pair name ~pubkey ~pubkey_hash ~private_key:uri) -- GitLab From fc5c9b0abd5d59d22993c42cb95199470c8d260c Mon Sep 17 00:00:00 2001 From: Elliot Cameron Date: Mon, 29 Apr 2019 18:30:47 -0400 Subject: [PATCH 39/49] Flextesa: Use verbose-signing in Wallet tests --- src/bin_flextesa/command_ledger_baking.ml | 2 +- src/bin_flextesa/command_ledger_wallet.ml | 123 +++++++++++++++--- src/lib_network_sandbox/console.ml | 14 +- src/lib_network_sandbox/interactive_test.ml | 4 +- .../internal_pervasives.ml | 26 ++++ src/lib_network_sandbox/running_processes.ml | 23 ++++ src/lib_network_sandbox/running_processes.mli | 12 ++ src/lib_network_sandbox/tezos_client.ml | 14 +- src/lib_network_sandbox/tezos_client.mli | 10 ++ 9 files changed, 195 insertions(+), 33 deletions(-) diff --git a/src/bin_flextesa/command_ledger_baking.ml b/src/bin_flextesa/command_ledger_baking.ml index 5eac2d00ec83..16f9776aac7f 100644 --- a/src/bin_flextesa/command_ledger_baking.ml +++ b/src/bin_flextesa/command_ledger_baking.ml @@ -77,7 +77,7 @@ let get_chain_id state ~client = Tezos_client.rpc state ~client `Get ~path:"/chains/main/chain_id" >>= (function | `String x -> return x - | _ -> failf "Failed to parse chain_id JSON from node") + | _ -> failf "Failed to parse chain_id JSON from node" ) >>= fun chain_id_string -> return (Tezos_crypto.Chain_id.of_b58check_exn chain_id_string) diff --git a/src/bin_flextesa/command_ledger_wallet.ml b/src/bin_flextesa/command_ledger_wallet.ml index 2ee18d729786..ce5536eb1b64 100644 --- a/src/bin_flextesa/command_ledger_wallet.ml +++ b/src/bin_flextesa/command_ledger_wallet.ml @@ -3,6 +3,43 @@ open Internal_pervasives let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt +let client_async_cmd state ~client args ~f = + Running_processes.run_async_cmdf state f "sh -c %s" + ( Tezos_client.client_command client ~state args + |> Genspio.Compile.to_one_liner |> Filename.quote ) + >>= fun (status, res) -> return (status = Lwt_unix.WEXITED 0, res) + +let ledger_hash_re () = + Re.( + compile + (seq + [ str "* Blake 2B Hash (ledger-style, with operation watermark):" + ; rep1 (alt [space; eol]) + ; group (rep1 alnum) + ; rep1 (alt [space; eol]) ])) + +(* Searches a stream for an expected ledger hash from `tezos-client --verbose-signing`*) +let find_and_print_signature_hash state stream = + let re = ledger_hash_re () in + let check lines = + Re.( + match exec_opt re lines with + | None -> None + | Some matches -> Some (Group.get matches 1)) + in + Asynchronous_result.Stream.fold (Lwt_io.read_lines stream) ~init:("", false) + ~f:(fun (all_output_prev, showed_message_prev) line -> + let all_output = all_output_prev ^ "\n" ^ line in + ( if not showed_message_prev then + match check all_output with + | None -> return false + | Some x -> + Console.say state EF.(wf "Hash should be: %s" x) + >>= fun () -> return true + else return true ) + >>= fun showed_message -> return (all_output, showed_message) ) + >>= fun (output, _) -> return output + let ledger_prompt_notice state ~ef ?(button = `Checkmark) () = let button_str = match button with @@ -15,13 +52,28 @@ let ledger_prompt_notice state ~ef ?(button = `Checkmark) () = desc (shout "Ledger-prompt") (list [ef; wf "Press %s on the ledger." button_str])) +let ledger_prompt_notice_expectation state message expectation = + ledger_prompt_notice state () + ~button:(match expectation with `Succeeds -> `Checkmark | `Fails -> `X) + ~ef: + EF.( + list + [ message; wf "\n\n" + ; wf + ( match expectation with + | `Succeeds -> ">> ACCEPT THIS <<" + | `Fails -> ">> REJECT THIS <<" ) ]) + +let run_with_status f = + Asynchronous_result.bind_on_error + (f () >>= fun x -> return (`Worked x)) + ~f:(fun x -> return (`Didn'tWork x)) + let assert_failure state msg f () = Console.say state EF.(wf "Asserting %s" msg) >>= fun () -> - Asynchronous_result.bind_on_error - (f () >>= fun _ -> return `Worked) - ~f:(fun _ -> return `Didn'tWork) - >>= function `Worked -> failf "%s" msg | `Didn'tWork -> return () + run_with_status f + >>= function `Worked _ -> failf "%s" msg | `Didn'tWork x -> return x let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt let assert_ a = if a then return () else failf "Assertion failed" @@ -42,23 +94,14 @@ let rec ask state ef = let ask_assert state ef () = ask state ef >>= fun b -> assert_ b let with_ledger_prompt state message expectation ~f = - ledger_prompt_notice state () - ~button:(match expectation with `Succeeds -> `Checkmark | `Fails -> `X) - ~ef: - EF.( - list - [ message; wf "\n\n" - ; wf - ( match expectation with - | `Succeeds -> ">> ACCEPT THIS <<" - | `Fails -> ">> REJECT THIS <<" ) ]) + ledger_prompt_notice_expectation state message expectation >>= fun () -> match expectation with | `Succeeds -> f () >>= fun _ -> Console.say state EF.(wf "> Got response: ACCEPTED") | `Fails -> assert_failure state "expected failure" f () - >>= fun () -> Console.say state EF.(wf "> Got response: REJECTED") + >>= fun _ -> Console.say state EF.(wf "> Got response: REJECTED") let with_ledger_test_reject_and_succeed state ef f = with_ledger_prompt state ef `Fails ~f @@ -68,7 +111,7 @@ let get_chain_id state ~client = Tezos_client.rpc state ~client `Get ~path:"/chains/main/chain_id" >>= (function | `String x -> return x - | _ -> failf "Failed to parse chain_id JSON from node") + | _ -> failf "Failed to parse chain_id JSON from node" ) >>= fun chain_id_string -> return (Tezos_crypto.Chain_id.of_b58check_exn chain_id_string) @@ -158,14 +201,58 @@ let run state ~node_exec ~client_exec ~admin_exec ~size ~base_port ~uri () = (fun () -> Tezos_client.Keyed.initialize state signer >>= fun _ -> return () ) >>= fun _ -> + let submit_proposals () = + client_async_cmd state ~client:(client 0) + ~f:(fun proc -> find_and_print_signature_hash state proc#stdout) + [ "submit"; "proposals"; "for" + ; Tezos_protocol.Account.pubkey_hash ledger_account + ; "Pt24m4xiPbLDhVgVfABUjirbmda3yohdN82Sp9FeuAXJ4eV9otd" + ; "Psd1ynUBhMZAeajwcZJAeq5NrxorM6UCU4GJqxZ7Bx2e9vUWB6z"; "--force" + ; "--verbose-signing" ] + in + ledger_prompt_notice_expectation state + EF.(wf "Submitting multi-protocol proposal submission") + `Fails + >>= submit_proposals + >>= fun (success, stdout) -> + assert_ (not success) + >>= fun () -> + ( match + String.substr_index stdout ~pattern:"Conditions of use not satisfied" + with + | None -> failf "expected rejection %s" stdout + | Some _ -> return () ) + >>= fun () -> + ledger_prompt_notice_expectation state + EF.(wf "Submitting multi-protocol proposal submission") + `Succeeds + >>= submit_proposals + >>= fun (success, stdout) -> + assert_ (not success) + >>= fun () -> + ( match + String.substr_index stdout + ~pattern:"not registered as valid delegate key" + with + | None -> failf "expected error that key is not registered as valid delegate" + | Some _ -> return () ) + >>= fun _ -> forge_batch_transactions state ~client:(client 0) ~src:(Tezos_protocol.Account.pubkey_hash ledger_account) ~dest:"tz2KZPgf2rshxNUBXFcTaCemik1LH1v9qz3F" ~n:50 () >>= fun batch_transaction_bytes -> + let bytes_hash = + Tezos_crypto.( + `Hex batch_transaction_bytes |> Hex.to_bytes + |> Tezos_stdlib.MBytes.of_bytes + |> (fun x -> [x]) + |> Blake2B.hash_bytes |> Blake2B.to_string |> Base58.raw_encode) + in with_ledger_test_reject_and_succeed state EF.( - wf - "Signing batch of transaction: Unrecognized Operation - Sign Unverified") + wf "Signing batch of transaction: Unrecognized Operation - Sign Hash %s" + bytes_hash) + (* Todo blake2b hash here *) (sign state ~client:signer ~bytes:batch_transaction_bytes) let cmd ~pp_error () = diff --git a/src/lib_network_sandbox/console.ml b/src/lib_network_sandbox/console.ml index 8eb5400bf29a..4de364d4ea5a 100644 --- a/src/lib_network_sandbox/console.ml +++ b/src/lib_network_sandbox/console.ml @@ -68,12 +68,10 @@ let cli_term () = value & opt (enum answers) `G & info ["color"] ~doc))) let do_output t = - Lwt_exception.catch - Lwt.( - fun () -> - Lwt_io.write t.channel (Buffer.contents t.buffer) - >>= fun () -> Buffer.clear t.buffer ; return_unit) - () + Lwt.( + fun () -> + Lwt_io.write t.channel (Buffer.contents t.buffer) + >>= fun () -> Buffer.clear t.buffer ; return_unit) let sayf (o : _ Base_state.t) (fmt : Format.formatter -> unit -> unit) : (_, _) Asynchronous_result.t = @@ -95,7 +93,7 @@ let sayf (o : _ Base_state.t) (fmt : Format.formatter -> unit -> unit) : pp_print_newline ppf () ; pp_close_box ppf () ; pp_print_flush ppf ()) ; - do_output o#console + Lwt_exception.catch (do_output o#console) () let say (o : _ Base_state.t) ef : (_, _) Asynchronous_result.t = let date = @@ -111,7 +109,7 @@ let say (o : _ Base_state.t) ef : (_, _) Asynchronous_result.t = fprintf fmt "%a" Easy_format.Pretty.to_formatter msg ; pp_print_newline fmt () ; pp_print_flush fmt ()) ; - do_output o#console + Lwt_exception.catch (do_output o#console) () module Prompt = struct type item = diff --git a/src/lib_network_sandbox/interactive_test.ml b/src/lib_network_sandbox/interactive_test.ml index a43d77a50ed0..fa3bcc4c65ac 100644 --- a/src/lib_network_sandbox/interactive_test.ml +++ b/src/lib_network_sandbox/interactive_test.ml @@ -165,7 +165,7 @@ module Commands = struct ] :: prev) ) >>= fun ef -> say state EF.(list ef) - | _other -> cmdline_fail "command expects 1 argument: name-prefix") + | _other -> cmdline_fail "command expects 1 argument: name-prefix" ) let kill_all state = unit_loop_no_args @@ -232,7 +232,7 @@ module Commands = struct [ desc (af "output") (ocaml_string_list res) ; desc (af "exn") (exn e) ]) >>= fun () -> return [] ) - | `Error -> return []) + | `Error -> return [] ) >>= fun contracts -> let balance block contract = let path = diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index c4cb278d6174..4adba5f6e380 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -225,6 +225,32 @@ module Asynchronous_result = struct >>= fun _ -> return () end + module Stream = struct + let fold : + 'elt Lwt_stream.t + -> f:('b -> 'elt -> ('b, 'error) t) + -> init:'b + -> ('b, 'error) t = + fun stream ~f ~init -> + let error = ref None in + Lwt.catch + (fun () -> + Lwt_stream.fold_s + (fun elt prevm -> + match prevm with + | Ok x -> f x elt + | Error _ -> + error := Some prevm ; + Lwt.fail Not_found ) + stream (Result.Ok init) ) + (fun e -> + match !error with + | Some res -> Lwt.return res + | None -> + (* `f` threw a forbidden exception! *) + Lwt.fail e ) + end + let map_option o ~f = match o with | None -> return None diff --git a/src/lib_network_sandbox/running_processes.ml b/src/lib_network_sandbox/running_processes.ml index f7e3a474da8f..5d8355bfc5a9 100644 --- a/src/lib_network_sandbox/running_processes.ml +++ b/src/lib_network_sandbox/running_processes.ml @@ -153,6 +153,17 @@ let start t process = in State.add_process t process proc >>= fun () -> return {process; lwt= proc} +let start_full t process = + let proc_full = + Lwt_process.open_process_full + (Option.value ~default:"" process.binary, Array.of_list process.command) + in + let proc = (proc_full :> Lwt_process.process_none) in + State.add_process t process proc + >>= fun () -> + return {process; lwt= proc} + >>= fun proc_state -> return (proc_state, proc_full) + let wait _t {lwt; _} = Lwt_exception.catch (fun () -> lwt#close) () >>= fun _status -> return _status @@ -246,6 +257,18 @@ let run_cmdf state fmt = end) ) fmt +let run_async_cmdf state f fmt = + ksprintf + (fun s -> + let id = fresh_id state "cmd" ~seed:s in + let proc = Process.make_in_session id ["sh"; "-c"; s] in + start_full state proc + >>= fun (proc_state, proc) -> + f proc + >>= fun res -> + wait state proc_state >>= fun status -> return (status, res) ) + fmt + let run_successful_cmdf state fmt = ksprintf (fun cmd -> diff --git a/src/lib_network_sandbox/running_processes.mli b/src/lib_network_sandbox/running_processes.mli index 1978025b3fcb..0adb39772a35 100644 --- a/src/lib_network_sandbox/running_processes.mli +++ b/src/lib_network_sandbox/running_processes.mli @@ -76,6 +76,18 @@ val run_cmdf : -> 'a (** Run a shell command and wait for its end. *) +val run_async_cmdf : + < runner: State.t ; .. > + -> ( Lwt_process.process_full + -> ('a, ([> `Lwt_exn of exn] as 'b)) Asynchronous_result.t) + -> ( 'c + , unit + , string + , (Unix.process_status * 'a, 'b) Asynchronous_result.t ) + format4 + -> 'c +(** Run a shell command and run a function over the process data before waiting for its end. *) + val run_successful_cmdf : < paths: Paths.t ; runner: State.t ; .. > -> ( 'a diff --git a/src/lib_network_sandbox/tezos_client.ml b/src/lib_network_sandbox/tezos_client.ml index 0f3d30753ccc..b607caa892fc 100644 --- a/src/lib_network_sandbox/tezos_client.ml +++ b/src/lib_network_sandbox/tezos_client.ml @@ -105,13 +105,18 @@ end open Command_error open Console -let successful_client_cmd state ~client args = +let client_cmd state ~client args = Running_processes.run_cmdf state "sh -c %s" ( client_command client ~state args |> Genspio.Compile.to_one_liner |> Filename.quote ) >>= fun res -> Console.display_errors_of_command state res - >>= function + >>= fun success -> return (success, res) + +let successful_client_cmd state ~client args = + client_cmd state ~client args + >>= fun (success, res) -> + match success with | true -> return res | false -> failf ~args "Client-command failure: %s" (String.concat ~sep:" " args) @@ -212,7 +217,7 @@ let list_known_addresses state ~client = [ group (rep1 (alt [alnum; char '_'])) ; str ": " ; group (rep1 alnum) - ; Re.alt [space; eol; eos] ])) + ; alt [space; eol; eos] ])) in return (List.filter_map res#out @@ -285,7 +290,8 @@ module Ledger = struct List.find known_addresses ~f:(fun (_, pkh) -> pkh = pubkey_hash) with | None -> "" - | Some (alias, _) -> alias in + | Some (alias, _) -> alias + in return (Tezos_protocol.Account.key_pair name ~pubkey ~pubkey_hash ~private_key:uri) diff --git a/src/lib_network_sandbox/tezos_client.mli b/src/lib_network_sandbox/tezos_client.mli index cc741da648e2..ab71f9b4e71f 100644 --- a/src/lib_network_sandbox/tezos_client.mli +++ b/src/lib_network_sandbox/tezos_client.mli @@ -62,6 +62,16 @@ module Command_error : sig val pp : Format.formatter -> t -> unit end +val client_cmd : + < application_name: string + ; console: Console.t + ; paths: Paths.t + ; runner: Running_processes.State.t + ; .. > + -> client:client + -> string list + -> (bool * Process_result.t, [> `Lwt_exn of exn]) Asynchronous_result.t + val successful_client_cmd : < application_name: string ; console: Console.t -- GitLab From 76cfdcd3e3d6ecac5c01304819218dbe6cff2cd3 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Tue, 7 May 2019 17:43:55 -0400 Subject: [PATCH 40/49] Flextesa: fix rebase build errors --- src/bin_flextesa/command_ledger_baking.ml | 2 +- src/bin_flextesa/command_ledger_wallet.ml | 2 +- .../internal_pervasives.ml | 26 ------------------- 3 files changed, 2 insertions(+), 28 deletions(-) diff --git a/src/bin_flextesa/command_ledger_baking.ml b/src/bin_flextesa/command_ledger_baking.ml index 16f9776aac7f..04e4bc75fc6c 100644 --- a/src/bin_flextesa/command_ledger_baking.ml +++ b/src/bin_flextesa/command_ledger_baking.ml @@ -20,7 +20,7 @@ let assert_failure state msg f () = >>= fun () -> Asynchronous_result.bind_on_error (f () >>= fun _ -> return `Worked) - ~f:(fun _ -> return `Didn'tWork) + ~f:(fun ~result _ -> return `Didn'tWork) >>= function `Worked -> failf "%s" msg | `Didn'tWork -> return () let failf fmt = ksprintf (fun s -> fail (`Scenario_error s)) fmt diff --git a/src/bin_flextesa/command_ledger_wallet.ml b/src/bin_flextesa/command_ledger_wallet.ml index ce5536eb1b64..3d5bb0447556 100644 --- a/src/bin_flextesa/command_ledger_wallet.ml +++ b/src/bin_flextesa/command_ledger_wallet.ml @@ -67,7 +67,7 @@ let ledger_prompt_notice_expectation state message expectation = let run_with_status f = Asynchronous_result.bind_on_error (f () >>= fun x -> return (`Worked x)) - ~f:(fun x -> return (`Didn'tWork x)) + ~f:(fun ~result x -> return (`Didn'tWork x)) let assert_failure state msg f () = Console.say state EF.(wf "Asserting %s" msg) diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index 4adba5f6e380..c4cb278d6174 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -225,32 +225,6 @@ module Asynchronous_result = struct >>= fun _ -> return () end - module Stream = struct - let fold : - 'elt Lwt_stream.t - -> f:('b -> 'elt -> ('b, 'error) t) - -> init:'b - -> ('b, 'error) t = - fun stream ~f ~init -> - let error = ref None in - Lwt.catch - (fun () -> - Lwt_stream.fold_s - (fun elt prevm -> - match prevm with - | Ok x -> f x elt - | Error _ -> - error := Some prevm ; - Lwt.fail Not_found ) - stream (Result.Ok init) ) - (fun e -> - match !error with - | Some res -> Lwt.return res - | None -> - (* `f` threw a forbidden exception! *) - Lwt.fail e ) - end - let map_option o ~f = match o with | None -> return None -- GitLab From 2a865b8d35b8d8f8d230c068c22e401f5bb3f09c Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 10 May 2019 10:40:19 -0400 Subject: [PATCH 41/49] Flextesa: improve documentation --- src/lib_network_sandbox/tezos_client.mli | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/lib_network_sandbox/tezos_client.mli b/src/lib_network_sandbox/tezos_client.mli index ab71f9b4e71f..d05569910fee 100644 --- a/src/lib_network_sandbox/tezos_client.mli +++ b/src/lib_network_sandbox/tezos_client.mli @@ -4,16 +4,19 @@ open Internal_pervasives type t = {id: string; port: int; exec: Tezos_executable.t} type client = t -val no_node_client : exec:Tezos_executable.t -> t - val of_node : exec:Tezos_executable.t -> Tezos_node.t -> t (** Create a client which is meant to communicate with a given node. *) +val no_node_client : exec:Tezos_executable.t -> t +(** Create a client not connected to a node (e.g. for ledger interaction). *) + val base_dir : t -> state:< paths: Paths.t ; .. > -> string +(** Get the path to the ["--base-dir"] option of the client. *) + +(** {3 Build Scripts } *) val client_command : t -> state:< paths: Paths.t ; .. > -> string list -> unit Genspio.EDSL.t -(** {3 Build Scripts } *) val bootstrapped_script : t -> state:< paths: Paths.t ; .. > -> unit Genspio.EDSL.t -- GitLab From 4cb4749a75f0c0ba7674d20ae92e9df9d3750635 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 10 May 2019 11:04:00 -0400 Subject: [PATCH 42/49] =?UTF-8?q?Flextesa:=20remove=20=E2=80=9CKiln-proces?= =?UTF-8?q?s=E2=80=9D=20support?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/bin_flextesa/command_accusations.ml | 99 ++++++------- src/bin_flextesa/command_mini_network.ml | 25 +--- src/lib_network_sandbox/kiln.ml | 180 +---------------------- src/lib_network_sandbox/kiln.mli | 48 +----- 4 files changed, 58 insertions(+), 294 deletions(-) diff --git a/src/bin_flextesa/command_accusations.ml b/src/bin_flextesa/command_accusations.ml index b5a364b52826..74d3de5628ee 100644 --- a/src/bin_flextesa/command_accusations.ml +++ b/src/bin_flextesa/command_accusations.ml @@ -4,8 +4,8 @@ open Console let default_attempts = 35 -let little_mesh_with_bakers ?base_port ?kiln state ~starting_level ~node_exec - ~client_exec ~bakers () = +let little_mesh_with_bakers ?base_port ?generate_kiln_config state + ~starting_level ~node_exec ~client_exec ~bakers () = Helpers.clear_root state >>= fun () -> Interactive_test.Pauser.generic state @@ -59,29 +59,28 @@ let little_mesh_with_bakers ?base_port ?kiln state ~starting_level ~node_exec Interactive_test.Commands. [ arbitrary_command_on_clients state ~clients:[client_0; client_1; client_2] ] ; - Asynchronous_result.map_option kiln ~f:(fun k -> + Asynchronous_result.map_option generate_kiln_config ~f:(fun kiln_config -> Tezos_client.rpc state ~client:client_0 `Get ~path:"/chains/main/chain_id" >>= fun chain_id_json -> let network_id = match chain_id_json with `String s -> s | _ -> assert false in - Kiln.start state ~network_id k - ~bakers: - ( List.map baker_list ~f:(fun (account, _) -> - Tezos_protocol.Account.(name account, pubkey_hash account) ) - @ List.map [baker_0; baker_1; baker_2] ~f:(fun bak -> - ( bak.key_name - , Tezos_protocol.Key.Of_name.pubkey_hash bak.key_name ) ) - |> List.dedup_and_sort ~compare:(fun (_, a) (_, b) -> - String.compare a b ) ) - ~node_uris: + Kiln.Configuration_directory.generate state kiln_config + ~peers: + (List.map all_nodes ~f:(fun {Tezos_node.p2p_port; _} -> p2p_port)) + ~sandbox_json:(Tezos_protocol.sandbox_path ~config:state protocol) + ~nodes: (List.map all_nodes ~f:(fun {Tezos_node.rpc_port; _} -> sprintf "http://localhost:%d" rpc_port )) - >>= fun (pg, kiln) -> - Interactive_test.Pauser.generic state EF.[af "Started Kiln with its DB."] - ) - >>= fun (_ : unit option) -> + ~bakers: + (List.map protocol.Tezos_protocol.bootstrap_accounts + ~f:(fun (account, _) -> + Tezos_protocol.Account.(name account, pubkey_hash account) )) + ~network_string:network_id ~node_exec ~client_exec + >>= fun () -> + return EF.(wf "Kiln was configured at `%s`" kiln_config.path) ) + >>= fun kiln_info_opt -> let bake msg baker = Tezos_client.Keyed.bake state baker msg in List.fold (List.init (starting_level - 1) ~f:(fun n -> n)) @@ -123,10 +122,10 @@ let wait_for_operation_in_mempools state ~nodes:all_nodes ~kind ~client_exec (`Not_done (sprintf "Waiting for %S to show up in the mempool" kind)) ) -let simple_double_baking ~starting_level ?kiln ~state ~base_port node_exec - client_exec () = +let simple_double_baking ~starting_level ?generate_kiln_config ~state + ~base_port node_exec client_exec () = little_mesh_with_bakers ~bakers:1 state ~node_exec ~client_exec () ~base_port - ~starting_level ?kiln + ~starting_level ?generate_kiln_config >>= fun (all_nodes, client_0, baker_0, client_1, baker_1, client_2, baker_2) -> let kill_nth nth = List.nth_exn all_nodes nth |> Helpers.kill_node state in let restart_nth nth = @@ -236,10 +235,10 @@ let find_endorsement_in_mempool state ~client = | None -> return (`Not_done (sprintf "No endorsement so far")) | Some e -> return (`Done e) ) -let simple_double_endorsement ~starting_level ?kiln ~state ~base_port node_exec - client_exec () = +let simple_double_endorsement ~starting_level ?generate_kiln_config ~state + ~base_port node_exec client_exec () = little_mesh_with_bakers ~bakers:2 state ~node_exec ~client_exec () - ~starting_level ~base_port ?kiln + ~starting_level ~base_port ?generate_kiln_config >>= fun (all_nodes, client_0, baker_0, client_1, baker_1, client_2, baker_2) -> (* 2 bakers ⇒ baker_0 and baker_2 are for the same key on ≠ nodes *) assert ( @@ -364,8 +363,7 @@ let simple_double_endorsement ~starting_level ?kiln ~state ~base_port node_exec last_level)) ) >>= fun () -> say state EF.(af "Test done.") -let with_accusers ?kiln ~state ~base_port node_exec accuser_exec client_exec () - = +let with_accusers ~state ~base_port node_exec accuser_exec client_exec () = Helpers.clear_root state >>= fun () -> let block_interval = 2 in @@ -419,25 +417,25 @@ let with_accusers ?kiln ~state ~base_port node_exec accuser_exec client_exec () >>= fun (client_1, baker_1) -> baker 2 >>= fun (client_2, baker_2) -> - Asynchronous_result.map_option kiln ~f:(fun k -> - Tezos_client.rpc state ~client:client_0 `Get - ~path:"/chains/main/chain_id" - >>= fun chain_id_json -> - let network_id = - match chain_id_json with `String s -> s | _ -> assert false - in - Kiln.start state ~network_id k - ~bakers: - [ Tezos_protocol.Account.( - let acc = fst baker_0_account in - (name acc, pubkey_hash acc)) ] - ~node_uris: - (List.map all_nodes ~f:(fun {Tezos_node.rpc_port; _} -> - sprintf "http://localhost:%d" rpc_port )) - >>= fun (pg, kiln) -> - Interactive_test.Pauser.generic state EF.[af "Started Kiln with its DB."] - ) - >>= fun (_ : unit option) -> + (* Asynchronous_result.map_option kiln ~f:(fun k -> + * Tezos_client.rpc state ~client:client_0 `Get + * ~path:"/chains/main/chain_id" + * >>= fun chain_id_json -> + * let network_id = + * match chain_id_json with `String s -> s | _ -> assert false + * in + * Kiln.start state ~network_id k + * ~bakers: + * [ Tezos_protocol.Account.( + * let acc = fst baker_0_account in + * (name acc, pubkey_hash acc)) ] + * ~node_uris: + * (List.map all_nodes ~f:(fun {Tezos_node.rpc_port; _} -> + * sprintf "http://localhost:%d" rpc_port )) + * >>= fun (pg, kiln) -> + * Interactive_test.Pauser.generic state EF.[af "Started Kiln with its DB."] + * ) + * >>= fun (_ : unit option) -> *) Interactive_test.Pauser.add_commands state Interactive_test.Commands.( all_defaults state ~nodes:all_nodes @@ -627,14 +625,13 @@ let cmd ~pp_error () = bnod bcli accex - kiln + generate_kiln_config state -> let checks () = let acc = if test = `With_accusers then [accex] else [] in Helpers.System_dependencies.precheck state `Or_fail ~executables:(acc @ [bnod; bcli]) - ~using_docker:(kiln <> None) in let actual_test () = match test with @@ -645,13 +642,13 @@ let cmd ~pp_error () = | `Simple_double_baking -> checks () >>= fun () -> - simple_double_baking ~state bnod bcli ~base_port ?kiln - ~starting_level () + simple_double_baking ~state bnod bcli ~base_port + ?generate_kiln_config ~starting_level () | `Simple_double_endorsing -> checks () >>= fun () -> - simple_double_endorsement ~state bnod bcli ~base_port ?kiln - ~starting_level () + simple_double_endorsement ~state bnod bcli ~base_port + ?generate_kiln_config ~starting_level () in (state, Interactive_test.Pauser.run_test ~pp_error state actual_test) ) @@ -675,7 +672,7 @@ let cmd ~pp_error () = $ Tezos_executable.cli_term `Node "tezos" $ Tezos_executable.cli_term `Client "tezos" $ Tezos_executable.cli_term `Accuser "tezos" - $ Kiln.cli_term () + $ Kiln.Configuration_directory.cli_term () $ Test_command_line.cli_state ~name:"accusing" () ) (let doc = "Sandbox networks which record double-bakings." in let man : Manpage.block list = diff --git a/src/bin_flextesa/command_mini_network.ml b/src/bin_flextesa/command_mini_network.ml index ec7d5cfba575..37200658b2e6 100644 --- a/src/bin_flextesa/command_mini_network.ml +++ b/src/bin_flextesa/command_mini_network.ml @@ -2,13 +2,12 @@ open Tezos_network_sandbox open Internal_pervasives open Console -let run state ~protocol ~size ~base_port ~no_daemons_for ?kiln - ?external_peer_ports ?generate_kiln_config node_exec client_exec baker_exec - endorser_exec accuser_exec () = +let run state ~protocol ~size ~base_port ~no_daemons_for ?external_peer_ports + ?generate_kiln_config node_exec client_exec baker_exec endorser_exec + accuser_exec () = Helpers.System_dependencies.precheck state `Or_fail ~executables: [node_exec; client_exec; baker_exec; endorser_exec; accuser_exec] - ~using_docker:(kiln <> None) >>= fun () -> Test_scenario.network_with_protocol ?external_peer_ports ~protocol ~size ~base_port state ~node_exec ~client_exec @@ -20,20 +19,8 @@ let run state ~protocol ~size ~base_port ~no_daemons_for ?kiln let network_id = match chain_id_json with `String s -> s | _ -> assert false in - Asynchronous_result.map_option kiln ~f:(fun k -> - Kiln.start state ~network_id k - ~bakers: - (List.map protocol.Tezos_protocol.bootstrap_accounts - ~f:(fun (account, _) -> - Tezos_protocol.Account.(name account, pubkey_hash account) )) - ~node_uris: - (List.map nodes ~f:(fun {Tezos_node.rpc_port; _} -> - sprintf "http://localhost:%d" rpc_port )) - >>= fun (pg, kiln) -> return () ) - >>= fun (_ : unit option) -> Asynchronous_result.map_option generate_kiln_config ~f:(fun kiln_config -> - Kiln.Configuration_directory.generate state - kiln_config + Kiln.Configuration_directory.generate state kiln_config ~peers:(List.map nodes ~f:(fun {Tezos_node.p2p_port; _} -> p2p_port)) ~sandbox_json:(Tezos_protocol.sandbox_path ~config:state protocol) ~nodes: @@ -126,12 +113,11 @@ let cmd ~pp_error () = bak endo accu - kiln generate_kiln_config state -> let actual_test = - run state ~size ~base_port ~protocol bnod bcli bak endo accu ?kiln + run state ~size ~base_port ~protocol bnod bcli bak endo accu ?generate_kiln_config ~external_peer_ports ~no_daemons_for in (state, Interactive_test.Pauser.run_test ~pp_error state actual_test) @@ -160,7 +146,6 @@ let cmd ~pp_error () = $ Tezos_executable.cli_term `Baker "tezos" $ Tezos_executable.cli_term `Endorser "tezos" $ Tezos_executable.cli_term `Accuser "tezos" - $ Kiln.cli_term () $ Kiln.Configuration_directory.cli_term () $ Test_command_line.cli_state ~name:"mininet" () ) (let doc = "Small network sandbox with bakers, endorsers, and accusers." in diff --git a/src/lib_network_sandbox/kiln.ml b/src/lib_network_sandbox/kiln.ml index 56f3180d0a07..492b4f3b7d6c 100644 --- a/src/lib_network_sandbox/kiln.ml +++ b/src/lib_network_sandbox/kiln.ml @@ -1,186 +1,10 @@ open Internal_pervasives -type t = - { run: [`Docker of string | `Dev_mode of string * string] - ; port: int - ; postgres: [`Docker of int] option - ; pause_for_user: bool } - -let make ~run ~port ?postgres ~pause_for_user () = - {run; port; postgres; pause_for_user} - -let default_docker_image = "obsidiansystems/tezos-bake-monitor:0.4.0" -let default_postgres_port = 4_532 - -let default = - make ~run:(`Docker default_docker_image) ~port:8086 - ~postgres:(`Docker default_postgres_port) ~pause_for_user:false () - -let start ?(network_id = "zeronet") state {run; port; postgres; pause_for_user} - ~node_uris ~bakers = - let name nonbase = sprintf "flxts-%s" nonbase in - let kiln_port = port in - ( match postgres with - | Some (`Docker pg_port) -> - let pg_password = Tezos_protocol.Key.Of_name.pubkey "pg-password" in - let pg = - Running_processes.Process.docker_run (name "kiln-postgres-db") - ~image:"postgres" - ~options: - [ "-p"; sprintf "%d:5432" pg_port; "-e" - ; sprintf "POSTGRES_PASSWORD=%s" pg_password ] - ~args:[] - in - let pg_cli_option = - sprintf - "--pg-connection=host=localhost port=%d dbname=postgres \ - user=postgres password=%s" - pg_port pg_password - in - Running_processes.start state pg - >>= fun pg_process -> - Helpers.wait_for state ~attempts:20 ~seconds:8. (fun attempt -> - Running_processes.run_cmdf state - "docker run --rm -e PGPASSWORD=%s --network host -it postgres \ - psql -h localhost -p %d -U postgres -w -c '\\l'" - pg_password pg_port - >>= fun res -> - Console.display_errors_of_command state res - >>= function - | true -> return (`Done ()) - | false -> - return - (`Not_done - (sprintf "Waiting for postgres to be ready (%d)" attempt)) ) - >>= fun () -> return (Some (pg_process, pg_cli_option)) - | None -> return None ) - >>= fun pg_opt -> - (* We need to use /tmp and not the root-path because of Docker access rights. *) - let tmp = "/tmp" // sprintf "kiln-config-%d" port in - Running_processes.run_cmdf state - "rm -fr %s ; mkdir -p %s/config ; chmod -R 777 %s" tmp tmp tmp - >>= fun _ -> - System.write_file state ~perm:0o777 (tmp // "config/loggers") - ~content: - {json|[ - { "logger":{"Stderr":{}} , "filters": { "SQL":"Error" , "":"Info"}} -]|json} - >>= fun () -> - System.write_file state ~perm:0o777 - (tmp // "config/kiln-node-custom-args") - ~content: - (sprintf - "--net-addr 0.0.0.0:10000 --private-mode --no-bootstrap-peers %s \ - --bootstrap-threshold 0 --connections 5 --sandbox \ - /home/smondet/tmp/metetests//0_mininet-test-data/protocol-default-and-command-line/sandbox.json" - ( List.map - (List.init 5 ~f:(fun i -> 20_001 + (2 * i))) - ~f:(sprintf "--peer 127.0.0.1:%d") - |> String.concat ~sep:" " )) - >>= fun () -> - Running_processes.run_cmdf state " chmod -R 777 %s" tmp - >>= fun _ -> - let kiln = - let args = - (match pg_opt with None -> [] | Some (_, cli) -> [cli]) - @ [ "--nodes" - ; String.concat ~sep:"," node_uris - ; "--bakers" - ; String.concat ~sep:"," - (List.map bakers ~f:(fun (n, pkh) -> sprintf "%s@%s" pkh n)) - ; "--network"; network_id; "--"; "--port"; Int.to_string kiln_port ] - in - match run with - | `Docker image -> - Running_processes.Process.docker_run (name "kiln-backend") ~image - ~options: - ["--network"; "host"; "-v"; sprintf "%s:/var/run/bake-monitor" tmp] - ~args - | `Dev_mode (dir, cmd) -> - Running_processes.Process.genspio (name "kiln-dev-backend") - Genspio.EDSL.( - seq - [ exec ["cd"; tmp] - ; exec ["echo"; sprintf "tmp is %s" tmp] - ; call [str "echo"; getenv (str "PATH")] - ; exec ["sh"; "-c"; sprintf "ln -sf %s/* %s" dir tmp] - ; exec ["ls"; "-la"] - ; exec (cmd :: sprintf "--kiln-data-dir=%s" tmp :: args) ]) - in - Running_processes.start state kiln - >>= fun kiln_process -> - Console.say state - EF.( - wf - "Kiln was started (cf. , Data-dir: %s) with \ - nodes: %s, and network-id: %s" - kiln_port tmp - (List.map node_uris ~f:(sprintf "`%s`") |> String.concat ~sep:", ") - network_id) - >>= fun () -> - ( match bakers with - | ([] | _) when not pause_for_user -> return () - | _ -> - Interactive_test.Pauser.generic state ~force:true - EF. - [ wf "Started Kiln with Nodes and Bakers." - ; wf "You may open and quit this prompt (`q`)." - kiln_port ] ) - >>= fun () -> return (Option.map ~f:fst pg_opt, kiln_process) - -let cli_term () = - let open Cmdliner in - Term.( - pure (fun run_docker run_dev_opt port postgres pause_for_user -> function - | true -> - let run = Option.value run_dev_opt ~default:run_docker in - Some (make ~run ?postgres ~port ~pause_for_user ()) - | false -> None ) - $ Arg.( - let doc = "Set the Kiln docker image." in - pure (fun docker_image -> `Docker docker_image) - $ value - (opt string default_docker_image (info ["kiln-docker-image"] ~doc))) - $ Arg.( - let doc = - "Set the path to the directory containing Kiln's `./backend`." - in - pure (Option.map ~f:(fun dir -> `Dev_mode (dir, "./backend"))) - $ value (opt (some string) None (info ["kiln-dev-mode"] ~doc))) - $ Arg.( - value - (opt int default.port (info ["kiln-port"] ~doc:"Set the kiln port."))) - $ Arg.( - pure (function - | false -> fun port -> Some (`Docker port) - | true -> fun _ -> None ) - $ value - (flag - (info ["kiln-without-postgres"] - ~doc:"Let Kiln run its own Postgres.")) - $ value - (opt int default_postgres_port - (info ["kiln-pg-port"] ~doc:"Set the Postgres port for Kiln."))) - $ Arg.( - value - (flag - (info ["pause-to-display-kiln"] - ~doc: - "Add an interactive pause to show the user the URI of \ - Kiln's GUI."))) - $ Arg.( - value - (flag - (info ["with-kiln"] - ~doc: - "Add Kiln to the network (may make the test partially \ - interactive).")))) - module Configuration_directory = struct type t = {path: string; clean: bool; p2p_port: int} - let generate state t ~peers ~sandbox_json ~nodes ~bakers ~network_string - ~node_exec ~client_exec ~protocol_execs = + let generate state ?(protocol_execs = []) t ~peers ~sandbox_json ~nodes + ~bakers ~network_string ~node_exec ~client_exec = (* For now, client-exec in Kiln is not protocol dependent, this should be fixed soon. *) let {path; clean; p2p_port} = t in diff --git a/src/lib_network_sandbox/kiln.mli b/src/lib_network_sandbox/kiln.mli index e8b0817db4ac..815d80ebabe5 100644 --- a/src/lib_network_sandbox/kiln.mli +++ b/src/lib_network_sandbox/kiln.mli @@ -1,50 +1,8 @@ -(** Manage a Kiln process next to a network-sandbox. *) +(** Helpers to run Kiln with a network-sandbox. *) open Internal_pervasives -type t - -val make : - run:[`Dev_mode of string * string | `Docker of string] - -> port:int - -> ?postgres:[`Docker of int] - -> pause_for_user:bool - -> unit - -> t -(** Configure a Kiln process-to-be, running on port [~port] and - managing a PostgreSQL database on port [~postgres:(`Docker - port)]. If [pause_for_user] is [true], !{start} will add an - interactive pause to show the user the URI of the WebUI. *) - -val default_docker_image : string -val default : t - -val start : - ?network_id:string - -> < application_name: string - ; console: Console.t - ; paths: Paths.t - ; pauser: Interactive_test.Pauser.t - ; runner: Running_processes.State.t - ; test_interactivity: Interactive_test.Interactivity.t - ; .. > - -> t - -> node_uris:string list - -> bakers:(string * string) list - -> ( Running_processes.State.process_state option - * Running_processes.State.process_state - , [> `Lwt_exn of exn | `Waiting_for of string * [`Time_out]] ) - Asynchronous_result.t -(** Start the Kiln and Postgres processes. [~network_id] is usually - the chain-id of the sandbox, [~node_uris] is the list or URIs given to - the ["--nodes"] option, if [~bakers] is not [[]] the test will force - [state#pauser] to pause for the user to add the baker addresses to - Kiln. *) - -val cli_term : unit -> t option Cmdliner.Term.t -(** Build a {!Cmdliner.Term.t} which provides options like - ["--with-kiln"] or ["--kiln-docker-image"]. *) - +(** Generate Kiln ["./config/"] directories from sandbox parameters. *) module Configuration_directory : sig type t = {path: string; clean: bool; p2p_port: int} @@ -53,6 +11,7 @@ module Configuration_directory : sig ; paths: Paths.t ; runner: Running_processes.State.t ; .. > + -> ?protocol_execs:(string * Tezos_executable.t * Tezos_executable.t) list -> t -> peers:int list -> sandbox_json:string @@ -61,7 +20,6 @@ module Configuration_directory : sig -> network_string:string -> node_exec:Tezos_executable.t -> client_exec:Tezos_executable.t - -> protocol_execs:(string * Tezos_executable.t * Tezos_executable.t) list -> (unit, [> Lwt_exception.t]) Asynchronous_result.t val cli_term : unit -> t option Cmdliner.Term.t -- GitLab From 89d63f4ec44a0454936db819d649bb576e2ee073 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 10 May 2019 11:19:11 -0400 Subject: [PATCH 43/49] Flextesa: update tutorial --- docs/developer/flextesa.rst | 32 +++++++++----------------------- 1 file changed, 9 insertions(+), 23 deletions(-) diff --git a/docs/developer/flextesa.rst b/docs/developer/flextesa.rst index 6afe879afa90..3dbbedc2a71e 100644 --- a/docs/developer/flextesa.rst +++ b/docs/developer/flextesa.rst @@ -18,8 +18,7 @@ There are testing-only ``opam`` dependencies: ``dum`` and ``genspio`` Usage ----- -See ``./tezos-sandbox --help`` (or one can use -``_build/default/src/bin_flextesa/main.exe``). +See ``./tezos-sandbox --help``. When running (semi-)interactive tests, it is recommended to wrap the call with ``rlwrap`` or ``ledit``. @@ -37,11 +36,11 @@ endorsers: rlwrap ./tezos-sandbox mini-network \ --root-path /tmp/zz-mininet-test \ - --tezos-node-binary _build/default/src/bin_node/main.exe \ - --tezos-baker-alpha-binary _build/default/src/proto_alpha/bin_baker/main_baker_alpha.exe \ - --tezos-endorser-alpha-binary _build/default/src/proto_alpha/bin_endorser/main_endorser_alpha.exe \ - --tezos-accuser-alpha-binary _build/default/src/proto_alpha/bin_accuser/main_accuser_alpha.exe \ - --tezos-client-binary _build/default/src/bin_client/main_client.exe + --tezos-node-binary ./tezos-node \ + --tezos-baker-alpha-binary ./tezos-baker-alpha \ + --tezos-endorser-alpha-binary ./tezos-endorser-alpha \ + --tezos-accuser-alpha-binary ./tezos-accuser-alpha \ + --tezos-client-binary ./tezos-client Once the network is started this test scenario becomes interactive: @@ -72,26 +71,13 @@ sandbox before killing all the nodes. --pause-at-end=true -This test among other ones can run +This test among other ones can generate configuration files for `Kiln `__ -alongside the *Ꜩ-sandbox*, for instance: - -:: - - rlwrap ./tezos-sandbox accusations simple-double-endorsing --with-kiln - -See also the options ``--kiln-*`` for configuration, and the option -``--starting-level`` (since Kiln assumes a long-running blockchain -adding more, e.g. 40, bakes at the beginning of the test brings us to a -more “normal” state). +to run alongside the *Ꜩ-sandbox*, for instance: Voting With a Ledger Nano S ~~~~~~~~~~~~~~~~~~~~~~~~~~~ - **Note:** this requires a recent ``tezos-client`` with the changes - from `!848 `__ as - well as the 2.0.0 version of the ledger Baking app. - The voting test tries to do a full round of voting and protocol switch, including baking on the test-chain, see documentation in ``./tezos-sandbox voting --help``. @@ -109,7 +95,7 @@ period. One example is this branch: ```obsidian.systems/tezos#zeronet-with-proto042`` `__ -which allows one to build a Zeronet-like code base with an extra +which allows one to build an Apr2019-Zeronet-like code base with an extra protocol, lets assume this is built at path ``$zeronet_042``. Also, get an URI for your ledger (the test requires both the Wallet and -- GitLab From 58d345f5677805ad81adc27e2e76c8b0ac4e33db Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 10 May 2019 12:00:30 -0400 Subject: [PATCH 44/49] Flextesa: improve help of the daemons-upgrade test --- .../command_daemons_protocol_change.ml | 32 +++++++++++++++---- src/lib_network_sandbox/tezos_protocol.ml | 4 +-- 2 files changed, 28 insertions(+), 8 deletions(-) diff --git a/src/bin_flextesa/command_daemons_protocol_change.ml b/src/bin_flextesa/command_daemons_protocol_change.ml index d43f804e4df6..eb087a55a0bb 100644 --- a/src/bin_flextesa/command_daemons_protocol_change.ml +++ b/src/bin_flextesa/command_daemons_protocol_change.ml @@ -12,7 +12,7 @@ let wait_for_voting_period ?level_withing_period state ~client ~attempts period (Option.value_map level_withing_period ~default:"" ~f:(sprintf " (and level-within-period ≤ %d)")) in - Console.sayf state Format.(fun ppf () -> pp_print_text ppf message) + Console.say state EF.(wf "%s" message) >>= fun () -> Helpers.wait_for state ~attempts ~seconds:10. (fun nth -> Asynchronous_result.map_option level_withing_period ~f:(fun lvl -> @@ -357,13 +357,33 @@ let cmd ~pp_error () = pure (fun p -> `Protocol_path p) $ required (pos 0 (some string) None - (info [] ~doc:"The protocol to inject and vote on." ~docv:"PATH"))) + (info [] ~doc:"The protocol to inject and vote on." + ~docv:"PROTOCOL-PATH"))) $ Kiln.Configuration_directory.cli_term () $ Test_command_line.cli_state ~name:"daemons-upgrade" () ) - (let doc = "Small network sandbox with bakers, endorsers, and accusers." in + (let doc = + "Vote and Protocol-upgrade with bakers, endorsers, and accusers." + in let man : Manpage.block list = - [ `P - "This test builds a small sandbox network, start various daemons, \ - and then ... TODO ..." ] + [ `S "DAEMONS-UPGRADE TEST" + ; `P + "This test builds and runs a sandbox network to do a full voting \ + round followed by a protocol change while all the daemons." + ; `P "The test is interactive-only:" + ; `Blocks + (List.concat_mapi + ~f:(fun i s -> [`Noblank; `P (sprintf "%d) %s" (i + 1) s)]) + [ "It starts a sandbox assuming the protocol of the `--first-*` \ + executables (use the `--protocol-hash` option to make sure \ + it matches)." + ; "An interactive pause is done to let the user play with the \ + `first` protocol." + ; "Once the user quits the prompt (`q` or `quit` command), a \ + full voting round happens with a single proposal: the one at \ + `PROTOCOL-PATH` (which should be the one understood by the \ + `--second-*` executables)." + ; "Once the protocol switch has happened (and been verified), \ + the test re-enters an interactive prompt to let the user \ + play with the new protocol." ]) ] in info "daemons-upgrade" ~man ~doc) diff --git a/src/lib_network_sandbox/tezos_protocol.ml b/src/lib_network_sandbox/tezos_protocol.ml index 261f17d03295..178d89c3f12b 100644 --- a/src/lib_network_sandbox/tezos_protocol.ml +++ b/src/lib_network_sandbox/tezos_protocol.ml @@ -351,12 +351,12 @@ let cli_term () = (opt (some int) None (info ["blocks-per-voting-period"] - ~docs:"Set the length of voting periods"))) + ~doc:"Set the length of voting periods"))) $ Arg.( pure (fun x -> `Protocol_hash x) $ value (opt (some string) None - (info ["protocol-hash"] ~docs:"Set the (starting) protocol hash."))) + (info ["protocol-hash"] ~doc:"Set the (starting) protocol hash."))) $ Arg.( pure (fun x -> `Time_between_blocks x) $ value -- GitLab From c15e38d0ef787e5fbf544da4f9b9259f9adb09be Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 10 May 2019 12:24:31 -0400 Subject: [PATCH 45/49] Flextesa: clean-up accusations test code --- src/bin_flextesa/command_accusations.ml | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/src/bin_flextesa/command_accusations.ml b/src/bin_flextesa/command_accusations.ml index 74d3de5628ee..decfaec6919b 100644 --- a/src/bin_flextesa/command_accusations.ml +++ b/src/bin_flextesa/command_accusations.ml @@ -285,8 +285,6 @@ let simple_double_endorsement ~starting_level ?generate_kiln_config ~state >>= fun () -> Helpers.restart_node state node_1 ~client_exec >>= fun () -> - (* Tezos_client.Keyed.bake state baker_0 "baker-0 baking lonelily" - * >>= fun () -> *) Test_scenario.Queries.wait_for_all_levels_to_be state ~attempts:default_attempts ~seconds:8. [node_1; node_2] (`Equal_to (starting_level + 1)) @@ -405,9 +403,6 @@ let with_accusers ~state ~base_port node_exec accuser_exec client_exec () = let bak = Tezos_client.Keyed.make client ~key_name ~secret_key:(Tezos_protocol.Account.private_key (fst baker_0_account)) - (* ~secret_key: - * (Tezos_protocol.Key.Of_name.private_key - * (fst baker_0 |> Tezos_protocol.name_to_string)) *) in Tezos_client.Keyed.initialize state bak >>= fun _ -> return (client, bak) in @@ -417,25 +412,6 @@ let with_accusers ~state ~base_port node_exec accuser_exec client_exec () = >>= fun (client_1, baker_1) -> baker 2 >>= fun (client_2, baker_2) -> - (* Asynchronous_result.map_option kiln ~f:(fun k -> - * Tezos_client.rpc state ~client:client_0 `Get - * ~path:"/chains/main/chain_id" - * >>= fun chain_id_json -> - * let network_id = - * match chain_id_json with `String s -> s | _ -> assert false - * in - * Kiln.start state ~network_id k - * ~bakers: - * [ Tezos_protocol.Account.( - * let acc = fst baker_0_account in - * (name acc, pubkey_hash acc)) ] - * ~node_uris: - * (List.map all_nodes ~f:(fun {Tezos_node.rpc_port; _} -> - * sprintf "http://localhost:%d" rpc_port )) - * >>= fun (pg, kiln) -> - * Interactive_test.Pauser.generic state EF.[af "Started Kiln with its DB."] - * ) - * >>= fun (_ : unit option) -> *) Interactive_test.Pauser.add_commands state Interactive_test.Commands.( all_defaults state ~nodes:all_nodes -- GitLab From 90287029cf17d45ebe6c3114fc920cdc4721f6a4 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 10 May 2019 13:16:34 -0400 Subject: [PATCH 46/49] Flextesa: clean-up code --- src/bin_flextesa/command_voting.ml | 8 -------- src/lib_network_sandbox/internal_pervasives.ml | 11 ----------- 2 files changed, 19 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 867abdf81f35..9b6bdd35c683 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -254,12 +254,6 @@ let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec let tmpdir = Paths.root state // sprintf "protocol-%s" name in Console.say state EF.(wf "Injecting protocol from %s" tmpdir) >>= fun () -> - (* -Running_processes.run_successful_cmdf state - "cp -r %s %s && echo '(* Protocol %s *)' >> %s/main.mli" - (Filename.quote demo_path) (Filename.quote tmpdir) name - (Filename.quote tmpdir) - *) Running_processes.run_successful_cmdf state "cp -r %s %s" (Filename.quote path) (Filename.quote tmpdir) >>= fun _ -> @@ -282,8 +276,6 @@ Running_processes.run_successful_cmdf state make_and_inject_protocol ~make_different:(winner_path = demo_path) "demo" demo_path >>= fun demo_hash -> - (* Loop.n_times 3 (fun nth -> make_and_inject_protocol (sprintf "The%dth" nth)) - * >>= fun () -> *) Tezos_admin_client.successful_command admin_0 state ["list"; "protocols"] >>= fun res -> let after_injections_protocols = res#out in diff --git a/src/lib_network_sandbox/internal_pervasives.ml b/src/lib_network_sandbox/internal_pervasives.ml index c4cb278d6174..bf876287b454 100644 --- a/src/lib_network_sandbox/internal_pervasives.ml +++ b/src/lib_network_sandbox/internal_pervasives.ml @@ -360,17 +360,6 @@ module System = struct Lwt_io.with_file ~mode:Lwt_io.input path (fun out -> Lwt_io.read out) ) () - - (* -{json|[ - { "logger":{"Stderr":{}} , "filters": { "SQL":"Error" , "":"Info"}} -]|json} - (* -{ "logger":{"File":{"file":"/var/run/bake-monitor/kiln.log"}}, "filters": { "": "Debug" } } - *) - ) ) - () - *) end (** WIP [jq]-like manipulation in pure OCaml. *) -- GitLab From ee0e9ec42a9b6f13770de8929dfa3bebd56e1681 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Fri, 10 May 2019 14:09:22 -0400 Subject: [PATCH 47/49] Flextesa: fix `--help` of the ledger tests --- src/bin_flextesa/command_ledger_baking.ml | 5 ++--- src/bin_flextesa/command_ledger_wallet.ml | 5 ++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/bin_flextesa/command_ledger_baking.ml b/src/bin_flextesa/command_ledger_baking.ml index 04e4bc75fc6c..ad91860082af 100644 --- a/src/bin_flextesa/command_ledger_baking.ml +++ b/src/bin_flextesa/command_ledger_baking.ml @@ -411,6 +411,5 @@ let cmd ~pp_error () = (opt int 46_000 (info ["base-port"; "P"] ~doc:"Base port number to build upon"))) $ Test_command_line.cli_state ~name:"ledger-baking" () ) - (let doc = "Sandbox networks which record double-bakings" in - let man : Manpage.block list = [`S "LEDGER-BAKING TESTS"] in - info ~man ~doc "ledger-baking") + (let doc = "Interactive test exercising the Ledger Baking app features" in + info ~doc "ledger-baking") diff --git a/src/bin_flextesa/command_ledger_wallet.ml b/src/bin_flextesa/command_ledger_wallet.ml index 3d5bb0447556..8ce228eb5f42 100644 --- a/src/bin_flextesa/command_ledger_wallet.ml +++ b/src/bin_flextesa/command_ledger_wallet.ml @@ -286,6 +286,5 @@ let cmd ~pp_error () = (opt int 46_000 (info ["base-port"; "P"] ~doc:"Base port number to build upon"))) $ Test_command_line.cli_state ~name:"ledger-wallet" () ) - (let doc = "Sandbox networks which record double-bakings" in - let man : Manpage.block list = [`S "LEDGER-WALLET TESTS"] in - info ~man ~doc "ledger-wallet") + (let doc = "Interactive test exercising the Ledger Wallet app features" in + info ~doc "ledger-wallet") -- GitLab From 493b61b5969e18d805eeb5b894be0ef8aa7604e9 Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Wed, 15 May 2019 17:44:30 -0400 Subject: [PATCH 48/49] Flextesa: fix build (rebase error) --- src/bin_flextesa/command_ledger_baking.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/bin_flextesa/command_ledger_baking.ml b/src/bin_flextesa/command_ledger_baking.ml index ad91860082af..1858cf797ba3 100644 --- a/src/bin_flextesa/command_ledger_baking.ml +++ b/src/bin_flextesa/command_ledger_baking.ml @@ -249,8 +249,8 @@ let run state ~node_exec ~client_exec ~admin_exec ~size ~base_port ~uri () = { d with time_between_blocks= [1; 2] ; bootstrap_accounts= - (ledger_account, 1_000_000_000_000) - :: List.map ~f:(fun (a, _) -> (a, 1_000)) d.bootstrap_accounts } + (ledger_account, 1_000_000_000_000L) + :: List.map ~f:(fun (a, _) -> (a, 1_000L)) d.bootstrap_accounts } in Test_scenario.network_with_protocol ~protocol ~size ~base_port state ~node_exec ~client_exec -- GitLab From 9a6d722cb6148c5301b29872ef9068cc19d45cfa Mon Sep 17 00:00:00 2001 From: Sebastien Mondet Date: Wed, 15 May 2019 17:58:20 -0400 Subject: [PATCH 49/49] Flextesa: fix voting test (rebase error) --- src/bin_flextesa/command_voting.ml | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/bin_flextesa/command_voting.ml b/src/bin_flextesa/command_voting.ml index 9b6bdd35c683..850c3e8edfd1 100644 --- a/src/bin_flextesa/command_voting.ml +++ b/src/bin_flextesa/command_voting.ml @@ -254,7 +254,7 @@ let run state ~winner_path ~demo_path ~current_hash ~node_exec ~client_exec let tmpdir = Paths.root state // sprintf "protocol-%s" name in Console.say state EF.(wf "Injecting protocol from %s" tmpdir) >>= fun () -> - Running_processes.run_successful_cmdf state "cp -r %s %s" + Running_processes.run_successful_cmdf state "cp -L -r %s %s" (Filename.quote path) (Filename.quote tmpdir) >>= fun _ -> ( if make_different then @@ -597,19 +597,21 @@ let cmd ~pp_error () = ~clueless_winner ~demo_path ~node_exec ~size ~admin_exec ~base_port ~client_exec ~winner_client_exec ?with_ledger) ) ) $ Arg.( - required - (pos 0 (some string) None - (info [] ~docv:"WINNER-PROTOCOL-PATH" - ~doc: - "The protocol to inject and make win the election, e.g. \ - `src/proto_004_Pt24m4xi/lib_protocol/src`."))) + pure Filename.dirname + $ required + (pos 0 (some string) None + (info [] ~docv:"WINNER-PROTOCOL-PATH" + ~doc: + "The protocol to inject and make win the election, e.g. \ + `src/proto_004_Pt24m4xi/lib_protocol/src/TEZOS_PROTOCOL`."))) $ Arg.( - required - (pos 1 (some string) None - (info [] ~docv:"LOOSER-PROTOCOL-PATH" - ~doc: - "The protocol to inject and down-vote, e.g. \ - `./src/bin_client/test/demo/`."))) + pure Filename.dirname + $ required + (pos 1 (some string) None + (info [] ~docv:"LOOSER-PROTOCOL-PATH" + ~doc: + "The protocol to inject and down-vote, e.g. \ + `./src/bin_client/test/demo/TEZOS_PROTOCOL`."))) $ Tezos_executable.cli_term `Node "current" $ Tezos_executable.cli_term `Client "current" $ Tezos_executable.cli_term `Admin "current" -- GitLab