From 2ad13136b3ed3981ce94e0ba06792b53d81338fd Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <me@rgrinberg.com>
Date: Sun, 13 Sep 2026 12:53:49 +0100
Subject: [PATCH] feat(stdune): add tuple-free record codecs to Conv

Add a typed record builder using curried constructors for decoding and
field projections for encoding. Completed builders remain composable
as field codecs.

Migrate straightforward RPC records, including calls, initialization,
registry entries, locations, diagnostics, messages, jobs, and promotion
requests. Preserve field parsing order and the existing wire formats,
including V1 diagnostic tags, and update structural digest snapshots.

Add legacy-codec comparisons, wire-format snapshots, and round-trip
tests, plus coverage for versions, errors, recursion, empty records,
and records beyond eight fields.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
---
 otherlibs/dune-rpc/diagnostics_v1.ml          |  53 ++--
 otherlibs/dune-rpc/exported_types.ml          | 126 ++++----
 otherlibs/dune-rpc/procedures.ml              |  20 +-
 otherlibs/dune-rpc/registry.ml                |  12 +-
 otherlibs/dune-rpc/types.ml                   |  48 ++-
 otherlibs/stdune/src/conv.ml                  |  46 +++
 otherlibs/stdune/src/conv.mli                 |  44 ++-
 otherlibs/stdune/test/conv_tests.ml           | 218 +++++++++++++
 otherlibs/stdune/test/conv_tests.mli          |   0
 test/expect-tests/dune_rpc/digests.ml         |  26 +-
 test/expect-tests/dune_rpc/dune_rpc_tests.ml  | 290 +++++++++++++++++-
 .../dune_rpc_e2e/dune_rpc_registry_test.ml    |  29 ++
 12 files changed, 759 insertions(+), 153 deletions(-)
 create mode 100644 otherlibs/stdune/test/conv_tests.ml
 create mode 100644 otherlibs/stdune/test/conv_tests.mli

diff --git a/otherlibs/dune-rpc/diagnostics_v1.ml b/otherlibs/dune-rpc/diagnostics_v1.ml
index e947899d245..d069ab78bc6 100644
--- a/otherlibs/dune-rpc/diagnostics_v1.ml
+++ b/otherlibs/dune-rpc/diagnostics_v1.ml
@@ -9,11 +9,12 @@ module Related = struct
 
   let sexp =
     let open Conv in
-    let loc = field "loc" (required Loc.sexp) in
-    let message = field "message" (required sexp_pp_unit) in
-    let to_ (loc, message) = { loc; message } in
-    let from { loc; message } = loc, message in
-    iso (record (both loc message)) to_ from
+    record
+      (Record.make (fun loc message -> { loc; message })
+       |> Record.field "loc" (required Loc.sexp) ~get:(fun { loc; _ } -> loc)
+       |> Record.field "message" (required sexp_pp_unit) ~get:(fun { message; _ } ->
+         message)
+       |> Record.finish)
   ;;
 
   let to_diagnostic_related t : Diagnostic.Related.t =
@@ -45,24 +46,30 @@ let sexp_severity =
 
 let sexp =
   let open Conv in
-  let from { targets; message; loc; severity; promotion; directory; id; related } =
-    targets, message, loc, severity, promotion, directory, id, related
-  in
-  let to_ (targets, message, loc, severity, promotion, directory, id, related) =
-    { targets; message; loc; severity; promotion; directory; id; related }
-  in
-  let loc = field "loc" (optional Loc.sexp) in
-  let message = field "message" (required sexp_pp_unit) in
-  let targets = field "targets" (required (list Target.sexp)) in
-  let severity = field "severity" (optional sexp_severity) in
-  let directory = field "directory" (optional string) in
-  let promotion = field "promotion" (required (list Diagnostic.Promotion.sexp)) in
-  let id = field "id" (required Diagnostic.Id.sexp) in
-  let related = field "related" (required (list Related.sexp)) in
-  iso
-    (record (eight targets message loc severity promotion directory id related))
-    to_
-    from
+  record
+    (Record.make (fun targets message loc severity promotion directory id related ->
+       { targets; message; loc; severity; promotion; directory; id; related })
+     |> Record.field
+          "targets"
+          (required (list Target.sexp))
+          ~get:(fun { targets; _ } -> targets)
+     |> Record.field "message" (required sexp_pp_unit) ~get:(fun { message; _ } ->
+       message)
+     |> Record.field "loc" (optional Loc.sexp) ~get:(fun { loc; _ } -> loc)
+     |> Record.field "severity" (optional sexp_severity) ~get:(fun { severity; _ } ->
+       severity)
+     |> Record.field
+          "promotion"
+          (required (list Diagnostic.Promotion.sexp))
+          ~get:(fun { promotion; _ } -> promotion)
+     |> Record.field "directory" (optional string) ~get:(fun { directory; _ } ->
+       directory)
+     |> Record.field "id" (required Diagnostic.Id.sexp) ~get:(fun { id; _ } -> id)
+     |> Record.field
+          "related"
+          (required (list Related.sexp))
+          ~get:(fun { related; _ } -> related)
+     |> Record.finish)
 ;;
 
 let to_diagnostic t : Diagnostic.t =
diff --git a/otherlibs/dune-rpc/exported_types.ml b/otherlibs/dune-rpc/exported_types.ml
index 097fcd1f76b..67f20666d58 100644
--- a/otherlibs/dune-rpc/exported_types.ml
+++ b/otherlibs/dune-rpc/exported_types.ml
@@ -11,26 +11,27 @@ module Loc = struct
 
   let pos_sexp =
     let open Conv in
-    let to_ (pos_fname, pos_lnum, pos_bol, pos_cnum) =
-      { Lexing.pos_fname; pos_lnum; pos_bol; pos_cnum }
-    in
-    let from { Lexing.pos_fname; pos_lnum; pos_bol; pos_cnum } =
-      pos_fname, pos_lnum, pos_bol, pos_cnum
-    in
-    let pos_fname = field "pos_fname" (required string) in
-    let pos_lnum = field "pos_lnum" (required int) in
-    let pos_bol = field "pos_bol" (required int) in
-    let pos_cnum = field "pos_cnum" (required int) in
-    iso (record (four pos_fname pos_lnum pos_bol pos_cnum)) to_ from
+    record
+      (Record.make (fun pos_fname pos_lnum pos_bol pos_cnum ->
+         { Lexing.pos_fname; pos_lnum; pos_bol; pos_cnum })
+       |> Record.field "pos_fname" (required string) ~get:(fun { Lexing.pos_fname; _ } ->
+         pos_fname)
+       |> Record.field "pos_lnum" (required int) ~get:(fun { Lexing.pos_lnum; _ } ->
+         pos_lnum)
+       |> Record.field "pos_bol" (required int) ~get:(fun { Lexing.pos_bol; _ } ->
+         pos_bol)
+       |> Record.field "pos_cnum" (required int) ~get:(fun { Lexing.pos_cnum; _ } ->
+         pos_cnum)
+       |> Record.finish)
   ;;
 
   let sexp =
     let open Conv in
-    let to_ (start, stop) = { start; stop } in
-    let from { start; stop } = start, stop in
-    let start = field "start" (required pos_sexp) in
-    let stop = field "stop" (required pos_sexp) in
-    iso (record (both start stop)) to_ from
+    record
+      (Record.make (fun start stop -> { start; stop })
+       |> Record.field "start" (required pos_sexp) ~get:start
+       |> Record.field "stop" (required pos_sexp) ~get:stop
+       |> Record.finish)
   ;;
 end
 
@@ -462,11 +463,11 @@ module Diagnostic = struct
 
     let sexp =
       let open Conv in
-      let from { in_build; in_source } = in_build, in_source in
-      let to_ (in_build, in_source) = { in_build; in_source } in
-      let in_build = field "in_build" (required string) in
-      let in_source = field "in_source" (required string) in
-      iso (record (both in_build in_source)) to_ from
+      record
+        (Record.make (fun in_build in_source -> { in_build; in_source })
+         |> Record.field "in_build" (required string) ~get:in_build
+         |> Record.field "in_source" (required string) ~get:in_source
+         |> Record.finish)
     ;;
   end
 
@@ -491,11 +492,14 @@ module Diagnostic = struct
 
     let sexp =
       let open Conv in
-      let loc = field "loc" (required Loc.sexp) in
-      let message = field "message" (required (Pp.sexp User_message.Style.sexp)) in
-      let to_ (loc, message) = { loc; message } in
-      let from { loc; message } = loc, message in
-      iso (record (both loc message)) to_ from
+      record
+        (Record.make (fun loc message -> { loc; message })
+         |> Record.field "loc" (required Loc.sexp) ~get:loc
+         |> Record.field
+              "message"
+              (required (Pp.sexp User_message.Style.sexp))
+              ~get:message_with_style
+         |> Record.finish)
     ;;
   end
 
@@ -532,24 +536,21 @@ module Diagnostic = struct
 
   let sexp =
     let open Conv in
-    let from { targets; message; loc; severity; promotion; directory; id; related } =
-      targets, message, loc, severity, promotion, directory, id, related
-    in
-    let to_ (targets, message, loc, severity, promotion, directory, id, related) =
-      { targets; message; loc; severity; promotion; directory; id; related }
-    in
-    let loc = field "loc" (optional Loc.sexp) in
-    let message = field "message" (required (Pp.sexp User_message.Style.sexp)) in
-    let targets = field "targets" (required (list Target.sexp)) in
-    let severity = field "severity" (optional sexp_severity) in
-    let directory = field "directory" (optional string) in
-    let promotion = field "promotion" (required (list Promotion.sexp)) in
-    let id = field "id" (required Id.sexp) in
-    let related = field "related" (required (list Related.sexp)) in
-    iso
-      (record (eight targets message loc severity promotion directory id related))
-      to_
-      from
+    record
+      (Record.make (fun targets message loc severity promotion directory id related ->
+         { targets; message; loc; severity; promotion; directory; id; related })
+       |> Record.field "targets" (required (list Target.sexp)) ~get:targets
+       |> Record.field
+            "message"
+            (required (Pp.sexp User_message.Style.sexp))
+            ~get:message_with_style
+       |> Record.field "loc" (optional Loc.sexp) ~get:loc
+       |> Record.field "severity" (optional sexp_severity) ~get:severity
+       |> Record.field "promotion" (required (list Promotion.sexp)) ~get:promotion
+       |> Record.field "directory" (optional string) ~get:directory
+       |> Record.field "id" (required Id.sexp) ~get:id
+       |> Record.field "related" (required (list Related.sexp)) ~get:related
+       |> Record.finish)
   ;;
 
   let to_dyn t = Sexp.to_dyn (Conv.to_sexp sexp t)
@@ -634,11 +635,11 @@ module Message = struct
 
   let sexp =
     let open Conv in
-    let from { payload; message } = payload, message in
-    let to_ (payload, message) = { payload; message } in
-    let payload = field "payload" (optional sexp) in
-    let message = field "message" (required string) in
-    iso (record (both payload message)) to_ from
+    record
+      (Record.make (fun payload message -> { payload; message })
+       |> Record.field "payload" (optional sexp) ~get:payload
+       |> Record.field "message" (required string) ~get:message
+       |> Record.finish)
   ;;
 
   let to_sexp_unversioned = Conv.to_sexp sexp
@@ -661,13 +662,14 @@ module Job = struct
 
   let sexp =
     let open Conv in
-    let from { id; pid; description; started_at } = id, pid, description, started_at in
-    let to_ (id, pid, description, started_at) = { id; pid; description; started_at } in
-    let id = field "id" (required Id.sexp) in
-    let started_at = field "started_at" (required float) in
-    let pid = field "pid" (required int) in
-    let description = field "description" (required sexp_pp_unit) in
-    iso (record (four id pid description started_at)) to_ from
+    record
+      (Record.make (fun id pid description started_at ->
+         { id; pid; description; started_at })
+       |> Record.field "id" (required Id.sexp) ~get:id
+       |> Record.field "pid" (required int) ~get:pid
+       |> Record.field "description" (required sexp_pp_unit) ~get:description
+       |> Record.field "started_at" (required float) ~get:started_at
+       |> Record.finish)
   ;;
 
   module Event = struct
@@ -842,10 +844,12 @@ module Promote_targets = struct
 
   let sexp =
     let open Conv in
-    let files = field "files" (required Files_to_promote.sexp) in
-    let matching = field "matching" (required Matching.sexp) in
-    let to_ (files, matching) = { files; matching } in
-    let from { files; matching } = files, matching in
-    iso (record (both files matching)) to_ from
+    record
+      (Record.make (fun files matching -> { files; matching })
+       |> Record.field "files" (required Files_to_promote.sexp) ~get:(fun { files; _ } ->
+         files)
+       |> Record.field "matching" (required Matching.sexp) ~get:(fun { matching; _ } ->
+         matching)
+       |> Record.finish)
   ;;
 end
diff --git a/otherlibs/dune-rpc/procedures.ml b/otherlibs/dune-rpc/procedures.ml
index 3cd7bc9b44c..82174fb50be 100644
--- a/otherlibs/dune-rpc/procedures.ml
+++ b/otherlibs/dune-rpc/procedures.ml
@@ -87,11 +87,14 @@ module Public = struct
     module V1 = struct
       let req =
         let open Conv in
-        let path = field "path" (required string) in
-        let contents = field "contents" (required string) in
-        let to_ (path, contents) = path, `Contents contents in
-        let from (path, `Contents contents) = path, contents in
-        iso (record (both path contents)) to_ from
+        record
+          (Record.make (fun path contents -> path, `Contents contents)
+           |> Record.field "path" (required string) ~get:fst
+           |> Record.field
+                "contents"
+                (required string)
+                ~get:(fun (_, `Contents contents) -> contents)
+           |> Record.finish)
       ;;
     end
 
@@ -179,9 +182,10 @@ module Public = struct
 
       let conv =
         let open Conv in
-        let to_ root = { root } in
-        let from { root } = root in
-        iso (record (field "root" (required string))) to_ from
+        record
+          (Record.make (fun root -> { root })
+           |> Record.field "root" (required string) ~get:(fun { root } -> root)
+           |> Record.finish)
       ;;
     end
 
diff --git a/otherlibs/dune-rpc/registry.ml b/otherlibs/dune-rpc/registry.ml
index f61ede96c78..826a23079bf 100644
--- a/otherlibs/dune-rpc/registry.ml
+++ b/otherlibs/dune-rpc/registry.ml
@@ -47,12 +47,12 @@ module Dune = struct
 
   let sexp : t Conv.value =
     let open Conv in
-    let to_ (where, root, pid) = { where; root; pid } in
-    let from { where; root; pid } = where, root, pid in
-    let where = field "where" (required Where.sexp) in
-    let root = field "root" (required string) in
-    let pid = field "pid" (required Pid.conv) in
-    iso (record (three where root pid)) to_ from
+    record
+      (Record.make (fun where root pid -> { where; root; pid })
+       |> Record.field "where" (required Where.sexp) ~get:where
+       |> Record.field "root" (required string) ~get:root
+       |> Record.field "pid" (required Pid.conv) ~get:(fun { pid; _ } -> pid)
+       |> Record.finish)
   ;;
 
   type error =
diff --git a/otherlibs/dune-rpc/types.ml b/otherlibs/dune-rpc/types.ml
index da204916cc3..8202e0dec89 100644
--- a/otherlibs/dune-rpc/types.ml
+++ b/otherlibs/dune-rpc/types.ml
@@ -75,11 +75,11 @@ module Call = struct
 
   let fields =
     let open Conv in
-    let to_ (method_, params) = { method_; params } in
-    let from { method_; params } = method_, params in
-    let method_ = field "method" (required Method.Name.sexp) in
-    let params = field "params" (required sexp) in
-    iso (both method_ params) to_ from
+    Record.make (fun method_ params -> { method_; params })
+    |> Record.field "method" (required Method.Name.sexp) ~get:(fun { method_; _ } ->
+      method_)
+    |> Record.field "params" (required sexp) ~get:(fun { params; _ } -> params)
+    |> Record.finish
   ;;
 end
 
@@ -131,19 +131,16 @@ module Response = struct
 
     let sexp =
       let open Conv in
-      let id = field "payload" (optional sexp) in
-      let message = field "message" (required string) in
-      let kind =
-        field
-          "kind"
-          (required
-             (enum [ "Invalid_request", Invalid_request; "Code_error", Code_error ]))
-      in
       record
-        (iso
-           (three id message kind)
-           (fun (payload, message, kind) -> { payload; message; kind })
-           (fun { payload; message; kind } -> payload, message, kind))
+        (Record.make (fun payload message kind -> { payload; message; kind })
+         |> Record.field "payload" (optional sexp) ~get:payload
+         |> Record.field "message" (required string) ~get:message
+         |> Record.field
+              "kind"
+              (required
+                 (enum [ "Invalid_request", Invalid_request; "Code_error", Code_error ]))
+              ~get:kind
+         |> Record.finish)
     ;;
 
     let to_dyn { payload; message; kind } =
@@ -214,16 +211,13 @@ module Initialize = struct
 
     let sexp =
       let open Conv in
-      let dune_version = field "dune_version" (required Version.sexp) in
-      let protocol_version = field "protocol_version" (required Protocol.sexp) in
-      let id = Id.required_field in
-      let to_ (dune_version, protocol_version, id) =
-        { dune_version; protocol_version; id }
-      in
-      let from { dune_version; protocol_version; id } =
-        dune_version, protocol_version, id
-      in
-      record (iso (three dune_version protocol_version id) to_ from)
+      record
+        (Record.make (fun dune_version protocol_version id ->
+           { dune_version; protocol_version; id })
+         |> Record.field "dune_version" (required Version.sexp) ~get:dune_version
+         |> Record.field "protocol_version" (required Protocol.sexp) ~get:protocol_version
+         |> Record.add Id.required_field ~get:id
+         |> Record.finish)
     ;;
 
     let of_call { Call.method_; params } ~version =
diff --git a/otherlibs/stdune/src/conv.ml b/otherlibs/stdune/src/conv.ml
index 89e0c13f7b1..6970e993be1 100644
--- a/otherlibs/stdune/src/conv.ml
+++ b/otherlibs/stdune/src/conv.ml
@@ -146,6 +146,13 @@ type ('a, 'kind) t =
       * ('b, fields) t
       -> (('a, 'b) Either.t, fields) t
   | Record : ('a, fields) t -> ('a, values) t
+  | Record_fields : ('a, 'a) record_builder -> ('a, fields) t
+
+and ('record, 'remaining) record_builder =
+  | Make : 'constructor -> ('record, 'constructor) record_builder
+  | Add :
+      ('record, 'a -> 'remaining) record_builder * ('a, fields) t * ('record -> 'a)
+      -> ('record, 'remaining) record_builder
 
 and ('a, 'arg) constr =
   { (* TODO allow constructors without an argument *)
@@ -251,6 +258,15 @@ let sexp_for_digest t =
          | None -> List [ Atom "Fixpoint"; iter (id :: ids) (Fdecl.get fdecl) ])
       | Either (a, b) -> List [ Atom "Either"; iter ids a; iter ids b ]
       | Record t -> List [ Atom "Record"; iter ids t ]
+      | Record_fields builder ->
+        List (Atom "Record_fields" :: record_fields ids builder [])
+  and record_fields
+    : type r f. int list -> (r, f) record_builder -> Sexp.t list -> Sexp.t list
+    =
+    fun ids builder acc ->
+    match builder with
+    | Make _ -> acc
+    | Add (builder, fields, _) -> record_fields ids builder (iter ids fields :: acc)
   in
   iter [] t
 ;;
@@ -278,6 +294,7 @@ let to_sexp : 'a. ('a, values) t -> 'a -> Sexp.t =
     | Record r ->
       let fields = loop r a in
       Fields.to_sexp fields
+    | Record_fields builder -> record_fields builder a
     | Field (name, spec) ->
       (match spec with
        | Required t -> Fields.of_field name (loop t a)
@@ -310,6 +327,14 @@ let to_sexp : 'a. ('a, values) t -> 'a -> Sexp.t =
          Code_error.raise
            "enum does not include this value"
            [ "valid values", list (fun (x, _) -> string x) choices ])
+  and record_fields : type r f. (r, f) record_builder -> r -> Fields.t =
+    fun builder value ->
+    match builder with
+    | Make _ -> Fields.empty
+    | Add (builder, fields, get) ->
+      let previous = record_fields builder value in
+      let fields = loop fields (get value) in
+      Fields.merge previous fields
   in
   loop t a
 ;;
@@ -390,6 +415,9 @@ let of_sexp : 'a. ('a, values) t -> version:int * int -> Sexp.t -> 'a =
       let a, Fields f = loop r fields in
       Fields.check_empty f;
       a, Values
+    | Record_fields builder ->
+      let value, rest = record_fields builder ctx in
+      value, Fields rest
     | Field (name, spec) ->
       (match spec with
        | Required v ->
@@ -449,6 +477,14 @@ let of_sexp : 'a. ('a, values) t -> version:int * int -> Sexp.t -> 'a =
          (match List.assoc choices a with
           | None -> raise_of_sexp "unable to read enum"
           | Some s -> s, Values))
+  and record_fields : type r f. (r, f) record_builder -> Fields.t -> f * Fields.t =
+    fun builder ctx ->
+    match builder with
+    | Make constructor -> constructor, ctx
+    | Add (builder, fields, _) ->
+      let constructor, rest = record_fields builder ctx in
+      let value, Fields rest = loop fields rest in
+      constructor value, rest
   in
   discard_values (loop t sexp)
 ;;
@@ -509,6 +545,16 @@ let eight a b c d e f g h =
 let sexp = Sexp
 let required x = Required x
 let optional x = Optional x
+
+module Record = struct
+  type ('record, 'remaining) builder = ('record, 'remaining) record_builder
+
+  let make constructor = Make constructor
+  let add fields ~get builder = Add (builder, fields, get)
+  let field name spec ~get builder = add (field name spec) ~get builder
+  let finish builder = Record_fields builder
+end
+
 let fdecl_id = ref 0
 
 let fixpoint f =
diff --git a/otherlibs/stdune/src/conv.mli b/otherlibs/stdune/src/conv.mli
index baf4277836a..072268e9f75 100644
--- a/otherlibs/stdune/src/conv.mli
+++ b/otherlibs/stdune/src/conv.mli
@@ -24,11 +24,8 @@ val enum : (string * 'a) list -> ('a, values) t
 
 (** [iso t to_ from] creates a parser for a type ['b] out of a parser for a
     type ['a], where ['a] and ['b] are isomorphic to one another. The functions
-    [to_] and [from] convert between the two types ['a] and ['b]. A typical
-    approach for parsing record types is to convert them to/from tuples (via the
-    [three], [four], etc. combinators) which can be parsed with [record], and
-    then use [iso] to convert the parser for a tuple type into a parser for the
-    original record type. *)
+    [to_] and [from] convert between the two types ['a] and ['b]. For record
+    types, [Record] avoids the need to convert to and from tuples. *)
 val iso : ('a, 'k) t -> ('a -> 'b) -> ('b -> 'a) -> ('b, 'k) t
 
 val iso_result : ('a, 'k) t -> ('a -> ('b, exn) result) -> ('b -> 'a) -> ('b, 'k) t
@@ -93,6 +90,43 @@ val eight
 val record : ('a, fields) t -> ('a, values) t
 val either : ('a, fields) t -> ('b, fields) t -> (('a, 'b) Either.t, fields) t
 
+(** Record construction for decoding, paired with field projections for encoding.
+    The constructor and projections must agree, as with the two directions of
+    [iso]. For example:
+    {[
+      record
+        (Record.make (fun name age -> { name; age })
+         |> Record.field "name" (required string) ~get:(fun t -> t.name)
+         |> Record.field "age" (optional int) ~get:(fun t -> t.age)
+         |> Record.finish)
+    ]} *)
+module Record : sig
+  type ('record, 'remaining) builder
+
+  val make : 'constructor -> ('record, 'constructor) builder
+
+  (** Consume one constructor argument, using [get] to recover it when encoding.
+      Fields are decoded in the order they are added. Field names must not
+      overlap with previously added fields. *)
+  val add
+    :  ('a, fields) t
+    -> get:('record -> 'a)
+    -> ('record, 'a -> 'remaining) builder
+    -> ('record, 'remaining) builder
+
+  (** [field name spec] is [add (field name spec)]. *)
+  val field
+    :  string
+    -> 'a field
+    -> get:('record -> 'a)
+    -> ('record, 'a -> 'remaining) builder
+    -> ('record, 'remaining) builder
+
+  (** Finish once all constructor arguments have been supplied. The resulting
+      fields may be composed with other fields, or wrapped with [record]. *)
+  val finish : ('record, 'record) builder -> ('record, fields) t
+end
+
 (** {2 parsing sums} *)
 
 type ('a, 'arg) constr
diff --git a/otherlibs/stdune/test/conv_tests.ml b/otherlibs/stdune/test/conv_tests.ml
new file mode 100644
index 00000000000..ea7a58df2c6
--- /dev/null
+++ b/otherlibs/stdune/test/conv_tests.ml
@@ -0,0 +1,218 @@
+open Stdune
+
+module Sample = struct
+  type t =
+    { name : string
+    ; age : int option
+    ; tags : string list
+    }
+
+  let tags =
+    let open Conv in
+    version (field "tags" (required (list string))) ~since:(2, 0) ~until:(3, 0)
+  ;;
+
+  let legacy =
+    let open Conv in
+    iso
+      (record (three (field "name" (required string)) (field "age" (optional int)) tags))
+      (fun (name, age, tags) -> { name; age; tags })
+      (fun { name; age; tags } -> name, age, tags)
+  ;;
+
+  let fields =
+    let open Conv in
+    Record.make (fun name age tags -> { name; age; tags })
+    |> Record.field "name" (required string) ~get:(fun { name; _ } -> name)
+    |> Record.field "age" (optional int) ~get:(fun { age; _ } -> age)
+    |> Record.add tags ~get:(fun { tags; _ } -> tags)
+    |> Record.finish
+  ;;
+
+  let conv = Conv.record fields
+end
+
+let%expect_test "record builder preserves encoding and decoding" =
+  let values =
+    [ { Sample.name = ""; age = None; tags = [] }
+    ; { Sample.name = "a name"; age = Some 42; tags = [ "first"; "second" ] }
+    ]
+  in
+  List.iter values ~f:(fun value ->
+    let legacy = Conv.to_sexp Sample.legacy value in
+    let current = Conv.to_sexp Sample.conv value in
+    print_endline (Sexp.to_string current);
+    Printf.printf
+      "same encoding: %b; old -> new: %b; new -> old: %b\n"
+      (Sexp.equal legacy current)
+      (Poly.equal (Conv.of_sexp Sample.conv ~version:(2, 0) legacy) (Ok value))
+      (Poly.equal (Conv.of_sexp Sample.legacy ~version:(2, 0) current) (Ok value)));
+  [%expect
+    {|
+    ((name "") (tags ()))
+    same encoding: true; old -> new: true; new -> old: true
+    ((age 42) (name "a name") (tags (first second)))
+    same encoding: true; old -> new: true; new -> old: true |}]
+;;
+
+let%expect_test "record builder preserves errors, field order and versions" =
+  let field name value = Sexp.List [ Atom name; value ] in
+  let name = field "name" (Atom "sample") in
+  let age = field "age" (Atom "42") in
+  let tags = field "tags" (List []) in
+  let inputs : Sexp.t list =
+    [ List [ name; age; tags ]
+    ; List [ tags; age; name ]
+    ; List [ name; tags ]
+    ; List [ name; tags; field "extra" (Atom "unexpected") ]
+    ; List [ name; name; tags ]
+    ; List [ tags ]
+    ; List [ name ]
+    ; List [ name; field "age" (Atom "invalid"); tags ]
+    ; List [ name; age; field "tags" (Atom "invalid") ]
+    ; List [ name; field "age" (Atom "invalid"); field "tags" (Atom "invalid") ]
+    ; List [ field "name" (List []); tags ]
+    ; List [ List [ Atom "name" ]; tags ]
+    ; List []
+    ; Atom "not a record"
+    ]
+  in
+  List.iter
+    [ 1, 9; 2, 0; 2, 1; 3, 0; 3, 1 ]
+    ~f:(fun version ->
+      let agrees =
+        List.for_all inputs ~f:(fun sexp ->
+          Poly.equal
+            (Conv.of_sexp Sample.legacy ~version sexp)
+            (Conv.of_sexp Sample.conv ~version sexp))
+      in
+      let major, minor = version in
+      Printf.printf
+        "%d.%d: all %d results agree: %b\n"
+        major
+        minor
+        (List.length inputs)
+        agrees);
+  [%expect
+    {|
+    1.9: all 14 results agree: true
+    2.0: all 14 results agree: true
+    2.1: all 14 results agree: true
+    3.0: all 14 results agree: true
+    3.1: all 14 results agree: true |}]
+;;
+
+let%expect_test "record builder composes flattened field groups" =
+  let fields =
+    let open Conv in
+    Record.make (fun sample id -> sample, id)
+    |> Record.add Sample.fields ~get:fst
+    |> Record.field "id" (required int) ~get:snd
+    |> Record.finish
+  in
+  let value = { Sample.name = "sample"; age = None; tags = [] }, 7 in
+  let conv = Conv.record fields in
+  let sexp = Conv.to_sexp conv value in
+  print_endline (Sexp.to_string sexp);
+  Printf.printf
+    "round trip: %b\n"
+    (Poly.equal (Conv.of_sexp conv ~version:(2, 0) sexp) (Ok value));
+  [%expect
+    {|
+    ((id 7) (name sample) (tags ()))
+    round trip: true |}]
+;;
+
+let%expect_test "empty record builder" =
+  let conv = Conv.(record (Record.finish (Record.make ()))) in
+  Conv.to_sexp conv () |> Sexp.to_string |> print_endline;
+  Printf.printf
+    "empty record: %b; extra fields rejected: %b\n"
+    (Poly.equal (Conv.of_sexp conv ~version:(1, 0) (List [])) (Ok ()))
+    (Result.is_error
+       (Conv.of_sexp conv ~version:(1, 0) (Sexp.record [ "extra", Atom "value" ])));
+  [%expect
+    {|
+    ()
+    empty record: true; extra fields rejected: true |}]
+;;
+
+module Large = struct
+  type t =
+    { a : int
+    ; b : int
+    ; c : int
+    ; d : int
+    ; e : int
+    ; f : int
+    ; g : int
+    ; h : int
+    ; i : int
+    }
+
+  let conv =
+    let open Conv in
+    record
+      (Record.make (fun a b c d e f g h i -> { a; b; c; d; e; f; g; h; i })
+       |> Record.field "a" (required int) ~get:(fun { a; _ } -> a)
+       |> Record.field "b" (required int) ~get:(fun { b; _ } -> b)
+       |> Record.field "c" (required int) ~get:(fun { c; _ } -> c)
+       |> Record.field "d" (required int) ~get:(fun { d; _ } -> d)
+       |> Record.field "e" (required int) ~get:(fun { e; _ } -> e)
+       |> Record.field "f" (required int) ~get:(fun { f; _ } -> f)
+       |> Record.field "g" (required int) ~get:(fun { g; _ } -> g)
+       |> Record.field "h" (required int) ~get:(fun { h; _ } -> h)
+       |> Record.field "i" (required int) ~get:(fun { i; _ } -> i)
+       |> Record.finish)
+  ;;
+end
+
+let%expect_test "record builder is not limited to eight fields" =
+  let value = { Large.a = 1; b = 2; c = 3; d = 4; e = 5; f = 6; g = 7; h = 8; i = 9 } in
+  let sexp = Conv.to_sexp Large.conv value in
+  print_endline (Sexp.to_string sexp);
+  Printf.printf
+    "round trip: %b\n"
+    (Poly.equal (Conv.of_sexp Large.conv ~version:(1, 0) sexp) (Ok value));
+  [%expect
+    {|
+    ((a 1) (b 2) (c 3) (d 4) (e 5) (f 6) (g 7) (h 8) (i 9))
+    round trip: true |}]
+;;
+
+module Tree = struct
+  type t =
+    { label : string
+    ; children : t list
+    }
+
+  let conv () =
+    Conv.fixpoint (fun tree ->
+      let open Conv in
+      record
+        (Record.make (fun label children -> { label; children })
+         |> Record.field "label" (required string) ~get:(fun { label; _ } -> label)
+         |> Record.field
+              "children"
+              (required (list tree))
+              ~get:(fun { children; _ } -> children)
+         |> Record.finish))
+  ;;
+end
+
+let%expect_test "recursive record builder and digest" =
+  let conv = Tree.conv () in
+  let value = { Tree.label = "root"; children = [ { label = "leaf"; children = [] } ] } in
+  let sexp = Conv.to_sexp conv value in
+  print_endline (Sexp.to_string sexp);
+  Printf.printf
+    "round trip: %b; independently constructed digests agree: %b\n"
+    (Poly.equal (Conv.of_sexp conv ~version:(1, 0) sexp) (Ok value))
+    (Sexp.equal (Conv.sexp_for_digest conv) (Conv.sexp_for_digest (Tree.conv ())));
+  Conv.sexp_for_digest conv |> Sexp.to_string |> print_endline;
+  [%expect
+    {|
+    ((children (((children ()) (label leaf)))) (label root))
+    round trip: true; independently constructed digests agree: true
+    (Fixpoint (Record (Record_fields (Field label (Required String)) (Field children (Required (List (Recurse 0))))))) |}]
+;;
diff --git a/otherlibs/stdune/test/conv_tests.mli b/otherlibs/stdune/test/conv_tests.mli
new file mode 100644
index 00000000000..e69de29bb2d
diff --git a/test/expect-tests/dune_rpc/digests.ml b/test/expect-tests/dune_rpc/digests.ml
index 55933bbb111..f798d74703d 100644
--- a/test/expect-tests/dune_rpc/digests.ml
+++ b/test/expect-tests/dune_rpc/digests.ml
@@ -101,10 +101,10 @@ let%expect_test "print digests for all declared RPCs" =
     diagnostics
       Version 1:
         Request: Unit
-        Response: ffd3de9652c685594aacfc51d28f2533
+        Response: 310b6c3a69cc19c0eca499630848ac3e
       Version 2:
         Request: Unit
-        Response: 0d4442e0c36d6727a9acf9aabce6a6ad
+        Response: 389288a99e13b445dea30465c28c748b
     shutdown
       Version 1:
         Payload: Unit
@@ -118,7 +118,7 @@ let%expect_test "print digests for all declared RPCs" =
         Response: 14894520de5f9b49826c37876bedfaad
     format-dune-file
       Version 1:
-        Request: 15eae4b546faf05a0fc3b6d03aed0c63
+        Request: 07e42be6c22c1562e5c71693ecca2cee
         Response: String
     promote
       Version 1:
@@ -127,10 +127,10 @@ let%expect_test "print digests for all declared RPCs" =
     promote_many
       Version 1:
         Request: (Iso (List String))
-        Response: 9b023f3c0fa25b79499054bca94d5498
+        Response: 0e3f2f6008422025e109eea164914c9b
       Version 2:
-        Request: 083acd32b67fa4dfd9b625241d1d91d0
-        Response: 9b023f3c0fa25b79499054bca94d5498
+        Request: d45d16a280aee5f61d5045595dfae97d
+        Response: 0e3f2f6008422025e109eea164914c9b
     build_dir
       Version 1:
         Request: Unit
@@ -138,32 +138,32 @@ let%expect_test "print digests for all declared RPCs" =
     runtest
       Version 1:
         Request: (List String)
-        Response: 9b023f3c0fa25b79499054bca94d5498
+        Response: 0e3f2f6008422025e109eea164914c9b
     dap/initialize
       Version 1:
         Request: String
-        Response: 0762ced460c7fc004b73a87b2eaf4664
+        Response: 59e9b8fc460bc46600782f11ff800103
     dap/build-deps
       Version 1:
         Request: 042dc00d68ff9ee66979e82fefde258a
         Response: (Sum (None Unit) (Some String))
     notify/abort
       Version 1:
-        Payload: 0e9dfd1099101769896cf0bb06f891c6
+        Payload: 3c23fff9a001cfddf6d82eecd81d845f
     notify/log
       Version 1:
-        Payload: 0e9dfd1099101769896cf0bb06f891c6
+        Payload: 3c23fff9a001cfddf6d82eecd81d845f
     poll/running-jobs
       Version 1:
         Request: Sexp
-        Response: 33528f248084297d123a6ebd4c3ddee0
+        Response: 1faa7cea90ac2e24ad1dac47ab7360c4
     poll/diagnostic
       Version 1:
         Request: Sexp
-        Response: 443627a52ab5595206164d020ff01c56
+        Response: 8cb1e41f5131e4c1f0833a9335c303f8
       Version 2:
         Request: Sexp
-        Response: 12995aa06697c01ef35c0339bd2fa29e
+        Response: 1d96678d29ab01ca8adf929be6d5a077
     poll/progress
       Version 1:
         Request: Sexp
diff --git a/test/expect-tests/dune_rpc/dune_rpc_tests.ml b/test/expect-tests/dune_rpc/dune_rpc_tests.ml
index 31d3f51bb97..2b48a3fcded 100644
--- a/test/expect-tests/dune_rpc/dune_rpc_tests.ml
+++ b/test/expect-tests/dune_rpc/dune_rpc_tests.ml
@@ -181,16 +181,12 @@ module Add = struct
   let v2 =
     let req =
       let open Conv in
-      let parse =
-        record
-          (three
-             (field "x" (required int))
-             (field "y" (required int))
-             (field "others" (required (list int))))
-      in
-      let to_ (x, y, others) = { x; y; others } in
-      let from { x; y; others } = x, y, others in
-      iso parse to_ from
+      record
+        (Record.make (fun x y others -> { x; y; others })
+         |> Record.field "x" (required int) ~get:(fun { x; _ } -> x)
+         |> Record.field "y" (required int) ~get:(fun { y; _ } -> y)
+         |> Record.field "others" (required (list int)) ~get:(fun { others; _ } -> others)
+         |> Record.finish)
     in
     let resp =
       let open Conv in
@@ -337,3 +333,277 @@ let%expect_test "server to client request" =
     client: received response 20
     server: finished. |}]
 ;;
+
+let check_wire_compatibility legacy current values =
+  let encode = Conv.to_sexp in
+  let decode conv sexp =
+    Conv.of_sexp conv ~version:(3, 0) sexp |> Result.map ~f:(encode legacy)
+  in
+  let all f = List.for_all values ~f in
+  printfn
+    "same bytes: %b; old -> new: %b; new -> old: %b"
+    (all (fun value ->
+       String.equal
+         (Csexp.to_string (encode legacy value))
+         (Csexp.to_string (encode current value))))
+    (all (fun value ->
+       let sexp = encode legacy value in
+       Poly.equal (decode current sexp) (Ok sexp)))
+    (all (fun value ->
+       Poly.equal (decode legacy (encode current value)) (Ok (encode legacy value))))
+;;
+
+let%expect_test "call fields preserve the flattened wire format" =
+  let legacy =
+    let open Conv in
+    iso
+      (both (field "method" (required Method.Name.sexp)) (field "params" (required sexp)))
+      (fun (method_, params) -> { Call.method_; params })
+      (fun { Call.method_; params } -> method_, params)
+  in
+  let call =
+    Call.create ~method_:(Method.Name.of_string "build") ~params:(Atom "target") ()
+  in
+  let with_id fields = Conv.(record (both (field "id" (required int)) fields)) in
+  check_wire_compatibility (with_id legacy) (with_id Call.fields) [ 42, call ];
+  Conv.to_sexp (with_id Call.fields) (42, call) |> Sexp.to_string |> print_endline;
+  [%expect
+    {|
+    same bytes: true; old -> new: true; new -> old: true
+    ((id 42) (method build) (params target)) |}]
+;;
+
+let%expect_test "diagnostic record wire compatibility" =
+  let legacy =
+    let open Conv in
+    iso
+      (record
+         (eight
+            (field "targets" (required (list Target.sexp)))
+            (field "message" (required (Pp.sexp User_message.Style.sexp)))
+            (field "loc" (optional Loc.sexp))
+            (field
+               "severity"
+               (optional (enum [ "error", Diagnostic.Error; "warning", Warning ])))
+            (field "promotion" (required (list Diagnostic.Promotion.sexp)))
+            (field "directory" (optional string))
+            (field "id" (required Diagnostic.Id.sexp))
+            (field "related" (required (list Diagnostic.Related.sexp)))))
+      (fun (targets, message, loc, severity, promotion, directory, id, related) ->
+         { Diagnostic.targets; message; loc; severity; promotion; directory; id; related })
+      (fun { Diagnostic.targets
+           ; message
+           ; loc
+           ; severity
+           ; promotion
+           ; directory
+           ; id
+           ; related
+           } -> targets, message, loc, severity, promotion, directory, id, related)
+  in
+  let start =
+    { Lexing.pos_fname = "source.ml"; pos_lnum = 2; pos_bol = 10; pos_cnum = 12 }
+  in
+  let loc = { Loc.start; stop = { start with pos_cnum = 18 } } in
+  let message = Pp.tag User_message.Style.Error (Pp.verbatim "a styled message") in
+  let values =
+    List.concat_map [ None; Some loc ] ~f:(fun location ->
+      List.concat_map [ None; Some Diagnostic.Error; Some Warning ] ~f:(fun severity ->
+        List.map [ None; Some "directory" ] ~f:(fun directory ->
+          { Diagnostic.targets = [ Target.Path "target"; Alias "all" ]
+          ; message
+          ; loc = location
+          ; severity
+          ; promotion =
+              [ { Diagnostic.Promotion.in_build = "build"; in_source = "source" } ]
+          ; directory
+          ; id = Diagnostic.Id.create 42
+          ; related = [ { Diagnostic.Related.loc; message } ]
+          })))
+  in
+  check_wire_compatibility legacy Diagnostic.sexp values;
+  [%expect {| same bytes: true; old -> new: true; new -> old: true |}]
+;;
+
+let%expect_test "exported record wire formats" =
+  let check conv value =
+    let sexp = Conv.to_sexp conv value in
+    print_endline (Sexp.to_string sexp);
+    printfn
+      "round trip: %b"
+      (Poly.equal (Conv.of_sexp conv ~version:(3, 0) sexp) (Ok value))
+  in
+  let start = { Lexing.pos_fname = "a.ml"; pos_lnum = 2; pos_bol = 10; pos_cnum = 12 } in
+  let loc =
+    { Loc.start
+    ; stop = { Lexing.pos_fname = "b.ml"; pos_lnum = 3; pos_bol = 20; pos_cnum = 25 }
+    }
+  in
+  check Loc.sexp loc;
+  [%expect
+    {|
+    ((start ((pos_bol 10) (pos_cnum 12) (pos_fname a.ml) (pos_lnum 2))) (stop ((pos_bol 20) (pos_cnum 25) (pos_fname b.ml) (pos_lnum 3))))
+    round trip: true |}];
+  check
+    Diagnostic.Promotion.sexp
+    { Diagnostic.Promotion.in_build = "_build/a"; in_source = "a" };
+  [%expect
+    {|
+    ((in_build _build/a) (in_source a))
+    round trip: true |}];
+  check
+    Diagnostic.Related.sexp
+    { Diagnostic.Related.loc
+    ; message = Pp.tag User_message.Style.Hint (Pp.verbatim "hint")
+    };
+  [%expect
+    {|
+    ((loc ((start ((pos_bol 10) (pos_cnum 12) (pos_fname a.ml) (pos_lnum 2))) (stop ((pos_bol 20) (pos_cnum 25) (pos_fname b.ml) (pos_lnum 3))))) (message (Tag ((Hint ()) (Verbatim hint)))))
+    round trip: true |}];
+  List.iter [ None; Some (Sexp.Atom "payload") ] ~f:(fun payload ->
+    check Message.sexp { Message.payload; message = "message" });
+  [%expect
+    {|
+    ((message message))
+    round trip: true
+    ((message message) (payload payload))
+    round trip: true |}];
+  let id = Job.Id.create 42 in
+  check
+    Job.Event.sexp
+    (Job.Event.Start
+       { Job.id
+       ; pid = 123
+       ; description = Pp.tag () (Pp.verbatim "job")
+       ; started_at = 1.5
+       });
+  check Job.Event.sexp (Job.Event.Stop id);
+  [%expect
+    {|
+    (Start ((description (Tag (Verbatim job))) (id 42) (pid 123) (started_at 1.5)))
+    round trip: true
+    (Stop 42)
+    round trip: true |}];
+  List.iter
+    [ Files_to_promote.All; These [ Stdune.Path.Source.of_string "a" ] ]
+    ~f:(fun files ->
+      List.iter [ Promote_targets.Matching.Exact; Prefix ] ~f:(fun matching ->
+        check Promote_targets.sexp { Promote_targets.files; matching }));
+  [%expect
+    {|
+    ((files ()) (matching exact))
+    round trip: true
+    ((files ()) (matching prefix))
+    round trip: true
+    ((files (a)) (matching exact))
+    round trip: true
+    ((files (a)) (matching prefix))
+    round trip: true |}]
+;;
+
+let%expect_test "RPC protocol record wire formats" =
+  let check conv value =
+    let sexp = Conv.to_sexp conv value in
+    print_endline (Sexp.to_string sexp);
+    printfn
+      "round trip: %b"
+      (Poly.equal (Conv.of_sexp conv ~version:(3, 0) sexp) (Ok value))
+  in
+  let response = Conv.record Response.fields in
+  let id = Id.make (Atom "request") in
+  List.iter [ Response.Error.Invalid_request; Code_error ] ~f:(fun kind ->
+    List.iter [ None; Some (Sexp.Atom "payload") ] ~f:(fun payload ->
+      check response (id, Error { Response.Error.kind; payload; message = "message" })));
+  [%expect
+    {|
+    ((id request) (result (error ((kind Invalid_request) (message message)))))
+    round trip: true
+    ((id request) (result (error ((kind Invalid_request) (message message) (payload payload)))))
+    round trip: true
+    ((id request) (result (error ((kind Code_error) (message message)))))
+    round trip: true
+    ((id request) (result (error ((kind Code_error) (message message) (payload payload)))))
+    round trip: true |}];
+  let request = { Initialize.Request.dune_version = 3, 0; protocol_version = 0; id } in
+  let call = Initialize.Request.to_call request in
+  Conv.to_sexp (Conv.record Call.fields) call |> Sexp.to_string |> print_endline;
+  printfn
+    "round trip: %b"
+    (Poly.equal (Initialize.Request.of_call call ~version:(3, 0)) (Ok request));
+  [%expect
+    {|
+    ((method initialize) (params ((dune_version (3 0)) (id request) (protocol_version 0))))
+    round trip: true |}];
+  let module Initialize_response = Procedures.Public.Action_plugin.Initialize_response in
+  check Initialize_response.conv { Initialize_response.root = "/sandbox/default" };
+  [%expect
+    {|
+    ((root /sandbox/default))
+    round trip: true |}]
+;;
+
+let%expect_test "format and add request wire formats" =
+  let check (_, Decl.Generation.T { req; upgrade_req; downgrade_req; _ }) value =
+    let sexp = Conv.to_sexp req (downgrade_req value) in
+    print_endline (Sexp.to_string sexp);
+    let decoded = Conv.of_sexp req ~version:(3, 0) sexp |> Result.map ~f:upgrade_req in
+    printfn "round trip: %b" (Poly.equal decoded (Ok value))
+  in
+  List.iter Procedures.Public.format_dune_file.generations ~f:(fun gen ->
+    check gen ("dune", `Contents "contents"));
+  [%expect
+    {|
+    ((contents contents) (path dune))
+    round trip: true |}];
+  check Add.v2 { Add.x = 2; y = 7; others = [ -1; 3 ] };
+  [%expect
+    {|
+    ((others (-1 3)) (x 2) (y 7))
+    round trip: true |}]
+;;
+
+let%expect_test "V1 diagnostic record wire format" =
+  let start = { Lexing.pos_fname = "a.ml"; pos_lnum = 2; pos_bol = 10; pos_cnum = 12 } in
+  let loc = { Loc.start; stop = { start with pos_cnum = 18 } } in
+  let message = Pp.tag User_message.Style.Details (Pp.verbatim "message") in
+  let minimal =
+    { Diagnostic.id = Diagnostic.Id.create 7
+    ; message
+    ; targets = []
+    ; loc = None
+    ; severity = None
+    ; promotion = []
+    ; directory = None
+    ; related = []
+    }
+  in
+  let full =
+    { minimal with
+      targets = [ Target.Alias "all" ]
+    ; loc = Some loc
+    ; severity = Some Warning
+    ; promotion = [ { Diagnostic.Promotion.in_build = "build"; in_source = "source" } ]
+    ; directory = Some "dir"
+    ; related = [ { Diagnostic.Related.loc; message } ]
+    }
+  in
+  List.iter
+    Procedures.Public.diagnostics.generations
+    ~f:(fun (version, Decl.Generation.T { resp; upgrade_resp; downgrade_resp; _ }) ->
+      if version = 1
+      then
+        List.iter [ minimal; full ] ~f:(fun diagnostic ->
+          let value = [ diagnostic ] in
+          let sexp = Conv.to_sexp resp (downgrade_resp value) in
+          print_endline (Sexp.to_string sexp);
+          let decoded =
+            Conv.of_sexp resp ~version:(3, 0) sexp |> Result.map ~f:upgrade_resp
+          in
+          printfn "round trip: %b" (Poly.equal decoded (Ok value))));
+  [%expect
+    {|
+    (((id 7) (message (Tag (Verbatim message))) (promotion ()) (related ()) (targets ())))
+    round trip: true
+    (((directory dir) (id 7) (loc ((start ((pos_bol 10) (pos_cnum 12) (pos_fname a.ml) (pos_lnum 2))) (stop ((pos_bol 10) (pos_cnum 18) (pos_fname a.ml) (pos_lnum 2))))) (message (Tag (Verbatim message))) (promotion (((in_build build) (in_source source)))) (related (((loc ((start ((pos_bol 10) (pos_cnum 12) (pos_fname a.ml) (pos_lnum 2))) (stop ((pos_bol 10) (pos_cnum 18) (pos_fname a.ml) (pos_lnum 2))))) (message (Tag (Verbatim message)))))) (severity warning) (targets ((Alias all)))))
+    round trip: true |}]
+;;
diff --git a/test/expect-tests/dune_rpc_e2e/dune_rpc_registry_test.ml b/test/expect-tests/dune_rpc_e2e/dune_rpc_registry_test.ml
index 7e9f5237b4a..193a32231d9 100644
--- a/test/expect-tests/dune_rpc_e2e/dune_rpc_registry_test.ml
+++ b/test/expect-tests/dune_rpc_e2e/dune_rpc_registry_test.ml
@@ -44,6 +44,35 @@ let run =
         Scheduler.Run.go config run ~timeout:(Time.Span.of_secs 5.0))
 ;;
 
+let%expect_test "registry record wire format" =
+  let config =
+    Registry.Config.create
+      (Xdg.create
+         ~env:(function
+           | "XDG_RUNTIME_DIR" -> Some "."
+           | _ -> None)
+         ())
+  in
+  List.iter
+    [ `Unix "rpc"; `Ip (`Host "localhost", `Port 8587) ]
+    ~f:(fun where ->
+      let dune = Registry.Dune.create ~where ~root:"project" ~pid:(Pid.of_int_exn 123) in
+      let (`Caller_should_write file) = Registry.Config.register config dune in
+      print_endline file.contents;
+      let round_trip =
+        match Registry.Dune.of_file file with
+        | Error _ -> false
+        | Ok decoded -> Ordering.is_eq (Registry.Dune.compare dune decoded)
+      in
+      printfn "round trip: %b" round_trip);
+  [%expect
+    {|
+    ((3:pid3:123)(4:root7:project)(5:where13:unix:path=rpc))
+    round trip: true
+    ((3:pid3:123)(4:root7:project)(5:where28:tcp:host=localhost,port=8587))
+    round trip: true |}]
+;;
+
 let%expect_test "poll skips scans after the registry mtime changes" =
   let module IO = struct
     let mtime = ref 0.0