fewd/src/fd_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_client).
-vsn("0.1.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   = none :: none | 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_client_man or a prior fd_client kicks things off.
%% This is called in the context of fd_client_man or the prior fd_client.

start(ListenSocket) ->
    fd_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_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 = io:format("~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_client_man (so it can still close it on a call to fd_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 = io:format("~p Connection accepted from: ~p~n", [self(), Peer]),
            ok = fd_client_man:enroll(),
            State = #s{socket = Socket},
            loop(Parent, Debug, State);
        {error, closed} ->
            ok = io:format("~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 = Next}) ->
    ok = inet:setopts(Socket, [{active, once}]),
    receive
        {tcp, Socket, Message} ->
            tell("~p Next = ~p", [?LINE, Next]),
            Received =
                case Next of
                    none -> Message;
                    _    -> <<Next/binary, Message/binary>>
                end,
            tell("qhl_parse(Socket, ~tp)", [Received]),
            case qhl:parse(Socket, Received) of
                {ok, Req, NewNext} ->
                    tell("qhl return: {ok, ~p, ~p}", [Req, NewNext]),
                    handle_request(Socket, Req),
                    NewState = State#s{next = NewNext},
                    loop(Parent, Debug, NewState);
                Error ->
                    %% should trigger bad request
                    io:format("~p QHL parse error: ~tp", [?LINE, Error]),
                    io:format("~p bad request:~n~ts", [?LINE, Received]),
                    http_err(Socket, 400),
                    gen_tcp:shutdown(Socket, read_write),
                    exit(normal)
            end;
        {tcp_closed, Socket} ->
            ok = io:format("~p Socket closed, retiring.~n", [self()]),
            exit(normal);
        {system, From, Request} ->
            sys:handle_system_msg(Request, From, Parent, ?MODULE, Debug, State);
        Unexpected ->
            ok = io:format("~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

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


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


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

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_sfc_entry:encoding(Entry) of
            gzip -> [{"content-encoding", "gzip"}];
            none -> []
        end,
    Headers1 = [{"content-type", fd_sfc_entry:mime_type(Entry)} | Headers0],
    Response = #response{headers = Headers1,
                         body    = fd_sfc_entry:contents(Entry)},
    respond(Sock, Response);
respond_static(Sock, not_found) ->
    http_err(Sock, 404).


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

ws_echo2(Sock, Request) ->
    tell("~p: ws_echo request: ~tp", [?LINE, Request]),
    case fd_ws:handshake(Request) of
        {ok, Response} ->
            tell("~p: ws_echo response: ~tp", [?LINE, Response]),
            respond(Sock, Response),
            tell("~p: ws_echo: entering loop", [?LINE]),
            ws_echo_loop(Sock);
        Error ->
            tell("ws_echo: error: ~tp", [Error]),
            http_err(Sock, 400)
    end.

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

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

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}     -> {jsgud("<noop>"), Ctx1};
                        {ok, Sentence, Ctx1} -> {jsgud(wfc_pp:sentence(Sentence)), Ctx1};
                        {error, Message}     -> {jsbad(Message), Ctx0}
                    end;
                {error, Message} ->
                    {jsbad(Message), Ctx0}
            end
        catch
            error:E:S ->
                ErrorMessage = unicode:characters_to_list(io_lib:format("parser crashed: ~p:~p", [E, S])),
                {jsbad(ErrorMessage), Ctx0}
        end,
    % update cache with new context
    ok = fd_cache:set(Cookie, NewCtx),
    Body    = zj:encode(RespObj),
    Response = #response{headers = [{"content-type", "application/json"},
                                    {"set-cookie",   ["wfc=", Cookie]}],
                         body    = Body},
    respond(Sock, Response);
wfcin(Sock, Request) ->
    tell("wfcin: bad request: ~tp", [Request]),
    http_err(Sock, 400).


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

new_cookie() ->
    binary:encode_hex(crypto:strong_rand_bytes(8)).

jsgud(X) ->
    #{"ok"     => true,
      "result" => X}.

jsbad(X) ->
    #{"ok"    => false,
      "error" => X}.

http_err(Sock, N) ->
    Slogan = qhl:slogan(N),
    Body = ["<!doctype html>"
            "<html lang=\"en\">"
                "<head>"
                    "<meta charset=\"utf-8\">"
                    "<title>QHL: ", integer_to_list(N), " ", Slogan, "</title>"
                "</head>"
                "<body>"
                    "<h1>"
                        "QHL: ", integer_to_list(N), " ", Slogan,
                    "</h1>"
                "</body>"
            "</html>"],
    Resp = #response{code    = N,
                     headers = [{"content/type", "text/html"}],
                     body    = Body},
    respond(Sock, Resp).


respond(Sock, Response) ->
    gen_tcp:send(Sock, fmtresp(Response)).


fmtresp(#response{type    = page,   %% no idea what {data, String} is
                  version = http11,
                  code    = Code,
                  headers = Hs,
                  body    = Body}) ->
    %% need byte size for binary
    Headers = add_headers(Hs, Body),
    [io_lib:format("HTTP/1.1 ~tp ~ts", [Code, qhl:slogan(Code)]), "\r\n",
     [io_lib:format("~ts: ~ts\r\n", [K, V]) || {K, V} <- Headers],
     "\r\n",
     Body].


%% body needed just for size
add_headers(Hs, Body) ->
    Defaults = default_headers(Body),
    Hs2 = proplists:to_map(Hs),
    proplists:from_map(maps:merge(Defaults, Hs2)).


default_headers(Body) ->
    BodySize = byte_size(iolist_to_binary(Body)),
    #{"Server"         => "fewd 0.1.0",
      "Date"           => qhl:ridiculous_web_date(),
      "Content-Length" => io_lib:format("~p", [BodySize])}.