diff --git a/src/lwt/opentelemetry_lwt.ml b/src/lwt/opentelemetry_lwt.ml index cfd06a5e..dc7f2f0f 100644 --- a/src/lwt/opentelemetry_lwt.ml +++ b/src/lwt/opentelemetry_lwt.ml @@ -3,6 +3,7 @@ open Lwt.Syntax module Span_id = Span_id module Trace_id = Trace_id +module Event = Event module Span = Span module Globals = Globals module Timestamp_ns = Timestamp_ns diff --git a/src/opentelemetry.ml b/src/opentelemetry.ml index f9948875..aa82fafa 100644 --- a/src/opentelemetry.ml +++ b/src/opentelemetry.ml @@ -184,7 +184,46 @@ module Globals = struct List.rev_append (List.filter not_redundant global_attributes) into end -(* TODO: Event.t, use it in Span *) +type key_value = string * [`Int of int | `String of string | `Bool of bool | `None] + +(**/**) +let _conv_key_value (k,v) = + let open Proto.Common in + let value = match v with + | `Int i -> Some (Int_value (Int64.of_int i)) + | `String s -> Some (String_value s) + | `Bool b -> Some (Bool_value b) + | `None -> None + in + default_key_value ~key:k ~value () + +(**/**) + +(** Events. + + Events occur at a given time and can carry attributes. They always + belong in a span. *) +module Event : sig + open Proto.Trace + type t = span_event + + val make : + ?time_unix_nano:Timestamp_ns.t -> + ?attrs:key_value list -> + string -> + t + +end = struct + open Proto.Trace + type t = span_event + + 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 () +end (** Spans. @@ -226,6 +265,7 @@ module Span : sig ?trace_state:string -> ?service_name:string -> ?attrs:key_value list -> + ?events:Event.t list -> ?status:status -> trace_id:Trace_id.t -> ?parent:id -> @@ -273,6 +313,7 @@ end = struct ?trace_state ?(service_name= !Globals.service_name) ?(attrs=[]) + ?(events=[]) ?status ~trace_id ?parent ?(links=[]) ~start_time ~end_time @@ -318,7 +359,7 @@ end = struct default_span ~trace_id ?parent_span_id ~span_id:(Span_id.to_bytes id) - ~attributes + ~attributes ~events ?trace_state ~status ~kind ~name ~links ~start_time_unix_nano:start_time @@ -345,13 +386,27 @@ module Trace = struct let rs = default_resource_spans ~instrumentation_library_spans:[ils] () in Collector.send_trace [rs] ~over:(fun () -> ()) ~ret:(fun () -> ()) + (** Scope to be used with {!with_}. *) + type scope = { + trace_id: Trace_id.t; + span_id: Span_id.t; + mutable events: Event.t list; + } + + (** Add an event to the scope. It will be aggregated into the span *) + let[@inline] add_event (scope:scope) (ev:Event.t) : unit = + scope.events <- ev :: scope.events + (** Sync span guard *) let with_ ?trace_state ?service_name ?attrs ?kind ?(trace_id=Trace_id.create()) ?parent ?links - name (f:Trace_id.t * Span_id.t -> 'a) : 'a = + name (f: scope -> 'a) : 'a = + let start_time = Timestamp_ns.now_unix_ns() in let span_id = Span_id.create() in + let scope = {trace_id;span_id;events=[]} in + let finally ok = let status = match ok with | Ok () -> default_status ~code:Status_code_ok () @@ -359,14 +414,14 @@ module Trace = struct let span, _ = Span.create ?kind ~trace_id ?parent ?links ~id:span_id - ?trace_state ?service_name ?attrs + ?trace_state ?service_name ?attrs ~events:scope.events ~start_time ~end_time:(Timestamp_ns.now_unix_ns()) ~status name in emit [span]; in try - let x = f (trace_id,span_id) in + let x = f scope in finally (Ok ()); x with e -> diff --git a/tests/emit1.ml b/tests/emit1.ml index f9eaff21..357c00fe 100644 --- a/tests/emit1.ml +++ b/tests/emit1.ml @@ -7,13 +7,13 @@ let run () = Printf.printf "collector is on %S\n%!" (Opentelemetry_client_ocurl.get_url()); let i = ref 0 in while true do - let@ (tr,sp) = T.Trace.with_ ~kind:T.Span.Span_kind_producer + let@ scope = T.Trace.with_ ~kind:T.Span.Span_kind_producer "loop.outer" ~attrs:["i", `Int !i] in for j=0 to 4 do - let@ (_,sp) = T.Trace.with_ ~kind:T.Span.Span_kind_internal - ~trace_id:tr ~parent:sp + let@ scope = T.Trace.with_ ~kind:T.Span.Span_kind_internal + ~trace_id:scope.trace_id ~parent:scope.span_id ~attrs:["j", `Int j] "loop.inner" in Unix.sleepf 2.; @@ -31,13 +31,15 @@ let run () = (try let@ _ = T.Trace.with_ ~kind:T.Span.Span_kind_internal - ~trace_id:tr ~parent:sp + ~trace_id:scope.trace_id ~parent:scope.span_id "alloc" in (* allocate some stuff *) let _arr = Sys.opaque_identity @@ Array.make (25 * 25551) 42.0 in ignore _arr; Unix.sleepf 0.1; if j=4 && !i mod 13 = 0 then failwith "oh no"; (* simulate a failure *) + + T.Trace.add_event scope @@ T.Event.make "done with alloc"; with Failure _ -> ()); done;