Don't compute staged ledger hash on every RPC call

src/lib/bootstrap_controller/bootstrap_controller.ml

@@ -1031,10 +1031,16 @@ let%test_module "Bootstrap_controller tests" =
                   ~pending_coinbases ~get_state
                 |> Deferred.Or_error.ok_exn
               in
-              assert (
-                Staged_ledger_hash.equal
-                  (Staged_ledger.hash staged_ledger)
-                  (Staged_ledger.hash actual_staged_ledger) ) ) )
+              let height =
+                Transition_frontier.Breadcrumb.consensus_state breadcrumb
+                |> Consensus.Data.Consensus_state.blockchain_length
+                |> Mina_numbers.Length.to_int
+              in
+              [%test_eq: Staged_ledger_hash.t]
+                ~message:
+                  (sprintf "mismatch of staged ledger hash height %d" height)
+                (Transition_frontier.Breadcrumb.staged_ledger_hash breadcrumb)
+                (Staged_ledger.hash actual_staged_ledger) ) )
 
     (*
     let%test_unit "if we see a new transition that is better than the \

src/lib/genesis_proof/genesis_proof.ml

@@ -150,52 +150,6 @@ end
 
 include T
 
-let base_proof (module B : Blockchain_snark.Blockchain_snark_state.S)
-    (t : Inputs.t) =
-  let genesis_ledger = Genesis_ledger.Packed.t t.genesis_ledger in
-  let constraint_constants = t.constraint_constants in
-  let consensus_constants = t.consensus_constants in
-  let prev_state =
-    Protocol_state.negative_one ~genesis_ledger
-      ~genesis_epoch_data:t.genesis_epoch_data ~constraint_constants
-      ~consensus_constants ~genesis_body_reference:t.genesis_body_reference
-  in
-  let curr = t.protocol_state_with_hashes.data in
-  let dummy_txn_stmt : Transaction_snark.Statement.With_sok.t =
-    let t =
-      Blockchain_state.ledger_proof_statement
-        (Protocol_state.blockchain_state curr)
-    in
-    { t with sok_digest = Sok_message.Digest.default }
-  in
-  let genesis_epoch_ledger =
-    match t.genesis_epoch_data with
-    | None ->
-        genesis_ledger
-    | Some data ->
-        data.staking.ledger
-  in
-  let open Pickles_types in
-  let blockchain_dummy =
-    Pickles.Proof.dummy Nat.N2.n Nat.N2.n Nat.N2.n ~domain_log2:16
-  in
-  let txn_dummy =
-    Pickles.Proof.dummy Nat.N2.n Nat.N2.n Nat.N0.n ~domain_log2:14
-  in
-  B.step
-    ~handler:
-      (Consensus.Data.Prover_state.precomputed_handler ~constraint_constants
-         ~genesis_epoch_ledger )
-    { transition =
-        Snark_transition.genesis ~constraint_constants ~consensus_constants
-          ~genesis_ledger ~genesis_body_reference:t.genesis_body_reference
-    ; prev_state
-    ; prev_state_proof = blockchain_dummy
-    ; txn_snark = dummy_txn_stmt
-    ; txn_snark_proof = txn_dummy
-    }
-    t.protocol_state_with_hashes.data
-
 let digests (module T : Transaction_snark.S)
     (module B : Blockchain_snark.Blockchain_snark_state.S) =
   let open Lazy.Let_syntax in

src/lib/mina_block/validated_block.ml

@@ -66,3 +66,7 @@ let state_body_hash (t, _) =
 let header t = t |> forget |> With_hash.data |> Block.header
 
 let body t = t |> forget |> With_hash.data |> Block.body
+
+let is_genesis t =
+  header t |> Header.protocol_state |> Mina_state.Protocol_state.consensus_state
+  |> Consensus.Data.Consensus_state.is_genesis_state

src/lib/mina_block/validated_block.mli

@@ -31,3 +31,5 @@ val state_body_hash : t -> State_body_hash.t
 val header : t -> Header.t
 
 val body : t -> Staged_ledger_diff.Body.t
+
+val is_genesis : t -> bool

src/lib/sync_handler/sync_handler.ml

@@ -139,7 +139,8 @@ module Make (Inputs : Inputs_intf) :
       in
       let scan_state = Staged_ledger.scan_state staged_ledger in
       let merkle_root =
-        Staged_ledger.hash staged_ledger |> Staged_ledger_hash.ledger_hash
+        Breadcrumb.staged_ledger_hash breadcrumb
+        |> Staged_ledger_hash.ledger_hash
       in
       let%map scan_state_protocol_states = protocol_states scan_state in
       let pending_coinbase =

src/lib/transition_frontier/frontier_base/breadcrumb.ml

@@ -13,6 +13,7 @@ module T = struct
     ; staged_ledger : Staged_ledger.t
     ; just_emitted_a_proof : bool
     ; transition_receipt_time : Time.t option
+    ; staged_ledger_hash : Staged_ledger_hash.t
     }
   [@@deriving fields]
 
@@ -31,17 +32,30 @@ module T = struct
 
   let create ~validated_transition ~staged_ledger ~just_emitted_a_proof
       ~transition_receipt_time =
+    (* TODO This looks terrible, consider removing this in the hardfork by either
+       removing staged_ledger_hash from the header or computing it consistently
+       for the genesis block *)
+    let staged_ledger_hash =
+      if Mina_block.Validated.is_genesis validated_transition then
+        Staged_ledger.hash staged_ledger
+      else
+        Mina_block.Validated.header validated_transition
+        |> Mina_block.Header.protocol_state |> Protocol_state.blockchain_state
+        |> Blockchain_state.staged_ledger_hash
+    in
     { validated_transition
     ; staged_ledger
     ; just_emitted_a_proof
     ; transition_receipt_time
+    ; staged_ledger_hash
     }
 
   let to_yojson
       { validated_transition
       ; staged_ledger = _
       ; just_emitted_a_proof
       ; transition_receipt_time
+      ; staged_ledger_hash = _
       } =
     `Assoc
       [ ( "validated_transition"
@@ -61,7 +75,8 @@ T.
   , staged_ledger
   , just_emitted_a_proof
   , transition_receipt_time
-  , to_yojson )]
+  , to_yojson
+  , staged_ledger_hash )]
 
 include Allocation_functor.Make.Basic (T)
 
@@ -398,7 +413,7 @@ module For_tests = struct
       let body =
         Mina_block.Body.create @@ Staged_ledger_diff.forget staged_ledger_diff
       in
-      let%bind ( `Hash_after_applying next_staged_ledger_hash
+      let%bind ( `Hash_after_applying staged_ledger_hash
                , `Ledger_proof ledger_proof_opt
                , `Staged_ledger _
                , `Pending_coinbase_update _ ) =
@@ -436,7 +451,7 @@ module For_tests = struct
       let next_blockchain_state =
         Blockchain_state.create_value
           ~timestamp:(Block_time.now @@ Block_time.Controller.basic ~logger)
-          ~staged_ledger_hash:next_staged_ledger_hash ~genesis_ledger_hash
+          ~staged_ledger_hash ~genesis_ledger_hash
           ~body_reference:
             (Body.compute_reference
                ~tag:Mina_net2.Bitswap_tag.(to_enum Body)

src/lib/transition_frontier/frontier_base/breadcrumb.mli

@@ -82,6 +82,8 @@ val display : t -> display
 
 val name : t -> string
 
+val staged_ledger_hash : t -> Staged_ledger_hash.t
+
 module For_tests : sig
   val gen :
        ?logger:Logger.t

src/lib/transition_frontier/frontier_base/root_data.ml

@@ -51,7 +51,7 @@ module Historical = struct
       Staged_ledger.pending_coinbase_collection staged_ledger
     in
     let staged_ledger_target_ledger_hash =
-      Staged_ledger.hash staged_ledger |> Staged_ledger_hash.ledger_hash
+      Breadcrumb.staged_ledger_hash breadcrumb |> Staged_ledger_hash.ledger_hash
     in
     let common = Common.create ~scan_state ~pending_coinbase in
     { transition; common; staged_ledger_target_ledger_hash }

src/lib/transition_frontier/full_frontier/full_frontier.ml

@@ -1010,12 +1010,14 @@ module For_tests = struct
            ~src:(Lazy.force Genesis_ledger.t)
            ~dest:(Mina_ledger.Ledger.create ~depth:ledger_depth ()) )
     in
+    let staged_ledger =
+      Staged_ledger.create_exn ~constraint_constants ~ledger:root_ledger
+    in
     let root_data =
       let open Root_data in
       { transition =
           Mina_block.Validated.lift @@ Mina_block.genesis ~precomputed_values
-      ; staged_ledger =
-          Staged_ledger.create_exn ~constraint_constants ~ledger:root_ledger
+      ; staged_ledger
       ; protocol_states = []
       }
     in

src/lib/transition_frontier/persistent_frontier/persistent_frontier.ml

@@ -63,14 +63,9 @@ let construct_staged_ledger_at_root ~(precomputed_values : Precomputed_values.t)
       ~expected_merkle_root:(Staged_ledger_hash.ledger_hash staged_ledger_hash)
       ~get_state
   in
-  let is_genesis =
-    Mina_block.Validated.header root_transition
-    |> Header.protocol_state |> Protocol_state.consensus_state
-    |> Consensus.Data.Consensus_state.is_genesis_state
-  in
   let constructed_staged_ledger_hash = Staged_ledger.hash staged_ledger in
   if
-    is_genesis
+    Mina_block.Validated.is_genesis root_transition
     || Staged_ledger_hash.equal staged_ledger_hash
          constructed_staged_ledger_hash
   then Deferred.return (Ok staged_ledger)