1%% Copyright (c) 2019, Loïc Hoguin <essen@ninenines.eu>
2%%
3%% Permission to use, copy, modify, and/or distribute this software for any
4%% purpose with or without fee is hereby granted, provided that the above
5%% copyright notice and this permission notice appear in all copies.
6%%
7%% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8%% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9%% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10%% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11%% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12%% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13%% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
14
15%% This is a full level 4 implementation of URI Templates
16%% as defined by RFC6570.
17
18-module(cow_uri_template).
19
20-export([parse/1]).
21-export([expand/2]).
22
23-type op() :: simple_string_expansion
24	| reserved_expansion
25	| fragment_expansion
26	| label_expansion_with_dot_prefix
27	| path_segment_expansion
28	| path_style_parameter_expansion
29	| form_style_query_expansion
30	| form_style_query_continuation.
31
32-type var_list() :: [
33	{no_modifier, binary()}
34	| {{prefix_modifier, pos_integer()}, binary()}
35	| {explode_modifier, binary()}
36].
37
38-type uri_template() :: [
39	binary() | {expr, op(), var_list()}
40].
41-export_type([uri_template/0]).
42
43-type variables() :: #{
44	binary() => binary()
45		| integer()
46		| float()
47		| [binary()]
48		| #{binary() => binary()}
49}.
50
51-include("cow_inline.hrl").
52-include("cow_parse.hrl").
53
54%% Parse a URI template.
55
56-spec parse(binary()) -> uri_template().
57parse(URITemplate) ->
58	parse(URITemplate, <<>>).
59
60parse(<<>>, <<>>) ->
61	[];
62parse(<<>>, Acc) ->
63	[Acc];
64parse(<<${,R/bits>>, <<>>) ->
65	parse_expr(R);
66parse(<<${,R/bits>>, Acc) ->
67	[Acc|parse_expr(R)];
68%% @todo Probably should reject unallowed characters so that
69%% we don't produce invalid URIs.
70parse(<<C,R/bits>>, Acc) when C =/= $} ->
71	parse(R, <<Acc/binary, C>>).
72
73parse_expr(<<$+,R/bits>>) ->
74	parse_var_list(R, reserved_expansion, []);
75parse_expr(<<$#,R/bits>>) ->
76	parse_var_list(R, fragment_expansion, []);
77parse_expr(<<$.,R/bits>>) ->
78	parse_var_list(R, label_expansion_with_dot_prefix, []);
79parse_expr(<<$/,R/bits>>) ->
80	parse_var_list(R, path_segment_expansion, []);
81parse_expr(<<$;,R/bits>>) ->
82	parse_var_list(R, path_style_parameter_expansion, []);
83parse_expr(<<$?,R/bits>>) ->
84	parse_var_list(R, form_style_query_expansion, []);
85parse_expr(<<$&,R/bits>>) ->
86	parse_var_list(R, form_style_query_continuation, []);
87parse_expr(R) ->
88	parse_var_list(R, simple_string_expansion, []).
89
90parse_var_list(<<C,R/bits>>, Op, List)
91		when ?IS_ALPHANUM(C) or (C =:= $_) ->
92	parse_varname(R, Op, List, <<C>>).
93
94parse_varname(<<C,R/bits>>, Op, List, Name)
95		when ?IS_ALPHANUM(C) or (C =:= $_) or (C =:= $.) or (C =:= $%) ->
96	parse_varname(R, Op, List, <<Name/binary,C>>);
97parse_varname(<<$:,C,R/bits>>, Op, List, Name)
98		when (C =:= $1) or (C =:= $2) or (C =:= $3) or (C =:= $4) or (C =:= $5)
99			or (C =:= $6) or (C =:= $7) or (C =:= $8) or (C =:= $9) ->
100	parse_prefix_modifier(R, Op, List, Name, <<C>>);
101parse_varname(<<$*,$,,R/bits>>, Op, List, Name) ->
102	parse_var_list(R, Op, [{explode_modifier, Name}|List]);
103parse_varname(<<$*,$},R/bits>>, Op, List, Name) ->
104	[{expr, Op, lists:reverse([{explode_modifier, Name}|List])}|parse(R, <<>>)];
105parse_varname(<<$,,R/bits>>, Op, List, Name) ->
106	parse_var_list(R, Op, [{no_modifier, Name}|List]);
107parse_varname(<<$},R/bits>>, Op, List, Name) ->
108	[{expr, Op, lists:reverse([{no_modifier, Name}|List])}|parse(R, <<>>)].
109
110parse_prefix_modifier(<<C,R/bits>>, Op, List, Name, Acc)
111		when ?IS_DIGIT(C), byte_size(Acc) < 4 ->
112	parse_prefix_modifier(R, Op, List, Name, <<Acc/binary,C>>);
113parse_prefix_modifier(<<$,,R/bits>>, Op, List, Name, Acc) ->
114	parse_var_list(R, Op, [{{prefix_modifier, binary_to_integer(Acc)}, Name}|List]);
115parse_prefix_modifier(<<$},R/bits>>, Op, List, Name, Acc) ->
116	[{expr, Op, lists:reverse([{{prefix_modifier, binary_to_integer(Acc)}, Name}|List])}|parse(R, <<>>)].
117
118%% Expand a URI template (after parsing it if necessary).
119
120-spec expand(binary() | uri_template(), variables()) -> iodata().
121expand(URITemplate, Vars) when is_binary(URITemplate) ->
122	expand(parse(URITemplate), Vars);
123expand(URITemplate, Vars) ->
124	expand1(URITemplate, Vars).
125
126expand1([], _) ->
127	[];
128expand1([Literal|Tail], Vars) when is_binary(Literal) ->
129	[Literal|expand1(Tail, Vars)];
130expand1([{expr, simple_string_expansion, VarList}|Tail], Vars) ->
131	[simple_string_expansion(VarList, Vars)|expand1(Tail, Vars)];
132expand1([{expr, reserved_expansion, VarList}|Tail], Vars) ->
133	[reserved_expansion(VarList, Vars)|expand1(Tail, Vars)];
134expand1([{expr, fragment_expansion, VarList}|Tail], Vars) ->
135	[fragment_expansion(VarList, Vars)|expand1(Tail, Vars)];
136expand1([{expr, label_expansion_with_dot_prefix, VarList}|Tail], Vars) ->
137	[label_expansion_with_dot_prefix(VarList, Vars)|expand1(Tail, Vars)];
138expand1([{expr, path_segment_expansion, VarList}|Tail], Vars) ->
139	[path_segment_expansion(VarList, Vars)|expand1(Tail, Vars)];
140expand1([{expr, path_style_parameter_expansion, VarList}|Tail], Vars) ->
141	[path_style_parameter_expansion(VarList, Vars)|expand1(Tail, Vars)];
142expand1([{expr, form_style_query_expansion, VarList}|Tail], Vars) ->
143	[form_style_query_expansion(VarList, Vars)|expand1(Tail, Vars)];
144expand1([{expr, form_style_query_continuation, VarList}|Tail], Vars) ->
145	[form_style_query_continuation(VarList, Vars)|expand1(Tail, Vars)].
146
147simple_string_expansion(VarList, Vars) ->
148	lists:join($,, [
149		apply_modifier(Modifier, unreserved, $,, Value)
150	|| {Modifier, _Name, Value} <- lookup_variables(VarList, Vars)]).
151
152reserved_expansion(VarList, Vars) ->
153	lists:join($,, [
154		apply_modifier(Modifier, reserved, $,, Value)
155	|| {Modifier, _Name, Value} <- lookup_variables(VarList, Vars)]).
156
157fragment_expansion(VarList, Vars) ->
158	case reserved_expansion(VarList, Vars) of
159		[] -> [];
160		Expanded -> [$#, Expanded]
161	end.
162
163label_expansion_with_dot_prefix(VarList, Vars) ->
164	segment_expansion(VarList, Vars, $.).
165
166path_segment_expansion(VarList, Vars) ->
167	segment_expansion(VarList, Vars, $/).
168
169segment_expansion(VarList, Vars, Sep) ->
170	Expanded = lists:join(Sep, [
171		apply_modifier(Modifier, unreserved, Sep, Value)
172	|| {Modifier, _Name, Value} <- lookup_variables(VarList, Vars)]),
173	case Expanded of
174		[] -> [];
175		[[]] -> [];
176		_ -> [Sep, Expanded]
177	end.
178
179path_style_parameter_expansion(VarList, Vars) ->
180	parameter_expansion(VarList, Vars, $;, $;, trim).
181
182form_style_query_expansion(VarList, Vars) ->
183	parameter_expansion(VarList, Vars, $?, $&, no_trim).
184
185form_style_query_continuation(VarList, Vars) ->
186	parameter_expansion(VarList, Vars, $&, $&, no_trim).
187
188parameter_expansion(VarList, Vars, LeadingSep, Sep, Trim) ->
189	Expanded = lists:join(Sep, [
190		apply_parameter_modifier(Modifier, unreserved, Sep, Trim, Name, Value)
191	|| {Modifier, Name, Value} <- lookup_variables(VarList, Vars)]),
192	case Expanded of
193		[] -> [];
194		[[]] -> [];
195		_ -> [LeadingSep, Expanded]
196	end.
197
198lookup_variables([], _) ->
199	[];
200lookup_variables([{Modifier, Name}|Tail], Vars) ->
201	case Vars of
202		#{Name := Value} -> [{Modifier, Name, Value}|lookup_variables(Tail, Vars)];
203		_ -> lookup_variables(Tail, Vars)
204	end.
205
206apply_modifier(no_modifier, AllowedChars, _, List) when is_list(List) ->
207	lists:join($,, [urlencode(Value, AllowedChars) || Value <- List]);
208apply_modifier(explode_modifier, AllowedChars, ExplodeSep, List) when is_list(List) ->
209	lists:join(ExplodeSep, [urlencode(Value, AllowedChars) || Value <- List]);
210apply_modifier(Modifier, AllowedChars, ExplodeSep, Map) when is_map(Map) ->
211	{JoinSep, KVSep} = case Modifier of
212		no_modifier -> {$,, $,};
213		explode_modifier -> {ExplodeSep, $=}
214	end,
215	lists:reverse(lists:join(JoinSep,
216		maps:fold(fun(Key, Value, Acc) ->
217			[[
218				urlencode(Key, AllowedChars),
219				KVSep,
220				urlencode(Value, AllowedChars)
221			]|Acc]
222		end, [], Map)
223	));
224apply_modifier({prefix_modifier, MaxLen}, AllowedChars, _, Value) ->
225	urlencode(string:slice(binarize(Value), 0, MaxLen), AllowedChars);
226apply_modifier(_, AllowedChars, _, Value) ->
227	urlencode(binarize(Value), AllowedChars).
228
229apply_parameter_modifier(_, _, _, _, _, []) ->
230	[];
231apply_parameter_modifier(_, _, _, _, _, Map) when Map =:= #{} ->
232	[];
233apply_parameter_modifier(no_modifier, AllowedChars, _, _, Name, List) when is_list(List) ->
234	[
235		Name,
236		$=,
237		lists:join($,, [urlencode(Value, AllowedChars) || Value <- List])
238	];
239apply_parameter_modifier(explode_modifier, AllowedChars, ExplodeSep, _, Name, List) when is_list(List) ->
240	lists:join(ExplodeSep, [[
241		Name,
242		$=,
243		urlencode(Value, AllowedChars)
244	] || Value <- List]);
245apply_parameter_modifier(Modifier, AllowedChars, ExplodeSep, _, Name, Map) when is_map(Map) ->
246	{JoinSep, KVSep} = case Modifier of
247		no_modifier -> {$,, $,};
248		explode_modifier -> {ExplodeSep, $=}
249	end,
250	[
251		case Modifier of
252			no_modifier ->
253				[
254					Name,
255					$=
256				];
257			explode_modifier ->
258				[]
259		end,
260		lists:reverse(lists:join(JoinSep,
261			maps:fold(fun(Key, Value, Acc) ->
262				[[
263					urlencode(Key, AllowedChars),
264					KVSep,
265					urlencode(Value, AllowedChars)
266				]|Acc]
267			end, [], Map)
268		))
269	];
270apply_parameter_modifier(Modifier, AllowedChars, _, Trim, Name, Value0) ->
271	Value1 = binarize(Value0),
272	Value = case Modifier of
273		{prefix_modifier, MaxLen} ->
274			string:slice(Value1, 0, MaxLen);
275		no_modifier ->
276			Value1
277	end,
278	[
279		Name,
280		case Value of
281			<<>> when Trim =:= trim ->
282				[];
283			<<>> when Trim =:= no_trim ->
284				$=;
285			_ ->
286				[
287					$=,
288					urlencode(Value, AllowedChars)
289				]
290		end
291	].
292
293binarize(Value) when is_integer(Value) ->
294	integer_to_binary(Value);
295binarize(Value) when is_float(Value) ->
296	float_to_binary(Value, [{decimals, 10}, compact]);
297binarize(Value) ->
298	Value.
299
300urlencode(Value, unreserved) ->
301	urlencode_unreserved(Value, <<>>);
302urlencode(Value, reserved) ->
303	urlencode_reserved(Value, <<>>).
304
305urlencode_unreserved(<<C,R/bits>>, Acc)
306		when ?IS_URI_UNRESERVED(C) ->
307	urlencode_unreserved(R, <<Acc/binary,C>>);
308urlencode_unreserved(<<C,R/bits>>, Acc) ->
309	urlencode_unreserved(R, <<Acc/binary,$%,?HEX(C)>>);
310urlencode_unreserved(<<>>, Acc) ->
311	Acc.
312
313urlencode_reserved(<<C,R/bits>>, Acc)
314		when ?IS_URI_UNRESERVED(C) or ?IS_URI_GEN_DELIMS(C) or ?IS_URI_SUB_DELIMS(C) ->
315	urlencode_reserved(R, <<Acc/binary,C>>);
316urlencode_reserved(<<C,R/bits>>, Acc) ->
317	urlencode_reserved(R, <<Acc/binary,$%,?HEX(C)>>);
318urlencode_reserved(<<>>, Acc) ->
319	Acc.
320
321-ifdef(TEST).
322expand_uritemplate_test_() ->
323	Files = filelib:wildcard("deps/uritemplate-tests/*.json"),
324	lists:flatten([begin
325		{ok, JSON} = file:read_file(File),
326		Tests = jsx:decode(JSON, [return_maps]),
327		[begin
328			%% Erlang doesn't have a NULL value.
329			Vars = maps:remove(<<"undef">>, Vars0),
330			[
331				{iolist_to_binary(io_lib:format("~s - ~s: ~s => ~s",
332					[filename:basename(File), Section, URITemplate,
333						if
334							is_list(Expected) -> lists:join(<<" OR ">>, Expected);
335							true -> Expected
336						end
337					])),
338					fun() ->
339						case Expected of
340							false ->
341								{'EXIT', _} = (catch expand(URITemplate, Vars));
342							[_|_] ->
343								Result = iolist_to_binary(expand(URITemplate, Vars)),
344								io:format("~p", [Result]),
345								true = lists:member(Result, Expected);
346							_ ->
347								Expected = iolist_to_binary(expand(URITemplate, Vars))
348						end
349					end}
350			|| [URITemplate, Expected] <- Cases]
351		end || {Section, #{
352			<<"variables">> := Vars0,
353			<<"testcases">> := Cases
354		}} <- maps:to_list(Tests)]
355	end || File <- Files]).
356-endif.
357