diff options
Diffstat (limited to 'portal/ws/portal.ml')
-rw-r--r-- | portal/ws/portal.ml | 37 |
1 files changed, 18 insertions, 19 deletions
diff --git a/portal/ws/portal.ml b/portal/ws/portal.ml index 6814e7c..33e5743 100644 --- a/portal/ws/portal.ml +++ b/portal/ws/portal.ml @@ -106,27 +106,26 @@ let ws_endpoint (domain : string) : string Lwt.t = | Some x -> Lwt.return x | None -> Lwt.fail_with (domain ^ ": no WebSocket endpoint in Web-host Metadata.") -(** [ws_stream url] is a promise to a framed Lwt stream (and its push function) - communicating with the websocket located at [url] using the XMPP protocol. - - Valid XMPP WebSocket subprotocol frames must be sent to the stream, because it - directly exposes the websocket under. +(** [connect url] is a promise to a [socket] communicating with [url] using the XMPP + protocol. If the websocket is closed server-side, the stream closes. *) -let ws_stream (url : string) = - let open Lwt_stream in - let stream, message = create () in - let open Lwt_condition in - let is_open = create () in - let (ws : WebSockets.webSocket Js.t) = - new%js WebSockets.webSocket_withProtocol (jss url) (jss "xmpp") - in let push = function - | Some msg -> ws##send (jss msg) - | None -> ws##close - in ws##.onclose := Dom.handler (fun _ -> message None; Js._true); - ws##.onmessage := Dom.handler (fun x -> Some (sjs x##.data) |> message; Js._false); - ws##.onopen := Dom.handler (fun _ -> signal is_open (); Js._false); - let+ () = wait is_open in stream, push, ws +let connect (domain : domain) : socket Lwt.t = + let ws_stream (url : string) = + let open Lwt_stream in + let stream, message = create () in + let open Lwt_condition in + let is_open = create () in + let (ws : WebSockets.webSocket Js.t) = + new%js WebSockets.webSocket_withProtocol (jss url) (jss "xmpp") + in let push = function + | Some msg -> ws##send (jss msg) + | None -> ws##close + in ws##.onclose := Dom.handler (fun _ -> message None; Js._true); + ws##.onmessage := Dom.handler (fun x -> Some (sjs x##.data) |> message; Js._false); + ws##.onopen := Dom.handler (fun _ -> signal is_open (); Js._false); + let+ () = wait is_open in {domain; stream; push} + in ws_endpoint domain >>= ws_stream (** [portal_of_socket] is a Portal communicating with the socket [socket] via the Websocket subprotocol. |