-module(albedo_oauth).
%% Browser OAuth sign-ins run by the daemon for its clients. One owner process
%% tracks the flows; each flow owns its loopback callback listener and ends by
%% storing the credential in creds.json's accounts under the provider's key.

-export([start/2, status/1, input/2, cancel/1, accounts/2, select/3, remove/3,
         parse_input/1]).

-define(OWNER, albedo_oauth).
-define(FLOW_TIMEOUT_MS, 300000).
-define(FORGET_MS, 600000).
-define(CALL_MS, 5000).

%% Login is the Gleam oauth.Login record:
%% {login, Provider, Label, Detail, Protocol, Store, {callback, Host, Port, Path, Fixed}, Authorize, Exchange, Account}
start(Home, Login) -> call({start, Home, Login}).

status(Id) -> call({status, Id}).

input(Id, Text) -> call({input, Id, Text}).

cancel(Id) -> call({cancel, Id}).

call(Message) ->
    Owner = owner(),
    Ref = erlang:monitor(process, Owner),
    Owner ! {self(), Ref, Message},
    receive
        {Ref, Reply} -> erlang:demonitor(Ref, [flush]), Reply;
        {'DOWN', Ref, process, _, _} -> {error, <<"sign-in service stopped">>}
    after ?CALL_MS ->
        erlang:demonitor(Ref, [flush]),
        {error, <<"sign-in service is busy">>}
    end.

owner() ->
    case whereis(?OWNER) of
        undefined ->
            Pid = spawn(fun() -> owner_loop(#{}) end),
            case catch register(?OWNER, Pid) of
                true -> Pid;
                _ -> exit(Pid, kill), whereis(?OWNER)
            end;
        Pid -> Pid
    end.

%% ---- owner --------------------------------------------------------------

owner_loop(Flows) ->
    receive
        {From, Ref, {start, Home, Login}} ->
            Id = token(12),
            Owner = self(),
            Pid = spawn(fun() -> flow(Owner, Id, Home, Login) end),
            erlang:monitor(process, Pid),
            receive
                {Id, ready, Url} ->
                    From ! {Ref, {ok, {Id, Url}}},
                    owner_loop(Flows#{Id => #{pid => Pid, status => {waiting, <<"waiting for browser authorization">>}}});
                {Id, failed, Reason} ->
                    From ! {Ref, {error, Reason}},
                    owner_loop(Flows)
            after ?CALL_MS ->
                exit(Pid, kill),
                From ! {Ref, {error, <<"sign-in did not start">>}},
                owner_loop(Flows)
            end;
        {From, Ref, {status, Id}} ->
            From ! {Ref, case Flows of
                #{Id := #{status := Status}} -> {ok, Status};
                _ -> {error, <<"unknown sign-in">>}
            end},
            owner_loop(Flows);
        {From, Ref, {input, Id, Text}} ->
            From ! {Ref, case Flows of
                #{Id := #{pid := Pid}} -> Pid ! {input, Text}, {ok, nil};
                _ -> {error, <<"unknown sign-in">>}
            end},
            owner_loop(Flows);
        {From, Ref, {cancel, Id}} ->
            case Flows of
                #{Id := #{pid := Pid}} -> exit(Pid, kill);
                _ -> ok
            end,
            From ! {Ref, {ok, nil}},
            owner_loop(maps:remove(Id, Flows));
        {Id, update, Status} ->
            owner_loop(update(Flows, Id, Status));
        {forget, Id} ->
            owner_loop(maps:remove(Id, Flows));
        {'DOWN', _, process, Pid, Reason} ->
            %% A flow that died without settling failed.
            owner_loop(maps:map(fun
                (_, #{pid := P, status := {S, _}} = F) when P =:= Pid, S =/= done, S =/= failed ->
                    F#{status => {failed, iolist_to_binary(io_lib:format("sign-in stopped: ~p", [Reason]))}};
                (_, F) -> F
            end, Flows));
        _ -> owner_loop(Flows)
    end.

update(Flows, Id, {State, _} = Status) ->
    case Flows of
        #{Id := Flow} ->
            (State =:= done orelse State =:= failed) andalso
                erlang:send_after(?FORGET_MS, self(), {forget, Id}),
            Flows#{Id := Flow#{status => Status}};
        _ -> Flows
    end.

%% ---- one flow -----------------------------------------------------------

flow(Owner, Id, Home, {login, Provider, _, _, _, Store, {callback, Host, Port, Path, Fixed}, Authorize, Exchange, Account}) ->
    case listen(Port, Fixed) of
        {error, Reason} ->
            Owner ! {Id, failed, iolist_to_binary(io_lib:format(
                "could not listen for the ~s sign-in callback on 127.0.0.1:~B (~p)", [Provider, Port, Reason]))};
        {ok, Socket, Bound} ->
            State = token(16),
            Verifier = base64url(crypto:strong_rand_bytes(64)),
            Challenge = base64url(crypto:hash(sha256, Verifier)),
            Redirect = iolist_to_binary(["http://", Host, ":", integer_to_binary(Bound), Path]),
            Grant = {grant, Redirect, State, Verifier, Challenge},
            Self = self(),
            spawn_link(fun() -> accept(Socket, Path, Self) end),
            Owner ! {Id, ready, Authorize(Grant)},
            erlang:send_after(?FLOW_TIMEOUT_MS, self(), timeout),
            Settle = fun(Status) -> Owner ! {Id, update, Status} end,
            Outcome = wait(State),
            gen_tcp:close(Socket),
            case Outcome of
                {ok, Code} ->
                    Settle({exchanging, <<"exchanging authorization code">>}),
                    Progress = fun(Text) -> Settle({exchanging, Text}), nil end,
                    try Exchange(Grant, Code, Progress) of
                        {ok, Credential} ->
                            case store(Home, Store, Credential, Account) of
                                {ok, Label} -> Settle({done, Label});
                                {error, Reason} -> Settle({failed, Reason})
                            end;
                        {error, Reason} -> Settle({failed, Reason})
                    catch Class:Reason ->
                        Settle({failed, iolist_to_binary(io_lib:format("sign-in failed: ~p:~p", [Class, Reason]))})
                    end;
                {error, Reason} -> Settle({failed, Reason})
            end
    end.

listen(Port, Fixed) ->
    Options = [binary, {active, false}, {ip, {127, 0, 0, 1}}, {reuseaddr, true}, {packet, http_bin}],
    Result = case gen_tcp:listen(Port, Options) of
        {error, eaddrinuse} when not Fixed -> gen_tcp:listen(0, Options);
        Other -> Other
    end,
    case Result of
        {ok, Socket} -> {ok, Socket, bound(Socket)};
        Error -> Error
    end.

bound(Socket) -> {ok, {_, Port}} = inet:sockname(Socket), Port.

%% The browser callback and a pasted code race; the first valid one wins.
wait(State) ->
    receive
        {callback, #{<<"error">> := Error} = Query} ->
            case maps:get(<<"state">>, Query, State) of
                State ->
                    {error, <<"authorization failed: ",
                              (maps:get(<<"error_description">>, Query, Error))/binary>>};
                _ -> wait(State)
            end;
        {callback, #{<<"code">> := <<_, _/binary>> = Code, <<"state">> := State}} -> {ok, Code};
        {callback, _} -> wait(State);
        {input, Text} ->
            case parse_input(Text) of
                {<<>>, _} -> {error, <<"missing authorization code">>};
                {Code, <<>>} -> {ok, Code};
                {Code, State} -> {ok, Code};
                {_, _} -> {error, <<"oauth state mismatch">>}
            end;
        timeout -> {error, <<"sign-in timed out waiting for the browser">>}
    end.

accept(Listen, Path, Flow) ->
    case gen_tcp:accept(Listen) of
        {ok, Socket} ->
            _ = serve(Socket, Path, Flow),
            gen_tcp:close(Socket),
            accept(Listen, Path, Flow);
        {error, _} -> ok
    end.

serve(Socket, Path, Flow) ->
    case gen_tcp:recv(Socket, 0, 10000) of
        {ok, {http_request, 'GET', {abs_path, Target}, _}} ->
            drain_headers(Socket),
            {RequestPath, Query} = split_target(Target),
            case RequestPath =:= iolist_to_binary(Path) of
                true ->
                    Flow ! {callback, Query},
                    page(Socket, 200, case Query of
                        #{<<"code">> := _} -> <<"Authentication completed. You can close this window and return to albedo.">>;
                        _ -> <<"Authentication failed. Return to albedo for details.">>
                    end);
                false -> page(Socket, 404, <<"Not found.">>)
            end;
        _ -> page(Socket, 400, <<"Bad request.">>)
    end.

drain_headers(Socket) ->
    case gen_tcp:recv(Socket, 0, 10000) of
        {ok, http_eoh} -> ok;
        {ok, _} -> drain_headers(Socket);
        _ -> ok
    end.

split_target(Target) ->
    case binary:split(Target, <<"?">>) of
        [P, Q] -> {P, maps:from_list(uri_string:dissect_query(Q))};
        [P] -> {P, #{}}
    end.

page(Socket, Status, Text) ->
    Body = <<"<!doctype html><meta charset=utf-8><title>albedo</title><p>", Text/binary, "</p>">>,
    gen_tcp:send(Socket, [<<"HTTP/1.1 ">>, integer_to_binary(Status), <<" OK\r\ncontent-type: text/html; charset=utf-8\r\ncontent-length: ">>,
                          integer_to_binary(byte_size(Body)), <<"\r\nconnection: close\r\n\r\n">>, Body]).

%% A pasted redirect url, `code#state`, a query string, or a bare code.
parse_input(Text0) ->
    Text = string:trim(unicode:characters_to_binary(Text0)),
    case uri_string:parse(Text) of
        #{scheme := _, host := _, query := Q} -> query_pair(Q);
        _ ->
            case binary:split(Text, <<"#">>) of
                [Code, State] -> {Code, State};
                [_] ->
                    case binary:match(Text, <<"code=">>) of
                        nomatch -> {Text, <<>>};
                        _ -> query_pair(string:trim(Text, leading, "?#"))
                    end
            end
    end.

query_pair(Q) ->
    Query = maps:from_list(uri_string:dissect_query(Q)),
    {maps:get(<<"code">>, Query, <<>>), maps:get(<<"state">>, Query, <<>>)}.

%% ---- creds.json accounts ------------------------------------------------

id(Account, Credential) -> element(2, Account(Credential)).

%% A sign-in replaces the stored account with the same identity.
store(Home, Store, Json, Account) ->
    Credential = json:decode(iolist_to_binary(Json)),
    Id = id(Account, Credential),
    update(Home, Store, fun(Values) ->
        case lists:any(fun(V) -> id(Account, V) =:= Id end, Values) of
            true -> [case id(Account, V) =:= Id of true -> Credential; false -> V end || V <- Values];
            false -> Values ++ [Credential]
        end
    end, fun(_) -> {ok, element(3, Account(Credential))} end).

update(Home, Store, Change, Reply) ->
    Path = albedo_credentials:creds_path(Home),
    albedo_settings_lock:with_lock(filename:dirname(Path), fun() ->
        case albedo_credentials:accounts(Path) of
            {error, enoent} -> update_data(Path, #{}, Store, Change, Reply);
            {ok, Current} -> update_data(Path, Current, Store, Change, Reply);
            {error, _} -> {error, <<"creds.json is unreadable; repair it before signing in">>}
        end
    end, fun() -> {error, <<"credential store is busy">>} end).

update_data(Path, Current, Store, Change, Reply) ->
    Values = Change(albedo_credentials:values(Current, Store)),
    case albedo_credentials:put_accounts(Path, albedo_credentials:put_values(Current, Store, Values)) of
        ok -> Reply(Values);
        {error, _} -> {error, <<"could not write creds.json">>}
    end.

accounts(Home, {login, _, _, _, _, Store, _, _, _, Account}) ->
    case albedo_credentials:accounts(albedo_credentials:creds_path(Home)) of
        {ok, Data} -> [Account(V) || V <- albedo_credentials:values(Data, Store)];
        _ -> []
    end.

select(Home, {login, _, _, _, _, Store, _, _, _, Account}, Id) ->
    update(Home, Store, fun(Values) ->
        [V#{<<"selected">> => id(Account, V) =:= Id} || V <- Values]
    end, fun(_) -> {ok, nil} end).

remove(Home, {login, _, _, _, _, Store, _, _, _, Account}, Id) ->
    update(Home, Store, fun(Values) -> [V || V <- Values, id(Account, V) =/= Id] end,
           fun(_) -> {ok, nil} end).

%% ---- helpers ------------------------------------------------------------

token(Bytes) -> binary:encode_hex(crypto:strong_rand_bytes(Bytes), lowercase).

base64url(Bytes) -> base64:encode(Bytes, #{mode => urlsafe, padding => false}).