QPQ-AG/hakuzaru
11
0
Fork 0
Code Issues 3 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Compare commits

merge into: QPQ-AG/hakuzaru:spivee/fixes
Branches Tags
QPQ-AG/hakuzaru:master QPQ-AG/hakuzaru:spivee/fixes QPQ-AG/hakuzaru:shared_secrets QPQ-AG/hakuzaru:grids3
QPQ-AG/hakuzaru:v0.9.1
..
pull from: QPQ-AG/hakuzaru:shared_secrets
Branches Tags
QPQ-AG/hakuzaru:spivee/fixes QPQ-AG/hakuzaru:shared_secrets QPQ-AG/hakuzaru:master QPQ-AG/hakuzaru:grids3
QPQ-AG/hakuzaru:v0.9.1

2 Commits
spivee/fixes .. shared_secrets

Author SHA1 Message Date
zxq9 bb7b4c3629 Replace case with a simpler assertion 2026-05-30 15:33:43 +09:00
zxq9 11a9b36681 Add shared secret functions to hz_key_master 2026-05-30 11:53:36 +09:00
3 changed files with 453 additions and 337 deletions
Expand all files Collapse all files
src/hz_aaci.erl
+180 -135
View File
@@ -527,7 +527,10 @@ opaque_type(Params, #{record := FieldDefs}) ->
|| #{name := Name, type := Type} <- FieldDefs],
{record, Fields};
opaque_type(Params, #{variant := VariantDefs}) ->
ConvertVariant = fun(Pair) -> opaque_variant_each(Params, Pair) end,
ConvertVariant = fun(Pair) ->
[{Name, Types}] = maps:to_list(Pair),
{binary_to_list(Name), [opaque_type(Params, Type) || Type <- Types]}
end,
Variants = lists:map(ConvertVariant, VariantDefs),
{variant, Variants};
opaque_type(Params, #{tuple := TypeDefs}) ->
@@ -538,11 +541,6 @@ opaque_type(Params, Pair) when is_map(Pair) ->
[{Name, TypeArgs}] = maps:to_list(Pair),
{opaque_type_name(Name), [opaque_type(Params, Arg) || Arg <- TypeArgs]}.
opaque_variant_each(Params, Pair) ->
[{Name, Types}] = maps:to_list(Pair),
ElemTypes = [opaque_type(Params, Type) || Type <- Types],
{binary_to_list(Name), ElemTypes}.
-spec opaque_type_name(binary()) -> atom() | string().
% Atoms for any builtins that aren't qualified by a namespace in Sophia.
@@ -850,7 +848,7 @@ erlang_args_to_fate(VarTypes, Terms) ->
DefLength = length(VarTypes),
ArgLength = length(Terms),
if
DefLength =:= ArgLength -> coerce_zipped_bindings(lists:zip(VarTypes, Terms), arg);
DefLength =:= ArgLength -> coerce_zipped_bindings(lists:zip(VarTypes, Terms), to_fate, arg);
DefLength > ArgLength -> {error, too_few_args};
DefLength < ArgLength -> {error, too_many_args}
end.
@@ -928,10 +926,7 @@ erlang_to_fate({O, N, char}, Str) ->
single_error({invalid, O, N, Str})
end;
erlang_to_fate({O, N, {bytes, [Count]}}, Bytes) when is_bitstring(Bytes) ->
case check_bytes(O, N, Count, Bytes) of
ok -> {ok, {bytes, Bytes}};
{error, Reason} -> {error, Reason}
end;
coerce_bytes(O, N, Count, Bytes);
erlang_to_fate({_, _, bits}, Num) when is_integer(Num) ->
{ok, {bits, Num}};
erlang_to_fate({_, _, bits}, Bits) when is_bitstring(Bits) ->
@@ -939,19 +934,19 @@ erlang_to_fate({_, _, bits}, Bits) when is_bitstring(Bits) ->
<<IntValue:Size>> = Bits,
{ok, {bits, IntValue}};
erlang_to_fate({_, _, {list, [Type]}}, Data) when is_list(Data) ->
coerce_list(Type, Data);
coerce_list(Type, Data, to_fate);
erlang_to_fate({_, _, {map, [KeyType, ValType]}}, Data) when is_map(Data) ->
coerce_map(KeyType, ValType, Data);
coerce_map(KeyType, ValType, Data, to_fate);
erlang_to_fate({O, N, {tuple, ElementTypes}}, Data) when is_tuple(Data) ->
ElementList = tuple_to_list(Data),
coerce_tuple(O, N, ElementTypes, ElementList);
coerce_tuple(O, N, ElementTypes, ElementList, to_fate);
erlang_to_fate({O, N, {variant, Variants}}, Name) when is_list(Name) ->
erlang_to_fate({O, N, {variant, Variants}}, {Name});
erlang_to_fate({O, N, {variant, Variants}}, Data) when is_tuple(Data), tuple_size(Data) > 0 ->
[Name | Terms] = tuple_to_list(Data),
case lookup_variant(Name, Variants) of
{Tag, TermTypes} ->
coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms);
coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms, to_fate);
not_found ->
ValidNames = [Valid || {Valid, _} <- Variants],
single_error({invalid_variant, O, N, Name, ValidNames})
@@ -959,15 +954,17 @@ erlang_to_fate({O, N, {variant, Variants}}, Data) when is_tuple(Data), tuple_siz
erlang_to_fate({O, N, {record, MemberTypes}}, Map) when is_map(Map) ->
coerce_map_to_record(O, N, MemberTypes, Map);
erlang_to_fate({O, N, {unknown_type, _}}, Data) ->
warn_unknown_type(O, N, Data),
case N of
already_normalized ->
Message = "Warning: Unknown type ~p. Using term ~p as is.~n",
io:format(Message, [O, Data]);
_ ->
Message = "Warning: Unknown type ~p (i.e. ~p). Using term ~p as is.~n",
io:format(Message, [O, N, Data])
end,
{ok, Data};
erlang_to_fate({O, N, _}, Data) -> single_error({invalid, O, N, Data}).
warn_unknown_type(O, already_normalized, Data) ->
io:format("Warning: Unknown type ~p. Using term ~p as is.~n", [O, Data]);
warn_unknown_type(O, N, Data) ->
io:format("Warning: Unknown type ~p (i.e. ~p). Using term ~p as is.~n", [O, N, Data]).
coerce_chain_object(_, _, _, _, {raw, Binary}) ->
{ok, Binary};
coerce_chain_object(O, N, T, Tag, S) ->
@@ -991,78 +988,78 @@ decode_chain_object(Tag, S) ->
error:incorrect_size -> {error, incorrect_size}
end.
check_bytes(O, N, _, Bytes) when bit_size(Bytes) rem 8 /= 0 ->
coerce_bytes(O, N, _, Bytes) when bit_size(Bytes) rem 8 /= 0 ->
single_error({partial_bytes, O, N, bit_size(Bytes)});
check_bytes(_, _, any, _) ->
ok;
check_bytes(O, N, Count, Bytes) when byte_size(Bytes) /= Count ->
coerce_bytes(_, _, any, Bytes) ->
{ok, Bytes};
coerce_bytes(O, N, Count, Bytes) when byte_size(Bytes) /= Count ->
single_error({incorrect_size, O, N, Bytes});
check_bytes(_, _, _, _) ->
ok.
coerce_bytes(_, _, _, Bytes) ->
{ok, Bytes}.
coerce_zipped_bindings(Bindings, Tag) ->
coerce_zipped_bindings(Bindings, Tag, [], []).
coerce_zipped_bindings(Bindings, Direction, Tag) ->
coerce_zipped_bindings(Bindings, Direction, Tag, [], []).
coerce_zipped_bindings([Next | Rest], Tag, Good, Broken) ->
coerce_zipped_bindings([Next | Rest], Direction, Tag, Good, Broken) ->
{{ArgName, Type}, Term} = Next,
case erlang_to_fate(Type, Term) of
case coerce_direction(Type, Term, Direction) of
{ok, NewTerm} ->
coerce_zipped_bindings(Rest, Tag, [NewTerm | Good], Broken);
coerce_zipped_bindings(Rest, Direction, Tag, [NewTerm | Good], Broken);
{error, Errors} ->
Wrapped = wrap_errors({Tag, ArgName}, Errors),
coerce_zipped_bindings(Rest, Tag, Good, [Wrapped | Broken])
coerce_zipped_bindings(Rest, Direction, Tag, Good, [Wrapped | Broken])
end;
coerce_zipped_bindings([], _, Good, []) ->
coerce_zipped_bindings([], _, _, Good, []) ->
{ok, lists:reverse(Good)};
coerce_zipped_bindings([], _, _, Broken) ->
coerce_zipped_bindings([], _, _, _, Broken) ->
{error, combine_errors(Broken)}.
coerce_list(Type, Elements) ->
coerce_list(Type, Elements, Direction) ->
% 0 index since it represents a sophia list
coerce_list(Type, Elements, 0, [], []).
coerce_list(Type, Elements, Direction, 0, [], []).
coerce_list(Type, [Next | Rest], Index, Good, Broken) ->
case erlang_to_fate(Type, Next) of
{ok, Coerced} -> coerce_list(Type, Rest, Index + 1, [Coerced | Good], Broken);
coerce_list(Type, [Next | Rest], Direction, Index, Good, Broken) ->
case coerce_direction(Type, Next, Direction) of
{ok, Coerced} -> coerce_list(Type, Rest, Direction, Index + 1, [Coerced | Good], Broken);
{error, Errors} ->
Wrapped = wrap_errors({index, Index}, Errors),
coerce_list(Type, Rest, Index + 1, Good, [Wrapped | Broken])
coerce_list(Type, Rest, Direction, Index + 1, Good, [Wrapped | Broken])
end;
coerce_list(_Type, [], _, Good, []) ->
coerce_list(_Type, [], _, _, Good, []) ->
{ok, lists:reverse(Good)};
coerce_list(_, [], _, _, Broken) ->
coerce_list(_, [], _, _, _, Broken) ->
{error, combine_errors(Broken)}.
coerce_map(KeyType, ValType, Data) ->
coerce_map(KeyType, ValType, maps:iterator(Data), #{}, []).
coerce_map(KeyType, ValType, Data, Direction) ->
coerce_map(KeyType, ValType, maps:iterator(Data), Direction, #{}, []).
coerce_map(KeyType, ValType, Remaining, Good, Broken) ->
coerce_map(KeyType, ValType, Remaining, Direction, Good, Broken) ->
case maps:next(Remaining) of
{K, V, RemainingAfter} ->
coerce_map2(KeyType, ValType, RemainingAfter, Good, Broken, K, V);
coerce_map2(KeyType, ValType, RemainingAfter, Direction, Good, Broken, K, V);
none ->
coerce_map_finish(Good, Broken)
end.
coerce_map2(KeyType, ValType, Remaining, Good, Broken, K, V) ->
case erlang_to_fate(KeyType, K) of
coerce_map2(KeyType, ValType, Remaining, Direction, Good, Broken, K, V) ->
case coerce_direction(KeyType, K, Direction) of
{ok, KFATE} ->
coerce_map3(KeyType, ValType, Remaining, Good, Broken, K, V, KFATE);
coerce_map3(KeyType, ValType, Remaining, Direction, Good, Broken, K, V, KFATE);
{error, Errors} ->
Wrapped = wrap_errors(map_key, Errors),
% Continue as if the key coerced successfully, so that we can give
% errors for both the key and the value.
coerce_map3(KeyType, ValType, Remaining, Good, [Wrapped | Broken], K, V, error)
coerce_map3(KeyType, ValType, Remaining, Direction, Good, [Wrapped | Broken], K, V, error)
end.
coerce_map3(KeyType, ValType, Remaining, Good, Broken, K, V, KFATE) ->
case erlang_to_fate(ValType, V) of
coerce_map3(KeyType, ValType, Remaining, Direction, Good, Broken, K, V, KFATE) ->
case coerce_direction(ValType, V, Direction) of
{ok, VFATE} ->
NewGood = Good#{KFATE => VFATE},
coerce_map(KeyType, ValType, Remaining, NewGood, Broken);
coerce_map(KeyType, ValType, Remaining, Direction, NewGood, Broken);
{error, Errors} ->
Wrapped = wrap_errors({map_value, K}, Errors),
coerce_map(KeyType, ValType, Remaining, Good, [Wrapped | Broken])
coerce_map(KeyType, ValType, Remaining, Direction, Good, [Wrapped | Broken])
end.
coerce_map_finish(Good, []) ->
@@ -1079,10 +1076,13 @@ lookup_variant(Name, [_ | Rest], Tag) ->
lookup_variant(_Name, [], _Tag) ->
not_found.
coerce_tuple(O, N, TermTypes, Terms) ->
case coerce_elems_to_fate(TermTypes, Terms, tuple_element) of
coerce_tuple(O, N, TermTypes, Terms, Direction) ->
case coerce_tuple_elements(TermTypes, Terms, Direction, tuple_element) of
{ok, Converted} ->
{ok, {tuple, list_to_tuple(Converted)}};
case Direction of
to_fate -> {ok, {tuple, list_to_tuple(Converted)}};
from_fate -> {ok, list_to_tuple(Converted)}
end;
{error, too_few_terms} ->
single_error({tuple_too_few_terms, O, N, list_to_tuple(Terms)});
{error, too_many_terms} ->
@@ -1090,14 +1090,19 @@ coerce_tuple(O, N, TermTypes, Terms) ->
Errors -> Errors
end.
coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms) ->
coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms, Direction) ->
% FIXME: we could go through and add the variant tag to the adt_element
% paths?
case coerce_elems_to_fate(TermTypes, Terms, adt_element) of
case coerce_tuple_elements(TermTypes, Terms, Direction, adt_element) of
{ok, Converted} ->
Arities = [length(VariantTerms)
|| {_, VariantTerms} <- Variants],
{ok, {variant, Arities, Tag, list_to_tuple(Converted)}};
case Direction of
to_fate ->
Arities = [length(VariantTerms)
|| {_, VariantTerms} <- Variants],
{ok, {variant, Arities, Tag, list_to_tuple(Converted)}};
from_fate ->
{ok, list_to_tuple([Name | Converted])}
end;
{error, too_few_terms} ->
single_error({adt_too_few_terms, O, N, Name, TermTypes, Terms});
{error, too_many_terms} ->
@@ -1105,32 +1110,32 @@ coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms) ->
Errors -> Errors
end.
coerce_elems_to_fate(Types, Terms, Tag) ->
coerce_tuple_elements(Types, Terms, Direction, Tag) ->
% The sophia standard library uses 0 indexing for lists, and fst/snd/thd
% for tuples... Not sure how we should report errors in tuples, then.
coerce_elems_to_fate(Types, Terms, Tag, 0, [], []).
coerce_tuple_elements(Types, Terms, Direction, Tag, 0, [], []).
coerce_elems_to_fate([Type | Types], [Term | Terms], Tag, Index, Good, Broken) ->
case erlang_to_fate(Type, Term) of
coerce_tuple_elements([Type | Types], [Term | Terms], Direction, Tag, Index, Good, Broken) ->
case coerce_direction(Type, Term, Direction) of
{ok, Value} ->
coerce_elems_to_fate(Types, Terms, Tag, Index + 1, [Value | Good], Broken);
coerce_tuple_elements(Types, Terms, Direction, Tag, Index + 1, [Value | Good], Broken);
{error, Errors} ->
Wrapped = wrap_errors({Tag, Index}, Errors),
coerce_elems_to_fate(Types, Terms, Tag, Index + 1, Good, [Wrapped | Broken])
coerce_tuple_elements(Types, Terms, Direction, Tag, Index + 1, Good, [Wrapped | Broken])
end;
coerce_elems_to_fate([], [], _, _, Good, []) ->
coerce_tuple_elements([], [], _, _, _, Good, []) ->
{ok, lists:reverse(Good)};
coerce_elems_to_fate([], [], _, _, _, Broken) ->
coerce_tuple_elements([], [], _, _, _, _, Broken) ->
{error, combine_errors(Broken)};
coerce_elems_to_fate(_, [], _, _, _, _) ->
coerce_tuple_elements(_, [], _, _, _, _, _) ->
{error, too_few_terms};
coerce_elems_to_fate([], _, _, _, _, _) ->
coerce_tuple_elements([], _, _, _, _, _, _) ->
{error, too_many_terms}.
coerce_map_to_record(O, N, MemberTypes, Map) ->
case zip_record_fields(MemberTypes, Map) of
{ok, Zipped} ->
case coerce_zipped_bindings(Zipped, field) of
case coerce_zipped_bindings(Zipped, to_fate, field) of
{ok, [SingleElem]} ->
% Singleton records aren't implemented as FATE tuples at
% all.
@@ -1147,6 +1152,31 @@ coerce_map_to_record(O, N, MemberTypes, Map) ->
single_error({unexpected_fields, O, N, Names})
end.
coerce_record_to_map(O, N, MemberTypes, Tuple) ->
{Names, Types} = lists:unzip(MemberTypes),
Terms = tuple_to_list(Tuple),
% FIXME: We could go through and change the record_element paths into field
% paths?
case coerce_tuple_elements(Types, Terms, from_fate, record_element) of
{ok, Converted} ->
Map = maps:from_list(lists:zip(Names, Converted)),
{ok, Map};
{error, too_few_terms} ->
single_error({record_too_few_terms, O, N, Tuple});
{error, too_many_terms} ->
single_error({record_too_many_terms, O, N, Tuple});
{error, Errors} ->
correct_record_error_paths(Names, Errors)
end.
correct_record_error_paths(Names, Errors) ->
CorrectOne = fun({Error, [{record_element, N} | Path]}) ->
FieldName = lists:nth(N + 1, Names),
{Error, [{record_element, N, FieldName} | Path]}
end,
Corrected = lists:map(CorrectOne, Errors),
{error, Corrected}.
zip_record_fields(Fields, Map) ->
case lists:mapfoldl(fun zip_record_field/2, {Map, []}, Fields) of
{_, {_, Missing = [_|_]}} ->
@@ -1187,10 +1217,20 @@ combine_errors(Broken) ->
%%% FATE to Erlang
-spec fate_to_erlang(Type, FATE) -> Erlang
% Not sure if this is needed... fate_to_erlang shouldn't fail.
coerce_direction(Type, Term, to_fate) ->
erlang_to_fate(Type, Term);
coerce_direction(Type, Term, from_fate) ->
fate_to_erlang(Type, Term).
-spec fate_to_erlang(Type, FATE) -> {ok, Erlang} | {error, Errors}
when Type :: annotated_type(),
FATE :: gmb_fate_data:fate_type(),
Erlang :: erlang_repr().
Erlang :: erlang_repr(),
Errors :: [{Reason, [PathStep]}],
Reason :: term(),
PathStep :: term().
%% @doc
%% Convert a FATE-flavored Erlang term into a Sophia-flavored Erlang term
%% Typically this is called by hakuzaru for you when decoding results from the
@@ -1200,81 +1240,83 @@ combine_errors(Broken) ->
%% information.
fate_to_erlang({_, _, integer}, S) when is_integer(S) ->
S;
{ok, S};
fate_to_erlang({_, _, address}, {address, Bin}) ->
Address = gmser_api_encoder:encode(account_pubkey, Bin),
unicode:characters_to_list(Address);
{ok, unicode:characters_to_list(Address)};
fate_to_erlang({_, _, contract}, {contract, Bin}) ->
Address = gmser_api_encoder:encode(contract_pubkey, Bin),
unicode:characters_to_list(Address);
{ok, unicode:characters_to_list(Address)};
fate_to_erlang({_, _, signature}, Bin) ->
Address = gmser_api_encoder:encode(signature, Bin),
unicode:characters_to_list(Address);
{ok, unicode:characters_to_list(Address)};
%fate_to_erlang({_, _, channel}, {channel, S}) when is_binary(S) ->
%S;
%{ok, S};
fate_to_erlang({_, _, boolean}, true) ->
true;
{ok, true};
fate_to_erlang({_, _, boolean}, false) ->
false;
{ok, false};
fate_to_erlang({_, _, string}, Bin) ->
binary_to_list(Bin);
Str = binary_to_list(Bin),
{ok, Str};
fate_to_erlang({_, _, char}, Val) ->
Val;
fate_to_erlang({O, N, {bytes, [Count]}}, {bytes, Bytes}) when is_bitstring(Bytes) ->
case check_bytes(O, N, Count, Bytes) of
ok -> Bytes;
{error, Reason} -> erlang:exit(Reason)
end;
{ok, Val};
fate_to_erlang({O, N, {bytes, [Count]}}, Bytes) when is_bitstring(Bytes) ->
coerce_bytes(O, N, Count, Bytes);
fate_to_erlang({_, _, bits}, {bits, Num}) ->
Num;
{ok, Num};
fate_to_erlang({_, _, {list, [Type]}}, Data) when is_list(Data) ->
Each = fun(Elem) -> fate_to_erlang(Type, Elem) end,
lists:map(Each, Data);
coerce_list(Type, Data, from_fate);
fate_to_erlang({_, _, {map, [KeyType, ValType]}}, Data) when is_map(Data) ->
coerce_map_to_erlang(KeyType, ValType, maps:iterator(Data), #{});
fate_to_erlang({_, _, {tuple, ElementTypes}}, {tuple, Data}) ->
coerce_map(KeyType, ValType, Data, from_fate);
fate_to_erlang({O, N, {tuple, ElementTypes}}, {tuple, Data}) ->
ElementList = tuple_to_list(Data),
Elems = coerce_elems_to_erlang(ElementTypes, ElementList),
list_to_tuple(Elems);
fate_to_erlang({_, _, {variant, Variants}}, {variant, _, Tag, Tuple}) ->
coerce_tuple(O, N, ElementTypes, ElementList, from_fate);
fate_to_erlang({O, N, {variant, Variants}}, {variant, _, Tag, Tuple}) ->
Terms = tuple_to_list(Tuple),
{Name, Types} = lists:nth(Tag + 1, Variants),
Elems = coerce_elems_to_erlang(Types, Terms),
list_to_tuple([Name | Elems]);
fate_to_erlang({_, _, {record, [SingleField]}}, Data) ->
{Name, TermTypes} = lists:nth(Tag + 1, Variants),
coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms, from_fate);
fate_to_erlang({O, N, {record, [SingleMemberType]}}, Data) ->
% Singleton records aren't implemented as FATE tuples at all.
coerce_record_to_map([SingleField], [Data], #{});
fate_to_erlang({_, _, {record, MemberTypes}}, {tuple, Tuple}) ->
Terms = tuple_to_list(Tuple),
coerce_record_to_map(MemberTypes, Terms, #{});
% Pretend they are, so we can get the full error indexing of the
% non-singletone case.
coerce_record_to_map(O, N, [SingleMemberType], {Data});
fate_to_erlang({O, N, {record, MemberTypes}}, {tuple, Tuple}) ->
coerce_record_to_map(O, N, MemberTypes, Tuple);
fate_to_erlang({O, N, {unknown_type, _}}, Data) ->
warn_unknown_type(O, N, Data),
Data;
fate_to_erlang({O, N, _}, Data) ->
erlang:exit({invalid, O, N, Data}).
case N of
already_normalized ->
Message = "Warning: Unknown type ~p. Using term ~p as is.~n",
io:format(Message, [O, Data]);
_ ->
Message = "Warning: Unknown type ~p (i.e. ~p). Using term ~p as is.~n",
io:format(Message, [O, N, Data])
end,
{ok, Data};
fate_to_erlang(Type, Data) ->
TypeStr = type_to_iolist(Type),
io:format("Warning: Could not coerce term into ~s. Using term as is: ~p~n", [TypeStr, Data]),
{ok, Data}.
coerce_elems_to_erlang(Types, Elems) ->
Zipped = lists:zip(Types, Elems),
Each = fun({Type, Elem}) -> fate_to_erlang(Type, Elem) end,
lists:map(Each, Zipped).
type_to_iolist({O, already_normalized, S}) ->
% Already normalized. Example output:
% type {map, [string, integer]}
opaque_type_to_iolist(O, S);
type_to_iolist({O, N, S}) ->
% Type alias. Print the alias, and then print the normalized version in
% parentheses. Example output:
% type "my_alias" (i.e. record type {"my_record_type", [integer]})
io_lib:format("type ~p (i.e. ~s)", [O, opaque_type_to_iolist(N, S)]).
coerce_record_to_map([{Name, Type} | Types], [Term | Terms], Acc) ->
Coerced = fate_to_erlang(Type, Term),
NewAcc = maps:put(Name, Coerced, Acc),
coerce_record_to_map(Types, Terms, NewAcc);
coerce_record_to_map([], [], Acc) ->
Acc.
coerce_map_to_erlang(KeyType, ValType, Iter, Acc) ->
case maps:next(Iter) of
{KeyFATE, ValFATE, Rest} ->
Key = fate_to_erlang(KeyType, KeyFATE),
Val = fate_to_erlang(ValType, ValFATE),
NewAcc = maps:put(Key, Val, Acc),
coerce_map_to_erlang(KeyType, ValType, Rest, NewAcc);
none ->
Acc
end.
opaque_type_to_iolist(N, {record, _}) ->
% N is the name of a record definition.
io_lib:format("record type ~p", [N]);
opaque_type_to_iolist(N, {variant, _}) ->
% N is the name of a variant definition.
io_lib:format("variant type ~p", [N]);
opaque_type_to_iolist(N, _) ->
% N is some other constructive type.
io_lib:format("type ~p", [N]).
@@ -1312,7 +1354,7 @@ check_erlang_to_fate(Type, Sophia, Fate) ->
end.
check_fate_to_erlang(Type, Fate, Sophia) ->
SophiaActual = fate_to_erlang(Type, Fate),
{ok, SophiaActual} = fate_to_erlang(Type, Fate),
% Now check that the results were what we expected.
case SophiaActual of
Sophia ->
@@ -1410,7 +1452,7 @@ coerce_record_test() ->
coerce_bytes_test() ->
{ok, Type} = annotate_type({tuple, [{bytes, [4]}, {bytes, [any]}]}, #{}),
check_roundtrip(Type, {<<"abcd">>, <<"efghi">>}, {tuple, {{bytes, <<"abcd">>}, {bytes, <<"efghi">>}}}).
check_roundtrip(Type, {<<"abcd">>, <<"efghi">>}, {tuple, {<<"abcd">>, <<"efghi">>}}).
coerce_bits_test() ->
{ok, Type} = annotate_type(bits, #{}),
@@ -1429,7 +1471,7 @@ coerce_unicode_test() ->
coerce_hash_test() ->
{ok, Type} = annotate_type("hash", builtin_typedefs()),
Hash = list_to_binary(lists:seq(1,32)),
check_roundtrip(Type, Hash, {bytes, Hash}),
check_roundtrip(Type, Hash, Hash),
ok.
@@ -1477,7 +1519,10 @@ singleton_record_substitution_test() ->
{ok, {[], GOutput}} = get_function_signature(AACI, "g"),
check_roundtrip(GOutput, #{"it" => #{"it" => 123}}, 123),
{ok, {[], HOutput}} = get_function_signature(AACI, "h"),
check_roundtrip(HOutput, #{"it" => {123, 456}}, {tuple, {123, 456}}).
check_roundtrip(HOutput, #{"it" => {123, 456}}, {tuple, {123, 456}}),
% Also check that records have accurate paths, since the implementation for
% record error paths is a bit fiddly.
{error, [{{tuple_too_many_terms, _, _, _}, [{record_element, 0, "it"}]}]} = fate_to_erlang(HOutput, {tuple, {1, 2, 3}}).
tuple_substitution_test() ->
Contract = "
src/hz_key_master.erl
+239 -29
View File
@@ -1,17 +1,43 @@
%%% @doc
%%% Key functions
%%% Hakuzaru Key Functions
%%%
%%% The main reason this is a module of its own is that in the original architecture
%%% it was a process rather than just a library of functions. Now that it exists, though,
%%% there is little motivation to cram everything here into the controller process's
%%% code.
%%% The Gajumaru's default key type is based on Elliptical Curve Cryptography (ECC).
%%% The specific curve used is 25519, and the typical key representation is Ed25519.
%%%
%%% The "Ed" in "Ed25519" stands for Harold Edwards. This form represents
%%% a coordinate on a "Twisted Edwards Curve".
%%%
%%% The "X" in "X25519" stands for the X-coordinate, also known as the
%%% "Montgomery u-coordinate" on a "Montgomery Curve".
%%%
%%% The two are equivalent, but have meaningfully different properties.
%%% @end
-module(hz_key_master).
-vsn("0.9.2").
-export([make_key/1, encode/1, decode/1]).
-export([lcg/1]).
-export([make_key/0, make_key/1, encode/1, decode/1]).
-export([shared_secret_a/6, shared_secret_b/6,
ed25519_pk_to_x25519/1, ed25519_sk_to_x25519/1,
hkdf/4, hkdf/5]).
-spec make_key() -> {ID, KeyPair}
when ID :: string(),
KeyPair :: #{secret => binary(), public => binary()}.
%% @doc
%% @equiv make_key(<<>>)
make_key() ->
make_key(<<>>).
-spec make_key(Secret) -> {ID, KeyPair}
when Secret :: <<>> | <<_:32*8>>,
ID :: string(),
KeyPair :: #{secret => binary(), public => binary()}.
%% @doc
%% Generate a Ed25519 keypair tagged with the corresponding Gajumaru ID.
make_key(<<>>) ->
Pair = #{public := Public} = ecu_eddsa:sign_keypair(),
@@ -125,28 +151,212 @@ sumcheck(Width, Bits) ->
end.
-spec lcg(integer()) -> integer().
%% A simple PRNG that fits into 32 bits and is easy to implement anywhere (Kotlin).
%% Specifically, it is a "linear congruential generator" of the Lehmer variety.
%% The constants used are based on recommendations from Park, Miller and Stockmeyer:
%% https://www.firstpr.com.au/dsp/rand31/p105-crawford.pdf#page=4
-spec shared_secret_a(A_E_E_SK, B_P_E_PK, B_E_E_PK, Protocol, Version, Salt) -> SS
when A_E_E_SK :: binary(),
B_P_E_PK :: <<_:32*8>>,
B_E_E_PK :: <<_:32*8>>,
Protocol :: binary(),
Version :: binary(),
Salt :: binary(),
SS :: <<_:32*8>>.
%% @doc
%% Alice's side of a shared key derivation based on ed25519 keys as generated by this module.
%%
%% The input value should be between 1 and 2^31-1.
%%
%% The purpose of this PRNG is for password-based dictionary shuffling.
%% Typically Alice would be providing an ephemeral key to establish
%% a shared secret while remaining (at least initially) anonymous from Bob. Bob,
%% on the other hand, is providing a permanent key and also an ephemeral key,
%% proving identity without exposing the shared secret in the future were one of
%% the secrets to be compromised.
%% <ul>
%% <li>`A_E_E_SK' Alice's Ephemeral Ed25519 Secret Key.</li>
%% <li>`B_P_E_PK' Bob's Permanent Ed25519 Public Key.</li>
%% <li>`B_E_E_PK' Bob's Ephemeral Ed25519 Public Key.</li>
%% <li>`Protocol' is an arbitrary binary string, typically a protocol name in UTF-8.</li>
%% <li>`Version' is another arbitrary binary string, typically a protocol version in UTF-8.</li>
%% <li>`Salt' is a binary salt, which if empty will be replaced by a binary string of zeroes.</li>
%% <li>`SS' is the resulting 32-byte shared secret.</li>
%% </ul>
lcg(N) ->
M = 16#7FFFFFFF,
A = 48271,
Q = 44488, % M div A
R = 3399, % M rem A
Div = N div Q,
Rem = N rem Q,
S = Rem * A,
T = Div * R,
Result = S - T,
case Result < 0 of
false -> Result;
true -> Result + M
shared_secret_a(A_E_E_SK, B_P_E_PK, B_E_E_PK, Protocol, Version, Salt) ->
A_E_X_SK = ed25519_sk_to_x25519(A_E_E_SK),
B_P_X_PK = ed25519_pk_to_x25519(B_P_E_PK),
B_E_X_PK = ed25519_pk_to_x25519(B_E_E_PK),
DH_Permanent = crypto:compute_key(ecdh, B_P_X_PK, A_E_X_SK, x25519),
DH_Ephemeral = crypto:compute_key(ecdh, B_E_X_PK, A_E_X_SK, x25519),
finalize_hkdf(DH_Permanent, DH_Ephemeral, Protocol, Version, Salt).
-spec shared_secret_b(B_P_E_SK, B_E_E_SK, A_E_E_PK, Protocol, Version, Salt) -> SS
when B_P_E_SK :: binary(),
B_E_E_SK :: binary(),
A_E_E_PK :: <<_:32*8>>,
Protocol :: binary(),
Version :: binary(),
Salt :: binary(),
SS :: <<_:32*8>>.
%% @doc
%% Bobs's side of a shared key derivation based on ed25519 keys as generated by this module.
%%
%% Typically Alice would be providing an ephemeral key to establish
%% a shared secret while remaining (at least initially) anonymous from Bob. Bob,
%% on the other hand, is providing a permanent key and also an ephemeral key,
%% proving identity without exposing the shared secret in the future were one of
%% the secrets to be compromised.
%% <ul>
%% <li>`B_P_E_SK' Bob's Permanent Ed25519 Secret Key.</li>
%% <li>`B_E_E_SK' Bob's Ephemeral Ed25519 Secret Key.</li>
%% <li>`A_E_E_PK' Alice's Ephemeral Ed25519 Public Key.</li>
%% <li>`Protocol' is an arbitrary binary string, typically a protocol name in UTF-8.</li>
%% <li>`Version' is another arbitrary binary string, typically a protocol version in UTF-8.</li>
%% <li>`Salt' is a binary salt, which if empty will be replaced by a binary string of zeroes.</li>
%% <li>`SS' is the resulting 32-byte shared secret.</li>
%% </ul>
shared_secret_b(B_P_E_SK, B_E_E_SK, A_E_E_PK, Protocol, Version, Salt) ->
B_P_X_SK = ed25519_sk_to_x25519(B_P_E_SK),
B_E_X_SK = ed25519_sk_to_x25519(B_E_E_SK),
A_E_X_PK = ed25519_pk_to_x25519(A_E_E_PK),
DH_Permanent = crypto:compute_key(ecdh, A_E_X_PK, B_P_X_SK, x25519),
DH_Ephemeral = crypto:compute_key(ecdh, A_E_X_PK, B_E_X_SK, x25519),
finalize_hkdf(DH_Permanent, DH_Ephemeral, Protocol, Version, Salt).
finalize_hkdf(DH_Permanent, DH_Ephemeral, Protocol, Version, Salt) ->
MixedInput = <<DH_Permanent/binary, DH_Ephemeral/binary>>,
Info = <<Protocol/binary, ":", Version/binary, ":">>,
hkdf(sha256, MixedInput, Salt, Info).
%% Curve25519 Prime Field Constant: 2^255 - 19
%% Yes, in hex it reads kind of like "lucky fed"
p() -> 16#7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFED.
-spec ed25519_pk_to_x25519(ED25519_PubKey) -> X25519_PubKey
when ED25519_PubKey :: <<_:32*8>>,
X25519_PubKey :: <<_:32*8>>.
%% @doc
%% Convert a curve 25519 public key from Edwards representation to X-coordinate
%% representation.
ed25519_pk_to_x25519(<<ED25519_PK:32/binary>>) ->
<<CompressedInt:256/little-integer>> = ED25519_PK,
% Clear the sign bit (MSB) to get the raw y-coordinate
Y = CompressedInt band ((1 bsl 255) - 1),
% Compute u = (1 + y) / (1 - y) mod P
Num = (1 + Y) rem p(),
Den = (1 - Y + p()) rem p(),
case Den =:= 0 of
true ->
% If y == 1, the point maps to the point at infinity.
% On X25519, this translates to u = 0.
<<0:256/little-integer>>;
false ->
U = (Num * mod_inv(Den, p())) rem p(),
<<U:256/little-integer>>
end.
-spec ed25519_sk_to_x25519(ED25519_SecKey) -> X25519_SecKey
when ED25519_SecKey :: binary(),
X25519_SecKey :: <<_:32*8>>.
%% @doc
%% Convert a curve 25519 secret key from Edwards representation to X-coordinate
%% representation.
ed25519_sk_to_x25519(<<ED25519_SK_Secret:32/binary, _/binary>>) ->
<<X25519_SK:32/binary, _/binary>> = crypto:hash(sha512, ED25519_SK_Secret),
X25519_SK.
mod_inv(A, M) ->
{1, X, _} = ext_gcd(A, M),
(X + M) rem M.
ext_gcd(A, 0) ->
{A, 1, 0};
ext_gcd(A, B) ->
{G, X1, Y1} = ext_gcd(B, A rem B),
{G, Y1, X1 - (A div B) * Y1}.
-spec hkdf(Hash, IKM, Salt, Info) -> DerivedKey
when Hash :: md5 | sha | sha224 | sha256 | sha384 | sha512,
IKM :: binary(),
Salt :: binary(),
Info :: binary(),
DerivedKey :: <<_:32*8>>.
%% @doc
%% 32-byte HMAC-Based Extract-and-Expand Key Derivation
%% @equiv hkdf(Hash, IKM, Salt, Info, 32)
hkdf(Hash, IKM, Salt, Info) ->
hkdf(Hash, IKM, Salt, Info, 32).
-spec hkdf(Hash, IKM, Salt, Info, Length) -> DerivedKey
when Hash :: md5 | sha | sha224 | sha256 | sha384 | sha512,
IKM :: binary(),
Salt :: binary(),
Info :: binary(),
Length :: 16 | 20 | 28 | 32 | 48 | 64,
DerivedKey :: binary().
%% @doc
%% RFC-5869 compliant HMAC-Based Extract-and-Expand Key Derivation
%%
%% RFC-5869:
%% <a href="https://datatracker.ietf.org/doc/html/rfc5869">https://datatracker.ietf.org/doc/html/rfc5869</a>
%%
%% The purpose of HKDF is to take an initial, raw secret input that might
%% be mathematically strong but structurally "clumpy" and transform it into one
%% or more uniform, high-entropy keys suitable for use in cryptography.
%%
%% The problem is that when Alice and Bob compute a Diffie-Hellman shared secret
%% over X25519, the resulting bytes are mathematically secure, but they are not
%% evenly distributed as random noise. Cryptographic ciphers expect keys where
%% every single bit has an exactly 50% chance of being a 0 or a 1. Passing raw
%% DH outputs straight into a cipher can introduce subtle, exploitable patterns.
%%
%% HKDF "smooths out" the entropy.
%%
%% HMAC stands for "Keyed-Hash Message Authentication Code", but without the
%% leading "K" just to keep us on our toes. The problem it solves is that simply
%% concatenating a secret and some target data and hashing them together to produce
%% a message authentication hash leaves the resulting hash vulnerable to a "length
%% extension attack". An attacker can append additional data to the end of the
%% message and arrive at a valid new hash without ever knowing the secret.
%%
%% RFC-2104 provides good background information on the technique:
%% <a href="https://datatracker.ietf.org/doc/html/rfc2104">https://datatracker.ietf.org/doc/html/rfc2104</a>
hkdf(Hash, IKM, Salt, Info, Length) ->
PRK = extract(Hash, Salt, IKM),
expand(Hash, PRK, Info, Length).
extract(Hash, <<>>, IKM) ->
%% If salt is empty RFC 5869 requires a string of zeros equal to hash size
Salt = binary:copy(<<0>>, hash_size(Hash)),
extract(Hash, Salt, IKM);
extract(Hash, Salt, IKM) ->
crypto:mac(hmac, Hash, Salt, IKM).
expand(Hash, PRK, Info, OutLen) ->
HashLen = hash_size(Hash),
BlockCount = (OutLen + HashLen - 1) div HashLen,
true = BlockCount =< 255,
FullBlocks = expand_loop(Hash, PRK, Info, BlockCount, 1, <<>>, <<>>),
<<Output:OutLen/binary, _/binary>> = FullBlocks,
Output.
expand_loop(Hash, PRK, Info, N, Counter, PrevT, Acc) when Counter =< N ->
Payload = <<PrevT/binary, Info/binary, Counter:8>>,
T = crypto:mac(hmac, Hash, PRK, Payload),
expand_loop(Hash, PRK, Info, N, Counter + 1, T, <<Acc/binary, T/binary>>);
expand_loop(_, _, _, _, _, _, Acc) ->
Acc.
hash_size(md5) -> 16;
hash_size(sha) -> 20;
hash_size(sha224) -> 28;
hash_size(sha256) -> 32;
hash_size(sha384) -> 48;
hash_size(sha512) -> 64.
src/hz_sophia.erl
+34 -173
View File
@@ -343,12 +343,6 @@ parse_expression2(_, _, _, Token) ->
unknown_type() ->
{unknown_type, already_normalized, unknown_type}.
int_type() ->
{integer, already_normalized, integer}.
int_list_type() ->
{{list, [integer]}, alread_normalized, {list, [int_type()]}}.
expect_tokens([], Pos, String) ->
{ok, {Pos, String}};
expect_tokens([Str | Rest], Pos, String) ->
@@ -383,14 +377,11 @@ parse_alphanum(Type, Pos, String, ["Bits", "all"], Row, Start, End) ->
typecheck_bits(Type, Pos, String, -1, Row, Start, End);
parse_alphanum(Type, Pos, String, ["Bits", "none"], Row, Start, End) ->
typecheck_bits(Type, Pos, String, 0, Row, Start, End);
parse_alphanum(Type, Pos, String, ["variant"], Row, Start, End) ->
parse_anonymous_variant(Type, Pos, String, Row, Start, End);
parse_alphanum(Type, Pos, String, [[C | _] = S], Row, Start, End) when ?IS_LATIN_LOWER(C) ->
% From a programming perspective, we are trying to parse a constant, so
% an alphanum token can really only be a constructor, or a chain object.
% Constructors start with uppercase characters, and we have handled our
% made-up 'variant' case explicitly, so the only other lowercase constants
% are serialized chain objects.
% Constructors start with uppercase characters, so lowercase can only be a
% chain object.
try
case gmser_api_encoder:decode(unicode:characters_to_binary(S)) of
{account_pubkey, Data} ->
@@ -409,8 +400,8 @@ parse_alphanum(Type, Pos, String, [[C | _] = S], Row, Start, End) when ?IS_LATIN
_:_ -> {error, {unexpected_identifier, S, Row, Start, End}}
end;
parse_alphanum(Type, Pos, String, Path, Row, Start, End) ->
% Now having handled all lowercase terms, anything else must be uppercase,
% which is either a variant constructor, or totally invalid.
% Inversely, chain object prefixes are always lowercase, so any other path
% must be a variant constructor, or invalid.
parse_variant(Type, Pos, String, Path, Row, Start, End).
typecheck_integer({_, _, integer}, Pos, String, Value, _, _, _) ->
@@ -740,12 +731,6 @@ parse_variant({O, N, {variant, Variants}}, Pos, String, [Namespace, Constructor]
_ ->
{error, {invalid_constructor, O, N, Namespace ++ "." ++ Constructor, Row, Start, End}}
end;
parse_variant({_, _, unknown_type}, Pos, String, ["None"], _, _, _) ->
% Special case for None without type info.
parse_variant3([0, 1], 0, [], Pos, String);
parse_variant({_, _, unknown_type}, Pos, String, ["Some"], _, _, _) ->
% Also a special case for Some.
parse_variant3([0, 1], 1, [unknown_type()], Pos, String);
parse_variant({_, _, unknown_type}, _, _, _, Row, Start, End) ->
{error, {unresolved_variant, Row, Start, End}};
parse_variant({O, N, _}, _, _, _, Row, Start, End) ->
@@ -768,7 +753,8 @@ get_typename(Name) ->
parse_variant2(O, N, Variants, Pos, String, Prefix, Constructor, Row, Start, End) ->
case lookup_variant(Constructor, Variants, 0) of
{ok, {Tag, ElemTypes}} ->
Arities = get_arities(Variants),
GetArity = fun({_, OtherElemTypes}) -> length(OtherElemTypes) end,
Arities = lists:map(GetArity, Variants),
parse_variant3(Arities, Tag, ElemTypes, Pos, String);
error ->
{error, {invalid_constructor, O, N, Prefix ++ Constructor, Row, Start, End}}
@@ -804,112 +790,6 @@ lookup_variant(Ident, [{Ident, ElemTypes} | _], Tag) ->
lookup_variant(Ident, [_ | Rest], Tag) ->
lookup_variant(Ident, Rest, Tag + 1).
get_arities(Variants) ->
GetArity = fun({_, OtherElemTypes}) -> length(OtherElemTypes) end,
lists:map(GetArity, Variants).
parse_anonymous_variant({O, N, {variant, Variants}}, Pos, String, _, _, _) ->
parse_anonymous_variant2({O, N, {variant, Variants}}, Pos, String);
parse_anonymous_variant({O, N, unknown_type}, Pos, String, _, _, _) ->
parse_anonymous_variant2({O, N, unknown_type}, Pos, String);
parse_anonymous_variant({O, N, _}, _, _, Row, Start, End) ->
{error, {wrong_type, O, N, variant, Row, Start, End}}.
parse_anonymous_variant2(Type, Pos, String) ->
case expect_tokens(["("], Pos, String) of
{ok, {NewPos, NewString}} ->
parse_anonymous_variant3(Type, NewPos, NewString);
{error, Reason} ->
{error, Reason}
end.
parse_anonymous_variant3(Type, Pos, String) ->
case parse_arities(Type, Pos, String) of
{ok, {Arities, NewPos, NewString}} ->
parse_anonymous_variant4(Type, NewPos, NewString, Arities);
{error, Reason} ->
{error, Reason}
end.
parse_anonymous_variant4(Type, Pos, String, Arities) ->
case expect_tokens([","], Pos, String) of
{ok, {NewPos, NewString}} ->
parse_anonymous_variant5(Type, NewPos, NewString, Arities);
{error, Reason} ->
{error, Reason}
end.
parse_anonymous_variant5(Type, Pos, String, Arities) ->
case parse_anonymous_tag(Pos, String, Arities) of
{ok, {Tag, NewPos, NewString}} ->
parse_anonymous_variant6(Type, NewPos, NewString, Arities, Tag);
{error, Reason} ->
{error, Reason}
end.
parse_anonymous_variant6(Type, Pos, String, Arities, Tag) ->
ElemTypes = infer_anonymous_variant_elem_types(Type, Arities, Tag),
case parse_multivalue3(ElemTypes, Pos, String, []) of
{ok, {Terms, NewPos, NewString}} ->
Result = {variant, Arities, Tag, list_to_tuple(Terms)},
{ok, {Result, NewPos, NewString}};
{error, Reason} ->
{error, Reason}
end.
parse_arities(Type, Pos, String) ->
case next_token(Pos, String) of
{ok, {Token, NewPos, NewString}} ->
parse_arities2(Type, NewPos, NewString, Token);
{error, Reason} ->
{error, Reason}
end.
parse_arities2(Type, Pos, String, Token = {_, _, _, Row, Start, _}) ->
case parse_expression2(int_list_type(), Pos, String, Token) of
{ok, {Arities, NewPos, NewString}} ->
parse_arities3(Type, NewPos, NewString, Arities, Row, Start);
{error, Reason} ->
{error, Reason}
end.
parse_arities3({O, N, {variant, Variants}}, Pos, String, Arities, Row, Start) ->
ExpectedArities = get_arities(Variants),
case Arities == ExpectedArities of
true ->
{ok, {Arities, Pos, String}};
false ->
{error, {wrong_arities, O, N, Arities, Row, Start}}
end;
parse_arities3(_, Pos, String, Arities, _, _) ->
{ok, {Arities, Pos, String}}.
parse_anonymous_tag(Pos, String, Arities) ->
case next_token(Pos, String) of
{ok, {Token, NewPos, NewString}} ->
parse_anonymous_tag2(NewPos, NewString, Arities, Token);
{error, Reason} ->
{error, Reason}
end.
parse_anonymous_tag2(Pos, String, Arities, Token = {_, _, _, Row, Start, End}) ->
TagCount = length(Arities),
case parse_expression2(int_type(), Pos, String, Token) of
{ok, {Tag, _, _}} when Tag < 0 ->
{error, {negative_tag, Tag, Row, Start, End}};
{ok, {Tag, _, _}} when Tag >= TagCount ->
{error, {invalid_tag, Tag, TagCount, Row, Start, End}};
Result ->
Result
end.
infer_anonymous_variant_elem_types({_, _, {variant, Variants}}, _, Tag) ->
{_Name, ElemTypes} = lists:nth(Tag + 1, Variants),
ElemTypes;
infer_anonymous_variant_elem_types({_, _, unknown_type}, Arities, Tag) ->
Arity = lists:nth(Tag + 1, Arities),
lists:duplicate(Arity, unknown_type()).
%%% Record parsing
parse_record_or_map({_, _, {map, [KeyType, ValueType]}}, Pos, String, _, _) ->
@@ -1147,12 +1027,15 @@ fate_to_iolist(Type, {tuple, Tuple}) ->
_ ->
tuple_to_iolist([], Tuple)
end;
fate_to_iolist(Type, {variant, Arities, Tag, Tuple}) ->
fate_to_iolist(Type, {variant, _, Tag, Tuple}) ->
case Type of
{O, N, {variant, VariantTypes}} when Tag < length(VariantTypes) ->
variant_to_iolist(O, N, VariantTypes, Tag, Tuple);
{_, _, _} ->
anonymous_variant_to_iolist(Arities, Tag, Tuple)
{O, N, _} ->
% TODO: Make up a special syntax for anonymous variant terms.
erlang:exit({untyped_variant, O, N});
_ ->
erlang:exit({untyped_variant, unknown_type, already_normalized})
end;
fate_to_iolist(Type, List) when is_list(List) ->
case Type of
@@ -1247,22 +1130,6 @@ choose_variant_prefix(O, N) ->
[]
end.
% We don't have type information, but the Sophia programming language doesn't
% have syntax for anonymous variants, so we have to make a syntax up. This
% syntax is also supported when parsing terms, so that the output of one
% contract call can be fed easily into another contract call.
anonymous_variant_to_iolist(Arities, Tag, Tuple) ->
% Extract the elements of the tuple.
Elems = tuple_to_list(Tuple),
% Turn the arities, tag, and elements into an iolist.
AritiesStr = list_to_iolist(int_type(), Arities),
TagStr = integer_to_list(Tag),
FullTermsStr = list_elems_to_iolist(unknown_type(), Elems, [AritiesStr, ", ", TagStr]),
% Wrap that iolist in the anonymous 'variant' constructor.
["variant(", FullTermsStr, ")"].
multivalue_to_iolist([FirstType | ElemTypes], [FirstTerm | Elems]) ->
FirstTermChars = fate_to_iolist(FirstType, FirstTerm),
multivalue_to_iolist(ElemTypes, Elems, FirstTermChars);
@@ -1415,18 +1282,16 @@ check_parser_roundtrip(Sophia) ->
% syntax. Let's do a lenient test.
roundtrip_parser_lenient(unknown_type(), Sophia, Fate).
check_parser_with_typedef(Typedef, Sophia, UntypedSophia) ->
check_parser_with_typedef(Typedef, Sophia) ->
% Compile the type definitions alongside the usual literal expression.
Source = "contract C =\n " ++ Typedef ++ "\n entrypoint f() = " ++ Sophia,
{Fate, Type} = compile_entrypoint_value_and_type(Source, "f"),
% Do a typed parse, as usual. Variant namespaces can make pretty printing
% ambiguous, so make the roundtrip lenient.
roundtrip_parser_lenient(Type, Sophia, Fate),
% Do an untyped parse, but using a second special Sophia expression that
% doesn't require type info to parse. This one *doesn't* need to be
% lenient, since we are specifying a distinct sophia expression.
roundtrip_parser(unknown_type(), UntypedSophia, Fate).
% Do a typed parse, as usual, but there are probably record/variant
% definitions in the AACI, so untyped parses probably don't work, and
% variants often have optional namespaces, so the sophia result might not
% match exactly, but should still be equivalent.
roundtrip_parser_lenient(Type, Sophia, Fate).
anon_types_test() ->
% Integers.
@@ -1458,10 +1323,6 @@ anon_types_test() ->
check_parser_roundtrip("(1, [2, 3], (4, 5))"),
% Map.
check_parser_roundtrip("{[1] = 2, [3] = 4}"),
% Option.
check_parser_roundtrip("None"),
check_parser_roundtrip("Some(1)"),
check_parser_roundtrip("Some([1, 2, 3])"),
ok.
@@ -1481,7 +1342,7 @@ string_escape_codes_test() ->
records_test() ->
TypeDef = "record pair = {x: int, y: int}",
Sophia = "{x = 1, y = 2}",
check_parser_with_typedef(TypeDef, Sophia, "(1, 2)"),
check_parser_with_typedef(TypeDef, Sophia),
% The above won't run an untyped parse on the expression, but we can. It
% will error, though.
{error, {unresolved_record, _, _, _}} = parse_literal(unknown_type(), Sophia).
@@ -1489,11 +1350,11 @@ records_test() ->
variant_test() ->
TypeDef = "datatype multi('a) = Zero | One('a) | Two('a, 'a)",
check_parser_with_typedef(TypeDef, "Zero", "variant([0, 1, 2], 0)"),
check_parser_with_typedef(TypeDef, "One(0)", "variant([0, 1, 2], 1, 0)"),
check_parser_with_typedef(TypeDef, "Two(0, 1)", "variant([0, 1, 2], 2, 0, 1)"),
check_parser_with_typedef(TypeDef, "Two([], [1, 2, 3])", "variant([0, 1, 2], 2, [], [1, 2, 3])"),
check_parser_with_typedef(TypeDef, "C.Zero", "variant([0, 1, 2], 0)"),
check_parser_with_typedef(TypeDef, "Zero"),
check_parser_with_typedef(TypeDef, "One(0)"),
check_parser_with_typedef(TypeDef, "Two(0, 1)"),
check_parser_with_typedef(TypeDef, "Two([], [1, 2, 3])"),
check_parser_with_typedef(TypeDef, "C.Zero"),
{error, {unresolved_variant, _, _, _}} = parse_literal(unknown_type(), "Zero"),
@@ -1501,10 +1362,10 @@ variant_test() ->
ambiguous_variant_test() ->
TypeDef = "datatype mytype = C | D",
check_parser_with_typedef(TypeDef, "C", "variant([0, 0], 0)"),
check_parser_with_typedef(TypeDef, "D", "variant([0, 0], 1)"),
check_parser_with_typedef(TypeDef, "C.C", "variant([0, 0], 0)"),
check_parser_with_typedef(TypeDef, "C.D", "variant([0, 0], 1)"),
check_parser_with_typedef(TypeDef, "C"),
check_parser_with_typedef(TypeDef, "D"),
check_parser_with_typedef(TypeDef, "C.C"),
check_parser_with_typedef(TypeDef, "C.D"),
ok.
@@ -1549,9 +1410,9 @@ bits_test() ->
singleton_records_test() ->
TypeDef = "record singleton('a) = {it: 'a}",
check_parser_with_typedef(TypeDef, "{it = 123}", "123"),
check_parser_with_typedef(TypeDef, "{it = {it = {it = 5}}}", "5"),
check_parser_with_typedef(TypeDef, "[{it = 1}, {it = 2}, {it = 3}]", "[1, 2, 3]"),
check_parser_with_typedef(TypeDef, "{it = 123}"),
check_parser_with_typedef(TypeDef, "{it = {it = {it = 5}}}"),
check_parser_with_typedef(TypeDef, "[{it = 1}, {it = 2}, {it = 3}]"),
ok.
@@ -1560,9 +1421,9 @@ singleton_variants_test() ->
% actually a special case; singleton variants are in fact wrapped in the
% FATE too.
TypeDef = "datatype wrapped('a) = Wrap('a)",
check_parser_with_typedef(TypeDef, "Wrap(123)", "variant([1], 0, 123)"),
check_parser_with_typedef(TypeDef, "Wrap(Wrap(123))", "variant([1], 0, variant([1], 0, 123))"),
check_parser_with_typedef(TypeDef, "[Wrap(1), Wrap(2), Wrap(3)]", "[variant([1], 0, 1), variant([1], 0, 2), variant([1], 0, 3)]"),
check_parser_with_typedef(TypeDef, "Wrap(123)"),
check_parser_with_typedef(TypeDef, "Wrap(Wrap(123))"),
check_parser_with_typedef(TypeDef, "[Wrap(1), Wrap(2), Wrap(3)]"),
ok.