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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
module TYPES = struct
type base_url = BASE of string
type url = URL of string
end
include TYPES
let cut_at s c =
try
let pos = String.index s c in
let len = String.length s in
String.sub s 0 pos,
String.sub s (pos+1) (len - pos - 1)
with _ -> s, ""
let encode s =
let pos = ref 0 in
let len = String.length s in
let res = Bytes.create (3*len) in
let hexa_digit x =
if x >= 10 then Char.chr (Char.code 'A' + x - 10)
else Char.chr (Char.code '0' + x) in
for i=0 to len-1 do
match String.get s i with
| 'a'..'z' | 'A'..'Z' | '0'..'9' | '.' | '-' | '*' | '_' ->
Bytes.set res !pos (String.get s i); incr pos
| c ->
Bytes.set res !pos '%';
Bytes.set res (!pos+1) @@ hexa_digit (Char.code c / 16);
Bytes.set res (!pos+2) @@ hexa_digit (Char.code c mod 16);
pos := !pos + 3
done;
Bytes.sub_string res 0 !pos
let digit_hexa x =
match x with
| 'a' .. 'f' -> (Char.code x) + 10 - (Char.code 'a')
| 'A' .. 'F' -> (Char.code x) + 10 - (Char.code 'A')
| '0' .. '9' -> (Char.code x) - (Char.code '0')
| _ -> failwith "Not an hexa number (encode.ml)"
let decode s =
let len = String.length s in
let r = Buffer.create len in
let rec iter i =
if i < len then
match s.[i] with
| '+' -> Buffer.add_char r ' '; iter (i+1)
| '%' ->
let n =
try
let fst = digit_hexa s.[i+1] in
let snd = digit_hexa s.[i+2] in
Buffer.add_char r (char_of_int (fst*16 + snd));
3
with _ ->
Buffer.add_char r '%';
1
in
iter (i+n)
| c -> Buffer.add_char r c; iter (i+1)
in
iter 0;
Buffer.contents r
let encode_args ?(url=false) l =
String.concat "&" (List.map (fun (name, arg) ->
Printf.sprintf "%s=%s" name
(String.concat ","
(if url then List.map encode arg else arg))) l)
let decode_args ?(url=false) s =
let args = String.split_on_char '&' s in
List.map (fun s ->
let s, v = cut_at s '=' in
let v = String.split_on_char ',' v in
let s = decode s in
let v = if url then List.map decode v else v in
s, v
) args
let content_type = "application/x-www-form-urlencoded"
let encode_obj ?(url=false) enc x =
let rec aux ?prefix = function
| `Null -> None
| `String s -> let s = if url then encode s else s in
Some (match prefix with None -> s | Some p -> p ^ "=" ^ s)
| `Float f ->
let s = if floor f = f then string_of_int (int_of_float f) else string_of_float f in
Some (match prefix with None -> s | Some p -> p ^ "=" ^ s)
| `Bool b -> let s = string_of_bool b in
Some (match prefix with None -> s | Some p -> p ^ "=" ^ s)
| `A l ->
if l = [] then None else
Some (String.concat "&" @@
List.rev @@ snd @@
List.fold_left (fun (i, acc) x ->
let prefix = match prefix with
| None -> None
| Some p -> Some (p ^ "[" ^ (string_of_int i) ^ "]") in
match aux ?prefix x with
| None -> i, acc
| Some s -> i+1, s :: acc) (0, []) l)
| `O l ->
if l = [] then None else
Some (String.concat "&" @@ List.filter_map (fun (k, v) ->
let prefix = match prefix with None -> k | Some p -> p ^ "[" ^ k ^ "]" in
aux ~prefix v) l) in
match aux (Json_encoding.construct enc x) with
| None -> ""
| Some s -> s
let assemble (BASE url) parts args =
let n = String.length url in
let sep =
if n = 0 || url.[n - 1] = '/' || parts = "" then "" else "/" in
let url = Printf.sprintf "%s%s%s%s" url sep parts args in
URL url