tiny_httpd/src/Tiny_httpd.mli

(** {1 Tiny Http Server}

    This library implements a very simple, basic HTTP/1.1 server using blocking
    IOs and threads. Basic routing based on {!Scanf} is provided for convenience,
    so that several handlers can be registered.

    It is possible to use a thread pool, see {!create}'s argument [new_thread].

    The [echo] example (see [src/examples/echo.ml]) demonstrates some of the
    features by declaring a few endpoints, including one for uploading files:

    {[
module S = Tiny_httpd

let () =
  let server = S.create () in
  (* say hello *)
  S.add_route_handler ~meth:`GET server
    S.Route.(exact "hello" @/ string @/ return)
    (fun name _req -> S.Response.make_ok ("hello " ^name ^"!\n"));
  (* echo request *)
  S.add_route_handler server
    S.Route.(exact "echo" @/ return)
    (fun req -> S.Response.make_ok (Format.asprintf "echo:@ %a@." S.Request.pp req));
  S.add_route_handler ~meth:`PUT server
    S.Route.(exact "upload" @/ string_urlencoded @/ return)
    (fun path req ->
        try
          let oc = open_out @@ "/tmp/" ^ path in
          output_string oc req.S.Request.body;
          flush oc;
          S.Response.make_string (Ok "uploaded file")
        with e ->
          S.Response.fail ~code:500 "couldn't upload file: %s"
            (Printexc.to_string e)
      );
  Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server);
  match S.run server with
  | Ok () -> ()
  | Error e -> raise e
    ]}

    It is then possible to query it using curl:

    {[
$ dune exec src/examples/echo.exe &
listening on http://127.0.0.1:8080

# the path "hello/name" greets you.
$ curl -X GET http://localhost:8080/hello/quadrarotaphile
hello quadrarotaphile!

# the path "echo" just prints the request.
$ curl -X GET http://localhost:8080/echo --data "howdy y'all"
echo:
{meth=GET;
 headers=Host: localhost:8080
         User-Agent: curl/7.66.0
         Accept: */*
         Content-Length: 10
         Content-Type: application/x-www-form-urlencoded;
 path="/echo"; body="howdy y'all"}


    ]}

*)


(** {2 Tiny buffer implementation}

    These buffers are used to avoid allocating too many byte arrays when
    processing streams and parsing requests.
*)

module Buf_ : sig
  type t
  val size : t -> int
  val clear : t -> unit
  val create : ?size:int -> unit -> t
  val contents : t -> string

  val bytes_slice : t -> bytes
  (** Access underlying slice of bytes.
      @since 0.5 *)

  val contents_and_clear : t -> string
  (** Get contents of the buffer and clear it.
      @since 0.5 *)

  val add_bytes : t -> bytes -> int -> int -> unit
  (** Append given bytes slice to the buffer.
      @since 0.5 *)
end

(** {2 Generic stream of data}

    Streams are used to represent a series of bytes that can arrive progressively.
    For example, an uploaded file will be sent as a series of chunks. *)

type byte_stream = {
  bs_fill_buf: unit -> (bytes * int * int);
  (** See the current slice of the internal buffer as [bytes, i, len],
      where the slice is [bytes[i] .. [bytes[i+len-1]]].
      Can block to refill the buffer if there is currently no content.
      If [len=0] then there is no more data. *)
  bs_consume: int -> unit;
  (** Consume n bytes from the buffer. This should only be called with [n <= len]
      after a call to [is_fill_buf] that returns a slice of length [len]. *)
  bs_close: unit -> unit;
  (** Close the stream. *)
}
(** A buffered stream, with a view into the current buffer (or refill if empty),
    and a function to consume [n] bytes.
    See {!Byte_stream} for more details. *)

module Byte_stream : sig
  type t = byte_stream

  val close : t -> unit

  val empty : t

  val of_chan : in_channel -> t
  (** Make a buffered stream from the given channel. *)

  val of_chan_close_noerr : in_channel -> t
  (** Same as {!of_chan} but the [close] method will never fail. *)

  val of_bytes : ?i:int -> ?len:int -> bytes -> t
  (** A stream that just returns the slice of bytes starting from [i]
      and of length [len]. *)

  val of_string : string -> t

  val iter : (bytes -> int -> int -> unit) -> t -> unit
  (** Iterate on the chunks of the stream
      @since 0.3 *)

  val to_chan : out_channel -> t -> unit
  (** Write the stream to the channel.
      @since 0.3 *)

  val with_file : string -> (t -> 'a) -> 'a
  (** Open a file with given name, and obtain an input stream
      on its content. When the function returns, the stream (and file) are closed. *)

  val read_line : ?buf:Buf_.t -> t -> string
  (** Read a line from the stream.
      @param buf a buffer to (re)use. Its content will be cleared. *)

  val read_all : ?buf:Buf_.t -> t -> string
  (** Read the whole stream into a string.
      @param buf a buffer to (re)use. Its content will be cleared. *)
end

(** {2 Methods} *)

module Meth : sig
  type t = [
    | `GET
    | `PUT
    | `POST
    | `HEAD
    | `DELETE
  ]
  (** A HTTP method.
      For now we only handle a subset of these.

      See https://tools.ietf.org/html/rfc7231#section-4 *)

  val pp : Format.formatter -> t -> unit
  val to_string : t -> string
end

(** {2 Headers}

    Headers are metadata associated with a request or response. *)

module Headers : sig
  type t = (string * string) list
  (** The header files of a request or response.

      Neither the key nor the value can contain ['\r'] or ['\n'].
      See https://tools.ietf.org/html/rfc7230#section-3.2 *)

  val empty : t
  (** Empty list of headers
      @since 0.5 *)

  val get : ?f:(string->string) -> string -> t -> string option
  (** [get k headers] looks for the header field with key [k].
      @param f if provided, will transform the value before it is returned. *)

  val set : string -> string -> t -> t
  (** [set k v headers] sets the key [k] to value [v].
      It erases any previous entry for [k] *)

  val remove : string -> t -> t
  (** Remove the key from the headers, if present. *)

  val contains : string -> t -> bool
  (** Is there a header with the given key? *)

  val pp : Format.formatter -> t -> unit
  (** Pretty print the headers. *)
end

(** {2 Requests}

    Requests are sent by a client, e.g. a web browser or cURL. *)

module Request : sig
  type 'body t = {
    meth: Meth.t;
    host: string;
    headers: Headers.t;
    path: string;
    path_components: string list;
    query: (string*string) list;
    body: 'body;
  }
  (** A request with method, path, host, headers, and a body, sent by a client.

      The body is polymorphic because the request goes through
      several transformations. First it has no body, as only the request
      and headers are read; then it has a stream body; then the body might be
      entirely read as a string via {!read_body_full}.

      The field [query] was added @since 0.6 and contains
        the query parameters in ["?foo=bar,x=y"]
      The field [path_components] is the part of the path that precedes [query]
        and is split on ["/"] and was added @since 0.6
  *)

  val pp : Format.formatter -> string t -> unit
  (** Pretty print the request and its body *)

  val pp_ : Format.formatter -> _ t -> unit
  (** Pretty print the request without its body *)

  val headers : _ t -> Headers.t
  (** List of headers of the request, including ["Host"] *)

  val get_header : ?f:(string->string) -> _ t -> string -> string option

  val get_header_int : _ t -> string -> int option

  val set_header : 'a t -> string -> string -> 'a t

  val host : _ t -> string
  (** Host field of the request. It also appears in the headers. *)

  val meth : _ t -> Meth.t
  (** Method for the request. *)

  val path : _ t -> string
  (** Request path. *)

  val query : _ t -> (string*string) list
  (** Decode the query part of the {!path} field
      @since 0.4 *)

  val body : 'b t -> 'b
  (** Request body, possibly empty. *)

  val limit_body_size : max_size:int -> byte_stream t -> byte_stream t
  (** Limit the body size to [max_size] bytes, or return
      a [413] error.
      @since 0.3
  *)

  val read_body_full : byte_stream t -> string t
  (** Read the whole body into a string. Potentially blocking. *)

  (**/**)
  (* for testing purpose, do not use *)
  module Internal_ : sig
    val parse_req_start : ?buf:Buf_.t -> byte_stream -> unit t option
    val parse_body : ?buf:Buf_.t -> unit t -> byte_stream -> byte_stream t
  end
  (**/**)
end

(** {2 Response Codes} *)

module Response_code : sig
  type t = int
  (** A standard HTTP code.

      https://tools.ietf.org/html/rfc7231#section-6 *)

  val ok : t
  (** The code [200] *)

  val not_found : t
  (** The code [404] *)

  val descr : t -> string
  (** A description of some of the error codes.
      NOTE: this is not complete (yet). *)
end

(** {2 Responses}

    Responses are what a http server, such as {!Tiny_httpd}, send back to
    the client to answer a {!Request.t}*)

module Response : sig
  type body = [`String of string | `Stream of byte_stream]
  (** Body of a response, either as a simple string,
      or a stream of bytes. *)

  type t = {
    code: Response_code.t; (** HTTP response code. See {!Response_code}. *)
    headers: Headers.t; (** Headers of the reply. Some will be set by [Tiny_httpd] automatically. *)
    body: body; (** Body of the response. Can be empty. *)
  }
  (** A response to send back to a client. *)

  val make_raw :
    ?headers:Headers.t ->
    code:Response_code.t ->
    string ->
    t
  (** Make a response from its raw components, with a string body.
      Use [""] to not send a body at all. *)

  val make_raw_stream :
    ?headers:Headers.t ->
    code:Response_code.t ->
    byte_stream ->
    t
  (** Same as {!make_raw} but with a stream body. The body will be sent with
      the chunked transfer-encoding. *)

  val make :
    ?headers:Headers.t ->
    (body, Response_code.t * string) result -> t
  (** [make r] turns a result into a response.

      - [make (Ok body)] replies with [200] and the body.
      - [make (Error (code,msg))] replies with the given error code
        and message as body.
  *)

  val make_string :
    ?headers:Headers.t ->
    (string, Response_code.t * string) result -> t
  (** Same as {!make} but with a string body. *)

  val make_stream :
    ?headers:Headers.t ->
    (byte_stream, Response_code.t * string) result -> t
  (** Same as {!make} but with a stream body. *)

  val fail : ?headers:Headers.t -> code:int ->
    ('a, unit, string, t) format4 -> 'a
  (** Make the current request fail with the given code and message.
      Example: [fail ~code:404 "oh noes, %s not found" "waldo"].
  *)

  val fail_raise : code:int -> ('a, unit, string, 'b) format4 -> 'a
  (** Similar to {!fail} but raises an exception that exits the current handler.
      This should not be used outside of a (path) handler.
      Example: [fail_raise ~code:404 "oh noes, %s not found" "waldo"; never_executed()]
  *)

  val pp : Format.formatter -> t -> unit
  (** Pretty print the response. *)
end

(** {2 Routing}

    Basic type-safe routing.
    @since 0.6 *)
module Route : sig
  type ('a, 'b) comp
  (** An atomic component of a path *)

  type ('a, 'b) t
  (** A route, composed of path components *)

  val int : (int -> 'a, 'a) comp
  (** Matches an integer. *)

  val string : (string -> 'a, 'a) comp
  (** Matches a string and binds it as is. *)

  val string_urlencoded : (string -> 'a, 'a) comp
  (** Matches a URL-encoded string, and decodes it. *)

  val exact : string -> ('a, 'a) comp
  (** [exact "s"] matches ["s"] and nothing else. *)

  val return : ('a, 'a) t
  (** Matches the empty path. *)

  val (@/) : ('a, 'b) comp -> ('b, 'c) t -> ('a, 'c) t
  (** [comp / route] matches ["foo/bar/…"] iff [comp] matches ["foo"],
      and [route] matches ["bar/…"]. *)

  val pp : Format.formatter -> _ t -> unit
  (** Print the route.
      @since NEXT_RELEASE *)

  val to_string : _ t -> string
  (** Print the route.
      @since NEXT_RELEASE *)
end

(** {2 Server} *)

type t
(** A HTTP server. See {!create} for more details. *)

val create :
  ?masksigpipe:bool ->
  ?max_connections:int ->
  ?new_thread:((unit -> unit) -> unit) ->
  ?addr:string ->
  ?port:int ->
  unit ->
  t
(** Create a new webserver.

    The server will not do anything until {!run} is called on it.
    Before starting the server, one can use {!add_path_handler} and
    {!set_top_handler} to specify how to handle incoming requests.

    @param masksigpipe if true, block the signal {!Sys.sigpipe} which otherwise
    tends to kill client threads when they try to write on broken sockets. Default: [true].

    @param new_thread a function used to spawn a new thread to handle a
    new client connection. By default it is {!Thread.create} but one
    could use a thread pool instead.

    @param max_connections maximum number of simultaneous connections.
    @param addr address (IPv4 or IPv6) to listen on. Default ["127.0.0.1"].
    @param port to listen on. Default [8080].
    *)

val addr : t -> string
(** Address on which the server listens. *)

val is_ipv6 : t -> bool
(** [is_ipv6 server] returns [true] iff the address of the server is an IPv6 address.
    @since 0.3 *)

val port : t -> int
(** Port on which the server listens. *)

val add_decode_request_cb :
  t ->
  (unit Request.t -> (unit Request.t * (byte_stream -> byte_stream)) option) -> unit
(** Add a callback for every request.
    The callback can provide a stream transformer and a new request (with
    modified headers, typically).
    A possible use is to handle decompression by looking for a [Transfer-Encoding]
    header and returning a stream transformer that decompresses on the fly.
*)

val add_encode_response_cb:
  t -> (unit Request.t -> Response.t -> Response.t option) -> unit
(** Add a callback for every request/response pair.
    Similarly to {!add_encode_response_cb} the callback can return a new
    response, for example to compress it.
    The callback is given the query with only its headers,
    as well as the current response.
*)

val set_top_handler : t -> (string Request.t -> Response.t) -> unit
(** Setup a handler called by default.

    This handler is called with any request not accepted by any handler
    installed via {!add_path_handler}.
    If no top handler is installed, unhandled paths will return a [404] not found. *)

val add_path_handler :
  ?accept:(unit Request.t -> (unit, Response_code.t * string) result) ->
  ?meth:Meth.t ->
  t ->
  ('a, Scanf.Scanning.in_channel,
   'b, 'c -> string Request.t -> Response.t, 'a -> 'd, 'd) format6 ->
  'c -> unit
[@@ocaml.deprecated "use add_route_handler instead"]
(** [add_path_handler server "/some/path/%s@/%d/" f]
    calls [f "foo" 42 request] when a request with path "some/path/foo/42/"
    is received.

    This uses {!Scanf}'s splitting, which has some gotchas (in particular,
    ["%s"] is eager, so it's generally necessary to delimit its
    scope with a ["@/"] delimiter. The "@" before a character indicates it's
    a separator.

    Note that the handlers are called in the reverse order of their addition,
    so the last registered handler can override previously registered ones.

    @param meth if provided, only accept requests with the given method.
    Typically one could react to [`GET] or [`PUT].
    @param accept should return [Ok()] if the given request (before its body
    is read) should be accepted, [Error (code,message)] if it's to be rejected (e.g. because
    its content is too big, or for some permission error).
    See the {!http_of_dir} program for an example of how to use [accept] to
    filter uploads that are too large before the upload even starts.
*)

val add_route_handler :
  ?accept:(unit Request.t -> (unit, Response_code.t * string) result) ->
  ?meth:Meth.t ->
  t ->
  ('a, string Request.t -> Response.t) Route.t -> 'a ->
  unit

val add_path_handler_stream :
  ?accept:(unit Request.t -> (unit, Response_code.t * string) result) ->
  ?meth:Meth.t ->
  t ->
  ('a, Scanf.Scanning.in_channel,
   'b, 'c -> byte_stream Request.t -> Response.t, 'a -> 'd, 'd) format6 ->
  'c -> unit
[@@ocaml.deprecated "use add_route_handler_stream instead"]
(** Similar to {!add_path_handler}, but where the body of the request
    is a stream of bytes that has not been read yet.
    This is useful when one wants to stream the body directly into a parser,
    json decoder (such as [Jsonm]) or into a file.
    @since 0.3 *)

val add_route_handler_stream :
  ?accept:(unit Request.t -> (unit, Response_code.t * string) result) ->
  ?meth:Meth.t ->
  t ->
  ('a, byte_stream Request.t -> Response.t) Route.t -> 'a ->
  unit
(** Similar to {!add_route_handler}, but where the body of the request
    is a stream of bytes that has not been read yet.
    This is useful when one wants to stream the body directly into a parser,
    json decoder (such as [Jsonm]) or into a file.
    @since 0.6 *)

val stop : t -> unit
(** Ask the server to stop. This might not have an immediate effect
    as {!run} might currently be waiting on IO. *)

val run : t -> (unit, exn) result
(** Run the main loop of the server, listening on a socket
    described at the server's creation time, using [new_thread] to
    start a thread for each new client.

    This returns [Ok ()] if the server exits gracefully, or [Error e] if
    it exits with an error. *)

(**/**)

val _debug : ((('a, out_channel, unit, unit, unit, unit) format6 -> 'a) -> unit) -> unit
val _enable_debug: bool -> unit

(**/**)