%%%=============================================================================
%%% @copyright (C) 1999-2013, Erlang Solutions Ltd
%%% @author Diana Corbacho <diana.corbacho@erlang-solutions.com>
%%% @doc
%%% @end
%%%=============================================================================
-module(fusco_tests_eqc).
-copyright("2013, Erlang Solutions Ltd.").
-include_lib("eqc/include/eqc.hrl").
-include("fusco.hrl").
-define(TWO_OK, <<"HTTP/1.1 200 OK\r\n\r\n">>).
-define(FOUR_BAD_REQUEST, <<"HTTP/1.1 400 Bad Request\r\n">>).
-define(TWO_OK(V), case V of
undefined ->
?TWO_OK;
_ ->
<<"HTTP/1.1 200 OK\r\nConnection: ",
V/binary,"\r\n\r\n">>
end).
-export([prop_http_request_per_family/3,
prop_persistent_connection_per_family/3,
prop_reconnect_per_family/3,
prop_client_close_connection_per_family/3,
prop_connection_refused_per_family/3,
prop_http_request_cookie_path/3,
prop_http_request_supersede_cookie/3,
prop_http_request_max_age/3,
prop_http_request_expires/3]).
%%==============================================================================
%% Quickcheck generators
%%==============================================================================
valid_http_request() ->
?LET({RequestLine, Headers},
{http_eqc_gen:request_line(), http_eqc_gen:request_headers()},
?LET(Body, http_eqc_encoding:body(any),
{RequestLine, http_eqc_encoding:add_content_length(Headers, Body),
Body})).
valid_http_response() ->
?LET({StatusLine, Headers},
{status_line(), http_eqc_gen:headers()},
?LET(Body, http_eqc_encoding:body(StatusLine),
{StatusLine, Headers, Body}
)
).
status_line() ->
%% Discard CONTINUE for cookie testing, client waits for next messages
?SUCHTHAT({_, S, _}, http_eqc_gen:status_line(),
not lists:member(S, [<<"100">>, <<"101">>])).
token() ->
non_empty(list(choose($A, $z))).
path() ->
?LET({Path, Slash}, {non_empty(list(token())), slash()},
Path ++ Slash).
domain() ->
?LET(Domain, path(), list_to_binary(string:join(Domain, "."))).
slash() ->
oneof([["/"], []]).
subpath(Path, true) ->
?LET({Length, Slash}, {choose(1, length(Path)), slash()},
begin
{H, _} = lists:split(Length, Path),
case lists:last(H) of
"/" ->
H;
_ ->
H ++ Slash
end
end);
subpath(Path, false) ->
?SUCHTHAT(SubPath, path(), hd(SubPath) =/= hd(Path)).
max_age() ->
%% Make cookie expire on nat/0 and not expire on largeint/0
%% Otherwise, in black box testing we lose the control to make cookie
%% expire on values near the current time. It needs unit testing
%% to verify the expiration is precise.
?LET({Expires, MaxAge},
oneof([{true, nat()}, {false, largeint()}]),
case MaxAge of
0 ->
{true, MaxAge};
_ ->
{Expires, abs(MaxAge)}
end).
past() ->
?SUCHTHAT(Date, http_eqc_gen:sane_cookie_date(), is_past(Date)).
future() ->
?SUCHTHAT(Date, http_eqc_gen:sane_cookie_date(), is_future(Date)).
expires() ->
oneof([{true, past()}, {false, future()}]).
set_cookie(Path) ->
{<<"Set-Cookie">>, {http_eqc_gen:cookie_pair(),
[{<<"Path">>, encode_path(Path)}]}}.
set_cookie(Path, MaxAge) when is_integer(MaxAge) ->
{<<"Set-Cookie">>, {http_eqc_gen:cookie_pair(),
[{<<"Path">>, encode_path(Path)},
{<<"Max-Age">>, integer_to_binary(MaxAge)}]}};
set_cookie(Path, Expires) ->
{<<"Set-Cookie">>,
{http_eqc_gen:cookie_pair(),
[{<<"Path">>, encode_path(Path)},
{<<"Expires">>, Expires}]}}.
set_cookie(Path, Domain, Name, Value) ->
{<<"Set-Cookie">>, {{Name, Value}, [{<<"Path">>, encode_path(Path)},
{<<"Domain">>, Domain}]}}.
cookie_path() ->
%% Cookie rejected if the value for the Path attribute
%% is not a prefix of the requested-URI
?LET({Path, IsSubPath}, {path(), bool()},
?LET(SubPath, subpath(Path, IsSubPath),
?LET(Cookie, set_cookie(SubPath),
{Cookie, encode_path(Path), IsSubPath}
)
)
).
cookie_max_age() ->
%% Path is needed in the test setup to ensure cookie is not rejected
?LET({Path, {Expires, MaxAge}}, {path(), max_age()},
?LET(Cookie, set_cookie(Path, MaxAge),
{Cookie, encode_path(Path), Expires, MaxAge}
)
).
cookie_expires() ->
%% Path is needed in the test setup to ensure cookie is not rejected
?LET({Path, {Expires, Date}}, {path(), expires()},
?LET(Cookie, set_cookie(Path, Date),
{Cookie, encode_path(Path), Expires}
)
).
maybe_different_cookie_data(true, Path, Domain, Name) ->
{Path, Domain, Name};
maybe_different_cookie_data(false, Path, Domain, Name) ->
%% Generates a combination of 1 or more mutations on Path, Domain and Name
?LET([ChangePath, ChangeDomain, ChangeName],
?SUCHTHAT(V, vector(3, bool()),
lists:any(fun(X) -> X == true end, V)),
{change_path(ChangePath, Path),
change_domain(ChangeDomain, Domain),
change_name(ChangeName, Name)}
).
change_path(false, Path) ->
Path;
change_path(true, Path) ->
?SUCHTHAT(P, path(), hd(P) =/= hd(Path)).
change_domain(false, Domain) ->
Domain;
change_domain(true, Domain) ->
?SUCHTHAT(D, domain(), D =/= Domain).
change_name(false, Name) ->
Name;
change_name(true, Name) ->
?SUCHTHAT(N, http_eqc_gen:small_valid_bin(), N =/= Name).
%%==============================================================================
%% Quickcheck properties
%%==============================================================================
prop_http_request_per_family(Host, Family, Ssl) ->
eqc:numtests(
500,
?FORALL({{Method, Uri, _Version}, Headers, Body} = Msg,
valid_http_request(),
begin
Module = select_module(Ssl),
{ok, Listener, LS, Port} =
webserver:start(Module, [validate_msg(Msg)], Family),
{ok, Client} = fusco:start({Host, Port, Ssl}, []),
{ok, {Status, _, _, _, _}}
= fusco:request(Client, Uri, Method, Headers, Body, 10000),
ok = fusco:disconnect(Client),
webserver:stop(Module, Listener, LS),
Expected = {<<"200">>, <<"OK">>},
?WHENFAIL(io:format("Status: ~p~nExpected: ~p~n",
[Status, Expected]),
case Status of
Expected ->
true;
_ ->
false
end)
end)).
prop_persistent_connection_per_family(Host, Family, Ssl) ->
%% Fusco must keep the connection alive and be able to reconnect
%% Individual properties defined for reconnect and keep-alive
?FORALL(
Msgs,
non_empty(list({valid_http_request(), http_eqc_gen:connection_header()})),
begin
Module = select_module(Ssl),
{ok, Listener, LS, Port} =
webserver:start(Module,
[reply_msg(?TWO_OK(ConHeader)) || {_, ConHeader} <- Msgs],
Family),
{ok, Client} = fusco:start({Host, Port, Ssl}, []),
Replies = lists:map(fun({{{Method, Uri, _Version}, Headers, Body}, _}) ->
fusco:request(Client, Uri, Method, Headers, Body, 10000)
end, Msgs),
ok = fusco:disconnect(Client),
webserver:stop(Module, Listener, LS),
?WHENFAIL(io:format("Replies: ~p~nExpected: 200 OK~n", [Replies]),
lists:all(fun({ok, {{<<"200">>, <<"OK">>}, _, _, _, _}}) ->
true;
(_) ->
false
end, Replies))
end).
prop_reconnect_per_family(Host, Family, Ssl) ->
%% Connection is always closed in the server and fusco must reconnect
eqc:numtests(
50,
?FORALL(
Msgs,
non_empty(list(valid_http_request())),
begin
Module = select_module(Ssl),
{ok, Listener, LS, Port} =
webserver:start(Module,
[reply_and_close_msg(?TWO_OK) || _ <- Msgs],
Family),
{ok, Client} = fusco:start({Host, Port, Ssl}, []),
Replies = lists:map(fun({{Method, Uri, _Version}, Headers, Body}) ->
Hdrs = lists:keydelete(<<"Connection">>, 1, Headers),
fusco:request(Client, Uri, Method, Hdrs, Body, 10000)
end, Msgs),
ok = fusco:disconnect(Client),
webserver:stop(Module, Listener, LS),
?WHENFAIL(io:format("Replies: ~p~nExpected: 200 OK~n", [Replies]),
lists:all(fun({ok, {{<<"200">>, <<"OK">>}, _, _, _, _}}) ->
true;
(_) ->
false
end, Replies))
end)).
prop_client_close_connection_per_family(Host, Family, Ssl) ->
%% Fusco must close the connection if requested by the server
eqc:numtests(
25,
?FORALL({{{Method, Uri, _Version}, Headers, Body}, Connection},
{valid_http_request(), http_eqc_gen:connection_header()},
begin
Id = erlang:now(),
Module = select_module(Ssl),
{ok, Listener, LS, Port} =
webserver:start(Module,
[reply_msg_and_check(Id, ?TWO_OK(Connection))],
Family),
{ok, Client} = fusco:start({Host, Port, Ssl}, []),
{ok, {Status, _, _, _, _}}
= fusco:request(Client, Uri, Method, Headers, Body, 10000),
Closed = receive
{Id, closed} ->
true
after 1000 ->
false
end,
ok = fusco:disconnect(Client),
webserver:stop(Module, Listener, LS),
Expected = {<<"200">>, <<"OK">>},
MustClose = must_close(Headers, Connection),
?WHENFAIL(io:format("Connection: ~p~nStatus: ~p~nExpected:"
" ~p~nMust close: ~p~nClosed: ~p~n",
[Connection, Status, Expected, MustClose, Closed]),
case Status of
Expected ->
MustClose == Closed;
_ ->
false
end)
end)).
prop_connection_refused_per_family(Host, Family, Ssl) ->
eqc:numtests(1,
begin
Module = select_module(Ssl),
{ok, Listener, LS, Port} =
webserver:start(Module, [reply_msg(<<>>)], Family),
webserver:stop(Module, Listener, LS),
{ok, Client} = fusco:start({Host, Port, Ssl}, []),
Reply = fusco:connect(Client),
Expected = {error, econnrefused},
?WHENFAIL(io:format("Reply: ~p~nExpected: ~p~n",
[Reply, Expected]),
case Reply of
Expected ->
true;
_ ->
false
end)
end).
%% Cookie rejected if the value for the Path attribute
%% is not a prefix of the requested-URI
prop_http_request_cookie_path(Host, Family, Ssl) ->
?FORALL(
{Request, {Cookie, Path, IsSubPath},
{{_, Status, Reason}, _, _} = Response},
{valid_http_request(), cookie_path(), valid_http_response()},
begin
ResponseBin = build_response(Response, [Cookie]),
ValidationFun = validate_cookie(ResponseBin, fun check_cookie_deleted/3,
[not IsSubPath, Cookie]),
Responses =
send_cookie_requests(Host, Ssl, Family, ValidationFun, Path, Request,
[<<"first">>, <<"second">>], 0),
check_responses(Status, Reason, Responses)
end
).
%% Supersed old cookie if Name is the same as existing cookie,
%% and Domain and Path exactly match pre-existing ones
prop_http_request_supersede_cookie(Host, Family, Ssl) ->
?FORALL(
{Request, Path, Domain, {Name, Value}, Supersede,
{{_, Status, Reason}, _, _} = Response},
{valid_http_request(), path(), domain(), http_eqc_gen:cookie_pair(),
bool(), valid_http_response()},
%% Generate a second cookie that could supersed or not the previous one
%% Uses 'Supersede' as generation parameter
?LET(
{{SPath, SDomain, SName}, SValue},
{maybe_different_cookie_data(Supersede, Path, Domain, Name),
?SUCHTHAT(V, http_eqc_gen:small_valid_bin(), V =/= Value)},
begin
FirstCookie = set_cookie(Path, Domain, Name, Value),
SecondCookie = set_cookie(SPath, SDomain, SName, SValue),
FirstServerResponse = build_response(Response, [FirstCookie]),
SecondServerResponse = build_response(Response, [SecondCookie]),
ValidationFun = validate_cookie_supersede(
FirstServerResponse, SecondServerResponse,
Supersede, {Name, Value, encode_path(Path), Domain},
{SName, SValue, encode_path(SPath), SDomain}),
%% Three requests to supersede the value
%% First get cookie
%% Second get second cookie
%% Third checks received cookies
Responses =
send_cookie_requests(Host, Ssl, Family, ValidationFun,
encode_path(Path), Request,
[<<"first">>, <<"second">>, <<"third">>], 0),
check_responses(Status, Reason, Responses)
end
)
).
prop_http_request_max_age(Host, Family, Ssl) ->
eqc:numtests(
25,
?FORALL(
{Request, {Cookie, Path, Expires, MaxAge},
{{_, Status, Reason}, _, _} = Response},
{valid_http_request(), cookie_max_age(), valid_http_response()},
begin
ResponseBin = build_response(Response, [Cookie]),
ValidationFun = validate_cookie(ResponseBin, fun check_cookie_deleted/3,
[Expires, Cookie]),
WaitTime = expiration_time(Expires, MaxAge),
Responses =
send_cookie_requests(Host, Ssl, Family, ValidationFun, Path,
Request, [<<"first">>, <<"second">>],
WaitTime),
check_responses(Status, Reason, Responses)
end
)
).
prop_http_request_expires(Host, Family, Ssl) ->
?FORALL(
{Request, {Cookie, Path, Expires},
{{_, Status, Reason}, _, _} = Response},
{valid_http_request(), cookie_expires(), valid_http_response()},
begin
ResponseBin = build_response(Response, [Cookie]),
ValidationFun = validate_cookie(ResponseBin, fun check_cookie_deleted/3,
[Expires, Cookie]),
Responses =
send_cookie_requests(Host, Ssl, Family, ValidationFun, Path,
Request, [<<"first">>, <<"second">>], 0),
check_responses(Status, Reason, Responses)
end
).
%%==============================================================================
%% Internal functions
%%==============================================================================
validate_msg({{_Method, _Uri, _Version}, SentHeaders, SentBody}) ->
fun(Module, Socket, _Request, GotHeaders, GotBody) when SentBody == GotBody ->
case validate_headers(SentBody, GotHeaders, SentHeaders) of
true ->
Module:send(Socket, ?TWO_OK);
false ->
Module:send(Socket, ?FOUR_BAD_REQUEST)
end;
(Module, Socket, _Request, _GotHeaders, _) ->
Module:send(Socket, ?FOUR_BAD_REQUEST)
end.
validate_cookie(Response, Fun, Params) ->
fun(Module, Socket, _Request, Headers, _Body) ->
case proplists:get_value("Test", Headers) of
"first" ->
Module:send(Socket, Response);
"second" ->
case erlang:apply(Fun, [Headers | Params]) of
true ->
Module:send(Socket, ?TWO_OK);
false ->
Module:send(Socket, ?FOUR_BAD_REQUEST)
end
end
end.
validate_cookie_supersede(FirstResponse, SecondResponse, Supersede, FirstPair,
SecondPair) ->
fun(Module, Socket, _Request, Headers, _Body) ->
case proplists:get_value("Test", Headers) of
"first" ->
Module:send(Socket, FirstResponse);
"second" ->
Module:send(Socket, SecondResponse);
"third" ->
case check_cookie_supersede(Headers, Supersede, FirstPair, SecondPair) of
true ->
Module:send(Socket, ?TWO_OK);
false ->
Module:send(Socket, ?FOUR_BAD_REQUEST)
end
end
end.
build_cookie(N, V) ->
binary_to_list(<<N/binary,"=",V/binary>>).
check_cookie_deleted(Headers, true, _) ->
undefined == proplists:get_value("Cookie", Headers);
check_cookie_deleted(Headers, false, {_, {{N, V}, _}}) ->
build_cookie(N, V) == proplists:get_value("Cookie", Headers).
%% http://tools.ietf.org/search/rfc6265#section-4.1.2
check_cookie_supersede(Headers, true, {Name, _, _, _}, {_, NewValue, _, _}) ->
build_cookie(Name, NewValue) == proplists:get_value("Cookie", Headers);
check_cookie_supersede(Headers, false, {Name, Value, Path, _},
{NewName, NewValue, Path, _}) ->
lists:sort([build_cookie(Name, Value), build_cookie(NewName, NewValue)])
== lists:sort(string:tokens(proplists:get_value("Cookie", Headers), "; "));
check_cookie_supersede(Headers, false, {Name, Value, _, _}, _) ->
build_cookie(Name, Value)
== proplists:get_value("Cookie", Headers).
verify_host(GotHeaders, SentHeaders) ->
%% Host must be added by the client if it is not part of the headers list
%% http://tools.ietf.org/html/rfc2616#section-14.23
Key = "host",
case lists:keytake(Key, 1, GotHeaders) of
{value, {_, Value}, NewGotHeaders} ->
case lists:keytake(Key, 1, SentHeaders) of
%% The user sent the 'Host' header, value must match
{value, {_, Value}, NewSentHeaders} ->
{NewGotHeaders, NewSentHeaders};
false ->
{NewGotHeaders, SentHeaders};
_ ->
false
end;
false ->
false
end.
verify_content_length(Body, GotHeaders, SentHeaders) ->
%% Must be updated when the code supports transfer-encoding
%% http://tools.ietf.org/html/rfc2616#section-14.13
Key = "content-length",
ContentLength = iolist_size(Body),
{NewGotHeaders, GotContentLength}
= case lists:keytake(Key, 1, GotHeaders) of
{value, {_, Value}, H} ->
{H, list_to_integer(Value)};
false ->
{GotHeaders, 0}
end,
case ContentLength == GotContentLength of
true ->
{NewGotHeaders, lists:keydelete(Key, 1, SentHeaders)};
false ->
false
end.
validate_headers(Body, GotHeaders, SentHeaders) ->
CleanGotHeaders = lists:keysort(1, [{string:to_lower(K), V}
|| {K, V} <- GotHeaders]),
CleanSentHeaders = lists:keysort(1, [{string:to_lower(binary_to_list(K)),
binary_to_list(V)}
|| {K, V} <- SentHeaders]),
case verify_host(CleanGotHeaders, CleanSentHeaders) of
false ->
false;
{GotHeaders1, Headers1} ->
case verify_content_length(Body, GotHeaders1, Headers1) of
false ->
false;
{GotHeaders2, Headers2} ->
GotHeaders2 == Headers2
end
end.
reply_msg(Msg) ->
fun(Module, Socket, _Request, _Headers, _Body) ->
Module:send(Socket, Msg)
end.
reply_msg_and_check(Id, Msg) ->
Parent = self(),
fun(Module, Socket, _Request, _Headers, _Body) ->
Module:send(Socket, Msg),
case Module:recv(Socket, 0) of
{error, closed} ->
Parent ! {Id, closed};
_ ->
ok
end
end.
reply_and_close_msg(Msg) ->
fun(Module, Socket, _Request, _Headers, _Body) ->
Module:send(Socket, Msg),
Module:close(Socket)
end.
must_close(Headers, Connection) ->
case proplists:get_value(<<"Connection">>, Headers) of
<<"close">> ->
true;
_ ->
case Connection of
<<"close">> ->
true;
_ ->
false
end
end.
select_module(Ssl) ->
case Ssl of
true ->
ssl;
false ->
gen_tcp
end.
encode_path(Path) ->
case lists:split(length(Path) - 1, Path) of
{P, ["/"]} ->
list_to_binary(["/", string:join(P, "/"), "/"]);
_ ->
list_to_binary(["/", string:join(Path, "/")])
end.
build_response({StatusLine, Headers, Body}, Cookies) ->
http_eqc_encoding:build_valid_response(
StatusLine,
http_eqc_encoding:add_content_length(Headers, Body),
Cookies, Body).
send_cookie_requests(Host, Ssl, Family, ValidationFun, Path,
{{Method, _Uri, _Version}, Headers, Body},
RequestTags, WaitTime) ->
Module = select_module(Ssl),
{ok, Listener, LS, Port} =
webserver:start(Module, [ValidationFun], Family),
{ok, Client} = fusco:start({Host, Port, Ssl}, [{use_cookies, true}]),
%% Use header "test" to distinguish requests in the server side
Responses = lists:map(
fun(Header) ->
{ok, {Response, _, _, _, _}}
= fusco:request(Client, Path, Method,
[{<<"test">>, Header} | Headers],
Body, 10000),
timer:sleep(WaitTime),
Response
end, RequestTags),
ok = fusco:disconnect(Client),
webserver:stop(Module, Listener, LS),
Responses.
expiration_time(Expires, MaxAge) ->
case Expires of
true ->
MaxAge*1000;
false ->
0
end.
check_responses(Status, Reason, [First, Second]) ->
Expected = {Status, Reason},
?WHENFAIL(io:format("First: ~p~nExpected: ~p~nSecond: ~p~n",
[First, Expected, Second]),
{First, Second} == {Expected, {<<"200">>, <<"OK">>}}
);
check_responses(Status, Reason, [First, Second, Third]) ->
Expected = {Status, Reason},
?WHENFAIL(io:format("First: ~p~nSecond: ~p~nExpected: ~p~nThird ~p~n",
[First, Second, Expected, Third]),
{First, Second, Third}
== {Expected, Expected, {<<"200">>, <<"OK">>}}
).
diff(A, A) ->
eq;
diff(A, B) when A < B ->
lt;
diff(_, _) ->
gt.
is_past(DateTime) ->
{Date, {H, M, _}} = http_eqc_encoding:expires_datetime(DateTime),
case diff(Date, date()) of
lt ->
true;
gt ->
false;
eq ->
{HH, MM, _} = time(),
%% Set 30 min margin, safe side
case diff((HH*60+MM) - (H*60+M), 30) of
gt ->
true;
eq ->
true;
lt ->
false
end
end.
is_future(DateTime) ->
{Date, {H, M, _}} = http_eqc_encoding:expires_datetime(DateTime),
case diff(Date, date()) of
gt ->
true;
lt ->
false;
eq ->
{HH, MM, _} = time(),
%% Set 30 min margin, safe side
case diff((H*60+M) - (HH*60+MM), 30) of
gt ->
true;
eq ->
true;
lt ->
false
end
end.