diff options
author | Clombrong <cromblong@egregore.fun> | 2025-08-04 11:35:45 +0200 |
---|---|---|
committer | Clombrong <cromblong@egregore.fun> | 2025-08-11 11:39:53 +0200 |
commit | 4ff73a6c5562092abc262d9f7af0a2357aaa1168 (patch) | |
tree | 8aa76727942f4dc7e0ab41c04ccf8fdb37857a3e | |
parent | fe03eb042ce6afd531356aafa8023f7806594baf (diff) |
feat(session): move connect from flesh to session
-rw-r--r-- | lib/flesh.ml | 31 | ||||
-rw-r--r-- | lib/session.ml | 30 | ||||
-rw-r--r-- | test/hello.ml | 1 |
3 files changed, 31 insertions, 31 deletions
diff --git a/lib/flesh.ml b/lib/flesh.ml index d9574b8..49f4102 100644 --- a/lib/flesh.ml +++ b/lib/flesh.ml @@ -5,34 +5,3 @@ module Starttls = Starttls module Wire = Wire module Xml = Xml module Jid = Jid - -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 open Stream in - let* portal = connect domain - in - let needs_restart = function - | Feature.Mechanisms _ | STARTTLS -> true - | _ -> false - in - let+ features = - let rec handle_features (features : Stream.features) : Stream.features Lwt.t = - match features with - | feature :: rest -> - let* () = negotiate feature portal config - in if needs_restart (Feature.unwrap feature) - then start domain portal >>= handle_features - else handle_features rest - | features -> Lwt.return features - in start domain portal >>= handle_features - in (portal, features) - diff --git a/lib/session.ml b/lib/session.ml index c640080..1b591b5 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -1,2 +1,32 @@ +open Lwt.Syntax +open Lwt.Infix + type state = | Disconnected + +(** [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 open Stream in + let* portal = connect domain + in + let needs_restart = function + | Feature.Mechanisms _ | STARTTLS -> true + | _ -> false + in + let+ features = + let rec handle_features (features : Stream.features) : Stream.features Lwt.t = + match features with + | feature :: rest -> + let* () = negotiate feature portal config + in if needs_restart (Feature.unwrap feature) + then start domain portal >>= handle_features + else handle_features rest + | features -> Lwt.return features + in start domain portal >>= handle_features + in (portal, features) diff --git a/test/hello.ml b/test/hello.ml index 55a735e..c34f0a0 100644 --- a/test/hello.ml +++ b/test/hello.ml @@ -1,6 +1,7 @@ open! Lwt.Syntax open! Lwt.Infix open! Flesh +open! Session let main = let config : Stream.config = { |