Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
86 lines
2.9 KiB
Erlang
86 lines
2.9 KiB
Erlang
-module(envelope).
|
|
-export([validate_shape/1, get_field/2, canonical_bytes/1]).
|
|
|
|
%% Activity envelope per design §3.1.
|
|
%%
|
|
%% Erlang maps (#{...}) are not supported by this port, so envelopes
|
|
%% are represented as property lists of {atom_key, value} pairs. This
|
|
%% port's binary syntax also can't carry string literals; values that
|
|
%% would naturally be binaries in real Erlang are kept as atoms or
|
|
%% integer-segment binaries in the test corpus.
|
|
%%
|
|
%% Required fields: id, type, actor, published, signature.
|
|
%% The signature value is itself a property list with key_id,
|
|
%% algorithm, value.
|
|
%%
|
|
%% validate_shape/1 returns ok | {error, Reason}. Reasons:
|
|
%% not_a_proplist
|
|
%% {missing_field, FieldName}
|
|
%% {bad_signature, BadSigReason}
|
|
%%
|
|
%% get_field/2 returns {ok, Value} | not_found.
|
|
|
|
validate_shape(Env) when is_list(Env) ->
|
|
case check_required([id, type, actor, published, signature], Env) of
|
|
ok -> validate_signature_shape(Env);
|
|
Err -> Err
|
|
end;
|
|
validate_shape(_) ->
|
|
{error, not_a_proplist}.
|
|
|
|
get_field(_, []) -> not_found;
|
|
get_field(K, [{K, V} | _]) -> {ok, V};
|
|
get_field(K, [_ | Rest]) -> get_field(K, Rest).
|
|
|
|
check_required([], _) -> ok;
|
|
check_required([F | Rest], Env) ->
|
|
case get_field(F, Env) of
|
|
{ok, _} -> check_required(Rest, Env);
|
|
not_found -> {error, {missing_field, F}}
|
|
end.
|
|
|
|
validate_signature_shape(Env) ->
|
|
{ok, Sig} = get_field(signature, Env),
|
|
case is_list(Sig) of
|
|
true ->
|
|
case check_required([key_id, algorithm, value], Sig) of
|
|
ok -> ok;
|
|
{error, {missing_field, F}} ->
|
|
{error, {bad_signature, {missing_field, F}}}
|
|
end;
|
|
false ->
|
|
{error, {bad_signature, not_a_proplist}}
|
|
end.
|
|
|
|
%% canonical_bytes/1 — the byte string the signature covers.
|
|
%%
|
|
%% Real fed-sx will use dag-cbor over a JSON-LD-canonicalised form
|
|
%% (design §3.2). For milestone 1 we stand in for that with the host
|
|
%% BIF `cid:to_string/1`, which produces a CIDv1 over the deterministic
|
|
%% textual form of the term. Two prior steps make this work:
|
|
%% 1. The signature pair is stripped (sig covers everything except
|
|
%% itself).
|
|
%% 2. The top-level property list is sorted by key so field order in
|
|
%% the source envelope is not load-bearing.
|
|
%%
|
|
%% The result is an Erlang binary suitable as the sig-cover input.
|
|
|
|
canonical_bytes(Env) when is_list(Env) ->
|
|
Stripped = strip_signature(Env),
|
|
Sorted = sort_pairs(Stripped),
|
|
cid:to_string(Sorted).
|
|
|
|
strip_signature([]) -> [];
|
|
strip_signature([{signature, _} | Rest]) -> strip_signature(Rest);
|
|
strip_signature([P | Rest]) -> [P | strip_signature(Rest)].
|
|
|
|
sort_pairs([]) -> [];
|
|
sort_pairs([H | T]) -> insert_pair(H, sort_pairs(T)).
|
|
|
|
insert_pair(P, []) -> [P];
|
|
insert_pair({K1, V1}, [{K2, V2} | Rest]) ->
|
|
case K1 < K2 of
|
|
true -> [{K1, V1}, {K2, V2} | Rest];
|
|
false -> [{K2, V2} | insert_pair({K1, V1}, Rest)]
|
|
end.
|