blob: d7c29820987e610b2a77b2c474c4ecf9f5688773 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
type t = {
localpart : string option;
domainpart : string;
resourcepart : string option;
} [@@deriving show { with_path = false }]
exception InvalidUTF8
type uchars = Uchar.t list
let uchars_of_string s : uchars =
let open Uchar in
let len = String.length s in
let rec loop acc i =
if i >= len then
List.rev acc
else
let c = String.get_utf_8_uchar s i in
if not (utf_decode_is_valid c)
then raise InvalidUTF8
else
let k = utf_decode_length c in
let u = utf_decode_uchar c in
loop (u :: acc) (i + k)
in loop [] (String.length s)
let string_of_uchars (u : uchars) =
let buf = Buffer.create (4 * List.length u) in
List.iter (Buffer.add_utf_8_uchar buf) u;
Buffer.to_bytes buf |> String.of_bytes
let of_string (s : string) : t =
let open List in
let jid = uchars_of_string s in
let dend, resourcepart =
find_mapi (fun i c ->
if c = Uchar.of_char '/'
then Some (i, drop i jid |> string_of_uchars)
else None) jid
|> Option.fold ~none:(length jid, None) ~some:(fun (i, s) -> i, Some s)
and dstart, localpart =
rev jid
|> find_mapi (fun i c ->
if c = Uchar.of_char '@'
then Some (i, take i jid |> rev |> string_of_uchars)
else None)
|> Option.fold ~none:(0, None) ~some:(fun (i, s) -> i, Some s)
in {
localpart;
resourcepart;
domainpart = drop dstart jid |> take (dend-dstart) |> string_of_uchars
}
let to_string ({ localpart; domainpart; resourcepart } : t) =
let local = Option.fold ~none:"" ~some:(fun l -> l ^ "@") localpart
and resource = Option.fold ~none:"" ~some:(fun r -> "/" ^ r) resourcepart
in local ^ domainpart ^ resource
|
