Integration testing ability for async backend

_oasis

@@ -35,6 +35,15 @@ Library cohttp
   XMETARequires: re.emacs, stringext, uri, uri.services, fieldslib,
                  sexplib, bytes, base64
 
+Library cohttp_test
+  Build$:        flag(tests)
+  Install:       false
+  Path:          lib
+  Findlibname:   test
+  FindlibParent: cohttp
+  Modules:       Cohttp_test
+  BuildDepends:  cohttp, oUnit
+
 Flag lwt
   Description: build the Lwt library
   Default:     false
@@ -104,9 +113,18 @@ Library cohttp_lwt_unix_test
   Path:          lwt
   Findlibname:   lwt-unix-test
   FindlibParent: cohttp
-  BuildDepends:  cohttp.lwt, unix, lwt.unix, oUnit
+  BuildDepends:  cohttp.test, cohttp.lwt, unix, lwt.unix, oUnit
   Modules:       Cohttp_lwt_unix_test
 
+Library cohttp_async_test
+  Build$:        flag(async) && flag(tests)
+  Install:       false
+  Path:          async
+  Findlibname:   async-test
+  FindlibParent: cohttp
+  BuildDepends:  cohttp.test, cohttp.async, oUnit
+  Modules:       Cohttp_async_test
+
 Document cohttp
   Title:                Cohttp docs
   Type:                 ocamlbuild (0.3)
@@ -286,6 +304,15 @@ Executable test_net_async_server
   Install:            false
   BuildDepends:       cohttp, cohttp.async, oUnit (>= 1.0.2)
 
+Executable test_async_integration
+  Path:               lib_test
+  MainIs:             test_async_integration.ml
+  Build$:             flag(tests) && flag(async)
+  Custom:             true
+  CompiledObject:     best
+  Install:            false
+  BuildDepends:       cohttp.async-test
+
 Executable "cohttp-server-async"
   Path:               bin
   MainIs:             cohttp_server_async.ml
@@ -406,6 +433,11 @@ Test test_sanity
   Command:          $test_sanity
   WorkingDirectory: lib_test
 
+Test test_async_integration
+  Run$:             flag(tests) && flag(async)
+  Command:          $test_async_integration
+  WorkingDirectory: lib_test
+
 SourceRepository master
   Type:     git
   Location: https://github.com/mirage/ocaml-cohttp.git

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 5fa3841c8dc3c29fb17f88da786b068b)
+# DO NOT EDIT (digest: ca939fa07e91bbabbbe072870f7f76b4)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -35,16 +35,20 @@ true: annot, bin_annot
 "lib/body.cmx": for-pack(Cohttp)
 "lib/string_io.cmx": for-pack(Cohttp)
 "lib/conf.cmx": for-pack(Cohttp)
+# Library cohttp_test
+"lib/cohttp_test.cmxs": use_cohttp_test
 <lib/*.ml{,i,y}>: pkg_base64
 <lib/*.ml{,i,y}>: pkg_bytes
 <lib/*.ml{,i,y}>: pkg_fieldslib
 <lib/*.ml{,i,y}>: pkg_fieldslib.syntax
+<lib/*.ml{,i,y}>: pkg_oUnit
 <lib/*.ml{,i,y}>: pkg_re.emacs
 <lib/*.ml{,i,y}>: pkg_sexplib
 <lib/*.ml{,i,y}>: pkg_sexplib.syntax
 <lib/*.ml{,i,y}>: pkg_stringext
 <lib/*.ml{,i,y}>: pkg_uri
 <lib/*.ml{,i,y}>: pkg_uri.services
+<lib/*.ml{,i,y}>: use_cohttp
 # Library cohttp_lwt
 "lwt/cohttp_lwt.cmxs": use_cohttp_lwt
 # Library cohttp_lwt_unix
@@ -69,21 +73,6 @@ true: annot, bin_annot
 <js/*.ml{,i,y}>: use_cohttp_lwt
 # Library cohttp_async
 "async/cohttp_async.cmxs": use_cohttp_async
-<async/*.ml{,i,y}>: pkg_async
-<async/*.ml{,i,y}>: pkg_base64
-<async/*.ml{,i,y}>: pkg_bytes
-<async/*.ml{,i,y}>: pkg_conduit.async
-<async/*.ml{,i,y}>: pkg_fieldslib
-<async/*.ml{,i,y}>: pkg_fieldslib.syntax
-<async/*.ml{,i,y}>: pkg_magic-mime
-<async/*.ml{,i,y}>: pkg_re.emacs
-<async/*.ml{,i,y}>: pkg_sexplib
-<async/*.ml{,i,y}>: pkg_sexplib.syntax
-<async/*.ml{,i,y}>: pkg_stringext
-<async/*.ml{,i,y}>: pkg_threads
-<async/*.ml{,i,y}>: pkg_uri
-<async/*.ml{,i,y}>: pkg_uri.services
-<async/*.ml{,i,y}>: use_cohttp
 # Library cohttp_lwt_unix_test
 "lwt/cohttp_lwt_unix_test.cmxs": use_cohttp_lwt_unix_test
 <lwt/*.ml{,i,y}>: pkg_base64
@@ -105,6 +94,27 @@ true: annot, bin_annot
 <lwt/*.ml{,i,y}>: use_cohttp
 <lwt/*.ml{,i,y}>: use_cohttp_lwt
 <lwt/*.ml{,i,y}>: use_cohttp_lwt_unix
+<lwt/*.ml{,i,y}>: use_cohttp_test
+# Library cohttp_async_test
+"async/cohttp_async_test.cmxs": use_cohttp_async_test
+<async/*.ml{,i,y}>: pkg_async
+<async/*.ml{,i,y}>: pkg_base64
+<async/*.ml{,i,y}>: pkg_bytes
+<async/*.ml{,i,y}>: pkg_conduit.async
+<async/*.ml{,i,y}>: pkg_fieldslib
+<async/*.ml{,i,y}>: pkg_fieldslib.syntax
+<async/*.ml{,i,y}>: pkg_magic-mime
+<async/*.ml{,i,y}>: pkg_oUnit
+<async/*.ml{,i,y}>: pkg_re.emacs
+<async/*.ml{,i,y}>: pkg_sexplib
+<async/*.ml{,i,y}>: pkg_sexplib.syntax
+<async/*.ml{,i,y}>: pkg_stringext
+<async/*.ml{,i,y}>: pkg_threads
+<async/*.ml{,i,y}>: pkg_uri
+<async/*.ml{,i,y}>: pkg_uri.services
+<async/*.ml{,i,y}>: use_cohttp
+<async/*.ml{,i,y}>: use_cohttp_async
+<async/*.ml{,i,y}>: use_cohttp_test
 # Executable test_parser
 <lib_test/test_parser.{native,byte}>: pkg_base64
 <lib_test/test_parser.{native,byte}>: pkg_bytes
@@ -406,11 +416,33 @@ true: annot, bin_annot
 <lib_test/test_net_async_server.{native,byte}>: pkg_uri.services
 <lib_test/test_net_async_server.{native,byte}>: use_cohttp
 <lib_test/test_net_async_server.{native,byte}>: use_cohttp_async
+<lib_test/test_net_async_server.{native,byte}>: custom
+# Executable test_async_integration
+<lib_test/test_async_integration.{native,byte}>: pkg_async
+<lib_test/test_async_integration.{native,byte}>: pkg_base64
+<lib_test/test_async_integration.{native,byte}>: pkg_bytes
+<lib_test/test_async_integration.{native,byte}>: pkg_conduit.async
+<lib_test/test_async_integration.{native,byte}>: pkg_fieldslib
+<lib_test/test_async_integration.{native,byte}>: pkg_fieldslib.syntax
+<lib_test/test_async_integration.{native,byte}>: pkg_magic-mime
+<lib_test/test_async_integration.{native,byte}>: pkg_oUnit
+<lib_test/test_async_integration.{native,byte}>: pkg_re.emacs
+<lib_test/test_async_integration.{native,byte}>: pkg_sexplib
+<lib_test/test_async_integration.{native,byte}>: pkg_sexplib.syntax
+<lib_test/test_async_integration.{native,byte}>: pkg_stringext
+<lib_test/test_async_integration.{native,byte}>: pkg_threads
+<lib_test/test_async_integration.{native,byte}>: pkg_uri
+<lib_test/test_async_integration.{native,byte}>: pkg_uri.services
+<lib_test/test_async_integration.{native,byte}>: use_cohttp
+<lib_test/test_async_integration.{native,byte}>: use_cohttp_async
+<lib_test/test_async_integration.{native,byte}>: use_cohttp_async_test
+<lib_test/test_async_integration.{native,byte}>: use_cohttp_test
 <lib_test/*.ml{,i,y}>: pkg_async
 <lib_test/*.ml{,i,y}>: pkg_conduit.async
 <lib_test/*.ml{,i,y}>: pkg_threads
 <lib_test/*.ml{,i,y}>: use_cohttp_async
-<lib_test/test_net_async_server.{native,byte}>: custom
+<lib_test/*.ml{,i,y}>: use_cohttp_async_test
+<lib_test/test_async_integration.{native,byte}>: custom
 # Executable cohttp-server-async
 <bin/cohttp_server_async.{native,byte}>: pkg_async
 <bin/cohttp_server_async.{native,byte}>: pkg_base64
@@ -651,6 +683,7 @@ true: annot, bin_annot
 <lib_test/test_sanity.{native,byte}>: use_cohttp_lwt
 <lib_test/test_sanity.{native,byte}>: use_cohttp_lwt_unix
 <lib_test/test_sanity.{native,byte}>: use_cohttp_lwt_unix_test
+<lib_test/test_sanity.{native,byte}>: use_cohttp_test
 <lib_test/*.ml{,i,y}>: pkg_base64
 <lib_test/*.ml{,i,y}>: pkg_bytes
 <lib_test/*.ml{,i,y}>: pkg_conduit.lwt-unix
@@ -671,6 +704,7 @@ true: annot, bin_annot
 <lib_test/*.ml{,i,y}>: use_cohttp_lwt
 <lib_test/*.ml{,i,y}>: use_cohttp_lwt_unix
 <lib_test/*.ml{,i,y}>: use_cohttp_lwt_unix_test
+<lib_test/*.ml{,i,y}>: use_cohttp_test
 <lib_test/test_sanity.{native,byte}>: custom
 # OASIS_STOP
 true: principal, strict_sequence, debug

async/cohttp_async.ml

@@ -321,4 +321,5 @@ module Server = struct
     >>| fun server ->
     { server }
 
+  let close { server } = Tcp.Server.close server
 end

async/cohttp_async.mli

@@ -191,4 +191,6 @@ module Server : sig
     ('address, 'listening_on) Tcp.Where_to_listen.t
     -> (body:Body.t -> 'address -> Request.t -> response Deferred.t)
     -> ('address, 'listening_on) t Deferred.t
+
+  val close : (_, _) t -> unit Deferred.t
 end

async/cohttp_async_test.ml

@@ -0,0 +1,49 @@
+open Core.Std
+open Async.Std
+open OUnit
+open Cohttp_async
+
+type 'a io = 'a Deferred.t
+type body = Body.t
+type spec = Request.t -> body -> (Response.t * body) io
+type async_test = unit -> unit io
+
+let response_sequence = Cohttp_test.response_sequence failwith
+
+let temp_server ?port spec callback =
+  let port = match port with
+    | None -> Cohttp_test.next_port ()
+    | Some p -> p in
+  let uri = Uri.of_string ("http://0.0.0.0:" ^ (string_of_int port)) in
+  let server = Server.create (Tcp.on_port port) (fun ~body _sock req -> spec req body) in
+  server >>= fun server ->
+  callback uri >>= fun res ->
+  Server.close server >>| fun () ->
+  res
+
+let test_server_s ?port ?(name="Cohttp Server Test") spec f =
+  temp_server ?port spec begin fun uri ->
+    Log.Global.info "Test %s running on %s" name (Uri.to_string uri);
+    let tests = f uri in
+    let results =
+      tests
+      |> Deferred.List.map ~how:`Sequential ~f:(fun (name, test) ->
+        Log.Global.debug "Running %s" name;
+        let res =
+          try_with test >>| function
+          | Ok () -> `Ok
+          | Error exn -> `Exn exn in
+        res >>| (fun res -> (name, res))) in
+    results >>| (fun results ->
+      let ounit_tests =
+        results
+        |> List.map ~f:(fun (name, res) ->
+          name >:: fun () ->
+            match res with
+            | `Ok -> ()
+            | `Exn x -> raise x) in
+      name >::: ounit_tests)
+  end
+
+let run_async_tests test =
+  test >>| (fun a -> a |> OUnit.run_test_tt_main)

async/cohttp_async_test.mldylib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: 3dc3ad561bd9817e1c4a2f960f9cd7fe)
+Cohttp_async_test
+# OASIS_STOP

async/cohttp_async_test.mli

@@ -0,0 +1,4 @@
+open Async.Std
+
+include Cohttp_test.S with type 'a io = 'a Deferred.t and type body = Cohttp_async.Body.t
+val run_async_tests : OUnit.test io -> OUnit.test_result list Deferred.t

async/cohttp_async_test.mllib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: 3dc3ad561bd9817e1c4a2f960f9cd7fe)
+Cohttp_async_test
+# OASIS_STOP

lib/META

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 6a971f1fc0aa571e67858b56e5337a8c)
+# DO NOT EDIT (digest: 0993413eb2018c7116a8e1ceec9b45f9)
 version = "0.17.2"
 description = "HTTP library for Lwt, Async, JavaScript and Mirage"
 requires =
@@ -9,10 +9,21 @@ archive(byte, plugin) = "cohttp.cma"
 archive(native) = "cohttp.cmxa"
 archive(native, plugin) = "cohttp.cmxs"
 exists_if = "cohttp.cma"
+package "test" (
+ version = "0.17.2"
+ description = "HTTP library for Lwt, Async, JavaScript and Mirage"
+ requires = "cohttp oUnit"
+ archive(byte) = "cohttp_test.cma"
+ archive(byte, plugin) = "cohttp_test.cma"
+ archive(native) = "cohttp_test.cmxa"
+ archive(native, plugin) = "cohttp_test.cmxs"
+ exists_if = "cohttp_test.cma"
+)
+
 package "lwt-unix-test" (
  version = "0.17.2"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"
- requires = "cohttp.lwt unix lwt.unix oUnit"
+ requires = "cohttp.test cohttp.lwt unix lwt.unix oUnit"
  archive(byte) = "cohttp_lwt_unix_test.cma"
  archive(byte, plugin) = "cohttp_lwt_unix_test.cma"
  archive(native) = "cohttp_lwt_unix_test.cmxa"
@@ -53,6 +64,17 @@ package "js" (
  exists_if = "cohttp_lwt_xhr.cma"
 )
 
+package "async-test" (
+ version = "0.17.2"
+ description = "HTTP library for Lwt, Async, JavaScript and Mirage"
+ requires = "cohttp.test cohttp.async oUnit"
+ archive(byte) = "cohttp_async_test.cma"
+ archive(byte, plugin) = "cohttp_async_test.cma"
+ archive(native) = "cohttp_async_test.cmxa"
+ archive(native, plugin) = "cohttp_async_test.cmxs"
+ exists_if = "cohttp_async_test.cma"
+)
+
 package "async" (
  version = "0.17.2"
  description = "HTTP library for Lwt, Async, JavaScript and Mirage"

lib/cohttp_test.ml

@@ -0,0 +1,31 @@
+open Cohttp
+
+module type S = sig
+  type 'a io
+  type body
+
+  type spec = Request.t -> body -> (Response.t * body) io
+  type async_test = unit -> unit io
+
+  val response_sequence : (Response.t * body) io list -> spec
+  val temp_server : ?port:int -> spec -> (Uri.t -> 'a io) -> 'a io
+  val test_server_s : ?port:int -> ?name:string -> spec
+    -> (Uri.t -> (string * async_test) list) -> OUnit.test io
+  val run_async_tests : OUnit.test io -> OUnit.test_results io
+end
+
+let port = ref 9193
+
+let next_port () =
+  let current_port = !port in
+  incr port;
+  current_port
+
+let response_sequence fail responses =
+  let xs = ref responses in
+  fun _ _ ->
+    match !xs with
+    | x::xs' ->
+      xs := xs';
+      x
+    | [] -> fail "response_sequence: Server exhausted responses"

lib/cohttp_test.mldylib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: f17d8de0cfcc25325cac44106642e75d)
+Cohttp_test
+# OASIS_STOP

lib/cohttp_test.mli

@@ -0,0 +1,32 @@
+open Cohttp
+
+module type S = sig
+  type 'a io
+  type body
+
+  (** A server that is being tested must be defined by providing a spec *)
+  type spec = Request.t -> body -> (Response.t * body) io
+
+  type async_test = unit -> unit io
+
+  (** A server that returns the list of responses in sequences and crashes
+      on further requests *)
+  val response_sequence : (Response.t * body) io list -> spec
+
+  (** Create a temporary server according to spec that lives until the callback
+      thread is determined. The uri provided in the callback should be the base
+      uri for any requests made to the temp server *)
+  val temp_server : ?port:int -> spec -> (Uri.t -> 'a io) -> 'a io
+
+  (** Create a test suite against a server defined by spec. Tests
+      run sequentially. *)
+  val test_server_s : ?port:int -> ?name:string -> spec
+    -> (Uri.t -> (string * async_test) list) -> OUnit.test io
+
+  (** Run an async unit test and return and print the result *)
+  val run_async_tests : OUnit.test io -> OUnit.test_results io
+end
+
+(** Internal API. Subject to breakage *)
+val next_port : unit -> int
+val response_sequence : (string -> 'a) -> 'a list -> 'b -> 'c -> 'a

lib/cohttp_test.mllib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: f17d8de0cfcc25325cac44106642e75d)
+Cohttp_test
+# OASIS_STOP