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

fixes after we removed Scope

Browse source
This commit is contained in:
Simon Cruanes 2025-12-04 01:07:50 -05:00
parent a643bc6c02
commit b64ba8fbcd
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 34 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -43,11 +43,11 @@ module Server : sig
convenience. *) convenience. *)
val get_trace_context : val get_trace_context :
?from:[ `Internal | `External ] -> Request.t -> Otel.Scope.t option ?from:[ `Internal | `External ] -> Request.t -> Otel.Span.t option
(** Get the tracing scope from the custom [x-ocaml-otel-traceparent] header (** Get the tracing scope from the custom [x-ocaml-otel-traceparent] header
added by [trace] and [with_]. *) added by [trace] and [with_]. *)
val set_trace_context : Otel.Scope.t -> Request.t -> Request.t val set_trace_context : Otel.Span.t -> Request.t -> Request.t
(** Set the tracing scope in the custom [x-ocaml-otel-traceparent] header used (** Set the tracing scope in the custom [x-ocaml-otel-traceparent] header used
by [trace] and [with_]. *) by [trace] and [with_]. *)
@ -83,16 +83,16 @@ end = struct
let header_x_ocaml_otel_traceparent = "x-ocaml-otel-traceparent" let header_x_ocaml_otel_traceparent = "x-ocaml-otel-traceparent"
let set_trace_context (scope : Otel.Scope.t) req = let set_trace_context (span : Otel.Span.t) req =
let module Traceparent = Otel.Trace_context.Traceparent in let module Traceparent = Otel.Trace_context.Traceparent in
let headers = let headers =
Header.add (Request.headers req) header_x_ocaml_otel_traceparent Header.add (Request.headers req) header_x_ocaml_otel_traceparent
(Traceparent.to_value ~trace_id:scope.trace_id ~parent_id:scope.span_id (Traceparent.to_value ~trace_id:(Otel.Span.trace_id span)
()) ~parent_id:(Otel.Span.id span) ())
in in
{ req with headers } { req with headers }
let get_trace_context ?(from = `Internal) req = let get_trace_context ?(from = `Internal) req : Otel.Span.t option =
let module Traceparent = Otel.Trace_context.Traceparent in let module Traceparent = Otel.Trace_context.Traceparent in
let name = let name =
match from with match from with
@ -104,7 +104,9 @@ end = struct
| Some v -> | Some v ->
(match Traceparent.of_value v with (match Traceparent.of_value v with
| Ok (trace_id, parent_id) -> | Ok (trace_id, parent_id) ->
Some (Otel.Scope.make ~trace_id ~span_id:parent_id ()) (* TODO: we need a span_ctx here actually *)
Some
(Otel.Span.make ~trace_id ~id:parent_id ~start_time:0L ~end_time:0L "")
| Error _ -> None) | Error _ -> None)
let remove_trace_context req = let remove_trace_context req =
@ -115,31 +117,28 @@ end = struct
let trace ?service_name ?(attrs = []) callback conn req body = let trace ?service_name ?(attrs = []) callback conn req body =
let scope = get_trace_context ~from:`External req in let scope = get_trace_context ~from:`External req in
Otel_lwt.Trace.with_ ?service_name "request" ~kind:Span_kind_server Otel_lwt.Tracer.with_ "request" ~kind:Span_kind_server
?trace_id:(Option.map (fun scope -> scope.Otel.Trace.trace_id) scope) ?trace_id:(Option.map Otel.Span.trace_id parent)
?parent:(Option.map (fun scope -> scope.Otel.Trace.span_id) scope) ?parent:(Option.map Otel.Span.id parent)
~attrs:(attrs @ attrs_of_request req) ~attrs:(attrs @ attrs_of_request req)
(fun scope -> (fun scope ->
let open Lwt.Syntax in let open Lwt.Syntax in
let req = set_trace_context scope req in let req = set_trace_context scope req in
let* res, body = callback conn req body in let* res, body = callback conn req body in
Otel.Scope.add_attrs scope (fun () -> attrs_of_response res); Otel.Span.add_attrs scope (fun () -> attrs_of_response res);
Lwt.return (res, body)) Lwt.return (res, body))
let with_ ?trace_state ?service_name ?attrs let with_ ?trace_state ?attrs ?(kind = Otel.Span.Span_kind_internal) ?links
?(kind = Otel.Span.Span_kind_internal) ?links name req name req (f : Request.t -> 'a Lwt.t) =
(f : Request.t -> 'a Lwt.t) = let span = get_trace_context ~from:`Internal req in
let scope = get_trace_context ~from:`Internal req in Otel_lwt.Trace.with_ ?trace_state ?attrs ~kind
Otel_lwt.Trace.with_ ?trace_state ?service_name ?attrs ~kind ?trace_id:(Option.map Otel.Span.trace_id span) ?parent:span ?links name
?trace_id:(Option.map (fun scope -> scope.Otel.Trace.trace_id) scope) (fun span ->
?parent:(Option.map (fun scope -> scope.Otel.Trace.span_id) scope) let req = set_trace_context span in
?links name
(fun scope ->
let req = set_trace_context scope req in
f req) f req)
end end
let client ?(scope : Otel.Scope.t option) (module C : Cohttp_lwt.S.Client) = let client ?(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,20 +167,12 @@ let client ?(scope : Otel.Scope.t option) (module C : Cohttp_lwt.S.Client) =
] ]
let context_for ~uri ~meth = let context_for ~uri ~meth =
let trace_id = let trace_id = Option.map Otel.Span.trace_id span in
match scope with let parent = Option.map Otel.Span.id span in
| Some scope -> Some scope.trace_id
| None -> None
in
let parent =
match scope with
| Some scope -> Some scope.span_id
| None -> None
in
let attrs = attrs_for ~uri ~meth () in let attrs = attrs_for ~uri ~meth () in
trace_id, parent, attrs trace_id, parent, attrs
let add_traceparent (scope : Otel.Scope.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
let headers = let headers =
match headers with match headers with
@ -189,17 +180,17 @@ let client ?(scope : Otel.Scope.t option) (module C : Cohttp_lwt.S.Client) =
| Some headers -> headers | Some headers -> headers
in in
Header.add headers Traceparent.name Header.add headers Traceparent.name
(Traceparent.to_value ~trace_id:scope.trace_id ~parent_id:scope.span_id (Traceparent.to_value ~trace_id:(Otel.Span.trace_id span)
()) ~parent_id:(Otel.Span.id span) ())
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.Trace.with_ "request" ~kind:Span_kind_client ?trace_id ?parent
~attrs (fun scope -> ~attrs (fun span ->
let headers = add_traceparent scope 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.Scope.add_attrs scope (fun () -> Otel.Span.add_attrs span (fun () ->
let code = Response.status res in let code = Response.status res in
let code = Code.code_of_status code in let code = Code.code_of_status code in
[ "http.status_code", `Int code ]); [ "http.status_code", `Int code ]);
@ -226,10 +217,10 @@ let client ?(scope : Otel.Scope.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.Trace.with_ "request" ~kind:Span_kind_client ?trace_id ?parent
~attrs (fun scope -> ~attrs (fun span ->
let headers = add_traceparent scope headers in let headers = add_traceparent scope 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.Scope.add_attrs scope (fun () -> Otel.Span.add_attrs span (fun () ->
let code = Response.status res in let code = Response.status res in
let code = Code.code_of_status code in let code = Code.code_of_status code in
[ "http.status_code", `Int code ]); [ "http.status_code", `Int code ]);

6
src/lwt/opentelemetry_lwt.ml
View file

@ -21,10 +21,10 @@ module Tracer = struct
(** Sync span guard *) (** Sync span guard *)
let with_ ?force_new_trace_id ?trace_state ?attrs ?kind ?trace_id ?parent let with_ ?force_new_trace_id ?trace_state ?attrs ?kind ?trace_id ?parent
?scope ?links name (cb : Scope.t -> 'a Lwt.t) : 'a Lwt.t = ?links name (cb : Span.t -> 'a Lwt.t) : 'a Lwt.t =
let thunk, finally = let thunk, finally =
with_' ?force_new_trace_id ?trace_state ?attrs ?kind ?trace_id ?parent with_thunk_and_finally ?force_new_trace_id ?trace_state ?attrs ?kind
?scope ?links name cb ?trace_id ?parent ?links name cb
in in
try%lwt try%lwt