diff options
author | Clombrong <cromblong@egregore.fun> | 2025-06-27 08:33:40 +0200 |
---|---|---|
committer | Clombrong <cromblong@egregore.fun> | 2025-06-27 09:53:10 +0200 |
commit | 13273777453522c4b73083207b3ba50ea3ca6bd0 (patch) | |
tree | d51393040998bd5112201774c4c464b07e778bcd /lib | |
parent | 9276b39bcbed5e368d86da1bf02cba01fc164772 (diff) |
feat(wire): move next and get from xml to wire
Diffstat (limited to 'lib')
-rw-r--r-- | lib/sasl.ml | 2 | ||||
-rw-r--r-- | lib/stream.ml | 2 | ||||
-rw-r--r-- | lib/wire.ml | 21 | ||||
-rw-r--r-- | lib/xml.ml | 19 |
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)) @@ -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)) |