Decouple Mina_block.{Stable.Latest.t, t}

src/app/archive/lib/diff.ml

@@ -135,7 +135,8 @@ 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.read_all_proofs_from_disk block_with_hash
       ; accounts_accessed
       ; accounts_created
       ; tokens_used

src/app/archive/lib/processor.ml

@@ -4708,6 +4708,9 @@ let run pool reader ~genesis_constants ~constraint_constants ~logger
           { 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.write_all_proofs_to_disk block
+        in
         match%bind
           add_block_aux ~logger ~genesis_constants ~pool ~delete_older_than
             ~hash ~add_block ~accounts_accessed ~accounts_created ~tokens_used

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

@@ -189,7 +189,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

@@ -108,7 +108,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/dump_blocks/encoding.ml

@@ -3,7 +3,7 @@ open Core
 type t = Sexp | 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.read_all_proofs_from_disk
   | Some hash ->
       let previous_state_hash = Mina_base.State_hash.of_base58_check_exn hash in
       let h = header block in
@@ -29,6 +29,7 @@ let block_of_breadcrumb ?with_parent_statehash breadcrumb =
           ()
       in
       Mina_block.create ~header ~body:(body block)
+      |> Mina_block.read_all_proofs_from_disk
 
 module type S = sig
   type t
@@ -43,8 +44,8 @@ module type S = sig
   val of_string : string -> t
 end
 
-module Sexp_block : S with type t = Mina_block.t = struct
-  type t = Mina_block.t
+module Sexp_block : S with type t = Mina_block.Stable.Latest.t = struct
+  type t = Mina_block.Stable.Latest.t
 
   let name = "sexp"
 
@@ -56,8 +57,8 @@ module Sexp_block : S with type t = Mina_block.t = struct
   let of_string s = Sexp.of_string s |> Mina_block.Stable.Latest.t_of_sexp
 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"
 
@@ -84,7 +85,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/lib/block_producer/block_producer.ml

@@ -992,7 +992,9 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover
                      transition frontier" ;
                   Deferred.map ~f:Result.return
                     (Mina_networking.broadcast_state net
-                       (Breadcrumb.block_with_hash breadcrumb) )
+                       ( Breadcrumb.block_with_hash breadcrumb
+                       |> With_hash.map ~f:Mina_block.read_all_proofs_from_disk
+                       ) )
               | `Timed_out ->
                   (* FIXME #3167: this should be fatal, and more
                      importantly, shouldn't happen.

src/lib/bootstrap_controller/bootstrap_controller.ml

@@ -174,13 +174,19 @@ let on_transition ({ context = (module Context); _ } as t) ~sender
             $error" ;
         Deferred.return `Ignored
     | Ok peer_root_with_proof -> (
+        let pcd =
+          peer_root_with_proof.data
+          |> Proof_carrying_data.map ~f:Mina_block.write_all_proofs_to_disk
+          |> Proof_carrying_data.map_proof
+               ~f:(Tuple2.map_snd ~f:Mina_block.write_all_proofs_to_disk)
+        in
         match%bind
           Mina_block.verify_on_header
             ~verify:
               (Sync_handler.Root.verify
                  ~context:(module Context)
                  ~verifier:t.verifier candidate_consensus_state )
-            peer_root_with_proof.data
+            pcd
         with
         | Ok (`Root root, `Best_tip best_tip) ->
             if done_syncing_root root_sync_ledger then return `Ignored

src/lib/gossip_net/intf.ml

@@ -140,7 +140,7 @@ module type GOSSIP_NET = sig
     -> 'r rpc_response Deferred.t List.t Deferred.t
 
   val broadcast_state :
-    ?origin_topic:string -> t -> Mina_block.t -> unit Deferred.t
+    ?origin_topic:string -> t -> Mina_block.Stable.Latest.t -> unit Deferred.t
 
   val broadcast_transaction_pool_diff :
        ?origin_topic:string

src/lib/gossip_net/libp2p.ml

@@ -949,7 +949,7 @@ module Make (Rpc_interface : RPC_INTERFACE) :
       let pfs = !(t.publish_functions) in
       let%bind () =
         guard_topic ?origin_topic v1_topic_block pfs.publish_v1_block
-          (Mina_block.header state)
+          (Mina_block.Stable.Latest.header state)
       in
       guard_topic ?origin_topic v0_topic pfs.publish_v0 (Message.New_state state)
 

src/lib/gossip_net/message.ml

@@ -10,7 +10,7 @@ module Master = struct
     type transaction_pool_diff_msg = Transaction_pool.Resource_pool.Diff.t
 
     type msg =
-      | New_state of Mina_block.t
+      | New_state of Mina_block.Stable.Latest.t
       | Snark_pool_diff of snark_pool_diff_msg Network_pool.With_nonce.t
       | Transaction_pool_diff of
           Transaction_pool.Resource_pool.Diff.t Network_pool.With_nonce.t
@@ -76,8 +76,8 @@ module Latest = V2
 [%%define_locally Latest.(summary)]
 
 type block_sink_msg =
-  [ `Block of Mina_block.t Envelope.Incoming.t
-  | `Header of Mina_block.Header.t Envelope.Incoming.t ]
+  [ `Block of Mina_block.Stable.Latest.t Envelope.Incoming.t
+  | `Header of Mina_block.Header.Stable.Latest.t Envelope.Incoming.t ]
   * [ `Time_received of Block_time.t ]
   * [ `Valid_cb of Mina_net2.Validation_callback.t ]
 

src/lib/ledger_catchup/normal_catchup.ml

@@ -469,7 +469,7 @@ let download_transitions ~target_hash ~logger ~trust_system ~network
                            ~hash_data:
                              (Fn.compose Mina_state.Protocol_state.hashes
                                 (Fn.compose Mina_block.Header.protocol_state
-                                   Mina_block.header ) ) )
+                                   Mina_block.Stable.Latest.header ) ) )
                   in
                   if not @@ verify_against_hashes hashed_transitions hashes then (
                     let error_msg =
@@ -824,6 +824,12 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network
                  else
                    download_transitions ~logger ~trust_system ~network
                      ~preferred_peer ~hashes_of_missing_transitions ~target_hash
+                   >>| List.map
+                         ~f:
+                           (Envelope.Incoming.map
+                              ~f:
+                                (With_hash.map
+                                   ~f:Mina_block.write_all_proofs_to_disk ) )
                in
                [%log debug]
                  ~metadata:[ ("target_hash", State_hash.to_yojson target_hash) ]

src/lib/ledger_catchup/super_catchup.ml

@@ -1166,7 +1166,9 @@ let run_catchup ~context:(module Context : CONTEXT) ~trust_system ~verifier
         in
         Mina_networking.get_transition_chain
           ~heartbeat_timeout:(Time_ns.Span.of_sec sec)
-          ~timeout:(Time.Span.of_sec sec) network peer (List.map hs ~f:fst) )
+          ~timeout:(Time.Span.of_sec sec) network peer (List.map hs ~f:fst)
+        |> Deferred.Or_error.map
+             ~f:(List.map ~f:Mina_block.write_all_proofs_to_disk) )
       ~peers:(fun () -> Mina_networking.peers network)
       ~knowledge_context:
         (Broadcast_pipe.map best_tip_r

src/lib/mina_block/block.ml

@@ -42,7 +42,8 @@ module Stable = struct
 
       type nonrec t = t
 
-      type 'a creator = header:Header.t -> body:Staged_ledger_diff.Body.t -> 'a
+      type 'a creator =
+        header:Header.t -> body:Staged_ledger_diff.Body.Stable.Latest.t -> 'a
 
       let map_creator c ~f ~header ~body = f (c ~header ~body)
 
@@ -66,6 +67,7 @@ end]
 
 type t = Stable.Latest.t =
   { header : Header.t; body : Staged_ledger_diff.Body.t }
+[@@deriving fields]
 
 type with_hash = t State_hash.With_state_hashes.t
 
@@ -87,7 +89,7 @@ let to_logging_yojson header : Yojson.Safe.t =
              ~default:"<None>" ~f:Protocol_version.to_string ) )
     ]
 
-[%%define_locally Stable.Latest.(create, header, body)]
+let create ~header ~body = { header; body }
 
 let wrap_with_hash block =
   With_hash.of_data block
@@ -112,3 +114,7 @@ let account_ids_accessed ~constraint_constants t =
   |> List.concat
   |> List.dedup_and_sort
        ~compare:[%compare: Account_id.t * [ `Accessed | `Not_accessed ]]
+
+let write_all_proofs_to_disk = Fn.id
+
+let read_all_proofs_from_disk = Fn.id

src/lib/mina_block/block.mli

@@ -8,14 +8,18 @@ module Stable : sig
   module V2 : sig
     type t [@@deriving sexp, equal]
 
+    val header : t -> Header.Stable.V2.t
+
+    val body : t -> Staged_ledger_diff.Body.Stable.V1.t
+
     val transactions :
          constraint_constants:Genesis_constants.Constraint_constants.t
       -> t
       -> Transaction.Stable.V2.t With_status.t list
   end
 end]
 
-type t = Stable.Latest.t
+type t
 
 val to_logging_yojson : Header.t -> Yojson.Safe.t
 
@@ -46,3 +50,7 @@ val account_ids_accessed :
      constraint_constants:Genesis_constants.Constraint_constants.t
   -> t
   -> (Account_id.t * [ `Accessed | `Not_accessed ]) list
+
+val write_all_proofs_to_disk : Stable.Latest.t -> t
+
+val read_all_proofs_from_disk : t -> Stable.Latest.t

src/lib/mina_block/mina_block.ml

@@ -73,16 +73,23 @@ let consensus_state =
 
 include Block
 
+module Proof_carrying = struct
+  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
+    }
+end
+
 let verify_on_header ~verify
-    { Proof_carrying_data.proof = merkle_list, root_unverified
-    ; data = best_tip_unverified
-    } =
+    ( { 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 ) =
-    verify
-      { Proof_carrying_data.proof = (merkle_list, header root_unverified)
-      ; data = header best_tip_unverified
-      }
+    verify (Proof_carrying.to_header_data ~to_header:header pcd)
   in
   let root = Validation.with_body root_header (body root_unverified) in
   let best_tip =

src/lib/mina_block/validated_block.ml

@@ -77,4 +77,5 @@ let is_genesis t =
   header t |> Header.protocol_state |> Mina_state.Protocol_state.consensus_state
   |> Consensus.Data.Consensus_state.is_genesis_state
 
-let read_all_proofs_from_disk = Fn.id
+let read_all_proofs_from_disk ((b, v) : t) : Stable.Latest.t =
+  (With_hash.map ~f:Block.read_all_proofs_from_disk b, v)

src/lib/mina_intf/transition_frontier_components_intf.ml

@@ -321,8 +321,9 @@ module type Transition_router_intf = sig
     -> frontier_broadcast_writer:
          transition_frontier option Pipe_lib.Broadcast_pipe.Writer.t
     -> network_transition_reader:
-         ( [ `Block of Mina_block.t Envelope.Incoming.t
-           | `Header of Mina_block.Header.t Envelope.Incoming.t ]
+         ( [ `Block of Mina_block.Stable.Latest.t Envelope.Incoming.t
+           | `Header of Mina_block.Header.Stable.Latest.t Envelope.Incoming.t
+           ]
          * [ `Time_received of Block_time.t ]
          * [ `Valid_cb of Mina_net2.Validation_callback.t ] )
          Strict_pipe.Reader.t