feat!(portal): add from parameter to the opening stanza

2 files changed, 11 insertions, 4 deletions

diff --git a/portal/lib/portal.mli b/portal/lib/portal.mli
index d752fa7..c9b2460 100644
--- a/portal/lib/portal.mli
+++ b/portal/lib/portal.mli
@@ -1,6 +1,6 @@
 type t = string Lwt_stream.t * (string option -> unit)
 
-val stanza_open : string -> string
+val stanza_open : ?from:string -> string -> string
 
 val stanza_close : string
 
diff --git a/portal/lib/ws/portal.ml b/portal/lib/ws/portal.ml
index 6e4a231..f5491ca 100644
--- a/portal/lib/ws/portal.ml
+++ b/portal/lib/ws/portal.ml
@@ -9,11 +9,18 @@ type t = string Lwt_stream.t * (string option -> unit)
 (* sic. XEP-0156: "host-meta files MUST be fetched only over HTTPS". I don't make the rules. *)
 let well_known_of (domain : string) = "https://" ^ domain ^ "/.well-known/host-meta"
 
-let stanza_open domain =
-  (** [open_stanza domain] is an <open /> stanza for [domain]. *)
+let stanza_open ?from domain =
+  (** [open_stanza domain] is an <open /> stanza for [domain].
+
+      If [from] is specified, the <open /> stanza has the from parameter.
+   *)
   Printf.sprintf
-    {|<open xmlns="urn:ietf:params:xml:ns:xmpp-framing" to="%s" version="1.0" />|}
+    {|<open xmlns="urn:ietf:params:xml:ns:xmpp-framing"
+       to="%s"
+       %s
+       version="1.0" />|}
     domain
+    (Option.fold ~none:"" ~some:(fun jid -> {|from="|} ^ jid ^ {|"|}) from)
 
 let stanza_close = {|<close xmlns="urn:ietf:params:xml:ns:xmpp-framing" />|}