Merge pull request #17641 from MinaProtocol/lyh/improve-genesis-ledger-creation

Improve Genesis Ledger Creation

Author: cjjdespres

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

@@ -1142,8 +1142,7 @@ let setup_daemon logger ~itn_features ~default_snark_worker_fee =
           let consensus_local_state =
             Consensus.Data.Local_state.create
               ~context:(module Context)
-              ~genesis_ledger:
-                (Precomputed_values.genesis_ledger precomputed_values)
+              ~genesis_ledger:precomputed_values.genesis_ledger
               ~genesis_epoch_data:precomputed_values.genesis_epoch_data
               ~epoch_ledger_location
               ( Option.map block_production_keypair ~f:(fun keypair ->

src/app/cli/src/init/mina_run.ml

@@ -306,7 +306,8 @@ let setup_local_server ?(client_trustlist = []) ?rest_server_port
           | Ok ledger -> (
               match ledger with
               | Genesis_epoch_ledger l ->
-                  let%map accts = Mina_ledger.Ledger.to_list l in
+                  let l_inner = Lazy.force @@ Genesis_ledger.Packed.t l in
+                  let%map accts = Mina_ledger.Ledger.to_list l_inner in
                   Ok accts
               | Ledger_root l ->
                   let casted = Mina_ledger.Ledger.Root.as_unmasked l in

src/app/cli/src/init/test_ledger_application.ml

@@ -85,10 +85,8 @@ let mk_tx ~transfer_parties_get_actions_events ~event_elements ~action_elements
 let generate_protocol_state_stub ~consensus_constants ~constraint_constants
     ledger =
   let open Staged_ledger_diff in
-  Protocol_state.negative_one
-    ~genesis_ledger:(lazy ledger)
-    ~genesis_epoch_data:None ~constraint_constants ~consensus_constants
-    ~genesis_body_reference
+  Protocol_state.negative_one ~genesis_ledger:ledger ~genesis_epoch_data:None
+    ~constraint_constants ~consensus_constants ~genesis_body_reference
 
 let apply_txs ~transfer_parties_get_actions_events ~action_elements
     ~event_elements ~constraint_constants ~first_partition_slots ~no_new_stack
@@ -186,9 +184,16 @@ let test ~privkey_path ~ledger_path ?prev_block_path ~first_partition_slots
   O1trace.thread "mina"
   @@ fun () ->
   let%bind keypair = read_privkey privkey_path in
+
+  let module Test_genesis_ledger = Genesis_ledger.Make (struct
+    include Test_genesis_ledger
+
+    let directory = `Path ledger_path
+
+    let depth = constraint_constants.ledger_depth
+  end) in
   let init_ledger =
-    Ledger.create ~directory_name:ledger_path
-      ~depth:constraint_constants.ledger_depth ()
+    Lazy.force @@ Genesis_ledger.Packed.t (module Test_genesis_ledger)
   in
   let prev_protocol_state =
     let%map.Option prev_block_path = prev_block_path in
@@ -207,7 +212,7 @@ let test ~privkey_path ~ledger_path ?prev_block_path ~first_partition_slots
     match prev_protocol_state with
     | None ->
         generate_protocol_state_stub ~consensus_constants ~constraint_constants
-          init_ledger
+          (module Test_genesis_ledger)
     | Some p ->
         p
   in

src/app/zkapp_test_transaction/lib/commands.ml

@@ -109,7 +109,7 @@ let gen_proof ?(zkapp_account = None) (zkapp_command : Zkapp_command.t)
       let open Staged_ledger_diff in
       (*not using Precomputed_values.for_unit_test because of dependency cycle*)
       Mina_state.Genesis_protocol_state.t
-        ~genesis_ledger:Genesis_ledger.(Packed.t for_unit_tests)
+        ~genesis_ledger:Genesis_ledger.for_unit_tests
         ~genesis_epoch_data:Consensus.Genesis_epoch_data.for_unit_tests
         ~constraint_constants ~consensus_constants ~genesis_body_reference
     in
@@ -171,7 +171,7 @@ let generate_zkapp_txn (keypair : Signature_lib.Keypair.t) (ledger : Ledger.t)
   let compile_time_genesis =
     (*not using Precomputed_values.for_unit_test because of dependency cycle*)
     Mina_state.Genesis_protocol_state.t
-      ~genesis_ledger:Genesis_ledger.(Packed.t for_unit_tests)
+      ~genesis_ledger:Genesis_ledger.for_unit_tests
       ~genesis_epoch_data:Consensus.Genesis_epoch_data.for_unit_tests
       ~constraint_constants ~consensus_constants ~genesis_body_reference
   in

src/lib/consensus/genesis_epoch_data.ml

@@ -1,6 +1,5 @@
 module Data = struct
-  type t =
-    { ledger : Mina_ledger.Ledger.t Lazy.t; seed : Mina_base.Epoch_seed.t }
+  type t = { ledger : Genesis_ledger.Packed.t; seed : Mina_base.Epoch_seed.t }
 end
 
 type tt = { staking : Data.t; next : Data.t option }

src/lib/consensus/intf.ml

@@ -297,7 +297,7 @@ module type S = sig
   module Genesis_epoch_data : sig
     module Data : sig
       type t =
-        { ledger : Mina_ledger.Ledger.t Lazy.t; seed : Mina_base.Epoch_seed.t }
+        { ledger : Genesis_ledger.Packed.t; seed : Mina_base.Epoch_seed.t }
     end
 
     type tt = { staking : Data.t; next : Data.t option }
@@ -316,7 +316,7 @@ module type S = sig
 
         module Ledger_snapshot : sig
           type t =
-            | Genesis_epoch_ledger of Mina_ledger.Ledger.t
+            | Genesis_epoch_ledger of Genesis_ledger.Packed.t
             | Ledger_root of Mina_ledger.Ledger.Root.t
 
           val close : t -> unit
@@ -330,7 +330,7 @@ module type S = sig
       val create :
            Signature_lib.Public_key.Compressed.Set.t
         -> context:(module CONTEXT)
-        -> genesis_ledger:Mina_ledger.Ledger.t Lazy.t
+        -> genesis_ledger:Genesis_ledger.Packed.t
         -> genesis_epoch_data:Genesis_epoch_data.t
         -> epoch_ledger_location:string
         -> genesis_state_hash:State_hash.t
@@ -507,7 +507,7 @@ module type S = sig
         -> (var, Value.t) Snark_params.Tick.Typ.t
 
       val negative_one :
-           genesis_ledger:Mina_ledger.Ledger.t Lazy.t
+           genesis_ledger:Genesis_ledger.Packed.t
         -> genesis_epoch_data:Genesis_epoch_data.t
         -> constants:Constants.t
         -> constraint_constants:Genesis_constants.Constraint_constants.t
@@ -516,15 +516,15 @@ module type S = sig
       val create_genesis_from_transition :
            negative_one_protocol_state_hash:Mina_base.State_hash.t
         -> consensus_transition:Consensus_transition.Value.t
-        -> genesis_ledger:Mina_ledger.Ledger.t Lazy.t
+        -> genesis_ledger:Genesis_ledger.Packed.t
         -> genesis_epoch_data:Genesis_epoch_data.t
         -> constraint_constants:Genesis_constants.Constraint_constants.t
         -> constants:Constants.t
         -> Value.t
 
       val create_genesis :
            negative_one_protocol_state_hash:Mina_base.State_hash.t
-        -> genesis_ledger:Mina_ledger.Ledger.t Lazy.t
+        -> genesis_ledger:Genesis_ledger.Packed.t
         -> genesis_epoch_data:Genesis_epoch_data.t
         -> constraint_constants:Genesis_constants.Constraint_constants.t
         -> constants:Constants.t

src/lib/consensus/proof_of_stake.ml

@@ -276,19 +276,22 @@ module Make_str (A : Wire_types.Concrete) = struct
       module Snapshot = struct
         module Ledger_snapshot = struct
           type t =
-            | Genesis_epoch_ledger of Mina_ledger.Ledger.t
+            | Genesis_epoch_ledger of Genesis_ledger.Packed.t
             | Ledger_root of Mina_ledger.Ledger.Root.t
 
           let merkle_root = function
-            | Genesis_epoch_ledger ledger ->
-                Mina_ledger.Ledger.merkle_root ledger
+            | Genesis_epoch_ledger packed ->
+                Genesis_ledger.Packed.t packed
+                |> Lazy.force |> Mina_ledger.Ledger.merkle_root
             | Ledger_root ledger ->
                 Mina_ledger.Ledger.Root.merkle_root ledger
 
           let compute_delegatee_table keys ledger =
             match ledger with
             | Genesis_epoch_ledger ledger ->
-                compute_delegatee_table_genesis_ledger keys ledger
+                Genesis_ledger.Packed.t ledger
+                |> Lazy.force
+                |> compute_delegatee_table_genesis_ledger keys
             | Ledger_root ledger ->
                 compute_delegatee_table_ledger_root keys ledger
 
@@ -308,7 +311,8 @@ module Make_str (A : Wire_types.Concrete) = struct
           let ledger_subset keys ledger =
             let open Mina_ledger in
             match ledger with
-            | Genesis_epoch_ledger ledger ->
+            | Genesis_epoch_ledger packed ->
+                let ledger = Lazy.force @@ Genesis_ledger.Packed.t packed in
                 Sparse_ledger.of_ledger_subset_exn ledger keys
             | Ledger_root db_ledger ->
                 let ledger = Ledger.Root.as_masked db_ledger in
@@ -454,7 +458,7 @@ module Make_str (A : Wire_types.Concrete) = struct
           Snapshot.Ledger_snapshot.Ledger_root
             (Mina_ledger.Ledger.Root.create_single ~directory_name:location
                ~depth:constraint_constants.ledger_depth () ) )
-        else Genesis_epoch_ledger (Lazy.force genesis_epoch_ledger)
+        else Genesis_epoch_ledger genesis_epoch_ledger
 
       let create block_producer_pubkeys ~context:(module Context : CONTEXT)
           ~genesis_ledger ~genesis_epoch_data ~epoch_ledger_location
@@ -965,7 +969,8 @@ module Make_str (A : Wire_types.Concrete) = struct
             ]
 
         let genesis ~(genesis_epoch_data : Genesis_epoch_data.Data.t) =
-          { Poly.ledger = Epoch_ledger.genesis ~ledger:genesis_epoch_data.ledger
+          let ledger = Genesis_ledger.Packed.t genesis_epoch_data.ledger in
+          { Poly.ledger = Epoch_ledger.genesis ~ledger
           ; seed = genesis_epoch_data.seed
           ; start_checkpoint = Mina_base.State_hash.(of_hash zero)
           ; lock_checkpoint = Lock_checkpoint.null
@@ -1995,7 +2000,9 @@ module Make_str (A : Wire_types.Concrete) = struct
                  (Length.to_int constants.sub_windows_per_window - 1)
                  ~f:(Fn.const max_sub_window_density)
         ; last_vrf_output = Vrf.Output.Truncated.dummy
-        ; total_currency = genesis_ledger_total_currency ~ledger:genesis_ledger
+        ; total_currency =
+            genesis_ledger_total_currency
+              ~ledger:(Genesis_ledger.Packed.t genesis_ledger)
         ; curr_global_slot_since_hard_fork = Global_slot.zero ~constants
         ; global_slot_since_genesis
         ; staking_epoch_data =
@@ -2027,7 +2034,8 @@ module Make_str (A : Wire_types.Concrete) = struct
             }
         in
         let snarked_ledger_hash =
-          Lazy.force genesis_ledger |> Mina_ledger.Ledger.merkle_root
+          Genesis_ledger.Packed.t genesis_ledger
+          |> Lazy.force |> Mina_ledger.Ledger.merkle_root
           |> Mina_base.Frozen_ledger_hash.of_ledger_hash
         in
         let genesis_winner_pk = fst Vrf.Precomputed.genesis_winner in
@@ -2642,26 +2650,15 @@ module Make_str (A : Wire_types.Concrete) = struct
                       match snapshot.ledger with
                       | Ledger_snapshot.Ledger_root ledger ->
                           Ok ledger
-                      | Ledger_snapshot.Genesis_epoch_ledger ledger ->
-                          let module Ledger_transfer =
-                            Mina_ledger.Ledger_transfer.Make
-                              (Mina_ledger.Ledger)
-                              (Mina_ledger.Ledger.Any_ledger.M)
-                          in
+                      | Ledger_snapshot.Genesis_epoch_ledger packed ->
                           let fresh_root_ledger =
                             Mina_ledger.Ledger.Root.create_single
                               ~directory_name:snapshot_location
                               ~depth:Context.constraint_constants.ledger_depth
                               ()
                           in
-                          (* TODO: replace with more efficient root->root transfer *)
-                          let%map.Or_error _fresh_root_ledger =
-                            Ledger_transfer.transfer_accounts ~src:ledger
-                              ~dest:
-                                (Mina_ledger.Ledger.Root.as_unmasked
-                                   fresh_root_ledger )
-                          in
-                          fresh_root_ledger )
+                          Genesis_ledger.Packed.populate_root packed
+                            fresh_root_ledger )
                 in
                 match snapshot_id with
                 | Staking_epoch_snapshot ->
@@ -3103,7 +3100,7 @@ module Make_str (A : Wire_types.Concrete) = struct
 
     let%test "Receive a valid consensus_state with a bit of delay" =
       let constants = Lazy.force Constants.for_unit_tests in
-      let genesis_ledger = Genesis_ledger.(Packed.t for_unit_tests) in
+      let genesis_ledger = Genesis_ledger.for_unit_tests in
       let genesis_epoch_data = Genesis_epoch_data.for_unit_tests in
       let negative_one =
         Consensus_state.negative_one ~genesis_ledger ~genesis_epoch_data
@@ -3126,7 +3123,7 @@ module Make_str (A : Wire_types.Concrete) = struct
     let%test "Receive an invalid consensus_state" =
       let epoch = Epoch.of_int 5 in
       let constants = Lazy.force Constants.for_unit_tests in
-      let genesis_ledger = Genesis_ledger.(Packed.t for_unit_tests) in
+      let genesis_ledger = Genesis_ledger.for_unit_tests in
       let genesis_epoch_data = Genesis_epoch_data.for_unit_tests in
       let negative_one =
         Consensus_state.negative_one ~genesis_ledger ~genesis_epoch_data
@@ -3428,8 +3425,8 @@ module Make_str (A : Wire_types.Concrete) = struct
         let previous_consensus_state =
           Consensus_state.create_genesis
             ~negative_one_protocol_state_hash:previous_protocol_state_hash
-            ~genesis_ledger:Genesis_ledger.t ~genesis_epoch_data
-            ~constraint_constants ~constants
+            ~genesis_ledger:(module Genesis_ledger)
+            ~genesis_epoch_data ~constraint_constants ~constants
         in
         (*If this is a fork then check blockchain length and global_slot_since_genesis have been set correctly*)
         ( match constraint_constants.fork with
@@ -3646,8 +3643,8 @@ module Make_str (A : Wire_types.Concrete) = struct
         let previous_consensus_state =
           Consensus_state.create_genesis
             ~negative_one_protocol_state_hash:previous_protocol_state_hash
-            ~genesis_ledger:Genesis_ledger.t ~genesis_epoch_data
-            ~constraint_constants ~constants
+            ~genesis_ledger:(module Genesis_ledger)
+            ~genesis_epoch_data ~constraint_constants ~constants
         in
         let seed = previous_consensus_state.staking_epoch_data.seed in
         let maybe_sk, account = Genesis_ledger.largest_account_exn () in
@@ -3665,7 +3662,7 @@ module Make_str (A : Wire_types.Concrete) = struct
         in
         let epoch_snapshot =
           { Local_state.Snapshot.delegatee_table
-          ; ledger = Genesis_epoch_ledger ledger
+          ; ledger = Genesis_epoch_ledger (module Genesis_ledger)
           }
         in
         let balance = Balance.to_nanomina_int account.balance in

src/lib/fake_network/fake_network.ml

@@ -230,11 +230,10 @@ module Generator = struct
       Filename.temp_dir_name ^/ "epoch_ledger"
       ^ (Uuid_unix.create () |> Uuid.to_string)
     in
-    let genesis_ledger = Precomputed_values.genesis_ledger precomputed_values in
     let consensus_local_state =
       Consensus.Data.Local_state.create Public_key.Compressed.Set.empty
         ~context:(module Context)
-        ~genesis_ledger
+        ~genesis_ledger:precomputed_values.genesis_ledger
         ~genesis_epoch_data:precomputed_values.genesis_epoch_data
         ~epoch_ledger_location
         ~genesis_state_hash:
@@ -273,11 +272,10 @@ module Generator = struct
       Filename.temp_dir_name ^/ "epoch_ledger"
       ^ (Uuid_unix.create () |> Uuid.to_string)
     in
-    let genesis_ledger = Precomputed_values.genesis_ledger precomputed_values in
     let consensus_local_state =
       Consensus.Data.Local_state.create Public_key.Compressed.Set.empty
         ~context:(module Context)
-        ~genesis_ledger
+        ~genesis_ledger:precomputed_values.genesis_ledger
         ~genesis_epoch_data:precomputed_values.genesis_epoch_data
         ~epoch_ledger_location
         ~genesis_state_hash:

src/lib/genesis_ledger_helper/genesis_ledger_helper.ml

@@ -604,8 +604,7 @@ module Epoch_data = struct
           in
           [%log trace] "Loaded staking epoch ledger from $ledger_file"
             ~metadata:[ ("ledger_file", `String ledger_file) ] ;
-          ( { Consensus.Genesis_epoch_data.Data.ledger =
-                Genesis_ledger.Packed.t staking_ledger
+          ( { Consensus.Genesis_epoch_data.Data.ledger = staking_ledger
             ; seed = Epoch_seed.of_base58_check_exn config.staking.seed
             }
           , { config.staking with ledger = config' } )
@@ -622,8 +621,7 @@ module Epoch_data = struct
               [%log trace] "Loaded next epoch ledger from $ledger_file"
                 ~metadata:[ ("ledger_file", `String ledger_file) ] ;
               ( Some
-                  { Consensus.Genesis_epoch_data.Data.ledger =
-                      Genesis_ledger.Packed.t next_ledger
+                  { Consensus.Genesis_epoch_data.Data.ledger = next_ledger
                   ; seed = Epoch_seed.of_base58_check_exn seed
                   }
               , Some { Runtime_config.Epoch_data.Data.ledger = config''; seed }
@@ -707,8 +705,7 @@ module Genesis_proof = struct
     in
     let open Staged_ledger_diff in
     let protocol_state_with_hashes =
-      Mina_state.Genesis_protocol_state.t
-        ~genesis_ledger:(Genesis_ledger.Packed.t ledger)
+      Mina_state.Genesis_protocol_state.t ~genesis_ledger:ledger
         ~genesis_epoch_data ~constraint_constants ~consensus_constants
         ~genesis_body_reference
     in

src/lib/mina_graphql/mina_graphql.ml

@@ -2096,10 +2096,8 @@ module Queries = struct
             ; hash = { State_hash.State_hashes.state_hash = hash; _ }
             } =
           let open Staged_ledger_diff in
-          Genesis_protocol_state.t
-            ~genesis_ledger:(Genesis_ledger.Packed.t genesis_ledger)
-            ~genesis_epoch_data ~constraint_constants ~consensus_constants
-            ~genesis_body_reference
+          Genesis_protocol_state.t ~genesis_ledger ~genesis_epoch_data
+            ~constraint_constants ~consensus_constants ~genesis_body_reference
         in
         let winner = fst Consensus_state_hooks.genesis_winner in
         { With_hash.data =
@@ -2601,7 +2599,8 @@ module Queries = struct
     let cast_ledger = function
       | Consensus.Data.Local_state.Snapshot.Ledger_snapshot.Genesis_epoch_ledger
           l ->
-          Ledger.Any_ledger.cast (module Ledger) l
+          let l_inner = Lazy.force @@ Genesis_ledger.Packed.t l in
+          Ledger.Any_ledger.cast (module Ledger) l_inner
       | Consensus.Data.Local_state.Snapshot.Ledger_snapshot.Ledger_root l ->
           Ledger.Root.as_unmasked l
     in