Improve fork config generation for develop.

src/lib/mina_graphql/dune

@@ -60,6 +60,7 @@
    graphql_lib
    block_time
    currency
+   merkle_ledger
    mina_lib
    mina_commands
    mina_state

src/lib/mina_graphql/mina_graphql.ml

@@ -2293,15 +2293,6 @@ module Queries = struct
         |> Runtime_config.to_yojson |> Yojson.Safe.to_basic )
 
   let fork_config =
-    let rec map_results ~f = function
-      | [] ->
-          Result.return []
-      | r :: rs ->
-          let open Result.Let_syntax in
-          let%bind r' = f r in
-          let%map rs = map_results ~f rs in
-          r' :: rs
-    in
     field "fork_config"
       ~doc:
         "The runtime configuration for a blockchain fork intended to be a \
@@ -2314,59 +2305,69 @@ module Queries = struct
             `Assoc [ ("error", `String "Daemon is bootstrapping") ]
         | `Active best_tip -> (
             let block = Transition_frontier.Breadcrumb.(block best_tip) in
+            let blockchain_length = Mina_block.blockchain_length block in
             let global_slot =
-              Mina_block.blockchain_length block |> Unsigned.UInt32.to_int
+              Mina_block.consensus_state block
+              |> Consensus.Data.Consensus_state.curr_global_slot
             in
-            let accounts_or_error =
+            let staged_ledger =
               Transition_frontier.Breadcrumb.staged_ledger best_tip
               |> Staged_ledger.ledger
-              |> Ledger.foldi ~init:[] ~f:(fun _ accum act -> act :: accum)
-              |> map_results
-                   ~f:Runtime_config.Json_layout.Accounts.Single.of_account
             in
             let protocol_state =
               Transition_frontier.Breadcrumb.protocol_state best_tip
             in
-            match accounts_or_error with
+            let consensus =
+              Mina_state.Protocol_state.consensus_state protocol_state
+            in
+            let staking_epoch =
+              Consensus.Proof_of_stake.Data.Consensus_state.staking_epoch_data
+                consensus
+            in
+            let next_epoch =
+              Consensus.Proof_of_stake.Data.Consensus_state.next_epoch_data
+                consensus
+            in
+            let staking_epoch_seed =
+              Mina_base.Epoch_seed.to_base58_check
+                staking_epoch.Mina_base.Epoch_data.Poly.seed
+            in
+            let next_epoch_seed =
+              Mina_base.Epoch_seed.to_base58_check
+                next_epoch.Mina_base.Epoch_data.Poly.seed
+            in
+            let runtime_config = Mina_lib.runtime_config mina in
+            match
+              let open Result.Let_syntax in
+              let%bind staking_ledger =
+                match Mina_lib.staking_ledger mina with
+                | None ->
+                    Error "Staking ledger is not initialized."
+                | Some (Genesis_epoch_ledger l) ->
+                    Ok (Ledger.Any_ledger.cast (module Ledger) l)
+                | Some (Ledger_db l) ->
+                    Ok (Ledger.Any_ledger.cast (module Ledger.Db) l)
+              in
+              let%bind next_epoch_ledger =
+                match Mina_lib.next_epoch_ledger mina with
+                | None ->
+                    Error "Next epoch ledger is not initialized."
+                | Some `Notfinalized ->
+                    Ok None
+                | Some (`Finalized (Genesis_epoch_ledger l)) ->
+                    Ok (Some (Ledger.Any_ledger.cast (module Ledger) l))
+                | Some (`Finalized (Ledger_db l)) ->
+                    Ok (Some (Ledger.Any_ledger.cast (module Ledger.Db) l))
+              in
+              Runtime_config.make_fork_config ~staged_ledger ~global_slot
+                ~staking_ledger ~staking_epoch_seed ~next_epoch_ledger
+                ~next_epoch_seed ~blockchain_length
+                ~protocol_state_hash:protocol_state.previous_state_hash
+                runtime_config
+            with
             | Error e ->
                 `Assoc [ ("error", `String e) ]
-            | Ok accounts ->
-                let runtime_config = Mina_lib.runtime_config mina in
-                let ledger = Option.value_exn runtime_config.ledger in
-                let previous_length =
-                  let open Option.Let_syntax in
-                  let%bind proof = runtime_config.proof in
-                  let%map fork = proof.fork in
-                  fork.previous_length + global_slot
-                in
-                let fork =
-                  Runtime_config.Fork_config.
-                    { previous_state_hash =
-                        State_hash.to_base58_check
-                          protocol_state.previous_state_hash
-                    ; previous_length =
-                        Option.value ~default:global_slot previous_length
-                    ; genesis_slot = global_slot
-                    }
-                in
-                let update =
-                  Runtime_config.make
-                  (* add_genesis_winner must be set to false, because this
-                     config effectively creates a continuation of the current
-                     blockchain state and therefore the genesis ledger already
-                     contains the winner of the previous block. No need to
-                     artificially add it. In fact, it wouldn't work at all,
-                     because the new node would try to create this account at
-                     startup, even though it already exists, leading to an error.*)
-                    ~ledger:
-                      { ledger with
-                        base = Accounts accounts
-                      ; add_genesis_winner = Some false
-                      }
-                    ~proof:(Runtime_config.Proof_keys.make ~fork ())
-                    ()
-                in
-                let new_config = Runtime_config.combine runtime_config update in
+            | Ok new_config ->
                 Runtime_config.to_yojson new_config |> Yojson.Safe.to_basic ) )
 
   let thread_graph =

src/lib/runtime_config/dune

@@ -16,16 +16,19 @@
    data_hash_lib
    kimchi_backend.pasta
    kimchi_backend.pasta.basic
+   merkle_ledger
    mina_base
    mina_base.import
+   mina_ledger
    mina_numbers
-   signature_lib
    snark_params
    unsigned_extended
    pickles
    pickles.backend
    pickles_types
    with_hash
+   signature_lib
+   staged_ledger
    )
  (instrumentation (backend bisect_ppx))
  (preprocess (pps ppx_custom_printf ppx_sexp_conv ppx_let ppx_deriving_yojson