diff --git a/src/app/test_executive/dune b/src/app/test_executive/dune index 1020b99d7de..35a346a2543 100644 --- a/src/app/test_executive/dune +++ b/src/app/test_executive/dune @@ -1,64 +1,66 @@ (executable (name test_executive) (libraries - ;; opam libraries - async_kernel - async - core - uri - yojson - core_kernel - cmdliner - base.base_internalhash_types - base.caml - async_unix - unsigned_extended - stdio - sexplib0 - ;; local libraries - mina_wire_types - with_hash - data_hash_lib - kimchi_backend - kimchi_backend.pasta - kimchi_backend.pasta.basic - pickles - pickles_types - random_oracle_input - genesis_constants - bash_colors - integration_test_lib - signature_lib - mina_signature_kind - mina_base - mina_stdlib - mina_transaction - file_system - currency - mina_runtime_config - secrets - integration_test_cloud_engine - mina_generators - logger - random_oracle - mina_numbers - transaction_snark - snark_params - pickles.backend - pipe_lib - mina_base.import - key_gen - integers - user_command_input - participating_state - graph_algorithms - visualization - sgn - zkapp_command_builder - network_pool - zkapps_examples - cache_dir - snarky.backendless - ) - (instrumentation (backend bisect_ppx)) - (preprocess (pps ppx_mina ppx_jane ppx_deriving_yojson ppx_mina ppx_version))) + ;; opam libraries + async_kernel + async + core + uri + yojson + core_kernel + cmdliner + base.base_internalhash_types + base.caml + async_unix + unsigned_extended + stdio + sexplib0 + ;; local libraries + mina_wire_types + with_hash + data_hash_lib + kimchi_backend + kimchi_backend.pasta + kimchi_backend.pasta.basic + pickles + pickles_types + random_oracle_input + genesis_constants + bash_colors + integration_test_lib + signature_lib + mina_signature_kind + mina_base + mina_stdlib + mina_transaction + file_system + currency + mina_runtime_config + secrets + integration_test_cloud_engine + integration_test_local_engine + mina_generators + logger + random_oracle + mina_numbers + transaction_snark + snark_params + pickles.backend + pipe_lib + mina_base.import + key_gen + integers + user_command_input + participating_state + graph_algorithms + visualization + sgn + zkapp_command_builder + network_pool + zkapps_examples + cache_dir + snarky.backendless) + (instrumentation + (backend bisect_ppx)) + (preprocess + (pps ppx_mina ppx_jane ppx_deriving_yojson ppx_mina ppx_version))) diff --git a/src/app/test_executive/test_executive.ml b/src/app/test_executive/test_executive.ml index 583317827b5..fbb83d59158 100644 --- a/src/app/test_executive/test_executive.ml +++ b/src/app/test_executive/test_executive.ml @@ -47,7 +47,9 @@ let validate_inputs ~logger inputs (test_config : Test_config.t) : else Deferred.return () let engines : engine list = - [ ("cloud", (module Integration_test_cloud_engine : Intf.Engine.S)) ] + [ ("cloud", (module Integration_test_cloud_engine : Intf.Engine.S)) + ; ("local", (module Integration_test_local_engine : Intf.Engine.S)) + ] let tests : test list = [ ( "peers-reliability" diff --git a/src/dune-project b/src/dune-project index c4eddd53731..bce2fc4f74b 100644 --- a/src/dune-project +++ b/src/dune-project @@ -69,6 +69,7 @@ (package (name inline_test_quiet_logs)) (package (name integers_stubs_js)) (package (name integration_test_cloud_engine)) +(package (name integration_test_local_engine)) (package (name integration_test_lib)) (package (name internal_tracing)) (package (name interpolator_lib)) diff --git a/src/lib/integration_test_cloud_engine/dune b/src/lib/integration_test_cloud_engine/dune index 6f50aefc782..2757ed63d07 100644 --- a/src/lib/integration_test_cloud_engine/dune +++ b/src/lib/integration_test_cloud_engine/dune @@ -1,59 +1,70 @@ (library (public_name integration_test_cloud_engine) (name integration_test_cloud_engine) - (inline_tests (flags -verbose -show-counts)) - (instrumentation (backend bisect_ppx)) - (preprocessor_deps ../../graphql-ppx-config.inc ../../../graphql_schema.json) - (preprocess (pps - ppx_here - ppx_mina ppx_version ppx_let ppx_inline_test ppx_pipebang - ppx_custom_printf ppx_deriving_yojson lens.ppx_deriving - ppx_sexp_conv - graphql_ppx -- %{read-lines:../../graphql-ppx-config.inc})) -(libraries - ;; opam libraries - async_unix - async_kernel - core_kernel - core - async - cmdliner - base - uri - sexplib0 - stdio - result - base.caml - integers - re2 - ;; local libraries - key_gen - integration_test_lib - graphql_lib - mina_runtime_config - mina_base - genesis_constants - genesis_ledger_helper - logger - mina_base_import - signature_lib - currency - mina_version - timeout_lib - mina_numbers - mina_state - mina_stdlib - mina_transaction - file_system - pickles - pickles_types - backend - kimchi_pasta - kimchi_backend.pasta.basic - with_hash - data_hash_lib - generated_graphql_queries - mina_graphql - error_json - ) -) + (inline_tests + (flags -verbose -show-counts)) + (instrumentation + (backend bisect_ppx)) + (preprocessor_deps + ../../graphql-ppx-config.inc + ../../../graphql_schema.json) + (preprocess + (pps + ppx_here + ppx_mina + ppx_version + ppx_let + ppx_inline_test + ppx_pipebang + ppx_custom_printf + ppx_deriving_yojson + lens.ppx_deriving + ppx_sexp_conv + graphql_ppx + -- + %{read-lines:../../graphql-ppx-config.inc})) + (libraries + ;; opam libraries + async_unix + async_kernel + core_kernel + core + async + cmdliner + base + uri + sexplib0 + stdio + result + base.caml + integers + re2 + ;; local libraries + key_gen + integration_test_lib + graphql_lib + mina_runtime_config + mina_base + genesis_constants + genesis_ledger_helper + logger + mina_base_import + signature_lib + currency + mina_version + timeout_lib + mina_numbers + mina_state + mina_stdlib + mina_transaction + file_system + pickles + pickles_types + backend + kimchi_pasta + kimchi_backend.pasta.basic + with_hash + data_hash_lib + generated_graphql_queries + mina_graphql + error_json)) diff --git a/src/lib/integration_test_cloud_engine/graphql_polling_log_engine.ml b/src/lib/integration_test_cloud_engine/graphql_polling_log_engine.ml deleted file mode 100644 index 42d23e91dcd..00000000000 --- a/src/lib/integration_test_cloud_engine/graphql_polling_log_engine.ml +++ /dev/null @@ -1,142 +0,0 @@ -open Async -open Core -open Integration_test_lib -module Timeout = Timeout_lib.Core_time -module Node = Kubernetes_network.Node - -(** This implements Log_engine_intf for integration tests, by creating a simple system that polls a mina daemon's graphql endpoint for fetching logs*) - -let log_filter_of_event_type ev_existential = - let open Event_type in - let (Event_type ev_type) = ev_existential in - let (module Ty) = event_type_module ev_type in - match Ty.parse with - | From_error_log _ -> - [] (* TODO: Do we need this? *) - | From_daemon_log (struct_id, _) -> - [ Structured_log_events.string_of_id struct_id ] - | From_puppeteer_log _ -> - [] -(* TODO: Do we need this? *) - -let all_event_types_log_filter = - List.bind ~f:log_filter_of_event_type Event_type.all_event_types - -type t = - { logger : Logger.t - ; event_writer : (Node.t * Event_type.event) Pipe.Writer.t - ; event_reader : (Node.t * Event_type.event) Pipe.Reader.t - ; background_job : unit Deferred.Or_error.t - } - -let event_reader { event_reader; _ } = event_reader - -let parse_event_from_log_entry ~logger log_entry = - let open Or_error.Let_syntax in - let open Json_parsing in - Or_error.try_with_join (fun () -> - let payload = Yojson.Safe.from_string log_entry in - let%map event = - let%bind msg = - parse (parser_from_of_yojson Logger.Message.of_yojson) payload - in - let event_id = - Option.map ~f:Structured_log_events.string_of_id msg.event_id - in - [%log spam] "parsing daemon structured event, event_id = $event_id" - ~metadata:[ ("event_id", [%to_yojson: string option] event_id) ] ; - match msg.event_id with - | Some _ -> - Event_type.parse_daemon_event msg - | None -> - (* Currently unreachable, but we could include error logs here if - desired. - *) - Event_type.parse_error_log msg - in - event ) - -let rec filtered_log_entries_poll node ~logger ~event_writer - ~last_log_index_seen = - let open Deferred.Let_syntax in - if not (Pipe.is_closed event_writer) then ( - let%bind () = after (Time.Span.of_ms 10000.0) in - match%bind - Integration_test_lib.Graphql_requests.get_filtered_log_entries - (Node.get_ingress_uri node) - ~last_log_index_seen - with - | Ok log_entries -> - Array.iter log_entries ~f:(fun log_entry -> - match parse_event_from_log_entry ~logger log_entry with - | Ok a -> - Pipe.write_without_pushback_if_open event_writer (node, a) - | Error e -> - [%log warn] "Error parsing log $error" - ~metadata:[ ("error", `String (Error.to_string_hum e)) ] ) ; - let last_log_index_seen = - Array.length log_entries + last_log_index_seen - in - filtered_log_entries_poll node ~logger ~event_writer - ~last_log_index_seen - | Error err -> - [%log error] "Encountered an error while polling $node for logs: $err" - ~metadata: - [ ("node", `String (Node.infra_id node)) - ; ("err", Error_json.error_to_yojson err) - ] ; - (* Declare the node to be offline. *) - Pipe.write_without_pushback_if_open event_writer - (node, Event (Node_offline, ())) ; - (* Don't keep looping, the node may be restarting. *) - return (Ok ()) ) - else Deferred.Or_error.error_string "Event writer closed" - -let rec start_filtered_log node ~logger ~log_filter ~event_writer = - let open Deferred.Let_syntax in - if not (Pipe.is_closed event_writer) then - match%bind - Integration_test_lib.Graphql_requests.start_filtered_log ~logger - ~log_filter - (Node.get_ingress_uri node) - with - | Ok () -> - return (Ok ()) - | Error _ -> - start_filtered_log node ~logger ~log_filter ~event_writer - else Deferred.Or_error.error_string "Event writer closed" - -let rec poll_node_for_logs_in_background ~log_filter ~logger ~event_writer - (node : Node.t) = - let open Deferred.Or_error.Let_syntax in - [%log info] "Requesting for $node to start its filtered logs" - ~metadata:[ ("node", `String (Node.infra_id node)) ] ; - let%bind () = start_filtered_log ~logger ~log_filter ~event_writer node in - [%log info] "$node has started its filtered logs. Beginning polling" - ~metadata:[ ("node", `String (Node.infra_id node)) ] ; - let%bind () = - filtered_log_entries_poll node ~last_log_index_seen:0 ~logger ~event_writer - in - poll_node_for_logs_in_background ~log_filter ~logger ~event_writer node - -let poll_for_logs_in_background ~log_filter ~logger ~network ~event_writer = - Kubernetes_network.all_nodes network - |> Core.String.Map.data - |> Deferred.Or_error.List.iter ~how:`Parallel - ~f:(poll_node_for_logs_in_background ~log_filter ~logger ~event_writer) - -let create ~logger ~(network : Kubernetes_network.t) = - let open Deferred.Or_error.Let_syntax in - let log_filter = all_event_types_log_filter in - let event_reader, event_writer = Pipe.create () in - let background_job = - poll_for_logs_in_background ~log_filter ~logger ~network ~event_writer - in - return { logger; event_reader; event_writer; background_job } - -let destroy t : unit Deferred.Or_error.t = - let open Deferred.Or_error.Let_syntax in - let { logger; event_reader = _; event_writer; background_job = _ } = t in - Pipe.close event_writer ; - [%log debug] "graphql polling log engine destroyed" ; - return () diff --git a/src/lib/integration_test_cloud_engine/graphql_polling_log_engine.mli b/src/lib/integration_test_cloud_engine/graphql_polling_log_engine.mli deleted file mode 100644 index 1dbef606c1a..00000000000 --- a/src/lib/integration_test_cloud_engine/graphql_polling_log_engine.mli +++ /dev/null @@ -1,3 +0,0 @@ -include - Integration_test_lib.Intf.Engine.Log_engine_intf - with module Network := Kubernetes_network diff --git a/src/lib/integration_test_cloud_engine/integration_test_cloud_engine.ml b/src/lib/integration_test_cloud_engine/integration_test_cloud_engine.ml index 64f71860422..df72e1e1812 100644 --- a/src/lib/integration_test_cloud_engine/integration_test_cloud_engine.ml +++ b/src/lib/integration_test_cloud_engine/integration_test_cloud_engine.ml @@ -3,4 +3,13 @@ let name = "cloud" module Network = Kubernetes_network module Network_config = Mina_automation.Network_config module Network_manager = Mina_automation.Network_manager -module Log_engine = Graphql_polling_log_engine + +module Kubernetes_polling_interval = struct + let start_filtered_logs_interval = Core.Time.Span.of_sec 10.0 +end + +module Log_engine = + Integration_test_lib.Graphql_polling_log_engine + .Make_GraphQL_polling_log_engine + (Kubernetes_network) + (Kubernetes_polling_interval) diff --git a/src/lib/integration_test_lib/dune b/src/lib/integration_test_lib/dune index 54381e3d9ad..2b50d04a6c9 100644 --- a/src/lib/integration_test_lib/dune +++ b/src/lib/integration_test_lib/dune @@ -61,4 +61,5 @@ transition_handler snark_worker one_or_two + error_json )) diff --git a/src/lib/integration_test_lib/graphql_polling_log_engine.ml b/src/lib/integration_test_lib/graphql_polling_log_engine.ml new file mode 100644 index 00000000000..e344df952f9 --- /dev/null +++ b/src/lib/integration_test_lib/graphql_polling_log_engine.ml @@ -0,0 +1,149 @@ +open Async +open Core +module Timeout = Timeout_lib.Core_time + +(** This implements Log_engine_intf for integration tests, by creating a simple system that polls a mina daemon's graphql endpoint for fetching logs*) + +module Make_GraphQL_polling_log_engine + (Network : Intf.Engine.Network_intf) (Polling_interval : sig + val start_filtered_logs_interval : Time.Span.t + end) = +struct + module Node = Network.Node + + let log_filter_of_event_type ev_existential = + let open Event_type in + let (Event_type ev_type) = ev_existential in + let (module Ty) = event_type_module ev_type in + match Ty.parse with + | From_error_log _ -> + [] (* TODO: Do we need this? *) + | From_daemon_log (struct_id, _) -> + [ Structured_log_events.string_of_id struct_id ] + | From_puppeteer_log _ -> + [] + (* TODO: Do we need this? *) + + let all_event_types_log_filter = + List.bind ~f:log_filter_of_event_type Event_type.all_event_types + + type t = + { logger : Logger.t + ; event_writer : (Node.t * Event_type.event) Pipe.Writer.t + ; event_reader : (Node.t * Event_type.event) Pipe.Reader.t + ; background_job : unit Deferred.Or_error.t + } + + let event_reader { event_reader; _ } = event_reader + + let parse_event_from_log_entry ~logger log_entry = + let open Or_error.Let_syntax in + let open Json_parsing in + Or_error.try_with_join (fun () -> + let payload = Yojson.Safe.from_string log_entry in + let%map event = + let%bind msg = + parse (parser_from_of_yojson Logger.Message.of_yojson) payload + in + let event_id = + Option.map ~f:Structured_log_events.string_of_id msg.event_id + in + [%log spam] "parsing daemon structured event, event_id = $event_id" + ~metadata:[ ("event_id", [%to_yojson: string option] event_id) ] ; + match msg.event_id with + | Some _ -> + Event_type.parse_daemon_event msg + | None -> + (* Currently unreachable, but we could include error logs here if + desired. + *) + Event_type.parse_error_log msg + in + event ) + + let rec filtered_log_entries_poll node ~logger ~event_writer + ~last_log_index_seen = + let open Deferred.Let_syntax in + if not (Pipe.is_closed event_writer) then ( + let%bind () = after (Time.Span.of_ms 10000.0) in + match%bind + Graphql_requests.get_filtered_log_entries + (Node.get_ingress_uri node) + ~last_log_index_seen + with + | Ok log_entries -> + Array.iter log_entries ~f:(fun log_entry -> + match parse_event_from_log_entry ~logger log_entry with + | Ok a -> + Pipe.write_without_pushback_if_open event_writer (node, a) + | Error e -> + [%log warn] "Error parsing log $error" + ~metadata:[ ("error", `String (Error.to_string_hum e)) ] ) ; + let last_log_index_seen = + Array.length log_entries + last_log_index_seen + in + filtered_log_entries_poll node ~logger ~event_writer + ~last_log_index_seen + | Error err -> + [%log error] "Encountered an error while polling $node for logs: $err" + ~metadata: + [ ("node", `String (Node.infra_id node)) + ; ("err", Error_json.error_to_yojson err) + ] ; + (* Declare the node to be offline. *) + Pipe.write_without_pushback_if_open event_writer + (node, Event (Node_offline, ())) ; + (* Don't keep looping, the node may be restarting. *) + return (Ok ()) ) + else Deferred.Or_error.error_string "Event writer closed" + + let rec start_filtered_log node ~logger ~log_filter ~event_writer = + let open Deferred.Let_syntax in + if not (Pipe.is_closed event_writer) then + match%bind + Graphql_requests.start_filtered_log ~logger ~log_filter + ~retry_delay_sec: + (Polling_interval.start_filtered_logs_interval |> Time.Span.to_sec) + (Node.get_ingress_uri node) + with + | Ok () -> + return (Ok ()) + | Error _ -> + start_filtered_log node ~logger ~log_filter ~event_writer + else Deferred.Or_error.error_string "Event writer closed" + + let rec poll_node_for_logs_in_background ~log_filter ~logger ~event_writer + (node : Node.t) = + let open Deferred.Or_error.Let_syntax in + [%log info] "Requesting for $node to start its filtered logs" + ~metadata:[ ("node", `String (Node.infra_id node)) ] ; + let%bind () = start_filtered_log ~logger ~log_filter ~event_writer node in + [%log info] "$node has started its filtered logs. Beginning polling" + ~metadata:[ ("node", `String (Node.infra_id node)) ] ; + let%bind () = + filtered_log_entries_poll node ~last_log_index_seen:0 ~logger + ~event_writer + in + poll_node_for_logs_in_background ~log_filter ~logger ~event_writer node + + let poll_for_logs_in_background ~log_filter ~logger ~network ~event_writer = + Network.all_nodes network |> Core.String.Map.data + |> Deferred.Or_error.List.iter ~how:`Parallel + ~f:(poll_node_for_logs_in_background ~log_filter ~logger ~event_writer) + + let create ~logger ~(network : Network.t) = + let open Deferred.Or_error.Let_syntax in + let log_filter = all_event_types_log_filter in + let event_reader, event_writer = Pipe.create () in + let background_job = + poll_for_logs_in_background ~log_filter ~logger ~network ~event_writer + in + return { logger; event_reader; event_writer; background_job } + + let destroy t : unit Deferred.Or_error.t = + let open Deferred.Or_error.Let_syntax in + let { logger; event_reader = _; event_writer; background_job = _ } = t in + Pipe.close event_writer ; + [%log debug] "graphql polling log engine destroyed" ; + return () +end diff --git a/src/lib/integration_test_lib/graphql_requests.ml b/src/lib/integration_test_lib/graphql_requests.ml index 2cbcefb263d..e64c03a9a8c 100644 --- a/src/lib/integration_test_lib/graphql_requests.ml +++ b/src/lib/integration_test_lib/graphql_requests.ml @@ -1077,14 +1077,14 @@ let get_metrics ~logger node_uri = ; transaction_pool_size } -let start_filtered_log ~logger ~log_filter node_uri = +let start_filtered_log node_uri ~logger ~log_filter ~retry_delay_sec = let open Deferred.Let_syntax in let query_obj = Graphql.StartFilteredLog.(make @@ makeVariables ~filter:log_filter ()) in let%bind res = - exec_graphql_request ~logger:(Logger.null ()) ~retry_delay_sec:10.0 - ~node_uri ~query_name:"StartFilteredLog" query_obj + exec_graphql_request ~logger:(Logger.null ()) ~retry_delay_sec ~node_uri + ~query_name:"StartFilteredLog" query_obj in match res with | Ok query_result_obj -> diff --git a/src/lib/integration_test_local_engine/cli_inputs.ml b/src/lib/integration_test_local_engine/cli_inputs.ml new file mode 100644 index 00000000000..b0382124fa8 --- /dev/null +++ b/src/lib/integration_test_local_engine/cli_inputs.ml @@ -0,0 +1,5 @@ +open Cmdliner + +type t = unit + +let term = Term.const () diff --git a/src/lib/integration_test_local_engine/docker_compose.ml b/src/lib/integration_test_local_engine/docker_compose.ml new file mode 100644 index 00000000000..9faffd82c99 --- /dev/null +++ b/src/lib/integration_test_local_engine/docker_compose.ml @@ -0,0 +1,81 @@ +open Core_kernel +open Integration_test_lib + +module Dockerfile = struct + module Service = struct + module Volume = struct + type t = + { type_ : string [@key "type"]; source : string; target : string } + [@@deriving to_yojson] + + let create source target = { type_ = "bind"; source; target } + end + + module Environment = struct + type t = (string * string) list + + let to_yojson env = `Assoc (List.map env ~f:(fun (k, v) -> (k, `String v))) + end + + module Port = struct + type t = { published : int; target : int } [@@deriving to_yojson] + + let create ~published ~target = { published; target } + end + + type t = + { image : string + ; command : string list + ; entrypoint : string list option + [@to_yojson + fun j -> + match j with + | Some v -> + `List (List.map (fun s -> `String s) v) + | None -> + `Null] + ; ports : Port.t list + ; environment : Environment.t + ; volumes : Volume.t list + } + [@@deriving to_yojson] + + let create ~image ~command ~entrypoint ~ports ~environment ~volumes = + { image; command; entrypoint; ports; environment; volumes } + + let to_yojson { image; command; entrypoint; ports; environment; volumes } = + `Assoc + ( [ ("image", `String image) + ; ("command", `List (List.map ~f:(fun s -> `String s) command)) + ; ("ports", `List (List.map ~f:Port.to_yojson ports)) + ; ("environment", Environment.to_yojson environment) + ; ("volumes", `List (List.map ~f:Volume.to_yojson volumes)) + ] + @ + match entrypoint with + | Some ep -> + [ ("entrypoint", `List (List.map ~f:(fun s -> `String s) ep)) ] + | None -> + [] ) + end + + module StringMap = Map.Make (String) + + type service_map = Service.t StringMap.t + + let merge (m1 : service_map) (m2 : service_map) = + Base.Map.merge_skewed m1 m2 ~combine:(fun ~key:_ left _ -> left) + + let service_map_to_yojson m = + `Assoc (m |> Map.map ~f:Service.to_yojson |> Map.to_alist) + + type t = { version : string; services : service_map } [@@deriving to_yojson] + + let to_string = Fn.compose Yojson.Safe.pretty_to_string to_yojson + + let write_config t ~dir ~filename = + Out_channel.with_file ~fail_if_exists:false + (dir ^ "/" ^ filename) + ~f:(fun ch -> t |> to_string |> Out_channel.output_string ch) ; + Util.run_cmd_exn dir "chmod" [ "600"; filename ] +end diff --git a/src/lib/integration_test_local_engine/docker_network.ml b/src/lib/integration_test_local_engine/docker_network.ml new file mode 100644 index 00000000000..4deb1de6234 --- /dev/null +++ b/src/lib/integration_test_local_engine/docker_network.ml @@ -0,0 +1,330 @@ +open Core_kernel +open Async +open Integration_test_lib + +let get_container_id service_id = + let%bind cwd = Unix.getcwd () in + let open Malleable_error.Let_syntax in + let%bind container_ids = + Deferred.bind ~f:Malleable_error.or_hard_error + (Integration_test_lib.Util.run_cmd_or_error cwd "docker" + [ "ps"; "-f"; sprintf "name=%s" service_id; "--quiet" ] ) + in + let container_id_list = String.split container_ids ~on:'\n' in + match container_id_list with + | [] -> + Malleable_error.hard_error_format "No container id found for service %s" + service_id + | raw_container_id :: _ -> + return (String.strip raw_container_id) + +let run_in_container ?(exit_code = 10) container_id ~cmd = + let%bind.Deferred cwd = Unix.getcwd () in + Integration_test_lib.Util.run_cmd_or_hard_error ~exit_code cwd "docker" + ([ "exec"; container_id ] @ cmd) + +module Node = struct + type config = + { network_keypair : Network_keypair.t option + ; service_id : string + ; postgres_connection_uri : string option + ; graphql_port : int + } + + type t = { config : config; mutable should_be_running : bool } + + let id { config; _ } = config.service_id + + let infra_id { config; _ } = config.service_id + + let should_be_running { should_be_running; _ } = should_be_running + + let network_keypair { config; _ } = config.network_keypair + + let get_ingress_uri node = + Uri.make ~scheme:"http" ~host:"127.0.0.1" ~path:"/graphql" + ~port:node.config.graphql_port () + + let get_container_index_from_service_name service_name = + match String.split_on_chars ~on:[ '_' ] service_name with + | _ :: value :: _ -> + value + | _ -> + failwith "get_container_index_from_service_name: bad service name" + + let dump_archive_data ~logger (t : t) ~data_file = + let service_name = t.config.service_id in + match t.config.postgres_connection_uri with + | None -> + failwith + (sprintf "dump_archive_data: %s not an archive container" service_name) + | Some postgres_uri -> + let open Malleable_error.Let_syntax in + let%bind container_id = get_container_id service_name in + [%log info] "Dumping archive data from (node: %s, container: %s)" + service_name container_id ; + let%map data = + run_in_container container_id + ~cmd:[ "pg_dump"; "--create"; "--no-owner"; postgres_uri ] + in + [%log info] "Dumping archive data to file %s" data_file ; + Out_channel.with_file data_file ~f:(fun out_ch -> + Out_channel.output_string out_ch data ) + + let get_logs_in_container container_id = + let%bind.Deferred cwd = Unix.getcwd () in + Integration_test_lib.Util.run_cmd_or_hard_error ~exit_code:13 cwd "docker" + [ "logs"; container_id ] + + let dump_mina_logs ~logger (t : t) ~log_file = + let open Malleable_error.Let_syntax in + let%bind container_id = get_container_id t.config.service_id in + [%log info] "Dumping mina logs from (node: %s, container: %s)" + t.config.service_id container_id ; + let%map logs = get_logs_in_container container_id in + [%log info] "Dumping mina logs to file %s" log_file ; + Out_channel.with_file log_file ~f:(fun out_ch -> + Out_channel.output_string out_ch logs ) + + let cp_string_to_container_file container_id ~str ~dest = + let tmp_file, oc = + Caml.Filename.open_temp_file ~temp_dir:Filename.temp_dir_name + "integration_test_cp_string" ".tmp" + in + Out_channel.output_string oc str ; + Out_channel.close oc ; + let%bind cwd = Unix.getcwd () in + let dest_file = sprintf "%s:%s" container_id dest in + Integration_test_lib.Util.run_cmd_or_error cwd "docker" + [ "cp"; tmp_file; dest_file ] + + let run_replayer ?(start_slot_since_genesis = 0) ~logger (t : t) = + let open Malleable_error.Let_syntax in + let%bind container_id = get_container_id t.config.service_id in + [%log info] "Running replayer on (node: %s, container: %s)" + t.config.service_id container_id ; + let%bind accounts = + run_in_container container_id + ~cmd:[ "jq"; "-c"; ".ledger.accounts"; "/root/runtime_config.json" ] + in + let replayer_input = + sprintf + {| { "start_slot_since_genesis": %d, + "genesis_ledger": { "accounts": %s, "add_genesis_winner": true }} |} + start_slot_since_genesis accounts + in + let dest = "replayer-input.json" in + let%bind archive_container_id = get_container_id "archive" in + let%bind () = + Deferred.bind ~f:Malleable_error.return + (cp_string_to_container_file archive_container_id ~str:replayer_input + ~dest ) + >>| ignore + in + let postgres_url = Option.value_exn t.config.postgres_connection_uri in + run_in_container container_id + ~cmd: + [ "mina-replayer" + ; "--archive-uri" + ; postgres_url + ; "--input-file" + ; dest + ; "--output-file" + ; "/dev/null" + ; "--continue-on-error" + ] + + let dump_precomputed_blocks ~logger (t : t) = + let open Malleable_error.Let_syntax in + let container_id = t.config.service_id in + [%log info] + "Dumping precomputed blocks from logs for (node: %s, container: %s)" + t.config.service_id container_id ; + let%bind logs = get_logs_in_container container_id in + (* kubectl logs may include non-log output, like "Using password from environment variable" *) + let log_lines = + String.split logs ~on:'\n' + |> List.filter ~f:(String.is_prefix ~prefix:"{\"timestamp\":") + in + let jsons = List.map log_lines ~f:Yojson.Safe.from_string in + let metadata_jsons = + List.map jsons ~f:(fun json -> + match json with + | `Assoc items -> ( + match List.Assoc.find items ~equal:String.equal "metadata" with + | Some md -> + md + | None -> + failwithf "Log line is missing metadata: %s" + (Yojson.Safe.to_string json) + () ) + | other -> + failwithf "Expected log line to be a JSON record, got: %s" + (Yojson.Safe.to_string other) + () ) + in + let state_hash_and_blocks = + List.fold metadata_jsons ~init:[] ~f:(fun acc json -> + match json with + | `Assoc items -> ( + match + List.Assoc.find items ~equal:String.equal "precomputed_block" + with + | Some block -> ( + match + List.Assoc.find items ~equal:String.equal "state_hash" + with + | Some state_hash -> + (state_hash, block) :: acc + | None -> + failwith + "Log metadata contains a precomputed block, but no \ + state hash" ) + | None -> + acc ) + | other -> + failwithf "Expected log line to be a JSON record, got: %s" + (Yojson.Safe.to_string other) + () ) + in + let%bind.Deferred () = + Deferred.List.iter state_hash_and_blocks + ~f:(fun (state_hash_json, block_json) -> + let double_quoted_state_hash = + Yojson.Safe.to_string state_hash_json + in + let state_hash = + String.sub double_quoted_state_hash ~pos:1 + ~len:(String.length double_quoted_state_hash - 2) + in + let block = Yojson.Safe.pretty_to_string block_json in + let filename = state_hash ^ ".json" in + match%map.Deferred Sys.file_exists filename with + | `Yes -> + [%log info] + "File already exists for precomputed block with state hash %s" + state_hash + | _ -> + [%log info] + "Dumping precomputed block with state hash %s to file %s" + state_hash filename ; + Out_channel.with_file filename ~f:(fun out_ch -> + Out_channel.output_string out_ch block ) ) + in + Malleable_error.return () + + let start ~fresh_state node : unit Malleable_error.t = + let open Malleable_error.Let_syntax in + let%bind container_id = get_container_id node.config.service_id in + node.should_be_running <- true ; + let%bind () = + if fresh_state then + run_in_container container_id ~cmd:[ "rm"; "-rf"; ".mina-config/*" ] + >>| ignore + else Malleable_error.return () + in + run_in_container ~exit_code:11 container_id ~cmd:[ "/start.sh" ] >>| ignore + + let stop node = + let open Malleable_error.Let_syntax in + let%bind container_id = get_container_id node.config.service_id in + node.should_be_running <- false ; + run_in_container ~exit_code:12 container_id ~cmd:[ "/stop.sh" ] >>| ignore +end + +module Service_to_deploy = struct + type config = + { network_keypair : Network_keypair.t option + ; postgres_connection_uri : string option + ; graphql_port : int + } + + type t = { stack_name : string; service_name : string; config : config } + + let construct_service stack_name service_name config : t = + { stack_name; service_name; config } + + let init_service_to_deploy_config ?(network_keypair = None) + ?(postgres_connection_uri = None) ~graphql_port = + { network_keypair; postgres_connection_uri; graphql_port } + + let get_node_from_service t = + let open Malleable_error.Let_syntax in + let service_id = sprintf "%s_%s" t.stack_name t.service_name in + let%bind container_id = get_container_id service_id in + if String.is_empty container_id then + Malleable_error.hard_error_format "No container id found for service %s" + t.service_name + else + return + { Node.config = + { service_id + ; network_keypair = t.config.network_keypair + ; postgres_connection_uri = t.config.postgres_connection_uri + ; graphql_port = t.config.graphql_port + } + ; should_be_running = false + } +end + +type t = + { namespace : string + ; constants : Test_config.constants + ; seeds : Node.t Core.String.Map.t + ; block_producers : Node.t Core.String.Map.t + ; snark_coordinators : Node.t Core.String.Map.t + ; snark_workers : Node.t Core.String.Map.t + ; archive_nodes : Node.t Core.String.Map.t + ; genesis_keypairs : Network_keypair.t Core.String.Map.t + } + +let constants { constants; _ } = constants + +let constraint_constants { constants; _ } = constants.constraints + +let genesis_constants { constants; _ } = constants.genesis + +let seeds { seeds; _ } = seeds + +let block_producers { block_producers; _ } = block_producers + +let snark_coordinators { snark_coordinators; _ } = snark_coordinators + +let archive_nodes { archive_nodes; _ } = archive_nodes + +let all_mina_nodes { seeds; block_producers; snark_coordinators; _ } = + List.concat + [ Core.String.Map.to_alist seeds + ; Core.String.Map.to_alist block_producers + ; Core.String.Map.to_alist snark_coordinators + ] + |> Core.String.Map.of_alist_exn + +let all_nodes t = + List.concat + [ Core.String.Map.to_alist t.seeds + ; Core.String.Map.to_alist t.block_producers + ; Core.String.Map.to_alist t.snark_coordinators + ; Core.String.Map.to_alist t.snark_workers + ] + |> Core.String.Map.of_alist_exn + +let all_non_seed_nodes t = + List.concat + [ Core.String.Map.to_alist t.block_producers + ; Core.String.Map.to_alist t.snark_coordinators + ; Core.String.Map.to_alist t.snark_workers + ] + |> Core.String.Map.of_alist_exn + +let genesis_keypairs { genesis_keypairs; _ } = genesis_keypairs + +let all_ids t = + let deployments = all_nodes t |> Core.Map.to_alist in + List.fold deployments ~init:[] ~f:(fun acc (_, node) -> + List.cons node.config.service_id acc ) + +let initialize_infra ~logger network = + let _ = logger in + let _ = network in + Malleable_error.return () diff --git a/src/lib/integration_test_local_engine/docker_node_config.ml b/src/lib/integration_test_local_engine/docker_node_config.ml new file mode 100644 index 00000000000..bbdd0cb8773 --- /dev/null +++ b/src/lib/integration_test_local_engine/docker_node_config.ml @@ -0,0 +1,570 @@ +open Core_kernel +open Async +open Integration_test_lib +open Docker_compose + +module PortManager = struct + let mina_internal_rest_port = 3085 + + let mina_internal_client_port = 8301 + + let mina_internal_metrics_port = 10001 + + let mina_internal_server_port = 3086 + + let mina_internal_external_port = 10101 + + let postgres_internal_port = 5432 + + type t = + { mutable available_ports : int list + ; mutable used_ports : int list + ; min_port : int + ; max_port : int + } + + let create ~min_port ~max_port = + let available_ports = List.range min_port max_port in + { available_ports; used_ports = []; min_port; max_port } + + let allocate_port t = + match t.available_ports with + | [] -> + failwith "No available ports" + | port :: rest -> + t.available_ports <- rest ; + t.used_ports <- port :: t.used_ports ; + port + + let allocate_ports_for_node t = + let rest_port_source = allocate_port t in + let client_port_source = allocate_port t in + let metrics_port_source = allocate_port t in + [ { Dockerfile.Service.Port.published = rest_port_source + ; target = mina_internal_rest_port + } + ; { published = client_port_source; target = mina_internal_client_port } + ; { published = metrics_port_source; target = mina_internal_metrics_port } + ] + + let release_port t port = + t.used_ports <- List.filter t.used_ports ~f:(fun p -> p <> port) ; + t.available_ports <- port :: t.available_ports + + let get_latest_used_port t = + match t.used_ports with [] -> failwith "No used ports" | port :: _ -> port +end + +module Base_node_config = struct + type t = + { peer : string option + ; log_level : string + ; log_snark_work_gossip : bool + ; log_txn_pool_gossip : bool + ; generate_genesis_proof : bool + ; client_port : string + ; rest_port : string + ; external_port : string + ; metrics_port : string + ; runtime_config_path : string option + ; libp2p_key_path : string + ; libp2p_secret : string + } + [@@deriving to_yojson] + + let container_runtime_config_path = "/root/runtime_config.json" + + let container_entrypoint_path = "/root/entrypoint.sh" + + let container_keys_path = "/root/keys" + + let container_libp2p_key_path = container_keys_path ^ "/libp2p_key" + + let entrypoint_script = + ( "entrypoint.sh" + , {|#!/bin/bash + # This file is auto-generated by the local integration test framework. + # Path to the libp2p_key file + LIBP2P_KEY_PATH="|} + ^ container_libp2p_key_path + ^ {|" + # Generate keypair and set permissions if libp2p_key does not exist + if [ ! -f "$LIBP2P_KEY_PATH" ]; then + mina libp2p generate-keypair --privkey-path $LIBP2P_KEY_PATH + fi + /bin/chmod -R 700 |} + ^ container_keys_path ^ {|/ + # Import any compatible keys in |} + ^ container_keys_path ^ {|/*, excluding certain keys + for key_file in |} + ^ container_keys_path + ^ {|/*; do + # Exclude specific keys (e.g., libp2p keys) + if [[ $(basename "$key_file") != "libp2p_key" ]]; then + mina accounts import -config-directory /root/.mina-config -privkey-path "$key_file" + fi + done + # Execute the puppeteer script + exec /mina_daemon_puppeteer.py "$@" + |} + ) + + let runtime_config_volume : Docker_compose.Dockerfile.Service.Volume.t = + { type_ = "bind" + ; source = "runtime_config.json" + ; target = container_runtime_config_path + } + + let entrypoint_volume : Docker_compose.Dockerfile.Service.Volume.t = + { type_ = "bind" + ; source = "entrypoint.sh" + ; target = container_entrypoint_path + } + + let default ?(runtime_config_path = None) ?(peer = None) = + { runtime_config_path + ; peer + ; log_snark_work_gossip = true + ; log_txn_pool_gossip = true + ; generate_genesis_proof = true + ; log_level = "Debug" + ; client_port = PortManager.mina_internal_client_port |> Int.to_string + ; rest_port = PortManager.mina_internal_rest_port |> Int.to_string + ; metrics_port = PortManager.mina_internal_metrics_port |> Int.to_string + ; external_port = PortManager.mina_internal_external_port |> Int.to_string + ; libp2p_key_path = container_libp2p_key_path + ; libp2p_secret = "" + } + + let to_docker_env_vars t = + [ ("DAEMON_REST_PORT", t.rest_port) + ; ("DAEMON_CLIENT_PORT", t.client_port) + ; ("DAEMON_METRICS_PORT", t.metrics_port) + ; ("DAEMON_EXTERNAL_PORT", t.external_port) + ; ("RAYON_NUM_THREADS", "8") + ; ("MINA_PRIVKEY_PASS", "naughty blue worm") + ; ("MINA_LIBP2P_PASS", "") + ] + + let to_list t = + let base_args = + [ "-log-level" + ; t.log_level + ; "-log-snark-work-gossip" + ; Bool.to_string t.log_snark_work_gossip + ; "-log-txn-pool-gossip" + ; Bool.to_string t.log_txn_pool_gossip + ; "-generate-genesis-proof" + ; Bool.to_string t.generate_genesis_proof + ; "-client-port" + ; t.client_port + ; "-rest-port" + ; t.rest_port + ; "-external-port" + ; t.external_port + ; "-metrics-port" + ; t.metrics_port + ; "--libp2p-keypair" + ; t.libp2p_key_path + ; "-log-json" + ; "--insecure-rest-server" + ; "-external-ip" + ; "0.0.0.0" + ] + in + let peer_args = + match t.peer with Some peer -> [ "-peer"; peer ] | None -> [] + in + let runtime_config_path = + match t.runtime_config_path with + | Some path -> + [ "-config-file"; path ] + | None -> + [] + in + List.concat [ base_args; runtime_config_path; peer_args ] +end + +module Block_producer_config = struct + type config = + { keypair : Network_keypair.t + ; priv_key_path : string + ; enable_flooding : bool + ; enable_peer_exchange : bool + ; base_config : Base_node_config.t + } + [@@deriving to_yojson] + + type t = + { service_name : string + ; config : config + ; docker_config : Dockerfile.Service.t + } + [@@deriving to_yojson] + + let create_cmd config = + let base_args = Base_node_config.to_list config.base_config in + let block_producer_args = + [ "daemon" + ; "-block-producer-key" + ; config.priv_key_path + ; "-enable-flooding" + ; config.enable_flooding |> Bool.to_string + ; "-enable-peer-exchange" + ; config.enable_peer_exchange |> Bool.to_string + ] + in + List.concat [ block_producer_args; base_args ] + + let create_docker_config ~image ~entrypoint ~ports ~volumes ~environment + ~config = + { Dockerfile.Service.image + ; command = create_cmd config + ; entrypoint + ; ports + ; environment + ; volumes + } + + let create ~service_name ~image ~ports ~volumes ~config = + let entrypoint = Some [ "/root/entrypoint.sh" ] in + let environment = Base_node_config.to_docker_env_vars config.base_config in + let docker_config = + create_docker_config ~image ~ports ~volumes ~environment ~entrypoint + ~config + in + { service_name; config; docker_config } +end + +module Seed_config = struct + let peer_id = "12D3KooWMg66eGtSEx5UZ9EAqEp3W7JaGd6WTxdRFuqhskRN55dT" + + let libp2p_keypair = + {|{"box_primitive":"xsalsa20poly1305","pw_primitive":"argon2i","nonce":"7Bbvv2wZ6iCeqVyooU9WR81aygshMrLdXKieaHT","pwsalt":"Bh1WborqSwdzBi7m95iZdrCGspSf","pwdiff":[134217728,6],"ciphertext":"8fgvt4eKSzF5HMr1uEZARVHBoMgDKTx17zV7STVQyhyyEz1SqdH4RrU51MFGMPZJXNznLfz8RnSPsjrVqhc1CenfSLLWP5h7tTn86NbGmzkshCNvUiGEoSb2CrSLsvJsdn13ey9ibbZfdeXyDp9y6mKWYVmefAQLWUC1Kydj4f4yFwCJySEttAhB57647ewBRicTjdpv948MjdAVNf1tTxms4VYg4Jb3pLVeGAPaRtW5QHUkA8LwN5fh3fmaFk1mRudMd67UzGdzrVBeEHAp4zCnN7g2iVdWNmwN3"}|} + + let create_libp2p_peer ~peer_name ~external_port = + Printf.sprintf "/dns4/%s/tcp/%d/p2p/%s" peer_name external_port peer_id + + type config = + { archive_address : string option; base_config : Base_node_config.t } + [@@deriving to_yojson] + + type t = + { service_name : string + ; config : config + ; docker_config : Dockerfile.Service.t + } + [@@deriving to_yojson] + + let seed_libp2p_keypair : Docker_compose.Dockerfile.Service.Volume.t = + { type_ = "bind" + ; source = "keys/libp2p_key" + ; target = Base_node_config.container_libp2p_key_path + } + + let create_cmd config = + let base_args = Base_node_config.to_list config.base_config in + let seed_args = + match config.archive_address with + | Some archive_address -> + [ "daemon"; "-seed"; "-archive-address"; archive_address ] + | None -> + [ "daemon"; "-seed" ] + in + List.concat [ seed_args; base_args ] + + let create_docker_config ~image ~entrypoint ~ports ~volumes ~environment + ~config = + { Dockerfile.Service.image + ; command = create_cmd config + ; entrypoint + ; ports + ; environment + ; volumes + } + + let create ~service_name ~image ~ports ~volumes ~config = + let entrypoint = Some [ "/root/entrypoint.sh" ] in + let environment = Base_node_config.to_docker_env_vars config.base_config in + let docker_config = + create_docker_config ~image ~ports ~volumes ~environment ~entrypoint + ~config + in + { service_name; config; docker_config } +end + +module Snark_worker_config = struct + type config = + { daemon_address : string + ; daemon_port : string + ; proof_level : string + ; base_config : Base_node_config.t + } + [@@deriving to_yojson] + + type t = + { service_name : string + ; config : config + ; docker_config : Dockerfile.Service.t + } + [@@deriving to_yojson] + + let create_cmd config = + [ "internal" + ; "snark-worker" + ; "-proof-level" + ; config.proof_level + ; "-daemon-address" + ; config.daemon_address ^ ":" ^ config.daemon_port + ; "--shutdown-on-disconnect" + ; "false" + ] + + let create_docker_config ~image ~entrypoint ~ports ~volumes ~environment + ~config = + { Dockerfile.Service.image + ; command = create_cmd config + ; entrypoint + ; ports + ; environment + ; volumes + } + + let create ~service_name ~image ~ports ~volumes ~config = + let entrypoint = Some [ "/root/entrypoint.sh" ] in + let environment = Base_node_config.to_docker_env_vars config.base_config in + let docker_config = + create_docker_config ~image ~ports ~volumes ~environment ~entrypoint + ~config + in + { service_name; config; docker_config } +end + +module Snark_coordinator_config = struct + type config = + { snark_coordinator_key : string + ; snark_worker_fee : string + ; work_selection : string + ; worker_nodes : Snark_worker_config.t list + ; base_config : Base_node_config.t + } + [@@deriving to_yojson] + + type t = + { service_name : string + ; config : config + ; docker_config : Dockerfile.Service.t + } + [@@deriving to_yojson] + + let snark_coordinator_default_env ~snark_coordinator_key ~snark_worker_fee + ~work_selection = + [ ("MINA_SNARK_KEY", snark_coordinator_key) + ; ("MINA_SNARK_FEE", snark_worker_fee) + ; ("WORK_SELECTION", work_selection) + ; ("MINA_CLIENT_TRUSTLIST", "10.0.0.0/8,172.16.0.0/12,192.168.0.0/16") + ] + + let create_cmd config = + let base_args = Base_node_config.to_list config.base_config in + let snark_coordinator_args = + [ "daemon" + ; "-run-snark-coordinator" + ; config.snark_coordinator_key + ; "-snark-worker-fee" + ; config.snark_worker_fee + ; "-work-selection" + ; config.work_selection + ] + in + List.concat [ snark_coordinator_args; base_args ] + + let create_docker_config ~image ~entrypoint ~ports ~volumes ~environment + ~config = + { Dockerfile.Service.image + ; command = create_cmd config + ; entrypoint + ; ports + ; environment + ; volumes + } + + let create ~service_name ~image ~ports ~volumes ~config = + let entrypoint = Some [ "/root/entrypoint.sh" ] in + let environment = + snark_coordinator_default_env + ~snark_coordinator_key:config.snark_coordinator_key + ~snark_worker_fee:config.snark_worker_fee + ~work_selection:config.work_selection + @ Base_node_config.to_docker_env_vars config.base_config + in + let docker_config = + create_docker_config ~image ~ports ~volumes ~environment ~entrypoint + ~config + in + { service_name; config; docker_config } +end + +module Postgres_config = struct + type config = + { host : string + ; username : string + ; password : string + ; database : string + ; port : int + } + [@@deriving to_yojson] + + type t = + { service_name : string + ; config : config + ; docker_config : Dockerfile.Service.t + } + [@@deriving to_yojson] + + let postgres_image = "docker.io/bitnami/postgresql" + + let postgres_script = + ( "postgres_entrypoint.sh" + , {|#!/bin/bash +# This file is auto-generated by the local integration test framework. +cd /bitnami +# Create the archive database and import the schema +psql -U postgres -d archive -f ./create_schema.sql +|} + ) + + let postgres_create_schema_volume : Dockerfile.Service.Volume.t = + { type_ = "bind" + ; source = "create_schema.sql" + ; target = "/bitnami/create_schema.sql" + } + + let postgres_zkapp_schema_volume : Dockerfile.Service.Volume.t = + { type_ = "bind" + ; source = "zkapp_tables.sql" + ; target = "/bitnami/zkapp_tables.sql" + } + + let postgres_entrypoint_volume : Dockerfile.Service.Volume.t = + { type_ = "bind" + ; source = "postgres_entrypoint.sh" + ; target = "/docker-entrypoint-initdb.d/postgres_entrypoint.sh" + } + + let postgres_default_envs ~username ~password ~database ~port = + [ ("BITNAMI_DEBUG", "false") + ; ("POSTGRES_USER", username) + ; ("POSTGRES_PASSWORD", password) + ; ("POSTGRES_DB", database) + ; ("PGPASSWORD", password) + ; ("POSTGRESQL_PORT_NUMBER", port) + ; ("POSTGRESQL_ENABLE_LDAP", "no") + ; ("POSTGRESQL_ENABLE_TLS", "no") + ; ("POSTGRESQL_LOG_HOSTNAME", "false") + ; ("POSTGRESQL_LOG_CONNECTIONS", "false") + ; ("POSTGRESQL_LOG_DISCONNECTIONS", "false") + ; ("POSTGRESQL_PGAUDIT_LOG_CATALOG", "off") + ; ("POSTGRESQL_CLIENT_MIN_MESSAGES", "error") + ; ("POSTGRESQL_SHARED_PRELOAD_LIBRARIES", "pgaudit") + ; ("POSTGRES_HOST_AUTH_METHOD", "trust") + ] + + let create_connection_uri ~host ~username ~password ~database ~port = + Printf.sprintf "postgres://%s:%s@%s:%d/%s" username password host port + database + + let to_connection_uri t = + create_connection_uri ~host:t.host ~port:t.port ~username:t.username + ~password:t.password ~database:t.database + + let create_docker_config ~image ~entrypoint ~ports ~volumes ~environment = + { Dockerfile.Service.image + ; command = [] + ; entrypoint + ; ports + ; environment + ; volumes + } + + let create ~service_name ~image ~ports ~volumes ~config = + let environment = + postgres_default_envs ~username:config.username ~password:config.password + ~database:config.database + ~port:(Int.to_string config.port) + in + let docker_config = + create_docker_config ~image ~ports ~volumes ~environment ~entrypoint:None + in + { service_name; config; docker_config } +end + +module Archive_node_config = struct + type config = + { postgres_config : Postgres_config.t + ; server_port : int + ; base_config : Base_node_config.t + } + [@@deriving to_yojson] + + type t = + { service_name : string + ; config : config + ; docker_config : Dockerfile.Service.t + } + [@@deriving to_yojson] + + let archive_entrypoint_script = + ( "archive_entrypoint.sh" + , {|#!/bin/bash + # This file is auto-generated by the local integration test framework. + # Sleep for 15 seconds + echo "Sleeping for 15 seconds before starting..." + sleep 15 + exec "$@"|} + ) + + let archive_entrypoint_volume : Docker_compose.Dockerfile.Service.Volume.t = + { type_ = "bind" + ; source = "archive_entrypoint.sh" + ; target = Base_node_config.container_entrypoint_path + } + + let create_cmd config = + let base_args = + [ "mina-archive" + ; "run" + ; "-postgres-uri" + ; Postgres_config.to_connection_uri config.postgres_config.config + ; "-server-port" + ; Int.to_string config.server_port + ] + in + let runtime_config_path = + match config.base_config.runtime_config_path with + | Some path -> + [ "-config-file"; path ] + | None -> + [] + in + List.concat [ base_args; runtime_config_path ] + + let create_docker_config ~image ~entrypoint ~ports ~volumes ~environment + ~config = + { Dockerfile.Service.image + ; command = create_cmd config + ; entrypoint + ; ports + ; environment + ; volumes + } + + let create ~service_name ~image ~ports ~volumes ~config = + let entrypoint = Some [ "/root/entrypoint.sh" ] in + let environment = Base_node_config.to_docker_env_vars config.base_config in + let docker_config = + create_docker_config ~image ~ports ~volumes ~environment ~entrypoint + ~config + in + { service_name; config; docker_config } +end diff --git a/src/lib/integration_test_local_engine/dune b/src/lib/integration_test_local_engine/dune new file mode 100644 index 00000000000..e4a772945f2 --- /dev/null +++ b/src/lib/integration_test_local_engine/dune @@ -0,0 +1,70 @@ +(library + (public_name integration_test_local_engine) + (name integration_test_local_engine) + (inline_tests + (flags -verbose -show-counts)) + (instrumentation + (backend bisect_ppx)) + (preprocessor_deps + ../../graphql-ppx-config.inc + ../../../graphql_schema.json) + (preprocess + (pps + ppx_here + ppx_mina + ppx_version + ppx_let + ppx_inline_test + ppx_pipebang + ppx_custom_printf + ppx_deriving_yojson + lens.ppx_deriving + ppx_sexp_conv + graphql_ppx + -- + %{read-lines:../../graphql-ppx-config.inc})) + (libraries + ;; opam libraries + async_unix + async_kernel + core_kernel + core + async + cmdliner + base + uri + sexplib0 + stdio + result + base.caml + integers + re2 + ;; local libraries + key_gen + integration_test_lib + graphql_lib + mina_runtime_config + mina_base + genesis_constants + genesis_ledger_helper + logger + mina_base_import + signature_lib + currency + mina_version + timeout_lib + mina_numbers + mina_state + mina_stdlib + mina_transaction + file_system + pickles + pickles_types + backend + kimchi_pasta + kimchi_backend.pasta.basic + with_hash + data_hash_lib + generated_graphql_queries + mina_graphql + error_json)) diff --git a/src/lib/integration_test_local_engine/integration_test_local_engine.ml b/src/lib/integration_test_local_engine/integration_test_local_engine.ml new file mode 100644 index 00000000000..dc672814be8 --- /dev/null +++ b/src/lib/integration_test_local_engine/integration_test_local_engine.ml @@ -0,0 +1,15 @@ +let name = "local" + +module Network = Docker_network +module Network_config = Mina_docker.Network_config +module Network_manager = Mina_docker.Network_manager + +module Docker_polling_interval = struct + let start_filtered_logs_interval = Core.Time.Span.of_sec 0.25 +end + +module Log_engine = + Integration_test_lib.Graphql_polling_log_engine + .Make_GraphQL_polling_log_engine + (Docker_network) + (Docker_polling_interval) diff --git a/src/lib/integration_test_local_engine/integration_test_local_engine.mli b/src/lib/integration_test_local_engine/integration_test_local_engine.mli new file mode 100644 index 00000000000..e1ba61b4e77 --- /dev/null +++ b/src/lib/integration_test_local_engine/integration_test_local_engine.mli @@ -0,0 +1 @@ +include Integration_test_lib.Intf.Engine.S diff --git a/src/lib/integration_test_local_engine/mina_docker.ml b/src/lib/integration_test_local_engine/mina_docker.ml new file mode 100644 index 00000000000..58af851999d --- /dev/null +++ b/src/lib/integration_test_local_engine/mina_docker.ml @@ -0,0 +1,1052 @@ +open Core +open Async +open Currency +open Signature_lib +open Mina_base +open Integration_test_lib + +let docker_swarm_version = "3.8" + +module Network_config = struct + module Cli_inputs = Cli_inputs + + type docker_config = + { docker_swarm_version : string + ; stack_name : string + ; mina_image : string + ; mina_agent_image : string + ; mina_bots_image : string + ; mina_points_image : string + ; mina_archive_image : string + ; runtime_config : Yojson.Safe.t + ; seed_configs : Docker_node_config.Seed_config.t list + ; block_producer_configs : Docker_node_config.Block_producer_config.t list + ; snark_coordinator_config : + Docker_node_config.Snark_coordinator_config.t option + ; archive_node_configs : Docker_node_config.Archive_node_config.t list + ; mina_archive_schema_aux_files : string list + ; log_precomputed_blocks : bool + } + [@@deriving to_yojson] + + type t = + { debug_arg : bool + ; genesis_keypairs : + (Network_keypair.t Core.String.Map.t + [@to_yojson + fun map -> + `Assoc + (Core.Map.fold_right ~init:[] + ~f:(fun ~key:k ~data:v accum -> + (k, Network_keypair.to_yojson v) :: accum ) + map )] ) + ; constants : Test_config.constants + ; docker : docker_config + } + [@@deriving to_yojson] + + let expand ~logger ~test_name ~(cli_inputs : Cli_inputs.t) ~(debug : bool) + ~(test_config : Test_config.t) ~(images : Test_config.Container_images.t) + = + let _ = cli_inputs in + let { genesis_ledger + ; epoch_data + ; block_producers + ; snark_coordinator + ; snark_worker_fee + ; num_archive_nodes + ; log_precomputed_blocks + ; proof_config + ; Test_config.k + ; delta + ; slots_per_epoch + ; slots_per_sub_window + ; txpool_max_size + ; _ + } = + test_config + in + let git_commit = Mina_version.commit_id_short in + let stack_name = "it-" ^ git_commit ^ "-" ^ test_name in + let key_names_list = + List.map genesis_ledger ~f:(fun acct -> acct.account_name) + in + if List.contains_dup ~compare:String.compare key_names_list then + failwith + "All accounts in genesis ledger must have unique names. Check to make \ + sure you are not using the same account_name more than once" ; + let all_nodes_names_list = + List.map block_producers ~f:(fun acct -> acct.node_name) + @ match snark_coordinator with None -> [] | Some n -> [ n.node_name ] + in + if List.contains_dup ~compare:String.compare all_nodes_names_list then + failwith + "All nodes in testnet must have unique names. Check to make sure you \ + are not using the same node_name more than once" ; + let keypairs = + List.take + (List.tl_exn + (Array.to_list (Lazy.force Key_gen.Sample_keypairs.keypairs)) ) + (List.length genesis_ledger) + in + let runtime_timing_of_timing = function + | Account.Timing.Untimed -> + None + | Timed t -> + Some + { Runtime_config.Accounts.Single.Timed.initial_minimum_balance = + t.initial_minimum_balance + ; cliff_time = t.cliff_time + ; cliff_amount = t.cliff_amount + ; vesting_period = t.vesting_period + ; vesting_increment = t.vesting_increment + } + in + let add_accounts accounts_and_keypairs = + List.map accounts_and_keypairs + ~f:(fun + ( { Test_config.Test_Account.balance; account_name; timing } + , (pk, sk) ) + -> + let timing = runtime_timing_of_timing timing in + let default = Runtime_config.Accounts.Single.default in + let account = + { default with + pk = Public_key.Compressed.to_string pk + ; sk = Some (Private_key.to_base58_check sk) + ; balance = Balance.of_mina_string_exn balance + ; delegate = None + ; timing + } + in + (account_name, account) ) + in + let genesis_accounts_and_keys = List.zip_exn genesis_ledger keypairs in + let genesis_ledger_accounts = add_accounts genesis_accounts_and_keys in + let constraint_constants = + Genesis_ledger_helper.make_constraint_constants + ~default:Genesis_constants.Constraint_constants.compiled proof_config + in + let ledger_is_prefix ledger1 ledger2 = + List.is_prefix ledger2 ~prefix:ledger1 + ~equal:(fun + ({ account_name = name1; _ } : Test_config.Test_Account.t) + ({ account_name = name2; _ } : Test_config.Test_Account.t) + -> String.equal name1 name2 ) + in + let runtime_config = + { Runtime_config.daemon = + Some + { txpool_max_size = Some txpool_max_size + ; peer_list_url = None + ; zkapp_proof_update_cost = None + ; zkapp_signed_single_update_cost = None + ; zkapp_signed_pair_update_cost = None + ; zkapp_transaction_cost_limit = None + ; max_event_elements = None + ; max_action_elements = None + } + ; genesis = + Some + { k = Some k + ; delta = Some delta + ; slots_per_epoch = Some slots_per_epoch + ; slots_per_sub_window = Some slots_per_sub_window + ; genesis_state_timestamp = + Some Core.Time.(to_string_abs ~zone:Zone.utc (now ())) + } + ; proof = Some proof_config + ; ledger = + Some + { base = + Accounts + (List.map genesis_ledger_accounts ~f:(fun (_name, acct) -> + acct ) ) + ; add_genesis_winner = None + ; num_accounts = None + ; balances = [] + ; hash = None + ; name = None + } + ; epoch_data = + Option.map epoch_data ~f:(fun { staking = staking_ledger; next } -> + let genesis_winner_account : Runtime_config.Accounts.single = + Runtime_config.Accounts.Single.of_account + Mina_state.Consensus_state_hooks.genesis_winner_account + |> Result.ok_or_failwith + in + let ledger_of_epoch_accounts + (epoch_accounts : Test_config.Test_Account.t list) = + let epoch_ledger_accounts = + List.map epoch_accounts + ~f:(fun { account_name; balance; timing } -> + let balance = Balance.of_mina_string_exn balance in + let timing = runtime_timing_of_timing timing in + let genesis_account = + match + List.Assoc.find genesis_ledger_accounts account_name + ~equal:String.equal + with + | Some acct -> + acct + | None -> + failwithf + "Epoch ledger account %s not in genesis ledger" + account_name () + in + { genesis_account with balance; timing } ) + in + ( { base = + Accounts (genesis_winner_account :: epoch_ledger_accounts) + ; add_genesis_winner = None (* no effect *) + ; num_accounts = None + ; balances = [] + ; hash = None + ; name = None + } + : Runtime_config.Ledger.t ) + in + let staking = + let ({ epoch_ledger; epoch_seed } + : Test_config.Epoch_data.Data.t ) = + staking_ledger + in + if not (ledger_is_prefix epoch_ledger genesis_ledger) then + failwith "Staking epoch ledger not a prefix of genesis ledger" ; + let ledger = ledger_of_epoch_accounts epoch_ledger in + let seed = epoch_seed in + ({ ledger; seed } : Runtime_config.Epoch_data.Data.t) + in + let next = + Option.map next ~f:(fun { epoch_ledger; epoch_seed } -> + if + not + (ledger_is_prefix staking_ledger.epoch_ledger + epoch_ledger ) + then + failwith + "Staking epoch ledger not a prefix of next epoch ledger" ; + if not (ledger_is_prefix epoch_ledger genesis_ledger) then + failwith + "Next epoch ledger not a prefix of genesis ledger" ; + let ledger = ledger_of_epoch_accounts epoch_ledger in + let seed = epoch_seed in + ({ ledger; seed } : Runtime_config.Epoch_data.Data.t) ) + in + ({ staking; next } : Runtime_config.Epoch_data.t) ) + } + in + let genesis_constants = + Or_error.ok_exn + (Genesis_ledger_helper.make_genesis_constants ~logger + ~default:Genesis_constants.compiled runtime_config ) + in + let constants : Test_config.constants = + { constraints = constraint_constants; genesis = genesis_constants } + in + let mk_net_keypair keypair_name (pk, sk) = + let keypair = + { Keypair.public_key = Public_key.decompress_exn pk; private_key = sk } + in + Network_keypair.create_network_keypair ~keypair_name ~keypair + in + let long_commit_id = + if String.is_substring Mina_version.commit_id ~substring:"[DIRTY]" then + String.sub Mina_version.commit_id ~pos:7 + ~len:(String.length Mina_version.commit_id - 7) + else Mina_version.commit_id + in + let mina_archive_base_url = + "https://raw.githubusercontent.com/MinaProtocol/mina/" ^ long_commit_id + ^ "/src/app/archive/" + in + let mina_archive_schema_aux_files = + [ sprintf "%screate_schema.sql" mina_archive_base_url + ; sprintf "%szkapp_tables.sql" mina_archive_base_url + ] + in + let genesis_keypairs = + List.fold genesis_accounts_and_keys ~init:String.Map.empty + ~f:(fun map ({ account_name; _ }, (pk, sk)) -> + let keypair = mk_net_keypair account_name (pk, sk) in + String.Map.add_exn map ~key:account_name ~data:keypair ) + in + let open Docker_node_config in + let open Docker_compose.Dockerfile in + let port_manager = PortManager.create ~min_port:10000 ~max_port:11000 in + let docker_volumes = + [ Base_node_config.runtime_config_volume + ; Base_node_config.entrypoint_volume + ] + in + let generate_random_id () = + let rand_char () = + let ascii_a = int_of_char 'a' in + let ascii_z = int_of_char 'z' in + char_of_int (ascii_a + Random.int (ascii_z - ascii_a + 1)) + in + String.init 4 ~f:(fun _ -> rand_char ()) + in + let seed_config = + let config : Seed_config.config = + { archive_address = None + ; base_config = + Base_node_config.default ~peer:None + ~runtime_config_path: + (Some Base_node_config.container_runtime_config_path) + } + in + Seed_config.create + ~service_name:(sprintf "seed-%s" (generate_random_id ())) + ~image:images.mina + ~ports:(PortManager.allocate_ports_for_node port_manager) + ~volumes:(docker_volumes @ [ Seed_config.seed_libp2p_keypair ]) + ~config + in + let seed_config_peer = + Some + (Seed_config.create_libp2p_peer ~peer_name:seed_config.service_name + ~external_port:PortManager.mina_internal_external_port ) + in + let archive_node_configs = + List.init num_archive_nodes ~f:(fun index -> + let config = + { Postgres_config.host = + sprintf "postgres-%d-%s" (index + 1) (generate_random_id ()) + ; username = "postgres" + ; password = "password" + ; database = "archive" + ; port = PortManager.postgres_internal_port + } + in + let postgres_port = + Service.Port.create + ~published:(PortManager.allocate_port port_manager) + ~target:PortManager.postgres_internal_port + in + let postgres_config = + Postgres_config.create ~service_name:config.host + ~image:Postgres_config.postgres_image ~ports:[ postgres_port ] + ~volumes: + [ Postgres_config.postgres_create_schema_volume + ; Postgres_config.postgres_zkapp_schema_volume + ; Postgres_config.postgres_entrypoint_volume + ] + ~config + in + let archive_server_port = + Service.Port.create + ~published:(PortManager.allocate_port port_manager) + ~target:PortManager.mina_internal_server_port + in + let config : Archive_node_config.config = + { postgres_config + ; server_port = archive_server_port.target + ; base_config = + Base_node_config.default ~peer:None + ~runtime_config_path: + (Some Base_node_config.container_runtime_config_path) + } + in + let archive_rest_port = + Service.Port.create + ~published:(PortManager.allocate_port port_manager) + ~target:PortManager.mina_internal_rest_port + in + Archive_node_config.create + ~service_name: + (sprintf "archive-%d-%s" (index + 1) (generate_random_id ())) + ~image:images.archive_node + ~ports:[ archive_server_port; archive_rest_port ] + ~volumes: + [ Base_node_config.runtime_config_volume + ; Archive_node_config.archive_entrypoint_volume + ] + ~config ) + in + (* Each archive node has it's own seed node *) + let seed_configs = + List.mapi archive_node_configs ~f:(fun index archive_config -> + let config : Seed_config.config = + { archive_address = + Some + (sprintf "%s:%d" archive_config.service_name + PortManager.mina_internal_server_port ) + ; base_config = + Base_node_config.default ~peer:seed_config_peer + ~runtime_config_path: + (Some Base_node_config.container_runtime_config_path) + } + in + Seed_config.create + ~service_name: + (sprintf "seed-%d-%s" (index + 1) (generate_random_id ())) + ~image:images.mina + ~ports:(PortManager.allocate_ports_for_node port_manager) + ~volumes:docker_volumes ~config ) + @ [ seed_config ] + in + let block_producer_configs = + List.map block_producers ~f:(fun node -> + let keypair = + match + List.find genesis_accounts_and_keys + ~f:(fun ({ account_name; _ }, _keypair) -> + String.equal account_name node.account_name ) + with + | Some (_acct, keypair) -> + keypair |> mk_net_keypair node.account_name + | None -> + let failstring = + Format.sprintf + "Failing because the account key of all initial block \ + producers must be in the genesis ledger. name of Node: \ + %s. name of Account which does not exist: %s" + node.node_name node.account_name + in + failwith failstring + in + let priv_key_path = + Base_node_config.container_keys_path ^/ node.account_name + in + let volumes = + [ Service.Volume.create ("keys" ^/ node.account_name) priv_key_path + ] + @ docker_volumes + in + let block_producer_config : Block_producer_config.config = + { keypair + ; priv_key_path + ; enable_peer_exchange = true + ; enable_flooding = true + ; base_config = + Base_node_config.default ~peer:seed_config_peer + ~runtime_config_path: + (Some Base_node_config.container_runtime_config_path) + } + in + Block_producer_config.create ~service_name:node.node_name + ~image:images.mina + ~ports:(PortManager.allocate_ports_for_node port_manager) + ~volumes ~config:block_producer_config ) + in + let snark_coordinator_config = + match snark_coordinator with + | None -> + None + | Some snark_coordinator_node -> + let network_kp = + match + String.Map.find genesis_keypairs + snark_coordinator_node.account_name + with + | Some acct -> + acct + | None -> + let failstring = + Format.sprintf + "Failing because the account key of all initial snark \ + coordinators must be in the genesis ledger. name of \ + Node: %s. name of Account which does not exist: %s" + snark_coordinator_node.node_name + snark_coordinator_node.account_name + in + failwith failstring + in + let public_key = + Public_key.Compressed.to_base58_check + (Public_key.compress network_kp.keypair.public_key) + in + let coordinator_ports = + PortManager.allocate_ports_for_node port_manager + in + let daemon_port = + coordinator_ports + |> List.find_exn ~f:(fun p -> + p.target + = Docker_node_config.PortManager.mina_internal_client_port ) + in + let snark_node_service_name = snark_coordinator_node.node_name in + let worker_node_config : Snark_worker_config.config = + { daemon_address = snark_node_service_name + ; daemon_port = Int.to_string daemon_port.target + ; proof_level = "full" + ; base_config = + Base_node_config.default ~peer:None ~runtime_config_path:None + } + in + let worker_nodes = + List.init snark_coordinator_node.worker_nodes ~f:(fun index -> + Docker_node_config.Snark_worker_config.create + ~service_name: + (sprintf "snark-worker-%d-%s" (index + 1) + (generate_random_id ()) ) + ~image:images.mina + ~ports: + (Docker_node_config.PortManager.allocate_ports_for_node + port_manager ) + ~volumes:docker_volumes ~config:worker_node_config ) + in + let snark_coordinator_config : Snark_coordinator_config.config = + { worker_nodes + ; snark_worker_fee + ; snark_coordinator_key = public_key + ; work_selection = "seq" + ; base_config = + Base_node_config.default ~peer:seed_config_peer + ~runtime_config_path: + (Some Base_node_config.container_runtime_config_path) + } + in + Some + (Snark_coordinator_config.create + ~service_name:snark_node_service_name ~image:images.mina + ~ports:coordinator_ports ~volumes:docker_volumes + ~config:snark_coordinator_config ) + in + { debug_arg = debug + ; genesis_keypairs + ; constants + ; docker = + { docker_swarm_version + ; stack_name + ; mina_image = images.mina + ; mina_agent_image = images.user_agent + ; mina_bots_image = images.bots + ; mina_points_image = images.points + ; mina_archive_image = images.archive_node + ; runtime_config = Runtime_config.to_yojson runtime_config + ; log_precomputed_blocks + ; block_producer_configs + ; seed_configs + ; mina_archive_schema_aux_files + ; snark_coordinator_config + ; archive_node_configs + } + } + + (* + Composes a docker_compose.json file from the network_config specification and writes to disk. This docker_compose + file contains docker service definitions for each node in the local network. Each node service has different + configurations which are specified as commands, environment variables, and docker bind volumes. + We start by creating a runtime config volume to mount to each node service as a bind volume and then continue to create each + node service. As we create each definition for a service, we specify the docker command, volume, and environment varibles to + be used (which are mostly defaults). + *) + let to_docker network_config = + let open Docker_compose.Dockerfile in + let block_producer_map = + List.map network_config.docker.block_producer_configs ~f:(fun config -> + (config.service_name, config.docker_config) ) + |> StringMap.of_alist_exn + in + let seed_map = + List.map network_config.docker.seed_configs ~f:(fun config -> + (config.service_name, config.docker_config) ) + |> StringMap.of_alist_exn + in + let snark_coordinator_map = + match network_config.docker.snark_coordinator_config with + | Some config -> + StringMap.of_alist_exn [ (config.service_name, config.docker_config) ] + | None -> + StringMap.empty + in + let snark_worker_map = + match network_config.docker.snark_coordinator_config with + | Some snark_coordinator_config -> + List.map snark_coordinator_config.config.worker_nodes + ~f:(fun config -> (config.service_name, config.docker_config)) + |> StringMap.of_alist_exn + | None -> + StringMap.empty + in + let archive_node_map = + List.map network_config.docker.archive_node_configs ~f:(fun config -> + (config.service_name, config.docker_config) ) + |> StringMap.of_alist_exn + in + let postgres_map = + List.map network_config.docker.archive_node_configs + ~f:(fun archive_config -> + let config = archive_config.config.postgres_config in + (config.service_name, config.docker_config) ) + |> StringMap.of_alist_exn + in + let services = + postgres_map |> merge archive_node_map |> merge snark_worker_map + |> merge snark_coordinator_map + |> merge block_producer_map |> merge seed_map + in + { version = docker_swarm_version; services } +end + +module Network_manager = struct + type t = + { logger : Logger.t + ; stack_name : string + ; graphql_enabled : bool + ; docker_dir : string + ; docker_compose_file_path : string + ; constants : Test_config.constants + ; seed_workloads : Docker_network.Service_to_deploy.t Core.String.Map.t + ; block_producer_workloads : + Docker_network.Service_to_deploy.t Core.String.Map.t + ; snark_coordinator_workloads : + Docker_network.Service_to_deploy.t Core.String.Map.t + ; snark_worker_workloads : + Docker_network.Service_to_deploy.t Core.String.Map.t + ; archive_workloads : Docker_network.Service_to_deploy.t Core.String.Map.t + ; services_by_id : Docker_network.Service_to_deploy.t Core.String.Map.t + ; mutable deployed : bool + ; genesis_keypairs : Network_keypair.t Core.String.Map.t + } + + let get_current_running_stacks = + let open Malleable_error.Let_syntax in + let%bind all_stacks_str = + Util.run_cmd_or_hard_error "/" "docker" + [ "stack"; "ls"; "--format"; "{{.Name}}" ] + in + return (String.split ~on:'\n' all_stacks_str) + + let remove_stack_if_exists ~logger (network_config : Network_config.t) = + let open Malleable_error.Let_syntax in + let%bind all_stacks = get_current_running_stacks in + if List.mem all_stacks network_config.docker.stack_name ~equal:String.equal + then + let%bind () = + if network_config.debug_arg then + Deferred.bind ~f:Malleable_error.return + (Util.prompt_continue + "Existing stack name of same name detected, pausing startup. \ + Enter [y/Y] to continue on and remove existing stack name, \ + start clean, and run the test; press Ctrl-C to quit out: " ) + else + Malleable_error.return + ([%log info] + "Existing stack of same name detected; removing to start clean" ) + in + Util.run_cmd_or_hard_error "/" "docker" + [ "stack"; "rm"; network_config.docker.stack_name ] + >>| Fn.const () + else return () + + let generate_docker_stack_file ~logger ~docker_dir ~docker_compose_file_path + ~network_config = + let open Deferred.Let_syntax in + let%bind () = + if%bind File_system.dir_exists docker_dir then ( + [%log info] "Old docker stack directory found; removing to start clean" ; + File_system.remove_dir docker_dir ) + else return () + in + [%log info] "Writing docker configuration %s" docker_dir ; + let%bind () = Unix.mkdir docker_dir in + let%bind _ = + Docker_compose.Dockerfile.write_config ~dir:docker_dir + ~filename:docker_compose_file_path + (Network_config.to_docker network_config) + in + return () + + let write_docker_bind_volumes ~logger ~docker_dir + ~(network_config : Network_config.t) = + let open Deferred.Let_syntax in + [%log info] "Writing runtime_config %s" docker_dir ; + let%bind () = + Yojson.Safe.to_file + (String.concat [ docker_dir; "/runtime_config.json" ]) + network_config.docker.runtime_config + |> Deferred.return + in + [%log info] "Writing out the genesis keys to dir %s" docker_dir ; + let kps_base_path = String.concat [ docker_dir; "/keys" ] in + let%bind () = Unix.mkdir kps_base_path in + [%log info] "Writing genesis keys to %s" kps_base_path ; + let%bind () = + Core.String.Map.iter network_config.genesis_keypairs ~f:(fun kp -> + let keypath = String.concat [ kps_base_path; "/"; kp.keypair_name ] in + Out_channel.with_file ~fail_if_exists:true keypath ~f:(fun ch -> + kp.private_key |> Out_channel.output_string ch ) ; + Out_channel.with_file ~fail_if_exists:true (keypath ^ ".pub") + ~f:(fun ch -> kp.public_key |> Out_channel.output_string ch) ; + ignore + (Util.run_cmd_exn kps_base_path "chmod" [ "600"; kp.keypair_name ]) ) + |> Deferred.return + in + [%log info] "Writing seed libp2p keypair to %s" kps_base_path ; + let%bind () = + let keypath = String.concat [ kps_base_path; "/"; "libp2p_key" ] in + Out_channel.with_file ~fail_if_exists:true keypath ~f:(fun ch -> + Docker_node_config.Seed_config.libp2p_keypair + |> Out_channel.output_string ch ) ; + ignore (Util.run_cmd_exn kps_base_path "chmod" [ "600"; "libp2p_key" ]) ; + return () + in + let%bind () = + ignore (Util.run_cmd_exn docker_dir "chmod" [ "700"; "keys" ]) + |> Deferred.return + in + [%log info] + "Writing custom entrypoint script (libp2p key generation and puppeteer \ + context)" ; + let entrypoint_filename, entrypoint_script = + Docker_node_config.Base_node_config.entrypoint_script + in + Out_channel.with_file ~fail_if_exists:true + (docker_dir ^/ entrypoint_filename) ~f:(fun ch -> + entrypoint_script |> Out_channel.output_string ch ) ; + [%log info] + "Writing custom archive entrypoint script (wait for postgres to \ + initialize)" ; + let archive_filename, archive_script = + Docker_node_config.Archive_node_config.archive_entrypoint_script + in + Out_channel.with_file ~fail_if_exists:true (docker_dir ^/ archive_filename) + ~f:(fun ch -> archive_script |> Out_channel.output_string ch) ; + ignore (Util.run_cmd_exn docker_dir "chmod" [ "+x"; archive_filename ]) ; + let%bind _ = + Deferred.List.iter network_config.docker.mina_archive_schema_aux_files + ~f:(fun schema_url -> + let filename = Filename.basename schema_url in + [%log info] "Downloading %s" schema_url ; + let%bind _ = + Util.run_cmd_or_hard_error docker_dir "curl" + [ "-o"; filename; schema_url ] + in + [%log info] + "Writing custom postgres entrypoint script (import archive node \ + schema)" ; + + Deferred.return () ) + |> Deferred.return + in + ignore (Util.run_cmd_exn docker_dir "chmod" [ "+x"; entrypoint_filename ]) ; + [%log info] "Writing custom postgres entrypoint script (create schema)" ; + let postgres_entrypoint_filename, postgres_entrypoint_script = + Docker_node_config.Postgres_config.postgres_script + in + Out_channel.with_file ~fail_if_exists:true + (docker_dir ^/ postgres_entrypoint_filename) ~f:(fun ch -> + postgres_entrypoint_script |> Out_channel.output_string ch ) ; + ignore + (Util.run_cmd_exn docker_dir "chmod" + [ "+x"; postgres_entrypoint_filename ] ) ; + return () + + let initialize_workloads ~logger (network_config : Network_config.t) = + let find_rest_port ports = + List.find_map_exn ports ~f:(fun port -> + match port with + | Docker_compose.Dockerfile.Service.Port.{ published; target } -> + if target = Docker_node_config.PortManager.mina_internal_rest_port + then Some published + else None ) + in + [%log info] "Initializing seed workloads" ; + let seed_workloads = + List.map network_config.docker.seed_configs ~f:(fun seed_config -> + let graphql_port = find_rest_port seed_config.docker_config.ports in + let node = + Docker_network.Service_to_deploy.construct_service + network_config.docker.stack_name seed_config.service_name + (Docker_network.Service_to_deploy.init_service_to_deploy_config + ~network_keypair:None ~postgres_connection_uri:None + ~graphql_port ) + in + (seed_config.service_name, node) ) + |> Core.String.Map.of_alist_exn + in + [%log info] "Initializing block producer workloads" ; + let block_producer_workloads = + List.map network_config.docker.block_producer_configs ~f:(fun bp_config -> + let graphql_port = find_rest_port bp_config.docker_config.ports in + let node = + Docker_network.Service_to_deploy.construct_service + network_config.docker.stack_name bp_config.service_name + (Docker_network.Service_to_deploy.init_service_to_deploy_config + ~network_keypair:(Some bp_config.config.keypair) + ~postgres_connection_uri:None ~graphql_port ) + in + (bp_config.service_name, node) ) + |> Core.String.Map.of_alist_exn + in + [%log info] "Initializing snark coordinator and worker workloads" ; + let snark_coordinator_workloads, snark_worker_workloads = + match network_config.docker.snark_coordinator_config with + | Some snark_coordinator_config -> + let snark_coordinator_workloads = + if List.length snark_coordinator_config.config.worker_nodes > 0 then + let graphql_port = + find_rest_port snark_coordinator_config.docker_config.ports + in + let coordinator = + Docker_network.Service_to_deploy.construct_service + network_config.docker.stack_name + snark_coordinator_config.service_name + (Docker_network.Service_to_deploy + .init_service_to_deploy_config ~network_keypair:None + ~postgres_connection_uri:None ~graphql_port ) + in + [ (snark_coordinator_config.service_name, coordinator) ] + |> Core.String.Map.of_alist_exn + else Core.String.Map.empty + in + let snark_worker_workloads = + List.map snark_coordinator_config.config.worker_nodes + ~f:(fun snark_worker_config -> + let graphql_port = + find_rest_port snark_worker_config.docker_config.ports + in + let worker = + Docker_network.Service_to_deploy.construct_service + network_config.docker.stack_name + snark_worker_config.service_name + (Docker_network.Service_to_deploy + .init_service_to_deploy_config ~network_keypair:None + ~postgres_connection_uri:None ~graphql_port ) + in + + (snark_worker_config.service_name, worker) ) + |> Core.String.Map.of_alist_exn + in + (snark_coordinator_workloads, snark_worker_workloads) + | None -> + (Core.String.Map.of_alist_exn [], Core.String.Map.of_alist_exn []) + in + [%log info] "Initializing archive node workloads" ; + let archive_workloads = + List.map network_config.docker.archive_node_configs + ~f:(fun archive_config -> + let graphql_port = + find_rest_port archive_config.docker_config.ports + in + let postgres_connection_uri = + Some + (Docker_node_config.Postgres_config.to_connection_uri + archive_config.config.postgres_config.config ) + in + let node = + Docker_network.Service_to_deploy.construct_service + network_config.docker.stack_name archive_config.service_name + (Docker_network.Service_to_deploy.init_service_to_deploy_config + ~network_keypair:None ~postgres_connection_uri ~graphql_port ) + in + (archive_config.service_name, node) ) + |> Core.String.Map.of_alist_exn + in + ( seed_workloads + , block_producer_workloads + , snark_coordinator_workloads + , snark_worker_workloads + , archive_workloads ) + + let poll_until_stack_deployed ~logger = + let poll_interval = Time.Span.of_sec 15.0 in + let max_polls = 20 (* 5 mins *) in + let get_service_statuses () = + let%bind output = + Util.run_cmd_exn "/" "docker" + [ "service"; "ls"; "--format"; "{{.Name}}: {{.Replicas}}" ] + in + return + ( output |> String.split_lines + |> List.map ~f:(fun line -> + match String.split ~on:':' line with + | [ name; replicas ] -> + (String.strip name, String.strip replicas) + | _ -> + failwith "Unexpected format for docker service output" ) ) + in + let rec poll n = + [%log debug] "Checking Docker service statuses, n=%d" n ; + let%bind service_statuses = get_service_statuses () in + let bad_service_statuses = + List.filter service_statuses ~f:(fun (_, status) -> + let parts = String.split ~on:'/' status in + assert (List.length parts = 2) ; + let num, denom = + ( String.strip (List.nth_exn parts 0) + , String.strip (List.nth_exn parts 1) ) + in + not (String.equal num denom) ) + in + let open Malleable_error.Let_syntax in + if List.is_empty bad_service_statuses then return () + else if n > 0 then ( + [%log debug] "Got bad service statuses, polling again ($failed_statuses" + ~metadata: + [ ( "failed_statuses" + , `Assoc + (List.Assoc.map bad_service_statuses ~f:(fun v -> `String v)) + ) + ] ; + let%bind () = + after poll_interval |> Deferred.bind ~f:Malleable_error.return + in + poll (n - 1) ) + else + let bad_service_statuses_json = + `List + (List.map bad_service_statuses ~f:(fun (service_name, status) -> + `Assoc + [ ("service_name", `String service_name) + ; ("status", `String status) + ] ) ) + in + [%log fatal] + "Not all services could be deployed in time: $bad_service_statuses" + ~metadata:[ ("bad_service_statuses", bad_service_statuses_json) ] ; + Malleable_error.hard_error_string ~exit_code:4 + (Yojson.Safe.to_string bad_service_statuses_json) + in + [%log info] "Waiting for Docker services to be deployed" ; + let res = poll max_polls in + match%bind.Deferred res with + | Error _ -> + [%log error] "Not all Docker services were deployed, cannot proceed!" ; + res + | Ok _ -> + [%log info] "Docker services deployed" ; + res + + let create ~logger (network_config : Network_config.t) = + let open Malleable_error.Let_syntax in + let%bind () = remove_stack_if_exists ~logger network_config in + let ( seed_workloads + , block_producer_workloads + , snark_coordinator_workloads + , snark_worker_workloads + , archive_workloads ) = + initialize_workloads ~logger network_config + in + let services_by_id = + let all_workloads = + Core.String.Map.data seed_workloads + @ Core.String.Map.data snark_coordinator_workloads + @ Core.String.Map.data snark_worker_workloads + @ Core.String.Map.data block_producer_workloads + @ Core.String.Map.data archive_workloads + in + all_workloads + |> List.map ~f:(fun w -> (w.service_name, w)) + |> String.Map.of_alist_exn + in + let open Deferred.Let_syntax in + let docker_dir = network_config.docker.stack_name in + let docker_compose_file_path = + network_config.docker.stack_name ^ ".compose.json" + in + let%bind () = + generate_docker_stack_file ~logger ~docker_dir ~docker_compose_file_path + ~network_config + in + let%bind () = + write_docker_bind_volumes ~logger ~docker_dir ~network_config + in + let t = + { stack_name = network_config.docker.stack_name + ; logger + ; docker_dir + ; docker_compose_file_path + ; constants = network_config.constants + ; graphql_enabled = true + ; seed_workloads + ; block_producer_workloads + ; snark_coordinator_workloads + ; snark_worker_workloads + ; archive_workloads + ; services_by_id + ; deployed = false + ; genesis_keypairs = network_config.genesis_keypairs + } + in + [%log info] "Initializing docker swarm" ; + Malleable_error.return t + + let deploy t = + let logger = t.logger in + if t.deployed then failwith "network already deployed" ; + [%log info] "Deploying stack '%s' from %s" t.stack_name t.docker_dir ; + let open Malleable_error.Let_syntax in + let%bind (_ : string) = + Util.run_cmd_or_hard_error t.docker_dir "docker" + [ "stack"; "deploy"; "-c"; t.docker_compose_file_path; t.stack_name ] + in + t.deployed <- true ; + let%bind () = poll_until_stack_deployed ~logger in + let open Malleable_error.Let_syntax in + let func_for_fold ~(key : string) ~data accum_M = + let%bind mp = accum_M in + let%map node = + Docker_network.Service_to_deploy.get_node_from_service data + in + Core.String.Map.add_exn mp ~key ~data:node + in + let%map seeds = + Core.String.Map.fold t.seed_workloads + ~init:(Malleable_error.return Core.String.Map.empty) + ~f:func_for_fold + and block_producers = + Core.String.Map.fold t.block_producer_workloads + ~init:(Malleable_error.return Core.String.Map.empty) + ~f:func_for_fold + and snark_coordinators = + Core.String.Map.fold t.snark_coordinator_workloads + ~init:(Malleable_error.return Core.String.Map.empty) + ~f:func_for_fold + and snark_workers = + Core.String.Map.fold t.snark_worker_workloads + ~init:(Malleable_error.return Core.String.Map.empty) + ~f:func_for_fold + and archive_nodes = + Core.String.Map.fold t.archive_workloads + ~init:(Malleable_error.return Core.String.Map.empty) + ~f:func_for_fold + in + let network = + { Docker_network.namespace = t.stack_name + ; constants = t.constants + ; seeds + ; block_producers + ; snark_coordinators + ; snark_workers + ; archive_nodes + ; genesis_keypairs = t.genesis_keypairs + } + in + let nodes_to_string = + Fn.compose (String.concat ~sep:", ") (List.map ~f:Docker_network.Node.id) + in + [%log info] "Network deployed" ; + [%log info] "testnet namespace: %s" t.stack_name ; + [%log info] "snark coordinators: %s" + (nodes_to_string (Core.String.Map.data network.snark_coordinators)) ; + [%log info] "snark workers: %s" + (nodes_to_string (Core.String.Map.data network.snark_workers)) ; + [%log info] "block producers: %s" + (nodes_to_string (Core.String.Map.data network.block_producers)) ; + [%log info] "archive nodes: %s" + (nodes_to_string (Core.String.Map.data network.archive_nodes)) ; + network + + let destroy t = + [%log' info t.logger] "Destroying network" ; + if not t.deployed then failwith "network not deployed" ; + let%bind _ = + Util.run_cmd_exn "/" "docker" [ "stack"; "rm"; t.stack_name ] + in + t.deployed <- false ; + Deferred.unit + + let cleanup t = + let%bind () = if t.deployed then destroy t else return () in + [%log' info t.logger] "Cleaning up network configuration" ; + let%bind () = File_system.remove_dir t.docker_dir in + Deferred.unit + + let destroy t = + Deferred.Or_error.try_with ~here:[%here] (fun () -> destroy t) + |> Deferred.bind ~f:Malleable_error.or_hard_error +end