aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorClombrong <cromblong@egregore.fun>2025-08-04 11:35:45 +0200
committerClombrong <cromblong@egregore.fun>2025-08-11 11:39:53 +0200
commit4ff73a6c5562092abc262d9f7af0a2357aaa1168 (patch)
tree8aa76727942f4dc7e0ab41c04ccf8fdb37857a3e
parentfe03eb042ce6afd531356aafa8023f7806594baf (diff)
feat(session): move connect from flesh to session
-rw-r--r--lib/flesh.ml31
-rw-r--r--lib/session.ml30
-rw-r--r--test/hello.ml1
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 = {