diff options
-rw-r--r-- | lib/stream.ml | 26 |
1 files changed, 13 insertions, 13 deletions
diff --git a/lib/stream.ml b/lib/stream.ml index b501a78..0944f8b 100644 --- a/lib/stream.ml +++ b/lib/stream.ml @@ -9,34 +9,34 @@ type feature = | STARTTLS of [`Required | `Optional] | Other of Xml.element -(** [parse_features el] is a [features] record with all the features of the - [<stream:features>] stanza contained in [el]. *) -let parse_features (el : Xml.element) : feature list = +(** [parse_features stanza] is a list of the features contained in the <features> + [stanza]. *) +let parse_features (stanza : Xml.element) : feature list = let open Xml in let open Either in let children = - if not (List.for_all is_left el.children) - then raise (InvalidStanza (element_to_string el)) - else List.filter_map find_left el.children + if not (List.for_all is_left stanza.children) + then raise (InvalidStanza (element_to_string stanza)) + else List.filter_map find_left stanza.children in let parse_single_mechanism = function | Left {local_name = "mechanism"; children = [Right mechanism]; _} -> Sasl.parse_auth_mechanism mechanism - | _ -> raise (InvalidStanza (element_to_string el)) + | _ -> raise (InvalidStanza (element_to_string stanza)) in - let parse_feature (el : Xml.element) : feature = + let parse_feature (stanza : Xml.element) : feature = let parse_mechanisms ch = List.map parse_single_mechanism ch and parse_starttls = function | [Left {local_name="required"; _}] -> `Required | [] -> `Optional - | _ -> raise (InvalidStanza (element_to_string el)) - in match el.local_name with - | "mechanisms" -> Mechanisms (parse_mechanisms el.children) - | "starttls" -> STARTTLS (parse_starttls el.children) - | _ -> Other el + | _ -> raise (InvalidStanza (element_to_string stanza)) + in match stanza.local_name with + | "mechanisms" -> Mechanisms (parse_mechanisms stanza.children) + | "starttls" -> STARTTLS (parse_starttls stanza.children) + | _ -> Other stanza in let features = List.map parse_feature children (* The XMPP spec mandates that sending a features element that contains only a <starttls/> means the STARTTLS negotiation is required. *) |