feat(portal_tcp): add connect function

1 files changed, 11 insertions, 8 deletions

diff --git a/portal/tcp/portal_tcp.ml b/portal/tcp/portal_tcp.ml
index 69f0348..451d303 100644
--- a/portal/tcp/portal_tcp.ml
+++ b/portal/tcp/portal_tcp.ml
@@ -32,11 +32,14 @@ let tcp_stream (domain : string) : (string Lwt_stream.t * file_descr) Lwt.t =
                  | len -> Lwt.return_some (Bytes.sub_string buffer 0 len))
         in (stream, sock)
 
-let connect (domain : string) =
-  let+ tcp_stream, tcp_socket = tcp_stream domain
-  in let push msg =
-       let none () = close tcp_socket
-       and some s () =
-         write_string tcp_socket s 0 (String.length s) |> Lwt.map ignore
-       in Option.fold ~none ~some msg |> Lwt.async
-     in tcp_stream, push
+let connect (domain : string) : t Lwt.t =
+  let+ tcp_stream, tcp_socket = tcp_stream domain in
+  let push msg =
+    let none () = close tcp_socket
+    and some s () =
+      let str = write_xml s |> to_string
+      in write_string tcp_socket str 0 (String.length str) |> Lwt.map ignore
+    in Option.fold ~none ~some msg |> Lwt.async
+  and report loc err = raise (MalformedStanza (loc, err)) in
+  let open Markup_lwt in
+  tcp_stream |> lwt_stream |> strings_to_bytes |> parse_xml ~report |> signals, push