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

fix integrations

Browse source
This commit is contained in:
Simon Cruanes 2025-12-04 15:30:14 -05:00
parent d02d609cf9
commit 00cf5aa712
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
3 changed files with 47 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
src/integrations/cohttp/opentelemetry_cohttp_lwt.ml
View file

@ -2,9 +2,16 @@ module Otel = Opentelemetry
module Otel_lwt = Opentelemetry_lwt module Otel_lwt = Opentelemetry_lwt
open Cohttp 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 module Server : sig
val trace : val trace :
?service_name:string -> ?tracer:Otel.Tracer.t ->
?attrs:Otel.Span.key_value list -> ?attrs:Otel.Span.key_value list ->
('conn -> Request.t -> 'body -> (Response.t * 'body) Lwt.t) -> ('conn -> Request.t -> 'body -> (Response.t * 'body) Lwt.t) ->
'conn -> 'conn ->
@ -27,8 +34,8 @@ module Server : sig
]} *) ]} *)
val with_ : val with_ :
?tracer:Otel.Tracer.t ->
?trace_state:string -> ?trace_state:string ->
?service_name:string ->
?attrs:Otel.Span.key_value list -> ?attrs:Otel.Span.key_value list ->
?kind:Otel.Span.kind -> ?kind:Otel.Span.kind ->
?links:Otel.Span_link.t list -> ?links:Otel.Span_link.t list ->
@ -76,11 +83,6 @@ end = struct
| Some r -> [ "http.request.header.referer", `String r ]); | 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 header_x_ocaml_otel_traceparent = "x-ocaml-otel-traceparent"
let set_trace_context (span : Otel.Span.t) req = let set_trace_context (span : Otel.Span.t) req =
@ -115,30 +117,33 @@ end = struct
in in
{ req with headers } { req with headers }
let trace ?service_name ?(attrs = []) callback conn req body = let trace ?(tracer = Otel.Tracer.get_main ()) ?(attrs = []) callback conn req
let scope = get_trace_context ~from:`External req in body =
Otel_lwt.Tracer.with_ "request" ~kind:Span_kind_server 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) ?trace_id:(Option.map Otel.Span.trace_id parent)
?parent:(Option.map Otel.Span.id parent) ?parent
~attrs:(attrs @ attrs_of_request req) ~attrs:(attrs @ attrs_of_request req)
(fun scope -> (fun span ->
let open Lwt.Syntax in 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 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)) Lwt.return (res, body))
let with_ ?trace_state ?attrs ?(kind = Otel.Span.Span_kind_internal) ?links let with_ ?(tracer = Otel.Tracer.get_main ()) ?trace_state ?attrs
name req (f : Request.t -> 'a Lwt.t) = ?(kind = Otel.Span.Span_kind_internal) ?links name req
(f : Request.t -> 'a Lwt.t) =
let span = get_trace_context ~from:`Internal req in 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 ?trace_id:(Option.map Otel.Span.trace_id span) ?parent:span ?links name
(fun span -> (fun span ->
let req = set_trace_context span in let req = set_trace_context span req in
f req) f req)
end 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 let module Traced = struct
open Lwt.Syntax 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 context_for ~uri ~meth =
let trace_id = Option.map Otel.Span.trace_id span in 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 let attrs = attrs_for ~uri ~meth () in
trace_id, parent, attrs trace_id, span, attrs
let add_traceparent (span : Otel.Span.t) headers = let add_traceparent (span : Otel.Span.t) headers =
let module Traceparent = Otel.Trace_context.Traceparent in 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) : let call ?ctx ?headers ?body ?chunked meth (uri : Uri.t) :
(Response.t * Cohttp_lwt.Body.t) Lwt.t = (Response.t * Cohttp_lwt.Body.t) Lwt.t =
let trace_id, parent, attrs = context_for ~uri ~meth in let trace_id, parent, attrs = context_for ~uri ~meth in
Otel_lwt.Trace.with_ "request" ~kind:Span_kind_client ?trace_id ?parent Otel_lwt.Tracer.with_ tracer "request" ~kind:Span_kind_client ?trace_id
~attrs (fun span -> ?parent ~attrs (fun span ->
let headers = add_traceparent span headers in let headers = add_traceparent span headers in
let* res, body = C.call ?ctx ~headers ?body ?chunked meth uri in let* res, body = C.call ?ctx ~headers ?body ?chunked meth uri in
Otel.Span.add_attrs span (fun () -> Otel.Span.add_attrs span (attrs_of_response res);
let code = Response.status res in
let code = Code.code_of_status code in
[ "http.status_code", `Int code ]);
Lwt.return (res, body)) Lwt.return (res, body))
let head ?ctx ?headers uri = 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 post_form ?ctx ?headers ~params uri =
let trace_id, parent, attrs = context_for ~uri ~meth:`POST in let trace_id, parent, attrs = context_for ~uri ~meth:`POST in
Otel_lwt.Trace.with_ "request" ~kind:Span_kind_client ?trace_id ?parent Otel_lwt.Tracer.with_ tracer "request" ~kind:Span_kind_client ?trace_id
~attrs (fun span -> ?parent ~attrs (fun span ->
let headers = add_traceparent scope headers in let headers = add_traceparent span headers in
let* res, body = C.post_form ?ctx ~headers ~params uri in let* res, body = C.post_form ?ctx ~headers ~params uri in
Otel.Span.add_attrs span (fun () -> Otel.Span.add_attrs span (attrs_of_response res);
let code = Response.status res in
let code = Code.code_of_status code in
[ "http.status_code", `Int code ]);
Lwt.return (res, body)) Lwt.return (res, body))
let callv = C.callv (* TODO *) let callv = C.callv (* TODO *)

16
src/integrations/logs/opentelemetry_logs.ml
View file

@ -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 *) (* Log a message to otel with some attrs *)
let log ?service_name ?(attrs = []) ?(scope = Otel.Ambient_span.get ()) ~level let log ?(logger = Otel.Logger.get_main ()) ?attrs
msg = ?(scope = Otel.Ambient_span.get ()) ~level msg =
let log_level = Logs.level_to_string (Some level) in let log_level = Logs.level_to_string (Some level) in
let span_id = Option.map Otel.Span.id scope in let span_id = Option.map Otel.Span.id scope in
let trace_id = Option.map Otel.Span.trace_id scope in let trace_id = Option.map Otel.Span.trace_id scope in
let severity = log_level_to_severity level in let severity = log_level_to_severity level in
let log = 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 in
(* Noop if no backend is set *) (* Noop if no backend is set *)
(* TODO: be more explicit *) (* 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 = let report src level ~over k msgf =
msgf (fun ?header ?(tags : Logs.Tag.set option) fmt -> msgf (fun ?header ?(tags : Logs.Tag.set option) fmt ->
let k _ = let k _ =
@ -91,13 +91,13 @@ let otel_reporter ?service_name ?(attributes = []) () : Logs.reporter =
let do_emit = let do_emit =
Option.value ~default:true (Logs.Tag.find emit_telemetry_tag tags) Option.value ~default:true (Logs.Tag.find emit_telemetry_tag tags)
in in
if do_emit then log ?service_name ~attrs ~level msg; if do_emit then log ~attrs ~level msg;
k ()) k ())
fmt) fmt)
in in
{ Logs.report } { 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 (* Copied directly from the Logs.mli docs. Just calls a bunch of reporters in a
row *) row *)
let combine r1 r2 = let combine r1 r2 =
@ -107,5 +107,5 @@ let attach_otel_reporter ?service_name ?attributes reporter =
in in
{ Logs.report } { Logs.report }
in in
let otel_reporter = otel_reporter ?service_name ?attributes () in let otel_reporter = otel_reporter ?attributes () in
combine reporter otel_reporter combine reporter otel_reporter

19
src/integrations/logs/opentelemetry_logs.mli
View file

@ -24,11 +24,8 @@ val emit_telemetry : bool -> Logs.Tag.set
{!emit_telemetry_tag} as its only member *) {!emit_telemetry_tag} as its only member *)
val otel_reporter : val otel_reporter :
?service_name:string -> ?attributes:(string * Opentelemetry.value) list -> unit -> Logs.reporter
?attributes:(string * Opentelemetry.value) list -> (** [otel_reporter ?tag_value_pp_buffer_size ?attrs ()] creates a
unit ->
Logs.reporter
(** [otel_reporter ?service_name ?tag_value_pp_buffer_size ?attrs ()] creates a
[Logs.reporter] that will create and emit an OTel log with the following [Logs.reporter] that will create and emit an OTel log with the following
info: info:
{ul {ul
@ -61,19 +58,17 @@ val otel_reporter :
Example use: [Logs.set_reporter (Opentelemetery_logs.otel_reporter ())] *) Example use: [Logs.set_reporter (Opentelemetery_logs.otel_reporter ())] *)
val attach_otel_reporter : val attach_otel_reporter :
?service_name:string ->
?attributes:(string * Opentelemetry.value) list -> ?attributes:(string * Opentelemetry.value) list ->
Logs.reporter -> Logs.reporter ->
Logs.reporter Logs.reporter
(** [attach_otel_reporter ?service_name ?attributes reporter] will create a (** [attach_otel_reporter ?attributes reporter] will create a reporter that
reporter that first calls the reporter passed as an argument, then an otel first calls the reporter passed as an argument, then an otel report created
report created via {!otel_reporter}, for every log. This is useful for if via {!otel_reporter}, for every log. This is useful for if you want to emit
you want to emit logs to stderr and to OTel at the same time. logs to stderr and to OTel at the same time.
Example: Example:
{[ {[
let reporter = Logs_fmt.reporter () in let reporter = Logs_fmt.reporter () in
Logs.set_reporter Logs.set_reporter
(Opentelemetry_logs.attach_otel_reporter ?service_name ?attributes (Opentelemetry_logs.attach_otel_reporter ?attributes reporter)
reporter)
]} *) ]} *)