From ff915790a045b1428814b07bf3a8217df0eb2ef8 Mon Sep 17 00:00:00 2001
From: Gabriel Buica <danutgabriel.buica@cloud.com>
Date: Thu, 16 Jan 2025 09:20:14 +0000
Subject: [PATCH] fixup! CP-52744: Thread `TraceContext` as json inside
 debug_info

---
 dune-project                     |  6 ++++--
 ocaml/libs/tracing/dune          | 13 +++++++++++--
 ocaml/libs/tracing/tracing.ml    | 15 ++++++++++-----
 ocaml/libs/tracing/tracing.mli   |  2 +-
 ocaml/xapi-idl/lib/debug_info.ml | 26 ++++++--------------------
 xapi-tracing.opam                |  6 ++++--
 6 files changed, 36 insertions(+), 32 deletions(-)

diff --git a/dune-project b/dune-project
index 2a672e0a841..a21217568fe 100644
--- a/dune-project
+++ b/dune-project
@@ -103,13 +103,15 @@
    dune
    (alcotest :with-test)
    (fmt :with-test)
-   ppx_deriving_yojson
+   ppx_deriving_rpc
    re
+   rpclib
+   result
+   rresult
    uri
    (uuid :with-test)
    (xapi-log (= :version))
    (xapi-stdext-threads (= :version))
-   yojson
   )
   (synopsis "Allows to instrument code to generate tracing information")
   (description "This library provides modules to allow gathering runtime traces.")
diff --git a/ocaml/libs/tracing/dune b/ocaml/libs/tracing/dune
index 97c7e470e87..98d1d2fe002 100644
--- a/ocaml/libs/tracing/dune
+++ b/ocaml/libs/tracing/dune
@@ -1,9 +1,18 @@
 (library
  (name tracing)
  (modules tracing)
- (libraries re uri yojson xapi-log xapi-stdext-threads threads.posix)
+ (libraries
+  re
+  rpclib.core
+  rpclib.json
+  result
+  rresult
+  uri
+  xapi-log
+  xapi-stdext-threads
+  threads.posix)
  (preprocess
-  (pps ppx_deriving_yojson))
+  (pps ppx_deriving_rpc))
  (public_name xapi-tracing))
 
 (library
diff --git a/ocaml/libs/tracing/tracing.ml b/ocaml/libs/tracing/tracing.ml
index 14f8421ec5a..0a70fd8ad47 100644
--- a/ocaml/libs/tracing/tracing.ml
+++ b/ocaml/libs/tracing/tracing.ml
@@ -211,12 +211,12 @@ end
 
 (* The context of a trace that can be propagated across service boundaries. *)
 module TraceContext = struct
-  type traceparent = string [@@deriving yojson]
+  type traceparent = string [@@deriving rpcty]
 
-  type baggage = (string * string) list [@@deriving yojson]
+  type baggage = (string * string) list [@@deriving rpcty]
 
   type t = {traceparent: traceparent option; baggage: baggage option}
-  [@@deriving yojson]
+  [@@deriving rpcty]
 
   let empty = {traceparent= None; baggage= None}
 
@@ -228,9 +228,14 @@ module TraceContext = struct
 
   let baggage_of ctx = ctx.baggage
 
-  let to_json_string t = Yojson.Safe.to_string (to_yojson t)
+  let to_json_string trace_context =
+    Rpcmarshal.marshal t.Rpc.Types.ty trace_context |> Jsonrpc.to_string
 
-  let of_json_string s = of_yojson (Yojson.Safe.from_string s)
+  let of_json_string s =
+    s
+    |> Jsonrpc.of_string
+    |> Rpcmarshal.unmarshal t.Rpc.Types.ty
+    |> Rresult.R.get_ok
 end
 
 module SpanContext = struct
diff --git a/ocaml/libs/tracing/tracing.mli b/ocaml/libs/tracing/tracing.mli
index 7239bf83675..d80f70c74fc 100644
--- a/ocaml/libs/tracing/tracing.mli
+++ b/ocaml/libs/tracing/tracing.mli
@@ -97,7 +97,7 @@ module TraceContext : sig
 
   val to_json_string : t -> string
 
-  val of_json_string : string -> (t, string) result
+  val of_json_string : string -> t
 end
 
 module SpanContext : sig
diff --git a/ocaml/xapi-idl/lib/debug_info.ml b/ocaml/xapi-idl/lib/debug_info.ml
index 24517c4c5c9..ece80acb6b5 100644
--- a/ocaml/xapi-idl/lib/debug_info.ml
+++ b/ocaml/xapi-idl/lib/debug_info.ml
@@ -24,22 +24,11 @@ let of_string s =
   match String.split_on_char separator s with
   | [log; traceparent] ->
       let trace_context =
-        try
-          let trace_context = Tracing.TraceContext.of_json_string traceparent in
-          match trace_context with
-          | Ok trace_context ->
-              Some trace_context
-          | Error _ ->
-              None
+        try Tracing.TraceContext.of_json_string traceparent
         with _ ->
-          Some
-            (TraceContext.empty
-            |> TraceContext.with_traceparent (Some traceparent)
-            )
-      in
-      let spancontext =
-        Option.(join (map Tracing.SpanContext.of_trace_context trace_context))
+          TraceContext.empty |> TraceContext.with_traceparent (Some traceparent)
       in
+      let spancontext = Tracing.SpanContext.of_trace_context trace_context in
       let tracing =
         Option.map (Fun.flip Tracer.span_of_span_context log) spancontext
       in
@@ -93,12 +82,9 @@ let traceparent_of_dbg dbg =
   match String.split_on_char separator dbg with
   | [_; traceparent] -> (
     try
-      let trace_context = Tracing.TraceContext.of_json_string traceparent in
-      match trace_context with
-      | Ok trace_context ->
-          Tracing.TraceContext.traceparent_of trace_context
-      | Error _ ->
-          None
+      traceparent
+      |> Tracing.TraceContext.of_json_string
+      |> Tracing.TraceContext.traceparent_of
     with _ -> Some traceparent
   )
   | _ ->
diff --git a/xapi-tracing.opam b/xapi-tracing.opam
index f5c0df48bfe..3c401a8d0c3 100644
--- a/xapi-tracing.opam
+++ b/xapi-tracing.opam
@@ -13,13 +13,15 @@ depends: [
   "dune" {>= "3.15"}
   "alcotest" {with-test}
   "fmt" {with-test}
-  "ppx_deriving_yojson"
+  "ppx_deriving_rpc"
   "re"
+  "rpclib"
+  "result"
+  "rresult"
   "uri"
   "uuid" {with-test}
   "xapi-log" {= version}
   "xapi-stdext-threads" {= version}
-  "yojson"
   "odoc" {with-doc}
 ]
 build: [