-module(livery_client_cookie).
-moduledoc """
Client layer: a cookie jar (RFC 6265, client side).
Before each request it picks the stored cookies that match the target
(host, path, secure) and merges them into one `Cookie` header, keeping any
`Cookie` the caller already set. After the response it parses every
`Set-Cookie` header and updates the jar: a new cookie replaces the one
under the same `(domain, path, name)` key, and an expired one (a past
`Expires`, or `Max-Age` <= 0) deletes it. Add it with
`livery_client:cookie_jar/0,1`.
The jar keeps no cookies of its own; it reads and writes them through a
`livery_client_cookie_store` (default `livery_client_cookie_store_ets`),
an in-memory per-jar store shared across the request processes that run
the client.
This is a subset: no public suffix list, no third-party-cookie policy,
no persistence. `SameSite` is parsed but not enforced.
""".
-export([jar/0, jar/1, call/3]).
-export_type([state/0]).
-define(DEFAULT_MAX_COOKIES, 3000).
%% Seconds between the gregorian epoch (year 0) and the Unix epoch (1970).
-define(UNIX_EPOCH, 62167219200).
-opaque state() :: #{
module := module(),
store := livery_client_cookie_store:store(),
max_cookies := pos_integer()
}.
%% A stored cookie. Opaque to the store; the layer owns this shape.
-type cookie() :: #{
name := binary(),
value := binary(),
domain := binary(),
path := binary(),
secure := boolean(),
http_only := boolean(),
same_site := binary() | undefined,
host_only := boolean(),
expires := non_neg_integer() | session,
created := integer()
}.
%%====================================================================
%% Constructor
%%====================================================================
-doc "Build a jar with the default ETS store and cookie cap.".
-spec jar() -> state().
jar() -> jar(#{}).
-doc """
Build a jar. `Opts`: `max_cookies` (total cap before the oldest are
evicted, default 3000), `store` (a `livery_client_cookie_store` callback
module, default `livery_client_cookie_store_ets`). Any other keys are
passed through to the store's `init/1`.
""".
-spec jar(map()) -> state().
jar(Opts) ->
Module = maps:get(store, Opts, livery_client_cookie_store_ets),
Store = Module:init(Opts),
#{
module => Module,
store => Store,
max_cookies => maps:get(max_cookies, Opts, ?DEFAULT_MAX_COOKIES)
}.
%%====================================================================
%% Layer
%%====================================================================
-spec call(livery_client:request(), livery_client:next(), state()) ->
{ok, livery_client:response()} | {error, term()}.
call(Req, Next, State) ->
case parse_url(livery_client:url(Req)) of
{ok, Scheme, Host, Path} ->
Req1 = attach_cookies(Req, State, Scheme, Host, Path),
Result = Next(Req1),
store_response(Result, State, Host, Path),
Result;
error ->
Next(Req)
end.
%%====================================================================
%% Outbound: select and merge cookies
%%====================================================================
attach_cookies(Req, #{module := Module, store := Store}, Scheme, Host, Path) ->
Now = erlang:system_time(second),
Live = drop_expired(Module:get(Store), Now, Module, Store),
Matching = [C || C <- Live, send_match(C, Scheme, Host, Path)],
Pairs = [<<N/binary, "=", V/binary>> || #{name := N, value := V} <- sort_cookies(Matching)],
merge_cookie_header(Req, Pairs).
merge_cookie_header(Req, []) ->
Req;
merge_cookie_header(Req, Pairs) ->
Jar = iolist_to_binary(lists:join(<<"; ">>, Pairs)),
case livery_client:header(<<"cookie">>, Req) of
undefined ->
livery_client:set_header(<<"cookie">>, Jar, Req);
Existing ->
livery_client:set_header(<<"cookie">>, <<Existing/binary, "; ", Jar/binary>>, Req)
end.
%% Longest path first; ties broken by earliest creation (RFC 6265 5.4).
sort_cookies(Cookies) ->
lists:sort(fun(A, B) -> order(A) =< order(B) end, Cookies).
order(#{path := P, created := C}) -> {-byte_size(P), C}.
send_match(#{secure := Secure} = Cookie, Scheme, Host, Path) ->
secure_ok(Secure, Scheme) andalso
domain_match(Host, Cookie) andalso
path_match(Path, maps:get(path, Cookie)).
secure_ok(false, _Scheme) -> true;
secure_ok(true, Scheme) -> Scheme =:= <<"https">>.
domain_match(Host, #{host_only := true, domain := Domain}) ->
Host =:= Domain;
domain_match(Host, #{host_only := false, domain := Domain}) ->
Host =:= Domain orelse suffix_match(Host, Domain).
%% Host ends with "." ++ Domain (a proper sub-domain), per RFC 6265 5.1.3.
suffix_match(Host, Domain) ->
DS = byte_size(Domain),
HS = byte_size(Host),
HS > DS andalso
binary:part(Host, HS - DS, DS) =:= Domain andalso
binary:at(Host, HS - DS - 1) =:= $..
path_match(Path, Path) ->
true;
path_match(ReqPath, CookiePath) ->
PS = byte_size(CookiePath),
case ReqPath of
<<CookiePath:PS/binary, $/, _/binary>> -> true;
<<CookiePath:PS/binary, _/binary>> -> binary:last(CookiePath) =:= $/;
_ -> false
end.
%%====================================================================
%% Inbound: parse Set-Cookie and update the jar
%%====================================================================
store_response({ok, Resp}, State, Host, Path) ->
Values = [V || {N, V} <- livery_client:headers(Resp), string:lowercase(N) =:= <<"set-cookie">>],
lists:foreach(fun(V) -> ingest(V, State, Host, Path) end, Values),
enforce_max(State);
store_response(_Other, _State, _Host, _Path) ->
ok.
ingest(Value, #{module := Module, store := Store}, Host, Path) ->
case parse_set_cookie(Value, Host, Path) of
ignore ->
ok;
Cookie ->
Key = key(Cookie),
case expired(Cookie, erlang:system_time(second)) of
true -> Module:delete(Store, Key);
false -> Module:put(Store, Key, Cookie)
end
end.
enforce_max(#{module := Module, store := Store, max_cookies := Max}) ->
All = Module:get(Store),
case length(All) - Max of
Excess when Excess =< 0 ->
ok;
Excess ->
Oldest = lists:sublist(lists:sort(fun by_created/2, All), Excess),
lists:foreach(fun(C) -> Module:delete(Store, key(C)) end, Oldest)
end.
by_created(#{created := A}, #{created := B}) -> A =< B.
key(#{domain := D, path := P, name := N}) -> {D, P, N}.
expired(#{expires := session}, _Now) -> false;
expired(#{expires := E}, Now) -> E =< Now.
drop_expired(Cookies, Now, Module, Store) ->
lists:filter(
fun(C) ->
case expired(C, Now) of
true ->
Module:delete(Store, key(C)),
false;
false ->
true
end
end,
Cookies
).
%%====================================================================
%% Set-Cookie parsing (RFC 6265 5.2)
%%====================================================================
-spec parse_set_cookie(binary(), binary(), binary()) -> cookie() | ignore.
parse_set_cookie(Bin, Host, ReqPath) ->
[NameValue | AttrParts] = binary:split(Bin, <<";">>, [global]),
case parse_nv(string:trim(NameValue)) of
ignore -> ignore;
{Name, Value} -> build_cookie(Name, Value, parse_attrs(AttrParts), Host, ReqPath)
end.
parse_nv(Seg) ->
case binary:split(Seg, <<"=">>) of
[Name0, Value0] ->
case string:trim(Name0) of
<<>> -> ignore;
Name -> {Name, string:trim(Value0)}
end;
_ ->
ignore
end.
%% Later attributes win: fold prepends, so the head is the last occurrence
%% and keyfind returns it first.
parse_attrs(Parts) ->
lists:foldl(
fun(Part, Acc) ->
case parse_attr(string:trim(Part)) of
skip -> Acc;
KV -> [KV | Acc]
end
end,
[],
Parts
).
parse_attr(<<>>) ->
skip;
parse_attr(Part) ->
case binary:split(Part, <<"=">>) of
[K, V] -> {string:lowercase(string:trim(K)), string:trim(V)};
[K] -> {string:lowercase(string:trim(K)), <<>>}
end.
build_cookie(Name, Value, Attrs, Host, ReqPath) ->
Now = erlang:system_time(second),
{Domain, HostOnly} = domain_attr(attr(<<"domain">>, Attrs), Host),
#{
name => Name,
value => Value,
domain => Domain,
path => path_attr(attr(<<"path">>, Attrs), ReqPath),
secure => has_attr(<<"secure">>, Attrs),
http_only => has_attr(<<"httponly">>, Attrs),
same_site => attr(<<"samesite">>, Attrs),
host_only => HostOnly,
expires => expiry(Attrs, Now),
created => Now
}.
attr(Key, Attrs) ->
case lists:keyfind(Key, 1, Attrs) of
{Key, V} -> V;
false -> undefined
end.
has_attr(Key, Attrs) -> lists:keymember(Key, 1, Attrs).
%% No Domain => host-only, scoped to the exact request host. With a Domain,
%% strip a leading dot; an IP host ignores any Domain that is not itself.
domain_attr(undefined, Host) ->
{Host, true};
domain_attr(<<>>, Host) ->
{Host, true};
domain_attr(Domain0, Host) ->
Domain = string:lowercase(strip_dot(Domain0)),
case is_ip(Host) andalso Domain =/= Host of
true -> {Host, true};
false -> {Domain, false}
end.
strip_dot(<<".", Rest/binary>>) -> Rest;
strip_dot(Domain) -> Domain.
is_ip(Host) ->
case inet:parse_address(binary_to_list(Host)) of
{ok, _} -> true;
{error, _} -> false
end.
path_attr(undefined, ReqPath) -> default_path(ReqPath);
path_attr(<<"/", _/binary>> = Path, _ReqPath) -> Path;
path_attr(_Other, ReqPath) -> default_path(ReqPath).
%% RFC 6265 5.1.4: the request path up to but not including the rightmost
%% slash, or "/" when there is only the leading slash.
default_path(<<"/", _/binary>> = Path) ->
case binary:matches(Path, <<"/">>) of
[_] ->
<<"/">>;
Matches ->
case lists:last(Matches) of
{0, _} -> <<"/">>;
{Pos, _} -> binary:part(Path, 0, Pos)
end
end;
default_path(_Other) ->
<<"/">>.
%% Max-Age wins over Expires (RFC 6265 5.3). Max-Age <= 0 expires now
%% (sentinel 0, always <= the current time).
expiry(Attrs, Now) ->
case max_age(attr(<<"max-age">>, Attrs)) of
{ok, Secs} when Secs =< 0 -> 0;
{ok, Secs} -> Now + Secs;
none -> expires(attr(<<"expires">>, Attrs))
end.
max_age(undefined) ->
none;
max_age(Bin) ->
try
{ok, binary_to_integer(string:trim(Bin))}
catch
error:badarg -> none
end.
expires(undefined) ->
session;
expires(DateBin) ->
case parse_http_date(DateBin) of
{ok, Secs} -> Secs;
error -> session
end.
%%====================================================================
%% HTTP-date parsing (RFC 6265 5.1.1: IMF-fixdate, RFC 850, asctime)
%%====================================================================
-spec parse_http_date(binary()) -> {ok, non_neg_integer()} | error.
parse_http_date(Bin) ->
finalize_date(lists:foldl(fun classify_token/2, #{}, date_tokens(Bin))).
%% Split on the cookie-date delimiter set; ":" is kept so the time stays
%% one token.
date_tokens(Bin) -> date_tokens(Bin, [], []).
date_tokens(<<>>, [], Acc) ->
lists:reverse(Acc);
date_tokens(<<>>, Cur, Acc) ->
lists:reverse([lists:reverse(Cur) | Acc]);
date_tokens(<<C, Rest/binary>>, Cur, Acc) ->
case is_delim(C) of
true when Cur =:= [] -> date_tokens(Rest, [], Acc);
true -> date_tokens(Rest, [], [lists:reverse(Cur) | Acc]);
false -> date_tokens(Rest, [C | Cur], Acc)
end.
is_delim(C) ->
C =:= 16#09 orelse
(C >= 16#20 andalso C =< 16#2F) orelse
(C >= 16#3B andalso C =< 16#40) orelse
(C >= 16#5B andalso C =< 16#60) orelse
(C >= 16#7B andalso C =< 16#7E).
classify_token(Tok, Fields) ->
case parse_time(Tok) of
{ok, H, Mi, S} when not is_map_key(time, Fields) ->
Fields#{time => true, h => H, mi => Mi, s => S};
_ ->
classify_dmy(Tok, Fields)
end.
classify_dmy(Tok, Fields) ->
case day(Tok) of
{ok, D} when not is_map_key(day, Fields) -> Fields#{day => D};
_ -> classify_my(Tok, Fields)
end.
classify_my(Tok, Fields) ->
case month(Tok) of
{ok, M} when not is_map_key(month, Fields) -> Fields#{month => M};
_ -> classify_year(Tok, Fields)
end.
classify_year(Tok, Fields) ->
case year(Tok) of
{ok, Y} when not is_map_key(year, Fields) -> Fields#{year => Y};
_ -> Fields
end.
parse_time(Tok) ->
case string:lexemes(Tok, ":") of
[H, Mi, S] ->
case {num(H), num(Mi), num(S)} of
{{ok, Hn}, {ok, Min}, {ok, Sn}} when Hn =< 23, Min =< 59, Sn =< 60 ->
{ok, Hn, Min, Sn};
_ ->
error
end;
_ ->
error
end.
day(Tok) when length(Tok) =< 2 ->
case num(Tok) of
{ok, D} when D >= 1, D =< 31 -> {ok, D};
_ -> error
end;
day(_Tok) ->
error.
year(Tok) when length(Tok) =< 4 ->
case num(Tok) of
{ok, Y} -> {ok, fix_year(Y)};
error -> error
end;
year(_Tok) ->
error.
fix_year(Y) when Y >= 70, Y =< 99 -> Y + 1900;
fix_year(Y) when Y >= 0, Y =< 69 -> Y + 2000;
fix_year(Y) -> Y.
month(Tok) when length(Tok) >= 3 ->
month_num(string:lowercase(string:slice(Tok, 0, 3)));
month(_Tok) ->
error.
month_num("jan") -> {ok, 1};
month_num("feb") -> {ok, 2};
month_num("mar") -> {ok, 3};
month_num("apr") -> {ok, 4};
month_num("may") -> {ok, 5};
month_num("jun") -> {ok, 6};
month_num("jul") -> {ok, 7};
month_num("aug") -> {ok, 8};
month_num("sep") -> {ok, 9};
month_num("oct") -> {ok, 10};
month_num("nov") -> {ok, 11};
month_num("dec") -> {ok, 12};
month_num(_Other) -> error.
num([]) ->
error;
num(Str) ->
case lists:all(fun(C) -> C >= $0 andalso C =< $9 end, Str) of
true -> {ok, list_to_integer(Str)};
false -> error
end.
finalize_date(#{day := D, month := Mo, year := Y, h := H, mi := Mi, s := S}) ->
case calendar:valid_date(Y, Mo, D) of
true ->
Greg = calendar:datetime_to_gregorian_seconds({{Y, Mo, D}, {H, Mi, S}}),
{ok, Greg - ?UNIX_EPOCH};
false ->
error
end;
finalize_date(_Incomplete) ->
error.
%%====================================================================
%% URL parsing
%%====================================================================
parse_url(Url) ->
case uri_string:parse(Url) of
#{host := Host} = Map ->
{ok, scheme(Map), string:lowercase(Host), path(Map)};
_ ->
error
end.
scheme(#{scheme := S}) -> string:lowercase(S);
scheme(_Map) -> <<>>.
path(#{path := <<>>}) -> <<"/">>;
path(#{path := P}) -> P;
path(_Map) -> <<"/">>.