feat(portal-tcp): make header into stream

1 files changed, 10 insertions, 7 deletions

diff --git a/portal/tcp/portal.ml b/portal/tcp/portal.ml
index 3abf00e..48d0571 100644
--- a/portal/tcp/portal.ml
+++ b/portal/tcp/portal.ml
@@ -185,10 +185,15 @@ let _encrypted = function
   | Plain _ -> false
   | Tls _ -> true
 
-let header ?from (portal : t) =
+let stream ?from (_socket : socket) : t Lwt.t =
   let stanza =
+    let domain = match _socket with
+      | Plain s -> s.domain
+      | Tls s -> s.domain
+    in
     let attributes =
-      [(("", "to"), portal.domain); (("", "version"), "1.0");
+      [(("", "to"), domain);
+       (("", "version"), "1.0");
        (("http://www.w3.org/XML/1998/namespace", "lang"), "en");
        (("http://www.w3.org/2000/xmlns/", "xmlns"), "jabber:client");
        (("http://www.w3.org/2000/xmlns/", "stream"), xmlns)]
@@ -207,12 +212,10 @@ let header ?from (portal : t) =
            If you have Github, feel free to get the word out to aantron. *)
         `Comment ""]
   in
-  let stream, push = match portal._socket with
+  let stream, push = match _socket with
     | Plain s -> socket_to_stream s
     | Tls s -> socket_to_stream s
-  in portal.stream <- stream;
-     portal.push <- push;
-     push (Some (of_list stanza));
+  in push (Some (of_list stanza));
      let some_id ((_, name), value) = if name = "id" then Some value else None in
      let* xml = Markup_lwt.next stream in
      let* id = match xml with
@@ -225,5 +228,5 @@ let header ?from (portal : t) =
           end
        | _ -> Lwt.return_none
      in match id with
-        | Some id -> Lwt.return id
+        | Some _id -> Lwt.return {stream; push; _socket}
         | None -> Lwt.fail_with "Invalid stream opening server-side."