diff options
Diffstat (limited to 'portal/ws/portal.ml')
| -rw-r--r-- | portal/ws/portal.ml | 9 |
1 files changed, 5 insertions, 4 deletions
diff --git a/portal/ws/portal.ml b/portal/ws/portal.ml index ee4b636..dfd12cf 100644 --- a/portal/ws/portal.ml +++ b/portal/ws/portal.ml @@ -10,6 +10,7 @@ type socket = WebSockets.webSocket Js.t type t = { stream : (signal, async) stream; push : (signal, sync) stream option -> unit; + _socket : socket; } let xmlns = "urn:ietf:params:xml:ns:xmpp-framing" @@ -21,7 +22,7 @@ let well_known_of (domain : string) = "https://" ^ domain ^ "/.well-known/host-m (** [open_stanza domain] is an <open /> stanza for [domain]. If [from] is specified, the <open /> stanza has the from parameter. *) -let header ?from domain {stream; push} = +let header ?from domain {stream; push; _} = let stanza = let attributes = let open Option in @@ -111,7 +112,7 @@ let ws_stream (url : string) = 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 + let+ () = wait is_open in stream, push, ws (** [connect domain] is an Lwt stream (and its push function) communicating with the XMPP server running at [domain] via the Websocket subprotocol. @@ -128,7 +129,7 @@ let ws_stream (url : string) = function user websocket \ <--- stream <--- markup_lwt <--- ws_stream <--- / *) let connect domain = - let+ ws_stream, ws_push = ws_endpoint domain >>= ws_stream in + let+ ws_stream, ws_push, ws = ws_endpoint domain >>= ws_stream in let open Markup_lwt in (* When sending a malformed stanza (one that Markup.ml doesn't like), a MalformedStanza exception is raised. *) @@ -153,4 +154,4 @@ let connect domain = |> map (fun x -> write_xml x |> to_string) |> to_lwt_stream |> Lwt_stream.iter (fun s -> ws_push (Some s))); - {stream; push} + {stream; push; _socket=ws} |