aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorClombrong <cromblong@egregore.fun>2025-06-27 08:33:40 +0200
committerClombrong <cromblong@egregore.fun>2025-06-27 09:53:10 +0200
commit13273777453522c4b73083207b3ba50ea3ca6bd0 (patch)
treed51393040998bd5112201774c4c464b07e778bcd
parent9276b39bcbed5e368d86da1bf02cba01fc164772 (diff)
feat(wire): move next and get from xml to wire
-rw-r--r--lib/sasl.ml2
-rw-r--r--lib/stream.ml2
-rw-r--r--lib/wire.ml21
-rw-r--r--lib/xml.ml19
4 files changed, 23 insertions, 21 deletions
diff --git a/lib/sasl.ml b/lib/sasl.ml
index 1837044..81c4476 100644
--- a/lib/sasl.ml
+++ b/lib/sasl.ml
@@ -59,7 +59,7 @@ let send_auth_stanza ({stream; push; _} : Portal.t) localpart pass mechanism =
`Text [gen_auth mechanism];
`End_element]
in Some (Markup.of_list stanza_list) |> push;
- try Xml.get stream >|= parse_sasl_response
+ try Wire.get stream >|= parse_sasl_response
with exn -> Lwt.fail exn
let authenticate
diff --git a/lib/stream.ml b/lib/stream.ml
index a4795ef..01d6a55 100644
--- a/lib/stream.ml
+++ b/lib/stream.ml
@@ -45,5 +45,5 @@ let parse_features (el : Xml.element) : features =
{{: https://datatracker.ietf.org/doc/html/rfc6120#section-4.3 }}. *)
let negotiate (domain : string) (portal : Portal.t) : features Lwt.t =
let* _id = Portal.header domain portal
- in let+ features = Xml.get portal.stream >|= parse_features
+ in let+ features = Wire.get portal.stream >|= parse_features
in features
diff --git a/lib/wire.ml b/lib/wire.ml
index e69de29..ce50f78 100644
--- a/lib/wire.ml
+++ b/lib/wire.ml
@@ -0,0 +1,21 @@
+open Lwt.Syntax
+open Markup
+open Xml
+
+(** [next stream] is a promise containing a full stanza of the fragments of
+ [stream]. *)
+let next (stream : (signal, async) stream) : (signal, sync) stream Lwt.t =
+ let traverse_stanza depth fragment =
+ let depth = match fragment with
+ | `Start_element _ -> depth + 1
+ | `End_element -> depth - 1
+ | _ -> depth
+ in ([fragment], if depth = 0 then None else Some depth)
+ in transform traverse_stanza 0 stream |> Markup_lwt.load
+
+(** [get stream] is a promise containing a single Xml element of [stream]. *)
+let get (stream : (signal, async) stream) : element Lwt.t =
+ let* signal = next stream
+ in match tree signal with
+ | Some xml -> Lwt.return xml
+ | None -> Lwt.fail (InvalidStanza (signal |> write_xml |> to_string))
diff --git a/lib/xml.ml b/lib/xml.ml
index 25332a5..99a388f 100644
--- a/lib/xml.ml
+++ b/lib/xml.ml
@@ -1,4 +1,3 @@
-open Lwt.Syntax
open Markup
exception InvalidStanza of string
@@ -57,21 +56,3 @@ let element_to_string ?(indent = 2) (el : element) =
|> tab)
^ "\n</" ^ local_name ^ ">"
in element_to_string "" el |> String.trim
-
-(** [next stream] is a promise containing a full stanza of the fragments of
- [stream]. *)
-let next (stream : (signal, async) stream) : (signal, sync) stream Lwt.t =
- let traverse_stanza depth fragment =
- let depth = match fragment with
- | `Start_element _ -> depth + 1
- | `End_element -> depth - 1
- | _ -> depth
- in ([fragment], if depth = 0 then None else Some depth)
- in transform traverse_stanza 0 stream |> Markup_lwt.load
-
-(** [get stream] is a promise containing a single Xml element of [stream]. *)
-let get (stream : (signal, async) stream) : element Lwt.t =
- let* signal = next stream
- in match tree signal with
- | Some xml -> Lwt.return xml
- | None -> Lwt.fail (InvalidStanza (signal |> write_xml |> to_string))