simon/ocaml-opentelemetry
1
0
Fork 0
mirror of https://github.com/ocaml-tracing/ocaml-opentelemetry.git synced 2026-03-07 18:37:56 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixes

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

7
src/client/signal.ml
View file

@ -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

104
src/core/opentelemetry.ml
View file

@ -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

5
src/trace/opentelemetry_trace.ml
View file

@ -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 =