let src = Logs.Src.create "server"

module Log = (val Logs.src_log src : Logs.LOG)
module Method = Mte.Method
module Headers = Mte.Headers
module Status = Mte.Status

let request_from_h1 ~scheme { H1.Request.meth; target; headers; _ } =
  let headers = Mte.Headers.of_list (H1.Headers.to_list headers) in
  Mte.{ meth; target; scheme; headers }

let request_from_h2 { H2.Request.meth; target; scheme; headers } =
  Mte.{ meth; target; scheme; headers }

let request_handler (reqd : [`H1 of H1.Reqd.t | `H2 of H2.Reqd.t] ) =
  let request =
    match reqd with
    | `H1 reqd ->
        request_from_h1 ~scheme:"http" (H1.Reqd.request reqd)
   | `H2 reqd -> request_from_h2 (H2.Reqd.request reqd)
  in
  begin
    match reqd with
    | `H1 _ ->
    Log.debug (fun m -> m "(HTTP/1.1) request-handler: %S" request.target);
   | `H2 _ -> Log.debug (fun m -> m "(H2) request-handler: %S" request.target);
  end;
  let Mte.{ status; headers; content } = Mte.request_handler request in
  let status =
    match status with
    | #H1.Status.t as status -> status
    | _ -> Fmt.failwith "H2 status response on a H1 request"
  in
  let headers = H1.Headers.of_list (Headers.to_list headers) in
  let response = H1.Response.create ~headers status in
  H1.Reqd.respond_with_string reqd response content

let http_1_1_request_handler reqd =
  let request = request_from_h1 ~scheme:"http" (H1.Reqd.request reqd) in
  Log.debug (fun m -> m "(HTTP/1.1) request-handler: %S" request.target);
  let Mte.{ status; headers; content } = Mte.request_handler request in
  let status =
    match status with
    | #H1.Status.t as status -> status
    | _ -> Fmt.failwith "H2 status response on a H1 request"
  in
  let headers = H1.Headers.of_list (Headers.to_list headers) in
  let response = H1.Response.create ~headers status in
  H1.Reqd.respond_with_string reqd response content

let http_2_0_request_handler reqd =
  let request = request_from_h2 (H2.Reqd.request reqd) in
  Log.debug (fun m -> m "(H2) request-handler: %S" request.target);
  let Mte.{ status; headers; content } = Mte.request_handler request in
  let response = H2.Response.create ~headers status in
  H2.Reqd.respond_with_string reqd response content

let alpn_request_handler : type reqd headers request response ro wo.
    reqd -> (reqd, headers, request, response, ro, wo) Alpn.protocol -> unit =
 fun reqd -> function
  | Alpn.HTTP_1_1 _ -> http_1_1_request_handler reqd
  | Alpn.H2 _ -> http_2_0_request_handler reqd

let headers_of_list : type reqd headers request response ro wo.
    (reqd, headers, request, response, ro, wo) Alpn.protocol ->
    (string * string) list ->
    headers =
 fun protocol lst ->
  match protocol with
  | Alpn.HTTP_1_1 _ -> H1.Headers.of_list lst
  | Alpn.H2 _ -> H2.Headers.of_list lst

let respond_with_string : type reqd headers request response ro wo.
    (reqd, headers, request, response, ro, wo) Alpn.protocol ->
    headers:headers ->
    respond:(headers -> wo) ->
    string ->
    unit =
 fun protocol ~headers ~respond str ->
  let body = respond headers in
  match protocol with
  | Alpn.HTTP_1_1 _ ->
      H1.Body.Writer.write_string body str;
      H1.Body.Writer.close body
  | Alpn.H2 _ ->
      H2.Body.Writer.write_string body str;
      H2.Body.Writer.close body

let alpn_error_handler : type reqd headers request response ro wo.
    _ ->
    (reqd, headers, request, response, ro, wo) Alpn.protocol ->
    ?request:_ ->
    _ ->
    (headers -> wo) ->
    unit =
 fun _edn protocol ?request:_ error respond ->
  let contents =
    match error with
    | `Bad_gateway -> {|Bad gateway.|}
    | `Bad_request -> {|Bad request.|}
    | `Exn (Paf.Flow err) | `Exn (Paf.Flow_write err) ->
        Fmt.str {|I/O error: %s.|} err
    | `Exn exn -> Fmt.str {|Unknown error: %S.|} (Printexc.to_string exn)
    | `Internal_server_error -> {|Internal server error.|}
  in
  let headers =
    headers_of_list protocol
      [
        ("content-type", "text/plain");
        ("content-length", string_of_int (String.length contents));
      ]
  in
  respond_with_string protocol ~respond ~headers contents

let http_1_1_error_handler edn ?request error respond =
  alpn_error_handler edn ?request Alpn.http_1_1
    (error :> Alpn.server_error)
    respond

let http_2_0_error_handler edn ?request error respond =
  alpn_error_handler edn ?request Alpn.h2 (error :> Alpn.server_error) respond