diff --git a/lib_test/helpers.ml b/lib_test/helpers.ml index 7bfb68cb..9ce0be45 100644 --- a/lib_test/helpers.ml +++ b/lib_test/helpers.ml @@ -61,3 +61,13 @@ end let write_operation = Alcotest.of_pp Write_operation.pp_hum let read_operation = Alcotest.of_pp Read_operation.pp_hum + +module Headers = struct + include Headers + + let (@) a b = Headers.add_list a (Headers.to_list b) + + let connection_close = Headers.of_list ["connection", "close"] + let encoding_chunked = Headers.of_list ["transfer-encoding", "chunked"] + let encoding_fixed n = Headers.of_list ["content-length", string_of_int n] +end diff --git a/lib_test/test_client_connection.ml b/lib_test/test_client_connection.ml index 1209ebc6..4075c590 100644 --- a/lib_test/test_client_connection.ml +++ b/lib_test/test_client_connection.ml @@ -99,9 +99,7 @@ let test_get () = read_response t response; (* Single GET, response closes connection *) - let response = - Response.create `OK ~headers:(Headers.of_list [ "connection", "close" ]) - in + let response = Response.create `OK ~headers:Headers.connection_close in let body, t = request request' @@ -116,9 +114,7 @@ let test_get () = connection_is_shutdown t; (* Single GET, streaming body *) - let response = - Response.create `OK ~headers:(Headers.of_list [ "transfer-encoding", "chunked" ]) - in + let response = Response.create `OK ~headers:Headers.encoding_chunked in let body, t = request request' @@ -257,9 +253,7 @@ let test_failed_response_parse () = test "HTTP/1.1 200\r\n\r\n" 12 (`Malformed_response ": char ' '"); - let response = - Response.create `OK ~headers:(Headers.of_list ["Content-length", "-1"]) - in + let response = Response.create `OK ~headers:(Headers.encoding_fixed (-1)) in test (response_to_string response) 39 (`Invalid_response_body_length response); ;; diff --git a/lib_test/test_server_connection.ml b/lib_test/test_server_connection.ml index d775847e..a7352911 100644 --- a/lib_test/test_server_connection.ml +++ b/lib_test/test_server_connection.ml @@ -66,6 +66,17 @@ let write_eof t = report_write_result t `Closed; ;; +let writer_ready t = + let is_write = + Alcotest.testable Write_operation.pp_hum (fun a b -> + match a, b with + | `Write _, `Write _ -> true + | _ -> false) + in + Alcotest.check is_write "Writer is ready" + (`Write []) (next_write_operation t); +;; + let writer_yielded t = Alcotest.check write_operation "Writer is in a yield state" `Yield (next_write_operation t); @@ -155,14 +166,14 @@ let test_single_get () = (* Single GET, close the connection *) let t = create default_request_handler in - read_request t (Request.create `GET "/" ~headers:(Headers.of_list ["connection", "close"])); + read_request t (Request.create `GET "/" ~headers:Headers.connection_close); write_response t (Response.create `OK); connection_is_shutdown t; (* Single GET, with reponse body *) let response_body = "This is a test" in let t = create (request_handler_with_body response_body) in - read_request t (Request.create `GET "/" ~headers:(Headers.of_list ["connection", "close"])); + read_request t (Request.create `GET "/" ~headers:Headers.connection_close); write_response t ~body:response_body (Response.create `OK); @@ -173,21 +184,14 @@ let test_asynchronous_response () = let response_body = "hello, world!" in let response_body_length = String.length response_body in let response = - Response.create - `OK - ~headers:(Headers.of_list [("content-length", string_of_int response_body_length)]) - in + Response.create `OK ~headers:(Headers.encoding_fixed response_body_length) in let continue = ref (fun () -> ()) in let t = create (fun reqd -> continue := fun () -> Body.close_reader (Reqd.request_body reqd); let data = Bigstringaf.of_string ~off:0 ~len:response_body_length response_body in let size = Bigstringaf.length data in - let response = - Response.create - `OK - ~headers:(Headers.of_list [("content-length", string_of_int size)]) - in + let response = Response.create `OK ~headers:(Headers.encoding_fixed size) in let response_body = Reqd.respond_with_streaming reqd response in Body.write_bigstring response_body data; @@ -206,12 +210,10 @@ let test_asynchronous_response () = ;; let test_echo_post () = - let request = Request.create `GET "/" ~headers:(Headers.of_list ["transfer-encoding", "chunked"]) in + let request = Request.create `GET "/" ~headers:Headers.encoding_chunked in (* Echo a single chunk *) - let response = - Response.create `OK ~headers:(Headers.of_list ["transfer-encoding", "chunked"]) - in + let response = Response.create `OK ~headers:Headers.encoding_chunked in let t = create (echo_handler response) in read_request t request; read_string t "e\r\nThis is a test"; @@ -223,9 +225,7 @@ let test_echo_post () = writer_yielded t; (* Echo two chunks *) - let response = - Response.create `OK ~headers:(Headers.of_list ["transfer-encoding", "chunked"]) - in + let response = Response.create `OK ~headers:Headers.encoding_chunked in let t = create (echo_handler response) in read_request t request; read_string t "e\r\nThis is a test"; @@ -240,7 +240,7 @@ let test_echo_post () = (* Echo and close *) let response = - Response.create `OK ~headers:(Headers.of_list ["connection", "close"]) + Response.create `OK ~headers:Headers.connection_close in let t = create (echo_handler response) in read_request t request; @@ -268,7 +268,7 @@ let test_streaming_response () = ;; let test_asynchronous_streaming_response () = - let request = Request.create `GET "/" ~headers:(Headers.of_list ["connection", "close"]) in + let request = Request.create `GET "/" ~headers:Headers.connection_close in let response = Response.create `OK in let body = ref None in @@ -310,7 +310,7 @@ let test_asynchronous_streaming_response () = ;; let test_asynchronous_streaming_response_with_immediate_flush () = - let request = Request.create `GET "/" ~headers:(Headers.of_list ["connection", "close"]) in + let request = Request.create `GET "/" ~headers:Headers.connection_close in let response = Response.create `OK in let body = ref None in @@ -346,10 +346,7 @@ let test_asynchronous_streaming_response_with_immediate_flush () = let test_empty_fixed_streaming_response () = let request = Request.create `GET "/" in - let response = - Response.create `OK - ~headers:(Headers.of_list ["Content-length", "0"]) - in + let response = Response.create `OK ~headers:(Headers.encoding_fixed 0) in let t = create (streaming_handler response []) in read_request t request; @@ -359,10 +356,7 @@ let test_empty_fixed_streaming_response () = let test_empty_chunked_streaming_response () = let request = Request.create `GET "/" in - let response = - Response.create `OK - ~headers:(Headers.of_list ["Transfer-encoding", "chunked"]) - in + let response = Response.create `OK ~headers:Headers.encoding_chunked in let t = create (streaming_handler response []) in read_request t request; @@ -490,10 +484,7 @@ let test_asynchronous_error_asynchronous_handling () = let test_chunked_encoding () = let request_handler reqd = - let response = - Response.create `OK - ~headers:(Headers.of_list [ "Transfer-encoding", "chunked" ]) - in + let response = Response.create `OK ~headers:Headers.encoding_chunked in let resp_body = Reqd.respond_with_streaming reqd response in Body.write_string resp_body "First chunk"; Body.flush resp_body (fun () -> @@ -506,7 +497,7 @@ let test_chunked_encoding () = write_response t ~msg:"First chunk written" ~body:"b\r\nFirst chunk\r\n" - (Response.create `OK ~headers:(Headers.of_list ["Transfer-encoding", "chunked"])); + (Response.create `OK ~headers:Headers.encoding_chunked); write_string t ~msg:"Second chunk" "c\r\nSecond chunk\r\n"; @@ -519,10 +510,7 @@ let test_chunked_encoding () = let test_blocked_write_on_chunked_encoding () = let request_handler reqd = - let response = - Response.create `OK - ~headers:(Headers.of_list [ "Transfer-encoding", "chunked" ]) - in + let response = Response.create `OK ~headers:Headers.encoding_chunked in let resp_body = Reqd.respond_with_streaming reqd response in Body.write_string resp_body "gets partially written"; (* Response body never gets closed but for the purposes of the test, that's @@ -531,7 +519,7 @@ let test_blocked_write_on_chunked_encoding () = let t = create ~error_handler request_handler in writer_yielded t; read_request t (Request.create `GET "/"); - let first_write = "HTTP/1.1 200 OK\r\nTransfer-encoding: chunked\r\n\r\n16\r\ngets partially written\r\n" in + let first_write = "HTTP/1.1 200 OK\r\ntransfer-encoding: chunked\r\n\r\n16\r\ngets partially written\r\n" in Alcotest.(check (option string)) "first write" (Some first_write) (next_write_operation t |> Write_operation.to_write_as_string); @@ -619,10 +607,7 @@ let test_failed_request_parse () = let test_bad_request () = (* A `Bad_request is returned in a number of cases surrounding transfer-encoding or content-length headers. *) - let request = - Request.create `GET "/" - ~headers:(Headers.of_list ["content-length", "-1"]) - in + let request = Request.create `GET "/" ~headers:(Headers.encoding_fixed (-1)) in let error_handler_fired = ref false in let error_handler ?request:request' error start_response = error_handler_fired := true; @@ -710,6 +695,23 @@ let test_parse_failure_after_checkpoint () = | Some error -> Alcotest.(check request_error) "Error" error `Bad_request ;; +let test_response_finished_before_body_read () = + let response = Response.create `OK in + let body = ref None in + let request_handler reqd = + body := Some (Reqd.request_body reqd); + Reqd.respond_with_string reqd response "" + in + let t = create request_handler in + read_request t (Request.create `GET "/" ~headers:(Headers.encoding_fixed 5)); + write_response t response; + Body.close_reader (Option.get !body); + (* Finish the request and send another *) + read_string t "hello"; + read_request t (Request.create `GET "/"); + write_response t response; +;; + let tests = [ "initial reader state" , `Quick, test_initial_reader_state ; "shutdown reader closed", `Quick, test_reader_is_closed_after_eof @@ -736,4 +738,5 @@ let tests = ; "multiple requests in single read", `Quick, test_multiple_requests_in_single_read ; "multiple async requests in single read", `Quick, test_multiple_async_requests_in_single_read ; "parse failure after checkpoint", `Quick, test_parse_failure_after_checkpoint + ; "response finished before body read", `Quick, test_response_finished_before_body_read ]