diff --git a/Makefile b/Makefile index 3c23ad69123..3d3616c64ec 100755 --- a/Makefile +++ b/Makefile @@ -221,6 +221,7 @@ build-archive-utils: ocaml_checks reformat-diff ## Build archive node and relate src/app/archive_blocks/archive_blocks.exe \ src/app/extract_blocks/extract_blocks.exe \ src/app/missing_blocks_auditor/missing_blocks_auditor.exe \ + src/app/archive_hardfork_toolbox/archive_hardfork_toolbox.exe \ --profile=$(DUNE_PROFILE) \ && echo "āœ… Build complete" diff --git a/changes/17955.md b/changes/17955.md new file mode 100644 index 00000000000..d1a47e0114e --- /dev/null +++ b/changes/17955.md @@ -0,0 +1,3 @@ +Archive Hardfork Toolbox + +Utility tool for various hardfork verifications or confirmations regarding hardfork runbook automation \ No newline at end of file diff --git a/scripts/debian/builder-helpers.sh b/scripts/debian/builder-helpers.sh index f653f2aa0ab..b5e9771b0f9 100755 --- a/scripts/debian/builder-helpers.sh +++ b/scripts/debian/builder-helpers.sh @@ -714,6 +714,8 @@ copy_common_archive_configs() { "${BUILDDIR}/usr/local/bin/mina-archive-blocks" cp ./default/src/app/extract_blocks/extract_blocks.exe \ "${BUILDDIR}/usr/local/bin/mina-extract-blocks" + cp ./default/src/app/archive_hardfork_toolbox/archive_hardfork_toolbox.exe \ + "${BUILDDIR}/usr/local/bin/mina-archive-hardfork-toolbox" mkdir -p "${BUILDDIR}/etc/mina/archive" cp ../scripts/archive/missing-blocks-guardian.sh \ diff --git a/src/app/archive_hardfork_toolbox/Readme.md b/src/app/archive_hardfork_toolbox/Readme.md new file mode 100644 index 00000000000..62f93bc0ace --- /dev/null +++ b/src/app/archive_hardfork_toolbox/Readme.md @@ -0,0 +1,121 @@ +# Archive Hardfork Toolbox + +The Archive Hardfork Toolbox is a utility for verifying the integrity of archive database migrations and validating hardfork operations in the Mina protocol. This tool helps ensure that database schema upgrades and fork transitions maintain data consistency. + +## Overview + +This toolbox provides commands to: +- Verify fork block candidates before migration +- Validate database schema upgrades +- Ensure fork block integrity and ancestry + +## Commands + +### fork-candidate + +A group of commands for pre-fork verifications to validate that a candidate block is suitable for forking. + +#### is-in-best-chain + +Verifies that the fork block is in the best chain of the blockchain. + +**Usage:** +```bash +archive_hardfork_toolbox fork-candidate is-in-best-chain \ + --archive-uri "postgresql://user:pass@host:port/db" \ + --fork-state-hash "3NKx..." \ + --fork-height 12345 \ + --fork-slot 67890 +``` + +**Parameters:** +- `--archive-uri`: URI for connecting to the mainnet archive database +- `--fork-state-hash`: Hash of the fork state +- `--fork-height`: Height of the fork block +- `--fork-slot`: Global slot since genesis of the fork block + +#### confirmations + +Verifies that the fork block has the required number of confirmations. + +**Usage:** +```bash +archive_hardfork_toolbox fork-candidate confirmations \ + --archive-uri "postgresql://user:pass@host:port/db" \ + --fork-state-hash "3NKx..." \ + --fork-slot 67890 \ + --required-confirmations 290 +``` + +**Parameters:** +- `--archive-uri`: URI for connecting to the mainnet archive database +- `--fork-state-hash`: Hash of the fork state +- `--fork-slot`: Global slot since genesis of the fork block +- `--required-confirmations`: Number of confirmations required for the fork block + +#### no-commands-after + +Verifies that no commands were executed after the fork block, ensuring a clean fork point. + +**Usage:** +```bash +archive_hardfork_toolbox fork-candidate no-commands-after \ + --archive-uri "postgresql://user:pass@host:port/db" \ + --fork-state-hash "3NKx..." \ + --fork-slot 67890 +``` + +**Parameters:** +- `--archive-uri`: URI for connecting to the mainnet archive database +- `--fork-state-hash`: Hash of the fork state +- `--fork-slot`: Global slot since genesis of the fork block + +### verify-upgrade + +Verifies the upgrade from pre-fork to post-fork database schema. + +**Usage:** +```bash +archive_hardfork_toolbox verify-upgrade \ + --archive-uri "postgresql://user:pass@host:port/db" \ + --version "3.2.0" +``` + +**Parameters:** +- `--archive-uri`: URI for connecting to the pre-fork mainnet archive database +- `--version`: Version to upgrade to (e.g., "3.2.0") + +### validate-fork + +Validates the fork block and its ancestors to ensure blockchain integrity. + +**Usage:** +```bash +archive_hardfork_toolbox validate-fork \ + --archive-uri "postgresql://user:pass@host:port/db" \ + --fork-state-hash "3NKx..." \ + --fork-slot 67890 +``` + +**Parameters:** +- `--archive-uri`: URI for connecting to the mainnet archive database +- `--fork-state-hash`: Hash of the fork state +- `--fork-slot`: Global slot since genesis of the fork block + +## Typical Workflow + +1. **Pre-fork validation**: Use the `fork-candidate` commands to ensure the chosen fork point is valid: + - Check if the block is in the best chain + - Verify sufficient confirmations + - Ensure no commands after the fork point + +2. **Schema upgrade**: Use `verify-upgrade` to validate the database migration process + +3. **Post-fork validation**: Use `validate-fork` to ensure the fork block and its ancestry remain intact + +## Database Connection + +All commands require an `--archive-uri` parameter that should be a PostgreSQL connection string in the format: +``` +postgresql://username:password@hostname:port/database_name +``` \ No newline at end of file diff --git a/src/app/archive_hardfork_toolbox/archive_hardfork_toolbox.ml b/src/app/archive_hardfork_toolbox/archive_hardfork_toolbox.ml new file mode 100644 index 00000000000..35d837ce038 --- /dev/null +++ b/src/app/archive_hardfork_toolbox/archive_hardfork_toolbox.ml @@ -0,0 +1,138 @@ +(* berkeley_migration_verifier.ml -- verify integrity of migrated archive db from original Mina mainnet schema *) + +open Async +open Logic + +let run_check_and_exit check_fn = + let open Deferred.Let_syntax in + let%bind results = check_fn () in + report_all_checks results ; + if has_failures results then Shutdown.exit 1 else Deferred.return () + +let is_in_best_chain_command = + Async.Command.async ~summary:"Verify fork block is in best chain" + (let open Command.Let_syntax in + let%map archive_uri = + Command.Param.flag "--archive-uri" + ~doc:"URI URI for connecting to the mainnet archive database" + Command.Param.(required string) + and fork_state_hash = + Command.Param.flag "--fork-state-hash" ~aliases:[ "-fork-state-hash" ] + Command.Param.(required string) + ~doc:"String Hash of the fork state" + and fork_height = + Command.Param.flag "--fork-height" ~aliases:[ "-fork-height" ] + Command.Param.(required int) + ~doc:"Int Height of the fork block" + and fork_slot = + Command.Param.flag "--fork-slot" ~aliases:[ "-fork-slot" ] + Command.Param.(required int) + ~doc:"Int64 Global slot since genesis of the fork block" + in + + fun () -> + run_check_and_exit (fun () -> + is_in_best_chain ~archive_uri ~fork_state_hash ~fork_height ~fork_slot + () )) + +let confirmations_command = + Async.Command.async + ~summary:"Verify number of confirmations for the fork block" + (let open Command.Let_syntax in + let%map archive_uri = + Command.Param.flag "--archive-uri" + ~doc:"URI URI for connecting to the mainnet archive database" + Command.Param.(required string) + and latest_state_hash = + Command.Param.flag "--latest-state-hash" ~aliases:[ "-latest-state-hash" ] + Command.Param.(required string) + ~doc:"String Hash of the latest state" + and fork_slot = + Command.Param.flag "--fork-slot" ~aliases:[ "-fork-slot" ] + Command.Param.(required int) + ~doc:"Int64 Global slot since genesis of the fork block" + and required_confirmations = + Command.Param.flag "--required-confirmations" + ~aliases:[ "-required-confirmations" ] + Command.Param.(required int) + ~doc:"Int Number of confirmations required for the fork block" + in + + fun () -> + run_check_and_exit (fun () -> + confirmations_check ~archive_uri ~latest_state_hash + ~required_confirmations ~fork_slot () )) + +let no_commands_after_command = + Async.Command.async ~summary:"Verify no commands after the fork block" + (let open Command.Let_syntax in + let%map archive_uri = + Command.Param.flag "--archive-uri" + ~doc:"URI URI for connecting to the mainnet archive database" + Command.Param.(required string) + and fork_state_hash = + Command.Param.flag "--fork-state-hash" ~aliases:[ "-fork-state-hash" ] + Command.Param.(required string) + ~doc:"String Hash of the fork state" + and fork_slot = + Command.Param.flag "--fork-slot" ~aliases:[ "-fork-slot" ] + Command.Param.(required int) + ~doc:"Int64 Global slot since genesis of the fork block" + in + + fun () -> + run_check_and_exit (fun () -> + no_commands_after ~archive_uri ~fork_state_hash ~fork_slot () )) + +let verify_upgrade_command = + Async.Command.async + ~summary:"Verify upgrade from pre-fork to post-fork schema" + (let open Command.Let_syntax in + let%map archive_uri = + Command.Param.flag "--archive-uri" + ~doc:"URI URI for connecting to the pre-fork mainnet archive database" + Command.Param.(required string) + and version = + Command.Param.flag "--version" ~aliases:[ "-version" ] + Command.Param.(required string) + ~doc:"String Version to upgrade to (e.g. 3.2.0 etc)" + in + fun () -> + run_check_and_exit (fun () -> verify_upgrade ~archive_uri ~version ())) + +let validate_fork_command = + Async.Command.async ~summary:"Validate fork block and its ancestors" + (let open Command.Let_syntax in + let%map archive_uri = + Command.Param.flag "--archive-uri" + ~doc:"URI URI for connecting to the mainnet archive database" + Command.Param.(required string) + and fork_state_hash = + Command.Param.flag "--fork-state-hash" ~aliases:[ "-fork-state-hash" ] + Command.Param.(required string) + ~doc:"String Hash of the fork state" + and fork_slot = + Command.Param.flag "--fork-slot" ~aliases:[ "-fork-slot" ] + Command.Param.(required int) + ~doc:"Int64 Global slot since genesis of the fork block" + in + fun () -> + run_check_and_exit (fun () -> + validate_fork ~archive_uri ~fork_state_hash ~fork_slot () )) + +let commands = + [ ( "fork-candidate" + , Async_command.group ~summary:"Pre-fork verifications" + ~preserve_subcommand_order:() + [ ("is-in-best-chain", is_in_best_chain_command) + ; ("confirmations", confirmations_command) + ; ("no-commands-after", no_commands_after_command) + ] ) + ; ("verify-upgrade", verify_upgrade_command) + ; ("validate-fork", validate_fork_command) + ] + +let () = + Async_command.run + (Async_command.group ~summary:"Archive hardfork toolbox" + ~preserve_subcommand_order:() commands ) diff --git a/src/app/archive_hardfork_toolbox/dune b/src/app/archive_hardfork_toolbox/dune new file mode 100644 index 00000000000..6132f8a76f3 --- /dev/null +++ b/src/app/archive_hardfork_toolbox/dune @@ -0,0 +1,48 @@ +(executable + (package archive_hardfork_toolbox) + (name archive_hardfork_toolbox) + (public_name archive_hardfork_toolbox) + (libraries + ;; opam libraries + async_unix + core + result + async_kernel + uri + stdio + caqti-driver-postgresql + caqti + async + core_kernel + caqti-async + base + base.caml + async.async_command + integers + ;; local libraries + logger + archive_lib + block_time + consensus + consensus_vrf + currency + genesis_constants + genesis_ledger_helper + mina_base + mina_base.import + mina_block + mina_caqti + mina_numbers + mina_state + mina_transaction + mina_wire_types + one_or_two + protocol_version + runtime_config + signature_lib + unsigned_extended + with_hash + ) + (preprocessor_deps ../../config.mlh) + (instrumentation (backend bisect_ppx)) + (preprocess (pps ppx_version ppx_mina ppx_let ppx_hash ppx_compare ppx_sexp_conv h_list.ppx))) diff --git a/src/app/archive_hardfork_toolbox/logic.ml b/src/app/archive_hardfork_toolbox/logic.ml new file mode 100644 index 00000000000..bd63051a79b --- /dev/null +++ b/src/app/archive_hardfork_toolbox/logic.ml @@ -0,0 +1,240 @@ +open Async +open Core + +type check_error = Success | Failure of string + +type check_result = { id : string; name : string; result : check_error } + +let check_result_to_string { id; name; result } = + match result with + | Success -> + sprintf "āœ… [%s] %s: PASSED" id name + | Failure err -> + sprintf "āŒ [%s] %s: FAILED - %s" id name err + +let report_all_checks results = + let passed_checks = + List.filter results ~f:(fun { result; _ } -> + match result with Success -> true | _ -> false ) + in + let failed_checks = + List.filter results ~f:(fun { result; _ } -> + match result with Failure _ -> true | _ -> false ) + in + + printf "\n=== CHECK REPORT ===\n" ; + printf "Total checks: %d\n" (List.length results) ; + printf "Passed: %d\n" (List.length passed_checks) ; + printf "Failed: %d\n\n" (List.length failed_checks) ; + + printf "=== DETAILED RESULTS ===\n" ; + List.iter results ~f:(fun result -> + printf "%s\n" (check_result_to_string result) ) ; + + if List.is_empty failed_checks then printf "\nšŸŽ‰ All checks passed!\n" + else ( + printf "\nšŸ’„ Failed checks:\n" ; + List.iter failed_checks ~f:(fun { id; name; _ } -> + printf " - [%s] %s\n" id name ) ) + +let has_failures results = + List.exists results ~f:(fun { result; _ } -> + match result with Failure _ -> true | _ -> false ) + +let connect archive_uri = + let archive_uri = Uri.of_string archive_uri in + match Mina_caqti.connect_pool archive_uri with + | Error e -> + failwithf "āŒ Connection failed to db, due to: %s" (Caqti_error.show e) () + | Ok pool -> + Deferred.return pool + +let is_in_best_chain ~archive_uri ~fork_state_hash ~fork_height ~fork_slot () = + let open Deferred.Let_syntax in + let%bind pool = connect archive_uri in + let query_db = Mina_caqti.query pool in + + let%bind tip = query_db ~f:(fun db -> Sql.latest_state_hash db) in + let%bind (in_chain : bool) = + query_db ~f:(fun db -> + Sql.is_in_the_best_chain db ~tip_hash:tip ~check_hash:fork_state_hash + ~check_height:fork_height ~check_slot:(Int64.of_int fork_slot) () ) + in + let result = + if in_chain then Success + else + Failure + (sprintf + "Fork block %s at slot %d is not in the best chain ending with tip \ + %s" + fork_state_hash fork_slot tip ) + in + let check_result = { id = "1.B"; name = "Best chain validation"; result } in + Deferred.return [ check_result ] + +let confirmations_check ~archive_uri ~latest_state_hash ~fork_slot + ~required_confirmations () = + let open Deferred.Let_syntax in + let%bind pool = connect archive_uri in + let query_db = Mina_caqti.query pool in + let%bind confirmations = + query_db ~f:(fun db -> + Sql.no_of_confirmations db ~latest_state_hash ~fork_slot ) + in + let result = + if confirmations >= required_confirmations then Success + else + Failure + (sprintf + "Expected at least %d confirmations for the fork block %s at slot \ + %d, however got only %d" + required_confirmations latest_state_hash fork_slot confirmations ) + in + let check_result = + { id = "2.C"; name = "Confirmation count check"; result } + in + Deferred.return [ check_result ] + +let no_commands_after ~archive_uri ~fork_state_hash ~fork_slot () = + let open Deferred.Let_syntax in + let%bind pool = connect archive_uri in + let query_db = Mina_caqti.query pool in + let%bind _, _, _, user_commands_count = + query_db ~f:(fun db -> + Sql.number_of_user_commands_since_block db ~fork_state_hash ~fork_slot ) + in + let%bind _, _, _, internal_commands_count = + query_db ~f:(fun db -> + Sql.number_of_internal_commands_since_block db ~fork_state_hash + ~fork_slot ) + in + + let%bind _, _, _, zkapps_commands_count = + query_db ~f:(fun db -> + Sql.number_of_zkapps_commands_since_block db ~fork_state_hash ~fork_slot ) + in + + let result = + if + user_commands_count = 0 + && internal_commands_count = 0 + && zkapps_commands_count = 0 + then Success + else + Failure + (sprintf + "Expected no user, internal or zkapps commands after the fork block \ + %s at slot %d, however got %d user commands and %d internal \ + commands and %d zkapps commands" + fork_state_hash fork_slot user_commands_count internal_commands_count + zkapps_commands_count ) + in + let check_result = + { id = "3.N"; name = "No commands after fork check"; result } + in + Deferred.return [ check_result ] + +let verify_upgrade ~archive_uri ~version () = + let open Deferred.Let_syntax in + let results = ref [] in + let%bind pool = connect archive_uri in + let query_db = Mina_caqti.query pool in + let%bind res = + query_db ~f:(fun db -> Sql.SchemaVerification.fetch_schema_row db ~version) + in + let%bind missing_cols_zkapp_states = + query_db ~f:(fun db -> + Sql.SchemaVerification.fetch_missing_cols db ~table:"zkapp_states" ) + in + let%bind missing_cols_zkapp_states_nullable = + query_db ~f:(fun db -> + Sql.SchemaVerification.fetch_missing_cols db + ~table:"zkapp_states_nullable" ) + in + + let%bind () = + match res with + | None -> + results := + { id = "4.S" + ; name = "Schema migration status" + ; result = + Failure + (sprintf "No schema migration found for version %s" version) + } + :: !results ; + Deferred.return () + | Some status -> + let expected = "applied" in + let result = + if String.equal status expected then Success + else + Failure + (sprintf + "Expected schema migration with version %s to be \"%s\" \ + however got status %s" + version expected status ) + in + results := + { id = "4.S"; name = "Schema migration status"; result } :: !results ; + Deferred.return () + in + + let%bind () = + let result = + if Int.( = ) missing_cols_zkapp_states 0 then Success + else + Failure + (sprintf + "Missing columns for zkapp_states detected during upgrade \ + verification: %d" + missing_cols_zkapp_states ) + in + results := + { id = "5.M"; name = "Missing columns check [zkapp_states]"; result } + :: !results ; + Deferred.return () + in + + let%bind () = + let result = + if Int.( = ) missing_cols_zkapp_states_nullable 0 then Success + else + Failure + (sprintf + "Missing columns for zkapp_states_nullable detected during \ + upgrade verification: %d" + missing_cols_zkapp_states_nullable ) + in + results := + { id = "6.M" + ; name = "Missing columns check [zkapp_states_nullable]" + ; result + } + :: !results ; + Deferred.return () + in + + Deferred.return !results + +let validate_fork ~archive_uri ~fork_state_hash ~fork_slot () = + let open Deferred.Let_syntax in + let%bind pool = connect archive_uri in + let query_db = Mina_caqti.query pool in + let fork_slot = Int64.of_int fork_slot in + + let%bind last_fork_block = query_db ~f:(fun db -> Sql.last_fork_block db) in + let result = + if + String.equal (fst last_fork_block) fork_state_hash + && Int64.equal (snd last_fork_block) fork_slot + then Success + else + Failure + (sprintf + "Expected last fork block to be %s at slot %Ld, however got %s at \ + slot %Ld" + (fst last_fork_block) (snd last_fork_block) fork_state_hash fork_slot ) + in + let check_result = { id = "8.F"; name = "Fork validation"; result } in + Deferred.return [ check_result ] diff --git a/src/app/archive_hardfork_toolbox/sql.ml b/src/app/archive_hardfork_toolbox/sql.ml new file mode 100644 index 00000000000..67b7d5b4252 --- /dev/null +++ b/src/app/archive_hardfork_toolbox/sql.ml @@ -0,0 +1,196 @@ +open Core +open Caqti_request.Infix + +module type CONNECTION = Mina_caqti.CONNECTION + +let latest_state_hash_query = + (Caqti_type.unit ->! Caqti_type.string) + {sql| + SELECT state_hash from blocks order by height desc limit 1; + |sql} + +let latest_state_hash (module Conn : CONNECTION) = + Conn.find latest_state_hash_query () + +let is_in_the_best_chain_query = + (Caqti_type.(t4 string string int int64) ->! Caqti_type.bool) + {sql| + WITH RECURSIVE chain AS ( + SELECT + b.id, + NULLIF(b.parent_id, 0) AS parent_id, + b.state_hash, + b.height, + b.global_slot_since_genesis, + ARRAY[b.id] AS path + FROM blocks b + WHERE b.state_hash = ? + + UNION ALL + + SELECT + p.id, + NULLIF(p.parent_id, 0) AS parent_id, + p.state_hash, + p.height, + p.global_slot_since_genesis, + c.path || p.id + FROM blocks p + JOIN chain c ON p.id = c.parent_id + WHERE NOT p.id = ANY (c.path) + ) + SELECT EXISTS ( + SELECT 1 FROM chain + WHERE state_hash = ? + AND height = ? + AND global_slot_since_genesis = ? + ) AS is_in_chain; + |sql} + +let is_in_the_best_chain (module Conn : CONNECTION) ~tip_hash ~check_hash + ~check_height ~check_slot () = + Conn.find is_in_the_best_chain_query + (tip_hash, check_hash, check_height, check_slot) + +let no_of_confirmations_query = + (Caqti_type.(t2 string int) ->! Caqti_type.int) + {sql| + WITH RECURSIVE chain AS +( + SELECT id, parent_id, chain_status, state_hash, height, global_slot_since_genesis FROM blocks + WHERE state_hash = ? + + UNION ALL + SELECT b.id, b.parent_id, b.chain_status, b.state_hash, b.height, b.global_slot_since_genesis FROM blocks b + INNER JOIN chain ON b.id = chain.parent_id AND (chain.id <> 0 OR b.id = 0) + ) SELECT count(*) FROM chain where global_slot_since_genesis >= ?; + |sql} + +let no_of_confirmations (module Conn : CONNECTION) ~latest_state_hash ~fork_slot + = + Conn.find no_of_confirmations_query (latest_state_hash, fork_slot) + +let number_of_user_commands_since_block_query = + (Caqti_type.(t2 string int) ->! Caqti_type.(t4 string int int int)) + {sql| + WITH RECURSIVE chain AS +( + SELECT id, parent_id, chain_status, state_hash, height, global_slot_since_genesis FROM blocks + WHERE state_hash = ? + UNION ALL + SELECT b.id, b.parent_id, b.chain_status, b.state_hash, b.height, b.global_slot_since_genesis FROM blocks b + INNER JOIN chain ON b.id = chain.parent_id AND (chain.id <> 0 OR b.id = 0) + ) SELECT state_hash, height, global_slot_since_genesis, count(bc.block_id) as user_command_count FROM chain left join blocks_user_commands bc on bc.block_id = id where global_slot_since_genesis >= ? group by state_hash, height, global_slot_since_genesis; + |sql} + +let number_of_user_commands_since_block (module Conn : CONNECTION) + ~fork_state_hash ~fork_slot = + Conn.find number_of_user_commands_since_block_query + (fork_state_hash, fork_slot) + +let number_of_internal_commands_since_block_query = + (Caqti_type.(t2 string int) ->! Caqti_type.(t4 string int int int)) + {sql| + WITH RECURSIVE chain AS + ( + SELECT id, parent_id, chain_status, state_hash, height, global_slot_since_genesis FROM blocks + WHERE state_hash = ? + UNION ALL + SELECT b.id, b.parent_id, b.chain_status, b.state_hash, b.height, b.global_slot_since_genesis FROM blocks b + INNER JOIN chain ON b.id = chain.parent_id AND (chain.id <> 0 OR b.id = 0) + ) SELECT state_hash, height, global_slot_since_genesis, count(bc.block_id) as internal_command_count FROM chain left join blocks_internal_commands bc on bc.block_id = id where global_slot_since_genesis >= ? group by state_hash, height, global_slot_since_genesis +; + |sql} + +let number_of_internal_commands_since_block (module Conn : CONNECTION) + ~fork_state_hash ~fork_slot = + Conn.find number_of_internal_commands_since_block_query + (fork_state_hash, fork_slot) + +let number_of_zkapps_commands_since_block_query = + (Caqti_type.(t2 string int) ->! Caqti_type.(t4 string int int int)) + {sql| + WITH RECURSIVE chain AS + ( + SELECT id, parent_id, chain_status, state_hash, height, global_slot_since_genesis FROM blocks + WHERE state_hash = ? + UNION ALL + SELECT b.id, b.parent_id, b.chain_status, b.state_hash, b.height, b.global_slot_since_genesis FROM blocks b + INNER JOIN chain ON b.id = chain.parent_id AND (chain.id <> 0 OR b.id = 0) + ) SELECT state_hash, height, global_slot_since_genesis, count(bc.block_id) as zkapp_command_count FROM chain left join blocks_zkapp_commands bc on bc.block_id = id where global_slot_since_genesis >= ? group by state_hash, height, global_slot_since_genesis +; + |sql} + +let number_of_zkapps_commands_since_block (module Conn : CONNECTION) + ~fork_state_hash ~fork_slot = + Conn.find number_of_zkapps_commands_since_block_query + (fork_state_hash, fork_slot) + +let last_fork_block_query = + (Caqti_type.unit ->! Caqti_type.(t2 string int64)) + {sql| + SELECT state_hash, global_slot_since_genesis FROM blocks + WHERE global_slot_since_hard_fork = 0 + ORDER BY height DESC + LIMIT 1; + |sql} + +let last_fork_block (module Conn : CONNECTION) = + Conn.find last_fork_block_query () + +module SchemaVerification = struct + module Types = struct + type schema_row = + { status : string option + ; description : string option + ; applied_at : string + ; validated_at : string option + } + + type result = + { missing_cols : int + ; total_fks : int + ; valid_fks : int + ; expected_cols_min : int + ; expected_cols_max : int + ; expected_fk_count : int + ; schema : schema_row option + ; ok_cols : bool + ; ok_fk_present : bool + ; ok_fk_validated : bool + ; ok_schema_status : bool + ; ok : bool + } + end + + module Queries = struct + (* 1) How many of element8..element31 are missing in table ? *) + let missing_cols_req = + (Caqti_type.string ->! Caqti_type.int) + @@ {| + SELECT count(*) FROM generate_series(8,31) g(n) + LEFT JOIN information_schema.columns c + ON c.table_schema='public' + AND c.table_name=? + AND c.column_name='element'||g.n + WHERE c.column_name IS NULL + |} + + (* 2) Row from public.schema_version for a given version. + We stringify timestamps for driver simplicity. *) + let schema_row_req = + (Caqti_type.string ->? Caqti_type.string) + @@ {| + SELECT + status + FROM migration_history + WHERE protocol_version = ? + |} + end + + let fetch_missing_cols (module Conn : CONNECTION) ~table = + Conn.find Queries.missing_cols_req table + + let fetch_schema_row (module Conn : CONNECTION) ~version = + Conn.find_opt Queries.schema_row_req version +end diff --git a/src/dune-project b/src/dune-project index 6e1bd8d118d..1d6f7ea506c 100644 --- a/src/dune-project +++ b/src/dune-project @@ -3,6 +3,7 @@ (package (name allocation_functor)) (package (name archive)) +(package (name archive_hardfork_toolbox)) (package (name archive_blocks)) (package (name archive_lib)) (package (name base58_check))