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 (lwt
(>= "5.3")) (>= "5.3"))
(cohttp-lwt (cohttp-lwt
(and (>= "6.0.0"))
(>= "4.0.0")
(< "6")))
(alcotest :with-test)) (alcotest :with-test))
(synopsis "Opentelemetry tracing for Cohttp HTTP servers")) (synopsis "Opentelemetry tracing for Cohttp HTTP servers"))

View file

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

View file

@ -1,7 +1,6 @@
module Otel = Opentelemetry module Otel = Opentelemetry
module Otel_lwt = Opentelemetry_lwt module Otel_lwt = Opentelemetry_lwt
open Cohttp open Cohttp
open Cohttp_lwt
module Server : sig module Server : sig
val trace : val trace :
@ -144,6 +143,17 @@ let client ?(scope : Otel.Scope.t option) (module C : Cohttp_lwt.S.Client) =
let module Traced = struct let module Traced = struct
open Lwt.Syntax 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:_ () = let attrs_for ~uri ~meth:_ () =
[ [
"http.method", `String (Code.string_of_method `GET); "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 (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) : 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