summaryrefslogtreecommitdiff
path: root/ocaml/lib
diff options
context:
space:
mode:
Diffstat (limited to 'ocaml/lib')
-rw-r--r--ocaml/lib/io/dune2
-rw-r--r--ocaml/lib/io/http.ml285
2 files changed, 286 insertions, 1 deletions
diff --git a/ocaml/lib/io/dune b/ocaml/lib/io/dune
index db1abbb..924541c 100644
--- a/ocaml/lib/io/dune
+++ b/ocaml/lib/io/dune
@@ -1,4 +1,4 @@
(library
(name io_drivers)
- (modules behn ames)
+ (modules behn ames http)
(libraries nock_lib zarith eio eio.unix))
diff --git a/ocaml/lib/io/http.ml b/ocaml/lib/io/http.ml
new file mode 100644
index 0000000..97a4b08
--- /dev/null
+++ b/ocaml/lib/io/http.ml
@@ -0,0 +1,285 @@
+(* 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
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-16 15:02:23 +0000