diff options
Diffstat (limited to 'portal/lib/portal_ws.ml')
| -rw-r--r-- | portal/lib/portal_ws.ml | 8 |
1 files changed, 7 insertions, 1 deletions
diff --git a/portal/lib/portal_ws.ml b/portal/lib/portal_ws.ml index 0b4bdd2..b0fe295 100644 --- a/portal/lib/portal_ws.ml +++ b/portal/lib/portal_ws.ml @@ -15,6 +15,8 @@ let stanza_open domain = let stanza_close = {|<close xmlns="urn:ietf:params:xml:ns:xmpp-framing" />|} +exception MalformedStanza of Markup.location * Markup.Error.t + let ws_endpoint (domain : string) = (** [ws_endpoint domain] is a promise containing the XMPP websocket endpoint associated with [domain], by using the domain's Web-host Metadata. @@ -100,9 +102,13 @@ let connect domain = |> concat in let open Markup in + (* When sending a malformed stanza (one that Markup.ml doesn't like), a MalformedStanza exception is raised. *) + let report loc err = + raise (MalformedStanza (loc, err)) + in spliced |> Markup_lwt.lwt_stream - |> Markup_lwt.parse_xml + |> Markup_lwt.parse_xml ~report |> signals (* XML declarations are not to be transmitted to the underlying WebSocket, per IETF recommendation. https://datatracker.ietf.org/doc/html/rfc7395#section-3.3.3 *) |