Add structured headers, variants and variant-key building

2 files changed, 253 insertions, 23 deletions

diff --git a/src/cow_http_hd.erl b/src/cow_http_hd.erl
index cbc9f6b..3189b01 100644
--- a/src/cow_http_hd.erl
+++ b/src/cow_http_hd.erl
@@ -101,6 +101,8 @@
 -export([parse_upgrade/1]).
 % @todo -export([parse_user_agent/1]). RFC7231
 % @todo -export([parse_variant_vary/1]). RFC2295
+-export([parse_variant_key/2]).
+-export([parse_variants/1]).
 -export([parse_vary/1]).
 % @todo -export([parse_via/1]). RFC7230
 % @todo -export([parse_want_digest/1]). RFC3230
@@ -118,6 +120,8 @@
 -export([access_control_allow_origin/1]).
 -export([access_control_expose_headers/1]).
 -export([access_control_max_age/1]).
+-export([variant_key/1]).
+-export([variants/1]).
 
 -type etag() :: {weak | strong, binary()}.
 -export_type([etag/0]).
@@ -3060,6 +3064,77 @@ parse_upgrade_error_test_() ->
 		|| V <- Tests].
 -endif.
 
+%% @doc Parse the Variant-Key header.
+%%
+%% The Variants header must be parsed first in order to know
+%% the NumMembers argument as it is the number of members in
+%% the Variants dictionary.
+
+-spec parse_variant_key(binary(), pos_integer()) -> [[binary()]].
+parse_variant_key(VariantKey, NumMembers) ->
+	List = cow_http_struct_hd:parse_list(VariantKey),
+	[case Inner of
+		{with_params, InnerList, #{}} ->
+			NumMembers = length(InnerList),
+			[case Item of
+				{with_params, {token, Value}, #{}} -> Value;
+				{with_params, {string, Value}, #{}} -> Value
+			end || Item <- InnerList]
+	end || Inner <- List].
+
+-ifdef(TEST).
+parse_variant_key_test_() ->
+	Tests = [
+		{<<"(en)">>, 1, [[<<"en">>]]},
+		{<<"(gzip fr)">>, 2, [[<<"gzip">>, <<"fr">>]]},
+		{<<"(gzip fr), (\"identity\" fr)">>, 2, [[<<"gzip">>, <<"fr">>], [<<"identity">>, <<"fr">>]]},
+		{<<"(\"gzip \" fr)">>, 2, [[<<"gzip ">>, <<"fr">>]]},
+		{<<"(en br)">>, 2, [[<<"en">>, <<"br">>]]},
+		{<<"(\"0\")">>, 1, [[<<"0">>]]},
+		{<<"(silver), (\"bronze\")">>, 1, [[<<"silver">>], [<<"bronze">>]]},
+		{<<"(some_person)">>, 1, [[<<"some_person">>]]},
+		{<<"(gold europe)">>, 2, [[<<"gold">>, <<"europe">>]]}
+	],
+	[{V, fun() -> R = parse_variant_key(V, N) end} || {V, N, R} <- Tests].
+
+parse_variant_key_error_test_() ->
+	Tests = [
+		{<<"(gzip fr), (identity fr), (br fr oops)">>, 2}
+	],
+	[{V, fun() -> {'EXIT', _} = (catch parse_variant_key(V, N)) end} || {V, N} <- Tests].
+-endif.
+
+%% @doc Parse the Variants header.
+
+-spec parse_variants(binary()) -> [{binary(), [binary()]}].
+parse_variants(Variants) ->
+	{Dict0, Order} = cow_http_struct_hd:parse_dictionary(Variants),
+	Dict = maps:map(fun(_, {with_params, List, #{}}) ->
+		[case Item of
+			{with_params, {token, Value}, #{}} -> Value;
+			{with_params, {string, Value}, #{}} -> Value
+		end || Item <- List]
+	end, Dict0),
+	[{Key, maps:get(Key, Dict)} || Key <- Order].
+
+-ifdef(TEST).
+parse_variants_test_() ->
+	Tests = [
+		{<<"accept-language=(de en jp)">>, [{<<"accept-language">>, [<<"de">>, <<"en">>, <<"jp">>]}]},
+		{<<"accept-encoding=(gzip)">>, [{<<"accept-encoding">>, [<<"gzip">>]}]},
+		{<<"accept-encoding=()">>, [{<<"accept-encoding">>, []}]},
+		{<<"accept-encoding=(gzip br), accept-language=(en fr)">>, [
+			{<<"accept-encoding">>, [<<"gzip">>, <<"br">>]},
+			{<<"accept-language">>, [<<"en">>, <<"fr">>]}
+		]},
+		{<<"accept-language=(en fr de), accept-encoding=(gzip br)">>, [
+			{<<"accept-language">>, [<<"en">>, <<"fr">>, <<"de">>]},
+			{<<"accept-encoding">>, [<<"gzip">>, <<"br">>]}
+		]}
+	],
+	[{V, fun() -> R = parse_variants(V) end} || {V, R} <- Tests].
+-endif.
+
 %% @doc Parse the Vary header.
 
 -spec parse_vary(binary()) -> '*' | [binary()].
@@ -3448,6 +3523,63 @@ access_control_max_age_test_() ->
 	[{V, fun() -> R = access_control_max_age(V) end} || {V, R} <- Tests].
 -endif.
 
+%% @doc Build the Variant-Key-06 (draft) header.
+
+-spec variant_key([[binary()]]) -> iolist().
+%% We assume that the lists are of correct length.
+variant_key(VariantKeys) ->
+	cow_http_struct_hd:list([
+		{with_params, [
+			{with_params, {string, Value}, #{}}
+		|| Value <- InnerList], #{}}
+	|| InnerList <- VariantKeys]).
+
+-ifdef(TEST).
+variant_key_identity_test_() ->
+	Tests = [
+		{1, [[<<"en">>]]},
+		{2, [[<<"gzip">>, <<"fr">>]]},
+		{2, [[<<"gzip">>, <<"fr">>], [<<"identity">>, <<"fr">>]]},
+		{2, [[<<"gzip ">>, <<"fr">>]]},
+		{2, [[<<"en">>, <<"br">>]]},
+		{1, [[<<"0">>]]},
+		{1, [[<<"silver">>], [<<"bronze">>]]},
+		{1, [[<<"some_person">>]]},
+		{2, [[<<"gold">>, <<"europe">>]]}
+	],
+	[{lists:flatten(io_lib:format("~p", [V])),
+		fun() -> V = parse_variant_key(iolist_to_binary(variant_key(V)), N) end} || {N, V} <- Tests].
+-endif.
+
+%% @doc Build the Variants-06 (draft) header.
+
+-spec variants([{binary(), [binary()]}]) -> iolist().
+variants(Variants) ->
+	cow_http_struct_hd:dictionary([
+		{Key, {with_params, [
+			{with_params, {string, Value}, #{}}
+		|| Value <- List], #{}}}
+	|| {Key, List} <- Variants]).
+
+-ifdef(TEST).
+variants_identity_test_() ->
+	Tests = [
+		[{<<"accept-language">>, [<<"de">>, <<"en">>, <<"jp">>]}],
+		[{<<"accept-encoding">>, [<<"gzip">>]}],
+		[{<<"accept-encoding">>, []}],
+		[
+			{<<"accept-encoding">>, [<<"gzip">>, <<"br">>]},
+			{<<"accept-language">>, [<<"en">>, <<"fr">>]}
+		],
+		[
+			{<<"accept-language">>, [<<"en">>, <<"fr">>, <<"de">>]},
+			{<<"accept-encoding">>, [<<"gzip">>, <<"br">>]}
+		]
+	],
+	[{lists:flatten(io_lib:format("~p", [V])),
+		fun() -> V = parse_variants(iolist_to_binary(variants(V))) end} || V <- Tests].
+-endif.
+
 %% Internal.
 
 %% Only return if the list is not empty.
diff --git a/src/cow_http_struct_hd.erl b/src/cow_http_struct_hd.erl
index acbf7b2..373c8da 100644
--- a/src/cow_http_struct_hd.erl
+++ b/src/cow_http_struct_hd.erl
@@ -32,13 +32,16 @@
 -export([parse_dictionary/1]).
 -export([parse_item/1]).
 -export([parse_list/1]).
+-export([dictionary/1]).
+-export([item/1]).
+-export([list/1]).
 
 -include("cow_parse.hrl").
 
 -type sh_list() :: [sh_item() | sh_inner_list()].
 -type sh_inner_list() :: sh_with_params([sh_item()]).
 -type sh_params() :: #{binary() => sh_bare_item() | undefined}.
--type sh_dictionary() :: #{binary() => sh_item() | sh_inner_list()}.
+-type sh_dictionary() :: {#{binary() => sh_item() | sh_inner_list()}, [binary()]}.
 -type sh_item() :: sh_with_params(sh_bare_item()).
 -type sh_bare_item() :: integer() | float() | boolean()
 	| {string | token | binary, binary()}.
@@ -53,39 +56,39 @@
 	(C =:= $z)
 ).
 
-%% Public interface.
+%% Parsing.
 
 -spec parse_dictionary(binary()) -> sh_dictionary().
 parse_dictionary(<<>>) ->
-	#{};
+	{#{}, []};
 parse_dictionary(<<C,R/bits>>) when ?IS_LC_ALPHA(C) ->
-	{Dict, <<>>} = parse_dict_key(R, #{}, <<C>>),
-	Dict.
+	{Dict, Order, <<>>} = parse_dict_key(R, #{}, [], <<C>>),
+	{Dict, Order}.
 
-parse_dict_key(<<$=,$(,R0/bits>>, Acc, K) ->
+parse_dict_key(<<$=,$(,R0/bits>>, Acc, Order, K) ->
 	false = maps:is_key(K, Acc),
 	{Item, R} = parse_inner_list(R0, []),
-	parse_dict_before_sep(R, Acc#{K => Item});
-parse_dict_key(<<$=,R0/bits>>, Acc, K) ->
+	parse_dict_before_sep(R, Acc#{K => Item}, [K|Order]);
+parse_dict_key(<<$=,R0/bits>>, Acc, Order, K) ->
 	false = maps:is_key(K, Acc),
 	{Item, R} = parse_item1(R0),
-	parse_dict_before_sep(R, Acc#{K => Item});
-parse_dict_key(<<C,R/bits>>, Acc, K)
+	parse_dict_before_sep(R, Acc#{K => Item}, [K|Order]);
+parse_dict_key(<<C,R/bits>>, Acc, Order, K)
 		when ?IS_LC_ALPHA(C) or ?IS_DIGIT(C)
 			or (C =:= $_) or (C =:= $-) or (C =:= $*) ->
-	parse_dict_key(R, Acc, <<K/binary,C>>).
+	parse_dict_key(R, Acc, Order, <<K/binary,C>>).
 
-parse_dict_before_sep(<<C,R/bits>>, Acc) when ?IS_WS(C) ->
-	parse_dict_before_sep(R, Acc);
-parse_dict_before_sep(<<C,R/bits>>, Acc) when C =:= $, ->
-	parse_dict_before_member(R, Acc);
-parse_dict_before_sep(<<>>, Acc) ->
-	{Acc, <<>>}.
+parse_dict_before_sep(<<C,R/bits>>, Acc, Order) when ?IS_WS(C) ->
+	parse_dict_before_sep(R, Acc, Order);
+parse_dict_before_sep(<<C,R/bits>>, Acc, Order) when C =:= $, ->
+	parse_dict_before_member(R, Acc, Order);
+parse_dict_before_sep(<<>>, Acc, Order) ->
+	{Acc, lists:reverse(Order), <<>>}.
 
-parse_dict_before_member(<<C,R/bits>>, Acc) when ?IS_WS(C) ->
-	parse_dict_before_member(R, Acc);
-parse_dict_before_member(<<C,R/bits>>, Acc) when ?IS_LC_ALPHA(C) ->
-	parse_dict_key(R, Acc, <<C>>).
+parse_dict_before_member(<<C,R/bits>>, Acc, Order) when ?IS_WS(C) ->
+	parse_dict_before_member(R, Acc, Order);
+parse_dict_before_member(<<C,R/bits>>, Acc, Order) when ?IS_LC_ALPHA(C) ->
+	parse_dict_key(R, Acc, Order, <<C>>).
 
 -spec parse_item(binary()) -> sh_item().
 parse_item(Bin) ->
@@ -218,7 +221,7 @@ parse_binary(<<C,R/bits>>, Acc) when ?IS_ALPHANUM(C) or (C =:= $+) or (C =:= $/)
 	parse_binary(R, <<Acc/binary,C>>).
 
 -ifdef(TEST).
-struct_hd_test_() ->
+parse_struct_hd_test_() ->
 	Files = filelib:wildcard("deps/structured-header-tests/*.json"),
 	lists:flatten([begin
 		{ok, JSON} = file:read_file(File),
@@ -248,7 +251,7 @@ struct_hd_test_() ->
 					<<"list">> when MustFail; CanFail ->
 						{'EXIT', _} = (catch parse_list(Raw));
 					<<"dictionary">> ->
-						Expected = (catch parse_dictionary(Raw));
+						{Expected, _Order} = (catch parse_dictionary(Raw));
 					<<"item">> ->
 						Expected = (catch parse_item(Raw));
 					<<"list">> ->
@@ -320,3 +323,98 @@ trim_ws_end(Value, N) ->
 			Value2
 	end.
 -endif.
+
+%% Building.
+
+-spec dictionary(#{binary() => sh_item() | sh_inner_list()}
+		| [{binary(), sh_item() | sh_inner_list()}])
+	-> iolist().
+%% @todo Also accept this? dictionary({Map, Order}) ->
+dictionary(Map) when is_map(Map) ->
+	dictionary(maps:to_list(Map));
+dictionary(KVList) when is_list(KVList) ->
+	lists:join(<<", ">>, [
+		[Key, $=, item_or_inner_list(Value)]
+	|| {Key, Value} <- KVList]).
+
+-spec item(sh_item()) -> iolist().
+item({with_params, BareItem, Params}) ->
+	[bare_item(BareItem), params(Params)].
+
+-spec list(sh_list()) -> iolist().
+list(List) ->
+	lists:join(<<", ">>, [item_or_inner_list(Value) || Value <- List]).
+
+item_or_inner_list(Value={with_params, List, _}) when is_list(List) ->
+	inner_list(Value);
+item_or_inner_list(Value) ->
+	item(Value).
+
+inner_list({with_params, List, Params}) ->
+	[$(, lists:join($\s, [item(Value) || Value <- List]), $), params(Params)].
+
+bare_item({string, String}) ->
+	[$", escape_string(String, <<>>), $"];
+bare_item({token, Token}) ->
+	Token;
+bare_item({binary, Binary}) ->
+	[$*, base64:encode(Binary), $*];
+bare_item(Integer) when is_integer(Integer) ->
+	integer_to_binary(Integer);
+%% In order to properly reproduce the float as a string we
+%% must first determine how many decimals we want in the
+%% fractional component, otherwise rounding errors may occur.
+bare_item(Float) when is_float(Float) ->
+	Decimals = case trunc(Float) of
+		I when I >= 10000000000000 -> 1;
+		I when I >= 1000000000000 -> 2;
+		I when I >= 100000000000 -> 3;
+		I when I >= 10000000000 -> 4;
+		I when I >= 1000000000 -> 5;
+		_ -> 6
+	end,
+	float_to_binary(Float, [{decimals, Decimals}, compact]);
+bare_item(true) ->
+	<<"?1">>;
+bare_item(false) ->
+	<<"?0">>.
+
+escape_string(<<>>, Acc) -> Acc;
+escape_string(<<$\\,R/bits>>, Acc) -> escape_string(R, <<Acc/binary,$\\,$\\>>);
+escape_string(<<$",R/bits>>, Acc) -> escape_string(R, <<Acc/binary,$\\,$">>);
+escape_string(<<C,R/bits>>, Acc) -> escape_string(R, <<Acc/binary,C>>).
+
+params(Params) ->
+	maps:fold(fun
+		(Key, undefined, Acc) ->
+			[[$;, Key]|Acc];
+		(Key, Value, Acc) ->
+			[[$;, Key, $=, bare_item(Value)]|Acc]
+	end, [], Params).
+
+-ifdef(TEST).
+struct_hd_identity_test_() ->
+	Files = filelib:wildcard("deps/structured-header-tests/*.json"),
+	lists:flatten([begin
+		{ok, JSON} = file:read_file(File),
+		Tests = jsx:decode(JSON, [return_maps]),
+		[
+			{iolist_to_binary(io_lib:format("~s: ~s", [filename:basename(File), Name])), fun() ->
+				Expected = expected_to_term(Expected0),
+				case HeaderType of
+					<<"dictionary">> ->
+						{Expected, _Order} = parse_dictionary(iolist_to_binary(dictionary(Expected)));
+					<<"item">> ->
+						Expected = parse_item(iolist_to_binary(item(Expected)));
+					<<"list">> ->
+						Expected = parse_list(iolist_to_binary(list(Expected)))
+				end
+			end}
+		|| #{
+			<<"name">> := Name,
+			<<"header_type">> := HeaderType,
+			%% We only run tests that must not fail.
+			<<"expected">> := Expected0
+		} <- Tests]
+	end || File <- Files]).
+-endif.