|
| 1 | +(* berkeley_migration_verifier.ml -- verify integrity of migrated archive db from original Mina mainnet schema *) |
| 2 | + |
| 3 | +open Async |
| 4 | +open Cli_lib.Flag |
| 5 | +open Logic |
| 6 | + |
| 7 | +let run_check_and_exit check_fn () = |
| 8 | + let open Deferred.Let_syntax in |
| 9 | + let%bind results = check_fn () in |
| 10 | + report_all_checks results ; |
| 11 | + if has_failures results then Shutdown.exit 1 else Deferred.return () |
| 12 | + |
| 13 | +let fork_state_hash = |
| 14 | + Command.Param.( |
| 15 | + flag "--fork-state-hash" (required string) |
| 16 | + ~doc:"String Hash of the fork state") |
| 17 | + |
| 18 | +let fork_slot = |
| 19 | + Command.Param.( |
| 20 | + flag "--fork-slot" (required int) |
| 21 | + ~doc:"Int64 Global slot since genesis of the fork block") |
| 22 | + |
| 23 | +let is_in_best_chain_command = |
| 24 | + Async.Command.async ~summary:"Verify fork block is in best chain" |
| 25 | + (let%map_open.Command { value = postgres_uri; _ } = Uri.Archive.postgres |
| 26 | + and fork_state_hash = fork_state_hash |
| 27 | + and fork_height = |
| 28 | + Command.Param.flag "--fork-height" |
| 29 | + Command.Param.(required int) |
| 30 | + ~doc:"Int Height of the fork block" |
| 31 | + and fork_slot = fork_slot in |
| 32 | + |
| 33 | + run_check_and_exit |
| 34 | + (is_in_best_chain ~postgres_uri ~fork_state_hash ~fork_height ~fork_slot) |
| 35 | + ) |
| 36 | + |
| 37 | +let confirmations_command = |
| 38 | + Async.Command.async |
| 39 | + ~summary:"Verify number of confirmations for the fork block" |
| 40 | + (let%map_open.Command { value = postgres_uri; _ } = Uri.Archive.postgres |
| 41 | + and latest_state_hash = |
| 42 | + Command.Param.flag "--latest-state-hash" |
| 43 | + Command.Param.(required string) |
| 44 | + ~doc:"String Hash of the latest state" |
| 45 | + and fork_slot = fork_slot |
| 46 | + and required_confirmations = |
| 47 | + Command.Param.flag "--required-confirmations" |
| 48 | + Command.Param.(required int) |
| 49 | + ~doc:"Int Number of confirmations required for the fork block" |
| 50 | + in |
| 51 | + |
| 52 | + run_check_and_exit |
| 53 | + (confirmations_check ~postgres_uri ~latest_state_hash |
| 54 | + ~required_confirmations ~fork_slot ) ) |
| 55 | + |
| 56 | +let no_commands_after_command = |
| 57 | + Async.Command.async ~summary:"Verify no commands after the fork block" |
| 58 | + (let%map_open.Command { value = postgres_uri; _ } = Uri.Archive.postgres |
| 59 | + and fork_state_hash = fork_state_hash |
| 60 | + and fork_slot = fork_slot in |
| 61 | + |
| 62 | + run_check_and_exit |
| 63 | + (no_commands_after ~postgres_uri ~fork_state_hash ~fork_slot) ) |
| 64 | + |
| 65 | +let verify_upgrade_command = |
| 66 | + Async.Command.async |
| 67 | + ~summary:"Verify upgrade from pre-fork to post-fork schema" |
| 68 | + (let%map_open.Command { value = postgres_uri; _ } = Uri.Archive.postgres |
| 69 | + and expected_protocol_version = |
| 70 | + Command.Param.flag "--protocol-version" |
| 71 | + Command.Param.(required string) |
| 72 | + ~doc:"String Protocol Version to upgrade to (e.g. 3.2.0 etc)" |
| 73 | + and expected_migration_version = |
| 74 | + Command.Param.flag "--migration-version" |
| 75 | + Command.Param.(required string) |
| 76 | + ~doc:"String Migration Version that generates current schema" |
| 77 | + in |
| 78 | + run_check_and_exit |
| 79 | + (verify_upgrade ~postgres_uri ~expected_protocol_version |
| 80 | + ~expected_migration_version ) ) |
| 81 | + |
| 82 | +let validate_fork_command = |
| 83 | + Async.Command.async ~summary:"Validate fork block and its ancestors" |
| 84 | + (let%map_open.Command { value = postgres_uri; _ } = Uri.Archive.postgres |
| 85 | + and fork_state_hash = fork_state_hash |
| 86 | + and fork_slot = fork_slot in |
| 87 | + run_check_and_exit |
| 88 | + (validate_fork ~postgres_uri ~fork_state_hash ~fork_slot) ) |
| 89 | + |
| 90 | +(* TODO: consider refactor these commands to reuse queries in the future. *) |
| 91 | +let commands = |
| 92 | + [ ( "fork-candidate" |
| 93 | + , Async_command.group ~summary:"Pre-fork verifications" |
| 94 | + ~preserve_subcommand_order:() |
| 95 | + [ ("is-in-best-chain", is_in_best_chain_command) |
| 96 | + ; ("confirmations", confirmations_command) |
| 97 | + ; ("no-commands-after", no_commands_after_command) |
| 98 | + ] ) |
| 99 | + ; ("verify-upgrade", verify_upgrade_command) |
| 100 | + ; ("validate-fork", validate_fork_command) |
| 101 | + ] |
| 102 | + |
| 103 | +let () = |
| 104 | + Async_command.run |
| 105 | + (Async_command.group ~summary:"Archive hardfork toolbox" |
| 106 | + ~preserve_subcommand_order:() commands ) |
0 commit comments