From a35ea4c646255830f7f7b0483040e04c14c3c88e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 30 Oct 2025 21:31:51 -0400 Subject: [PATCH] fixes --- src/client/signal.ml | 7 +-- src/core/opentelemetry.ml | 104 +++++++++++++++---------------- src/trace/opentelemetry_trace.ml | 5 +- 3 files changed, 56 insertions(+), 60 deletions(-) diff --git a/src/client/signal.ml b/src/client/signal.ml index 7a2eddd5..d3fafcfa 100644 --- a/src/client/signal.ml +++ b/src/client/signal.ml @@ -54,14 +54,14 @@ module Encode = struct resource_logs |> resource_to_string ~encoder ~ctor:(fun r -> - Logs_service.default_export_logs_service_request ~resource_logs:r ()) + Logs_service.make_export_logs_service_request ~resource_logs:r ()) ~enc:Logs_service.encode_pb_export_logs_service_request let metrics ?encoder resource_metrics = resource_metrics |> resource_to_string ~encoder ~ctor:(fun r -> - Metrics_service.default_export_metrics_service_request + Metrics_service.make_export_metrics_service_request ~resource_metrics:r ()) ~enc:Metrics_service.encode_pb_export_metrics_service_request @@ -69,8 +69,7 @@ module Encode = struct resource_spans |> resource_to_string ~encoder ~ctor:(fun r -> - Trace_service.default_export_trace_service_request ~resource_spans:r - ()) + Trace_service.make_export_trace_service_request ~resource_spans:r ()) ~enc:Trace_service.encode_pb_export_trace_service_request end diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index ffac42b7..a3c8f312 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -673,7 +673,7 @@ open struct let _conv_key_value (k, v) = let open Proto.Common in let value = _conv_value v in - default_key_value ~key:k ~value () + make_key_value ~key:k ?value () end (** {2 Global settings} *) @@ -695,9 +695,9 @@ module Globals = struct @since 0.12 *) let service_version = ref None - let instrumentation_library = - default_instrumentation_scope ~version:"%%VERSION_NUM%%" ~name:"ocaml-otel" - () + let instrumentation_library : instrumentation_scope = + make_instrumentation_scope ~version:"%%VERSION_NUM%%" ~name:"ocaml-otel" + ~attributes:[] () (** Global attributes, initially set via OTEL_RESOURCE_ATTRIBUTES and modifiable by the user code. They will be attached to each outgoing @@ -705,7 +705,7 @@ module Globals = struct let global_attributes : key_value list ref = let parse_pair s = match String.split_on_char '=' s with - | [ a; b ] -> default_key_value ~key:a ~value:(Some (String_value b)) () + | [ a; b ] -> make_key_value ~key:a ~value:(String_value b) () | _ -> failwith (Printf.sprintf "invalid attribute: %S" s) in ref @@ -734,32 +734,32 @@ module Globals = struct let mk_attributes ?(service_name = !service_name) ?(attrs = []) () : _ list = let l = List.map _conv_key_value attrs in let l = - default_key_value ~key:Conventions.Attributes.Service.name - ~value:(Some (String_value service_name)) () + make_key_value ~key:Conventions.Attributes.Service.name + ~value:(String_value service_name) () :: l in let l = match !service_instance_id with | None -> l | Some v -> - default_key_value ~key:Conventions.Attributes.Service.instance_id - ~value:(Some (String_value v)) () + make_key_value ~key:Conventions.Attributes.Service.instance_id + ~value:(String_value v) () :: l in let l = match !service_namespace with | None -> l | Some v -> - default_key_value ~key:Conventions.Attributes.Service.namespace - ~value:(Some (String_value v)) () + make_key_value ~key:Conventions.Attributes.Service.namespace + ~value:(String_value v) () :: l in let l = match !service_version with | None -> l | Some v -> - default_key_value ~key:Conventions.Attributes.Service.version - ~value:(Some (String_value v)) () + make_key_value ~key:Conventions.Attributes.Service.version + ~value:(String_value v) () :: l in l |> merge_global_attributes_ @@ -786,7 +786,7 @@ end = struct let make ?(time_unix_nano = Timestamp_ns.now_unix_ns ()) ?(attrs = []) (name : string) : t = let attrs = List.map _conv_key_value attrs in - default_span_event ~time_unix_nano ~name ~attributes:attrs () + make_span_event ~time_unix_nano ~name ~attributes:attrs () end (** Span Link @@ -826,7 +826,7 @@ end = struct let dropped_attributes_count = Option.map Int32.of_int dropped_attributes_count in - default_span_link + make_span_link ~trace_id:(Trace_id.to_bytes trace_id) ~span_id:(Span_id.to_bytes span_id) ?trace_state ~attributes ?dropped_attributes_count () @@ -840,9 +840,10 @@ end module Span_status : sig open Proto.Trace - type t = status = { - message: string; - code: status_status_code; + type t = status = private { + mutable _presence: Pbrt.Bitfield.t; + mutable message: string; + mutable code: status_status_code; } type code = status_status_code = @@ -854,9 +855,10 @@ module Span_status : sig end = struct open Proto.Trace - type t = status = { - message: string; - code: status_status_code; + type t = status = private { + mutable _presence: Pbrt.Bitfield.t; + mutable message: string; + mutable code: status_status_code; } type code = status_status_code = @@ -864,7 +866,7 @@ end = struct | Status_code_ok | Status_code_error - let make ~message ~code = { message; code } + let[@inline] make ~message ~code : t = make_status ~message ~code () end (** @since 0.11 *) @@ -1199,8 +1201,8 @@ end = struct let parent_span_id = Option.map Span_id.to_bytes parent in let attributes = List.map _conv_key_value attrs in let span = - default_span ~trace_id ?parent_span_id ~span_id:(Span_id.to_bytes id) - ~attributes ~events ?trace_state ~status ~kind ~name ~links + make_span ~trace_id ?parent_span_id ~span_id:(Span_id.to_bytes id) + ~attributes ~events ?trace_state ?status ~kind ~name ~links ~start_time_unix_nano:start_time ~end_time_unix_nano:end_time () in span, id @@ -1216,14 +1218,13 @@ module Trace = struct type span = Span.t - let make_resource_spans ?service_name ?attrs spans = + let make_resource_spans ?service_name ?attrs spans : resource_spans = let ils = - default_scope_spans ~scope:(Some Globals.instrumentation_library) ~spans - () + make_scope_spans ~scope:Globals.instrumentation_library ~spans () in let attributes = Globals.mk_attributes ?service_name ?attrs () in - let resource = Proto.Resource.default_resource ~attributes () in - default_resource_spans ~resource:(Some resource) ~scope_spans:[ ils ] () + let resource = Proto.Resource.make_resource ~attributes () in + make_resource_spans ~resource ~scope_spans:[ ils ] () (** Sync emitter. @@ -1290,7 +1291,7 @@ module Trace = struct | Error (e, bt) -> Scope.record_exception scope e bt; Some - (default_status ~code:Status_code_error + (make_status ~code:Status_code_error ~message:(Printexc.to_string e) ())) in let span, _ = @@ -1371,23 +1372,22 @@ module Metrics = struct ?(now = Timestamp_ns.now_unix_ns ()) ?(attrs = []) (d : float) : number_data_point = let attributes = attrs |> List.map _conv_key_value in - default_number_data_point ~start_time_unix_nano ~time_unix_nano:now - ~attributes ~value:(As_double d) () + make_number_data_point ~start_time_unix_nano ~time_unix_nano:now ~attributes + ~value:(As_double d) ~exemplars:[] () (** Number data point, as an int *) let int ?(start_time_unix_nano = _program_start) ?(now = Timestamp_ns.now_unix_ns ()) ?(attrs = []) (i : int) : number_data_point = let attributes = attrs |> List.map _conv_key_value in - default_number_data_point ~start_time_unix_nano ~time_unix_nano:now - ~attributes + make_number_data_point ~start_time_unix_nano ~time_unix_nano:now ~attributes ~value:(As_int (Int64.of_int i)) - () + ~exemplars:[] () (** Aggregation of a scalar metric, always with the current value *) let gauge ~name ?description ?unit_ (l : number_data_point list) : t = - let data = Gauge (default_gauge ~data_points:l ()) in - default_metric ~name ?description ?unit_ ~data () + let data = Gauge (make_gauge ~data_points:l ()) in + make_metric ~name ?description ?unit_ ~data () type aggregation_temporality = Metrics.aggregation_temporality = | Aggregation_temporality_unspecified @@ -1399,9 +1399,9 @@ module Metrics = struct ?(aggregation_temporality = Aggregation_temporality_cumulative) ?is_monotonic (l : number_data_point list) : t = let data = - Sum (default_sum ~data_points:l ?is_monotonic ~aggregation_temporality ()) + Sum (make_sum ~data_points:l ?is_monotonic ~aggregation_temporality ()) in - default_metric ~name ?description ?unit_ ~data () + make_metric ~name ?description ?unit_ ~data () (** Histogram data @param count number of values in population (non negative) @@ -1416,15 +1416,15 @@ module Metrics = struct ?(explicit_bounds = []) ?sum ~bucket_counts ~count () : histogram_data_point = let attributes = attrs |> List.map _conv_key_value in - default_histogram_data_point ~start_time_unix_nano ~time_unix_nano:now + make_histogram_data_point ~start_time_unix_nano ~time_unix_nano:now ~attributes ~exemplars ~bucket_counts ~explicit_bounds ~count ?sum () let histogram ~name ?description ?unit_ ?aggregation_temporality (l : histogram_data_point list) : t = let data = - Histogram (default_histogram ~data_points:l ?aggregation_temporality ()) + Histogram (make_histogram ~data_points:l ?aggregation_temporality ()) in - default_metric ~name ?description ?unit_ ~data () + make_metric ~name ?description ?unit_ ~data () (* TODO: exponential history *) (* TODO: summary *) @@ -1434,12 +1434,11 @@ module Metrics = struct let make_resource_metrics ?service_name ?attrs (l : t list) : resource_metrics = let lm = - default_scope_metrics ~scope:(Some Globals.instrumentation_library) - ~metrics:l () + make_scope_metrics ~scope:Globals.instrumentation_library ~metrics:l () in let attributes = Globals.mk_attributes ?service_name ?attrs () in - let resource = Proto.Resource.default_resource ~attributes () in - default_resource_metrics ~scope_metrics:[ lm ] ~resource:(Some resource) () + let resource = Proto.Resource.make_resource ~attributes () in + make_resource_metrics ~scope_metrics:[ lm ] ~resource () (** Emit some metrics to the collector (sync). This blocks until the backend has pushed the metrics into some internal queue, or discarded them. @@ -1543,9 +1542,9 @@ module Logs = struct let trace_id = Option.map Trace_id.to_bytes trace_id in let span_id = Option.map Span_id.to_bytes span_id in let body = _conv_value body in - default_log_record ~time_unix_nano ~observed_time_unix_nano + make_log_record ~time_unix_nano ~observed_time_unix_nano ~attributes:[] ?severity_number:severity ?severity_text:log_level ?flags ?trace_id - ?span_id ~body () + ?span_id ?body () (** Make a log entry whose body is a string *) let make_str ?time ?observed_time_unix_nano ?severity ?log_level ?flags @@ -1569,14 +1568,11 @@ module Logs = struct cause deadlocks. *) let emit ?service_name ?attrs (l : t list) : unit = let attributes = Globals.mk_attributes ?service_name ?attrs () in - let resource = Proto.Resource.default_resource ~attributes () in + let resource = Proto.Resource.make_resource ~attributes () in let ll = - default_scope_logs ~scope:(Some Globals.instrumentation_library) - ~log_records:l () - in - let rl = - default_resource_logs ~resource:(Some resource) ~scope_logs:[ ll ] () + make_scope_logs ~scope:Globals.instrumentation_library ~log_records:l () in + let rl = make_resource_logs ~resource ~scope_logs:[ ll ] () in Collector.send_logs [ rl ] ~ret:ignore end diff --git a/src/trace/opentelemetry_trace.ml b/src/trace/opentelemetry_trace.ml index 0126257b..ead41826 100644 --- a/src/trace/opentelemetry_trace.ml +++ b/src/trace/opentelemetry_trace.ml @@ -193,8 +193,9 @@ module Internal = struct let status : Span_status.t = match List.assoc_opt Well_known.status_error_key attrs with - | Some (`String message) -> { message; code = Status_code_error } - | _ -> { message = ""; code = Status_code_ok } + | Some (`String message) -> + Span_status.make ~message ~code:Status_code_error + | _ -> Span_status.make ~message:"" ~code:Status_code_ok in let attrs =