diff --git a/cohttp-async/src/body_raw.ml b/cohttp-async/src/body_raw.ml index 56211da172..7404bfc717 100644 --- a/cohttp-async/src/body_raw.ml +++ b/cohttp-async/src/body_raw.ml @@ -9,7 +9,7 @@ type t = [ let empty = `Empty let of_string s = ((B.of_string s) :> t) -let of_pipe p = `Pipe p +let of_pipe p = `Pipe (Pipe.filter ~f:(fun s -> String.(s <> "")) p) let to_string = function | #B.t as body -> return (B.to_string body) @@ -26,14 +26,23 @@ let drain = function let is_empty (body:t) = match body with | #B.t as body -> return (B.is_empty body) - | `Pipe s -> - Pipe.values_available s - >>| function - |`Eof -> true - |`Ok -> - match Pipe.peek s with - | None -> true - | Some _ -> false + | `Pipe pipe -> + Deferred.repeat_until_finished () @@ fun () -> + Pipe.values_available pipe + >>= function + | `Eof -> return (`Finished true) + | `Ok -> begin + match Pipe.peek pipe with + | None -> return (`Finished true) + | Some "" -> + begin + Pipe.read pipe + >>| function + | `Eof -> `Finished true + | `Ok _ -> `Repeat () + end + | Some _ -> return (`Finished false) + end let to_pipe = function | `Empty -> Pipe.of_list [] diff --git a/cohttp-async/test/test_async_integration.ml b/cohttp-async/test/test_async_integration.ml index 2519ca7438..a1cfeb22e4 100644 --- a/cohttp-async/test/test_async_integration.ml +++ b/cohttp-async/test/test_async_integration.ml @@ -107,15 +107,24 @@ let ts = let check_body_empty_status () = let is_empty = Cohttp_async.Body.is_empty in let tests = [ - Pipe.of_list [], true - ; Pipe.of_list ["foo"; "bar"], false - ; Pipe.of_list [""; "baz"], false] + "empty pipe", Pipe.of_list [], true + ; "pipe with elements", Pipe.of_list ["foo"; "bar"], false + ; "pipe with empty items at the beginning", Pipe.of_list [""; "baz"], false + ; "Pipe with empty strings", Pipe.of_list [""; ""; ""], true] in - Deferred.List.iter tests ~f:(fun (pipe, expected) -> + Deferred.List.iter tests ~f:(fun (msg, pipe, expected) -> is_empty (`Pipe pipe) >>| fun real -> - assert_equal expected real; + assert_equal ~msg expected real; ) + >>= fun () -> + let b = Pipe.of_list [""; ""; "foo"; "bar"] in + is_empty (`Pipe b) + >>= fun _ -> + Pipe.to_list b + >>| fun real -> + let msg = "Checking if pipe is empty consumes all leading empty strings" in + assert_equal ~msg ["foo"; "bar"] real in [ "empty chunk test", empty_chunk ; "large response", large_response diff --git a/cohttp-lwt-unix/test/dune b/cohttp-lwt-unix/test/dune index 81011c0aad..27f300a195 100644 --- a/cohttp-lwt-unix/test/dune +++ b/cohttp-lwt-unix/test/dune @@ -27,3 +27,13 @@ (name runtest) (package cohttp-lwt-unix) (action (run ./test_sanity_noisy.exe))) + +(executable + (modules test_body) + (name test_body) + (libraries cohttp_lwt_unix_test cohttp-lwt-unix)) + +(alias + (name runtest) + (package cohttp-lwt-unix) + (action (run ./test_body.exe))) diff --git a/cohttp-lwt-unix/test/test_body.ml b/cohttp-lwt-unix/test/test_body.ml new file mode 100644 index 0000000000..5e68679fbc --- /dev/null +++ b/cohttp-lwt-unix/test/test_body.ml @@ -0,0 +1,57 @@ +open Lwt +open Lwt.Infix +open OUnit + +module Body = Cohttp_lwt.Body + +let run_test f = + Lwt.try_bind f (fun () -> return `Ok) (fun exn -> return (`Exn exn)) + +let test_empty_body () = + Body.is_empty (`Stream (Lwt_stream.of_list [])) + >|= fun res -> + assert_equal true res + +let test_non_empty_stream () = + Body.is_empty (`Stream (Lwt_stream.of_list ["foo"; "bar"])) + >|= fun res -> + assert_equal false res + +let test_stream_with_leading_empty_strings () = + let s = Lwt_stream.of_list [""; ""; "foo"; ""; "bar"] in + Body.is_empty (`Stream s) + >>= fun res -> + assert_equal false res; + Lwt_stream.to_list s + >|= fun res -> + assert_equal ~msg:"is_empty should consume leading spaces" ["foo"; ""; "bar"] res + +let test_stream_empty_strings () = + Body.is_empty (`Stream (Lwt_stream.of_list [""; ""; ""])) + >|= fun res -> + assert_equal true res + +let tests = + [ "Empty stream", test_empty_body + ; "Non empty stream", test_non_empty_stream + ; "Stream with leading empty strings", test_stream_with_leading_empty_strings + ; "Stream with empty strings", test_stream_empty_strings ] + +let test_suite = + Lwt_list.map_s (fun (title, test) -> + run_test test + >|= fun res -> (title, res) + ) tests + >|= fun results -> + let tests = + ListLabels.map results ~f:(fun (title, res) -> + title >:: fun () -> + match res with + | `Ok -> () + | `Exn exn -> raise exn + ) + in + "Cohttp_Lwt.Body" >::: tests + +let _ = + test_suite |> Cohttp_lwt_unix_test.run_async_tests |> Lwt_main.run diff --git a/cohttp-lwt/src/body.ml b/cohttp-lwt/src/body.ml index 0550280066..cfc8d28f60 100644 --- a/cohttp-lwt/src/body.ml +++ b/cohttp-lwt/src/body.ml @@ -42,7 +42,10 @@ let create_stream fn arg = let is_empty (body:t) = match body with | #Body.t as body -> return (Body.is_empty body) - | `Stream s -> Lwt_stream.is_empty s + | `Stream s -> + Lwt_stream.get_while (fun x -> x = "") s + >>= fun _ -> + Lwt_stream.is_empty s let to_string (body:t) = match body with diff --git a/cohttp/src/body.ml b/cohttp/src/body.ml index bac0a1d54e..948f600ee1 100644 --- a/cohttp/src/body.ml +++ b/cohttp/src/body.ml @@ -26,10 +26,12 @@ let empty = `Empty let is_empty = function | `Empty - | `String "" - | `Strings [] -> true - | `String _ - | `Strings _ -> false + | `String "" -> true + | `String _ -> false + | `Strings xs -> + match List.filter (fun s -> s <> "") xs with + | [] -> true + | _ -> false let to_string = function | `Empty -> "" diff --git a/cohttp/test/dune b/cohttp/test/dune index 0c044849a0..ef7adfb384 100644 --- a/cohttp/test/dune +++ b/cohttp/test/dune @@ -27,3 +27,13 @@ (name runtest) (package cohttp) (action (run ./test_request.exe))) + +(executable + (name test_body) + (modules test_body) + (libraries cohttp alcotest fmt)) + +(alias + (name runtest) + (package cohttp) + (action (run ./test_body.exe))) diff --git a/cohttp/test/test_body.ml b/cohttp/test/test_body.ml new file mode 100644 index 0000000000..605ba11cc9 --- /dev/null +++ b/cohttp/test/test_body.ml @@ -0,0 +1,18 @@ +let test_if_body_empty () = + let tests = Cohttp.Body.[ + "empty string", of_string "", true + ; "empty list of strings", of_string_list [], true + ; "list of strings with empty bytes", of_string_list [""; ""; ""], true + ; "non empty list of strings", of_string_list [""; "foo"; "bar"], false + ] in + List.iter (fun (name, body, expected) -> + Alcotest.(check bool) name (Cohttp.Body.is_empty body) expected + ) tests + +let () = + Printexc.record_backtrace true; + Alcotest.run "test_body" [ + "Query body information", [ + "Check if body is empty", `Quick, test_if_body_empty; + ] + ]