From e3fda50bb534970e1771b49b046913acd5530469 Mon Sep 17 00:00:00 2001
From: Romain Calascibetta <romain.calascibetta@gmail.com>
Date: Mon, 31 Oct 2022 15:30:42 +0100
Subject: [PATCH] Add a test about POST request

---
 test/dune    |  3 ++-
 test/test.ml | 50 +++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 51 insertions(+), 2 deletions(-)

diff --git a/test/dune b/test/dune
index 34b428b..09e6f9e 100644
--- a/test/dune
+++ b/test/dune
@@ -6,4 +6,5 @@
 
 (rule
  (alias runtest)
- (action (run ./test.exe --color=always)))
+ (action
+  (run ./test.exe --color=always)))
diff --git a/test/test.ml b/test/test.ml
index 8ff98c0..508ecd0 100644
--- a/test/test.ml
+++ b/test/test.ml
@@ -113,7 +113,55 @@ let test01 =
     let body = Buffer.contents buf in
     Alcotest.(check string) "body" "Hello World!" body ;
     Lwt.return_unit
+
+let random_string ~len =
+  let res = Bytes.create len in
+  for i = 0 to len - 1 do
+    Bytes.set res i (Char.chr (Random.bits () land 0xff))
+  done ; Bytes.unsafe_to_string res
+
+let test02 =
+  Alcotest_lwt.test_case "Repeat (POST)" `Quick @@ fun _sw () ->
+  let open Lwt.Syntax in
+  let stop = Lwt_switch.create () in
+  let handler reqd =
+    let open Httpaf in
+    let { Request.meth; _ } = Reqd.request reqd in
+    if meth <> `POST then invalid_arg "Invalid HTTP method" ;
+    let headers = Headers.of_list
+      [ "content-type", "text/plain" ] in
+    let response = Response.create ~headers `OK in
+    let src = Reqd.request_body reqd in
+    let dst = Reqd.respond_with_streaming reqd response in
+    let rec on_eof () =
+      Body.close_reader src ;
+      Body.close_writer dst
+    and on_read buf ~off ~len =
+      Body.write_bigstring dst ~off ~len buf ;
+      Body.schedule_read src ~on_eof ~on_read in
+    Body.schedule_read src ~on_eof ~on_read in
+  let* stack = stack Ipaddr.V4.Prefix.loopback in
+  let happy_eyeballs = Happy_eyeballs.create stack in
+  let* ctx = Mimic_happy_eyeballs.connect happy_eyeballs in
+  let* t = HTTP_client.connect ctx in
+  let* `Initialized _thread = server ~stop (Tcpip_stack_socket.V4V6.tcp stack)
+    (`HTTP_1_1 (8080, handler)) in
+  let str = random_string ~len:0x1000 in
+  let* result = Http_mirage_client.request ~meth:`POST ~body:str t "http://localhost:8080/"
+    (fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf)
+    (Buffer.create 0x1000) in
+  match result with
+  | Error err ->
+    let* () = Lwt_switch.turn_off stop in
+    let* () = Tcpip_stack_socket.V4V6.disconnect stack in
+    Alcotest.failf "Client error: %a" Mimic.pp_error err
+  | Ok (_response, buf) ->
+    let* () = Lwt_switch.turn_off stop in
+    let* () = Tcpip_stack_socket.V4V6.disconnect stack in
+    let body = Buffer.contents buf in
+    Alcotest.(check string) "body" str body ;
+    Lwt.return_unit
  
  let () = Alcotest_lwt.run "http-mirage-client"
-     [ "simple", [ test01 ] ]
+     [ "http/1.1", [ test01; test02 ] ]
    |> Lwt_main.run