From c29ac75a82c2f5c04e9260bf157e8db20e926409 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 21 Jan 2026 22:15:23 -0500
Subject: [PATCH] opentelemetry.trace: expose sum and hist metrics

---
 src/core/metrics.ml               |  9 ++++++---
 src/trace/opentelemetry_trace.ml  | 31 ++++++++++++++++++++++---------
 src/trace/opentelemetry_trace.mli |  5 +++++
 3 files changed, 33 insertions(+), 12 deletions(-)

diff --git a/src/core/metrics.ml b/src/core/metrics.ml
index 083a94df..aab20afe 100644
--- a/src/core/metrics.ml
+++ b/src/core/metrics.ml
@@ -49,17 +49,20 @@ let sum ~name ?description ?unit_
   in
   make_metric ~name ?description ?unit_ ~data ()
 
+type histogram_data_point = Metrics.histogram_data_point
+
 (** Histogram data
     @param count number of values in population (non negative)
     @param sum sum of values in population (0 if count is 0)
     @param now the timestamp for this data point
     @param bucket_counts
       count value of histogram for each bucket. Sum of the counts must be equal
-      to [count]. length must be [1+length explicit_bounds]
+      to [count]. length must be [1+length explicit_bounds] (unless both have
+      length 0)
     @param explicit_bounds strictly increasing list of bounds for the buckets *)
 let histogram_data_point ?start_time_unix_nano ?(attrs = []) ?(exemplars = [])
-    ?(explicit_bounds = []) ?sum ~(now : Timestamp_ns.t) ~bucket_counts ~count
-    () : histogram_data_point =
+    ~explicit_bounds ?sum ~(now : Timestamp_ns.t) ~bucket_counts ~count () :
+    histogram_data_point =
   let attributes = attrs |> List.map Key_value.conv in
   make_histogram_data_point ?start_time_unix_nano ~time_unix_nano:now
     ~attributes ~exemplars ~bucket_counts ~explicit_bounds ~count ?sum ()
diff --git a/src/trace/opentelemetry_trace.ml b/src/trace/opentelemetry_trace.ml
index 5c593d7e..1cda56ad 100644
--- a/src/trace/opentelemetry_trace.ml
+++ b/src/trace/opentelemetry_trace.ml
@@ -10,6 +10,11 @@ module Extensions = struct
       }
     | Ev_set_span_kind of Otrace.span * OTEL.Span_kind.t
     | Ev_set_span_status of Otrace.span * OTEL.Span_status.t
+
+  type Otrace.metric +=
+    | Metric_hist of OTEL.Metrics.histogram_data_point
+    | Metric_sum_int of int
+    | Metric_sum_float of float
 end
 
 open Extensions
@@ -127,17 +132,25 @@ open struct
 
   let metric (self : state) ~level:_ ~params:_ ~data:attrs name v : unit =
     let now = OTEL.Clock.now self.clock in
-    let vals =
+    let kind =
+      let open Trace_core.Core_ext in
       match v with
-      | Trace_core.Core_ext.Metric_int i -> [ OTEL.Metrics.int ~attrs ~now i ]
-      | Trace_core.Core_ext.Metric_float v ->
-        [ OTEL.Metrics.float ~attrs ~now v ]
-      | _ -> []
+      | Metric_int i -> `gauge (OTEL.Metrics.int ~attrs ~now i)
+      | Metric_float v -> `gauge (OTEL.Metrics.float ~attrs ~now v)
+      | Metric_sum_int i -> `sum (OTEL.Metrics.int ~attrs ~now i)
+      | Metric_sum_float v -> `sum (OTEL.Metrics.float ~attrs ~now v)
+      | Metric_hist h -> `hist h
+      | _ -> `none
     in
-    if vals <> [] then (
-      let m = OTEL.Metrics.(gauge ~name vals) in
-      OTEL.Exporter.send_metrics self.exporter [ m ]
-    )
+
+    let m =
+      match kind with
+      | `none -> []
+      | `gauge v -> [ OTEL.Metrics.gauge ~name [ v ] ]
+      | `sum v -> [ OTEL.Metrics.sum ~name [ v ] ]
+      | `hist h -> [ OTEL.Metrics.histogram ~name [ h ] ]
+    in
+    if m <> [] then OTEL.Exporter.send_metrics self.exporter m
 
   let extension (_self : state) ~level:_ ev =
     match ev with
diff --git a/src/trace/opentelemetry_trace.mli b/src/trace/opentelemetry_trace.mli
index 17c8de48..ed421f99 100644
--- a/src/trace/opentelemetry_trace.mli
+++ b/src/trace/opentelemetry_trace.mli
@@ -33,6 +33,11 @@ module Extensions : sig
           (** Record exception and potentially turn span to an error *)
     | Ev_set_span_kind of Otrace.span * OTEL.Span_kind.t
     | Ev_set_span_status of Otrace.span * OTEL.Span_status.t
+
+  type Otrace.metric +=
+    | Metric_hist of OTEL.Metrics.histogram_data_point
+    | Metric_sum_int of int
+    | Metric_sum_float of float
 end
 
 val setup : unit -> unit