[Develop] Use headers in Best_tip_prover.verify

src/lib/best_tip_prover/best_tip_prover.ml

@@ -2,7 +2,6 @@ open Core_kernel
 open Mina_base
 open Mina_state
 open Async_kernel
-open Mina_block
 
 module type Inputs_intf = sig
   module Transition_frontier : module type of Transition_frontier
@@ -28,7 +27,8 @@ module Make (Inputs : Inputs_intf) :
 
     let get_previous ~context transition =
       let parent_hash =
-        transition |> Mina_block.Validated.header |> Header.protocol_state
+        transition |> Mina_block.Validated.header
+        |> Mina_block.Header.protocol_state
         |> Protocol_state.previous_state_hash
       in
       let open Option.Let_syntax in
@@ -88,24 +88,19 @@ module Make (Inputs : Inputs_intf) :
       }
 
   let validate_proof ~verifier ~genesis_state_hash
-      (transition_with_hash : Mina_block.with_hash) :
-      Mina_block.initial_valid_block Deferred.Or_error.t =
-    let validate (b, v) =
-      let open Deferred.Result.Let_syntax in
-      let h = (With_hash.map ~f:Mina_block.header b, v) in
-      Deferred.return (Validation.validate_protocol_versions h)
-      >>= Fn.compose Deferred.return
-            (Validation.validate_genesis_protocol_state ~genesis_state_hash)
-      >>= Validation.validate_single_proof ~verifier ~genesis_state_hash
-      >>| Fn.flip Validation.with_body (Mina_block.body @@ With_hash.data b)
-    in
+      (header_hashed : Mina_block.Header.with_hash) :
+      Mina_block.initial_valid_header Deferred.Or_error.t =
+    let open Mina_block.Validation in
     let%map validation =
-      Validation.wrap transition_with_hash
-      |> Validation.skip_time_received_validation
-           `This_block_was_not_received_via_gossip
-      |> Validation.skip_delta_block_chain_validation
+      wrap_header header_hashed
+      |> skip_time_received_validation `This_block_was_not_received_via_gossip
+      |> skip_delta_block_chain_validation
            `This_block_was_not_received_via_gossip
-      |> validate
+      |> validate_protocol_versions
+      |> Result.bind ~f:(validate_genesis_protocol_state ~genesis_state_hash)
+      |> Deferred.return
+      |> Deferred.Result.bind
+           ~f:(validate_single_proof ~verifier ~genesis_state_hash)
     in
     match validation with
     | Ok block ->
@@ -122,7 +117,9 @@ module Make (Inputs : Inputs_intf) :
             Error (Error.tag ~tag:"verifier proof" e) )
 
   let verify ~verifier ~genesis_constants ~precomputed_values
-      { Proof_carrying_data.data = best_tip; proof = merkle_list, root } =
+      { Proof_carrying_data.data = (best_tip : Mina_block.Header.t)
+      ; proof = merkle_list, (root : Mina_block.Header.t)
+      } =
     let open Deferred.Or_error.Let_syntax in
     let merkle_list_length = List.length merkle_list in
     let max_length = Transition_frontier.global_max_length genesis_constants in
@@ -132,11 +129,13 @@ module Make (Inputs : Inputs_intf) :
     let genesis_state_hash =
       State_hash.With_state_hashes.state_hash genesis_protocol_state
     in
-    let state_hashes block =
-      Mina_block.header block |> Header.protocol_state |> Protocol_state.hashes
+    let state_hashes h =
+      Mina_block.Header.protocol_state h |> Protocol_state.hashes
+    in
+    let root_with_hash = With_hash.of_data root ~hash_data:state_hashes in
+    let root_is_genesis =
+      State_hash.(root_with_hash.hash.state_hash = genesis_state_hash)
     in
-    let root_state_hash = (state_hashes root).state_hash in
-    let root_is_genesis = State_hash.(root_state_hash = genesis_state_hash) in
     let%bind () =
       Deferred.return
         (Result.ok_if_true
@@ -150,16 +149,11 @@ module Make (Inputs : Inputs_intf) :
     let best_tip_with_hash =
       With_hash.of_data best_tip ~hash_data:state_hashes
     in
-    let root_transition_with_hash =
-      With_hash.of_data root ~hash_data:state_hashes
-    in
     let%bind (_ : State_hash.t Mina_stdlib.Nonempty_list.t) =
       Deferred.return
         (Result.of_option
            (Merkle_list_verifier.verify
-              ~init:
-                (State_hash.With_state_hashes.state_hash
-                   root_transition_with_hash )
+              ~init:(State_hash.With_state_hashes.state_hash root_with_hash)
               merkle_list
               (State_hash.With_state_hashes.state_hash best_tip_with_hash) )
            ~error:
@@ -169,12 +163,15 @@ module Make (Inputs : Inputs_intf) :
     in
     let%map root, best_tip =
       Deferred.Or_error.both
-        (validate_proof ~genesis_state_hash ~verifier root_transition_with_hash)
+        (validate_proof ~genesis_state_hash ~verifier root_with_hash)
         (validate_proof ~genesis_state_hash ~verifier best_tip_with_hash)
     in
-    (`Root root, `Best_tip best_tip)
+    ( `Root (root : Mina_block.Validation.initial_valid_with_header)
+    , `Best_tip (best_tip : Mina_block.Validation.initial_valid_with_header) )
 end
 
 include Make (struct
   module Transition_frontier = Transition_frontier
 end)
+
+module Wrap_for_block = Wrap_for_block

src/lib/best_tip_prover/wrap_for_block.ml

@@ -0,0 +1,21 @@
+let map ~f
+    { Proof_carrying_data.proof = merkle_list, root_unverified
+    ; data = best_tip_unverified
+    } =
+  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
+      }
+  in
+  let root =
+    Mina_block.Validation.with_body root_header
+      (Mina_block.body root_unverified)
+  in
+  let best_tip =
+    Mina_block.Validation.with_body best_tip_header
+      (Mina_block.body best_tip_unverified)
+  in
+  (`Root root, `Best_tip best_tip)

src/lib/block_producer/block_producer.ml

@@ -887,19 +887,20 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover
                 |> Option.value_exn
               in
               [%log internal] "Produce_validated_transition" ;
+              let header =
+                Header.create ~protocol_state ~protocol_state_proof
+                  ~delta_block_chain_proof ()
+              in
+              let body = Body.create staged_ledger_diff in
               let%bind transition =
                 let open Result.Let_syntax in
-                Validation.wrap
-                  { With_hash.hash = protocol_state_hashes
-                  ; data =
-                      (let body = Body.create staged_ledger_diff in
-                       Mina_block.create ~body
-                         ~header:
-                           (Header.create ~protocol_state ~protocol_state_proof
-                              ~delta_block_chain_proof () ) )
-                  }
+                Validation.wrap_header
+                  { With_hash.hash = protocol_state_hashes; data = header }
+                |> Validation.skip_delta_block_chain_validation
+                     `This_block_was_not_received_via_gossip
                 |> Validation.skip_time_received_validation
                      `This_block_was_not_received_via_gossip
+                |> Fn.flip Validation.with_body body
                 |> Validation.skip_protocol_versions_validation
                      `This_block_has_valid_protocol_versions
                 |> validate_genesis_protocol_state_block
@@ -909,8 +910,6 @@ let produce ~genesis_breadcrumb ~context:(module Context : CONTEXT) ~prover
                           previous_protocol_state )
                 >>| Validation.skip_proof_validation
                       `This_block_was_generated_internally
-                >>| Validation.skip_delta_block_chain_validation
-                      `This_block_was_not_received_via_gossip
                 >>= Validation.validate_frontier_dependencies
                       ~to_header:Mina_block.header
                       ~context:(module Consensus_context)
@@ -1452,25 +1451,24 @@ let run_precomputed ~context:(module Context : CONTEXT) ~verifier ~trust_system
           let previous_protocol_state_hash =
             State_hash.With_state_hashes.state_hash previous_transition
           in
+          let header =
+            Header.create ~protocol_state ~protocol_state_proof
+              ~delta_block_chain_proof ()
+          in
+          let body = Body.create staged_ledger_diff in
           let%bind transition =
             let open Result.Let_syntax in
-            Validation.wrap
-              { With_hash.hash = protocol_state_hashes
-              ; data =
-                  (let body = Body.create staged_ledger_diff in
-                   Mina_block.create ~body
-                     ~header:
-                       (Header.create ~protocol_state ~protocol_state_proof
-                          ~delta_block_chain_proof () ) )
-              }
+            Validation.wrap_header
+              { With_hash.hash = protocol_state_hashes; data = header }
+            |> Validation.skip_delta_block_chain_validation
+                 `This_block_was_not_received_via_gossip
             |> Validation.skip_time_received_validation
                  `This_block_was_not_received_via_gossip
+            |> Fn.flip Validation.with_body body
             |> Validation.skip_protocol_versions_validation
                  `This_block_has_valid_protocol_versions
             |> Validation.skip_proof_validation
                  `This_block_was_generated_internally
-            |> Validation.skip_delta_block_chain_validation
-                 `This_block_was_not_received_via_gossip
             |> validate_genesis_protocol_state_block
                  ~genesis_state_hash:
                    (Protocol_state.genesis_state_hash

src/lib/bootstrap_controller/bootstrap_controller.ml

@@ -173,9 +173,11 @@ let on_transition ({ context = (module Context); _ } as t) ~sender
         Deferred.return `Ignored
     | Ok peer_root_with_proof -> (
         match%bind
-          Sync_handler.Root.verify
-            ~context:(module Context)
-            ~verifier:t.verifier candidate_consensus_state
+          Best_tip_prover.Wrap_for_block.map
+            ~f:
+              (Sync_handler.Root.verify
+                 ~context:(module Context)
+                 ~verifier:t.verifier candidate_consensus_state )
             peer_root_with_proof.data
         with
         | Ok (`Root root, `Best_tip best_tip) ->

src/lib/ledger_catchup/normal_catchup.ml

@@ -58,7 +58,9 @@ let validate_block ~genesis_state_hash (b, v) =
   let open Mina_block.Validation in
   let open Result.Let_syntax in
   let h = (With_hash.map ~f:Mina_block.header b, v) in
-  validate_genesis_protocol_state ~genesis_state_hash h
+  Mina_block.Validation.skip_time_received_validation
+    `This_block_was_not_received_via_gossip h
+  |> validate_genesis_protocol_state ~genesis_state_hash
   >>= validate_protocol_versions >>= validate_delta_block_chain
   >>| Fn.flip with_body (Mina_block.body @@ With_hash.data b)
 
@@ -83,10 +85,7 @@ let verify_transition ~context:(module Context : CONTEXT) ~trust_system
   let cached_initially_validated_transition_result =
     let open Result.Let_syntax in
     let%bind initially_validated_transition =
-      transition_with_hash
-      |> Mina_block.Validation.skip_time_received_validation
-           `This_block_was_not_received_via_gossip
-      |> validate_block ~genesis_state_hash
+      validate_block ~genesis_state_hash transition_with_hash
     in
     let enveloped_initially_validated_transition =
       Envelope.Incoming.map enveloped_transition

src/lib/ledger_catchup/super_catchup.ml

@@ -131,7 +131,9 @@ let validate_block ~genesis_state_hash (b, v) =
   let open Mina_block.Validation in
   let open Result.Let_syntax in
   let h = (With_hash.map ~f:Mina_block.header b, v) in
-  validate_genesis_protocol_state ~genesis_state_hash h
+  Mina_block.Validation.skip_time_received_validation
+    `This_block_was_not_received_via_gossip h
+  |> validate_genesis_protocol_state ~genesis_state_hash
   >>= validate_protocol_versions >>= validate_delta_block_chain
   >>| Fn.flip with_body (Mina_block.body @@ With_hash.data b)
 
@@ -155,9 +157,7 @@ let verify_transition ~context:(module Context : CONTEXT) ~trust_system
   let transition_with_hash = Envelope.Incoming.data enveloped_transition in
   let cached_initially_validated_transition_result =
     let%bind.Result initially_validated_transition =
-      Mina_block.Validation.skip_time_received_validation
-        `This_block_was_not_received_via_gossip transition_with_hash
-      |> validate_block ~genesis_state_hash
+      validate_block ~genesis_state_hash transition_with_hash
     in
     let enveloped_initially_validated_transition =
       Envelope.Incoming.map enveloped_transition

src/lib/mina_block/dune

@@ -58,7 +58,8 @@
   random_oracle_input
   ppx_version.runtime
   mina_wire_types
-  internal_tracing)
+  internal_tracing
+  proof_carrying_data)
  (instrumentation
   (backend bisect_ppx))
  (preprocess

src/lib/mina_block/validation.ml

@@ -388,7 +388,7 @@ let validate_delta_block_chain (t, validation) =
 let skip_delta_block_chain_validation `This_block_was_not_received_via_gossip
     (t, validation) =
   let previous_protocol_state_hash =
-    t |> With_hash.data |> Block.header |> Header.protocol_state
+    t |> With_hash.data |> Header.protocol_state
     |> Protocol_state.previous_state_hash
   in
   ( t

src/lib/mina_block/validation.mli

@@ -73,8 +73,15 @@ val skip_time_received_validation :
      , 'd
      , 'e
      , 'f )
-     with_block
-  -> ([ `Time_received ] * unit Truth.true_t, 'a, 'b, 'c, 'd, 'e, 'f) with_block
+     with_header
+  -> ( [ `Time_received ] * unit Truth.true_t
+     , 'a
+     , 'b
+     , 'c
+     , 'd
+     , 'e
+     , 'f )
+     with_header
 
 val validate_genesis_protocol_state :
      genesis_state_hash:State_hash.t
@@ -185,7 +192,7 @@ val skip_delta_block_chain_validation :
      , 'd
      , 'e
      , 'f )
-     with_block
+     with_header
   -> ( 'a
      , 'b
      , 'c
@@ -194,7 +201,7 @@ val skip_delta_block_chain_validation :
      , 'd
      , 'e
      , 'f )
-     with_block
+     with_header
 
 val validate_frontier_dependencies :
      to_header:('a -> Header.t)

src/lib/mina_intf/transition_frontier_components_intf.ml

@@ -179,11 +179,11 @@ module type Best_tip_prover_intf = sig
        verifier:Verifier.t
     -> genesis_constants:Genesis_constants.t
     -> precomputed_values:Precomputed_values.t
-    -> ( Mina_block.t
-       , State_body_hash.t list * Mina_block.t )
+    -> ( Mina_block.Header.t
+       , State_body_hash.t list * Mina_block.Header.t )
        Proof_carrying_data.t
-    -> ( [ `Root of Mina_block.initial_valid_block ]
-       * [ `Best_tip of Mina_block.initial_valid_block ] )
+    -> ( [ `Root of Mina_block.initial_valid_header ]
+       * [ `Best_tip of Mina_block.initial_valid_header ] )
        Deferred.Or_error.t
 end
 
@@ -206,11 +206,11 @@ module type Consensus_best_tip_prover_intf = sig
        context:(module CONTEXT)
     -> verifier:Verifier.t
     -> Consensus.Data.Consensus_state.Value.t State_hash.With_state_hashes.t
-    -> ( Mina_block.t
-       , State_body_hash.t list * Mina_block.t )
+    -> ( Mina_block.Header.t
+       , State_body_hash.t list * Mina_block.Header.t )
        Proof_carrying_data.t
-    -> ( [ `Root of Mina_block.initial_valid_block ]
-       * [ `Best_tip of Mina_block.initial_valid_block ] )
+    -> ( [ `Root of Mina_block.initial_valid_header ]
+       * [ `Best_tip of Mina_block.initial_valid_header ] )
        Deferred.Or_error.t
 end
 

src/lib/sync_handler/sync_handler.ml

@@ -256,7 +256,11 @@ module Make (Inputs : Inputs_intf) :
           (Consensus.Hooks.select
              ~context:(module Context)
              ~existing:
-               (With_hash.map ~f:Mina_block.consensus_state best_tip_transition)
+               (With_hash.map
+                  ~f:
+                    (Fn.compose Mina_state.Protocol_state.consensus_state
+                       Mina_block.Header.protocol_state )
+                  best_tip_transition )
              ~candidate )
           `Keep
       in

src/lib/transition_router/transition_router.ml

@@ -250,8 +250,11 @@ let download_best_tip ~context:(module Context : CONTEXT) ~notify_online
               "Successfully downloaded best tip with $length from $peer" ;
             (* TODO: Use batch verification instead *)
             match%bind
-              Best_tip_prover.verify ~verifier peer_best_tip ~genesis_constants
-                ~precomputed_values
+              Best_tip_prover.Wrap_for_block.map
+                ~f:
+                  (Best_tip_prover.verify ~verifier ~genesis_constants
+                     ~precomputed_values )
+                peer_best_tip
             with
             | Error e ->
                 [%log warn]