fewd/src/fd_httpd_client.erl

%%% @doc
%%% front end web development lab Client
%%%
%%% An extremely naive (currently Telnet) client handler.
%%% Unlike other modules that represent discrete processes, this one does not adhere
%%% to any OTP behavior. It does, however, adhere to OTP.
%%%
%%% In some cases it is more comfortable to write socket handlers or a certain
%%% category of state machines as "pure" Erlang processes. This approach is made
%%% OTP-able by use of the proc_lib module, which is the underlying library used
%%% to write the stdlib's behaviors like gen_server, gen_statem, gen_fsm, etc.
%%%
%%% http://erlang.org/doc/design_principles/spec_proc.html
%%% @end

-module(fd_httpd_client).
-vsn("0.2.0").
-author("Peter Harpending <peterharpending@qpq.swiss>").
-copyright("Peter Harpending <peterharpending@qpq.swiss>").
-license("BSD-2-Clause-FreeBSD").

-export([start/1]).
-export([start_link/1, init/2]).
-export([system_continue/3, system_terminate/4,
         system_get_state/1, system_replace_state/2]).


%%% Type and Record Definitions

-include("http.hrl").
-include("$zx_include/zx_logger.hrl").


-record(s, {socket = none :: none | gen_tcp:socket(),
            next   = <<>> :: binary()}).


%% An alias for the state record above. Aliasing state can smooth out annoyances
%% that can arise from using the record directly as its own type all over the code.

-type state() :: #s{}.


%%% Service Interface


-spec start(ListenSocket) -> Result
    when ListenSocket :: gen_tcp:socket(),
         Result       :: {ok, pid()}
                       | {error, Reason},
         Reason       :: {already_started, pid()}
                       | {shutdown, term()}
                       | term().
%% @private
%% How the fd_httpd_client_man or a prior fd_httpd_client kicks things off.
%% This is called in the context of fd_httpd_client_man or the prior fd_httpd_client.

start(ListenSocket) ->
    fd_httpd_client_sup:start_acceptor(ListenSocket).


-spec start_link(ListenSocket) -> Result
    when ListenSocket :: gen_tcp:socket(),
         Result       :: {ok, pid()}
                       | {error, Reason},
         Reason       :: {already_started, pid()}
                       | {shutdown, term()}
                       | term().
%% @private
%% This is called by the fd_httpd_client_sup. While start/1 is called to iniate a startup
%% (essentially requesting a new worker be started by the supervisor), this is
%% actually called in the context of the supervisor.

start_link(ListenSocket) ->
    proc_lib:start_link(?MODULE, init, [self(), ListenSocket]).


-spec init(Parent, ListenSocket) -> no_return()
    when Parent       :: pid(),
         ListenSocket :: gen_tcp:socket().
%% @private
%% This is the first code executed in the context of the new worker itself.
%% This function does not have any return value, as the startup return is
%% passed back to the supervisor by calling proc_lib:init_ack/2.
%% We see the initial form of the typical arity-3 service loop form here in the
%% call to listen/3.

init(Parent, ListenSocket) ->
    ok = tell("~p Listening.~n", [self()]),
    Debug = sys:debug_options([]),
    ok = proc_lib:init_ack(Parent, {ok, self()}),
    listen(Parent, Debug, ListenSocket).


-spec listen(Parent, Debug, ListenSocket) -> no_return()
    when Parent       :: pid(),
         Debug        :: [sys:dbg_opt()],
         ListenSocket :: gen_tcp:socket().
%% @private
%% This function waits for a TCP connection. The owner of the socket is still
%% the fd_httpd_client_man (so it can still close it on a call to fd_httpd_client_man:ignore/0),
%% but the only one calling gen_tcp:accept/1 on it is this process. Closing the socket
%% is one way a manager process can gracefully unblock child workers that are blocking
%% on a network accept.
%%
%% Once it makes a TCP connection it will call start/1 to spawn its successor.

listen(Parent, Debug, ListenSocket) ->
    case gen_tcp:accept(ListenSocket) of
        {ok, Socket} ->
            {ok, _} = start(ListenSocket),
            {ok, Peer} = inet:peername(Socket),
            ok = tell("~p Connection accepted from: ~p~n", [self(), Peer]),
            ok = fd_httpd_client_man:enroll(),
            State = #s{socket = Socket},
            loop(Parent, Debug, State);
        {error, closed} ->
            ok = tell("~p Retiring: Listen socket closed.~n", [self()]),
            exit(normal)
     end.


-spec loop(Parent, Debug, State) -> no_return()
    when Parent :: pid(),
         Debug  :: [sys:dbg_opt()],
         State  :: state().
%% @private
%% The service loop itself. This is the service state. The process blocks on receive
%% of Erlang messages, TCP segments being received themselves as Erlang messages.

loop(Parent, Debug, State = #s{socket = Socket, next = Next0}) ->
    ok = inet:setopts(Socket, [{active, once}]),
    receive
        {tcp, Socket, Message} ->
            Received = <<Next0/binary, Message/binary>>,
            case qhl:parse(Socket, Received) of
                {ok, Req, Next1} ->
                    Next2 = handle_request(Socket, Req, Next1),
                    NewState = State#s{next = Next2},
                    loop(Parent, Debug, NewState);
                Error ->
                    %% should trigger bad request
                    tell(error, "~p QHL parse error: ~tp", [?LINE, Error]),
                    tell(error, "~p bad request:~n~ts", [?LINE, Received]),
                    fd_httpd_utils:http_err(Socket, 400),
                    gen_tcp:shutdown(Socket, read_write),
                    exit(normal)
            end;
        {tcp_closed, Socket} ->
            ok = tell("~p Socket closed, retiring.~n", [self()]),
            exit(normal);
        {system, From, Request} ->
            sys:handle_system_msg(Request, From, Parent, ?MODULE, Debug, State);
        Unexpected ->
            ok = tell("~p Unexpected message: ~tp", [self(), Unexpected]),
            loop(Parent, Debug, State)
    end.


-spec system_continue(Parent, Debug, State) -> no_return()
    when Parent :: pid(),
         Debug  :: [sys:dbg_opt()],
         State  :: state().
%% @private
%% The function called by the OTP internal functions after a system message has been
%% handled. If the worker process has several possible states this is one place
%% resumption of a specific state can be specified and dispatched.

system_continue(Parent, Debug, State) ->
    loop(Parent, Debug, State).


-spec system_terminate(Reason, Parent, Debug, State) -> no_return()
    when Reason :: term(),
         Parent :: pid(),
         Debug  :: [sys:dbg_opt()],
         State  :: state().
%% @private
%% Called by the OTP inner bits to allow the process to terminate gracefully.
%% Exactly when and if this is callback gets called is specified in the docs:
%% See: http://erlang.org/doc/design_principles/spec_proc.html#msg

system_terminate(Reason, _Parent, _Debug, _State) ->
    exit(Reason).



-spec system_get_state(State) -> {ok, State}
    when State :: state().
%% @private
%% This function allows the runtime (or anything else) to inspect the running state
%% of the worker process at any arbitrary time.

system_get_state(State) -> {ok, State}.


-spec system_replace_state(StateFun, State) -> {ok, NewState, State}
    when StateFun :: fun(),
         State    :: state(),
         NewState :: term().
%% @private
%% This function allows the system to update the process state in-place. This is most
%% useful for state transitions between code types, like when performing a hot update
%% (very cool, but sort of hard) or hot patching a running system (living on the edge!).

system_replace_state(StateFun, State) ->
    {ok, StateFun(State), State}.



%%% http request handling

-spec handle_request(Sock, Request, Received) -> NewReceived
    when Sock        :: gen_tcp:socket(),
         Request     :: request(),
         Received    :: binary(),
         NewReceived :: binary().

handle_request(Sock, R = #request{method = M, path = P}, Received) when M =/= undefined, P =/= undefined ->
    tell("~tp ~tp ~ts", [self(), M, P]),
    route(Sock, M, P, R, Received).



-spec route(Sock, Method, Route, Request, Received) -> NewReceived
    when Sock        :: gen_tcp:socket(),
         Method      :: get | post,
         Route       :: binary(),
         Request     :: request(),
         Received    :: binary(),
         NewReceived :: binary().

route(Sock, get, Route, Request, Received) ->
    case Route of
         <<"/ws/echo">>   -> ws_echo(Sock, Request)                 , Received;
         <<"/">>          -> route_static(Sock, <<"/index.html">>)  , Received;
         _                -> route_static(Sock, Route)              , Received
    end;
route(Sock, post, Route, Request, Received) ->
    case Route of
         <<"/grids-spend">> -> grids_spend(Sock, Request) , Received;
         <<"/wfcin">>       -> wfcin(Sock, Request) , Received;
         _                  -> fd_httpd_utils:http_err(Sock, 404)  , Received
    end;
route(Sock, _, _, _, Received) ->
    fd_httpd_utils:http_err(Sock, 404),
    Received.



-spec route_static(Socket, Route) -> ok
    when Socket :: gen_tcp:socket(),
         Route  :: binary().

route_static(Sock, Route) ->
    respond_static(Sock, fd_httpd_sfc:query(Route)).



-spec respond_static(Sock, MaybeEty) -> ok
    when Sock     :: gen_tcp:socket(),
         MaybeEty :: fd_httpd_sfc:maybe_entry().

respond_static(Sock, {found, Entry}) ->
    % -record(e, {fs_path       :: file:filename(),
    %             last_modified :: file:date_time(),
    %             mime_type     :: string(),
    %             encoding      :: encoding(),
    %             contents      :: binary()}).
    Headers0 =
        case fd_httpd_sfc_entry:encoding(Entry) of
            gzip -> [{"content-encoding", "gzip"}];
            none -> []
        end,
    Headers1 = [{"content-type", fd_httpd_sfc_entry:mime_type(Entry)} | Headers0],
    Response = #response{headers = Headers1,
                         body    = fd_httpd_sfc_entry:contents(Entry)},
    fd_httpd_utils:respond(Sock, Response);
respond_static(Sock, not_found) ->
    fd_httpd_utils:http_err(Sock, 404).


%% ------------------------------
%% echo
%% ------------------------------

ws_echo(Sock, Request) ->
    try
        ws_echo2(Sock, Request)
    catch
        X:Y:Z ->
            tell(error, "CRASH ws_echo: ~tp:~tp:~tp", [X, Y, Z]),
            fd_httpd_utils:http_err(Sock, 500)
    end.

ws_echo2(Sock, Request) ->
    case qhl_ws:handshake(Request) of
        {ok, Response} ->
            fd_httpd_utils:respond(Sock, Response),
            ws_echo_loop(Sock);
        Error ->
            tell("ws_echo: error: ~tp", [Error]),
            fd_httpd_utils:http_err(Sock, 400)
    end.

ws_echo_loop(Sock) ->
    ws_echo_loop(Sock, [], <<>>).

ws_echo_loop(Sock, Frames, Received) ->
    tell("~p ws_echo_loop(Sock, ~tp, ~tp)", [self(), Frames, Received]),
    case qhl_ws:recv(Sock, Received, 5*qhl_ws:min(), Frames) of
        {ok, Message, NewFrames, NewReceived} ->
            tell("~p echo message: ~tp", [self(), Message]),
            % send the same message back
            ok = qhl_ws:send(Sock, Message),
            ws_echo_loop(Sock, NewFrames, NewReceived);
        Error ->
            tell(error, "ws_echo_loop: error: ~tp", [Error]),
            qhl_ws:send(Sock, {close, <<>>}),
            error(Error)
    end.

%% ------------------------------
%% grids
%% ------------------------------

grids_spend(Sock, #request{enctype = json,
                           body = B = #{"network_id" := NetId,
                                        "recipient"  := Recipient,
                                        "amount"     := Amount,
                                        "payload"    := Payload}}) ->
    tell("grids_spend good request: ~tp", [B]),
    RespObj =
        case fd_gridsd:mk_spend(NetId, Recipient, Amount, unicode:characters_to_binary(Payload)) of
            {ok, URL, PNG} ->
                #{"ok"         => true,
                  "result"     => #{"url"        => URL,
                                    "png_base64" => unicode:characters_to_list(base64:encode(PNG))}};
            {error, String} ->
                #{"ok"    => false,
                  "error" => String}
        end,
    Body = zj:encode(RespObj),
    % update cache with new context
    Response = #response{headers = [{"content-type", "application/json"}],
                         body    = Body},
    fd_httpd_utils:respond(Sock, Response);
grids_spend(Sock, Request) ->
    tell("grids_spend: bad request: ~tp", [Request]),
    fd_httpd_utils:http_err(Sock, 400).



%% ------------------------------
%% wfc
%% ------------------------------

wfcin(Sock, #request{enctype = json,
                     cookies = Cookies,
                     body = #{"wfcin" := Input}}) ->
    tell("wfcin good request: ~tp", [Input]),
    {Cookie, Ctx0} = ctx(Cookies),
    {RespObj, NewCtx} =
        %% FIXME: this should really be a new process
        try
            case wfc_read:expr(Input) of
                {ok, Expr, _Rest} ->
                    case wfc_eval:eval(Expr, Ctx0) of
                        {ok, noop, Ctx1}     -> {fd_httpd_utils:jsgud("<noop>"), Ctx1};
                        {ok, Sentence, Ctx1} -> {fd_httpd_utils:jsgud(wfc_pp:sentence(Sentence)), Ctx1};
                        {error, Message}     -> {fd_httpd_utils:jsbad(Message), Ctx0}
                    end;
                {error, Message} ->
                    {fd_httpd_utils:jsbad(Message), Ctx0}
            end
        catch
            error:E:S ->
                ErrorMessage = unicode:characters_to_list(io_lib:format("parser crashed: ~p:~p", [E, S])),
                {fd_httpd_utils:jsbad(ErrorMessage), Ctx0}
        end,
    % update cache with new context
    ok = fd_wfcd_cache:set(Cookie, NewCtx),
    Body    = zj:encode(RespObj),
    Response = #response{headers = [{"content-type", "application/json"},
                                    {"set-cookie",   ["wfc=", Cookie]}],
                         body    = Body},
    fd_httpd_utils:respond(Sock, Response);
wfcin(Sock, Request) ->
    tell("wfcin: bad request: ~tp", [Request]),
    fd_httpd_utils:http_err(Sock, 400).



-spec ctx(Cookies) -> {Cookie, Context}
    when Cookies :: #{binary() := Cookie},
         Cookie  :: binary(),
         Context :: wfc_eval_context:context().

ctx(#{<<"wfc">> := Cookie}) ->
    case fd_wfcd_cache:query(Cookie) of
        {ok, Context} -> {Cookie, Context};
        error         -> {Cookie, wfc_eval_context:default()}
    end;
ctx(_) ->
    {fd_httpd_utils:new_cookie(), wfc_eval_context:default()}.