exception ClosedStream type auth_mechanism = | PLAIN | Unknown of string [@@deriving show { with_path = false }] let parse_auth_mechanism = function | "PLAIN" -> PLAIN | other -> Unknown other type stream_features = { sasl_mechanisms : auth_mechanism list; starttls : [`Required | `Optional | `None]; unknown_features : Xml.element list; } (** [parse_features el] is a [stream_features] record with all the features of the [] stanza contained in [el]. *) let parse_features (el : Xml.element) : stream_features = let open Xml in let open Either in let parse_mechanism_stanza = function | Left {local_name = "mechanism"; children = [Right mechanism]; _} -> Some (parse_auth_mechanism mechanism) | _ -> None in let parse_feature (acc : stream_features) (feature : Xml.element) : stream_features = let parse_mechanisms ch = List.filter_map parse_mechanism_stanza ch and parse_starttls = function | [Left {local_name="required"; _}] -> `Required | [] -> `Optional | _ -> raise (InvalidStanza (element_to_string el)) in match feature.local_name with | "mechanisms" -> {acc with sasl_mechanisms=parse_mechanisms feature.children} | "starttls" -> {acc with starttls=parse_starttls feature.children} | _ -> {acc with unknown_features = feature :: acc.unknown_features} in List.fold_left parse_feature {sasl_mechanisms=[]; starttls=`None; unknown_features=[]} (List.filter_map find_left el.children)