Deduplicate code for interfaces

anmonteiro · Aug 4, 2019 · 473eab9 · 473eab9
1 parent 5dff1b4
commit 473eab9
Show file tree

Hide file tree

Showing 5 changed files with 22 additions and 147 deletions.
diff --git a/lwt-unix/httpaf_lwt_unix.mli b/lwt-unix/httpaf_lwt_unix.mli
@@ -40,13 +40,9 @@ open Httpaf
    to [Lwt_io.establish_server_with_client_socket]. For an example, see
    [examples/lwt_echo_server.ml]. *)
 module Server : sig
-  val create_connection_handler
-    :  ?config         : Config.t
-    -> request_handler : (Unix.sockaddr -> Lwt_unix.file_descr Server_connection.request_handler)
-    -> error_handler   : (Unix.sockaddr -> Server_connection.error_handler)
-    -> Unix.sockaddr
-    -> Lwt_unix.file_descr
-    -> unit Lwt.t
+  include Httpaf_lwt.Server
+    with type socket := Lwt_unix.file_descr
+     and type addr := Unix.sockaddr
 
   module TLS : sig
     val create_connection_handler
@@ -77,63 +73,25 @@ end
 
 (* For an example, see [examples/lwt_get.ml]. *)
 module Client : sig
-  type t
-
-  val create_connection
-    : ?config:Config.t
-    -> Lwt_unix.file_descr
-    -> t Lwt.t
-
-  val request
-    :  t
-    -> Request.t
-    -> error_handler    : Client_connection.error_handler
-    -> response_handler : Client_connection.response_handler
-    -> [`write] Body.t
-
-  val shutdown : t -> unit
-
-  val is_closed : t -> bool
+  include Httpaf_lwt.Client with type socket := Lwt_unix.file_descr
 
   module TLS : sig
-    type t
+    include Httpaf_lwt.Client with type socket := Lwt_unix.file_descr
 
     val create_connection
       :  ?client          : Tls_io.client
       -> ?config          : Config.t
       -> Lwt_unix.file_descr
       -> t Lwt.t
-
-    val request
-      :  t
-      -> Request.t
-      -> error_handler    : Client_connection.error_handler
-      -> response_handler : Client_connection.response_handler
-      -> [`write] Body.t
-
-    val shutdown : t -> unit
-
-    val is_closed : t -> bool
   end
 
   module SSL : sig
-    type t
+    include Httpaf_lwt.Client with type socket := Lwt_unix.file_descr
 
     val create_connection
       :  ?client          : Ssl_io.client
       -> ?config          : Config.t
       -> Lwt_unix.file_descr
       -> t Lwt.t
-
-    val request
-      :  t
-      -> Request.t
-      -> error_handler    : Client_connection.error_handler
-      -> response_handler : Client_connection.response_handler
-      -> [`write] Body.t
-
-    val shutdown : t -> unit
-
-    val is_closed : t -> bool
   end
 end
diff --git a/lwt/httpaf_lwt.ml b/lwt/httpaf_lwt.ml
@@ -85,30 +85,8 @@ end = struct
         ret
 end
 
-module type IO = sig
-  type socket
-  type addr
-
-  val read
-    :  socket
-    -> Bigstringaf.t
-    -> off:int
-    -> len:int
-    -> [ `Eof | `Ok of int ] Lwt.t
-
-  val writev
-     : socket
-    -> Faraday.bigstring Faraday.iovec list
-    -> [ `Closed | `Ok of int ] Lwt.t
-
-  val shutdown_send : socket -> unit
-
-  val shutdown_receive : socket -> unit
-
-  val close : socket -> unit Lwt.t
-end
-
 module Config = Httpaf.Config
+include Httpaf_lwt_intf
 
 module Server (Io: IO) = struct
   let create_connection_handler ?(config=Config.default) ~request_handler ~error_handler =

diff --git a/lwt/httpaf_lwt.mli b/lwt/httpaf_lwt.mli
@@ -33,62 +33,16 @@
     POSSIBILITY OF SUCH DAMAGE.
   ----------------------------------------------------------------------------*)
 
-open Httpaf
+module type IO = Httpaf_lwt_intf.IO
 
-module type IO = sig
-  type socket
-  type addr
+module type Server = Httpaf_lwt_intf.Server
 
-  (** The region [[off, off + len)] is where read bytes can be written to *)
-  val read
-    :  socket
-    -> Bigstringaf.t
-    -> off:int
-    -> len:int
-    -> [ `Eof | `Ok of int ] Lwt.t
-
-  val writev
-    : socket
-    -> Faraday.bigstring Faraday.iovec list
-    -> [ `Closed | `Ok of int ] Lwt.t
-
-  val shutdown_send : socket -> unit
-
-  val shutdown_receive : socket -> unit
-
-  val close : socket -> unit Lwt.t
-end
+module type Client = Httpaf_lwt_intf.Client
 
 (* The function that results from [create_connection_handler] should be passed
    to [Lwt_io.establish_server_with_client_socket]. For an example, see
    [examples/lwt_echo_server.ml]. *)
-module Server (Io: IO) : sig
-  val create_connection_handler
-    :  ?config         : Config.t
-    -> request_handler : (Io.addr -> Io.socket Server_connection.request_handler)
-    -> error_handler   : (Io.addr -> Server_connection.error_handler)
-    -> Io.addr
-    -> Io.socket
-    -> unit Lwt.t
-end
+module Server (Io: IO) : Server with type socket := Io.socket and type addr := Io.addr
 
 (* For an example, see [examples/lwt_get.ml]. *)
-module Client (Io: IO) : sig
-  type t
-
-  val create_connection
-    : ?config          : Config.t
-    -> Io.socket
-    -> t Lwt.t
-
-  val request
-    :  t
-    -> Request.t
-    -> error_handler    : Client_connection.error_handler
-    -> response_handler : Client_connection.response_handler
-    -> [`write] Body.t
-
-  val shutdown: t -> unit
-
-  val is_closed : t -> bool
-end
+module Client (Io: IO) : Client with type socket := Io.socket
diff --git a/mirage/httpaf_mirage.ml b/mirage/httpaf_mirage.ml
@@ -92,16 +92,16 @@ end
 module Server (Flow : Mirage_flow_lwt.S) = struct
   include Httpaf_lwt.Server (Make_IO (Flow))
 
-  type flow = Flow.flow
-
   let create_connection_handler ?config ~request_handler ~error_handler =
     fun flow ->
       let request_handler = fun () -> request_handler in
       let error_handler = fun () -> error_handler in
       create_connection_handler ?config ~request_handler ~error_handler () flow
 end
 
-module type Server_intf = sig
+(* Almost like the `Httpaf_lwt.Server` module type but we don't need the client
+ * address argument in Mirage. It's somewhere else. *)
+module type Server = sig
   type flow
 
   val create_connection_handler

diff --git a/mirage/httpaf_mirage.mli b/mirage/httpaf_mirage.mli
@@ -34,7 +34,9 @@
 
 open Httpaf
 
-module type Server_intf = sig
+(* TODO(anmonteiro): this can be in H2_mirage_intf and deduplicated across
+ * `.ml` and `.mli` files. *)
+module type Server = sig
   type flow
 
   val create_connection_handler
@@ -45,10 +47,10 @@ module type Server_intf = sig
 end
 
 module Server (Flow : Mirage_flow_lwt.S) :
-  Server_intf with type flow = Flow.flow
+  Server with type flow := Flow.flow
 
 module Server_with_conduit : sig
-  include Server_intf with type flow = Conduit_mirage.Flow.flow
+  include Server with type flow := Conduit_mirage.Flow.flow
 
   type t = Conduit_mirage.Flow.flow -> unit Lwt.t
 
@@ -57,22 +59,5 @@ module Server_with_conduit : sig
     (Conduit_mirage.server -> t -> unit Lwt.t) Lwt.t
 end
 
-module Client (Flow : Mirage_flow_lwt.S) : sig
-  type t
-
-  val create_connection
-    : ?config          : Config.t
-    -> Flow.flow
-    -> t Lwt.t
-
-  val request
-    :  t
-    -> Request.t
-    -> error_handler    : Client_connection.error_handler
-    -> response_handler : Client_connection.response_handler
-    -> [`write] Body.t
-
-  val shutdown : t -> unit
-
-  val is_closed : t -> bool
-end
+module Client (Flow : Mirage_flow_lwt.S) :
+ Httpaf_lwt.Client with type socket := Flow.flow