diff --git a/src/test/archive/archive_node_tests/archive_node_tests.ml b/src/test/archive/archive_node_tests/archive_node_tests.ml index 3ac5928746ce..d7ef263e03ce 100644 --- a/src/test/archive/archive_node_tests/archive_node_tests.ml +++ b/src/test/archive/archive_node_tests/archive_node_tests.ml @@ -1,9 +1,17 @@ open Core open Mina_automation_runner +let logger = Logger.create () + let () = Backtrace.elide := false ; - Async.Scheduler.set_record_backtraces true + Async.Scheduler.set_record_backtraces true ; + let random_seed = + Time.(now () |> to_span_since_epoch |> Span.to_ms) |> Int.of_float + in + [%log info] "Initializing random with seed" + ~metadata:[ ("seed", `Int random_seed) ] ; + Random.init random_seed let () = let open Alcotest in @@ -32,4 +40,13 @@ let () = ( module Mina_automation_fixture.Archive.Make_FixtureWithBootstrap (Upgrade_archive) ) ) ] ) + ; ( "live_upgrade_archive" + , [ test_case + "Recreate database from precomputed blocks. Meanwhile run upgrade \ + script randomly at some time" + `Quick + (Runner.run_blocking + ( module Mina_automation_fixture.Archive.Make_FixtureWithBootstrap + (Live_upgrade_archive) ) ) + ] ) ] diff --git a/src/test/archive/archive_node_tests/archive_precomputed_blocks_test.ml b/src/test/archive/archive_node_tests/archive_precomputed_blocks_test.ml index 5eda51a0063b..3ecbf767456b 100644 --- a/src/test/archive/archive_node_tests/archive_precomputed_blocks_test.ml +++ b/src/test/archive/archive_node_tests/archive_precomputed_blocks_test.ml @@ -69,7 +69,6 @@ let perf_metrics_to_yojson metrics = @raises Failure if a log line cannot be parsed as valid JSON @raises exn if required metadata fields ("elapsed" or "label") are missing *) let extract_perf_metrics log_file = - let open Deferred.Let_syntax in let%bind lines = Reader.file_lines log_file in let perf_metrics = List.filter_map lines ~f:(fun line -> @@ -122,7 +121,7 @@ let test_case (test_data : t) = unpack_precomputed_blocks test_data.network_data ~temp_dir:test_data.temp_dir in - let log_file = output ^ "/precomputed_blocks_test.log" in + let log_file = output ^/ "precomputed_blocks_test.log" in Archive.Process.start_logging test_data.archive ~log_file ; let%bind () = Daemon.archive_blocks_from_files daemon.executor @@ -142,7 +141,7 @@ let test_case (test_data : t) = archive_uri test_data.temp_dir in - let%bind perf_data = extract_perf_metrics log_file in + let%map perf_data = extract_perf_metrics log_file in perf_metrics_to_yojson perf_data |> Yojson.to_file "archive.perf" ; - Deferred.Or_error.return Mina_automation_fixture.Intf.Passed + Mina_automation_fixture.Intf.Passed diff --git a/src/test/archive/archive_node_tests/common.ml b/src/test/archive/archive_node_tests/common.ml index 673fd8af67fb..6d7f273cc90d 100644 --- a/src/test/archive/archive_node_tests/common.ml +++ b/src/test/archive/archive_node_tests/common.ml @@ -15,7 +15,6 @@ open Mina_automation @return Unit deferred that completes when assertion passes *) let assert_replayer_run_against_last_block ~replayer_input_file_path archive_uri output = - let open Deferred.Let_syntax in let connection = Psql.Conn_str archive_uri in let%bind latest_state_hash = Psql.run_command ~connection @@ -29,18 +28,17 @@ let assert_replayer_run_against_last_block ~replayer_input_file_path archive_uri failwith ("Failed to query latest state hash: " ^ Error.to_string_hum err) in - let output_ledger = output ^ "/output_ledger.json" in + let output_ledger = output ^/ "output_ledger.json" in let replayer = Replayer.default in - let%bind replayer_output = + let%map replayer_output = Replayer.run replayer ~archive_uri ~input_config:replayer_input_file_path ~target_state_hash:latest_state_hash ~interval_checkpoint:10 ~output_ledger () in - let () = print_endline replayer_output in + print_endline replayer_output ; let output_ledger = Replayer.Output.of_json_file_exn output_ledger in assert ( - String.equal output_ledger.target_epoch_ledgers_state_hash latest_state_hash ) ; - Deferred.unit + String.equal output_ledger.target_epoch_ledgers_state_hash latest_state_hash ) (** Unpack precomputed blocks from a source archive to a temporary directory. @@ -51,10 +49,8 @@ let assert_replayer_run_against_last_block ~replayer_input_file_path archive_uri @param source Source path of the tar archive containing precomputed blocks @return Deferred list of file paths to extracted JSON block files *) let unpack_precomputed_blocks ~temp_dir source = - let open Deferred.Let_syntax in - let%bind precomputed_blocks = + let%map precomputed_blocks = Network_data.untar_precomputed_blocks source temp_dir in - List.map precomputed_blocks ~f:(fun file -> temp_dir ^ "/" ^ file) - |> List.filter ~f:(fun file -> String.is_suffix file ~suffix:".json") - |> Deferred.return + List.map precomputed_blocks ~f:(fun file -> temp_dir ^/ file) + |> List.filter ~f:(String.is_suffix ~suffix:".json") diff --git a/src/test/archive/archive_node_tests/live_upgrade_archive.ml b/src/test/archive/archive_node_tests/live_upgrade_archive.ml new file mode 100644 index 000000000000..1cc2071d822f --- /dev/null +++ b/src/test/archive/archive_node_tests/live_upgrade_archive.ml @@ -0,0 +1,63 @@ +open Async +open Core +open Mina_automation +open Mina_automation_fixture.Archive +open Common + +(* NOTE: + To run this test, several preparation is needed + - ensure we have this test, replayer & archive node build with devnet profile + - ensure we have a data base instance up + - Run the following: + ``` + MINA_TEST_POSTGRES_URI=postgres://postgres:xxxx@localhost:5432 \ + MINA_TEST_NETWORK_DATA=./src/test/archive/sample_db \ + ./_build/default/src/test/archive/archive_node_tests/archive_node_tests.exe \ + test live_upgrade_archive + ``` +*) + +type t = Mina_automation_fixture.Archive.after_bootstrap + +let test_case (test_data : t) = + let daemon = Daemon.default () in + let archive_uri = test_data.archive.config.postgres_uri in + let temp_dir = test_data.temp_dir in + let%bind precomputed_blocks = + unpack_precomputed_blocks ~temp_dir test_data.network_data + in + let logger = Logger.create () in + let log_file = temp_dir ^/ "live_upgrade.log" in + let upgrade_path = + Archive.Scripts.filepath `Upgrade + |> Option.value_exn ~message:"Failed to find upgrade script" + in + let upgrade_script_finished = Ivar.create () in + (let%bind () = after (Time.Span.of_min (Random.float_range 0. 5.)) in + [%log info] "Starting upgrade script" ; + let%map result = + Psql.run_script ~connection:(Psql.Conn_str archive_uri) upgrade_path + in + [%log info] "Finished executing upgrade script" + ~metadata:[ ("result", `String result) ] ; + Ivar.fill upgrade_script_finished () ) + |> Deferred.don't_wait_for ; + Archive.Process.start_logging test_data.archive ~log_file ; + + let%bind () = + Daemon.archive_blocks_from_files daemon.executor + ~archive_address:test_data.archive.config.server_port ~format:`Precomputed + precomputed_blocks + in + [%log info] "Loaded all precomputed blocks" ; + + let%bind () = Ivar.read upgrade_script_finished in + + let%map () = + assert_replayer_run_against_last_block + ~replayer_input_file_path: + (Network_data.replayer_input_file_path test_data.network_data) + archive_uri temp_dir + in + + Mina_automation_fixture.Intf.Passed diff --git a/src/test/archive/archive_node_tests/load_genesis_ledger.ml b/src/test/archive/archive_node_tests/load_genesis_ledger.ml index 93987a5668c2..153adbc3e375 100644 --- a/src/test/archive/archive_node_tests/load_genesis_ledger.ml +++ b/src/test/archive/archive_node_tests/load_genesis_ledger.ml @@ -22,60 +22,56 @@ type t = Mina_automation_fixture.Archive.before_bootstrap let postgres_user_name = "postgres" let test_case (test_data : t) = - let open Deferred.Let_syntax in let config = { test_data.config with config_file = "genesis_ledgers/mainnet.json" } in let logger = Logger.create () in - let log_file = test_data.temp_dir ^ "/archive.load_genesis_ledger.log" in + let log_file = test_data.temp_dir ^/ "archive.load_genesis_ledger.log" in let%bind process = Archive.of_config config |> Archive.start in Archive.Process.start_logging process ~log_file ; - let max_postgres_memory = 4000.0 in let sleep_duration = Time.Span.of_sec 10.0 in - let max_archive_memory = 1000.0 in + + let max_archive_memory = 1024.0 in + let max_postgres_memory = 4096.0 in (* Set the duration for the archive process *) - let duration = Time.Span.of_min 10.0 in + let expected_duration = Time.Span.of_min 10.0 in [%log info] "Max Archive Memory: %s MiB" (Float.to_string max_archive_memory) ; [%log info] "Max Postgres Memory: %s MiB" (Float.to_string max_postgres_memory) ; [%log info] "Sleep Duration: %s" (Time.Span.to_string sleep_duration) ; - let%bind result = - let end_time = Time.add (Time.now ()) duration in - let rec loop () = - if Time.is_later (Time.now ()) ~than:end_time then Deferred.return () - else - let memory = Archive.Process.get_memory_usage_mib process in - let%bind () = - match memory with - | Some mem -> - [%log info] "Archive Memory usage: %s MiB" (Float.to_string mem) ; - if Float.( > ) mem max_archive_memory then - failwith "Archive process memory exceeds 1GB" - else Deferred.return () - | None -> - failwith "Error getting memory usage for archive process" - in - let%bind memory = - Utils.get_memory_usage_mib_of_user_process postgres_user_name - in - [%log info] "Postgres Memory usage: %s MiB" (Float.to_string memory) ; - if Float.( > ) memory max_postgres_memory then - failwith "Postgres memory exceeds 4GB" ; - let%bind () = Clock.after sleep_duration in - loop () - in - Monitor.try_with (fun () -> loop ()) - >>= function - | Ok () -> - Deferred.return Mina_automation_fixture.Intf.Passed - | Error exn -> - [%log error] "Test failed: %s" (Exn.to_string exn) ; - Deferred.return - @@ Mina_automation_fixture.Intf.Failed (Exn.to_string exn) + let start_time = Time.now () in + let rec loop () = + let executed_duration = Time.(diff (now ()) start_time) in + if Time.Span.(executed_duration > expected_duration) then + return Mina_automation_fixture.Intf.Passed + else + match Archive.Process.get_memory_usage_mib process with + | Some mem when Float.( > ) mem max_archive_memory -> + Mina_automation_fixture.Intf.Failed + (Error.create "Archive process memory exceeds 1GiB" mem + Float.sexp_of_t ) + |> return + | None -> + Mina_automation_fixture.Intf.Failed + (Error.createf "Error getting memory usage for archive process") + |> return + | Some mem -> + [%log info] "Archive Memory usage: %s MiB" (Float.to_string mem) ; + let%bind memory = + Utils.get_memory_usage_mib_of_user_process postgres_user_name + in + if Float.( > ) memory max_postgres_memory then + Mina_automation_fixture.Intf.Failed + (Error.create "Postgres memory exceeds 4GiB" memory + Float.sexp_of_t ) + |> return + else ( + [%log info] "Postgres Memory usage: %s MiB" (Float.to_string memory) ; + let%bind () = Clock.after sleep_duration in + loop () ) in - - Deferred.Or_error.return result + loop () diff --git a/src/test/archive/archive_node_tests/upgrade_archive.ml b/src/test/archive/archive_node_tests/upgrade_archive.ml index de8d4097f545..3c65cc057b1d 100644 --- a/src/test/archive/archive_node_tests/upgrade_archive.ml +++ b/src/test/archive/archive_node_tests/upgrade_archive.ml @@ -12,8 +12,7 @@ open Common ``` MINA_TEST_POSTGRES_URI=postgres://postgres:xxxx@localhost:5432 \ MINA_TEST_NETWORK_DATA=./src/test/archive/sample_db \ - DUNE_PROFILE=devnet \ - dune exec src/test/archive/archive_node_tests/archive_node_tests.exe -- \ + ./_build/default/src/test/archive/archive_node_tests/archive_node_tests.exe \ test upgrade_archive ``` *) @@ -21,14 +20,13 @@ open Common type t = Mina_automation_fixture.Archive.after_bootstrap let test_case (test_data : t) = - let open Deferred.Let_syntax in let daemon = Daemon.default () in let archive_uri = test_data.archive.config.postgres_uri in let temp_dir = test_data.temp_dir in let%bind precomputed_blocks = unpack_precomputed_blocks ~temp_dir test_data.network_data in - let log_file = temp_dir ^ "/upgrade.log" in + let log_file = temp_dir ^/ "upgrade.log" in let upgrade_path = Archive.Scripts.filepath `Upgrade |> Option.value_exn ~message:"Failed to find upgrade script" @@ -44,11 +42,11 @@ let test_case (test_data : t) = precomputed_blocks in - let%bind () = + let%map () = assert_replayer_run_against_last_block ~replayer_input_file_path: (Network_data.replayer_input_file_path test_data.network_data) archive_uri temp_dir in - Deferred.Or_error.return Mina_automation_fixture.Intf.Passed + Mina_automation_fixture.Intf.Passed diff --git a/src/test/command_line_tests/command_line_tests.ml b/src/test/command_line_tests/command_line_tests.ml index 2fe3a5b1991c..90f85d4edbd0 100644 --- a/src/test/command_line_tests/command_line_tests.ml +++ b/src/test/command_line_tests/command_line_tests.ml @@ -25,31 +25,33 @@ module BackgroundMode = struct let () = printf "Daemon logs:\n%s\n" logs in Writer.flushed (Lazy.force Writer.stdout) in - let%bind () = Daemon.Client.stop_daemon process.client in - Deferred.Or_error.return Mina_automation_fixture.Intf.Passed + let%map () = Daemon.Client.stop_daemon process.client in + Mina_automation_fixture.Intf.Passed end module DaemonRecover = struct type t = Mina_automation_fixture.Daemon.before_bootstrap let test_case (test : t) = - let daemon = Daemon.of_config test.config in - let%bind () = Daemon.Config.generate_keys test.config in - let ledger_file = test.config.dirs.conf ^/ "daemon.json" in - let%bind () = - Mina_automation_fixture.Daemon.generate_random_config daemon ledger_file - in - let%bind process = Daemon.start daemon in - let%bind.Deferred.Result () = - Daemon.Client.wait_for_bootstrap process.client () - in - let%bind.Deferred.Result _ = Daemon.Process.force_kill process in - let%bind process = Daemon.start daemon in - let%bind.Deferred.Result () = - Daemon.Client.wait_for_bootstrap process.client () - in - let%bind () = Daemon.Client.stop_daemon process.client in - Deferred.Or_error.return Mina_automation_fixture.Intf.Passed + (let daemon = Daemon.of_config test.config in + let%bind () = Daemon.Config.generate_keys test.config in + let ledger_file = test.config.dirs.conf ^/ "daemon.json" in + let%bind () = + Mina_automation_fixture.Daemon.generate_random_config daemon ledger_file + in + let%bind process = Daemon.start daemon in + let%bind.Deferred.Result () = + Daemon.Client.wait_for_bootstrap process.client () + in + let%bind.Deferred.Result _ = Daemon.Process.force_kill process in + let%bind process = Daemon.start daemon in + let%bind.Deferred.Result () = + Daemon.Client.wait_for_bootstrap process.client () + in + let%map () = Daemon.Client.stop_daemon process.client in + Ok () ) + >>| function + | Ok () -> Mina_automation_fixture.Intf.Passed | Error err -> Failed err end let contain_log_output output = @@ -65,16 +67,16 @@ module LedgerHash = struct let%bind _ = Mina_automation_fixture.Daemon.generate_random_accounts daemon ledger_file in - let%bind hash = Daemon.Client.ledger_hash client ~ledger_file in - Deferred.Or_error.return - ( if contain_log_output hash then - Mina_automation_fixture.Intf.Failed "output contains log" - else if not (String.is_prefix ~prefix:"j" hash) then - Failed "invalid ledger hash prefix" - else if Int.( <> ) (String.length hash) 52 then - Failed - (Printf.sprintf "invalid ledger hash length (%d)" (String.length hash)) - else Passed ) + let%map hash = Daemon.Client.ledger_hash client ~ledger_file in + if contain_log_output hash then + Mina_automation_fixture.Intf.Failed + (Error.of_string "output contains log") + else if not (String.is_prefix ~prefix:"j" hash) then + Failed (Error.of_string "invalid ledger hash prefix") + else if Int.( <> ) (String.length hash) 52 then + Failed + (Error.createf "invalid ledger hash length (%d)" (String.length hash)) + else Passed end module LedgerCurrency = struct @@ -92,17 +94,16 @@ module LedgerCurrency = struct Currency.Balance.to_nanomina_int account.balance ) |> List.sum (module Int) ~f:Fn.id in - let%bind output = Daemon.Client.ledger_currency client ~ledger_file in + let%map output = Daemon.Client.ledger_currency client ~ledger_file in let actual = Scanf.sscanf output "MINA : %f" Fn.id in let total_currency_float = float_of_int total_currency /. 1000000000.0 in - Deferred.Or_error.return - @@ if contain_log_output output then - Mina_automation_fixture.Intf.Failed "output contains log" + Mina_automation_fixture.Intf.Failed + (Error.of_string "output contains log") else if not Float.(abs (total_currency_float - actual) < 0.001) then Failed - (Printf.sprintf "invalid mina total count %f vs %f" total_currency_float + (Error.createf "invalid mina total count %f vs %f" total_currency_float actual ) else Passed end @@ -113,15 +114,14 @@ module AdvancedPrintSignatureKind = struct let test_case (test : t) = let daemon = Daemon.of_config test.config in let client = Daemon.client daemon in - let%bind output = Daemon.Client.advanced_print_signature_kind client in + let%map output = Daemon.Client.advanced_print_signature_kind client in let expected = "testnet" in - Deferred.Or_error.return - @@ if contain_log_output output then - Mina_automation_fixture.Intf.Failed "output contains log" + Mina_automation_fixture.Intf.Failed + (Error.of_string "output contains log") else if not (String.equal expected (String.strip output)) then - Failed (Printf.sprintf "invalid signature kind %s vs %s" expected output) + Failed (Error.createf "invalid signature kind %s vs %s" expected output) else Passed end @@ -137,15 +137,14 @@ module AdvancedCompileTimeConstants = struct in let temp_file = Filename.temp_file "commandline" "ledger.json" in Yojson.Safe.from_string config_content |> Yojson.Safe.to_file temp_file ; - let%bind output = + let%map output = Daemon.Client.advanced_compile_time_constants client ~config_file:temp_file in - Deferred.Or_error.return - @@ if contain_log_output output then - Mina_automation_fixture.Intf.Failed "output contains log" + Mina_automation_fixture.Intf.Failed + (Error.of_string "output contains log") else Passed end @@ -155,12 +154,11 @@ module AdvancedConstraintSystemDigests = struct let test_case (test : t) = let daemon = Daemon.of_config test.config in let client = Daemon.client daemon in - let%bind output = Daemon.Client.advanced_constraint_system_digests client in + let%map output = Daemon.Client.advanced_constraint_system_digests client in - Deferred.Or_error.return - @@ if contain_log_output output then - Mina_automation_fixture.Intf.Failed "output contains log" + Mina_automation_fixture.Intf.Failed + (Error.of_string "output contains log") else Passed end diff --git a/src/test/mina_automation/daemon.ml b/src/test/mina_automation/daemon.ml index 6609c72c81d5..d98925b34f69 100644 --- a/src/test/mina_automation/daemon.ml +++ b/src/test/mina_automation/daemon.ml @@ -193,6 +193,7 @@ type t = { config : Config.t; executor : Executor.t } let archive_blocks_from_files t ~archive_address ~format ?(sleep = 5) blocks = Deferred.List.iter blocks ~f:(fun block -> let%bind _ = archive_blocks t ~archive_address ~format [ block ] () in + (* WARN: live upgrade test expect this sleep to be present so we can emulate a race condition *) after (Time.Span.of_sec (Float.of_int sleep)) ) let of_config config = { config; executor = Executor.AutoDetect } diff --git a/src/test/mina_automation/fixture/intf.ml b/src/test/mina_automation/fixture/intf.ml index bb02dadd00da..cbaf6aac2070 100644 --- a/src/test/mina_automation/fixture/intf.ml +++ b/src/test/mina_automation/fixture/intf.ml @@ -1,11 +1,12 @@ +open Core open Async -type test_result = Passed | Failed of string | Warning of string +type test_result = Passed | Failed of Error.t | Warning of string module type TestCase = sig type t - val test_case : t -> test_result Deferred.Or_error.t + val test_case : t -> test_result Deferred.t end module type Fixture = sig @@ -24,7 +25,7 @@ module type Fixture = sig **) val setup : unit -> t Deferred.Or_error.t - val test_case : t -> test_result Deferred.Or_error.t + val test_case : t -> test_result Deferred.t val teardown : t -> unit Deferred.Or_error.t diff --git a/src/test/mina_automation/runner/runner.ml b/src/test/mina_automation/runner/runner.ml index 1f1810a4c9f3..ecfab26fa7a4 100644 --- a/src/test/mina_automation/runner/runner.ml +++ b/src/test/mina_automation/runner/runner.ml @@ -20,15 +20,17 @@ let run (module F : Intf.Fixture) = ) (fun () -> match%bind F.test_case test_case_after_setup with - | Ok result -> - return result - | Error err -> + | Failed err -> let%map () = F.on_test_fail test_case_after_setup in - Intf.Failed (Error.to_string_hum err) ) + Intf.Failed err + | result -> + return result ) let run_blocking test_case () = match Async.Thread_safe.block_on_async_exn (fun () -> run test_case) with | Intf.Passed -> () - | Warning msg | Failed msg -> + | Warning msg -> Alcotest.fail msg + | Failed err -> + Alcotest.fail (Error.to_string_hum err)