Wide merkle query

src/lib/mina_ledger/sync_ledger.ml

@@ -54,14 +54,30 @@ module Answer = struct
   module Stable = struct
     [@@@no_toplevel_latest_type]
 
+    module V3 = struct
+      type t =
+        ( Ledger_hash.Stable.V1.t
+        , Account.Stable.V2.t )
+        Syncable_ledger.Answer.Stable.V2.t
+      [@@deriving sexp, to_yojson]
+
+      let to_latest = Fn.id
+    end
+
     module V2 = struct
       type t =
         ( Ledger_hash.Stable.V1.t
         , Account.Stable.V2.t )
         Syncable_ledger.Answer.Stable.V1.t
       [@@deriving sexp, to_yojson]
 
-      let to_latest = Fn.id
+      let to_latest x = Syncable_ledger.Answer.Stable.V1.to_latest Fn.id x
+
+      (* Not a standard versioning function *)
+
+      (** Attempts to downgrade v3 -> v2 *)
+      let from_v3 : V3.t -> t =
+       fun x -> Syncable_ledger.Answer.Stable.V1.from_v2 x
     end
   end]
 
@@ -79,12 +95,31 @@ module Query = struct
   module Stable = struct
     [@@@no_toplevel_latest_type]
 
+    module V2 = struct
+      type t =
+        Ledger.Location.Addr.Stable.V1.t Syncable_ledger.Query.Stable.V2.t
+      [@@deriving sexp, to_yojson, hash, compare]
+
+      let to_latest = Fn.id
+    end
+
     module V1 = struct
       type t =
         Ledger.Location.Addr.Stable.V1.t Syncable_ledger.Query.Stable.V1.t
       [@@deriving sexp, to_yojson, hash, compare]
 
-      let to_latest = Fn.id
+      let to_latest : t -> V2.t = Syncable_ledger.Query.Stable.V1.to_latest
+
+      (* Not a standard versioning function *)
+
+      (** Attempts to downgrade v3 -> v2 *)
+      let from_v2 : V2.t -> t = function
+        | What_child_hashes (a, _) ->
+            What_child_hashes a
+        | What_contents a ->
+            What_contents a
+        | Num_accounts ->
+            Num_accounts
     end
   end]
 

src/lib/mina_networking/rpcs.ml

@@ -366,13 +366,13 @@ module Answer_sync_ledger_query = struct
     include Master
   end)
 
-  module V3 = struct
+  module V4 = struct
     module T = struct
-      type query = Ledger_hash.Stable.V1.t * Sync_ledger.Query.Stable.V1.t
+      type query = Ledger_hash.Stable.V1.t * Sync_ledger.Query.Stable.V2.t
       [@@deriving sexp]
 
       type response =
-        (( Sync_ledger.Answer.Stable.V2.t
+        (( Sync_ledger.Answer.Stable.V3.t
          , Bounded_types.Wrapped_error.Stable.V1.t )
          Result.t
         [@version_asserted] )
@@ -399,6 +399,49 @@ module Answer_sync_ledger_query = struct
     include Register (T')
   end
 
+  module V3 = struct
+    module T = struct
+      type query = Ledger_hash.Stable.V1.t * Sync_ledger.Query.Stable.V1.t
+      [@@deriving sexp]
+
+      type response =
+        (( Sync_ledger.Answer.Stable.V2.t
+         , Bounded_types.Wrapped_error.Stable.V1.t )
+         Result.t
+        [@version_asserted] )
+      [@@deriving sexp]
+
+      let query_of_caller_model : Master.T.query -> query =
+       fun (h, q) -> (h, Sync_ledger.Query.Stable.V1.from_v2 q)
+
+      let callee_model_of_query : query -> Master.T.query =
+       fun (h, q) -> (h, Sync_ledger.Query.Stable.V1.to_latest q)
+
+      let response_of_callee_model : Master.T.response -> response = function
+        | Ok a ->
+            Ok (Sync_ledger.Answer.Stable.V2.from_v3 a)
+        | Error e ->
+            Error e
+
+      let caller_model_of_response : response -> Master.T.response = function
+        | Ok a ->
+            Ok (Sync_ledger.Answer.Stable.V2.to_latest a)
+        | Error e ->
+            Error e
+    end
+
+    module T' =
+      Perf_histograms.Rpc.Plain.Decorate_bin_io
+        (struct
+          include M
+          include Master
+        end)
+        (T)
+
+    include T'
+    include Register (T')
+  end
+
   let receipt_trust_action_message (_, query) =
     ( "Answer_sync_ledger_query: $query"
     , [ ("query", Sync_ledger.Query.to_yojson query) ] )