(** ALPN support.

    [Alpn] depend on [http/af] & [h2] and choose them because they share the
    same {!Paf.RUNTIME} interface. [Alpn] does not require [ocaml-tls] so it's
    possible to use OpenSSL. It requires, at least:

    - Something to extract ALPN result from the TLS {i flow}
    - Something to represent as the string the peer (useful for over-framework)
    - An injection function (available from [mimic])

    In other words, [Alpn] did the only choice to trust on [http/af] & [h2] to
    handle HTTP/1.0, HTTP/1.1 and H2 protocols. *)

module type REQD = sig
  type t
  type request
  type response

  module Body : sig
    type ro
    type wo
  end

  val request : t -> request
  val request_body : t -> Body.ro
  val response : t -> response option
  val response_exn : t -> response
  val respond_with_string : t -> response -> string -> unit
  val respond_with_bigstring : t -> response -> Bigstringaf.t -> unit

  val respond_with_streaming :
    t -> ?flush_headers_immediately:bool -> response -> Body.wo

  val report_exn : t -> exn -> unit
  val try_with : t -> (unit -> unit) -> (unit, exn) result
end

type http_1_1_protocol =
  (module REQD
     with type t = H1.Reqd.t
      and type request = H1.Request.t
      and type response = H1.Response.t
      and type Body.ro = H1.Body.Reader.t
      and type Body.wo = H1.Body.Writer.t)

type h2_protocol =
  (module REQD
     with type t = H2.Reqd.t
      and type request = H2.Request.t
      and type response = H2.Response.t
      and type Body.ro = H2.Body.Reader.t
      and type Body.wo = H2.Body.Writer.t)

type ('reqd, 'headers, 'request, 'response, 'ro, 'wo) protocol =
  | HTTP_1_1 :
      http_1_1_protocol
      -> ( H1.Reqd.t,
           H1.Headers.t,
           H1.Request.t,
           H1.Response.t,
           H1.Body.Reader.t,
           H1.Body.Writer.t )
         protocol
  | H2 :
      h2_protocol
      -> ( H2.Reqd.t,
           H2.Headers.t,
           H2.Request.t,
           H2.Response.t,
           H2.Body.Reader.t,
           H2.Body.Writer.t )
         protocol

val http_1_1 :
  ( H1.Reqd.t,
    H1.Headers.t,
    H1.Request.t,
    H1.Response.t,
    H1.Body.Reader.t,
    H1.Body.Writer.t )
  protocol

val h2 :
  ( H2.Reqd.t,
    H2.Headers.t,
    H2.Request.t,
    H2.Response.t,
    H2.Body.Reader.t,
    H2.Body.Writer.t )
  protocol

type server_error =
  [ `Bad_gateway | `Bad_request | `Exn of exn | `Internal_server_error ]
(** Type of server errors. *)

type ('flow, 'edn) info = {
  alpn : 'flow -> string option;
  peer : 'flow -> 'edn;
  injection : 'flow -> Mimic.flow;
}
(** The type of information from a ['flow]:

    - [alpn] is a function which is able to extract the result of the
      negotiation between the client & the server about which protocol we need
      to use.
    - [peer] returns a [string] representation of the given ['flow] to help to
      print out some logs about this client.
    - [injection] is the function which wraps the given ['flow] to a
      [Mimic.flow].

    For the last function, it can be done if you already registered the protocol
    with [mimic]. In that case, the second value given by [Mimic.register] helps
    you to {i inject} your flow as a [Mimic.flow]:

    {[
      let _, protocol = Mimic.register ~name:"my-protocol" (module My_protocol)

      let injection (flow : My_protocol.flow) : Mimic.flow =
        let module R = (val Mimic.repr protocol) in
        R.T flow
    ]} *)

type ('flow, 'edn) server_handler = {
  error :
    'reqd 'headers 'request 'response 'ro 'wo.
    'edn ->
    ('reqd, 'headers, 'request, 'response, 'ro, 'wo) protocol ->
    ?request:'request ->
    server_error ->
    ('headers -> 'wo) ->
    unit;
  request :
    'reqd 'headers 'request 'response 'ro 'wo.
    'flow ->
    'edn ->
    'reqd ->
    ('reqd, 'headers, 'request, 'response, 'ro, 'wo) protocol ->
    unit;
}
(** The type of handler. To be able to handle http/1.1 and h2 requests with the
    same function, we have chosen to use record with universally quantified
    types. Such design requires some constraints: 1) [error] and [request]
    should be defined at top 2) if they requires extra informations (such as the
    path of file, a value to connect to a database, etc.), they can be used into
    handlers but the record must contains non-curried version of these handlers.
    3) you must use type annotation due to the GADT {!type:protocol}

    For instance, we have a value [db] is required by our request handler. You
    can describe your handler by this way:

    {[
      let error_handler
        : type reqd headers request response ro wo.
          _ -> (reqd, headers, request, response, ro, wo) Alpn.protocol ->
          ?request:request -> _ -> (headers -> wo) -> unit
        = fun edn protocol ?request error respond ->
          match protocol with
          | Alpn.HTTP_1_1 _ ->
            (* everything is specialized to the [H1] module. You can use
               [?request] as an [H1.Request.t option] without type error. *)
          | Alpn.H2 _ ->
            (* everything is specialized to the [H2] module. *)

      let request_handler
        : type reqd headers request response ro wo.
          Database.t -> _ -> _ -> reqd ->
          (reqd, headers, request, response, ro, wo) Alpn.protocol -> unit
        = fun db flow edn reqd -> function
        | Alpn.HTTP_1_1 _ -> ...
        | Alpn.H2 _ -> ...

      let handler db =
        { error= (fun edn protocol ?request error respond ->
                error_handler edn protocol ?request error respond)
        ; request= (fun flow edn reqd protocol ->
                request_handler db flow end reqd protocol) }
    ]} *)

val service :
  ('flow, 'edn) info ->
  (Mimic.flow, 'edn) server_handler ->
  ('socket -> ('flow, ([> `Closed | `Msg of string ] as 'error)) result Lwt.t) ->
  ('t -> ('socket, ([> `Closed | `Msg of string ] as 'error)) result Lwt.t) ->
  ('t -> unit Lwt.t) ->
  't Paf.service
(** [service info handler connect accept close] creates a new
    {!type:Paf.service} over the {i socket} ['flow]. From the given
    implementation of [accept] and [close], we are able to instantiate the
    {i main loop}. Then, from the given [info], we extract informations such the
    application layer protocol and choose which protocol we will use. Currently,
    if [info.alpn] returns:

    - [Some "http/1.0" | Some "http/1.1" | None], we launch an [http/af] service
    - [Some "h2"], we launch an [h2] service

    The user is able to identify which protocol we launched by
    {!type:server_handler}. The returned service can be run with {!Paf.serve}.
    Here is an example with [Lwt_unix.file_descr] and the TCP/IP transmission
    protocol (without ALPN negotiation):

    {[
      let _, protocol
        : Unix.sockaddr Mimic.value
          * (Unix.sockaddr, Lwt_unix.file_descr) Mimic.protocol
        = Mimic.register ~name:"lwt-tcp" (module TCP)

      let accept t =
        Lwt.catch begin fun () ->
          Lwt_unix.accept >>= fun (socket, _) ->
          Lwt.return_ok socket
        end @@ function
        | Unix.Unix_error (err, f, v) ->
          Lwt.return_error (`Unix (err, f, v))
        | exn -> raise exn

      let info =
        let module R = (val Mimic.register protocol) in
        { Alpn.alpn= const None
        ; Alpn.peer= (fun socket ->
          sockaddr_to_string (Lwt_unix.getpeername socket))
        ; Alpn.injection=
          (fun socket -> R.T socket) }

      let service = Alpn.service info handler
        accept Lwt_unix.close

      let fiber =
        let t = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
        Lwt_unix.bind t (Unix.ADDR_INET (Unix.inet_addr_loopback, 8080))
        >>= fun () ->
        let `Initialized th = Paf.serve service t in th

      let () = Lwt_main.run fiber
    ]} *)

type client_error =
  [ `Exn of exn
  | `Malformed_response of string
  | `Invalid_response_body_length_v1 of H1.Response.t
  | `Invalid_response_body_length_v2 of H2.Response.t
  | `Protocol_error of H2.Error_code.t * string ]
(** Type of client errors. *)

type 'edn client_handler = {
  error :
    'reqd 'headers 'request 'response 'ro 'wo.
    'edn ->
    ('reqd, 'headers, 'request, 'response, 'ro, 'wo) protocol ->
    client_error ->
    unit;
  response :
    'reqd 'headers 'request 'response 'ro 'wo.
    Mimic.flow ->
    'edn ->
    'response ->
    'ro ->
    ('reqd, 'headers, 'request, 'response, 'ro, 'wo) protocol ->
    unit;
}
(** The type of client handler. As {!type:server_handler}, we have chosen to use
    a record with universally quantified types. Please follow the explanation
    given about {!type:server_handler} to understand how to use it. *)

type alpn_response =
  | Response_HTTP_1_1 :
      (H1.Body.Writer.t * H1.Client_connection.t)
      -> alpn_response
  | Response_H2 : H2.Body.Writer.t * H2.Client_connection.t -> alpn_response

val run :
  ?alpn:string ->
  'edn client_handler ->
  'edn ->
  [ `V1 of H1.Request.t | `V2 of H2.Request.t ] ->
  Mimic.flow ->
  (alpn_response, [> `Msg of string ]) result Lwt.t
(** [run ?alpn ~client_handler edn req flow] tries communicate to [edn] via
    [flow] with a certain protocol according to the given [alpn] value and the
    given request. It returns the body of the request to allow the user to write
    on it (and communicate then with the server).

    [run] does only the ALPN dispatch. It does not instantiate the connection
    and it does not try to upgrade the protocol. It just choose the right HTTP
    protocol according to:

    - the given [alpn] value
    - the given [request] (if you want to communicate via HTTP/1.1 or H2)

    Here is an example with [mimic]:

    {[
      let run uri request =
        let ctx = ctx_of_uri uri in
        (* See Mimic for more details. *)
        Mimic.resolve ctx >>= function
        | Error _ as err -> Lwt.return err
        | Ok flow -> run ?alpn:None handler uri request flow
    ]} *)