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

@@ -0,0 +1,36 @@
+open Core
+open Async
+
+open Httpun_async
+
+let request_handler (_ : [< Socket.Address.t]) = Httpun_examples.Server.echo_post
+let error_handler (_ : [< Socket.Address.t]) = Httpun_examples.Server.error_handler
+
+let main port max_accepts_per_batch () =
+  let where_to_listen = Tcp.Where_to_listen.of_port port in
+  Tcp.(Server.create_sock ~on_handler_error:`Raise
+      ~backlog:10_000 ~max_connections:10_000 ~max_accepts_per_batch where_to_listen)
+  (Server.create_connection_handler ~request_handler ~error_handler)
+
+  >>= fun _server ->
+    Stdio.printf "Listening on port %i and echoing POST requests.\n" port;
+    Stdio.printf "To send a POST request, try one of the following\n\n";
+    Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/async/async_post.exe\n";
+    Stdio.printf "  echo \"Testing echo POST\" | dune exec examples/lwt/lwt_post.exe\n";
+    Stdio.printf "  echo \"Testing echo POST\" | curl -XPOST --data @- http://localhost:%d\n\n%!" port;
+    Deferred.never ()
+;;
+
+let () =
+  Command.async
+    ~summary:"Echo POST requests"
+    Command.Param.(
+      map (both
+          (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"))
+        ~f:(fun (port, accepts) ->
+              (fun () -> main port accepts ())))
+  |> Command_unix.run
+;;

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

@@ -0,0 +1,38 @@
+open! Core
+open Async
+
+open Httpun
+open Httpun_async
+
+let main port host () =
+  let where_to_connect = Tcp.Where_to_connect.of_host_and_port { host; port } in
+  Tcp.connect_sock where_to_connect
+  >>= fun socket ->
+    let finished = Ivar.create () in
+    let response_handler =
+      Httpun_examples.Client.print
+        ~on_eof:((Ivar.fill [@ocaml.alert "-deprecated"]) finished) in
+    let headers = Headers.of_list [ "host", host ] in
+    Client.create_connection socket >>= fun connection ->
+    let request_body =
+      Client.request
+        connection
+        ~error_handler:Httpun_examples.Client.error_handler
+        ~response_handler
+        (Request.create ~headers `GET "/")
+    in
+    Body.Writer.close request_body;
+    Ivar.read finished
+;;
+
+let () =
+  Command.async
+    ~summary:"Start a hello world Async client"
+    Command.Param.(
+      map (both
+          (flag "-p" (optional_with_default 80 int)
+            ~doc:"int destination port")
+          (anon ("host" %: string)))
+        ~f:(fun (port, host) ->
+              (fun () -> main port host ())))
+  |> Command_unix.run

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

@@ -0,0 +1,55 @@
+open! Core
+open Async
+
+open Httpun
+open Httpun_async
+
+let error_handler _ = assert false
+
+let main port host () =
+  let where_to_connect = Tcp.Where_to_connect.of_host_and_port { host; port } in
+  Tcp.connect_sock where_to_connect
+  >>= fun socket ->
+    let finished = Ivar.create () in
+    let response_handler =
+      Httpun_examples.Client.print
+        ~on_eof:((Ivar.fill [@ocaml.alert "-deprecated"]) finished) in
+    let request_headers =
+      Request.create ~headers:(Headers.of_list [ "host", host ]) `GET "/"
+    in
+    Client.create_connection socket >>= fun connection ->
+    let request_body =
+      Client.request
+        connection
+        ~response_handler
+        ~error_handler
+        request_headers
+    in
+    let finished' = Ivar.create () in
+    let response_handler' =
+      Httpun_examples.Client.print ~on_eof:((Ivar.fill [@ocaml.alert "-deprecated"]) finished')
+    in
+    let request_body' =
+      Client.request
+        connection
+        ~response_handler:response_handler'
+        ~error_handler
+        request_headers
+    in
+    Body.Writer.close request_body';
+    Body.Writer.close request_body;
+    Async.Deferred.all_unit [Ivar.read finished; Ivar.read finished'] >>= fun () ->
+      Client.shutdown connection
+;;
+
+let () =
+  Command.async
+    ~summary:"Start a hello world Async client"
+    Command.Param.(
+      map (both
+          (flag "-p" (optional_with_default 80 int)
+            ~doc:"int destination port")
+          (anon ("host" %: string)))
+        ~f:(fun (port, host) ->
+              (fun () -> main port host ())))
+  |> Command_unix.run

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

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

@@ -0,0 +1,50 @@
+open Core
+open Async
+
+open Httpun
+open Httpun_async
+
+let response_handler finished response response_body =
+  match response with
+  | { Response.status = `OK; _ } ->
+    let rec on_read bs ~off ~len =
+      Bigstring.to_string ~pos:off ~len bs |> print_endline;
+      Body.Reader.schedule_read response_body ~on_read ~on_eof
+    and on_eof () = (Ivar.fill [@ocaml.alert "-deprecated"]) finished () in
+    Body.Reader.schedule_read response_body ~on_read ~on_eof;
+  | response ->
+    Format.fprintf Format.std_formatter "%a\n%!" Response.pp_hum response;
+    Core.exit 1
+;;
+
+let error_handler _ = assert false
+
+let main port host () =
+  let where_to_connect = Tcp.Where_to_connect.of_host_and_port { host; port } in
+  let finished = Ivar.create () in
+  Tcp.connect_sock where_to_connect
+  >>= fun socket ->
+    Client.SSL.create_connection_with_default socket >>= fun conn ->
+    let headers = Headers.of_list [ "host", host ] in
+    let request_body =
+      Client.SSL.request
+        ~error_handler
+        ~response_handler:(response_handler finished)
+        conn
+        (Request.create ~headers `GET "/")
+    in
+    Body.Writer.close request_body;
+    Ivar.read finished
+;;
+
+let () =
+  Command.async_spec
+    ~summary:"Start a hello world Async server"
+    Command.Spec.(empty +>
+      flag "-p" (optional_with_default 443 int)
+        ~doc:"int destination port"
+      +>
+      flag "-h" (required string)
+        ~doc:"string destination host"
+    ) main
+  |> Command_unix.run

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

@@ -0,0 +1,54 @@
+open Core
+open Async
+
+open Httpun
+open Httpun_async
+
+let main port host () =
+  let where_to_connect = Tcp.Where_to_connect.of_host_and_port { host; port } in
+  Tcp.connect_sock where_to_connect
+  >>= fun socket ->
+    let finished = Ivar.create () in
+    let response_handler =
+      Httpun_examples.Client.print
+        ~on_eof:((Ivar.fill [@alert "-deprecated"]) finished) in
+    let headers =
+      Headers.of_list
+      [ "transfer-encoding", "chunked"
+      ; "connection"       , "close"
+      ; "host"             , host
+      ]
+    in
+    Client.create_connection socket >>= fun connection ->
+    let request_body =
+      Client.request
+        connection
+        ~error_handler:Httpun_examples.Client.error_handler
+        ~response_handler
+        (Request.create ~headers `POST "/")
+    in
+    let stdin = Lazy.force Reader.stdin in
+    don't_wait_for (
+      Reader.read_one_chunk_at_a_time stdin ~handle_chunk:(fun bs ~pos:off ~len ->
+        Body.Writer.write_bigstring request_body bs ~off ~len;
+        Body.Writer.flush request_body (fun _reason -> ());
+        return (`Consumed(len, `Need_unknown)))
+      >>| function
+        | `Eof_with_unconsumed_data s -> Body.Writer.write_string request_body s;
+                                         Body.Writer.close request_body
+        | `Eof                        -> Body.Writer.close request_body
+        | `Stopped ()                 -> assert false);
+    Ivar.read finished
+;;
+
+let () =
+  Command.async
+    ~summary:"Start a hello world Async client"
+    Command.Param.(
+      map (both
+          (flag "-p" (optional_with_default 80 int)
+            ~doc:"int destination port")
+          (anon ("host" %: string)))
+        ~f:(fun (port, host) ->
+              (fun () -> main port host ())))
+  |> Command_unix.run

unikernel/duniverse/httpun/examples/async/dune

@@ -0,0 +1,22 @@
+(executables
+ (libraries
+  httpun
+  httpun-async
+  httpun_examples
+  async
+  core
+  core_unix.command_unix)
+ (names
+  async_echo_post
+  async_get
+  async_get_pipelined
+  async_post
+  async_https_get
+  async_https_echo_post)
+ (flags
+  (:standard -w -9)))
+
+(alias
+ (name examples)
+ (deps
+  (glob_files *.exe)))