%%%=============================================================================
%%% @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.