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
124
125
126
127
128
129
130
131
132
133
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=true) 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=true) 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