Skip to content

Commit

Permalink
Deduplicate code for interfaces (#13)
Browse files Browse the repository at this point in the history
  • Loading branch information
anmonteiro committed May 11, 2020
1 parent 2291d7b commit d8f64e8
Show file tree
Hide file tree
Showing 6 changed files with 83 additions and 147 deletions.
54 changes: 6 additions & 48 deletions lwt-unix/httpaf_lwt_unix.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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 -> 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
Expand Down Expand Up @@ -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
24 changes: 1 addition & 23 deletions lwt/httpaf_lwt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
56 changes: 5 additions & 51 deletions lwt/httpaf_lwt.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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 -> 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
61 changes: 61 additions & 0 deletions lwt/httpaf_lwt_intf.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,61 @@
open Httpaf

module type IO = sig
type socket
type addr

(** 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 Server = sig
type socket

type addr

val create_connection_handler
: ?config : Config.t
-> request_handler : (addr -> Server_connection.request_handler)
-> error_handler : (addr -> Server_connection.error_handler)
-> addr
-> socket
-> unit Lwt.t
end

module type Client = sig
type t

type socket

val create_connection
: ?config : Config.t
-> 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
6 changes: 3 additions & 3 deletions mirage/httpaf_mirage.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
29 changes: 7 additions & 22 deletions mirage/httpaf_mirage.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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

Expand All @@ -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

0 comments on commit d8f64e8

Please sign in to comment.