Update to support cohttp 6

Preparation for Cohttp 6 started in
2022 (https://github.com/mirage/ocaml-cohttp/blob/main/CHANGES.md#v600alpha0-2022-10-24)
and 6 has been stable and released since Nov of 2024.
See https://github.com/mirage/ocaml-cohttp/blob/main/CHANGES.md#v600-2024-11-21

Removal of the `open Cohttp_lwt` solves deprecation warnings issued by
Cohttp 6, since everything we were using from the open has been moved
into `Cohttp`.
This commit is contained in:
Shon Feder 2025-05-25 21:36:09 -04:00
parent 92de45a2ec
commit 894158339e
No known key found for this signature in database
3 changed files with 13 additions and 7 deletions

View file

@ -101,9 +101,7 @@
(lwt
(>= "5.3"))
(cohttp-lwt
(and
(>= "4.0.0")
(< "6")))
(>= "6.0.0"))
(alcotest :with-test))
(synopsis "Opentelemetry tracing for Cohttp HTTP servers"))

View file

@ -18,7 +18,7 @@ depends: [
"opentelemetry-lwt" {= version}
"odoc" {with-doc}
"lwt" {>= "5.3"}
"cohttp-lwt" {>= "4.0.0" & < "6"}
"cohttp-lwt" {>= "6.0.0"}
"alcotest" {with-test}
]
build: [

View file

@ -1,7 +1,6 @@
module Otel = Opentelemetry
module Otel_lwt = Opentelemetry_lwt
open Cohttp
open Cohttp_lwt
module Server : sig
val trace :
@ -144,6 +143,17 @@ let client ?(scope : Otel.Scope.t option) (module C : Cohttp_lwt.S.Client) =
let module Traced = struct
open Lwt.Syntax
(* These types and values are not customized by our client, but are required to satisfy
[Cohttp_lwt.S.Client]. *)
include (C : sig
type ctx = C.ctx
type 'a io = 'a C.io
type 'a with_context = 'a C.with_context
type body = C.body
val map_context : 'a with_context -> ('a -> 'b) -> 'b with_context
val set_cache : Cohttp_lwt.S.call -> unit
end)
let attrs_for ~uri ~meth:_ () =
[
"http.method", `String (Code.string_of_method `GET);
@ -175,8 +185,6 @@ let client ?(scope : Otel.Scope.t option) (module C : Cohttp_lwt.S.Client) =
(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