feat(portal_tcp): rewrite stanza_open to negotiate

1 files changed, 17 insertions, 2 deletions

diff --git a/portal/tcp/portal.ml b/portal/tcp/portal.ml
index 32ff507..1ff4058 100644
--- a/portal/tcp/portal.ml
+++ b/portal/tcp/portal.ml
@@ -8,7 +8,7 @@ let xmlns = "jabber:client"
 
 exception MalformedStanza of Markup.location * Markup.Error.t
 
-let stanza_open ?from domain : (signal, sync) stream =
+let negotiate ?from domain ((stream, push) : t) =
   let stanza =
     let attributes =
       [(("", "to"), domain); (("", "version"), "1.0");
@@ -29,7 +29,22 @@ let stanza_open ?from domain : (signal, sync) stream =
 
            If you have Github, feel free to get the word out to aantron. *)
         `Comment ""]
-  in stanza |> of_list
+  and error = Lwt.fail_with "TODO"
+  in push (Some (of_list stanza));
+     let* xml = Markup_lwt.next stream
+     in match xml with
+        | Some `Xml {version="1.0"; encoding=None; standalone=None} ->
+           let* stream_open = Markup_lwt.next stream in
+           begin
+             match stream_open with
+             | Some `Start_element (("http://etherx.jabber.org/streams", "stream"), attributes) ->
+                List.find_map
+                  (fun ((_, name), value) -> if name = "id" then Some value else None)
+                  attributes
+                |> Option.fold ~none:error ~some:Lwt.return
+             | _ -> error
+           end
+        | _ -> error
 
 let stanza_close : (signal, sync) stream = [`End_element] |> Markup.of_list