feat(portal): change type t into a record

6 files changed, 32 insertions, 23 deletions

diff --git a/lib/sasl.ml b/lib/sasl.ml
index 137d84a..02c9222 100644
--- a/lib/sasl.ml
+++ b/lib/sasl.ml
@@ -29,7 +29,7 @@ let parse_sasl_error = function
 
 type sasl_auth = (string option, sasl_error * (string * string) option) result
 
-let send_auth_stanza (stream, push) localpart pass mechanism =
+let send_auth_stanza ({stream; push} : Portal.t) localpart pass mechanism =
   let gen_auth = function
     | PLAIN -> Base64.encode_exn ("\x00" ^ localpart ^ "\x00" ^ pass)
     | Unknown s -> failwith "Unsupported authentication mechanism " ^ s
diff --git a/lib/stream.ml b/lib/stream.ml
index ff3b939..a4795ef 100644
--- a/lib/stream.ml
+++ b/lib/stream.ml
@@ -43,7 +43,7 @@ let parse_features (el : Xml.element) : features =
 
     Basically, it conforms to
     {{: https://datatracker.ietf.org/doc/html/rfc6120#section-4.3 }}. *)
-let negotiate (domain : string) ((stream, push) : Portal.t) : features Lwt.t =
-  let* _id = Portal.header domain (stream, push)
-  in let+ features = Xml.get stream >|= parse_features
+let negotiate (domain : string) (portal : Portal.t) : features Lwt.t =
+  let* _id = Portal.header domain portal
+  in let+ features = Xml.get portal.stream >|= parse_features
      in features
diff --git a/portal/portal.mli b/portal/portal.mli
index d57a839..1fe90ef 100644
--- a/portal/portal.mli
+++ b/portal/portal.mli
@@ -2,10 +2,13 @@ open Markup
 
 exception MalformedStanza of location * Error.t
 
-type t = (signal, async) stream * ((signal, sync) stream option -> unit)
-
 type socket
 
+type t = {
+    stream : (signal, async) stream;
+    push : (signal, sync) stream option -> unit;
+  }
+
 (** This is the XML namespace of the underlying element stream.
 
     You can rely on it on your code, as an escape hatch, but you should probably not,
diff --git a/portal/tcp/portal.ml b/portal/tcp/portal.ml
index 3477429..931cf93 100644
--- a/portal/tcp/portal.ml
+++ b/portal/tcp/portal.ml
@@ -2,15 +2,18 @@ open Lwt.Syntax
 open Lwt_unix
 open Markup
 
-type t = (signal, async) stream * ((signal, sync) stream option -> unit)
-
 type socket = file_descr
 
+type t = {
+    stream : (signal, async) stream;
+    push : (signal, sync) stream option -> unit;
+  }
+
 let xmlns = "http://etherx.jabber.org/streams"
 
 exception MalformedStanza of Markup.location * Markup.Error.t
 
-let header ?from domain ((stream, push) : t) =
+let header ?from domain ({stream; push} : t) =
   let stanza =
     let attributes =
       [(("", "to"), domain); (("", "version"), "1.0");
@@ -48,7 +51,7 @@ let header ?from domain ((stream, push) : t) =
         | None -> Lwt.fail_with "Invalid stream opening server-side."
 
 
-let close (_, push) = [`End_element] |> Markup.of_list |> Option.some |> push
+let close {push; _} = [`End_element] |> Markup.of_list |> Option.some |> push
 
 (** [xmpp_port domain] is the port where [domain]'s XMPP server is hosted.
 
@@ -99,4 +102,4 @@ let connect (domain : string) : t Lwt.t =
   in Lwt.async (fun () ->
          let* _ = lwt_stream xml_stream |> Markup_lwt.write_xml |> iter send
          in Lwt_unix.close tcp_socket);
-     stream, push
+     {stream; push}
diff --git a/portal/ws/portal.ml b/portal/ws/portal.ml
index b2d21e1..ee4b636 100644
--- a/portal/ws/portal.ml
+++ b/portal/ws/portal.ml
@@ -5,10 +5,13 @@ open Markup
 let jss = Js.string
 let sjs = Js.to_string
 
-type t = (signal, async) stream * ((signal, sync) stream option -> unit)
-
 type socket = WebSockets.webSocket Js.t
 
+type t = {
+    stream : (signal, async) stream;
+    push : (signal, sync) stream option -> unit;
+  }
+
 let xmlns = "urn:ietf:params:xml:ns:xmpp-framing"
 
 (* sic. XEP-0156: "host-meta files MUST be fetched only over HTTPS". I don't make the
@@ -18,7 +21,7 @@ let well_known_of (domain : string) = "https://" ^ domain ^ "/.well-known/host-m
 (** [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 header ?from domain {stream; push} =
   let stanza =
     let attributes =
       let open Option in
@@ -46,7 +49,7 @@ let header ?from domain (stream, push) =
         | Some id -> Lwt.return id
         | None -> Lwt.fail_with "Invalid stream opening server-side."
 
-let close (_, p) =
+let close {push=p; _} =
   {|<close xmlns="|} ^ xmlns ^ {|" />|} |> string |> parse_xml |> signals |> Option.some |> p
 
 exception MalformedStanza of Markup.location * Markup.Error.t
@@ -150,4 +153,4 @@ let connect domain =
                |> map (fun x -> write_xml x |> to_string)
                |> to_lwt_stream
                |> Lwt_stream.iter (fun s -> ws_push (Some s)));
-  stream, push
+  {stream; push}
diff --git a/test/hello.ml b/test/hello.ml
index 1659787..9b58de1 100644
--- a/test/hello.ml
+++ b/test/hello.ml
@@ -2,15 +2,15 @@ open! Lwt.Syntax
 open! Lwt.Infix
 open! Flesh
 
-let program (stream, push) config (features : Stream.features) =
-  let+ _auth = Sasl.authenticate (stream, push) config features.mechanisms
+let program (p : Portal.t) config (features : Stream.features) =
+  let+ _auth = Sasl.authenticate p config features.mechanisms
   in begin match _auth with
      | Error (NotAuthorized, Some (_, text)) -> print_endline ("Not authorized: " ^ text)
      | Error (MalformedRequest, Some (_, text)) -> print_endline ("Malformed request: " ^ text)
      | Error _ -> print_endline "Error!"
      | Ok _ -> print_endline "Success!"
      end;
-     Portal.close (stream, push)
+     Portal.close p
 
 let main =
   let config : Sasl.auth_config = {
@@ -19,12 +19,12 @@ let main =
       preferred_mechanisms = [Sasl.PLAIN]
     }
   in let domain = (List.nth (String.split_on_char '@' config.jid) 1) in
-     let* stream, push = Portal.connect domain in
-     let* features = Stream.negotiate domain (stream, push) in
+     let* portal = Portal.connect domain in
+     let* features = Stream.negotiate domain portal in
      Lwt.catch
-       (fun () -> program (stream, push) config features >|= (fun () -> push None))
+       (fun () -> program portal config features >|= (fun () -> portal.push None))
        (fun exn ->
-         push None;
+         portal.push None;
          (* I suspect JavaScript's [wrap_callback] swallows the Exceptions thrown by
             OCaml, so... The next best thing is probably printing something. *)
          print_endline