refactor(cohttp): wrap in Server module

src/integrations/cohttp/README.md

@@ -1,11 +1,11 @@
 # Opentelemetry tracing for Cohttp_lwt servers
 
-Wrap your server callback with `Opentelemetry_cohttp_lwt.trace`:
+Wrap your server callback with `Opentelemetry_cohttp_lwt.Server.trace`:
 
 ```ocaml
 let my_server callback =
+  let callback =
+    Opentelemetry_cohttp_lwt.Server.trace ~service_name:"my-service" callback in
   Cohttp_lwt_unix.Server.create ~mode:(`TCP (`Port 8080))
-    (Server.make 
+    (Server.make () ~callback)
-      ~callback:(Opentelemetry_cohttp_lwt.trace ~service_name:"my-service" callback)
-      ())
 ```

src/integrations/cohttp/opentelemetry_cohttp_lwt.ml

@@ -3,58 +3,69 @@ module Otel_lwt = Opentelemetry_lwt
 open Cohttp
 open Cohttp_lwt
 
-type ('conn, 'body) callback =
+module Server : sig
-  'conn (* Cohttp_lwt_unix.Server.conn *)
+  (** Trace requests to a Cohttp server.
-  -> Request.t
-  -> 'body (* Cohttp_lwt.Body.t *)
-  -> (Response.t * 'body) Lwt.t
 
-let span_attrs (req : Request.t) =
+      Use it like this:
-  let meth = req |> Request.meth |> Code.string_of_method in
-  let referer = Header.get (Request.headers req) "referer" in
-  let host = Header.get (Request.headers req) "host" in
-  let ua = Header.get (Request.headers req) "user-agent" in
-  let uri = Request.uri req in
-  List.concat
-    [ [ ("http.method", `String meth) ]
-    ; (match host with None -> [] | Some h -> [ ("http.host", `String h) ])
-    ; [ ("http.url", `String (Uri.to_string uri)) ]
-    ; ( match ua with
-        | None ->
-           []
-        | Some ua ->
-           [ ("http.user_agent", `String ua) ] )
-    ; ( match referer with
-        | None ->
-           []
-        | Some r ->
-           [ ("http.request.header.referer", `String r) ] )
-    ]
 
-let trace_context_of_headers req =
+          let my_server callback =
-  let module Traceparent = Otel.Trace_context.Traceparent in
+            let callback =
-  match Header.get (Request.headers req) Traceparent.name with
+              Opentelemetry_cohttp_lwt.Server.trace ~service_name:"my-service" callback in
-  | None -> None, None
+            Cohttp_lwt_unix.Server.create ~mode:(`TCP (`Port 8080))
-  | Some v ->
+              (Server.make () ~callback)
-     (match Traceparent.of_value v with
+   *)
-      | Ok (trace_id, parent_id) -> (Some trace_id, Some parent_id)
+  val trace :
-      | Error _ -> None, None)
+    service_name:string ->
+    ('conn -> Request.t -> 'body -> (Response.t * 'body) Lwt.t) ->
+    'conn -> Request.t -> 'body -> (Response.t * 'body) Lwt.t
+end = struct
+  let span_attrs (req : Request.t) =
+    let meth = req |> Request.meth |> Code.string_of_method in
+    let referer = Header.get (Request.headers req) "referer" in
+    let host = Header.get (Request.headers req) "host" in
+    let ua = Header.get (Request.headers req) "user-agent" in
+    let uri = Request.uri req in
+    List.concat
+      [ [ ("http.method", `String meth) ]
+      ; (match host with None -> [] | Some h -> [ ("http.host", `String h) ])
+      ; [ ("http.url", `String (Uri.to_string uri)) ]
+      ; ( match ua with
+          | None ->
+             []
+          | Some ua ->
+             [ ("http.user_agent", `String ua) ] )
+      ; ( match referer with
+          | None ->
+             []
+          | Some r ->
+             [ ("http.request.header.referer", `String r) ] )
+      ]
 
-let trace ~service_name (callback : ('conn, 'body) callback ) : ('conn, 'body) callback =
+  let trace_context_of_headers req =
-  fun conn req body ->
+    let module Traceparent = Otel.Trace_context.Traceparent in
-  let trace_id, parent_id = trace_context_of_headers req in
+    match Header.get (Request.headers req) Traceparent.name with
-  let open Lwt.Syntax in
+    | None -> None, None
-  Otel_lwt.Trace.with_
+    | Some v ->
-    ~service_name
+       (match Traceparent.of_value v with
-    "request"
+        | Ok (trace_id, parent_id) -> (Some trace_id, Some parent_id)
-    ~kind:Span_kind_server
+        | Error _ -> None, None)
-    ~attrs:(span_attrs req)
+
-    ?parent:parent_id
+  let trace ~service_name callback =
-    ?trace_id
+    fun conn req body ->
-    (fun scope ->
+    let trace_id, parent_id = trace_context_of_headers req in
-      let* (res, body) = callback conn req body in
+    let open Lwt.Syntax in
-      Otel.Trace.add_attrs scope (fun () ->
+    Otel_lwt.Trace.with_
-          let code = Response.status res in
+      ~service_name
-          let code = Code.code_of_status code in
+      "request"
-          [ ("http.status_code", `Int code) ]) ;
+      ~kind:Span_kind_server
-      Lwt.return (res, body) )
+      ~attrs:(span_attrs req)
+      ?parent:parent_id
+      ?trace_id
+      (fun scope ->
+        let* (res, body) = callback conn req body 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