(* todo-ocaml: <bin> --socket <path> --db <path>, or --listen 127.0.0.1:<port>
   in place of --socket for local runs. *)

let usage = "app (--socket <path> | --listen 127.0.0.1:<port>) --db <path>"

(* Bodies are form posts; 1 MiB is far more than any title needs. *)
let max_body = 1 lsl 20

(* The request line and headers of one request, together. *)
let max_head = 64 * 1024

(* Each connection costs at most about max_head + max_body of buffers. *)
let max_connections = 256

(* A socket that refuses to read more than [remaining] bytes. cohttp-eio
   parses headers from an unbounded buffer, so every read goes through one
   of these: a connection starts with max_head bytes, and each request it
   carries gets max_body + max_head more (its body, then the next request's
   head). Running out raises [Head_too_large]. *)
module Budget = struct
  exception Head_too_large

  type t = { flow : Eio.Flow.source_ty Eio.Resource.t; mutable remaining : int }

  let read_methods = []

  let single_read t buf =
    if t.remaining <= 0 then raise Head_too_large;
    let buf = if Cstruct.length buf > t.remaining then Cstruct.sub buf 0 t.remaining else buf in
    let n = Eio.Flow.single_read t.flow buf in
    t.remaining <- t.remaining - n;
    n

  let handler = Eio.Flow.Pi.source (module struct
    type nonrec t = t
    let read_methods = read_methods
    let single_read = single_read
  end)

  let source t : Eio.Flow.source_ty Eio.Resource.t = Eio.Resource.T (t, handler)

  (* The budget of the connection whose request is being handled. *)
  let key : t Eio.Fiber.key = Eio.Fiber.create_key ()

  let next_request () =
    Option.iter (fun t -> t.remaining <- max_body + max_head) (Eio.Fiber.get key)
end

let fail fmt = Printf.ksprintf (fun s -> prerr_endline ("app: " ^ s); exit 2) fmt

let parse_listen s =
  match String.rindex_opt s ':' with
  | None -> fail "--listen wants 127.0.0.1:<port>, got %S" s
  | Some i -> (
      let host = String.sub s 0 i and port = String.sub s (i + 1) (String.length s - i - 1) in
      match (host, int_of_string_opt port) with
      | "127.0.0.1", Some port when port > 0 && port < 65536 ->
          (`Tcp (Eio.Net.Ipaddr.V4.loopback, port), "http://" ^ s)
      | "127.0.0.1", _ -> fail "bad port in --listen %S" s
      | _ -> fail "--listen only binds 127.0.0.1, got %S" host)

let to_app_request req body =
  let headers = Http.Request.headers req in
  let uri = Uri.of_string (Http.Request.resource req) in
  {
    Todo.App.meth = Http.Method.to_string (Http.Request.meth req);
    path = Uri.path uri;
    query = List.map (fun (k, v) -> (k, String.concat "," v)) (Uri.query uri);
    header = Http.Header.get headers;
    body;
  }

let callback app _conn req body =
  Budget.next_request ();
  let body =
    match Http.Request.meth req with
    | `POST -> Eio.Buf_read.(parse take_all) ~max_size:max_body body
    | _ -> Ok ""
  in
  let (res : Todo.App.response) =
    match body with
    | Ok body -> Todo.App.handle app (to_app_request req body)
    | Error _ -> Todo.App.text 413 "Request body too large\n"
  in
  let headers = Http.Header.of_list res.headers in
  let status = Http.Status.of_int res.status in
  match Http.Request.meth req with
  | `HEAD ->
      let headers = Http.Header.add headers "content-length" (string_of_int (String.length res.body)) in
      Cohttp_eio.Server.respond ~headers ~status ~body:(Eio.Flow.string_source "") ()
  | _ -> Cohttp_eio.Server.respond_string ~headers ~status ~body:res.body ()

(* One connection: cohttp-eio's own loop over keep-alive requests, reading
   through a Budget. A head too large for it gets 431 and the connection
   closes. *)
let connection server socket peer =
  Eio.Switch.run @@ fun sw ->
  let budget = { Budget.flow = (socket :> Eio.Flow.source_ty Eio.Resource.t); remaining = max_head } in
  let input = Eio.Buf_read.of_flow ~max_size:max_head (Budget.source budget) in
  Eio.Fiber.with_binding Budget.key budget @@ fun () ->
  try
    Eio.Buf_write.with_flow socket @@ fun output ->
    try Cohttp_eio.Server.callback server (sw, peer) input output
    with Budget.Head_too_large | Eio.Buf_read.Buffer_limit_exceeded ->
      Eio.Buf_write.string output
        "HTTP/1.1 431 Request Header Fields Too Large\r\ncontent-length: 0\r\nconnection: close\r\n\r\n"
  with Eio.Io (Eio.Net.E (Connection_reset _), _) -> ()

let () =
  let socket = ref "" and listen = ref "" and db = ref "" in
  Arg.parse
    [ ("--socket", Arg.Set_string socket, "<path> unix socket to listen on");
      ("--listen", Arg.Set_string listen, "<127.0.0.1:port> TCP address, for local runs");
      ("--db", Arg.Set_string db, "<path> SQLite database file") ]
    (fun a -> fail "unexpected argument %S" a)
    usage;
  if !db = "" || (!socket = "") = (!listen = "") then (prerr_endline ("usage: " ^ usage); exit 2);
  let addr, origin =
    if !listen <> "" then parse_listen !listen
    else
      ( `Unix !socket,
        match Sys.getenv_opt "CARLOS_HOST" with
        | Some h when h <> "" -> "https://" ^ h
        | _ -> "http://localhost" )
  in
  let store = Todo.Store.open_ !db in
  let app = Todo.App.create ~store ~origin ~version:Todo.Version.v in
  (* SIGTERM and SIGINT stop the server; Condition.broadcast is signal-safe. *)
  let stop = Eio.Condition.create () in
  let on_signal _ = Eio.Condition.broadcast stop in
  Sys.set_signal Sys.sigterm (Sys.Signal_handle on_signal);
  Sys.set_signal Sys.sigint (Sys.Signal_handle on_signal);
  Eio_posix.run (fun env ->
      Eio.Switch.run (fun sw ->
          (match addr with `Unix path when Sys.file_exists path -> Sys.remove path | _ -> ());
          let sock = Eio.Net.listen ~sw ~backlog:128 ~reuse_addr:true (Eio.Stdenv.net env) addr in
          Printf.eprintf "app: %s listening on %s\n%!" Todo.Version.v
            (if !listen <> "" then !listen else !socket);
          let server = Cohttp_eio.Server.make ~callback:(callback app) () in
          Eio.Fiber.first
            (fun () -> Eio.Condition.await_no_mutex stop)
            (fun () ->
              Eio.Net.run_server sock (connection server) ~max_connections ~on_error:(fun e ->
                  Printf.eprintf "app: %s\n%!" (Printexc.to_string e)))));
  (match addr with `Unix path -> (try Sys.remove path with Sys_error _ -> ()) | _ -> ());
  Todo.Store.close store;
  prerr_endline "app: stopped"