This commit is contained in:
Simon Cruanes 2025-10-30 21:31:51 -04:00
parent 0f1452e01e
commit a35ea4c646
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
3 changed files with 56 additions and 60 deletions

View file

@ -54,14 +54,14 @@ module Encode = struct
resource_logs resource_logs
|> resource_to_string ~encoder |> resource_to_string ~encoder
~ctor:(fun r -> ~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 ~enc:Logs_service.encode_pb_export_logs_service_request
let metrics ?encoder resource_metrics = let metrics ?encoder resource_metrics =
resource_metrics resource_metrics
|> resource_to_string ~encoder |> resource_to_string ~encoder
~ctor:(fun r -> ~ctor:(fun r ->
Metrics_service.default_export_metrics_service_request Metrics_service.make_export_metrics_service_request
~resource_metrics:r ()) ~resource_metrics:r ())
~enc:Metrics_service.encode_pb_export_metrics_service_request ~enc:Metrics_service.encode_pb_export_metrics_service_request
@ -69,8 +69,7 @@ module Encode = struct
resource_spans resource_spans
|> resource_to_string ~encoder |> resource_to_string ~encoder
~ctor:(fun r -> ~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 ~enc:Trace_service.encode_pb_export_trace_service_request
end end

View file

@ -673,7 +673,7 @@ open struct
let _conv_key_value (k, v) = let _conv_key_value (k, v) =
let open Proto.Common in let open Proto.Common in
let value = _conv_value v in let value = _conv_value v in
default_key_value ~key:k ~value () make_key_value ~key:k ?value ()
end end
(** {2 Global settings} *) (** {2 Global settings} *)
@ -695,9 +695,9 @@ module Globals = struct
@since 0.12 *) @since 0.12 *)
let service_version = ref None let service_version = ref None
let instrumentation_library = let instrumentation_library : instrumentation_scope =
default_instrumentation_scope ~version:"%%VERSION_NUM%%" ~name:"ocaml-otel" make_instrumentation_scope ~version:"%%VERSION_NUM%%" ~name:"ocaml-otel"
() ~attributes:[] ()
(** Global attributes, initially set via OTEL_RESOURCE_ATTRIBUTES and (** Global attributes, initially set via OTEL_RESOURCE_ATTRIBUTES and
modifiable by the user code. They will be attached to each outgoing 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 global_attributes : key_value list ref =
let parse_pair s = let parse_pair s =
match String.split_on_char '=' s with 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) | _ -> failwith (Printf.sprintf "invalid attribute: %S" s)
in in
ref ref
@ -734,32 +734,32 @@ module Globals = struct
let mk_attributes ?(service_name = !service_name) ?(attrs = []) () : _ list = let mk_attributes ?(service_name = !service_name) ?(attrs = []) () : _ list =
let l = List.map _conv_key_value attrs in let l = List.map _conv_key_value attrs in
let l = let l =
default_key_value ~key:Conventions.Attributes.Service.name make_key_value ~key:Conventions.Attributes.Service.name
~value:(Some (String_value service_name)) () ~value:(String_value service_name) ()
:: l :: l
in in
let l = let l =
match !service_instance_id with match !service_instance_id with
| None -> l | None -> l
| Some v -> | Some v ->
default_key_value ~key:Conventions.Attributes.Service.instance_id make_key_value ~key:Conventions.Attributes.Service.instance_id
~value:(Some (String_value v)) () ~value:(String_value v) ()
:: l :: l
in in
let l = let l =
match !service_namespace with match !service_namespace with
| None -> l | None -> l
| Some v -> | Some v ->
default_key_value ~key:Conventions.Attributes.Service.namespace make_key_value ~key:Conventions.Attributes.Service.namespace
~value:(Some (String_value v)) () ~value:(String_value v) ()
:: l :: l
in in
let l = let l =
match !service_version with match !service_version with
| None -> l | None -> l
| Some v -> | Some v ->
default_key_value ~key:Conventions.Attributes.Service.version make_key_value ~key:Conventions.Attributes.Service.version
~value:(Some (String_value v)) () ~value:(String_value v) ()
:: l :: l
in in
l |> merge_global_attributes_ l |> merge_global_attributes_
@ -786,7 +786,7 @@ end = struct
let make ?(time_unix_nano = Timestamp_ns.now_unix_ns ()) ?(attrs = []) let make ?(time_unix_nano = Timestamp_ns.now_unix_ns ()) ?(attrs = [])
(name : string) : t = (name : string) : t =
let attrs = List.map _conv_key_value attrs in 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 end
(** Span Link (** Span Link
@ -826,7 +826,7 @@ end = struct
let dropped_attributes_count = let dropped_attributes_count =
Option.map Int32.of_int dropped_attributes_count Option.map Int32.of_int dropped_attributes_count
in in
default_span_link make_span_link
~trace_id:(Trace_id.to_bytes trace_id) ~trace_id:(Trace_id.to_bytes trace_id)
~span_id:(Span_id.to_bytes span_id) ?trace_state ~attributes ~span_id:(Span_id.to_bytes span_id) ?trace_state ~attributes
?dropped_attributes_count () ?dropped_attributes_count ()
@ -840,9 +840,10 @@ end
module Span_status : sig module Span_status : sig
open Proto.Trace open Proto.Trace
type t = status = { type t = status = private {
message: string; mutable _presence: Pbrt.Bitfield.t;
code: status_status_code; mutable message: string;
mutable code: status_status_code;
} }
type code = status_status_code = type code = status_status_code =
@ -854,9 +855,10 @@ module Span_status : sig
end = struct end = struct
open Proto.Trace open Proto.Trace
type t = status = { type t = status = private {
message: string; mutable _presence: Pbrt.Bitfield.t;
code: status_status_code; mutable message: string;
mutable code: status_status_code;
} }
type code = status_status_code = type code = status_status_code =
@ -864,7 +866,7 @@ end = struct
| Status_code_ok | Status_code_ok
| Status_code_error | Status_code_error
let make ~message ~code = { message; code } let[@inline] make ~message ~code : t = make_status ~message ~code ()
end end
(** @since 0.11 *) (** @since 0.11 *)
@ -1199,8 +1201,8 @@ end = struct
let parent_span_id = Option.map Span_id.to_bytes parent in let parent_span_id = Option.map Span_id.to_bytes parent in
let attributes = List.map _conv_key_value attrs in let attributes = List.map _conv_key_value attrs in
let span = let span =
default_span ~trace_id ?parent_span_id ~span_id:(Span_id.to_bytes id) make_span ~trace_id ?parent_span_id ~span_id:(Span_id.to_bytes id)
~attributes ~events ?trace_state ~status ~kind ~name ~links ~attributes ~events ?trace_state ?status ~kind ~name ~links
~start_time_unix_nano:start_time ~end_time_unix_nano:end_time () ~start_time_unix_nano:start_time ~end_time_unix_nano:end_time ()
in in
span, id span, id
@ -1216,14 +1218,13 @@ module Trace = struct
type span = Span.t type span = Span.t
let make_resource_spans ?service_name ?attrs spans = let make_resource_spans ?service_name ?attrs spans : resource_spans =
let ils = let ils =
default_scope_spans ~scope:(Some Globals.instrumentation_library) ~spans make_scope_spans ~scope:Globals.instrumentation_library ~spans ()
()
in in
let attributes = Globals.mk_attributes ?service_name ?attrs () in 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
default_resource_spans ~resource:(Some resource) ~scope_spans:[ ils ] () make_resource_spans ~resource ~scope_spans:[ ils ] ()
(** Sync emitter. (** Sync emitter.
@ -1290,7 +1291,7 @@ module Trace = struct
| Error (e, bt) -> | Error (e, bt) ->
Scope.record_exception scope e bt; Scope.record_exception scope e bt;
Some Some
(default_status ~code:Status_code_error (make_status ~code:Status_code_error
~message:(Printexc.to_string e) ())) ~message:(Printexc.to_string e) ()))
in in
let span, _ = let span, _ =
@ -1371,23 +1372,22 @@ module Metrics = struct
?(now = Timestamp_ns.now_unix_ns ()) ?(attrs = []) (d : float) : ?(now = Timestamp_ns.now_unix_ns ()) ?(attrs = []) (d : float) :
number_data_point = number_data_point =
let attributes = attrs |> List.map _conv_key_value in let attributes = attrs |> List.map _conv_key_value in
default_number_data_point ~start_time_unix_nano ~time_unix_nano:now make_number_data_point ~start_time_unix_nano ~time_unix_nano:now ~attributes
~attributes ~value:(As_double d) () ~value:(As_double d) ~exemplars:[] ()
(** Number data point, as an int *) (** Number data point, as an int *)
let int ?(start_time_unix_nano = _program_start) let int ?(start_time_unix_nano = _program_start)
?(now = Timestamp_ns.now_unix_ns ()) ?(attrs = []) (i : int) : ?(now = Timestamp_ns.now_unix_ns ()) ?(attrs = []) (i : int) :
number_data_point = number_data_point =
let attributes = attrs |> List.map _conv_key_value in let attributes = attrs |> List.map _conv_key_value in
default_number_data_point ~start_time_unix_nano ~time_unix_nano:now make_number_data_point ~start_time_unix_nano ~time_unix_nano:now ~attributes
~attributes
~value:(As_int (Int64.of_int i)) ~value:(As_int (Int64.of_int i))
() ~exemplars:[] ()
(** Aggregation of a scalar metric, always with the current value *) (** Aggregation of a scalar metric, always with the current value *)
let gauge ~name ?description ?unit_ (l : number_data_point list) : t = let gauge ~name ?description ?unit_ (l : number_data_point list) : t =
let data = Gauge (default_gauge ~data_points:l ()) in let data = Gauge (make_gauge ~data_points:l ()) in
default_metric ~name ?description ?unit_ ~data () make_metric ~name ?description ?unit_ ~data ()
type aggregation_temporality = Metrics.aggregation_temporality = type aggregation_temporality = Metrics.aggregation_temporality =
| Aggregation_temporality_unspecified | Aggregation_temporality_unspecified
@ -1399,9 +1399,9 @@ module Metrics = struct
?(aggregation_temporality = Aggregation_temporality_cumulative) ?(aggregation_temporality = Aggregation_temporality_cumulative)
?is_monotonic (l : number_data_point list) : t = ?is_monotonic (l : number_data_point list) : t =
let data = let data =
Sum (default_sum ~data_points:l ?is_monotonic ~aggregation_temporality ()) Sum (make_sum ~data_points:l ?is_monotonic ~aggregation_temporality ())
in in
default_metric ~name ?description ?unit_ ~data () make_metric ~name ?description ?unit_ ~data ()
(** Histogram data (** Histogram data
@param count number of values in population (non negative) @param count number of values in population (non negative)
@ -1416,15 +1416,15 @@ module Metrics = struct
?(explicit_bounds = []) ?sum ~bucket_counts ~count () : ?(explicit_bounds = []) ?sum ~bucket_counts ~count () :
histogram_data_point = histogram_data_point =
let attributes = attrs |> List.map _conv_key_value in 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 () ~attributes ~exemplars ~bucket_counts ~explicit_bounds ~count ?sum ()
let histogram ~name ?description ?unit_ ?aggregation_temporality let histogram ~name ?description ?unit_ ?aggregation_temporality
(l : histogram_data_point list) : t = (l : histogram_data_point list) : t =
let data = let data =
Histogram (default_histogram ~data_points:l ?aggregation_temporality ()) Histogram (make_histogram ~data_points:l ?aggregation_temporality ())
in in
default_metric ~name ?description ?unit_ ~data () make_metric ~name ?description ?unit_ ~data ()
(* TODO: exponential history *) (* TODO: exponential history *)
(* TODO: summary *) (* TODO: summary *)
@ -1434,12 +1434,11 @@ module Metrics = struct
let make_resource_metrics ?service_name ?attrs (l : t list) : resource_metrics let make_resource_metrics ?service_name ?attrs (l : t list) : resource_metrics
= =
let lm = let lm =
default_scope_metrics ~scope:(Some Globals.instrumentation_library) make_scope_metrics ~scope:Globals.instrumentation_library ~metrics:l ()
~metrics:l ()
in in
let attributes = Globals.mk_attributes ?service_name ?attrs () in 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
default_resource_metrics ~scope_metrics:[ lm ] ~resource:(Some resource) () make_resource_metrics ~scope_metrics:[ lm ] ~resource ()
(** Emit some metrics to the collector (sync). This blocks until the backend (** Emit some metrics to the collector (sync). This blocks until the backend
has pushed the metrics into some internal queue, or discarded them. 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 trace_id = Option.map Trace_id.to_bytes trace_id in
let span_id = Option.map Span_id.to_bytes span_id in let span_id = Option.map Span_id.to_bytes span_id in
let body = _conv_value body 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 ?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 *) (** Make a log entry whose body is a string *)
let make_str ?time ?observed_time_unix_nano ?severity ?log_level ?flags let make_str ?time ?observed_time_unix_nano ?severity ?log_level ?flags
@ -1569,14 +1568,11 @@ module Logs = struct
cause deadlocks. *) cause deadlocks. *)
let emit ?service_name ?attrs (l : t list) : unit = let emit ?service_name ?attrs (l : t list) : unit =
let attributes = Globals.mk_attributes ?service_name ?attrs () in 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 = let ll =
default_scope_logs ~scope:(Some Globals.instrumentation_library) make_scope_logs ~scope:Globals.instrumentation_library ~log_records:l ()
~log_records:l ()
in
let rl =
default_resource_logs ~resource:(Some resource) ~scope_logs:[ ll ] ()
in in
let rl = make_resource_logs ~resource ~scope_logs:[ ll ] () in
Collector.send_logs [ rl ] ~ret:ignore Collector.send_logs [ rl ] ~ret:ignore
end end

View file

@ -193,8 +193,9 @@ module Internal = struct
let status : Span_status.t = let status : Span_status.t =
match List.assoc_opt Well_known.status_error_key attrs with match List.assoc_opt Well_known.status_error_key attrs with
| Some (`String message) -> { message; code = Status_code_error } | Some (`String message) ->
| _ -> { message = ""; code = Status_code_ok } Span_status.make ~message ~code:Status_code_error
| _ -> Span_status.make ~message:"" ~code:Status_code_ok
in in
let attrs = let attrs =