filter empty strings in list/pipe/stream

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 []

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

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)))

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

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

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 -> ""

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)))

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;
+    ]
+  ]