Apply vesting params update to runtime genesis ledger and root

src/app/archive/lib/processor.ml

@@ -4690,9 +4690,9 @@ let add_genesis_accounts ~logger ~(runtime_config_opt : Runtime_config.t option)
           Genesis_ledger_helper.init_from_config_file ~logger
             ~proof_level:Genesis_constants.Compiled.proof_level
             ~genesis_constants ~constraint_constants runtime_config
-            ~cli_proof_level:None ~genesis_backing_type:Stable_db
+            ~cli_proof_level:None ~hardfork_handling:Keep_running
         with
-        | Ok (precomputed_values, _) ->
+        | Ok precomputed_values ->
             precomputed_values
         | Error err ->
             failwithf "Could not get precomputed values, error: %s"

src/app/cli/src/cli_entrypoint/mina_cli_entrypoint.ml

@@ -87,8 +87,7 @@ module Chain_state_locations = struct
 end
 
 let load_config_files ~logger ~genesis_constants ~constraint_constants ~conf_dir
-    ~genesis_dir ~cli_proof_level ~proof_level ~genesis_backing_type
-    config_files =
+    ~genesis_dir ~cli_proof_level ~proof_level ~hardfork_handling config_files =
   let%bind config_jsons =
     let config_files_paths =
       List.map config_files ~f:(fun (config_file, _) -> `String config_file)
@@ -145,9 +144,9 @@ let load_config_files ~logger ~genesis_constants ~constraint_constants ~conf_dir
     match%map
       Genesis_ledger_helper.init_from_config_file ~cli_proof_level ~genesis_dir
         ~logger ~genesis_constants ~constraint_constants ~proof_level
-        ~genesis_backing_type config
+        ~hardfork_handling config
     with
-    | Ok (precomputed_values, _) ->
+    | Ok precomputed_values ->
         precomputed_values
     | Error err ->
         let ( json_config
@@ -844,17 +843,14 @@ let setup_daemon logger ~itn_features ~default_snark_worker_fee =
             Genesis_constants.Compiled.constraint_constants
           in
           let compile_config = Mina_compile_config.Compiled.t in
-          let ledger_backing_type =
-            Mina_lib.Config.ledger_backing ~hardfork_handling
-          in
           let%bind ( precomputed_values
                    , config_jsons
                    , config
                    , chain_state_locations ) =
             load_config_files ~logger ~conf_dir ~genesis_dir
               ~proof_level:Genesis_constants.Compiled.proof_level config_files
               ~genesis_constants ~constraint_constants ~cli_proof_level
-              ~genesis_backing_type:ledger_backing_type
+              ~hardfork_handling
           in
           constraint_constants.block_window_duration_ms |> Float.of_int
           |> Time.Span.of_ms |> Mina_metrics.initialize_all ;
@@ -1217,6 +1213,10 @@ let setup_daemon logger ~itn_features ~default_snark_worker_fee =
 
             let consensus_constants = precomputed_values.consensus_constants
           end in
+          let ledger_backing =
+            Genesis_ledger_helper.make_ledger_backing ~logger
+              ~constraint_constants ~runtime_config:config ~hardfork_handling
+          in
           let consensus_local_state =
             Consensus.Data.Local_state.create
               ~context:(module Context)
@@ -1229,7 +1229,7 @@ let setup_daemon logger ~itn_features ~default_snark_worker_fee =
               |> Option.to_list |> Public_key.Compressed.Set.of_list )
               ~genesis_state_hash:
                 precomputed_values.protocol_state_with_hashes.hash.state_hash
-              ~epoch_ledger_backing_type:ledger_backing_type
+              ~epoch_ledger_backing_type:ledger_backing
           in
           trace_database_initialization "epoch ledger" __LOC__
             epoch_ledger_location ;
@@ -2044,7 +2044,7 @@ let internal_commands logger ~itn_features =
                    , _chain_state_locations ) =
             load_config_files ~logger ~conf_dir ~genesis_dir ~genesis_constants
               ~constraint_constants ~proof_level ~cli_proof_level:None
-              ~genesis_backing_type:Stable_db config_files
+              ~hardfork_handling:Keep_running config_files
           in
           let pids = Child_processes.Termination.create_pid_table () in
           let%bind prover =

src/app/cli/src/init/client.ml

@@ -1845,7 +1845,7 @@ let compile_time_constants =
                conf_dir ^/ "daemon.json"
          in
          let open Async in
-         let%map ({ consensus_constants; _ } as precomputed_values), _ =
+         let%map ({ consensus_constants; _ } as precomputed_values) =
            config_file |> Genesis_ledger_helper.load_config_json >>| Or_error.ok
            >>| Option.value
                  ~default:
@@ -1855,7 +1855,7 @@ let compile_time_constants =
            >>= Genesis_ledger_helper.init_from_config_file ~genesis_constants
                  ~constraint_constants ~logger:(Logger.null ()) ~proof_level
                  ~cli_proof_level:None ~genesis_dir
-                 ~genesis_backing_type:Stable_db
+                 ~hardfork_handling:Keep_running
            >>| Or_error.ok_exn
          in
          let all_constants =

src/app/delegation_verify/delegation_verify.ml

@@ -63,11 +63,11 @@ let instantiate_verify_functions ~logger ~genesis_constants
         in
         Genesis_ledger_helper.init_from_config_file ~logger ~proof_level
           ~constraint_constants ~genesis_constants ~cli_proof_level
-          ~genesis_backing_type:Stable_db config
+          ~hardfork_handling:Keep_running config
       in
       let%map.Deferred precomputed_values =
         match precomputed_values with
-        | Ok (precomputed_values, _) ->
+        | Ok precomputed_values ->
             Deferred.return precomputed_values
         | Error _ ->
             Output.display_error "fail to read config file" ;

src/app/runtime_genesis_ledger/dune

@@ -13,17 +13,18 @@
   yojson
   async_unix
   ;;local libraries
+  cache_dir
+  cli_lib
+  coda_genesis_ledger
+  consensus
   genesis_constants
+  genesis_ledger_helper
+  logger
+  mina_base
   mina_runtime_config
   mina_ledger
-  genesis_ledger_helper
   mina_stdlib
-  logger
-  cache_dir
-  precomputed_values
-  coda_genesis_ledger
-  consensus
-  mina_base)
+  precomputed_values)
  (instrumentation
   (backend bisect_ppx))
  (preprocess

src/app/runtime_genesis_ledger/runtime_genesis_ledger.ml

@@ -15,14 +15,23 @@ end
 
 let logger = Logger.create ()
 
-let load_ledger ~ignore_missing_fields ~pad_app_state
+let load_ledger ~ignore_missing_fields ~pad_app_state ~hardfork_slot
     ~(constraint_constants : Genesis_constants.Constraint_constants.t)
     (accounts : Runtime_config.Accounts.t) =
+  let transform_account account =
+    let account_padded =
+      Runtime_config.Accounts.Single.to_account ~ignore_missing_fields
+        ~pad_app_state account
+    in
+    match hardfork_slot with
+    | None ->
+        account_padded
+    | Some hardfork_slot ->
+        Mina_base.Account.slot_reduction_update ~hardfork_slot account_padded
+  in
+
   let accounts =
-    List.map accounts ~f:(fun account ->
-        ( None
-        , Runtime_config.Accounts.Single.to_account ~ignore_missing_fields
-            ~pad_app_state account ) )
+    List.map accounts ~f:(fun account -> (None, transform_account account))
   in
   let packed =
     Genesis_ledger_helper.Ledger.packed_genesis_ledger_of_accounts ~logger
@@ -132,24 +141,33 @@ let load_config_exn config_file =
 
 let main ~(constraint_constants : Genesis_constants.Constraint_constants.t)
     ~config_file ~genesis_dir ~hash_output_file ~ignore_missing_fields
-    ~pad_app_state () =
+    ~pad_app_state ~hardfork_slot () =
+  let hardfork_slot =
+    Option.map
+      ~f:
+        (Genesis_ledger_helper.global_slot_since_hard_fork_to_genesis
+           ~constraint_constants )
+      hardfork_slot
+  in
   let%bind accounts, staking_accounts_opt, next_accounts_opt =
     load_config_exn config_file
   in
   let ledger =
     load_ledger ~ignore_missing_fields ~pad_app_state ~constraint_constants
-      accounts
+      ~hardfork_slot accounts
   in
   let staking_ledger : Ledger.t =
     Option.value_map ~default:ledger
       ~f:
-        (load_ledger ~ignore_missing_fields ~pad_app_state ~constraint_constants)
+        (load_ledger ~ignore_missing_fields ~pad_app_state ~constraint_constants
+           ~hardfork_slot )
       staking_accounts_opt
   in
   let next_ledger =
     Option.value_map ~default:staking_ledger
       ~f:
-        (load_ledger ~ignore_missing_fields ~pad_app_state ~constraint_constants)
+        (load_ledger ~ignore_missing_fields ~pad_app_state ~constraint_constants
+           ~hardfork_slot )
       next_accounts_opt
   in
   let%bind hash_json =
@@ -197,6 +215,13 @@ let () =
              ~doc:
                "BOOL whether to pad app_state to max allowed size (default: \
                 false)"
+         and hardfork_slot =
+           flag "--hardfork-slot"
+             (optional Cli_lib.Arg_type.hardfork_slot)
+             ~doc:
+               "INT the scheduled hardfork slot since last hardfork at which \
+                vesting parameter update should happen. If absent, don't \
+                update the vesting parameters"
          in
          main ~constraint_constants ~config_file ~genesis_dir ~hash_output_file
-           ~ignore_missing_fields ~pad_app_state) )
+           ~ignore_missing_fields ~pad_app_state ~hardfork_slot) )

src/lib/cli_lib/arg_type.ml

@@ -78,6 +78,10 @@ let global_slot =
   Command.Arg_type.map Command.Param.int
     ~f:Mina_numbers.Global_slot_since_genesis.of_int
 
+let hardfork_slot =
+  Command.Arg_type.map Command.Param.int
+    ~f:Mina_numbers.Global_slot_since_hard_fork.of_int
+
 let txn_fee =
   Command.Arg_type.map Command.Param.string ~f:Currency.Fee.of_mina_string_exn
 

src/lib/genesis_ledger_helper/dune

@@ -44,7 +44,8 @@
   logger
   mina_base.import
   staged_ledger_diff
-  mina_stdlib_unix)
+  mina_stdlib_unix
+  cli_lib)
  (instrumentation
   (backend bisect_ppx))
  (preprocess

src/lib/genesis_ledger_helper/genesis_ledger_helper.ml

@@ -837,10 +837,50 @@ let print_config ~logger config =
   [%log info] "Initializing with runtime configuration. Ledger name: $name"
     ~metadata
 
+(** Helper to convert a global slot since hard fork to a global slot since genesis *)
+let global_slot_since_hard_fork_to_genesis
+    ~(constraint_constants : Genesis_constants.Constraint_constants.t)
+    global_slot =
+  (* Convert the global slot to a span of slots since the current hard fork *)
+  let global_slot_span =
+    global_slot |> Mina_numbers.Global_slot_since_hard_fork.to_uint32
+    |> Mina_numbers.Global_slot_span.of_uint32
+  in
+  (* Retrieve the global slot since genesis of the genesis of the current
+     chain *)
+  let current_genesis_global_slot =
+    constraint_constants.fork
+    |> Option.value_map ~default:Mina_numbers.Global_slot_since_genesis.zero
+         ~f:(fun fork -> fork.global_slot_since_genesis)
+  in
+  (* Add the slot span to the current chain's genesis slot to get the desired quantity *)
+  Mina_numbers.Global_slot_since_genesis.add current_genesis_global_slot
+    global_slot_span
+
+let make_ledger_backing ~logger ~constraint_constants ~runtime_config
+    ~hardfork_handling =
+  let hardfork_slot =
+    Runtime_config.scheduled_hard_fork_genesis_slot runtime_config
+    |> Option.map
+         ~f:(global_slot_since_hard_fork_to_genesis ~constraint_constants)
+  in
+  match (hardfork_handling, hardfork_slot) with
+  | Cli_lib.Arg_type.Hardfork_handling.Migrate_exit, Some hardfork_slot ->
+      Root_ledger.Config.Converting_db hardfork_slot
+  | Migrate_exit, _ ->
+      failwith "No hardfork slot provided for Migrate_exit mode"
+  | Keep_running, Some _ ->
+      [%log warn]
+        "hardfork slot is set for keep_running hardfork handle, ignoring" ;
+      Stable_db
+  | Keep_running, None ->
+      Stable_db
+
 let inputs_from_config_file ?(genesis_dir = Cache_dir.autogen_path) ~logger
     ~cli_proof_level ~(genesis_constants : Genesis_constants.t)
     ~(constraint_constants : Genesis_constants.Constraint_constants.t)
-    ~genesis_backing_type ~proof_level:compiled_proof_level ?overwrite_version
+    ~(hardfork_handling : Cli_lib.Arg_type.Hardfork_handling.t)
+    ~proof_level:compiled_proof_level ?overwrite_version
     (config : Runtime_config.t) =
   print_config ~logger config ;
   let open Deferred.Or_error.Let_syntax in
@@ -896,6 +936,10 @@ let inputs_from_config_file ?(genesis_dir = Cache_dir.autogen_path) ~logger
           "Proof level %s is not compatible with compile-time proof level %s"
           (str proof_level) (str compiled)
   in
+  let genesis_backing_type =
+    make_ledger_backing ~logger ~constraint_constants ~runtime_config:config
+      ~hardfork_handling
+  in
   let%bind genesis_ledger, ledger_config, ledger_file =
     match config.ledger with
     | Some ledger ->
@@ -922,25 +966,18 @@ let inputs_from_config_file ?(genesis_dir = Cache_dir.autogen_path) ~logger
     Deferred.return
     @@ make_genesis_constants ~logger ~default:genesis_constants config
   in
-  let proof_inputs =
-    Genesis_proof.generate_inputs ~runtime_config:config ~proof_level
-      ~ledger:genesis_ledger ~constraint_constants ~genesis_constants
-      ~blockchain_proof_system_id ~genesis_epoch_data
-  in
-  (proof_inputs, config)
+  Genesis_proof.generate_inputs ~runtime_config:config ~proof_level
+    ~ledger:genesis_ledger ~constraint_constants ~genesis_constants
+    ~blockchain_proof_system_id ~genesis_epoch_data
 
 let init_from_config_file ~cli_proof_level ~genesis_constants
-    ~constraint_constants ~logger ~proof_level ~genesis_backing_type
+    ~constraint_constants ~logger ~proof_level ~hardfork_handling
     ?overwrite_version ?genesis_dir (config : Runtime_config.t) :
-    (Precomputed_values.t * Runtime_config.t) Deferred.Or_error.t =
-  let open Deferred.Or_error.Let_syntax in
-  let%map inputs, config =
-    inputs_from_config_file ~cli_proof_level ~genesis_constants
-      ~constraint_constants ~logger ~proof_level ~genesis_backing_type
-      ?overwrite_version ?genesis_dir config
-  in
-  let values = Genesis_proof.create_values_no_proof inputs in
-  (values, config)
+    Precomputed_values.t Deferred.Or_error.t =
+  inputs_from_config_file ~cli_proof_level ~genesis_constants
+    ~constraint_constants ~logger ~proof_level ~hardfork_handling
+    ?overwrite_version ?genesis_dir config
+  |> Deferred.Or_error.map ~f:Genesis_proof.create_values_no_proof
 
 let upgrade_old_config ~logger filename json =
   match json with