From 00d46841e44667ba465763901d59e9a196962b5f Mon Sep 17 00:00:00 2001
From: Corentin Leruth <corentin.leruth@gmail.com>
Date: Tue, 24 Sep 2024 09:26:58 +0200
Subject: [PATCH] add record_exception

---
 src/core/opentelemetry.ml    | 25 +++++++++++++++++++------
 src/lwt/opentelemetry_lwt.ml |  4 ++--
 2 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml
index be4135f0..e4e3128a 100644
--- a/src/core/opentelemetry.ml
+++ b/src/core/opentelemetry.ml
@@ -776,6 +776,21 @@ module Scope = struct
   let[@inline] add_event (scope : t) (ev : unit -> Event.t) : unit =
     if Collector.has_backend () then scope.events <- ev () :: scope.events
 
+  let[@inline] record_exception (scope : t) (exn : exn)
+      (bt : Printexc.raw_backtrace) : unit =
+    if Collector.has_backend () then (
+      let ev =
+        Event.make "exception"
+          ~attrs:
+            [
+              "message", `String (Printexc.to_string exn);
+              "type", `String (Printexc.exn_slot_name exn);
+              "stacktrace", `String (Printexc.raw_backtrace_to_string bt);
+            ]
+      in
+      scope.events <- ev :: scope.events
+    )
+
   (** Add an attr to the scope. It will be aggregated into the span.
 
       Note that this takes a function that produces attributes, and will only
@@ -1032,11 +1047,9 @@ module Trace = struct
         | Ok () -> default_status ~code:Status_code_ok ()
         | Error (e, bt) ->
           (* add backtrace *)
-          add_event scope (fun () ->
-              Event.make "error"
-                ~attrs:
-                  [ "backtrace", `String (Printexc.raw_backtrace_to_string bt) ]);
-          default_status ~code:Status_code_error ~message:e ()
+          Scope.record_exception scope e bt;
+          default_status ~code:Status_code_error ~message:(Printexc.to_string e)
+            ()
       in
       let span, _ =
         (* TODO: should the attrs passed to with_ go on the Span
@@ -1084,7 +1097,7 @@ module Trace = struct
       rv
     with e ->
       let bt = Printexc.get_raw_backtrace () in
-      finally (Error (Printexc.to_string e, bt));
+      finally (Error (e, bt));
       raise e
 end
 
diff --git a/src/lwt/opentelemetry_lwt.ml b/src/lwt/opentelemetry_lwt.ml
index 1d495f2d..cf450de5 100644
--- a/src/lwt/opentelemetry_lwt.ml
+++ b/src/lwt/opentelemetry_lwt.ml
@@ -29,8 +29,8 @@ module Trace = struct
       Lwt.return rv
     with e ->
       let bt = Printexc.get_raw_backtrace () in
-      let () = finally (Error (Printexc.to_string e, bt)) in
-      Lwt.fail e
+      let () = finally (Error (e, bt)) in
+      raise e
 end
 
 module Metrics = struct