refactor(portal-ws): move header function to stream

1 files changed, 34 insertions, 31 deletions

diff --git a/portal/ws/portal.ml b/portal/ws/portal.ml
index 3b15fbc..df0672e 100644
--- a/portal/ws/portal.ml
+++ b/portal/ws/portal.ml
@@ -37,37 +37,6 @@ exception MalformedStanza of Markup.Error.t
    rules. *)
 let well_known_of (domain : string) = "https://" ^ domain ^ "/.well-known/host-meta"
 
-(** [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 stanza =
-    let attributes =
-      let open Option in
-      [(("", "xmlns"), xmlns);
-       (("", "to"), domain)]
-      @ (map (fun jid -> (("", "from"), jid)) from |> to_list)
-      @ [(("", "version"), "1.0")]
-    in
-    [`Start_element
-       ((xmlns, "open"),
-        attributes);
-     `End_element]
-  in push (Some (of_list stanza));
-     let some_id ((_, name), value) = if name = "id" then Some value else None in
-     let* stanza_open = Markup_lwt.next stream in
-     let* id = match stanza_open with
-       | Some `Start_element ((ns, "open"), attributes) when ns = xmlns ->
-          let* close = Markup_lwt.next stream in
-          begin match close with
-          | Some `End_element -> List.find_map some_id attributes |> Lwt.return
-          | _ -> Lwt.return_none
-          end
-       | _ -> Lwt.return_none
-     in match id with
-        | Some id -> Lwt.return id
-        | None -> Lwt.fail_with "Invalid stream opening server-side."
-
 (** [ws_endpoint domain] is a promise containing the XMPP websocket endpoint
     associated with [domain], by using the domain's Web-host Metadata.
 
@@ -178,6 +147,40 @@ let portal_of_socket (ws : socket) : t =
                |> Lwt_stream.iter (fun s -> ws.push (Some s)));
   {stream; push; _socket=ws}
 
+(** [stream socket] is a promise to a Portal connected to [domain].
+
+    If [from] is specified, the <open /> stanza sent to the portal has a from
+    parameter. *)
+let stream ?from (socket : socket) : t Lwt.t =
+  let portal = portal_of_socket socket in
+  let {stream; push; _} = portal in
+  let stanza =
+    let attributes =
+      let open Option in
+      [(("", "xmlns"), xmlns);
+       (("", "to"), socket.domain)]
+      @ (map (fun jid -> (("", "from"), jid)) from |> to_list)
+      @ [(("", "version"), "1.0")]
+    in
+    [`Start_element
+       ((xmlns, "open"),
+        attributes);
+     `End_element]
+  in push (Some (of_list stanza));
+     let some_id ((_, name), value) = if name = "id" then Some value else None in
+     let* stanza_open = Markup_lwt.next stream in
+     let* id = match stanza_open with
+       | Some `Start_element ((ns, "open"), attributes) when ns = xmlns ->
+          let* close = Markup_lwt.next stream in
+          begin match close with
+          | Some `End_element -> List.find_map some_id attributes |> Lwt.return
+          | _ -> Lwt.return_none
+          end
+       | _ -> Lwt.return_none
+     in match id with
+        | Some _id -> Lwt.return portal
+        | None -> Lwt.fail_with "Invalid stream opening server-side."
+
 let starttls _ = Lwt.fail_with "STARTTLS is unimplemented in WebSockets."
 
 let _encrypted _ = true