Merge pull request #17996 from MinaProtocol/cjjdespres/dynamic-root-module

Refactor root ledger in preparation for the vesting parameter update changes

Author: cjjdespres

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

@@ -9,6 +9,7 @@ open Async
 module Graphql_cohttp_async =
   Graphql_internal.Make (Graphql_async.Schema) (Cohttp_async.Io)
     (Cohttp_async.Body)
+module Root_ledger = Mina_ledger.Root
 
 let snark_job_list_json t =
   let open Participating_state.Let_syntax in
@@ -316,7 +317,7 @@ let setup_local_server ?(client_trustlist = []) ~rest_server_port
                   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
+                  let casted = Root_ledger.as_unmasked l in
                   let%map accts =
                     Mina_ledger.Ledger.Any_ledger.M.to_list casted
                   in

src/lib/bootstrap_controller/bootstrap_controller.ml

@@ -7,6 +7,7 @@ open Pipe_lib.Strict_pipe
 open Network_peer
 open Mina_stdlib
 module Ledger = Mina_ledger.Ledger
+module Root_ledger = Mina_ledger.Root
 module Sync_ledger = Mina_ledger.Sync_ledger
 module Transition_cache = Transition_cache
 
@@ -428,7 +429,7 @@ let run_cycle ~context:(module Context : CONTEXT) ~trust_system ~verifier
               let%map staged_ledger_construction_time, construction_result =
                 time_deferred
                   (let open Deferred.Let_syntax in
-                  let temp_mask = Ledger.Root.as_masked temp_snarked_ledger in
+                  let temp_mask = Root_ledger.as_masked temp_snarked_ledger in
                   let%map result =
                     Staged_ledger
                     .of_scan_state_pending_coinbases_and_snarked_ledger ~logger
@@ -967,10 +968,10 @@ let%test_module "Bootstrap_controller tests" =
             ~root:(Transition_frontier.root new_frontier)
             sorted_external_transitions ;
           [%test_result: Ledger_hash.t]
-            ( Ledger.Root.merkle_root
+            ( Root_ledger.merkle_root
             @@ Transition_frontier.root_snarked_ledger new_frontier )
             ~expect:
-              ( Ledger.Root.merkle_root
+              ( Root_ledger.merkle_root
               @@ Transition_frontier.root_snarked_ledger peer_net.state.frontier
               ) )
 
@@ -992,7 +993,7 @@ let%test_module "Bootstrap_controller tests" =
               in
               let snarked_ledger =
                 Transition_frontier.root_snarked_ledger frontier
-                |> Ledger.Root.as_masked
+                |> Root_ledger.as_masked
               in
               let snarked_local_state =
                 Transition_frontier.root frontier

src/lib/consensus/intf.ml

@@ -4,6 +4,7 @@ open Async
 open Currency
 open Signature_lib
 open Mina_base
+module Root_ledger = Mina_ledger.Root
 
 module type CONTEXT = sig
   val logger : Logger.t
@@ -317,7 +318,7 @@ module type S = sig
         module Ledger_snapshot : sig
           type t =
             | Genesis_epoch_ledger of Genesis_ledger.Packed.t
-            | Ledger_root of Mina_ledger.Ledger.Root.t
+            | Ledger_root of Root_ledger.t
 
           val close : t -> unit
 
@@ -333,8 +334,7 @@ module type S = sig
         -> genesis_epoch_data:Genesis_epoch_data.t
         -> epoch_ledger_location:string
         -> genesis_state_hash:State_hash.t
-        -> epoch_ledger_backing_type:
-             Genesis_ledger.Ledger.Root.Config.backing_type
+        -> epoch_ledger_backing_type:Root_ledger.Config.backing_type
         -> Signature_lib.Public_key.Compressed.Set.t
         -> t
 
@@ -720,7 +720,7 @@ module type S = sig
          Consensus_state.Value.t
       -> Consensus_state.Value.t
       -> local_state:Local_state.t
-      -> snarked_ledger:Mina_ledger.Ledger.Root.t
+      -> snarked_ledger:Root_ledger.t
       -> genesis_ledger_hash:Mina_base.Frozen_ledger_hash.t
       -> unit
 

src/lib/consensus/proof_of_stake.ml

@@ -7,6 +7,7 @@ open Fold_lib
 open Signature_lib
 open Snark_params
 open Num_util
+module Root_ledger = Mina_ledger.Root
 
 module Segment_id = Mina_numbers.Nat.Make32 ()
 
@@ -91,8 +92,7 @@ module Make_str (A : Wire_types.Concrete) = struct
     O1trace.sync_thread "compute_delegatee_table_ledger_root" (fun () ->
         compute_delegatee_table keys ~iter_accounts:(fun f ->
             Mina_ledger.Ledger.Any_ledger.M.iteri
-              (Mina_ledger.Ledger.Root.as_unmasked ledger) ~f:(fun i acct ->
-                f i acct ) ) )
+              (Root_ledger.as_unmasked ledger) ~f:(fun i acct -> f i acct) ) )
 
   let compute_delegatee_table_ledger_any keys ledger =
     O1trace.sync_thread "compute_delegatee_table_ledger_any" (fun () ->
@@ -277,14 +277,14 @@ module Make_str (A : Wire_types.Concrete) = struct
         module Ledger_snapshot = struct
           type t =
             | Genesis_epoch_ledger of Genesis_ledger.Packed.t
-            | Ledger_root of Mina_ledger.Ledger.Root.t
+            | Ledger_root of Root_ledger.t
 
           let merkle_root = function
             | 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
+                Root_ledger.merkle_root ledger
 
           let compute_delegatee_table keys ledger =
             match ledger with
@@ -299,14 +299,14 @@ module Make_str (A : Wire_types.Concrete) = struct
             | Genesis_epoch_ledger _ ->
                 ()
             | Ledger_root ledger ->
-                Mina_ledger.Ledger.Root.close ledger
+                Root_ledger.close ledger
 
           let remove ~config = function
             | Genesis_epoch_ledger _ ->
                 ()
             | Ledger_root ledger ->
-                Mina_ledger.Ledger.Root.close ledger ;
-                Mina_ledger.Ledger.Root.Config.delete_backing config
+                Root_ledger.close ledger ;
+                Root_ledger.Config.delete_backing config
 
           let ledger_subset keys ledger =
             let open Mina_ledger in
@@ -315,7 +315,7 @@ module Make_str (A : Wire_types.Concrete) = struct
                 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
+                let ledger = Root_ledger.as_masked db_ledger in
                 let subset_ledger =
                   Sparse_ledger.of_ledger_subset_exn ledger keys
                 in
@@ -375,8 +375,7 @@ module Make_str (A : Wire_types.Concrete) = struct
               Option.t
           ; mutable epoch_ledger_uuids : epoch_ledger_uuids
           ; epoch_ledger_location : string
-          ; epoch_ledger_backing_type :
-              Mina_ledger.Ledger.Root.Config.backing_type
+          ; epoch_ledger_backing_type : Root_ledger.Config.backing_type
           }
 
         let to_yojson t =
@@ -400,14 +399,14 @@ module Make_str (A : Wire_types.Concrete) = struct
       type t = Data.t ref [@@deriving to_yojson]
 
       let staking_epoch_ledger_config (t : t) =
-        Mina_ledger.Ledger.Root.Config.with_directory
+        Root_ledger.Config.with_directory
           ~backing_type:!t.epoch_ledger_backing_type
           ~directory_name:
             ( !t.epoch_ledger_location
             ^ Uuid.to_string !t.epoch_ledger_uuids.staking )
 
       let next_epoch_ledger_config (t : t) =
-        Mina_ledger.Ledger.Root.Config.with_directory
+        Root_ledger.Config.with_directory
           ~backing_type:!t.epoch_ledger_backing_type
           ~directory_name:
             ( !t.epoch_ledger_location
@@ -461,13 +460,12 @@ module Make_str (A : Wire_types.Concrete) = struct
       let create_epoch_ledger ~config ~context:(module Context : CONTEXT)
           ~genesis_epoch_ledger =
         let open Context in
-        if Mina_ledger.Ledger.Root.Config.exists_any_backing config then (
+        if Root_ledger.Config.exists_any_backing config then (
           [%log info]
-            ~metadata:
-              [ ("config", Mina_ledger.Ledger.Root.Config.to_yojson config) ]
+            ~metadata:[ ("config", Root_ledger.Config.to_yojson config) ]
             "Loading epoch ledger from disk: $config" ;
           Snapshot.Ledger_snapshot.Ledger_root
-            (Mina_ledger.Ledger.Root.create ~logger ~config
+            (Root_ledger.create ~logger ~config
                ~depth:constraint_constants.ledger_depth () ) )
         else Genesis_epoch_ledger genesis_epoch_ledger
 
@@ -498,7 +496,7 @@ module Make_str (A : Wire_types.Concrete) = struct
           epoch_ledger_uuids
         in
         let ledger_config uuid =
-          Mina_ledger.Ledger.Root.Config.(
+          Root_ledger.Config.(
             with_directory ~backing_type:epoch_ledger_backing_type
               ~directory_name:(epoch_ledger_location ^ Uuid.to_string uuid))
         in
@@ -539,15 +537,11 @@ module Make_str (A : Wire_types.Concrete) = struct
                     , Mina_base.State_hash.to_yojson
                         epoch_ledger_uuids.genesis_state_hash )
                   ; ( "staking"
-                    , Mina_ledger.Ledger.Root.Config.to_yojson
-                        staking_ledger_config )
-                  ; ( "next"
-                    , Mina_ledger.Ledger.Root.Config.to_yojson
-                        next_ledger_config )
+                    , Root_ledger.Config.to_yojson staking_ledger_config )
+                  ; ("next", Root_ledger.Config.to_yojson next_ledger_config)
                   ] ;
-              Mina_ledger.Ledger.Root.Config.delete_backing
-                staking_ledger_config ;
-              Mina_ledger.Ledger.Root.Config.delete_backing next_ledger_config ;
+              Root_ledger.Config.delete_backing staking_ledger_config ;
+              Root_ledger.Config.delete_backing next_ledger_config ;
               create_new_uuids () )
           else create_new_uuids ()
         in
@@ -2639,7 +2633,7 @@ module Make_str (A : Wire_types.Concrete) = struct
                   Deferred.Or_error.ok_unit
               | Ledger_root next_epoch_ledger ->
                   let ledger =
-                    Mina_ledger.Ledger.Root.create_checkpoint next_epoch_ledger
+                    Root_ledger.create_checkpoint next_epoch_ledger
                       ~config:(staking_epoch_ledger_config local_state)
                       ()
                   in
@@ -2704,7 +2698,7 @@ module Make_str (A : Wire_types.Concrete) = struct
                     ~metadata:[ ("target_ledger_hash", ledger_hash_json) ] ;
                   assert (
                     Mina_base.Ledger_hash.equal target_ledger_hash
-                      (Mina_ledger.Ledger.Root.merkle_root ledger) ) ;
+                      (Root_ledger.merkle_root ledger) ) ;
                   reset_snapshot local_state snapshot_id ledger ;
                   Deferred.Or_error.ok_unit
               | `Target_changed _ ->
@@ -3035,9 +3029,7 @@ module Make_str (A : Wire_types.Concrete) = struct
     let frontier_root_transition (prev : Consensus_state.Value.t)
         (next : Consensus_state.Value.t) ~(local_state : Local_state.t)
         ~snarked_ledger ~genesis_ledger_hash =
-      let snarked_ledger_hash =
-        Mina_ledger.Ledger.Root.merkle_root snarked_ledger
-      in
+      let snarked_ledger_hash = Root_ledger.merkle_root snarked_ledger in
       if
         not
           (Epoch.equal
@@ -3071,19 +3063,18 @@ module Make_str (A : Wire_types.Concrete) = struct
           !local_state.next_epoch_snapshot <-
             { ledger =
                 (let config =
-                   Mina_ledger.Ledger.Root.Config.with_directory
+                   Root_ledger.Config.with_directory
                      ~backing_type:!local_state.epoch_ledger_backing_type
                      ~directory_name:
                        ( !local_state.epoch_ledger_location
                        ^ Uuid.to_string epoch_ledger_uuids.next )
                  in
                  Local_state.Snapshot.Ledger_snapshot.Ledger_root
-                   (Mina_ledger.Ledger.Root.create_checkpoint snarked_ledger
-                      ~config () ) )
+                   (Root_ledger.create_checkpoint snarked_ledger ~config ()) )
             ; delegatee_table =
                 compute_delegatee_table_ledger_any
                   (Local_state.current_block_production_keys local_state)
-                  (Mina_ledger.Ledger.Root.as_unmasked snarked_ledger)
+                  (Root_ledger.as_unmasked snarked_ledger)
             } ) )
 
     let should_bootstrap_len ~context:(module Context : CONTEXT) ~existing

src/lib/genesis_ledger/genesis_ledger.ml

@@ -3,6 +3,7 @@ open Currency
 open Signature_lib
 open Mina_base
 module Ledger = Mina_ledger.Ledger
+module Root_ledger = Mina_ledger.Root
 module Intf = Intf
 module Ledger_transfer_mask =
   Mina_ledger.Ledger_transfer.Make (Ledger) (Ledger.Any_ledger.M)
@@ -76,9 +77,9 @@ module Utils = struct
     assert (
       Ledger_hash.equal
         (Ledger.merkle_root genesis_mask)
-        (Ledger.Root.merkle_root root) ) ;
-    assert (Ledger.Root.depth root = depth) ;
-    Ledger.Root.create_checkpoint ~config root () |> Or_error.return
+        (Root_ledger.merkle_root root) ) ;
+    assert (Root_ledger.depth root = depth) ;
+    Root_ledger.create_checkpoint ~config root () |> Or_error.return
 
   let keypair_of_account_record_exn (private_key, account) =
     let open Account in
@@ -121,7 +122,7 @@ module Make (Inputs : Intf.Ledger_input_intf) : Intf.S = struct
   (* TODO: #1488 compute this at compile time instead of lazily *)
   (* The backing_ledger is either an `Ephemeral ledger, which exists purely as a
      mask in memory, with a null ledger root, or a `Root ledger, which is backed
-     by a concrete [Ledger.Root.t] on disk. We need a single mask to present to
+     by a concrete [Root_ledger.t] on disk. We need a single mask to present to
      the users of the genesis ledger interface (through the [t] value below), so
      that is also saved here. *)
   let backing_ledger =
@@ -133,14 +134,14 @@ module Make (Inputs : Intf.Ledger_input_intf) : Intf.S = struct
       | `New backing_type ->
           lazy
             ( `Root
-                (Ledger.Root.create_temporary ~logger ~backing_type ~depth ())
+                (Root_ledger.create_temporary ~logger ~backing_type ~depth ())
             , true )
       | `Path (directory_name, backing_type) ->
           lazy
             ( `Root
-                (Ledger.Root.create ~logger
+                (Root_ledger.create ~logger
                    ~config:
-                     (Ledger.Root.Config.with_directory ~backing_type
+                     (Root_ledger.Config.with_directory ~backing_type
                         ~directory_name )
                    ~depth () )
             , false )
@@ -150,7 +151,7 @@ module Make (Inputs : Intf.Ledger_input_intf) : Intf.S = struct
       | `Ephemeral ledger ->
           ledger
       | `Root ledger ->
-          Ledger.Root.as_masked ledger
+          Root_ledger.as_masked ledger
     in
     ( if insert_accounts then
       let addrs_and_accounts =
@@ -169,12 +170,12 @@ module Make (Inputs : Intf.Ledger_input_intf) : Intf.S = struct
     match backing_ledger with
     | `Ephemeral ledger ->
         let open Or_error.Let_syntax in
-        let root = Ledger.Root.create ~logger ~config ~depth () in
+        let root = Root_ledger.create ~logger ~config ~depth () in
         (* We are transferring to an unmasked view of the root, so this is
            used solely for the transfer side effect *)
         let%map _dest =
           Ledger_transfer_mask.transfer_accounts ~src:ledger
-            ~dest:(Ledger.Root.as_unmasked root)
+            ~dest:(Root_ledger.as_unmasked root)
         in
         root
     | `Root ledger ->
@@ -241,15 +242,15 @@ module Packed = struct
 end
 
 module Of_ledger (T : sig
-  val backing_ledger : Ledger.Root.t Lazy.t
+  val backing_ledger : Root_ledger.t Lazy.t
 
   val depth : int
 end) : Intf.S = struct
   include T
 
   let backing_ledger =
     Lazy.map
-      ~f:(fun ledger -> (ledger, Ledger.Root.as_masked ledger))
+      ~f:(fun ledger -> (ledger, Root_ledger.as_masked ledger))
       backing_ledger
 
   let t = Lazy.map ~f:snd backing_ledger

src/lib/genesis_ledger/intf.ml

@@ -1,6 +1,7 @@
 open Mina_base
 open Signature_lib
 open Core_kernel
+module Root_ledger = Mina_ledger.Root
 
 module Timing = struct
   type t = (int, int, int, int) Account_timing.Poly.t
@@ -63,8 +64,8 @@ module type Ledger_input_intf = sig
 
   val directory :
     [ `Ephemeral
-    | `New of Mina_ledger.Ledger.Root.Config.backing_type
-    | `Path of string * Mina_ledger.Ledger.Root.Config.backing_type ]
+    | `New of Root_ledger.Config.backing_type
+    | `Path of string * Root_ledger.Config.backing_type ]
 
   val depth : int
 
@@ -76,10 +77,7 @@ module type S = sig
 
   (** Create a new root ledger that is equal in state to the genesis ledger *)
   val create_root :
-       config:Mina_ledger.Ledger.Root.Config.t
-    -> depth:int
-    -> unit
-    -> Mina_ledger.Ledger.Root.t Or_error.t
+    config:Root_ledger.Config.t -> depth:int -> unit -> Root_ledger.t Or_error.t
 
   val depth : int