This commit is contained in:
Simon Cruanes 2023-07-12 20:17:57 -04:00
parent 7b094b55ad
commit 6137c20801
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4

View file

@ -10,14 +10,18 @@
module Buf = Tiny_httpd_buf module Buf = Tiny_httpd_buf
(** Input channel (byte source) *)
module In_channel = struct module In_channel = struct
type t = { type t = {
input: bytes -> int -> int -> int; input: bytes -> int -> int -> int;
(** Read into the slice. Returns [0] only if the (** Read into the slice. Returns [0] only if the
channel is closed. *) channel is closed. *)
close: unit -> unit; close: unit -> unit; (** Close the input. Must be idempotent. *)
} }
(** An input channel, i.e an incoming stream of bytes. *) (** An input channel, i.e an incoming stream of bytes.
This can be a [string], an [int_channel], an [Unix.file_descr], a
decompression wrapper around another input channel, etc. *)
let of_in_channel ?(close_noerr = false) (ic : in_channel) : t = let of_in_channel ?(close_noerr = false) (ic : in_channel) : t =
{ {
@ -41,18 +45,28 @@ module In_channel = struct
Unix.close fd); Unix.close fd);
} }
(** Read into the given slice.
@return the number of bytes read, [0] means end of input. *)
let[@inline] input (self : t) buf i len = self.input buf i len let[@inline] input (self : t) buf i len = self.input buf i len
(** Close the channel. *)
let[@inline] close self : unit = self.close () let[@inline] close self : unit = self.close ()
end end
(** Output channel (byte sink) *)
module Out_channel = struct module Out_channel = struct
type t = { type t = {
output: bytes -> int -> int -> unit; (** Output slice *) output: bytes -> int -> int -> unit; (** Output slice *)
flush: unit -> unit; (** Flush underlying buffer *) flush: unit -> unit; (** Flush underlying buffer *)
close: unit -> unit; close: unit -> unit; (** Close the output. Must be idempotent. *)
} }
(** An output channel, ie. a place into which we can write bytes. *) (** An output channel, ie. a place into which we can write bytes.
This can be a [Buffer.t], an [out_channel], a [Unix.file_descr], etc. *)
(** [of_out_channel oc] wraps the channel into a {!Out_channel.t}.
@param close_noerr if true, then closing the result uses [close_out_noerr]
instead of [close_out] to close [oc] *)
let of_out_channel ?(close_noerr = false) (oc : out_channel) : t = let of_out_channel ?(close_noerr = false) (oc : out_channel) : t =
{ {
output = (fun buf i len -> output oc buf i len); output = (fun buf i len -> output oc buf i len);
@ -65,12 +79,16 @@ module Out_channel = struct
close_out oc); close_out oc);
} }
(** Output the buffer slice into this channel *)
let[@inline] output (self : t) buf i len : unit = self.output buf i len let[@inline] output (self : t) buf i len : unit = self.output buf i len
let[@inline] output_string (self : t) (str : string) : unit = let[@inline] output_string (self : t) (str : string) : unit =
self.output (Bytes.unsafe_of_string str) 0 (String.length str) self.output (Bytes.unsafe_of_string str) 0 (String.length str)
(** Close the channel. *)
let[@inline] close self : unit = self.close () let[@inline] close self : unit = self.close ()
(** Flush (ie. force write) any buffered bytes. *)
let[@inline] flush self : unit = self.flush () let[@inline] flush self : unit = self.flush ()
let output_buf (self : t) (buf : Buf.t) : unit = let output_buf (self : t) (buf : Buf.t) : unit =
@ -101,28 +119,35 @@ module Out_channel = struct
{ flush; close; output } { flush; close; output }
end end
(** A writer abstraction. (** A writer abstraction. *)
A writer is a push-based stream of bytes. Give it an output channel and it will write
the bytes in it. *)
module Writer = struct module Writer = struct
type t = { write: Out_channel.t -> unit } [@@unboxed] type t = { write: Out_channel.t -> unit } [@@unboxed]
(** Writer. *) (** Writer.
A writer is a push-based stream of bytes.
Give it an output channel and it will write the bytes in it.
This is useful for responses: an http endpoint can return a writer
as its response's body, and output into it as if it were a regular
[out_channel], including controlling calls to [flush].
@since NEXT_RELEASE
*)
let[@inline] make ~write () : t = { write } let[@inline] make ~write () : t = { write }
(** Write into the channel. *) (** Write into the channel. *)
let[@inline] write (oc : Out_channel.t) (self : t) : unit = self.write oc let[@inline] write (oc : Out_channel.t) (self : t) : unit = self.write oc
(** Empty writer, will output 0 bytes. *)
let empty : t = { write = ignore } let empty : t = { write = ignore }
(** A writer that just emits the bytes from the given string. *) (** A writer that just emits the bytes from the given string. *)
let of_string (str : string) : t = let[@inline] of_string (str : string) : t =
let write oc = Out_channel.output_string oc str in let write oc = Out_channel.output_string oc str in
{ write } { write }
end end
(** A TCP server abstraction *) (** A TCP server abstraction. *)
module TCP_server = struct module TCP_server = struct
type conn_handler = { type conn_handler = {
handle: In_channel.t -> Out_channel.t -> unit; handle: In_channel.t -> Out_channel.t -> unit;
@ -136,14 +161,27 @@ module TCP_server = struct
(** Number of connections currently active *) (** Number of connections currently active *)
running: unit -> bool; (** Is the server currently running? *) running: unit -> bool; (** Is the server currently running? *)
stop: unit -> unit; stop: unit -> unit;
(** Ask the server to stop. This might not take effect immediately. *) (** Ask the server to stop. This might not take effect immediately,
and is idempotent. After this [server.running()] must return [false]. *)
} }
(** Running server. *) (** A running TCP server.
This contains some functions that provide information about the running
server, including whether it's active (as opposed to stopped), a function
to stop it, and statistics about the number of connections. *)
type builder = { type builder = {
serve: after_init:(t -> unit) -> handle:conn_handler -> unit -> unit; serve: after_init:(t -> unit) -> handle:conn_handler -> unit -> unit;
(** Blocking call to listen for incoming connections and handle them. (** Blocking call to listen for incoming connections and handle them.
Uses the connection handler to handle individual client connections. *) Uses the connection handler [handle] to handle individual client
connections in individual threads/fibers/tasks.
@param after_init is called once with the server after the server
has started. *)
} }
(** A TCP server implementation. *) (** A TCP server builder implementation.
Calling [builder.serve ~after_init ~handle ()] starts a new TCP server on
an unspecified endpoint
(most likely coming from the function returning this builder)
and returns the running server. *)
end end