MinaProtocol / mina / 411

Committed 24 Jul 2025 03:14PM UTC coverage: 33.188% (-27.7%) from 60.871%

Build # 411

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #17541 from MinaProtocol/brian/merge-compatible-into-develop

Merge compatible into develop

Coverage Stats

164 of 702 new or added lines in 96 files covered. (23.36%)

18243 existing lines in 393 files now uncovered.

23983 of 72264 relevant lines covered (33.19%)

24667.26 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

92.86

/src/test/archive/patch_archive_test/patch_archive_test.ml

(* patch_archive_test.ml *)

(* test patching of archive databases

   test structure:
    - import reference database for comparision (for example with 100 blocks)
    - create new schema and export blocks from reference db with some missing ones
    - patch the database with missing precomputed blocks
    - compare original and copy
*)

module Network_Data = struct
  type t =
    { init_script : String.t
    ; precomputed_blocks_zip : String.t
    ; genesis_ledger_file : String.t
    ; replayer_input_file : String.t
    ; folder : String.t
    }

  let create folder =
    { init_script = "archive_db.sql"
    ; genesis_ledger_file = "input.json"
    ; precomputed_blocks_zip = "precomputed_blocks.zip"
    ; replayer_input_file = "replayer_input_file.json"
    ; folder
    }
end

open Core_kernel
open Async
open Mina_automation

(* Reference: https://discuss.ocaml.org/t/more-natural-preferred-way-to-shuffle-an-array *)
let knuth_shuffle a =
  let a = Array.copy a in
  for i = Array.length a - 1 downto 1 do
    let k = Random.int (i + 1) in
    Array.swap a k i
  done ;
  a

let main ~db_uri ~network_data_folder () =
  let open Deferred.Let_syntax in
  let network_name = "dummy" in

  let network_data = Network_Data.create network_data_folder in

  let output_folder = Filename.temp_dir_name ^ "/output" in

  let%bind output_folder = Unix.mkdtemp output_folder in

  let connection = Psql.Conn_str db_uri in

  let source_db_name = "patch_archive_test_source" in
  let target_db_name = "patch_archive_test_target" in
  let%bind _ = Psql.create_empty_db ~connection ~db:source_db_name in
  let%bind _ =
    Psql.run_script ~connection ~db:source_db_name
      (network_data.folder ^ "/" ^ network_data.init_script)
  in
  let%bind () = Psql.create_mina_db ~connection ~db:target_db_name in

  let source_db = db_uri ^ "/" ^ source_db_name in
  let target_db = db_uri ^ "/" ^ target_db_name in

  let extract_blocks = Extract_blocks.default in
  let config =
    { Extract_blocks.Config.archive_uri = source_db
    ; range = Extract_blocks.Config.AllBlocks
    ; output_folder = Some output_folder
    ; network = Some network_name
    ; include_block_height_in_name = true
    }
  in
  let%bind _ = Extract_blocks.run extract_blocks ~config in

  let archive_blocks = Archive_blocks.default in

  let%bind extensional_files =
    Sys.ls_dir output_folder
    >>= Deferred.List.map ~f:(fun e ->
            Deferred.return (output_folder ^ "/" ^ e) )
  in

  let%bind () =
    if List.length extensional_files < 3 then (
      printf
        "Need at least 3 blocks to have meaningful intermediate block to patch \
         against" ;
      exit 1 )
    else Deferred.unit
  in
  let missing_blocks_count = min 3 (List.length extensional_files - 2) in

  (* never remove last and first block as missing-block-guardian can have issues
     when patching "border" blocks as it expect to fill gaps in the middle
  *)
  let candidate_blocks =
    Array.init (List.length extensional_files - 2) ~f:Int.succ
  in
  let missing_blocks =
    Array.slice (knuth_shuffle candidate_blocks) 0 missing_blocks_count
  in
  let unpatched_extensional_files =
    List.filteri extensional_files ~f:(fun i _ ->
        not (Array.mem missing_blocks i ~equal:Int.equal) )
    |> Utils.dedup_and_sort_archive_files
  in

  let%bind _ =
    Archive_blocks.run archive_blocks ~blocks:unpatched_extensional_files
      ~archive_uri:target_db ~format:Extensional
  in

  let%bind missing_blocks_auditor_path = Missing_blocks_auditor.path in

  let%bind archive_blocks_path = Archive_blocks.path in

  let config =
    { Missing_blocks_guardian.Config.archive_uri = Uri.of_string target_db
    ; precomputed_blocks = Uri.make ~scheme:"file" ~path:output_folder ()
    ; network = network_name
    ; run_mode = Run
    ; missing_blocks_auditor = missing_blocks_auditor_path
    ; archive_blocks = archive_blocks_path
    ; block_format = Extensional
    }
  in

  let missing_blocks_guardian = Missing_blocks_guardian.default in

  let%bind _ = Missing_blocks_guardian.run missing_blocks_guardian ~config in

  let replayer = Replayer.default in

  let%bind _ =
    Replayer.run replayer ~archive_uri:target_db
      ~input_config:
        (network_data.folder ^ "/" ^ network_data.replayer_input_file)
      ~interval_checkpoint:10 ~output_ledger:"./output_ledger" ()
  in

  Deferred.unit

let () =
  Command.(
    run
      (let open Let_syntax in
      async ~summary:"Test patching of blocks in an archive database"
        (let%map db_uri =
           Param.flag "--source-uri"
             ~doc:
               "URI URI for connecting to the database (e.g., \
                postgres://$USER@localhost:5432)"
             Param.(required string)
         and network_data_folder =
           Param.(
             flag "--network-data-folder" ~aliases:[ "network-data-folder" ]
               Param.(required string))
             ~doc:
               "Path Path to folder containing network data. Usually it's sql \
                for db import, genesis ledger and zipped precomputed blocks \
                archive"
         in
         main ~db_uri ~network_data_folder )))

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"	1✔
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	(* Reference: https://discuss.ocaml.org/t/more-natural-preferred-way-to-shuffle-an-array *)
35	let knuth_shuffle a =
36	let a = Array.copy a in	1✔
37	for i = Array.length a - 1 downto 1 do	1✔
38	let k = Random.int (i + 1) in	41✔
39	Array.swap a k i	41✔
40	done ;
41	a
42
43	let main ~db_uri ~network_data_folder () =
44	let open Deferred.Let_syntax in	1✔
45	let network_name = "dummy" in
46
47	let network_data = Network_Data.create network_data_folder in
48
49	let output_folder = Filename.temp_dir_name ^ "/output" in	1✔
50
51	let%bind output_folder = Unix.mkdtemp output_folder in	1✔
52
53	let connection = Psql.Conn_str db_uri in	1✔
54
55	let source_db_name = "patch_archive_test_source" in
56	let target_db_name = "patch_archive_test_target" in
57	let%bind _ = Psql.create_empty_db ~connection ~db:source_db_name in
58	let%bind _ =
59	Psql.run_script ~connection ~db:source_db_name	1✔
60	(network_data.folder ^ "/" ^ network_data.init_script)
61	in
62	let%bind () = Psql.create_mina_db ~connection ~db:target_db_name in
63
64	let source_db = db_uri ^ "/" ^ source_db_name in	1✔
65	let target_db = db_uri ^ "/" ^ target_db_name in
66
67	let extract_blocks = Extract_blocks.default in
68	let config =
69	{ Extract_blocks.Config.archive_uri = source_db
70	; range = Extract_blocks.Config.AllBlocks
71	; output_folder = Some output_folder
72	; network = Some network_name
73	; include_block_height_in_name = true
74	}
75	in
76	let%bind _ = Extract_blocks.run extract_blocks ~config in	1✔
77
78	let archive_blocks = Archive_blocks.default in	1✔
79
80	let%bind extensional_files =
81	Sys.ls_dir output_folder	1✔
82	>>= Deferred.List.map ~f:(fun e ->	1✔
83	Deferred.return (output_folder ^ "/" ^ e) )	44✔
84	in
85
86	let%bind () =
NEW 87	if List.length extensional_files < 3 then (	×
88	printf
89	"Need at least 3 blocks to have meaningful intermediate block to patch \
90	against" ;
NEW 91	exit 1 )	×
92	else Deferred.unit	1✔
93	in
94	let missing_blocks_count = min 3 (List.length extensional_files - 2) in	1✔
95
96	(* never remove last and first block as missing-block-guardian can have issues
97	when patching "border" blocks as it expect to fill gaps in the middle
98	*)
99	let candidate_blocks =	1✔
100	Array.init (List.length extensional_files - 2) ~f:Int.succ	1✔
101	in
102	let missing_blocks =	1✔
103	Array.slice (knuth_shuffle candidate_blocks) 0 missing_blocks_count	1✔
104	in
105	let unpatched_extensional_files =	1✔
106	List.filteri extensional_files ~f:(fun i _ ->
107	not (Array.mem missing_blocks i ~equal:Int.equal) )	44✔
108	\|> Utils.dedup_and_sort_archive_files	1✔
109	in
110
111	let%bind _ =
112	Archive_blocks.run archive_blocks ~blocks:unpatched_extensional_files	1✔
113	~archive_uri:target_db ~format:Extensional
114	in
115
116	let%bind missing_blocks_auditor_path = Missing_blocks_auditor.path in
117
118	let%bind archive_blocks_path = Archive_blocks.path in
119
120	let config =	1✔
121	{ Missing_blocks_guardian.Config.archive_uri = Uri.of_string target_db	1✔
122	; precomputed_blocks = Uri.make ~scheme:"file" ~path:output_folder ()	1✔
123	; network = network_name
124	; run_mode = Run
125	; missing_blocks_auditor = missing_blocks_auditor_path
126	; archive_blocks = archive_blocks_path
127	; block_format = Extensional
128	}
129	in
130
131	let missing_blocks_guardian = Missing_blocks_guardian.default in
132
133	let%bind _ = Missing_blocks_guardian.run missing_blocks_guardian ~config in	1✔
134
135	let replayer = Replayer.default in	1✔
136
137	let%bind _ =
138	Replayer.run replayer ~archive_uri:target_db	1✔
139	~input_config:
140	(network_data.folder ^ "/" ^ network_data.replayer_input_file)
141	~interval_checkpoint:10 ~output_ledger:"./output_ledger" ()
142	in
143
144	Deferred.unit	1✔
145
146	let () =
147	Command.(
148	run	×
149	(let open Let_syntax in
150	async ~summary:"Test patching of blocks in an archive database"	1✔
151	(let%map db_uri =
152	Param.flag "--source-uri"	1✔
153	~doc:
154	"URI URI for connecting to the database (e.g., \
155	postgres://$USER@localhost:5432)"
156	Param.(required string)	1✔
157	and network_data_folder =
158	Param.(
159	flag "--network-data-folder" ~aliases:[ "network-data-folder" ]	1✔
160	Param.(required string))	1✔
161	~doc:
162	"Path Path to folder containing network data. Usually it's sql \
163	for db import, genesis ledger and zipped precomputed blocks \
164	archive"
165	in
166	main ~db_uri ~network_data_folder )))	1✔

MinaProtocol / mina / 411

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous