path: root/ocaml/lib/io/http.ml

(* Eyre - HTTP Server Driver with Eio
 *
 * This is the HTTP server for serving web requests to Urbit ships.
 * Uses Eio.Net for async TCP connections - can handle thousands of concurrent clients!
 *
 * Key innovation vs C Vere:
 * - C Vere: Blocking HTTP with libh2o, sequential request processing
 * - Overe: Async HTTP with Eio, concurrent request handling with fiber-per-connection
 *)

(* HTTP request *)
type http_method =
  | GET
  | POST
  | PUT
  | DELETE
  | HEAD
  | OPTIONS
  | Other of string

type http_request = {
  method_: http_method;
  path: string;
  version: string;
  headers: (string * string) list;
  body: bytes;
}

(* HTTP response *)
type http_response = {
  status: int;
  status_text: string;
  headers: (string * string) list;
  body: bytes;
}

(* Eyre configuration *)
type config = {
  port: int;
  host: string;
}

(* Eyre driver state *)
type t = {
  config: config;
  mutable stats: stats;
}

and stats = {
  mutable requests_total: int64;
  mutable requests_active: int;
  mutable bytes_sent: int64;
  mutable bytes_recv: int64;
}

(* Create Eyre driver *)
let create config = {
  config;
  stats = {
    requests_total = 0L;
    requests_active = 0;
    bytes_sent = 0L;
    bytes_recv = 0L;
  };
}

(* Parse HTTP method *)
let parse_method str =
  match String.uppercase_ascii str with
  | "GET" -> GET
  | "POST" -> POST
  | "PUT" -> PUT
  | "DELETE" -> DELETE
  | "HEAD" -> HEAD
  | "OPTIONS" -> OPTIONS
  | other -> Other other

(* Method to string *)
let method_to_string = function
  | GET -> "GET"
  | POST -> "POST"
  | PUT -> "PUT"
  | DELETE -> "DELETE"
  | HEAD -> "HEAD"
  | OPTIONS -> "OPTIONS"
  | Other s -> s

(* Parse HTTP request line *)
let parse_request_line line =
  match String.split_on_char ' ' line with
  | [method_str; path; version] ->
      Ok (parse_method method_str, path, version)
  | _ ->
      Error "Invalid request line"

(* Parse HTTP header *)
let parse_header line =
  match String.index_opt line ':' with
  | Some idx ->
      let key = String.sub line 0 idx |> String.trim in
      let value = String.sub line (idx + 1) (String.length line - idx - 1) |> String.trim in
      Ok (key, value)
  | None ->
      Error "Invalid header"

(* Parse HTTP request from string *)
let parse_request data =
  let lines = String.split_on_char '\n' data in
  match lines with
  | [] -> Error "Empty request"
  | request_line :: header_lines ->
      (match parse_request_line (String.trim request_line) with
       | Error e -> Error e
       | Ok (method_, path, version) ->
           (* Parse headers until blank line *)
           let rec parse_headers acc = function
             | [] -> (List.rev acc, "")
             | "" :: rest | "\r" :: rest ->
                 (List.rev acc, String.concat "\n" rest)
             | line :: rest ->
                 (match parse_header (String.trim line) with
                  | Ok header -> parse_headers (header :: acc) rest
                  | Error _ -> parse_headers acc rest)
           in
           let headers, body_str = parse_headers [] header_lines in
           Ok {
             method_;
             path;
             version;
             headers;
             body = Bytes.of_string body_str;
           })

(* Generate HTTP response *)
let generate_response resp =
  let status_line = Printf.sprintf "HTTP/1.1 %d %s\r\n" resp.status resp.status_text in

  let headers_str = List.map (fun (k, v) ->
    Printf.sprintf "%s: %s\r\n" k v
  ) resp.headers |> String.concat "" in

  let response_header = status_line ^ headers_str ^ "\r\n" in

  (* Combine header and body *)
  let header_bytes = Bytes.of_string response_header in
  let total_len = Bytes.length header_bytes + Bytes.length resp.body in
  let result = Bytes.create total_len in

  Bytes.blit header_bytes 0 result 0 (Bytes.length header_bytes);
  Bytes.blit resp.body 0 result (Bytes.length header_bytes) (Bytes.length resp.body);

  result

(* Handle single HTTP connection *)
let handle_connection eyre ~sw:_ ~event_stream flow addr =
  Printf.printf "[Eyre] New connection from %s\n%!"
    (Format.asprintf "%a" Eio.Net.Sockaddr.pp addr);

  eyre.stats.requests_active <- eyre.stats.requests_active + 1;

  try
    (* Read request *)
    let buf = Cstruct.create 16384 in  (* 16KB buffer *)
    let recv_len = Eio.Flow.single_read flow buf in
    let request_data = Cstruct.to_string (Cstruct.sub buf 0 recv_len) in

    eyre.stats.bytes_recv <- Int64.add eyre.stats.bytes_recv (Int64.of_int recv_len);

    Printf.printf "[Eyre] Received %d bytes\n%!" recv_len;

    (* Parse request *)
    (match parse_request request_data with
     | Ok request ->
         eyre.stats.requests_total <- Int64.succ eyre.stats.requests_total;

         Printf.printf "[Eyre] %s %s %s\n%!"
           (method_to_string request.method_)
           request.path
           request.version;

         (* Create ovum for runtime *)
         let ovum = Nock_lib.Effects.make_ovum
           ~wire:(Nock_lib.Noun.atom 0)
           ~card:(Nock_lib.Noun.cell
                   (Nock_lib.Noun.atom 3)  (* eyre tag *)
                   (Nock_lib.Noun.atom 0))  (* simplified request data *)
         in

         (* Send to runtime event queue *)
         Eio.Stream.add event_stream ovum;

         (* Generate simple response *)
         let response = {
           status = 200;
           status_text = "OK";
           headers = [
             ("Content-Type", "text/plain");
             ("Content-Length", "13");
             ("Server", "Overe/0.1");
           ];
           body = Bytes.of_string "Hello, Urbit!";
         } in

         let response_bytes = generate_response response in
         eyre.stats.bytes_sent <- Int64.add eyre.stats.bytes_sent
           (Int64.of_int (Bytes.length response_bytes));

         (* Send response *)
         Eio.Flow.write flow [Cstruct.of_bytes response_bytes];

         Printf.printf "[Eyre] Sent %d byte response\n%!" (Bytes.length response_bytes)

     | Error err ->
         Printf.printf "[Eyre] Failed to parse request: %s\n%!" err;

         (* Send 400 Bad Request *)
         let response = {
           status = 400;
           status_text = "Bad Request";
           headers = [("Content-Length", "0")];
           body = Bytes.empty;
         } in

         let response_bytes = generate_response response in
         Eio.Flow.write flow [Cstruct.of_bytes response_bytes]
    );

    eyre.stats.requests_active <- eyre.stats.requests_active - 1

  with
  | End_of_file ->
      Printf.printf "[Eyre] Client closed connection\n%!";
      eyre.stats.requests_active <- eyre.stats.requests_active - 1
  | e ->
      Printf.printf "[Eyre] Connection error: %s\n%!" (Printexc.to_string e);
      eyre.stats.requests_active <- eyre.stats.requests_active - 1

(* Accept fiber - continuously accepts connections *)
let accept_fiber eyre ~env:_ ~sw ~event_stream listening_socket =
  Printf.printf "[Eyre] Accept fiber started\n%!";

  let rec loop () =
    try
      (* Accept connection - blocks this fiber but not others! *)
      Eio.Net.accept_fork listening_socket ~sw
        ~on_error:(fun exn ->
          Printf.printf "[Eyre] Accept error: %s\n%!" (Printexc.to_string exn)
        )
        (fun flow addr ->
          (* Handle connection in its own fiber *)
          handle_connection eyre ~sw ~event_stream flow addr
        );

      (* Loop forever *)
      loop ()
    with
    | End_of_file ->
        Printf.printf "[Eyre] Accept fiber closed\n%!"
    | Eio.Cancel.Cancelled _ ->
        Printf.printf "[Eyre] Accept fiber cancelled\n%!"
  in

  loop ()

(* Run Eyre driver - spawns accept fiber *)
let run eyre ~env ~sw ~event_stream =
  Printf.printf "[Eyre] Starting HTTP server on %s:%d\n%!"
    eyre.config.host eyre.config.port;

  (* Create listening socket *)
  let net = Eio.Stdenv.net env in
  let addr = `Tcp (Eio.Net.Ipaddr.V4.any, eyre.config.port) in
  let listening_socket = Eio.Net.listen net ~sw ~reuse_addr:true ~backlog:128 addr in

  Printf.printf "[Eyre] Listening on port %d\n%!" eyre.config.port;

  (* Spawn accept fiber *)
  Eio.Fiber.fork ~sw (fun () ->
    accept_fiber eyre ~env ~sw ~event_stream listening_socket
  );

  Printf.printf "[Eyre] HTTP server running!\n%!"

(* Get statistics *)
let get_stats eyre = eyre.stats