|
| 1 | +(* patch_archive_test.ml *) |
| 2 | + |
| 3 | +(* test patching of archive databases |
| 4 | +
|
| 5 | + test structure: |
| 6 | + - import reference database for comparision (for example with 100 blocks) |
| 7 | + - create new schema and export blocks from reference db with some missing ones |
| 8 | + - patch the database with missing precomputed blocks |
| 9 | + - compare original and copy |
| 10 | +*) |
| 11 | + |
| 12 | +module Network_Data = struct |
| 13 | + type t = |
| 14 | + { init_script : String.t |
| 15 | + ; precomputed_blocks_zip : String.t |
| 16 | + ; genesis_ledger_file : String.t |
| 17 | + ; replayer_input_file : String.t |
| 18 | + ; folder : String.t |
| 19 | + } |
| 20 | + |
| 21 | + let create folder = |
| 22 | + { init_script = "archive_db.sql" |
| 23 | + ; genesis_ledger_file = "input.json" |
| 24 | + ; precomputed_blocks_zip = "precomputed_blocks.zip" |
| 25 | + ; replayer_input_file = "replayer_input_file.json" |
| 26 | + ; folder |
| 27 | + } |
| 28 | +end |
| 29 | + |
| 30 | +open Core_kernel |
| 31 | +open Async |
| 32 | +open Mina_automation |
| 33 | + |
| 34 | +let main ~db_uri ~network_data_folder () = |
| 35 | + let open Deferred.Let_syntax in |
| 36 | + let missing_blocks_count = 3 in |
| 37 | + let network_name = "dummy" in |
| 38 | + |
| 39 | + let network_data = Network_Data.create network_data_folder in |
| 40 | + |
| 41 | + let output_folder = Filename.temp_dir_name ^ "/output" in |
| 42 | + |
| 43 | + let%bind output_folder = Unix.mkdtemp output_folder in |
| 44 | + |
| 45 | + let connection = Psql.Conn_str db_uri in |
| 46 | + |
| 47 | + let source_db_name = "patch_archive_test_source" in |
| 48 | + let target_db_name = "patch_archive_test_target" in |
| 49 | + let%bind _ = Psql.create_empty_db ~connection ~db:source_db_name in |
| 50 | + let%bind _ = |
| 51 | + Psql.run_script ~connection ~db:source_db_name |
| 52 | + (network_data.folder ^ "/" ^ network_data.init_script) |
| 53 | + in |
| 54 | + let%bind () = Psql.create_mina_db ~connection ~db:target_db_name in |
| 55 | + |
| 56 | + let source_db = db_uri ^ "/" ^ source_db_name in |
| 57 | + let target_db = db_uri ^ "/" ^ target_db_name in |
| 58 | + |
| 59 | + let extract_blocks = Extract_blocks.of_context Executor.AutoDetect in |
| 60 | + let config = |
| 61 | + { Extract_blocks.Config.archive_uri = source_db |
| 62 | + ; range = Extract_blocks.Config.AllBlocks |
| 63 | + ; output_folder = Some output_folder |
| 64 | + ; network = Some network_name |
| 65 | + ; include_block_height_in_name = true |
| 66 | + } |
| 67 | + in |
| 68 | + let%bind _ = Extract_blocks.run extract_blocks ~config in |
| 69 | + |
| 70 | + let archive_blocks = Archive_blocks.of_context Executor.AutoDetect in |
| 71 | + |
| 72 | + let%bind extensional_files = |
| 73 | + Sys.ls_dir output_folder |
| 74 | + >>= Deferred.List.map ~f:(fun e -> |
| 75 | + Deferred.return (output_folder ^ "/" ^ e) ) |
| 76 | + in |
| 77 | + |
| 78 | + let n = |
| 79 | + List.init missing_blocks_count ~f:(fun _ -> |
| 80 | + Random.int (List.length extensional_files) ) |
| 81 | + in |
| 82 | + |
| 83 | + let unpatched_extensional_files = |
| 84 | + List.filteri extensional_files ~f:(fun i _ -> |
| 85 | + not (List.mem n i ~equal:Int.equal) ) |
| 86 | + |> List.dedup_and_sort ~compare:(fun left right -> |
| 87 | + let scan_height item = |
| 88 | + let item = |
| 89 | + Filename.basename item |> Str.global_replace (Str.regexp "-") " " |
| 90 | + in |
| 91 | + Scanf.sscanf item "%s %d %s" (fun _ height _ -> height) |
| 92 | + in |
| 93 | + |
| 94 | + let left_height = scan_height left in |
| 95 | + let right_height = scan_height right in |
| 96 | + |
| 97 | + Int.compare left_height right_height ) |
| 98 | + in |
| 99 | + |
| 100 | + let%bind _ = |
| 101 | + Archive_blocks.run archive_blocks ~blocks:unpatched_extensional_files |
| 102 | + ~archive_uri:target_db ~format:Extensional |
| 103 | + in |
| 104 | + |
| 105 | + let%bind missing_blocks_auditor_path = |
| 106 | + Missing_blocks_auditor.of_context Executor.AutoDetect |
| 107 | + |> Missing_blocks_auditor.path |
| 108 | + in |
| 109 | + |
| 110 | + let%bind archive_blocks_path = Archive_blocks.path archive_blocks in |
| 111 | + |
| 112 | + let config = |
| 113 | + { Missing_blocks_guardian.Config.archive_uri = Uri.of_string target_db |
| 114 | + ; precomputed_blocks = Uri.make ~scheme:"file" ~path:output_folder () |
| 115 | + ; network = network_name |
| 116 | + ; run_mode = Run |
| 117 | + ; missing_blocks_auditor = missing_blocks_auditor_path |
| 118 | + ; archive_blocks = archive_blocks_path |
| 119 | + ; block_format = Extensional |
| 120 | + } |
| 121 | + in |
| 122 | + |
| 123 | + let missing_blocks_guardian = |
| 124 | + Missing_blocks_guardian.of_context Executor.AutoDetect |
| 125 | + in |
| 126 | + |
| 127 | + let%bind _ = Missing_blocks_guardian.run missing_blocks_guardian ~config in |
| 128 | + |
| 129 | + let replayer = Replayer.of_context Executor.AutoDetect in |
| 130 | + |
| 131 | + let%bind _ = |
| 132 | + Replayer.run replayer ~archive_uri:target_db |
| 133 | + ~input_config: |
| 134 | + (network_data.folder ^ "/" ^ network_data.replayer_input_file) |
| 135 | + ~interval_checkpoint:10 ~output_ledger:"./output_ledger" () |
| 136 | + in |
| 137 | + |
| 138 | + Deferred.unit |
| 139 | + |
| 140 | +let () = |
| 141 | + Command.( |
| 142 | + run |
| 143 | + (let open Let_syntax in |
| 144 | + async ~summary:"Test patching of blocks in an archive database" |
| 145 | + (let%map db_uri = |
| 146 | + Param.flag "--source-uri" |
| 147 | + ~doc: |
| 148 | + "URI URI for connecting to the database (e.g., \ |
| 149 | + postgres://$USER@localhost:5432)" |
| 150 | + Param.(required string) |
| 151 | + and network_data_folder = |
| 152 | + Param.( |
| 153 | + flag "--network-data-folder" ~aliases:[ "network-data-folder" ] |
| 154 | + Param.(required string)) |
| 155 | + ~doc: |
| 156 | + "Path Path to folder containing network data. Usually it's sql \ |
| 157 | + for db import, genesis ledger and zipped precomputed blocks \ |
| 158 | + archive" |
| 159 | + in |
| 160 | + main ~db_uri ~network_data_folder ))) |
0 commit comments