From 9ada40dd6847162daa1c3e9b14e50472ea030fcc Mon Sep 17 00:00:00 2001
From: Andreas Garnaes <andreas.garnaes@gmail.com>
Date: Thu, 3 Jan 2019 21:48:33 +0100
Subject: [PATCH] Add examples for websocketaf-lwt

---
 examples/lwt/dune           |  3 ++
 examples/lwt/echo_server.ml | 71 +++++++++++++++++++++++++++++++++++++
 examples/lwt/wscat.ml       | 66 ++++++++++++++++++++++++++++++++++
 3 files changed, 140 insertions(+)
 create mode 100644 examples/lwt/dune
 create mode 100644 examples/lwt/echo_server.ml
 create mode 100644 examples/lwt/wscat.ml

diff --git a/examples/lwt/dune b/examples/lwt/dune
new file mode 100644
index 0000000..ddb3e52
--- /dev/null
+++ b/examples/lwt/dune
@@ -0,0 +1,3 @@
+(executables
+ (names wscat echo_server)
+ (libraries websocketaf websocketaf-lwt lwt lwt.unix))
diff --git a/examples/lwt/echo_server.ml b/examples/lwt/echo_server.ml
new file mode 100644
index 0000000..7356301
--- /dev/null
+++ b/examples/lwt/echo_server.ml
@@ -0,0 +1,71 @@
+let connection_handler : Unix.sockaddr -> Lwt_unix.file_descr -> unit Lwt.t =
+  let module Body = Httpaf.Body in
+  let module Headers = Httpaf.Headers in
+  let module Reqd = Httpaf.Reqd in
+  let module Response = Httpaf.Response in
+  let module Status = Httpaf.Status in
+
+  let websocket_handler _ wsd =
+    let frame ~opcode ~is_fin:_ bs ~off ~len =
+      match opcode with
+      | `Continuation
+      | `Text
+      | `Binary ->
+        Websocketaf.Wsd.schedule wsd bs ~kind:`Text ~off ~len
+      | `Connection_close ->
+        Websocketaf.Wsd.close wsd
+      | `Ping ->
+        Websocketaf.Wsd.send_ping wsd
+      | `Pong
+      | `Other _ ->
+        ()
+    in
+    let eof () = ()
+    in
+    { Websocketaf.Server_connection.frame
+    ; eof
+    }
+  in
+
+  let error_handler _client_address ?request:_ error start_response =
+    let response_body = start_response Headers.empty in
+
+    begin match error with
+    | `Exn exn ->
+      Body.write_string response_body (Printexc.to_string exn);
+      Body.write_string response_body "\n";
+
+    | #Status.standard as error ->
+      Body.write_string response_body (Status.default_reason_phrase error)
+    end;
+  in
+
+  Websocketaf_lwt.Server.create_connection_handler
+    ?config:None
+    ~websocket_handler
+    ~error_handler
+
+
+
+let () =
+  let open Lwt.Infix in
+
+  let port = ref 8080 in
+  Arg.parse
+    ["-p", Arg.Set_int port, " Listening port number (8080 by default)"]
+    ignore
+    "Echoes websocket messages. Runs forever.";
+
+  let listen_address = Unix.(ADDR_INET (inet_addr_loopback, !port)) in
+
+  Lwt.async begin fun () ->
+    Lwt_io.establish_server_with_client_socket
+      listen_address connection_handler
+    >>= fun _server ->
+      Printf.printf "Listening on port %i and echoing websocket messages.\n" !port;
+      flush stdout;
+      Lwt.return_unit
+  end;
+
+  let forever, _ = Lwt.wait () in
+  Lwt_main.run forever
diff --git a/examples/lwt/wscat.ml b/examples/lwt/wscat.ml
new file mode 100644
index 0000000..b32c69b
--- /dev/null
+++ b/examples/lwt/wscat.ml
@@ -0,0 +1,66 @@
+open Lwt.Infix
+
+let websocket_handler wsd =
+  let rec input_loop wsd () =
+    Lwt_io.(read_line stdin) >>= fun line ->
+    let payload = Bytes.of_string line in
+    Websocketaf.Wsd.send_bytes wsd ~kind:`Text payload ~off:0 ~len:(Bytes.length payload);
+    input_loop wsd ()
+  in
+  Lwt.async (input_loop wsd);
+  let frame ~opcode:_ ~is_fin:_ bs ~off ~len =
+    let payload = Bytes.create len in
+    Lwt_bytes.blit_to_bytes
+      bs off
+      payload 0
+      len;
+    Printf.printf "%s\n" (Bytes.unsafe_to_string payload);
+    flush stdout
+  in
+  let eof () =
+    Printf.printf "[EOF]\n"
+  in
+  { Websocketaf.Client_connection.frame
+  ; eof
+  }
+
+let error_handler = function
+  | `Handshake_failure (rsp, _body) ->
+    Format.printf "Handshake failure: %a" Httpaf.Response.pp_hum rsp
+  | _ -> assert false
+
+let () =
+  let host = ref None in
+  let port = ref 80 in
+
+  Arg.parse
+    ["-p", Set_int port, " Port number (80 by default)"]
+    (fun host_argument -> host := Some host_argument)
+    "wscat.exe [-p N] HOST";
+
+  let host =
+    match !host with
+    | None -> failwith "No hostname provided"
+    | Some host -> host
+  in
+
+  Lwt_main.run begin
+    Lwt_unix.getaddrinfo host (string_of_int !port) [Unix.(AI_FAMILY PF_INET)]
+    >>= fun addresses ->
+
+    let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+    Lwt_unix.connect socket (List.hd addresses).Unix.ai_addr
+    >>= fun () ->
+
+    let nonce = "0123456789ABCDEF" in
+    let resource = "/" in
+    let port = !port in
+    Websocketaf_lwt.Client.connect
+      socket
+      ~nonce
+      ~host
+      ~port
+      ~resource
+      ~error_handler
+      ~websocket_handler
+  end