Use Proof_cache_tag.t in Ledger_proof.t

src/app/archive/cli/archive_cli.ml

@@ -69,7 +69,8 @@ let command_run =
          ~postgres_address:postgres.value
          ~server_port:
            (Option.value server_port.value ~default:server_port.default)
-         ~delete_older_than ~precomputed_values_opt ~missing_blocks_width )
+         ~delete_older_than ~precomputed_values_opt ~missing_blocks_width
+         ~proof_cache_db:(Proof_cache_tag.create_db ()) )
 
 let time_arg =
   (* Same timezone as Genesis_constants.genesis_state_timestamp. *)

src/app/archive/lib/diff.ml

@@ -135,7 +135,7 @@ module Builder = struct
                  (Time.diff account_created_time accounts_accessed_time) ) )
         ] ;
     Transition_frontier.Breadcrumb_added
-      { block = block_with_hash
+      { block = With_hash.map ~f:Mina_block.unwrap block_with_hash
       ; accounts_accessed
       ; accounts_created
       ; tokens_used

src/app/archive/lib/processor.ml

@@ -3304,9 +3304,13 @@ module Block = struct
         (Header.proposed_protocol_version_opt @@ Mina_block.header t)
       ~hash ~v1_transaction_hash:false
 
-  let add_from_precomputed conn ~constraint_constants (t : Precomputed.t) =
+  let add_from_precomputed ~proof_cache_db conn ~constraint_constants
+      (t : Precomputed.t) =
+    let staged_ledger_diff =
+      Staged_ledger_diff.generate ~proof_cache_db t.staged_ledger_diff
+    in
     add_parts_if_doesn't_exist conn ~constraint_constants
-      ~protocol_state:t.protocol_state ~staged_ledger_diff:t.staged_ledger_diff
+      ~protocol_state:t.protocol_state ~staged_ledger_diff
       ~protocol_version:t.protocol_version
       ~proposed_protocol_version:t.proposed_protocol_version
       ~hash:(Protocol_state.hashes t.protocol_state).state_hash
@@ -4680,10 +4684,11 @@ let add_block_aux ?(retries = 3) ~logger ~genesis_constants ~pool ~add_block
   retry ~f:add ~logger ~error_str:"add_block_aux" retries
 
 (* used by `archive_blocks` app *)
-let add_block_aux_precomputed ~constraint_constants ~logger ?retries ~pool
-    ~delete_older_than block =
+let add_block_aux_precomputed ~proof_cache_db ~constraint_constants ~logger
+    ?retries ~pool ~delete_older_than block =
   add_block_aux ~logger ?retries ~pool ~delete_older_than
-    ~add_block:(Block.add_from_precomputed ~constraint_constants)
+    ~add_block:
+      (Block.add_from_precomputed ~proof_cache_db ~constraint_constants)
     ~hash:(fun block ->
       (block.Precomputed.protocol_state |> Protocol_state.hashes).state_hash )
     ~accounts_accessed:block.Precomputed.accounts_accessed
@@ -4700,14 +4705,17 @@ let add_block_aux_extensional ~logger ?retries ~pool ~delete_older_than block =
     ~tokens_used:block.Extensional.Block.tokens_used block
 
 (* receive blocks from a daemon, write them to the database *)
-let run pool reader ~genesis_constants ~constraint_constants ~logger
-    ~delete_older_than : unit Deferred.t =
+let run ~proof_cache_db pool reader ~genesis_constants ~constraint_constants
+    ~logger ~delete_older_than : unit Deferred.t =
   Strict_pipe.Reader.iter reader ~f:(function
     | Diff.Transition_frontier
         (Breadcrumb_added
           { block; accounts_accessed; accounts_created; tokens_used; _ } ) -> (
         let add_block = Block.add_if_doesn't_exist ~constraint_constants in
         let hash = State_hash.With_state_hashes.state_hash in
+        let block =
+          With_hash.map ~f:(Mina_block.generate ~proof_cache_db) block
+        in
         match%bind
           add_block_aux ~logger ~genesis_constants ~pool ~delete_older_than
             ~hash ~add_block ~accounts_accessed ~accounts_created ~tokens_used
@@ -4858,7 +4866,7 @@ let create_metrics_server ~logger ~metrics_server_port ~missing_blocks_width
       go ()
 
 (* for running the archive process *)
-let setup_server ~(genesis_constants : Genesis_constants.t)
+let setup_server ~proof_cache_db ~(genesis_constants : Genesis_constants.t)
     ~(constraint_constants : Genesis_constants.Constraint_constants.t)
     ~metrics_server_port ~logger ~postgres_address ~server_port
     ~delete_older_than ~precomputed_values_opt ~missing_blocks_width =
@@ -4891,14 +4899,15 @@ let setup_server ~(genesis_constants : Genesis_constants.t)
       Deferred.unit
   | Ok pool ->
       let%bind () = add_genesis_accounts pool ~logger ~precomputed_values_opt in
-      run ~constraint_constants ~genesis_constants pool reader ~logger
-        ~delete_older_than
+      run ~proof_cache_db ~constraint_constants ~genesis_constants pool reader
+        ~logger ~delete_older_than
       |> don't_wait_for ;
       Strict_pipe.Reader.iter precomputed_block_reader
         ~f:(fun precomputed_block ->
           match%map
-            add_block_aux_precomputed ~logger ~pool ~genesis_constants
-              ~constraint_constants ~delete_older_than precomputed_block
+            add_block_aux_precomputed ~proof_cache_db ~logger ~pool
+              ~genesis_constants ~constraint_constants ~delete_older_than
+              precomputed_block
           with
           | Error e ->
               [%log warn]

src/app/archive/lib/test.ml

@@ -307,6 +307,7 @@ let%test_module "Archive node unit tests" =
           Strict_pipe.Writer.close writer ;
           let%bind () =
             Processor.run
+              ~proof_cache_db:(Proof_cache_tag.For_tests.create_db ())
               ~genesis_constants:precomputed_values.genesis_constants
               ~constraint_constants:precomputed_values.constraint_constants pool
               reader ~logger ~delete_older_than:None

src/app/archive_blocks/archive_blocks.ml

@@ -5,7 +5,8 @@ open Async
 open Archive_lib
 
 let main ~genesis_constants ~constraint_constants ~archive_uri ~precomputed
-    ~extensional ~success_file ~failure_file ~log_successes ~files () =
+    ~extensional ~success_file ~failure_file ~log_successes ~files
+    ~proof_cache_db () =
   let output_file_line path =
     match path with
     | Some path ->
@@ -58,8 +59,9 @@ let main ~genesis_constants ~constraint_constants ~archive_uri ~precomputed
               Error (Error.to_string_hum err)
         in
         make_add_block of_yojson
-          (Processor.add_block_aux_precomputed ~genesis_constants
-             ~constraint_constants ~pool ~delete_older_than:None ~logger )
+          (Processor.add_block_aux_precomputed ~proof_cache_db
+             ~genesis_constants ~constraint_constants ~pool
+             ~delete_older_than:None ~logger )
       in
       let add_extensional_block =
         (* allow use of older-versioned blocks *)
@@ -134,5 +136,7 @@ let () =
                 processed successfully"
              (Flag.optional_with_default true Param.bool)
          and files = Param.anon Anons.(sequence ("FILES" %: Param.string)) in
+         let proof_cache_db = Proof_cache_tag.create_db () in
          main ~genesis_constants ~constraint_constants ~archive_uri ~precomputed
-           ~extensional ~success_file ~failure_file ~log_successes ~files )))
+           ~extensional ~success_file ~failure_file ~log_successes ~files
+           ~proof_cache_db )))

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

@@ -1166,6 +1166,7 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ;
               ; time_controller
               ; pubsub_v1
               ; pubsub_v0
+              ; proof_cache_db = Proof_cache_tag.create_db ()
               }
           in
           let net_config =
@@ -1279,7 +1280,9 @@ Pass one of -peer, -peer-list-file, -seed, -peer-list-url.|} ;
                  ~node_status_url ~graphql_control_port:itn_graphql_port
                  ~simplified_node_stats
                  ~zkapp_cmd_limit:(ref compile_config.zkapp_cmd_limit)
-                 ~compile_config () )
+                 ~compile_config
+                 ~proof_cache_db:(Proof_cache_tag.create_db ())
+                 () )
           in
           { mina
           ; client_trustlist

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

@@ -186,7 +186,8 @@ let test ~privkey_path ~ledger_path ?prev_block_path ~first_partition_slots
     let prev_block =
       Binable.of_string (module Mina_block.Stable.Latest) prev_block_data
     in
-    Mina_block.header prev_block |> Mina_block.Header.protocol_state
+    Mina_block.Stable.Latest.header prev_block
+    |> Mina_block.Header.protocol_state
   in
   let consensus_constants =
     Consensus.Constants.create ~constraint_constants

src/app/delegation_verify/delegation_verify.ml

@@ -85,7 +85,7 @@ module Make_verifier (Source : Submission.Data_source) = struct
             verify_snark_work ~verify_transaction_snarks ~proof ~message
       else return ()
     in
-    let header = Mina_block.header block in
+    let header = Mina_block.Stable.Latest.header block in
     let protocol_state = Mina_block.Header.protocol_state header in
     let consensus_state =
       Mina_state.Protocol_state.consensus_state protocol_state

src/app/delegation_verify/known_blocks.ml

@@ -11,7 +11,7 @@ end
 
 module Deferred_block = struct
   type t =
-    { block : Mina_block.t Deferred.Or_error.t
+    { block : Mina_block.Stable.Latest.t Deferred.Or_error.t
     ; valid : unit Deferred.Or_error.t (* Raises if block is invalid. *)
     }
 
@@ -26,7 +26,7 @@ module Deferred_block = struct
     Deferred.create compute
 
   let verify_block ~verify_blockchain_snarks block =
-    let header = Mina_block.header block in
+    let header = Mina_block.Stable.Latest.header block in
     let open Mina_block.Header in
     verify_blockchain_snarks
       [ (protocol_state header, protocol_state_proof header) ]

src/app/disk_caching_stats/disk_caching_stats.ml

@@ -437,9 +437,7 @@ module Values (S : Sample) = struct
   let sok_message () : Mina_base.Sok_message.t =
     Mina_base.Sok_message.create ~fee:(fee ()) ~prover:(public_key ())
 
-  let merge_work () :
-      Transaction_snark_scan_state.Ledger_proof_with_sok_message.t =
-    (ledger_proof (), sok_message ())
+  let merge_work () = (ledger_proof (), sok_message ())
 end
 
 type size_params =

src/app/dump_blocks/encoding.ml

@@ -3,7 +3,7 @@ open Core
 type t = Json | Binary
 
 type 'a content =
-  | Block : Mina_block.t content
+  | Block : Mina_block.Stable.Latest.t content
   | Precomputed : Mina_block.Precomputed.t content
 
 let append_newline s = s ^ "\n"
@@ -13,7 +13,7 @@ let block_of_breadcrumb ?with_parent_statehash breadcrumb =
   let block = Frontier_base.Breadcrumb.block breadcrumb in
   match with_parent_statehash with
   | None ->
-      block
+      block |> Mina_block.unwrap
   | Some hash ->
       let previous_state_hash = Mina_base.State_hash.of_base58_check_exn hash in
       let h = header block in
@@ -28,7 +28,7 @@ let block_of_breadcrumb ?with_parent_statehash breadcrumb =
           ~current_protocol_version:(Header.current_protocol_version h)
           ()
       in
-      Mina_block.create ~header ~body:(body block)
+      Mina_block.create ~header ~body:(body block) |> Mina_block.unwrap
 
 module type S = sig
   type t
@@ -43,8 +43,8 @@ module type S = sig
   val of_string : string -> t
 end
 
-module Binary_block : S with type t = Mina_block.t = struct
-  type t = Mina_block.t
+module Binary_block : S with type t = Mina_block.Stable.Latest.t = struct
+  type t = Mina_block.Stable.Latest.t
 
   let name = "binary"
 
@@ -71,7 +71,8 @@ let precomputed_of_breadcrumb ?with_parent_statehash breadcrumb =
   let block = block_of_breadcrumb ?with_parent_statehash breadcrumb in
   let staged_ledger = Transition_frontier.Breadcrumb.staged_ledger breadcrumb in
   let scheduled_time =
-    Mina_block.(Header.protocol_state @@ header block)
+    Mina_block.Stable.Latest.header block
+    |> Mina_block.Header.protocol_state
     |> Mina_state.Protocol_state.blockchain_state
     |> Mina_state.Blockchain_state.timestamp
   in

src/app/heap_usage/values.ml

@@ -231,6 +231,8 @@ let scan_state_base_node_zkapp ~constraint_constants ~zkapp_command =
   in
   mk_scan_state_base_node varying ~constraint_constants
 
+let proof_cache_db = Proof_cache_tag.For_tests.create_db ()
+
 let scan_state_merge_node :
     Transaction_snark_scan_state.Ledger_proof_with_sok_message.t
     Parallel_scan.Merge.t =
@@ -270,6 +272,12 @@ let scan_state_merge_node :
       let ledger_proof = Transaction_snark.create ~statement ~proof in
       (ledger_proof, sok_msg)
     in
+    let left =
+      Tuple2.map_fst ~f:(Ledger_proof.Cached.generate ~proof_cache_db) left
+    in
+    let right =
+      Tuple2.map_fst ~f:(Ledger_proof.Cached.generate ~proof_cache_db) right
+    in
     Full { left; right; seq_no = 1; status = Todo }
   in
   ((weight1, weight2), job)

src/lib/best_tip_prover/wrap_for_block.ml

@@ -1,14 +1,18 @@
-let map ~f
+let to_header_data ~to_header
     { Proof_carrying_data.proof = merkle_list, root_unverified
     ; data = best_tip_unverified
     } =
+  { Proof_carrying_data.proof = (merkle_list, to_header root_unverified)
+  ; data = to_header best_tip_unverified
+  }
+
+let map ~f
+    ( { Proof_carrying_data.proof = _, root_unverified
+      ; data = best_tip_unverified
+      } as pcd ) =
   let%map.Async_kernel.Deferred.Or_error ( `Root root_header
                                          , `Best_tip best_tip_header ) =
-    f
-      { Proof_carrying_data.proof =
-          (merkle_list, Mina_block.header root_unverified)
-      ; data = Mina_block.header best_tip_unverified
-      }
+    f (to_header_data ~to_header:Mina_block.header pcd)
   in
   let root =
     Mina_block.Validation.with_body root_header

src/lib/block_producer/block_producer.ml

@@ -313,6 +313,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants
                             (Staged_ledger.Staged_ledger_error.to_string e) )
                       ; ( "diff"
                         , Staged_ledger_diff.Stable.Latest.to_yojson
+                          @@ Staged_ledger_diff.unwrap
                           @@ Staged_ledger_diff.forget diff )
                       ]
                     "Error applying the diff $diff: $error"
@@ -335,6 +336,9 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants
           , ledger_proof_opt
           , is_new_stack
           , pending_coinbase_update ) ->
+          let diff_unwrapped =
+            Staged_ledger_diff.unwrap @@ Staged_ledger_diff.forget diff
+          in
           let%bind protocol_state, consensus_transition_data =
             lift_sync (fun () ->
                 let previous_ledger_hash =
@@ -365,7 +369,7 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants
                 let body_reference =
                   Staged_ledger_diff.Body.compute_reference
                     ~tag:Mina_net2.Bitswap_tag.(to_enum Body)
-                    (Body.create @@ Staged_ledger_diff.forget diff)
+                    (Body.Stable.Latest.create diff_unwrapped)
                 in
                 let blockchain_state =
                   (* We use the time of the beginning of the slot because if things
@@ -913,7 +917,8 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover
                       ~transition_receipt_time () )
                 |> Deferred.Result.map_error ~f:(function
                      | `Invalid_staged_ledger_diff e ->
-                         `Invalid_staged_ledger_diff (e, staged_ledger_diff)
+                         `Invalid_staged_ledger_diff
+                           (e, Staged_ledger_diff.unwrap staged_ledger_diff)
                      | ( `Fatal_error _
                        | `Invalid_genesis_protocol_state
                        | `Invalid_staged_ledger_hash _
@@ -1346,8 +1351,9 @@ let run ~context:(module Context : CONTEXT) ~vrf_evaluator ~prover ~verifier
               ~f:(fun _ -> start ())
             : unit Block_time.Timeout.t ) )
 
-let run_precomputed ~context:(module Context : CONTEXT) ~verifier ~trust_system
-    ~time_controller ~frontier_reader ~transition_writer ~precomputed_blocks =
+let run_precomputed ~context:(module Context : CONTEXT) ~proof_cache_db
+    ~verifier ~trust_system ~time_controller ~frontier_reader ~transition_writer
+    ~precomputed_blocks =
   let open Context in
   let rejected_blocks_logger =
     Logger.create ~id:Logger.Logger_id.rejected_blocks ()
@@ -1435,7 +1441,10 @@ let run_precomputed ~context:(module Context : CONTEXT) ~verifier ~trust_system
             Header.create ~protocol_state ~protocol_state_proof
               ~delta_block_chain_proof ()
           in
-          let body = Body.create staged_ledger_diff in
+          let body =
+            Body.create
+              (Staged_ledger_diff.generate ~proof_cache_db staged_ledger_diff)
+          in
           let%bind transition =
             let open Result.Let_syntax in
             Validation.wrap_header