Merge remote-tracking branch 'origin/feature/cache-state-body-hashes'…

… into release/1.3.0

src/app/archive/archive_lib/diff.ml

@@ -53,9 +53,10 @@ end]
 
 module Builder = struct
   let breadcrumb_added breadcrumb =
-    let ((block, _) as validated_block) =
+    let validated_block =
       Breadcrumb.validated_transition breadcrumb
     in
+    let block, _ = External_transition.Validated.Stable.V1.of_v2 validated_block in
     let commands = External_transition.Validated.commands validated_block in
     let sender_receipt_chains_from_parent_ledger =
       let senders =

src/app/archive/archive_lib/processor.ml

@@ -1574,7 +1574,7 @@ module Block = struct
       (t : External_transition.Precomputed_block.t) =
     add_parts_if_doesn't_exist conn ~constraint_constants
       ~protocol_state:t.protocol_state ~staged_ledger_diff:t.staged_ledger_diff
-      ~hash:(Protocol_state.hash t.protocol_state)
+      ~hash:(Protocol_state.hashes t.protocol_state).state_hash
 
   let add_from_extensional (module Conn : CONNECTION)
       (block : Extensional.Block.t) =
@@ -2067,8 +2067,8 @@ let add_block_aux ?(retries = 3) ~logger ~add_block ~hash ~delete_older_than
 let add_block_aux_precomputed ~constraint_constants =
   add_block_aux ~add_block:(Block.add_from_precomputed ~constraint_constants)
     ~hash:(fun block ->
-      block.External_transition.Precomputed_block.protocol_state
-      |> Protocol_state.hash )
+      (block.External_transition.Precomputed_block.protocol_state
+      |> Protocol_state.hashes).state_hash )
 
 let add_block_aux_extensional =
   add_block_aux ~add_block:Block.add_from_extensional
@@ -2252,7 +2252,7 @@ let setup_server ~metrics_server_port ~constraint_constants ~logger
                 "Precomputed block $block could not be archived: $error"
                 ~metadata:
                   [ ( "block"
-                    , Protocol_state.hash precomputed_block.protocol_state
+                    , (Protocol_state.hashes precomputed_block.protocol_state).state_hash
                       |> State_hash.to_yojson )
                   ; ("error", `String (Caqti_error.show e)) ]
           | Ok () ->

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

@@ -986,7 +986,7 @@ let setup_daemon logger =
       let trust_system = Trust_system.create trust_dir in
       trace_database_initialization "trust_system" __LOC__ trust_dir ;
       let genesis_state_hash =
-        Precomputed_values.genesis_state_hash precomputed_values
+        (Precomputed_values.genesis_state_hashes precomputed_values).state_hash
       in
       let genesis_ledger_hash =
         Precomputed_values.genesis_ledger precomputed_values
@@ -1010,7 +1010,7 @@ let setup_daemon logger =
           |> Option.to_list |> Public_key.Compressed.Set.of_list )
           ~ledger_depth:precomputed_values.constraint_constants.ledger_depth
           ~genesis_state_hash:
-            (With_hash.hash precomputed_values.protocol_state_with_hash)
+            precomputed_values.protocol_state_with_hashes.hash.state_hash
       in
       trace_database_initialization "epoch ledger" __LOC__ epoch_ledger_location ;
       let%bind peer_list_file_contents_or_empty =

src/app/cli/src/init/transaction_snark_profiler.ml

@@ -121,7 +121,7 @@ let precomputed_values = Precomputed_values.compiled_inputs
 let state_body =
   Mina_state.(
     Lazy.map precomputed_values ~f:(fun values ->
-        values.protocol_state_with_hash.data |> Protocol_state.body))
+        values.protocol_state_with_hashes.data |> Protocol_state.body))
 
 let curr_state_view = Lazy.map state_body ~f:Mina_state.Protocol_state.Body.view
 

src/app/cli/src/tests/coda_worker.ml

@@ -407,7 +407,7 @@ module T = struct
               ~epoch_ledger_location
               ~ledger_depth:constraint_constants.ledger_depth
               ~genesis_state_hash:
-                (With_hash.hash precomputed_values.protocol_state_with_hash)
+                precomputed_values.protocol_state_with_hashes.hash.state_hash
           in
           let gossip_net_params =
             Gossip_net.Libp2p.Config.
@@ -580,7 +580,7 @@ module T = struct
                      External_transition.Validated.parent_hash t
                    in
                    let state_hash =
-                     External_transition.Validated.state_hash t
+                     (External_transition.Validated.state_hashes t).state_hash
                    in
                    let prev_state_hash = State_hash.to_bits prev_state_hash in
                    let state_hash = State_hash.to_bits state_hash in

src/app/cli/src/tests/coda_worker_testnet.ml

@@ -221,8 +221,9 @@ let start_prefix_check logger workers events testnet ~acceptable_delay =
               false
           | [ state_hash ]
             when State_hash.equal state_hash
-                   testnet.Api.precomputed_values.protocol_state_with_hash.hash
-            ->
+                   testnet.Api.precomputed_values.protocol_state_with_hashes
+                     .hash
+                     .state_hash ->
               (* Knowing only the genesis transition doesn't indicate an online
                  chain.
               *)

src/app/cli/src/tests/full_test.ml

@@ -114,7 +114,7 @@ let run_test () : unit Deferred.t =
              (Public_key.compress keypair.public_key))
           ~ledger_depth:constraint_constants.ledger_depth
           ~genesis_state_hash:
-            (With_hash.hash precomputed_values.protocol_state_with_hash)
+            precomputed_values.protocol_state_with_hashes.hash.state_hash
       in
       let client_port = 8123 in
       let libp2p_port = 8002 in

src/lib/best_tip_prover/best_tip_prover.ml

@@ -20,9 +20,7 @@ module Make (Inputs : Inputs_intf) :
 
     type proof_elem = State_body_hash.t
 
-    let to_proof_elem external_transition =
-      external_transition |> External_transition.Validated.protocol_state
-      |> Protocol_state.body |> Protocol_state.Body.hash
+    let to_proof_elem = External_transition.Validated.state_body_hash
 
     let get_previous ~context transition =
       let parent_hash =
@@ -40,8 +38,9 @@ module Make (Inputs : Inputs_intf) :
     type proof_elem = State_body_hash.t
 
     let hash acc body_hash =
-      Protocol_state.hash_abstract ~hash_body:Fn.id
-        { previous_state_hash = acc; body = body_hash }
+      (Protocol_state.hashes_abstract ~hash_body:Fn.id
+         { previous_state_hash = acc; body = body_hash })
+        .state_hash
   end)
 
   let prove ~logger frontier =
@@ -111,10 +110,12 @@ module Make (Inputs : Inputs_intf) :
     let merkle_list_length = List.length merkle_list in
     let max_length = Transition_frontier.global_max_length genesis_constants in
     let genesis_protocol_state =
-      Precomputed_values.genesis_state_with_hash precomputed_values
+      Precomputed_values.genesis_state_with_hashes precomputed_values
     in
-    let genesis_state_hash = With_hash.hash genesis_protocol_state in
-    let root_state_hash = External_transition.state_hash root in
+    let genesis_state_hash =
+      State_hash.With_state_hashes.state_hash genesis_protocol_state
+    in
+    let root_state_hash = (External_transition.state_hashes root).state_hash in
     let root_is_genesis = State_hash.(root_state_hash = genesis_state_hash) in
     let%bind () =
       Deferred.return
@@ -127,16 +128,20 @@ module Make (Inputs : Inputs_intf) :
            (Int.equal max_length merkle_list_length || root_is_genesis))
     in
     let best_tip_with_hash =
-      With_hash.of_data best_tip ~hash_data:External_transition.state_hash
+      With_hash.of_data best_tip ~hash_data:External_transition.state_hashes
     in
     let root_transition_with_hash =
-      With_hash.of_data root ~hash_data:External_transition.state_hash
+      With_hash.of_data root ~hash_data:External_transition.state_hashes
     in
     let%bind (_ : State_hash.t Non_empty_list.t) =
       Deferred.return
         (Result.of_option
-           (Merkle_list_verifier.verify ~init:root_transition_with_hash.hash
-              merkle_list best_tip_with_hash.hash)
+           (Merkle_list_verifier.verify
+              ~init:
+                (State_hash.With_state_hashes.state_hash
+                   root_transition_with_hash)
+              merkle_list
+              (State_hash.With_state_hashes.state_hash best_tip_with_hash))
            ~error:
              (Error.of_string
                 "Peer should have given a valid merkle list proof for their \

src/lib/block_producer/block_producer.ml

@@ -118,8 +118,9 @@ let generate_next_state ~constraint_constants ~previous_protocol_state
     Protocol_state.body previous_protocol_state |> Protocol_state.Body.hash
   in
   let previous_protocol_state_hash =
-    Protocol_state.hash_with_body ~body_hash:previous_protocol_state_body_hash
-      previous_protocol_state
+    (Protocol_state.hashes_with_body
+       ~body_hash:previous_protocol_state_body_hash previous_protocol_state)
+      .state_hash
   in
   let previous_state_view =
     Protocol_state.body previous_protocol_state
@@ -676,9 +677,11 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system
             | Some
                 (protocol_state, internal_transition, pending_coinbase_witness)
               ->
-                let protocol_state_hash = Protocol_state.hash protocol_state in
-                let consensus_state_with_hash =
-                  { With_hash.hash = protocol_state_hash
+                let protocol_state_hashes =
+                  Protocol_state.hashes protocol_state
+                in
+                let consensus_state_with_hashes =
+                  { With_hash.hash = protocol_state_hashes
                   ; data = Protocol_state.consensus_state protocol_state
                   }
                 in
@@ -688,20 +691,20 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system
                          ~existing:
                            (With_hash.map ~f:External_transition.consensus_state
                               previous_transition)
-                         ~candidate:consensus_state_with_hash ~logger)
+                         ~candidate:consensus_state_with_hashes ~logger)
                       ~expect:`Take
                       ~message:
                         "newly generated consensus states should be selected \
                          over their parent" ;
-                    let root_consensus_state_with_hash =
+                    let root_consensus_state_with_hashes =
                       Transition_frontier.root frontier
-                      |> Breadcrumb.consensus_state_with_hash
+                      |> Breadcrumb.consensus_state_with_hashes
                     in
                     [%test_result: [ `Take | `Keep ]]
                       (Consensus.Hooks.select
-                         ~existing:root_consensus_state_with_hash
+                         ~existing:root_consensus_state_with_hashes
                          ~constants:consensus_constants
-                         ~candidate:consensus_state_with_hash ~logger)
+                         ~candidate:consensus_state_with_hashes ~logger)
                       ~expect:`Take
                       ~message:
                         "newly generated consensus states should be selected \
@@ -730,7 +733,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system
                       Internal_transition.staged_ledger_diff internal_transition
                     in
                     let previous_state_hash =
-                      Protocol_state.hash previous_protocol_state
+                      (Protocol_state.hashes previous_protocol_state).state_hash
                     in
                     let delta_transition_chain_proof =
                       Transition_chain_prover.prove
@@ -742,7 +745,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system
                     let%bind transition =
                       let open Result.Let_syntax in
                       External_transition.Validation.wrap
-                        { With_hash.hash = protocol_state_hash
+                        { With_hash.hash = protocol_state_hashes
                         ; data =
                             External_transition.create ~protocol_state
                               ~protocol_state_proof ~staged_ledger_diff
@@ -805,7 +808,9 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system
                       Strict_pipe.Writer.write transition_writer breadcrumb
                     in
                     let metadata =
-                      [ ("state_hash", State_hash.to_yojson protocol_state_hash)
+                      [ ( "state_hash"
+                        , State_hash.to_yojson protocol_state_hashes.state_hash
+                        )
                       ]
                     in
                     [%log debug] ~metadata
@@ -814,7 +819,7 @@ let run ~logger ~vrf_evaluator ~prover ~verifier ~trust_system
                     Deferred.choose
                       [ Deferred.choice
                           (Transition_registry.register transition_registry
-                             protocol_state_hash)
+                             protocol_state_hashes.state_hash)
                           (Fn.const (Ok `Transition_accepted))
                       ; Deferred.choice
                           ( Time.Timeout.create time_controller
@@ -1146,9 +1151,9 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller
       ; staged_ledger_diff
       ; delta_transition_chain_proof
       } =
-    let protocol_state_hash = Protocol_state.hash protocol_state in
-    let consensus_state_with_hash =
-      { With_hash.hash = protocol_state_hash
+    let protocol_state_hashes = Protocol_state.hashes protocol_state in
+    let consensus_state_with_hashes =
+      { With_hash.hash = protocol_state_hashes
       ; data = Protocol_state.consensus_state protocol_state
       }
     in
@@ -1180,32 +1185,32 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller
                  ~existing:
                    (With_hash.map ~f:External_transition.consensus_state
                       previous_transition)
-                 ~candidate:consensus_state_with_hash ~logger)
+                 ~candidate:consensus_state_with_hashes ~logger)
               ~expect:`Take
               ~message:
                 "newly generated consensus states should be selected over \
                  their parent" ;
-            let root_consensus_state_with_hash =
+            let root_consensus_state_with_hashes =
               Transition_frontier.root frontier
-              |> Breadcrumb.consensus_state_with_hash
+              |> Breadcrumb.consensus_state_with_hashes
             in
             [%test_result: [ `Take | `Keep ]]
-              (Consensus.Hooks.select ~existing:root_consensus_state_with_hash
+              (Consensus.Hooks.select ~existing:root_consensus_state_with_hashes
                  ~constants:consensus_constants
-                 ~candidate:consensus_state_with_hash ~logger)
+                 ~candidate:consensus_state_with_hashes ~logger)
               ~expect:`Take
               ~message:
                 "newly generated consensus states should be selected over the \
                  tf root") ;
         let emit_breadcrumb () =
           let open Deferred.Result.Let_syntax in
           let previous_protocol_state_hash =
-            With_hash.hash previous_transition
+            State_hash.With_state_hashes.state_hash previous_transition
           in
           let%bind transition =
             let open Result.Let_syntax in
             External_transition.Validation.wrap
-              { With_hash.hash = protocol_state_hash
+              { With_hash.hash = protocol_state_hashes
               ; data =
                   External_transition.create ~protocol_state
                     ~protocol_state_proof ~staged_ledger_diff
@@ -1253,7 +1258,9 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller
             ~metadata:[ ("breadcrumb", Breadcrumb.to_yojson breadcrumb) ]
             Block_produced ;
           let metadata =
-            [ ("state_hash", State_hash.to_yojson protocol_state_hash) ]
+            [ ( "state_hash"
+              , State_hash.to_yojson protocol_state_hashes.state_hash )
+            ]
           in
           Mina_metrics.(Counter.inc_one Block_producer.blocks_produced) ;
           let%bind.Async.Deferred () =
@@ -1264,7 +1271,7 @@ let run_precomputed ~logger ~verifier ~trust_system ~time_controller
           Deferred.choose
             [ Deferred.choice
                 (Transition_registry.register transition_registry
-                   protocol_state_hash)
+                   protocol_state_hashes.state_hash)
                 (Fn.const (Ok `Transition_accepted))
             ; Deferred.choice
                 ( Time.Timeout.create time_controller (Time.Span.of_ms 20000L)

src/lib/blockchain_snark/blockchain_snark_state.ml

@@ -282,7 +282,8 @@ let check w ?handler ~proof_level ~constraint_constants txn_snark new_state_hash
     (Fn.flip handle (wrap_handler handler w)
        (let%bind prev =
           exists State_hash.typ
-            ~compute:(As_prover.return (Protocol_state.hash w.prev_state))
+            ~compute:
+              (As_prover.return (Protocol_state.hashes w.prev_state).state_hash)
         and curr =
           exists State_hash.typ ~compute:(As_prover.return new_state_hash)
         and txn_snark =
@@ -330,7 +331,7 @@ module Statement = struct
   type t = Protocol_state.Value.t
 
   let to_field_elements (t : t) : Tick.Field.t array =
-    [| Protocol_state.hash t |]
+    [| (Protocol_state.hashes t).state_hash |]
 end
 
 module Statement_var = struct
@@ -340,8 +341,9 @@ module Statement_var = struct
 end
 
 let typ =
-  Typ.transport State_hash.typ ~there:Protocol_state.hash ~back:(fun _ ->
-      failwith "cannot unhash")
+  Typ.transport State_hash.typ
+    ~there:(fun t -> (Protocol_state.hashes t).state_hash)
+    ~back:(fun _ -> failwith "cannot unhash")
 
 type tag =
   (State_hash.var, Protocol_state.value, Nat.N2.n, Nat.N1.n) Pickles.Tag.t