replace Root with Root_(hash, common) in persistent database

src/lib/transition_frontier/frontier_base/root_data.ml

@@ -33,6 +33,11 @@ module Common = struct
   let scan_state t = t.scan_state
 
   let pending_coinbase t = t.pending_coinbase
+
+  let read_all_proofs_from_disk { scan_state; pending_coinbase } =
+    { Stable.Latest.pending_coinbase
+    ; scan_state = Staged_ledger.Scan_state.read_all_proofs_from_disk scan_state
+    }
 end
 
 module Historical = struct
@@ -131,6 +136,8 @@ module Minimal = struct
 
       let to_latest = Fn.id
 
+      let common t = t.common
+
       let scan_state t = t.common.Common.Stable.Latest.scan_state
 
       let pending_coinbase t = t.common.Common.Stable.Latest.pending_coinbase

src/lib/transition_frontier/frontier_base/root_data.mli

@@ -11,6 +11,8 @@ module Common : sig
   end]
 
   type t
+
+  val read_all_proofs_from_disk : t -> Stable.V2.t
 end
 
 (* Historical root data is similar to Limited root data, except that it also
@@ -104,6 +106,8 @@ module Minimal : sig
 
       val of_limited : common:Common.Stable.V2.t -> State_hash.Stable.V1.t -> t
 
+      val common : t -> Common.Stable.V2.t
+
       val scan_state : t -> Staged_ledger.Scan_state.Stable.V2.t
 
       val pending_coinbase : t -> Pending_coinbase.Stable.V2.t

src/lib/transition_frontier/persistent_frontier/database.ml

@@ -50,7 +50,19 @@ module Schema = struct
     | Db_version : int t
     | Transition : State_hash.Stable.V1.t -> Mina_block.Stable.V2.t t
     | Arcs : State_hash.Stable.V1.t -> State_hash.Stable.V1.t list t
+    (* TODO:
+       In hard forks, `Root` should be replaced by `(Root_hash, Root_common)`;
+       For now, we try to replace `Root` with `(Root_hash, Root_common)` when:
+         1. initializing a new DB;
+         2. trying to moving the root;
+         3. trying to query `root` or `root_hash`
+       The reason for this is `Root_common` is too big(250MB+), and most of the time
+       we just need the hash. Reading the whole Root result in efficiency problems,
+       comboing with `bin_prot` being slow results in 90s persistent frontier bottleneck
+    *)
     | Root : Root_data.Minimal.Stable.V2.t t
+    | Root_hash : State_hash.Stable.V1.t t
+    | Root_common : Root_data.Common.Stable.V2.t t
     | Best_tip : State_hash.Stable.V1.t t
     | Protocol_states_for_root_scan_state
         : Mina_state.Protocol_state.Value.Stable.V2.t list t
@@ -66,6 +78,10 @@ module Schema = struct
         "Arcs _"
     | Root ->
         "Root"
+    | Root_hash ->
+        "Root_hash"
+    | Root_common ->
+        "Root_common"
     | Best_tip ->
         "Best_tip"
     | Protocol_states_for_root_scan_state ->
@@ -80,6 +96,10 @@ module Schema = struct
         [%bin_type_class: State_hash.Stable.Latest.t list]
     | Root ->
         [%bin_type_class: Root_data.Minimal.Stable.Latest.t]
+    | Root_hash ->
+        [%bin_type_class: State_hash.Stable.Latest.t]
+    | Root_common ->
+        [%bin_type_class: Root_data.Common.Stable.Latest.t]
     | Best_tip ->
         [%bin_type_class: State_hash.Stable.Latest.t]
     | Protocol_states_for_root_scan_state ->
@@ -134,6 +154,16 @@ module Schema = struct
           (module Keys.String)
           ~to_gadt:(fun _ -> Root)
           ~of_gadt:(fun Root -> "root")
+    | Root_hash ->
+        gadt_input_type_class
+          (module Keys.String)
+          ~to_gadt:(fun _ -> Root_hash)
+          ~of_gadt:(fun Root_hash -> "root_hash")
+    | Root_common ->
+        gadt_input_type_class
+          (module Keys.String)
+          ~to_gadt:(fun _ -> Root_common)
+          ~of_gadt:(fun Root_common -> "root_common")
     | Best_tip ->
         gadt_input_type_class
           (module Keys.String)
@@ -150,6 +180,8 @@ end
 module Error = struct
   type not_found_member =
     [ `Root
+    | `Root_hash
+    | `Root_common
     | `Best_tip
     | `Frontier_hash
     | `Root_transition
@@ -172,6 +204,10 @@ module Error = struct
       match member with
       | `Root ->
           ("root", None)
+      | `Root_hash ->
+          ("root hash", None)
+      | `Root_common ->
+          ("root common", None)
       | `Best_tip ->
           ("best tip", None)
       | `Frontier_hash ->
@@ -231,6 +267,36 @@ let get_if_exists db ~default ~key =
 let get db ~key ~error =
   match get db ~key with Some x -> Ok x | None -> Error error
 
+(**
+Don't use this when possible. It cost ~90s while get_root_hash cost seconds.
+*)
+let get_root t =
+  match get_batch t.db ~keys:[ Some_key Root_hash; Some_key Root_common ] with
+  | [ Some (Some_key_value (Root_hash, hash))
+    ; Some (Some_key_value (Root_common, common))
+    ] ->
+      Ok (Root_data.Minimal.Stable.V2.of_limited ~common hash)
+  | _ -> (
+      match get t.db ~key:Root ~error:(`Not_found `Root) with
+      | Ok root ->
+          (* automatically split Root into (Root_hash, Root_common) *)
+          Batch.with_batch t.db ~f:(fun batch ->
+              let hash = Root_data.Minimal.Stable.Latest.hash root in
+              let common = Root_data.Minimal.Stable.V2.common root in
+              Batch.set batch ~key:Root_hash ~data:hash ;
+              Batch.set batch ~key:Root_common ~data:common ) ;
+
+          Ok root
+      | Error _ as e ->
+          e )
+
+let get_root_hash t =
+  match get t.db ~key:Root_hash ~error:(`Not_found `Root_hash) with
+  | Ok hash ->
+      Ok hash
+  | Error _ ->
+      Result.map ~f:Root_data.Minimal.Stable.Latest.hash (get_root t)
+
 (* TODO: check that best tip is connected to root *)
 (* TODO: check for garbage *)
 let check t ~genesis_state_hash =
@@ -246,10 +312,9 @@ let check t ~genesis_state_hash =
       in
       (* checks the pointers, frontier hash, and checks pointer references *)
       let check_base () =
-        let%bind root =
-          get t.db ~key:Root ~error:(`Corrupt (`Not_found `Root))
+        let%bind root_hash =
+          Result.map_error (get_root_hash t) ~f:(fun e -> `Corrupt e)
         in
-        let root_hash = Root_data.Minimal.Stable.Latest.hash root in
         let%bind best_tip =
           get t.db ~key:Best_tip ~error:(`Corrupt (`Not_found `Best_tip))
         in
@@ -315,12 +380,11 @@ let initialize t ~root_data =
       Batch.set batch ~key:Db_version ~data:version ;
       Batch.set batch ~key:(Transition root_state_hash) ~data:root_transition ;
       Batch.set batch ~key:(Arcs root_state_hash) ~data:[] ;
-      Batch.set batch ~key:Root
+      Batch.set batch ~key:Root_hash ~data:root_state_hash ;
+      Batch.set batch ~key:Root_common
         ~data:
-          ( Root_data.Minimal.of_limited
-              ~common:(Root_data.Limited.common root_data)
-              root_state_hash
-          |> Root_data.Minimal.read_all_proofs_from_disk ) ;
+          ( root_data |> Root_data.Limited.common
+          |> Root_data.Common.read_all_proofs_from_disk ) ;
       Batch.set batch ~key:Best_tip ~data:root_state_hash ;
       Batch.set batch ~key:Protocol_states_for_root_scan_state
         ~data:
@@ -330,9 +394,8 @@ let initialize t ~root_data =
 let find_arcs_and_root t ~(arcs_cache : State_hash.t list State_hash.Table.t)
     ~parent_hashes =
   let f h = Rocks.Key.Some_key (Arcs h) in
-  let values =
-    get_batch t.db ~keys:(Some_key Root :: List.map parent_hashes ~f)
-  in
+  let root_hash = get_root_hash t in
+  let arcs = get_batch t.db ~keys:(List.map parent_hashes ~f) in
   let populate res parent_hash arc_opt =
     let%bind.Result () = res in
     match arc_opt with
@@ -342,13 +405,12 @@ let find_arcs_and_root t ~(arcs_cache : State_hash.t list State_hash.Table.t)
     | _ ->
         Error (`Not_found (`Arcs parent_hash))
   in
-  match values with
-  | Some (Some_key_value (Root, (old_root : Root_data.Minimal.Stable.V2.t)))
-    :: arcs ->
+  match root_hash with
+  | Ok hash ->
       let%map.Result () =
         List.fold2_exn ~init:(Result.return ()) ~f:populate parent_hashes arcs
       in
-      Root_data.Minimal.Stable.Latest.hash old_root
+      hash
   | _ ->
       Error (`Not_found `Old_root_transition)
 
@@ -372,11 +434,9 @@ let move_root ~old_root_hash ~new_root ~garbage =
     (Root_data.Limited.Stable.Latest.hashes new_root).state_hash
   in
   fun batch ->
-    Batch.set batch ~key:Root
-      ~data:
-        (Root_data.Minimal.Stable.Latest.of_limited
-           ~common:(Root_data.Limited.Stable.Latest.common new_root)
-           new_root_hash ) ;
+    Batch.set batch ~key:Root_hash ~data:new_root_hash ;
+    Batch.set batch ~key:Root_common
+      ~data:(Root_data.Limited.Stable.Latest.common new_root) ;
     Batch.set batch ~key:Protocol_states_for_root_scan_state
       ~data:
         (List.map ~f:With_hash.data
@@ -412,15 +472,10 @@ let get_transition t hash =
 
 let get_arcs t hash = get t.db ~key:(Arcs hash) ~error:(`Not_found (`Arcs hash))
 
-let get_root t = get t.db ~key:Root ~error:(`Not_found `Root)
-
 let get_protocol_states_for_root_scan_state t =
   get t.db ~key:Protocol_states_for_root_scan_state
     ~error:(`Not_found `Protocol_states_for_root_scan_state)
 
-let get_root_hash t =
-  Result.map ~f:Root_data.Minimal.Stable.Latest.hash (get_root t)
-
 let get_best_tip t = get t.db ~key:Best_tip ~error:(`Not_found `Best_tip)
 
 let set_best_tip data = Batch.set ~key:Best_tip ~data

src/lib/transition_frontier/persistent_frontier/database.mli

@@ -21,6 +21,8 @@ val with_batch : t -> f:(batch_t -> 'a) -> 'a
 module Error : sig
   type not_found_member =
     [ `Root
+    | `Root_hash
+    | `Root_common
     | `Best_tip
     | `Frontier_hash
     | `Root_transition