From c5e789c2d897a325327adccc87206d493fdb528f Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Thu, 24 Mar 2022 18:47:45 +0000 Subject: [PATCH 1/6] wip(cohttp): traced client --- .../cohttp/opentelemetry_cohttp_lwt.ml | 47 +++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml index f6f7e72d..cc11ccc1 100644 --- a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml +++ b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml @@ -145,3 +145,50 @@ end = struct let req = set_trace_context scope req in f req) end + +let client ?(scope : Otel.Trace.scope option) (module C : Cohttp_lwt.S.Client) = + let module Traced : Cohttp_lwt.S.Client = struct + include C + open Lwt.Syntax + + let attrs_for ~uri ~meth () = + [ ("http.method", `String (Code.string_of_method `GET)) + ; ("http.url", `String (Uri.to_string uri)) + ] + + let context_for ~uri ~meth = + let trace_id = match scope with | 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 + (trace_id, parent, attrs) + + let add_traceparent headers = + match scope with + | None -> headers + | Some scope -> + let module Traceparent = Otel.Trace_context.Traceparent in + let headers = match headers with | None -> Header.init () | Some headers -> headers in + let headers = + Header.add headers Traceparent.name + (Traceparent.to_value ~trace_id:scope.trace_id ~parent_id:scope.span_id ()) + in + Some headers + + let get ?ctx ?headers (uri : Uri.t) : (Response.t * Cohttp_lwt.Body.t) Lwt.t = + let (trace_id, parent, attrs) = context_for ~uri ~meth:`GET in + Otel_lwt.Trace.with_ "request" + ~kind:Span_kind_client + ?trace_id + ?parent + ~attrs + (fun scope -> + let headers = add_traceparent headers in + let* (res, body) = C.get ?ctx ?headers uri in + Otel.Trace.add_attrs scope (fun () -> + let code = Response.status res in + let code = Code.code_of_status code in + [ ("http.status_code", `Int code) ]) ; + Lwt.return (res, body)) + end + in + (module Traced : Cohttp_lwt.S.Client) From c8391fc522d0bef772fe1ddc2b22c613c5a5f7eb Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Thu, 24 Mar 2022 19:44:33 +0000 Subject: [PATCH 2/6] test(cohttp): client bin --- tests/bin/cohttp_client.ml | 59 ++++++++++++++++++++++++++++++++++++++ tests/bin/dune | 6 ++++ 2 files changed, 65 insertions(+) create mode 100644 tests/bin/cohttp_client.ml diff --git a/tests/bin/cohttp_client.ml b/tests/bin/cohttp_client.ml new file mode 100644 index 00000000..9070b30a --- /dev/null +++ b/tests/bin/cohttp_client.ml @@ -0,0 +1,59 @@ +module T = Opentelemetry +module Otel_lwt = Opentelemetry_lwt +let spf = Printf.sprintf +let (let@) f x = f x + +let sleep_inner = ref 0.1 +let sleep_outer = ref 2.0 + +let mk_client ~scope = Opentelemetry_cohttp_lwt.client ~scope (module Cohttp_lwt_unix.Client) + +let run () = + Printf.printf "collector is on %S\n%!" (Opentelemetry_client_ocurl.get_url()); + let open Lwt.Syntax in + let rec go () = + let@ scope = + Otel_lwt.Trace.with_ + ~kind:T.Span.Span_kind_producer + "loop.outer" + in + let* () = Lwt_unix.sleep !sleep_outer in + let module C = (val mk_client ~scope) in + let* (res, body) = C.get (Uri.of_string "https://enec1hql02hz.x.pipedream.net") in + let* () = Cohttp_lwt.Body.drain_body body in + go () + in + go () + +let () = + Sys.catch_break true; + T.Globals.service_name := "ocaml-otel-cohttp-client"; + T.Globals.service_namespace := Some "ocaml-otel.test"; + + let debug = ref false in + let thread = ref true in + let batch_traces = ref 400 in + let batch_metrics = ref 3 in + let opts = [ + "--debug", Arg.Bool ((:=) debug), " enable debug output"; + "--thread", Arg.Bool ((:=) thread), " use a background thread"; + "--batch-traces", Arg.Int ((:=) batch_traces), " size of traces batch"; + "--batch-metrics", Arg.Int ((:=) batch_metrics), " size of metrics batch"; + "--sleep-inner", Arg.Set_float sleep_inner, " sleep (in s) in inner loop"; + "--sleep-outer", Arg.Set_float sleep_outer, " sleep (in s) in outer loop"; + ] |> Arg.align in + + Arg.parse opts (fun _ -> ()) "emit1 [opt]*"; + + let some_if_nzero r = if !r > 0 then Some !r else None in + let config = Opentelemetry_client_ocurl.Config.make + ~debug:!debug + ~batch_traces:(some_if_nzero batch_traces) + ~batch_metrics:(some_if_nzero batch_metrics) + ~thread:!thread () in + Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ config: %a@]@." + !sleep_outer !sleep_inner Opentelemetry_client_ocurl.Config.pp config; + + Format.printf "Check HTTP requests at https://requestbin.com/r/enec1hql02hz/26qShWryt5vJc1JfrOwalhr5vQt@."; + + Opentelemetry_client_ocurl.with_setup ~config () (fun () -> Lwt_main.run (run ())) diff --git a/tests/bin/dune b/tests/bin/dune index d41bf219..639b3ec4 100644 --- a/tests/bin/dune +++ b/tests/bin/dune @@ -1,3 +1,9 @@ (executable (name emit1) + (modules emit1) (libraries unix opentelemetry opentelemetry-client-ocurl)) + +(executable + (name cohttp_client) + (modules cohttp_client) + (libraries cohttp-lwt-unix opentelemetry opentelemetry-client-ocurl opentelemetry-cohttp-lwt)) From 32fec9b2f5b9f5650ab0844db6750b5a11784e60 Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Thu, 24 Mar 2022 20:40:55 +0000 Subject: [PATCH 3/6] chore(cohttp): trace more methods --- .../cohttp/opentelemetry_cohttp_lwt.ml | 25 ++++++++++++++++--- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml index cc11ccc1..64802204 100644 --- a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml +++ b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml @@ -174,8 +174,8 @@ let client ?(scope : Otel.Trace.scope option) (module C : Cohttp_lwt.S.Client) in Some headers - let get ?ctx ?headers (uri : Uri.t) : (Response.t * Cohttp_lwt.Body.t) Lwt.t = - let (trace_id, parent, attrs) = context_for ~uri ~meth:`GET in + 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 @@ -183,12 +183,29 @@ let client ?(scope : Otel.Trace.scope option) (module C : Cohttp_lwt.S.Client) ~attrs (fun scope -> let headers = add_traceparent headers in - let* (res, body) = C.get ?ctx ?headers uri in + let* (res, body) = C.call ?ctx ?headers ?body ?chunked meth uri in Otel.Trace.add_attrs scope (fun () -> let code = Response.status res in let code = Code.code_of_status code in [ ("http.status_code", `Int code) ]) ; Lwt.return (res, body)) - end + + let head ?ctx ?headers uri = + let open Lwt.Infix in + call ?ctx ?headers `HEAD uri >|= fst + + let get ?ctx ?headers uri = call ?ctx ?headers `GET uri + + let delete ?ctx ?body ?chunked ?headers uri = + call ?ctx ?headers ?body ?chunked `DELETE uri + + let post ?ctx ?body ?chunked ?headers uri = + call ?ctx ?headers ?body ?chunked `POST uri + + let put ?ctx ?body ?chunked ?headers uri = + call ?ctx ?headers ?body ?chunked `PUT uri + + let patch ?ctx ?body ?chunked ?headers uri = + call ?ctx ?headers ?body ?chunked `PATCH uri end in (module Traced : Cohttp_lwt.S.Client) From 82bcebbb895f746182bd07ae689eeee902b63d6c Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Thu, 24 Mar 2022 21:01:56 +0000 Subject: [PATCH 4/6] chore(cohttp): optional service_name --- src/integrations/cohttp/opentelemetry_cohttp_lwt.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml index 64802204..6fb98ec4 100644 --- a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml +++ b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml @@ -19,7 +19,7 @@ module Server : sig (Server.make () ~callback:callback_traced) *) val trace : - service_name:string -> + ?service_name:string -> ?attrs:Otel.Span.key_value list -> ('conn -> Request.t -> 'body -> (Response.t * 'body) Lwt.t) -> 'conn -> Request.t -> 'body -> (Response.t * 'body) Lwt.t @@ -112,11 +112,11 @@ end = struct let headers = Header.remove (Request.headers req) header_x_ocaml_otel_traceparent in { req with headers } - let trace ~service_name ?(attrs=[]) callback = + let trace ?service_name ?(attrs=[]) callback = fun conn req body -> let scope = get_trace_context ~from:`External req in Otel_lwt.Trace.with_ - ~service_name + ?service_name "request" ~kind:Span_kind_server ?trace_id:(Option.map (fun scope -> scope.Otel.Trace.trace_id) scope) From 5e8affe508339ff6557da56319c4ecc4ebfd0365 Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Thu, 24 Mar 2022 22:06:02 +0000 Subject: [PATCH 5/6] fix(cohttp): use correct scope for traceparent header --- .../cohttp/opentelemetry_cohttp_lwt.ml | 20 +++++++------------ 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml index 6fb98ec4..57432fe4 100644 --- a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml +++ b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml @@ -162,17 +162,11 @@ let client ?(scope : Otel.Trace.scope option) (module C : Cohttp_lwt.S.Client) let attrs = attrs_for ~uri ~meth () in (trace_id, parent, attrs) - let add_traceparent headers = - match scope with - | None -> headers - | Some scope -> - let module Traceparent = Otel.Trace_context.Traceparent in - let headers = match headers with | None -> Header.init () | Some headers -> headers in - let headers = - Header.add headers Traceparent.name - (Traceparent.to_value ~trace_id:scope.trace_id ~parent_id:scope.span_id ()) - in - Some headers + let add_traceparent (scope : Otel.Trace.scope) headers = + let module Traceparent = Otel.Trace_context.Traceparent in + let headers = match headers with | None -> Header.init () | Some headers -> headers in + Header.add headers Traceparent.name + (Traceparent.to_value ~trace_id:scope.trace_id ~parent_id:scope.span_id ()) 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 @@ -182,8 +176,8 @@ let client ?(scope : Otel.Trace.scope option) (module C : Cohttp_lwt.S.Client) ?parent ~attrs (fun scope -> - let headers = add_traceparent headers in - let* (res, body) = C.call ?ctx ?headers ?body ?chunked meth uri in + let headers = add_traceparent scope headers in + let* (res, body) = C.call ?ctx ~headers ?body ?chunked meth uri in Otel.Trace.add_attrs scope (fun () -> let code = Response.status res in let code = Code.code_of_status code in From 0ad2d3f64178dd4ff93e0d1e80fd708ec321f4d6 Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Thu, 24 Mar 2022 23:10:11 +0000 Subject: [PATCH 6/6] feat(cohttp): trace post_form --- .../cohttp/opentelemetry_cohttp_lwt.ml | 28 +++++++++++++++++-- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml index 57432fe4..f2293c67 100644 --- a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml +++ b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml @@ -147,8 +147,7 @@ end = struct end let client ?(scope : Otel.Trace.scope option) (module C : Cohttp_lwt.S.Client) = - let module Traced : Cohttp_lwt.S.Client = struct - include C + let module Traced = struct open Lwt.Syntax let attrs_for ~uri ~meth () = @@ -168,6 +167,8 @@ let client ?(scope : Otel.Trace.scope option) (module C : Cohttp_lwt.S.Client) Header.add headers Traceparent.name (Traceparent.to_value ~trace_id:scope.trace_id ~parent_id:scope.span_id ()) + type ctx = C.ctx + 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" @@ -200,6 +201,27 @@ let client ?(scope : Otel.Trace.scope option) (module C : Cohttp_lwt.S.Client) call ?ctx ?headers ?body ?chunked `PUT uri let patch ?ctx ?body ?chunked ?headers uri = - call ?ctx ?headers ?body ?chunked `PATCH uri end + call ?ctx ?headers ?body ?chunked `PATCH uri + + 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 scope -> + let headers = add_traceparent scope headers in + let* (res, body) = + C.post_form ?ctx ~headers ~params uri + in + Otel.Trace.add_attrs scope (fun () -> + let code = Response.status res in + let code = Code.code_of_status code in + [ ("http.status_code", `Int code) ]) ; + Lwt.return (res, body)) + + let callv = C.callv (* TODO *) + end in (module Traced : Cohttp_lwt.S.Client)