1693

Committed 22 Apr 2026 12:09PM UTC coverage: 61.484% (+8.9%) from 52.595%

Build # 1693

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #18801 from MinaProtocol/georgeee/merge-compatible-to-develop-22apr2026

Merge `compatible` -> `develop`, 22 April 2026

Coverage Stats

55 of 55 new or added lines in 2 files covered. (100.0%)

2 existing lines in 1 file now uncovered.

53084 of 86338 relevant lines covered (61.48%)

476386.14 hits per line

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

57.14

/src/app/missing_blocks_auditor/missing_blocks_auditor.ml

(* missing_blocks_auditor.ml *)

open Core_kernel
open Async

(* bits in error code *)

let missing_blocks_error = 0

let pending_blocks_error = 1

let chain_length_error = 2

let chain_status_error = 3

let add_error, get_exit_code =
  let exit_code = ref 0 in
  let add_error n = exit_code := !exit_code lor (1 lsl n) in
  let get_exit_code () = !exit_code in
  (add_error, get_exit_code)

let main ~archive_uri () =
  let logger = Logger.create () in
  let archive_uri = Uri.of_string archive_uri in
  match Mina_caqti.connect_pool ~max_size:128 archive_uri with
  | Error e ->
      [%log fatal]
        ~metadata:[ ("error", `String (Caqti_error.show e)) ]
        "Failed to create a Caqti pool for Postgresql" ;
      exit 1
  | Ok pool ->
      [%log info] "Successfully created Caqti pool for Postgresql" ;
      [%log info] "Querying missing blocks" ;
      let%bind missing_blocks_raw =
        match%bind
          Mina_caqti.Pool.use (fun db -> Sql.Unparented_blocks.run db ()) pool
        with
        | Ok blocks ->
            return blocks
        | Error msg ->
            [%log error] "Error getting missing blocks"
              ~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;
            exit 1
      in
      (* filters out genesis or first fork block. This is needed as they are not considered missing and
         archive blocks can start from block with height > 1 in case of sandbox network forked from devnet/mainnet.
         Archive of such network won't include genesis block but fork block as a first block *)
      let%bind genesis_or_fork_block_height =
        match%bind
          Mina_caqti.Pool.use
            (fun db -> Sql.GenesisOrFirstForkBlockHeight.run db ())
            pool
        with
        | Ok height ->
            return height
        | Error msg ->
            [%log error] "Error getting genesis or first fork block height"
              ~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;
            exit 1
      in
      let missing_blocks =
        List.filter missing_blocks_raw ~f:(fun (_, _, height, _) ->
            height <> genesis_or_fork_block_height )
      in
      let%bind () =
        if List.is_empty missing_blocks then
          return @@ [%log info] "There are no missing blocks in the archive db"
        else (
          add_error missing_blocks_error ;
          Deferred.List.iter missing_blocks
            ~f:(fun (block_id, state_hash, height, parent_hash) ->
              match%map
                Mina_caqti.Pool.use
                  (fun db -> Sql.Missing_blocks_gap.run db height)
                  pool
              with
              | Ok gap_size ->
                  [%log info] "Block has no parent in archive db"
                    ~metadata:
                      [ ("block_id", `Int block_id)
                      ; ("state_hash", `String state_hash)
                      ; ("height", `Int height)
                      ; ("parent_hash", `String parent_hash)
                      ; ("parent_height", `Int (height - 1))
                      ; ("missing_blocks_gap", `Int gap_size)
                      ]
              | Error msg ->
                  [%log error] "Error getting missing blocks gap"
                    ~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;
                  Core_kernel.exit 1 ) )
      in
      [%log info] "Querying for gaps in chain statuses" ;
      let%bind highest_canonical =
        match%bind
          Mina_caqti.Pool.use
            (fun db -> Sql.Chain_status.run_highest_canonical db ())
            pool
        with
        | Ok height ->
            return height
        | Error msg ->
            [%log error] "Error getting greatest height of canonical blocks"
              ~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;
            exit 1
      in
      let%bind pending_below =
        match%bind
          Mina_caqti.Pool.use
            (fun db ->
              Sql.Chain_status.run_count_pending_below db highest_canonical )
            pool
        with
        | Ok count ->
            return count
        | Error msg ->
            [%log error]
              "Error getting number of pending blocks below highest canonical \
               block"
              ~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;
            exit 1
      in
      if Int64.equal pending_below Int64.zero then
        [%log info] "There are no gaps in the chain statuses"
      else (
        add_error pending_blocks_error ;
        [%log info]
          "There are $num_pending_blocks_below pending blocks lower than the \
           highest canonical block"
          ~metadata:
            [ ( "max_height_canonical_block"
              , `String (Int64.to_string highest_canonical) )
            ; ( "num_pending_blocks_below"
              , `String (Int64.to_string pending_below) )
            ] ) ;
      let%bind canonical_chain =
        match%bind
          Mina_caqti.Pool.use
            (fun db -> Sql.Chain_status.run_canonical_chain db highest_canonical)
            pool
        with
        | Ok chain ->
            return chain
        | Error msg ->
            [%log error] "Error getting canonical chain"
              ~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;
            exit 1
      in
      let chain_len = List.length canonical_chain |> Int64.of_int in
      if Int64.equal chain_len highest_canonical then
        [%log info] "Length of canonical chain is %Ld blocks" chain_len
      else (
        add_error chain_length_error ;
        if genesis_or_fork_block_height = 1 then
          [%log info] "Length of canonical chain is %Ld blocks, expected: %Ld"
            chain_len highest_canonical
        else
          [%log info]
            "Length of canonical chain is %Ld blocks, expected: %Ld. (Note: \
             genesis or first fork block has height %d)"
            chain_len highest_canonical genesis_or_fork_block_height ) ;
      let invalid_chain =
        List.filter canonical_chain
          ~f:(fun (_block_id, _state_hash, chain_status) ->
            not (String.equal chain_status "canonical") )
      in
      if List.is_empty invalid_chain then
        [%log info]
          "All blocks along the canonical chain have a valid chain status"
      else add_error chain_status_error ;
      List.iter invalid_chain ~f:(fun (block_id, state_hash, chain_status) ->
          [%log info]
            "Canonical block has a chain_status other than \"canonical\""
            ~metadata:
              [ ("block_id", `Int block_id)
              ; ("state_hash", `String state_hash)
              ; ("chain_status", `String chain_status)
              ] ) ;
      Core.exit (get_exit_code ())

let () =
  Command.(
    run
      (let open Let_syntax in
      Command.async
        ~summary:"Report state hashes of blocks missing from archive database"
        (let%map archive_uri =
           Param.flag "--archive-uri"
             ~doc:
               "URI URI for connecting to the archive database (e.g., \
                postgres://$USER@localhost:5432/archiver)"
             Param.(required string)
         in
         main ~archive_uri )))

1	(* missing_blocks_auditor.ml *)
2
3	open Core_kernel
4	open Async
5
6	(* bits in error code *)
7
8	let missing_blocks_error = 0
9
10	let pending_blocks_error = 1
11
12	let chain_length_error = 2
13
14	let chain_status_error = 3
15
16	let add_error, get_exit_code =
17	let exit_code = ref 0 in
18	let add_error n = exit_code := !exit_code lor (1 lsl n) in	34✔
19	let get_exit_code () = !exit_code in	18✔
20	(add_error, get_exit_code)
21
22	let main ~archive_uri () =
23	let logger = Logger.create () in	18✔
24	let archive_uri = Uri.of_string archive_uri in	18✔
25	match Mina_caqti.connect_pool ~max_size:128 archive_uri with	18✔
26	\| Error e ->	×
27	[%log fatal]	×
28	~metadata:[ ("error", `String (Caqti_error.show e)) ]	×
29	"Failed to create a Caqti pool for Postgresql" ;
30	exit 1	×
31	\| Ok pool ->	18✔
32	[%log info] "Successfully created Caqti pool for Postgresql" ;	18✔
33	[%log info] "Querying missing blocks" ;	18✔
34	let%bind missing_blocks_raw =
35	match%bind
36	Mina_caqti.Pool.use (fun db -> Sql.Unparented_blocks.run db ()) pool	18✔
37	with
38	\| Ok blocks ->	18✔
39	return blocks
40	\| Error msg ->	×
41	[%log error] "Error getting missing blocks"	×
42	~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;	×
43	exit 1	×
44	in
45	(* filters out genesis or first fork block. This is needed as they are not considered missing and
46	archive blocks can start from block with height > 1 in case of sandbox network forked from devnet/mainnet.
47	Archive of such network won't include genesis block but fork block as a first block *)
48	let%bind genesis_or_fork_block_height =
49	match%bind
50	Mina_caqti.Pool.use	18✔
51	(fun db -> Sql.GenesisOrFirstForkBlockHeight.run db ())	18✔
52	pool
53	with
54	\| Ok height ->	18✔
55	return height
56	\| Error msg ->	×
57	[%log error] "Error getting genesis or first fork block height"	×
58	~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;	×
59	exit 1	×
60	in
61	let missing_blocks =	18✔
62	List.filter missing_blocks_raw ~f:(fun (_, _, height, _) ->
63	height <> genesis_or_fork_block_height )	89✔
64	in
65	let%bind () =
66	if List.is_empty missing_blocks then
67	return @@ [%log info] "There are no missing blocks in the archive db"	1✔
68	else (	17✔
69	add_error missing_blocks_error ;
70	Deferred.List.iter missing_blocks	17✔
71	~f:(fun (block_id, state_hash, height, parent_hash) ->
72	match%map
73	Mina_caqti.Pool.use	71✔
74	(fun db -> Sql.Missing_blocks_gap.run db height)	71✔
75	pool
76	with
77	\| Ok gap_size ->	71✔
78	[%log info] "Block has no parent in archive db"	71✔
79	~metadata:
80	[ ("block_id", `Int block_id)
81	; ("state_hash", `String state_hash)
82	; ("height", `Int height)
83	; ("parent_hash", `String parent_hash)
84	; ("parent_height", `Int (height - 1))
85	; ("missing_blocks_gap", `Int gap_size)
86	]
87	\| Error msg ->	×
88	[%log error] "Error getting missing blocks gap"	×
89	~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;	×
90	Core_kernel.exit 1 ) )	×
91	in
92	[%log info] "Querying for gaps in chain statuses" ;	18✔
93	let%bind highest_canonical =
94	match%bind
95	Mina_caqti.Pool.use	18✔
96	(fun db -> Sql.Chain_status.run_highest_canonical db ())	18✔
97	pool
98	with
99	\| Ok height ->	18✔
100	return height
101	\| Error msg ->	×
102	[%log error] "Error getting greatest height of canonical blocks"	×
103	~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;	×
104	exit 1	×
105	in
106	let%bind pending_below =
107	match%bind
108	Mina_caqti.Pool.use	18✔
109	(fun db ->
110	Sql.Chain_status.run_count_pending_below db highest_canonical )	18✔
111	pool
112	with
113	\| Ok count ->	18✔
114	return count
115	\| Error msg ->	×
116	[%log error]	×
117	"Error getting number of pending blocks below highest canonical \
118	block"
119	~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;	×
120	exit 1	×
121	in
122	if Int64.equal pending_below Int64.zero then	18✔
123	[%log info] "There are no gaps in the chain statuses"	18✔
124	else (	×
125	add_error pending_blocks_error ;
126	[%log info]	×
127	"There are $num_pending_blocks_below pending blocks lower than the \
128	highest canonical block"
129	~metadata:
130	[ ( "max_height_canonical_block"
131	, `String (Int64.to_string highest_canonical) )	×
132	; ( "num_pending_blocks_below"
133	, `String (Int64.to_string pending_below) )	×
134	] ) ;
135	let%bind canonical_chain =
136	match%bind
137	Mina_caqti.Pool.use	18✔
138	(fun db -> Sql.Chain_status.run_canonical_chain db highest_canonical)	18✔
139	pool
140	with
141	\| Ok chain ->	18✔
142	return chain
143	\| Error msg ->	×
144	[%log error] "Error getting canonical chain"	×
145	~metadata:[ ("error", `String (Caqti_error.show msg)) ] ;	×
146	exit 1	×
147	in
148	let chain_len = List.length canonical_chain \|> Int64.of_int in	18✔
149	if Int64.equal chain_len highest_canonical then	18✔
150	[%log info] "Length of canonical chain is %Ld blocks" chain_len	1✔
151	else (	17✔
152	add_error chain_length_error ;
153	if genesis_or_fork_block_height = 1 then	17✔
154	[%log info] "Length of canonical chain is %Ld blocks, expected: %Ld"	17✔
155	chain_len highest_canonical
156	else
157	[%log info]	×
158	"Length of canonical chain is %Ld blocks, expected: %Ld. (Note: \
159	genesis or first fork block has height %d)"
160	chain_len highest_canonical genesis_or_fork_block_height ) ;
161	let invalid_chain =
162	List.filter canonical_chain
163	~f:(fun (_block_id, _state_hash, chain_status) ->
164	not (String.equal chain_status "canonical") )	42✔
165	in
166	if List.is_empty invalid_chain then	18✔
167	[%log info]	18✔
168	"All blocks along the canonical chain have a valid chain status"
UNCOV 169	else add_error chain_status_error ;	×
170	List.iter invalid_chain ~f:(fun (block_id, state_hash, chain_status) ->
UNCOV 171	[%log info]	×
172	"Canonical block has a chain_status other than \"canonical\""
173	~metadata:
174	[ ("block_id", `Int block_id)
175	; ("state_hash", `String state_hash)
176	; ("chain_status", `String chain_status)
177	] ) ;
178	Core.exit (get_exit_code ())	18✔
179
180	let () =
181	Command.(
182	run	×
183	(let open Let_syntax in
184	Command.async	18✔
185	~summary:"Report state hashes of blocks missing from archive database"
186	(let%map archive_uri =
187	Param.flag "--archive-uri"	18✔
188	~doc:
189	"URI URI for connecting to the archive database (e.g., \
190	postgres://$USER@localhost:5432/archiver)"
191	Param.(required string)	18✔
192	in
193	main ~archive_uri )))	18✔

MinaProtocol / mina / 1693

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