diff options
Diffstat (limited to 'lib/flesh.ml')
| -rw-r--r-- | lib/flesh.ml | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/lib/flesh.ml b/lib/flesh.ml index c6ab079..51f1b6c 100644 --- a/lib/flesh.ml +++ b/lib/flesh.ml @@ -3,3 +3,33 @@ module Sasl = Sasl module Starttls = Starttls module Wire = Wire module Xml = Xml + +open Lwt.Syntax +open Lwt.Infix + +(** [connect domain config] is a promise containing the portal connected to the XMPP + server located at [domain], and all its supported features. + + Basically, it conforms to {{: + https://datatracker.ietf.org/doc/html/rfc6120#section-4.3 }}, and gets the provided + Portal in a "ready" state. *) +let connect (domain : string) (config : Stream.config) : (Portal.t * Stream.features) Lwt.t = + let open Portal in + let* portal = connect domain + in + let needs_restart = function + | Stream.Mechanisms _ | STARTTLS -> true + | _ -> false + in + let+ features = + let rec handle_features (features : Stream.features) : Stream.features Lwt.t = + match features with + | feature :: mandatory, optional -> + let* () = Stream.negotiate_feature true feature portal config + in if needs_restart feature + then Stream.start domain portal >>= handle_features + else handle_features (mandatory, optional) + | features -> Lwt.return features + in Stream.start domain portal >>= handle_features + in (portal, features) + |