diff options
| -rw-r--r-- | portal/tcp/portal.ml | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/portal/tcp/portal.ml b/portal/tcp/portal.ml index f1eaff9..d70d21b 100644 --- a/portal/tcp/portal.ml +++ b/portal/tcp/portal.ml @@ -1,5 +1,4 @@ open Lwt.Syntax -open Lwt.Infix open Lwt_unix open Markup @@ -71,9 +70,9 @@ let tcp_socket (domain : string) : file_descr Lwt.t = let* addrinfos = getaddrinfo domain port_number [AI_SOCKTYPE SOCK_STREAM] in List.map get_socket addrinfos |> Lwt.pick -(** [file_descr_to_portal sock] is a Portal wrapping the Unix socket [sock] in Markup - signals, for XML consumption. *) -let file_descr_to_portal (sock : file_descr) : t = +(** [socket_to_stream sock] is a [stream, push] tuple wrapping the Unix socket [sock] in + Markup signals. *) +let socket_to_stream (sock : socket) = let raw_stream = Lwt_stream.from (fun () -> let bsize = 4096 in @@ -101,9 +100,11 @@ let file_descr_to_portal (sock : file_descr) : t = in Lwt.async (fun () -> let* _ = lwt_stream xml_stream |> Markup_lwt.write_xml |> iter send_char in Lwt_unix.close sock); - {stream; push; _socket=sock} + (stream, push) (** [connect domain] is a Portal.t communicating with the XMPP server located at [domain] via plaintext TCP. It simply chains the two previous functions. *) let connect (domain : string) : t Lwt.t = - tcp_socket domain >|= file_descr_to_portal + let+ _socket = tcp_socket domain + in let stream, push = socket_to_stream _socket + in {stream; push; _socket} |