Be compatible with mimic-happy-eyeballs.0.0.9

This commit is contained in:
Calascibetta Romain 2024-07-11 08:44:29 +02:00
parent d3bc51eec9
commit 5e50d325de
3 changed files with 28 additions and 11 deletions

View file

@ -15,7 +15,7 @@ depends: [
"mirage-time" {>= "3.0.0"} "mirage-time" {>= "3.0.0"}
"tcpip" {>= "7.0.0"} "tcpip" {>= "7.0.0"}
"lwt" {>= "5.5.0"} "lwt" {>= "5.5.0"}
"mimic-happy-eyeballs" "mimic-happy-eyeballs" {>= "0.0.9"}
"httpaf" "httpaf"
"alcotest-lwt" {with-test} "alcotest-lwt" {with-test}
"mirage-clock-unix" {with-test & >= "4.0.0"} "mirage-clock-unix" {with-test & >= "4.0.0"}

View file

@ -1,6 +1,6 @@
(executable (executable
(name test) (name test)
(libraries http-mirage-client tcpip.stack-socket paf.mirage (libraries fmt.tty logs.fmt http-mirage-client tcpip.stack-socket paf.mirage
mirage-clock-unix mirage-crypto-rng mirage-time-unix mirage-clock-unix mirage-crypto-rng mirage-time-unix
mimic-happy-eyeballs alcotest-lwt)) mimic-happy-eyeballs alcotest-lwt))

View file

@ -1,16 +1,33 @@
(* Functoria *) let reporter ppf =
let report src level ~over k msgf =
let k _ =
over () ;
k () in
let with_metadata header _tags k ppf fmt =
Format.kfprintf k ppf
("%a[%a]: " ^^ fmt ^^ "\n%!")
Logs_fmt.pp_header (level, header)
Fmt.(styled `Magenta string)
(Logs.Src.name src) in
msgf @@ fun ?header ?tags fmt -> with_metadata header tags k ppf fmt in
{ Logs.report }
module DNS_client = let () = Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ()
Dns_client_mirage.Make (Mirage_crypto_rng) (Time) (Mclock) (Pclock) let () = Logs.set_reporter (reporter Fmt.stdout)
(Tcpip_stack_socket.V4V6) let () = Logs.set_level ~all:true (Some Logs.Debug)
(* Functoria *)
module Happy_eyeballs = module Happy_eyeballs =
Happy_eyeballs_mirage.Make (Time) (Mclock) (Tcpip_stack_socket.V4V6) Happy_eyeballs_mirage.Make (Time) (Mclock) (Tcpip_stack_socket.V4V6)
(DNS_client)
module DNS_client =
Dns_client_mirage.Make (Mirage_crypto_rng) (Time) (Mclock) (Pclock)
(Tcpip_stack_socket.V4V6) (Happy_eyeballs)
module Mimic_happy_eyeballs = module Mimic_happy_eyeballs =
Mimic_happy_eyeballs.Make (Tcpip_stack_socket.V4V6) (DNS_client) Mimic_happy_eyeballs.Make (Tcpip_stack_socket.V4V6) (Happy_eyeballs)
(Happy_eyeballs) (DNS_client)
module HTTP_server = Paf_mirage.Make (Tcpip_stack_socket.V4V6.TCP) module HTTP_server = Paf_mirage.Make (Tcpip_stack_socket.V4V6.TCP)
@ -149,7 +166,7 @@ let test01 =
server ~stop (Tcpip_stack_socket.V4V6.tcp stack) (`HTTP_1_1 (8080, handler)) server ~stop (Tcpip_stack_socket.V4V6.tcp stack) (`HTTP_1_1 (8080, handler))
in in
let* result = let* result =
Http_mirage_client.request t "http://localhost:8080/" Http_mirage_client.request t "http://127.0.0.1:8080/"
(fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf) (fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf)
(Buffer.create 0x100) in (Buffer.create 0x100) in
match result with match result with
@ -197,7 +214,7 @@ let test02 =
in in
let str = random_string ~len:0x1000 in let str = random_string ~len:0x1000 in
let* result = let* result =
Http_mirage_client.request ~meth:`POST ~body:str t "http://localhost:8080/" Http_mirage_client.request ~meth:`POST ~body:str t "http://127.0.0.1:8080/"
(fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf) (fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf)
(Buffer.create 0x1000) in (Buffer.create 0x1000) in
match result with match result with