feat(portal_ws): create connect function

2 files changed, 27 insertions, 15 deletions

diff --git a/portal/lib/portal_ws.ml b/portal/lib/portal_ws.ml
index 1921891..f8fb4a9 100644
--- a/portal/lib/portal_ws.ml
+++ b/portal/lib/portal_ws.ml
@@ -1,4 +1,5 @@
 open Lwt.Syntax
+open Lwt.Infix
 open Js_of_ocaml
 let jss = Js.string
 let sjs = Js.to_string
@@ -59,6 +60,23 @@ let ws_stream (url : string) =
              Dom.handler (fun _ -> message None; Js._true);
            stream, push
 
-(* let connect domain = *)
-(*   let+ url = server_ws domain *)
-(*   in ws_stream url *)
+
+let connect domain =
+  (** [connect domain] is an Lwt stream (and its push function) communicating with the XMPP server running at [domain]
+      via the Websocket subprotocol.
+
+      This function is a complex wrapper around ws_stream, that accepts streamed XML and sends framed XML stanzas to
+      the underlying socket, with exactly one stanza per frame, according to RFC 7935.
+
+      It also sends the <close/> stanza used by the WebSocket subprotocol to the underlying WebSocket.
+
+      In essence, it (tries to) expose an identical interface to the original XMPP streamed protocol.
+
+      Here's an ASCII rendered flow of the data through the various streams.
+      / -> push -> streamed_stanzas -> to_frames -> ws_push -> \
+      function user                                     websocket
+      \  <---- stream <----  filter_map  <---- ws_stream <---- / *)
+  let open Lwt_stream in
+  let+ stream, ws_push = ws_endpoint domain >|= ws_stream in
+  let _streamed_stanzas, _push = create () in
+  stream, ws_push
diff --git a/portal/test/js/websockets_hello.ml b/portal/test/js/websockets_hello.ml
index 76b70e4..1e8b364 100644
--- a/portal/test/js/websockets_hello.ml
+++ b/portal/test/js/websockets_hello.ml
@@ -17,15 +17,9 @@ let rec run t =
 
 let () =
   run @@
-    let* ws = Portal_ws.ws_endpoint "squarebowl.club" in
-    let stream, push =
-      Portal_ws.ws_stream ws in
-    push (Some "malformed");
-    let+ stanzas = stream
-                   |> Lwt_stream.map
-                        (fun stanza ->
-                          match stanza with
-                          | {|<close xmlns='urn:ietf:params:xml:ns:xmpp-framing'/>|} -> push None; stanza
-                          | stanza -> stanza)
-                   |> Lwt_stream.to_list
-    in List.map (fun x -> " >>> " ^ x) stanzas |> String.concat "\n" |> print_endline
+    let domain = "squarebowl.club" in
+    let* stream, push =
+      Portal_ws.connect domain in
+       push (Some {|<malformed/>|});
+       let+ _ = Lwt_stream.iter (fun f -> print_endline f) stream
+       in push None