blob: b10deb17df3c38d2955a45b2e5f2406f084a9aad (
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
58
59
60
61
62
63
64
65
66
|
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 [] 0
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 dlen, localpart =
rev jid
|> find_mapi (fun i c ->
if c = Uchar.of_char '@'
then Some (i, take (length jid - i - 1) jid |> string_of_uchars)
else None)
|> Option.fold ~none:(0, None) ~some:(fun (i, s) -> i, Some s)
in {
localpart;
resourcepart;
domainpart = drop (dend-dlen) jid |> take dlen |> string_of_uchars
}
let%expect_test {|A "bare JID"|} =
"juliet@example.com" |> of_string |> show |> print_string;
[%expect {|
{ localpart = (Some "juliet"); domainpart = "example.com";
resourcepart = None } |}]
let%expect_test {|A "full JID"|} =
"juliet@example.com/foo" |> of_string |> show |> print_string
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
|
