Refactor Archive Node Test and Fixtures

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) ) )
+        ] )
     ]

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

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")

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

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 ()

src/test/archive/archive_node_tests/upgrade_archive.ml

@@ -12,23 +12,21 @@ 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
      ```
 *)
 
 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