unikernel/duniverse/httpun/examples/async/async_https_echo_post.ml

@@ -0,0 +1,68 @@
+open Core
+open Async
+
+open Httpun
+open Httpun_async
+
+
+let error_handler _ ?request:_ error start_response =
+  let response_body = start_response Headers.empty in
+  begin match error with
+  | `Exn exn ->
+    Body.Writer.write_string response_body (Exn.to_string exn);
+    Body.Writer.write_string response_body "\n";
+  | #Status.standard as error ->
+    Body.Writer.write_string response_body (Status.default_reason_phrase error)
+  end;
+  Body.Writer.close response_body
+;;
+
+let request_handler _ { Gluten.reqd; _ } =
+  match Reqd.request reqd  with
+  | { Request.meth = `POST; headers } ->
+    let response =
+      let content_type =
+        match Headers.get headers "content-type" with
+        | None   -> "application/octet-stream"
+        | Some x -> x
+      in
+      Response.create ~headers:(Headers.of_list ["content-type", content_type; "connection", "close"]) `OK
+    in
+    let request_body  = Reqd.request_body reqd in
+    let response_body = Reqd.respond_with_streaming reqd response in
+    let rec on_read buffer ~off ~len =
+      Body.Writer.write_bigstring response_body buffer ~off ~len;
+      Body.Reader.schedule_read request_body ~on_eof ~on_read;
+    and on_eof () =
+      print_endline "eof";
+      Body.Writer.close response_body
+    in
+    Body.Reader.schedule_read (Reqd.request_body reqd) ~on_eof ~on_read
+  | _ -> Reqd.respond_with_string reqd (Response.create `Method_not_allowed) ""
+;;
+
+let main port max_accepts_per_batch () =
+  let where_to_listen = Tcp.Where_to_listen.bind_to
+    (Tcp.Bind_to_address.Localhost)
+    (Tcp.Bind_to_port.On_port port) in
+  Tcp.(Server.create_sock ~on_handler_error:`Ignore
+      ~backlog:10_000 ~max_connections:10_000 ~max_accepts_per_batch where_to_listen)
+    (Server.SSL.create_connection_handler_with_default
+      ~certfile:"./certificates/server.pem"
+      ~keyfile:"./certificates/server.key"
+      ~request_handler
+      ~error_handler)
+  >>= fun _server ->
+  Deferred.never ()
+
+let () =
+  Command.async_spec
+    ~summary:"Start a hello world Async server"
+    Command.Spec.(empty +>
+      flag "-p" (optional_with_default 8080 int)
+        ~doc:"int Source port to listen on"
+      +>
+      flag "-a" (optional_with_default 1 int)
+        ~doc:"int Maximum accepts per batch"
+    ) main
+  |> Command_unix.run