Merge pull request #16586 from MinaProtocol/merge-back-to-develop-202…

…5-02-08

Merge back to develop

README.md

@@ -29,7 +29,7 @@ The Mina implementation of the Rosetta API offers a more stable and useful inter
 - [Mina Protocol](https://docs.minaprotocol.com/) documentation
 - [Installing and using a third-party wallet](https://docs.minaprotocol.com/using-mina/install-a-wallet)
 - [Sending a Payment using Mina's CLI](https://docs.minaprotocol.com/node-operators/sending-a-payment)
-- [Become a Node Operator](https://minaprotocol.com/docs/getting-started/)
+- [Become a Node Operator](https://docs.minaprotocol.com/node-operators/block-producer-node/getting-started)
 
 ### Technical Papers
 

src/app/heap_usage/values.ml

@@ -687,7 +687,7 @@ let staged_ledger_diff =
     }
       |json}
   in
-  Staged_ledger_diff.of_yojson json |> Result.ok_or_failwith
+  Staged_ledger_diff.Stable.Latest.of_yojson json |> Result.ok_or_failwith
 
 let merkle_path
     ~(constraint_constants : Genesis_constants.Constraint_constants.t) =

src/app/rosetta/README.md

@@ -48,7 +48,7 @@ The container includes 3 scripts in `/etc/mina/rosetta/scripts` that run a diffe
   and Rosetta node), but for a demo network with all operations occurring inside
   this container and no external network activity.
 * `docker-start.sh` connects the Mina node to a network (by default,
-  [Mainnet](https://docs.minaprotocol.com/node-operators/connecting-to-the-network))
+  [Mainnet](https://docs.minaprotocol.com/node-operators/block-producer-node/connecting-to-the-network))
   and initializes the archive database from publicly available nightly
   O(1) Labs backups. As with `docker-demo-start.sh`, this script runs a Mina
   node, a Mina archive, a PostgreSQL DB, and Rosetta. The script also
@@ -169,7 +169,7 @@ If the data in PostgreSQL is really stale (>24 hours), it would likely be better
 
 ### Operation Statuses
 
-Operations are always `Pending` if retrieved from the mempool. `Success` if they are in a block and fully applied. A transaction status of `Failed` occurs for transactions within a block whenever certain invariants are not met such as not sending enough to cover the account creation fee. Other reasons include misconfiguring new tokens or zkapps. See [this section of the code](https://github.com/MinaProtocol/mina/blob/03e11970387b05dd970c6ab0d1a0b01f18e3a8db/src/lib/coda_base/user_command_status.ml#L8-L21) for an exhaustive list.
+Operations are always `Pending` if retrieved from the mempool. `Success` if they are in a block and fully applied. A transaction status of `Failed` occurs for transactions within a block whenever certain invariants are not met such as not sending enough to cover the account creation fee. Other reasons include misconfiguring new tokens or zkapps. See [this section of the code](https://github.com/MinaProtocol/mina/blob/03e11970387b05dd970c6ab0d1a0b01f18e3a8db/src/lib/mina_base/transaction_status.ml#L10-L50) for an exhaustive list.
 
 ### Operations Types
 
@@ -218,7 +218,7 @@ To test the Construction API, for every kind of transaction supported in the Min
 
 Finally, we then take the signed transaction submit it to the network and go through the same flow as the Data API checks for this transaction. Ensuring its behavior is the same as if it had gone through the submit path via GraphQL directly.
 
-The signer library used by the test agent can be used as a reference for further signer implementations. An executable interface is also provided via the [`signer.exe` binary](https://github.com/MinaProtocol/mina/blob/src/app/rosetta/ocaml-signer/signer.ml).
+The signer library used by the test agent can be used as a reference for further signer implementations. An executable interface is also provided via the [`signer.exe` binary](https://github.com/MinaProtocol/mina/blob/develop/src/app/rosetta/ocaml-signer/signer.ml).
 
 #### Rosetta CLI Validation
 

src/lib/block_producer/block_producer.ml

@@ -312,8 +312,8 @@ let generate_next_state ~commit_id ~zkapp_cmd_limit ~constraint_constants
                         , `String
                             (Staged_ledger.Staged_ledger_error.to_string e) )
                       ; ( "diff"
-                        , Staged_ledger_diff.With_valid_signatures_and_proofs
-                          .to_yojson diff )
+                        , Staged_ledger_diff.Stable.Latest.to_yojson
+                          @@ Staged_ledger_diff.forget diff )
                       ]
                     "Error applying the diff $diff: $error"
               | Error e ->
@@ -523,7 +523,7 @@ let handle_block_production_errors ~logger ~rejected_blocks_logger
       in
       let metadata =
         [ ("error", Error_json.error_to_yojson e)
-        ; ("diff", Staged_ledger_diff.to_yojson staged_ledger_diff)
+        ; ("diff", Staged_ledger_diff.Stable.Latest.to_yojson staged_ledger_diff)
         ]
       in
       [%log error] ~metadata msg ;

src/lib/bootstrap_controller/bootstrap_controller.ml

@@ -376,7 +376,7 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network
           | Error err ->
               Deferred.return (staged_ledger_data_download_time, None, Error err)
           | Ok
-              ( scan_state
+              ( scan_state_uncached
               , expected_merkle_root
               , pending_coinbases
               , protocol_states ) -> (
@@ -385,7 +385,8 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network
                     let open Deferred.Or_error.Let_syntax in
                     let received_staged_ledger_hash =
                       Staged_ledger_hash.of_aux_ledger_and_coinbase_hash
-                        (Staged_ledger.Scan_state.hash scan_state)
+                        (Staged_ledger.Scan_state.Stable.Latest.hash
+                           scan_state_uncached )
                         expected_merkle_root pending_coinbases
                     in
                     [%log debug]
@@ -416,6 +417,10 @@ let run ~context:(module Context : CONTEXT) ~trust_system ~verifier ~network
                       List.map protocol_states
                         ~f:(With_hash.of_data ~hash_data:Protocol_state.hashes)
                     in
+                    let scan_state =
+                      Staged_ledger.Scan_state.write_all_proofs_to_disk
+                        scan_state_uncached
+                    in
                     let%bind protocol_states =
                       Staged_ledger.Scan_state.check_required_protocol_states
                         scan_state ~protocol_states

src/lib/ledger_catchup/normal_catchup.ml

@@ -1033,12 +1033,12 @@ let%test_module "Ledger_catchup tests" =
         Rose_tree.equal (Rose_tree.of_list_exn target_best_tip_path)
           catchup_breadcrumbs ~f:(fun breadcrumb_tree1 breadcrumb_tree2 ->
             let b1 =
-              Mina_block.Validated.unwrap
+              Mina_block.Validated.read_all_proofs_from_disk
                 (Transition_frontier.Breadcrumb.validated_transition
                    breadcrumb_tree1 )
             in
             let b2 =
-              Mina_block.Validated.unwrap
+              Mina_block.Validated.read_all_proofs_from_disk
                 (Transition_frontier.Breadcrumb.validated_transition
                    breadcrumb_tree2 )
             in

src/lib/ledger_catchup/super_catchup.ml

@@ -1637,7 +1637,10 @@ let%test_module "Ledger_catchup tests" =
             (* We force evaluation of state body hash for both blocks for further equality check *)
             let _hash1 = Mina_block.Validated.state_body_hash b1 in
             let _hash2 = Mina_block.Validated.state_body_hash b2 in
-            Mina_block.Validated.(Stable.Latest.equal (unwrap b1) (unwrap b2)) )
+            Mina_block.Validated.(
+              Stable.Latest.equal
+                (read_all_proofs_from_disk b1)
+                (read_all_proofs_from_disk b2)) )
       in
       if not catchup_breadcrumbs_are_best_tip_path then
         failwith

src/lib/mina_block/block.ml

@@ -4,6 +4,8 @@ open Mina_state
 
 [%%versioned
 module Stable = struct
+  [@@@no_toplevel_latest_type]
+
   module V2 = struct
     type t =
       { header : Header.Stable.V2.t
@@ -40,6 +42,9 @@ module Stable = struct
   end
 end]
 
+type t = Stable.Latest.t =
+  { header : Header.t; body : Staged_ledger_diff.Body.t }
+
 type with_hash = t State_hash.With_state_hashes.t
 
 let to_yojson t =

src/lib/mina_block/internal_transition.ml

@@ -52,7 +52,7 @@ type t = Stable.Latest.t =
   ; prover_state : Consensus.Data.Prover_state.t
   ; staged_ledger_diff : Staged_ledger_diff.t
   }
-[@@deriving sexp, fields, to_yojson]
+[@@deriving fields]
 
 let create ~snark_transition ~ledger_proof ~prover_state ~staged_ledger_diff =
   { Stable.Latest.snark_transition

src/lib/mina_block/precomputed_block.ml

@@ -53,7 +53,7 @@ module T = struct
     { scheduled_time : Block_time.t
     ; protocol_state : Protocol_state.value
     ; protocol_state_proof : Proof.t
-    ; staged_ledger_diff : Staged_ledger_diff.t
+    ; staged_ledger_diff : Staged_ledger_diff.Stable.Latest.t
     ; delta_transition_chain_proof :
         Frozen_ledger_hash.t * Frozen_ledger_hash.t list
     ; protocol_version : Protocol_version.t

src/lib/mina_block/validated_block.ml

@@ -75,4 +75,4 @@ let is_genesis t =
   header t |> Header.protocol_state |> Mina_state.Protocol_state.consensus_state
   |> Consensus.Data.Consensus_state.is_genesis_state
 
-let unwrap = Fn.id
+let read_all_proofs_from_disk = Fn.id

src/lib/mina_block/validated_block.mli

@@ -38,4 +38,4 @@ val body : t -> Staged_ledger_diff.Body.t
 
 val is_genesis : t -> bool
 
-val unwrap : t -> Stable.Latest.t
+val read_all_proofs_from_disk : t -> Stable.Latest.t

src/lib/mina_lmdb_storage/block.ml

@@ -166,10 +166,13 @@ let%test_module "Block storage tests" =
       let id = match id_ with `Ok a -> a | _ -> failwith "unexpected" in
       [%log info] "Push message received" ;
       [%test_eq: String.t] (Consensus.Body_reference.to_raw_string body_ref) id ;
-      [%test_eq:
-        ( Mina_block.Body.t
-        , [ `Invalid_structure of Error.t | `Non_full | `Tx_failed ] )
-        Result.t] (Ok body) (read_body db body_ref)
+      let body' =
+        read_body db body_ref
+        |> function
+        | Ok a -> a | Error _ -> failwith "unexpected failure to read_body"
+      in
+      if not (Mina_block.Body.Stable.Latest.equal body body') then
+        failwith "Retrieved body not equal to original body"
 
     let%test_unit "Write many blocks" =
       let n = 300 in

src/lib/mina_networking/mina_networking.mli

@@ -49,7 +49,7 @@ module Rpcs : sig
     type query = State_hash.t
 
     type response =
-      ( Staged_ledger.Scan_state.t
+      ( Staged_ledger.Scan_state.Stable.Latest.t
       * Ledger_hash.t
       * Pending_coinbase.t
       * Mina_state.Protocol_state.value list )
@@ -219,7 +219,7 @@ val get_staged_ledger_aux_and_pending_coinbases_at_hash :
      t
   -> Peer.Id.t
   -> State_hash.t
-  -> ( Staged_ledger.Scan_state.t
+  -> ( Staged_ledger.Scan_state.Stable.Latest.t
      * Ledger_hash.t
      * Pending_coinbase.t
      * Mina_state.Protocol_state.value list )

src/lib/mina_networking/rpcs.ml

@@ -211,7 +211,7 @@ module Get_staged_ledger_aux_and_pending_coinbases_at_hash = struct
       type query = State_hash.t
 
       type response =
-        ( Staged_ledger.Scan_state.t
+        ( Staged_ledger.Scan_state.Stable.Latest.t
         * Ledger_hash.t
         * Pending_coinbase.t
         * Mina_state.Protocol_state.value list )
@@ -304,8 +304,14 @@ module Get_staged_ledger_aux_and_pending_coinbases_at_hash = struct
             Actions.
               (Requested_unknown_item, Some (receipt_trust_action_message hash)))
         >>| const None
-    | _ ->
-        return result
+    | Some (scan_state, expected_merkle_root, pending_coinbases, protocol_states)
+      ->
+        return
+          (Some
+             ( Staged_ledger.Scan_state.read_all_proofs_from_disk scan_state
+             , expected_merkle_root
+             , pending_coinbases
+             , protocol_states ) )
 
   let rate_limit_budget = (4, `Per Time.Span.minute)
 

src/lib/proof_cache_tag/dune

@@ -1,14 +1,13 @@
 (library
  (public_name proof_cache_tag)
- (virtual_modules proof_cache_tag)
- (default_implementation proof_cache_tag.identity)
  (libraries
    ;; opam libraries
    core_kernel
    async
    ;; local libraries
    mina_base
    logger
+   disk_cache
    )
  (preprocess
   (pps ppx_mina ppx_version))

src/lib/proof_cache_tag/lmdb/proof_cache_tag.ml → src/lib/proof_cache_tag/proof_cache_tag.ml

@@ -8,13 +8,13 @@ type t =
   | Lmdb of { cache_id : Cache.id; cache_db : Cache.t }
   | Identity of Mina_base.Proof.t
 
-let unwrap = function
+let read_proof_from_disk = function
   | Lmdb t ->
       Cache.get t.cache_db t.cache_id
   | Identity proof ->
       proof
 
-let generate db proof =
+let write_proof_to_disk db proof =
   match db with
   | Lmdb_cache cache_db ->
       Lmdb { cache_id = Cache.put cache_db proof; cache_db }
@@ -30,11 +30,11 @@ module For_tests = struct
 
   let blockchain_dummy =
     Lazy.map
-      ~f:(fun dummy -> generate (create_db ()) dummy)
+      ~f:(fun dummy -> write_proof_to_disk (create_db ()) dummy)
       Mina_base.Proof.blockchain_dummy
 
   let transaction_dummy =
     Lazy.map
-      ~f:(fun dummy -> generate (create_db ()) dummy)
+      ~f:(fun dummy -> write_proof_to_disk (create_db ()) dummy)
       Mina_base.Proof.transaction_dummy
 end

src/lib/proof_cache_tag/proof_cache_tag.mli

@@ -10,9 +10,9 @@ val create_db :
   -> logger:Logger.t
   -> (cache_db, [> `Initialization_error of Error.t ]) Deferred.Result.t
 
-val unwrap : t -> Mina_base.Proof.t
+val read_proof_from_disk : t -> Mina_base.Proof.t
 
-val generate : cache_db -> Mina_base.Proof.t -> t
+val write_proof_to_disk : cache_db -> Mina_base.Proof.t -> t
 
 module For_tests : sig
   val blockchain_dummy : t lazy_t

src/lib/staged_ledger/staged_ledger.ml

@@ -421,7 +421,7 @@ module T = struct
       ; pending_coinbase_collection
       } : Staged_ledger_hash.t =
     Staged_ledger_hash.of_aux_ledger_and_coinbase_hash
-      (Scan_state.hash scan_state)
+      Scan_state.(Stable.Latest.hash @@ read_all_proofs_from_disk scan_state)
       (Ledger.merkle_root ledger)
       pending_coinbase_collection
 
@@ -1323,7 +1323,6 @@ module T = struct
         { commands_rev : User_command.Valid.t Sequence.t
         ; completed_work : Transaction_snark_work.Checked.t Sequence.t
         }
-      [@@deriving sexp_of]
 
       let add_user_command t uc =
         { t with
@@ -1353,7 +1352,6 @@ module T = struct
       ; is_coinbase_receiver_new : bool
       ; logger : (Logger.t[@sexp.opaque])
       }
-    [@@deriving sexp_of]
 
     let coinbase_ft (cw : Transaction_snark_work.Checked.t) =
       let fee = Transaction_snark_work.Checked.fee cw in
@@ -3767,11 +3765,9 @@ let%test_module "staged ledger tests" =
                       let work = List.hd_exn (List.drop work_done 1) in
                       assert_same_fee single work.fee )
               | _ ->
-                  failwith
-                    (sprintf
-                       !"Incorrect coinbase in the diff %{sexp: \
-                         Staged_ledger_diff.t}"
-                       diff )
+                  failwith @@ "Incorrect coinbase in the diff "
+                  ^ ( Staged_ledger_diff.Stable.Latest.to_yojson diff
+                    |> Yojson.Safe.to_string )
             in
             (diff, List.tl_exn proofs_available_left) )
       in
@@ -4376,10 +4372,6 @@ let%test_module "staged ledger tests" =
                        .commands diff )
                     = 1 ) ;
                   let f, s = diff.diff in
-                  [%log info] "Diff %s"
-                    ( Staged_ledger_diff.With_valid_signatures_and_proofs
-                      .to_yojson diff
-                    |> Yojson.Safe.to_string ) ;
                   let failed_command =
                     With_status.
                       { data = invalid_command