Be compatible with mimic-happy-eyeballs.0.0.9
This commit is contained in:
parent
d3bc51eec9
commit
5e50d325de
3 changed files with 28 additions and 11 deletions
|
@ -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"}
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
|
|
35
test/test.ml
35
test/test.ml
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue