From 00cf5aa712193bcd8624d2930ce9b28dc28c36a3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 4 Dec 2025 15:30:14 -0500 Subject: [PATCH] fix integrations --- .../cohttp/opentelemetry_cohttp_lwt.ml | 66 +++++++++---------- src/integrations/logs/opentelemetry_logs.ml | 16 ++--- src/integrations/logs/opentelemetry_logs.mli | 19 ++---- 3 files changed, 47 insertions(+), 54 deletions(-) diff --git a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml index 2ac0ed3d..13d21438 100644 --- a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml +++ b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml @@ -2,9 +2,16 @@ module Otel = Opentelemetry module Otel_lwt = Opentelemetry_lwt open Cohttp +open struct + let attrs_of_response (res : Response.t) = + let code = Response.status res in + let code = Code.code_of_status code in + [ "http.status_code", `Int code ] +end + module Server : sig val trace : - ?service_name:string -> + ?tracer:Otel.Tracer.t -> ?attrs:Otel.Span.key_value list -> ('conn -> Request.t -> 'body -> (Response.t * 'body) Lwt.t) -> 'conn -> @@ -27,8 +34,8 @@ module Server : sig ]} *) val with_ : + ?tracer:Otel.Tracer.t -> ?trace_state:string -> - ?service_name:string -> ?attrs:Otel.Span.key_value list -> ?kind:Otel.Span.kind -> ?links:Otel.Span_link.t list -> @@ -76,11 +83,6 @@ end = struct | Some r -> [ "http.request.header.referer", `String r ]); ] - let attrs_of_response (res : Response.t) = - let code = Response.status res in - let code = Code.code_of_status code in - [ "http.status_code", `Int code ] - let header_x_ocaml_otel_traceparent = "x-ocaml-otel-traceparent" let set_trace_context (span : Otel.Span.t) req = @@ -115,30 +117,33 @@ end = struct in { req with headers } - let trace ?service_name ?(attrs = []) callback conn req body = - let scope = get_trace_context ~from:`External req in - Otel_lwt.Tracer.with_ "request" ~kind:Span_kind_server + let trace ?(tracer = Otel.Tracer.get_main ()) ?(attrs = []) callback conn req + body = + let parent = get_trace_context ~from:`External req in + Otel_lwt.Tracer.with_ tracer "request" ~kind:Span_kind_server ?trace_id:(Option.map Otel.Span.trace_id parent) - ?parent:(Option.map Otel.Span.id parent) + ?parent ~attrs:(attrs @ attrs_of_request req) - (fun scope -> + (fun span -> let open Lwt.Syntax in - let req = set_trace_context scope req in + let req = set_trace_context span req in let* res, body = callback conn req body in - Otel.Span.add_attrs scope (fun () -> attrs_of_response res); + Otel.Span.add_attrs span (attrs_of_response res); Lwt.return (res, body)) - let with_ ?trace_state ?attrs ?(kind = Otel.Span.Span_kind_internal) ?links - name req (f : Request.t -> 'a Lwt.t) = + let with_ ?(tracer = Otel.Tracer.get_main ()) ?trace_state ?attrs + ?(kind = Otel.Span.Span_kind_internal) ?links name req + (f : Request.t -> 'a Lwt.t) = let span = get_trace_context ~from:`Internal req in - Otel_lwt.Trace.with_ ?trace_state ?attrs ~kind + Otel_lwt.Tracer.with_ tracer ?trace_state ?attrs ~kind ?trace_id:(Option.map Otel.Span.trace_id span) ?parent:span ?links name (fun span -> - let req = set_trace_context span in + let req = set_trace_context span req in f req) end -let client ?(span : Otel.Span.t option) (module C : Cohttp_lwt.S.Client) = +let client ?(tracer = Otel.Tracer.get_main ()) ?(span : Otel.Span.t option) + (module C : Cohttp_lwt.S.Client) = let module Traced = struct open Lwt.Syntax @@ -168,9 +173,8 @@ let client ?(span : Otel.Span.t option) (module C : Cohttp_lwt.S.Client) = let context_for ~uri ~meth = let trace_id = Option.map Otel.Span.trace_id span in - let parent = Option.map Otel.Span.id span in let attrs = attrs_for ~uri ~meth () in - trace_id, parent, attrs + trace_id, span, attrs let add_traceparent (span : Otel.Span.t) headers = let module Traceparent = Otel.Trace_context.Traceparent in @@ -186,14 +190,11 @@ let client ?(span : Otel.Span.t option) (module C : Cohttp_lwt.S.Client) = let call ?ctx ?headers ?body ?chunked meth (uri : Uri.t) : (Response.t * Cohttp_lwt.Body.t) Lwt.t = let trace_id, parent, attrs = context_for ~uri ~meth in - Otel_lwt.Trace.with_ "request" ~kind:Span_kind_client ?trace_id ?parent - ~attrs (fun span -> + Otel_lwt.Tracer.with_ tracer "request" ~kind:Span_kind_client ?trace_id + ?parent ~attrs (fun span -> let headers = add_traceparent span headers in let* res, body = C.call ?ctx ~headers ?body ?chunked meth uri in - Otel.Span.add_attrs span (fun () -> - let code = Response.status res in - let code = Code.code_of_status code in - [ "http.status_code", `Int code ]); + Otel.Span.add_attrs span (attrs_of_response res); Lwt.return (res, body)) let head ?ctx ?headers uri = @@ -216,14 +217,11 @@ let client ?(span : Otel.Span.t option) (module C : Cohttp_lwt.S.Client) = let post_form ?ctx ?headers ~params uri = let trace_id, parent, attrs = context_for ~uri ~meth:`POST in - Otel_lwt.Trace.with_ "request" ~kind:Span_kind_client ?trace_id ?parent - ~attrs (fun span -> - let headers = add_traceparent scope headers in + Otel_lwt.Tracer.with_ tracer "request" ~kind:Span_kind_client ?trace_id + ?parent ~attrs (fun span -> + let headers = add_traceparent span headers in let* res, body = C.post_form ?ctx ~headers ~params uri in - Otel.Span.add_attrs span (fun () -> - let code = Response.status res in - let code = Code.code_of_status code in - [ "http.status_code", `Int code ]); + Otel.Span.add_attrs span (attrs_of_response res); Lwt.return (res, body)) let callv = C.callv (* TODO *) diff --git a/src/integrations/logs/opentelemetry_logs.ml b/src/integrations/logs/opentelemetry_logs.ml index a91f2e44..16b1b513 100644 --- a/src/integrations/logs/opentelemetry_logs.ml +++ b/src/integrations/logs/opentelemetry_logs.ml @@ -34,20 +34,20 @@ let emit_telemetry do_emit = Logs.Tag.(empty |> add emit_telemetry_tag do_emit) (*****************************************************************************) (* Log a message to otel with some attrs *) -let log ?service_name ?(attrs = []) ?(scope = Otel.Ambient_span.get ()) ~level - msg = +let log ?(logger = Otel.Logger.get_main ()) ?attrs + ?(scope = Otel.Ambient_span.get ()) ~level msg = let log_level = Logs.level_to_string (Some level) in let span_id = Option.map Otel.Span.id scope in let trace_id = Option.map Otel.Span.trace_id scope in let severity = log_level_to_severity level in let log = - Otel.Log_record.make_str ~severity ~log_level ?trace_id ?span_id msg + Otel.Log_record.make_str ~severity ~log_level ?attrs ?trace_id ?span_id msg in (* Noop if no backend is set *) (* TODO: be more explicit *) - Otel.Logger.emit ?service_name ~attrs [ log ] + Otel.Emitter.emit logger [ log ] -let otel_reporter ?service_name ?(attributes = []) () : Logs.reporter = +let otel_reporter ?(attributes = []) () : Logs.reporter = let report src level ~over k msgf = msgf (fun ?header ?(tags : Logs.Tag.set option) fmt -> let k _ = @@ -91,13 +91,13 @@ let otel_reporter ?service_name ?(attributes = []) () : Logs.reporter = let do_emit = Option.value ~default:true (Logs.Tag.find emit_telemetry_tag tags) in - if do_emit then log ?service_name ~attrs ~level msg; + if do_emit then log ~attrs ~level msg; k ()) fmt) in { Logs.report } -let attach_otel_reporter ?service_name ?attributes reporter = +let attach_otel_reporter ?attributes reporter = (* Copied directly from the Logs.mli docs. Just calls a bunch of reporters in a row *) let combine r1 r2 = @@ -107,5 +107,5 @@ let attach_otel_reporter ?service_name ?attributes reporter = in { Logs.report } in - let otel_reporter = otel_reporter ?service_name ?attributes () in + let otel_reporter = otel_reporter ?attributes () in combine reporter otel_reporter diff --git a/src/integrations/logs/opentelemetry_logs.mli b/src/integrations/logs/opentelemetry_logs.mli index 7ac4e594..43fadb8f 100644 --- a/src/integrations/logs/opentelemetry_logs.mli +++ b/src/integrations/logs/opentelemetry_logs.mli @@ -24,11 +24,8 @@ val emit_telemetry : bool -> Logs.Tag.set {!emit_telemetry_tag} as its only member *) val otel_reporter : - ?service_name:string -> - ?attributes:(string * Opentelemetry.value) list -> - unit -> - Logs.reporter -(** [otel_reporter ?service_name ?tag_value_pp_buffer_size ?attrs ()] creates a + ?attributes:(string * Opentelemetry.value) list -> unit -> Logs.reporter +(** [otel_reporter ?tag_value_pp_buffer_size ?attrs ()] creates a [Logs.reporter] that will create and emit an OTel log with the following info: {ul @@ -61,19 +58,17 @@ val otel_reporter : Example use: [Logs.set_reporter (Opentelemetery_logs.otel_reporter ())] *) val attach_otel_reporter : - ?service_name:string -> ?attributes:(string * Opentelemetry.value) list -> Logs.reporter -> Logs.reporter -(** [attach_otel_reporter ?service_name ?attributes reporter] will create a - reporter that first calls the reporter passed as an argument, then an otel - report created via {!otel_reporter}, for every log. This is useful for if - you want to emit logs to stderr and to OTel at the same time. +(** [attach_otel_reporter ?attributes reporter] will create a reporter that + first calls the reporter passed as an argument, then an otel report created + via {!otel_reporter}, for every log. This is useful for if you want to emit + logs to stderr and to OTel at the same time. Example: {[ let reporter = Logs_fmt.reporter () in Logs.set_reporter - (Opentelemetry_logs.attach_otel_reporter ?service_name ?attributes - reporter) + (Opentelemetry_logs.attach_otel_reporter ?attributes reporter) ]} *)