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:shared_secrets
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:spivee/fixes
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

3 Commits
shared_secrets .. spivee/fixes

Author SHA1 Message Date
Jarvis Carroll 6daad4974c unwrap fate_to_erlang results 
fate_to_erlang can only really fail at runtime if the wrong AACI is
provided, in which case the details of how failure occured are not
helpful, or recoverable. Anything else will be so broken that dialyzer
will catch it, or is a bug in hakuzaru, that we want to know about.
 2026-06-08 07:23:34 +00:00
Jarvis Carroll d323fb0f52 Add special anonymous variant syntax 
This is outside of the scope of the sophia parser, but is a simple generalization to
'sophia terms' to make them able to represent any FATE term anonymously.

We also parse these anonymous variant expressions without type info, since it is convenient
for users to copy the output of one call into another call.

Anonymous parsing of None and Some was also added, since new users would be shocked if this
doesn't work, and advanced users will greatly appreciate that it does. The resulting FATE
terms are still rendered as variant([0, 1], ...), since user defined types can also have [0, 1]
as their arity list, and since automation and tooling programmers hate special case exceptions like that.

Anonymous parsing of other Chain and AENS terms are not added, since anonymous variants already cover those types,
so very little is gained by hard-coding such complex types into the term parser. Complex, version-specific compiler
types are already supported by hakuzaru, in the form of the ACI/AACI; parsing without AACI, on the other hand, is
intended to support language-agnostic communication using the primitives of FATE, and in general, variants
in FATE are anonymous.
 2026-06-05 03:08:38 +00:00
Jarvis Carroll ea3a5453f2 fix bytes coerce logic 2026-05-28 00:41:51 +00:00
3 changed files with 336 additions and 452 deletions
Expand all files Collapse all files
src/hz_aaci.erl
+135 -180
View File
@@ -527,10 +527,7 @@ opaque_type(Params, #{record := FieldDefs}) ->
|| #{name := Name, type := Type} <- FieldDefs], || #{name := Name, type := Type} <- FieldDefs],
{record, Fields}; {record, Fields};
opaque_type(Params, #{variant := VariantDefs}) -> opaque_type(Params, #{variant := VariantDefs}) ->
ConvertVariant = fun(Pair) -> ConvertVariant = fun(Pair) -> opaque_variant_each(Params, Pair) end,
[{Name, Types}] = maps:to_list(Pair),
{binary_to_list(Name), [opaque_type(Params, Type) || Type <- Types]}
end,
Variants = lists:map(ConvertVariant, VariantDefs), Variants = lists:map(ConvertVariant, VariantDefs),
{variant, Variants}; {variant, Variants};
opaque_type(Params, #{tuple := TypeDefs}) -> opaque_type(Params, #{tuple := TypeDefs}) ->
@@ -541,6 +538,11 @@ opaque_type(Params, Pair) when is_map(Pair) ->
[{Name, TypeArgs}] = maps:to_list(Pair), [{Name, TypeArgs}] = maps:to_list(Pair),
{opaque_type_name(Name), [opaque_type(Params, Arg) || Arg <- TypeArgs]}. {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(). -spec opaque_type_name(binary()) -> atom() | string().
% Atoms for any builtins that aren't qualified by a namespace in Sophia. % Atoms for any builtins that aren't qualified by a namespace in Sophia.
@@ -848,7 +850,7 @@ erlang_args_to_fate(VarTypes, Terms) ->
DefLength = length(VarTypes), DefLength = length(VarTypes),
ArgLength = length(Terms), ArgLength = length(Terms),
if if
DefLength =:= ArgLength -> coerce_zipped_bindings(lists:zip(VarTypes, Terms), to_fate, arg); DefLength =:= ArgLength -> coerce_zipped_bindings(lists:zip(VarTypes, Terms), arg);
DefLength > ArgLength -> {error, too_few_args}; DefLength > ArgLength -> {error, too_few_args};
DefLength < ArgLength -> {error, too_many_args} DefLength < ArgLength -> {error, too_many_args}
end. end.
@@ -926,7 +928,10 @@ erlang_to_fate({O, N, char}, Str) ->
single_error({invalid, O, N, Str}) single_error({invalid, O, N, Str})
end; end;
erlang_to_fate({O, N, {bytes, [Count]}}, Bytes) when is_bitstring(Bytes) -> erlang_to_fate({O, N, {bytes, [Count]}}, Bytes) when is_bitstring(Bytes) ->
coerce_bytes(O, N, Count, Bytes); case check_bytes(O, N, Count, Bytes) of
ok -> {ok, {bytes, Bytes}};
{error, Reason} -> {error, Reason}
end;
erlang_to_fate({_, _, bits}, Num) when is_integer(Num) -> erlang_to_fate({_, _, bits}, Num) when is_integer(Num) ->
{ok, {bits, Num}}; {ok, {bits, Num}};
erlang_to_fate({_, _, bits}, Bits) when is_bitstring(Bits) -> erlang_to_fate({_, _, bits}, Bits) when is_bitstring(Bits) ->
@@ -934,19 +939,19 @@ erlang_to_fate({_, _, bits}, Bits) when is_bitstring(Bits) ->
<<IntValue:Size>> = Bits, <<IntValue:Size>> = Bits,
{ok, {bits, IntValue}}; {ok, {bits, IntValue}};
erlang_to_fate({_, _, {list, [Type]}}, Data) when is_list(Data) -> erlang_to_fate({_, _, {list, [Type]}}, Data) when is_list(Data) ->
coerce_list(Type, Data, to_fate); coerce_list(Type, Data);
erlang_to_fate({_, _, {map, [KeyType, ValType]}}, Data) when is_map(Data) -> erlang_to_fate({_, _, {map, [KeyType, ValType]}}, Data) when is_map(Data) ->
coerce_map(KeyType, ValType, Data, to_fate); coerce_map(KeyType, ValType, Data);
erlang_to_fate({O, N, {tuple, ElementTypes}}, Data) when is_tuple(Data) -> erlang_to_fate({O, N, {tuple, ElementTypes}}, Data) when is_tuple(Data) ->
ElementList = tuple_to_list(Data), ElementList = tuple_to_list(Data),
coerce_tuple(O, N, ElementTypes, ElementList, to_fate); coerce_tuple(O, N, ElementTypes, ElementList);
erlang_to_fate({O, N, {variant, Variants}}, Name) when is_list(Name) -> 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}}, {Name});
erlang_to_fate({O, N, {variant, Variants}}, Data) when is_tuple(Data), tuple_size(Data) > 0 -> erlang_to_fate({O, N, {variant, Variants}}, Data) when is_tuple(Data), tuple_size(Data) > 0 ->
[Name | Terms] = tuple_to_list(Data), [Name | Terms] = tuple_to_list(Data),
case lookup_variant(Name, Variants) of case lookup_variant(Name, Variants) of
{Tag, TermTypes} -> {Tag, TermTypes} ->
coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms, to_fate); coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms);
not_found -> not_found ->
ValidNames = [Valid || {Valid, _} <- Variants], ValidNames = [Valid || {Valid, _} <- Variants],
single_error({invalid_variant, O, N, Name, ValidNames}) single_error({invalid_variant, O, N, Name, ValidNames})
@@ -954,17 +959,15 @@ 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) -> erlang_to_fate({O, N, {record, MemberTypes}}, Map) when is_map(Map) ->
coerce_map_to_record(O, N, MemberTypes, Map); coerce_map_to_record(O, N, MemberTypes, Map);
erlang_to_fate({O, N, {unknown_type, _}}, Data) -> erlang_to_fate({O, N, {unknown_type, _}}, Data) ->
case N of warn_unknown_type(O, N, Data),
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}; {ok, Data};
erlang_to_fate({O, N, _}, Data) -> single_error({invalid, O, N, 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}) -> coerce_chain_object(_, _, _, _, {raw, Binary}) ->
{ok, Binary}; {ok, Binary};
coerce_chain_object(O, N, T, Tag, S) -> coerce_chain_object(O, N, T, Tag, S) ->
@@ -988,78 +991,78 @@ decode_chain_object(Tag, S) ->
error:incorrect_size -> {error, incorrect_size} error:incorrect_size -> {error, incorrect_size}
end. end.
coerce_bytes(O, N, _, Bytes) when bit_size(Bytes) rem 8 /= 0 -> check_bytes(O, N, _, Bytes) when bit_size(Bytes) rem 8 /= 0 ->
single_error({partial_bytes, O, N, bit_size(Bytes)}); single_error({partial_bytes, O, N, bit_size(Bytes)});
coerce_bytes(_, _, any, Bytes) -> check_bytes(_, _, any, _) ->
{ok, Bytes}; ok;
coerce_bytes(O, N, Count, Bytes) when byte_size(Bytes) /= Count -> check_bytes(O, N, Count, Bytes) when byte_size(Bytes) /= Count ->
single_error({incorrect_size, O, N, Bytes}); single_error({incorrect_size, O, N, Bytes});
coerce_bytes(_, _, _, Bytes) -> check_bytes(_, _, _, _) ->
{ok, Bytes}. ok.
coerce_zipped_bindings(Bindings, Direction, Tag) -> coerce_zipped_bindings(Bindings, Tag) ->
coerce_zipped_bindings(Bindings, Direction, Tag, [], []). coerce_zipped_bindings(Bindings, Tag, [], []).
coerce_zipped_bindings([Next | Rest], Direction, Tag, Good, Broken) -> coerce_zipped_bindings([Next | Rest], Tag, Good, Broken) ->
{{ArgName, Type}, Term} = Next, {{ArgName, Type}, Term} = Next,
case coerce_direction(Type, Term, Direction) of case erlang_to_fate(Type, Term) of
{ok, NewTerm} -> {ok, NewTerm} ->
coerce_zipped_bindings(Rest, Direction, Tag, [NewTerm | Good], Broken); coerce_zipped_bindings(Rest, Tag, [NewTerm | Good], Broken);
{error, Errors} -> {error, Errors} ->
Wrapped = wrap_errors({Tag, ArgName}, Errors), Wrapped = wrap_errors({Tag, ArgName}, Errors),
coerce_zipped_bindings(Rest, Direction, Tag, Good, [Wrapped | Broken]) coerce_zipped_bindings(Rest, Tag, Good, [Wrapped | Broken])
end; end;
coerce_zipped_bindings([], _, _, Good, []) -> coerce_zipped_bindings([], _, Good, []) ->
{ok, lists:reverse(Good)}; {ok, lists:reverse(Good)};
coerce_zipped_bindings([], _, _, _, Broken) -> coerce_zipped_bindings([], _, _, Broken) ->
{error, combine_errors(Broken)}. {error, combine_errors(Broken)}.
coerce_list(Type, Elements, Direction) -> coerce_list(Type, Elements) ->
% 0 index since it represents a sophia list % 0 index since it represents a sophia list
coerce_list(Type, Elements, Direction, 0, [], []). coerce_list(Type, Elements, 0, [], []).
coerce_list(Type, [Next | Rest], Direction, Index, Good, Broken) -> coerce_list(Type, [Next | Rest], Index, Good, Broken) ->
case coerce_direction(Type, Next, Direction) of case erlang_to_fate(Type, Next) of
{ok, Coerced} -> coerce_list(Type, Rest, Direction, Index + 1, [Coerced | Good], Broken); {ok, Coerced} -> coerce_list(Type, Rest, Index + 1, [Coerced | Good], Broken);
{error, Errors} -> {error, Errors} ->
Wrapped = wrap_errors({index, Index}, Errors), Wrapped = wrap_errors({index, Index}, Errors),
coerce_list(Type, Rest, Direction, Index + 1, Good, [Wrapped | Broken]) coerce_list(Type, Rest, Index + 1, Good, [Wrapped | Broken])
end; end;
coerce_list(_Type, [], _, _, Good, []) -> coerce_list(_Type, [], _, Good, []) ->
{ok, lists:reverse(Good)}; {ok, lists:reverse(Good)};
coerce_list(_, [], _, _, _, Broken) -> coerce_list(_, [], _, _, Broken) ->
{error, combine_errors(Broken)}. {error, combine_errors(Broken)}.
coerce_map(KeyType, ValType, Data, Direction) -> coerce_map(KeyType, ValType, Data) ->
coerce_map(KeyType, ValType, maps:iterator(Data), Direction, #{}, []). coerce_map(KeyType, ValType, maps:iterator(Data), #{}, []).
coerce_map(KeyType, ValType, Remaining, Direction, Good, Broken) -> coerce_map(KeyType, ValType, Remaining, Good, Broken) ->
case maps:next(Remaining) of case maps:next(Remaining) of
{K, V, RemainingAfter} -> {K, V, RemainingAfter} ->
coerce_map2(KeyType, ValType, RemainingAfter, Direction, Good, Broken, K, V); coerce_map2(KeyType, ValType, RemainingAfter, Good, Broken, K, V);
none -> none ->
coerce_map_finish(Good, Broken) coerce_map_finish(Good, Broken)
end. end.
coerce_map2(KeyType, ValType, Remaining, Direction, Good, Broken, K, V) -> coerce_map2(KeyType, ValType, Remaining, Good, Broken, K, V) ->
case coerce_direction(KeyType, K, Direction) of case erlang_to_fate(KeyType, K) of
{ok, KFATE} -> {ok, KFATE} ->
coerce_map3(KeyType, ValType, Remaining, Direction, Good, Broken, K, V, KFATE); coerce_map3(KeyType, ValType, Remaining, Good, Broken, K, V, KFATE);
{error, Errors} -> {error, Errors} ->
Wrapped = wrap_errors(map_key, Errors), Wrapped = wrap_errors(map_key, Errors),
% Continue as if the key coerced successfully, so that we can give % Continue as if the key coerced successfully, so that we can give
% errors for both the key and the value. % errors for both the key and the value.
coerce_map3(KeyType, ValType, Remaining, Direction, Good, [Wrapped | Broken], K, V, error) coerce_map3(KeyType, ValType, Remaining, Good, [Wrapped | Broken], K, V, error)
end. end.
coerce_map3(KeyType, ValType, Remaining, Direction, Good, Broken, K, V, KFATE) -> coerce_map3(KeyType, ValType, Remaining, Good, Broken, K, V, KFATE) ->
case coerce_direction(ValType, V, Direction) of case erlang_to_fate(ValType, V) of
{ok, VFATE} -> {ok, VFATE} ->
NewGood = Good#{KFATE => VFATE}, NewGood = Good#{KFATE => VFATE},
coerce_map(KeyType, ValType, Remaining, Direction, NewGood, Broken); coerce_map(KeyType, ValType, Remaining, NewGood, Broken);
{error, Errors} -> {error, Errors} ->
Wrapped = wrap_errors({map_value, K}, Errors), Wrapped = wrap_errors({map_value, K}, Errors),
coerce_map(KeyType, ValType, Remaining, Direction, Good, [Wrapped | Broken]) coerce_map(KeyType, ValType, Remaining, Good, [Wrapped | Broken])
end. end.
coerce_map_finish(Good, []) -> coerce_map_finish(Good, []) ->
@@ -1076,13 +1079,10 @@ lookup_variant(Name, [_ | Rest], Tag) ->
lookup_variant(_Name, [], _Tag) -> lookup_variant(_Name, [], _Tag) ->
not_found. not_found.
coerce_tuple(O, N, TermTypes, Terms, Direction) -> coerce_tuple(O, N, TermTypes, Terms) ->
case coerce_tuple_elements(TermTypes, Terms, Direction, tuple_element) of case coerce_elems_to_fate(TermTypes, Terms, tuple_element) of
{ok, Converted} -> {ok, Converted} ->
case Direction of {ok, {tuple, list_to_tuple(Converted)}};
to_fate -> {ok, {tuple, list_to_tuple(Converted)}};
from_fate -> {ok, list_to_tuple(Converted)}
end;
{error, too_few_terms} -> {error, too_few_terms} ->
single_error({tuple_too_few_terms, O, N, list_to_tuple(Terms)}); single_error({tuple_too_few_terms, O, N, list_to_tuple(Terms)});
{error, too_many_terms} -> {error, too_many_terms} ->
@@ -1090,19 +1090,14 @@ coerce_tuple(O, N, TermTypes, Terms, Direction) ->
Errors -> Errors Errors -> Errors
end. end.
coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms, Direction) -> coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms) ->
% FIXME: we could go through and add the variant tag to the adt_element % FIXME: we could go through and add the variant tag to the adt_element
% paths? % paths?
case coerce_tuple_elements(TermTypes, Terms, Direction, adt_element) of case coerce_elems_to_fate(TermTypes, Terms, adt_element) of
{ok, Converted} -> {ok, Converted} ->
case Direction of Arities = [length(VariantTerms)
to_fate -> || {_, VariantTerms} <- Variants],
Arities = [length(VariantTerms) {ok, {variant, Arities, Tag, list_to_tuple(Converted)}};
|| {_, VariantTerms} <- Variants],
{ok, {variant, Arities, Tag, list_to_tuple(Converted)}};
from_fate ->
{ok, list_to_tuple([Name | Converted])}
end;
{error, too_few_terms} -> {error, too_few_terms} ->
single_error({adt_too_few_terms, O, N, Name, TermTypes, Terms}); single_error({adt_too_few_terms, O, N, Name, TermTypes, Terms});
{error, too_many_terms} -> {error, too_many_terms} ->
@@ -1110,32 +1105,32 @@ coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms, Direction) ->
Errors -> Errors Errors -> Errors
end. end.
coerce_tuple_elements(Types, Terms, Direction, Tag) -> coerce_elems_to_fate(Types, Terms, Tag) ->
% The sophia standard library uses 0 indexing for lists, and fst/snd/thd % 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. % for tuples... Not sure how we should report errors in tuples, then.
coerce_tuple_elements(Types, Terms, Direction, Tag, 0, [], []). coerce_elems_to_fate(Types, Terms, Tag, 0, [], []).
coerce_tuple_elements([Type | Types], [Term | Terms], Direction, Tag, Index, Good, Broken) -> coerce_elems_to_fate([Type | Types], [Term | Terms], Tag, Index, Good, Broken) ->
case coerce_direction(Type, Term, Direction) of case erlang_to_fate(Type, Term) of
{ok, Value} -> {ok, Value} ->
coerce_tuple_elements(Types, Terms, Direction, Tag, Index + 1, [Value | Good], Broken); coerce_elems_to_fate(Types, Terms, Tag, Index + 1, [Value | Good], Broken);
{error, Errors} -> {error, Errors} ->
Wrapped = wrap_errors({Tag, Index}, Errors), Wrapped = wrap_errors({Tag, Index}, Errors),
coerce_tuple_elements(Types, Terms, Direction, Tag, Index + 1, Good, [Wrapped | Broken]) coerce_elems_to_fate(Types, Terms, Tag, Index + 1, Good, [Wrapped | Broken])
end; end;
coerce_tuple_elements([], [], _, _, _, Good, []) -> coerce_elems_to_fate([], [], _, _, Good, []) ->
{ok, lists:reverse(Good)}; {ok, lists:reverse(Good)};
coerce_tuple_elements([], [], _, _, _, _, Broken) -> coerce_elems_to_fate([], [], _, _, _, Broken) ->
{error, combine_errors(Broken)}; {error, combine_errors(Broken)};
coerce_tuple_elements(_, [], _, _, _, _, _) -> coerce_elems_to_fate(_, [], _, _, _, _) ->
{error, too_few_terms}; {error, too_few_terms};
coerce_tuple_elements([], _, _, _, _, _, _) -> coerce_elems_to_fate([], _, _, _, _, _) ->
{error, too_many_terms}. {error, too_many_terms}.
coerce_map_to_record(O, N, MemberTypes, Map) -> coerce_map_to_record(O, N, MemberTypes, Map) ->
case zip_record_fields(MemberTypes, Map) of case zip_record_fields(MemberTypes, Map) of
{ok, Zipped} -> {ok, Zipped} ->
case coerce_zipped_bindings(Zipped, to_fate, field) of case coerce_zipped_bindings(Zipped, field) of
{ok, [SingleElem]} -> {ok, [SingleElem]} ->
% Singleton records aren't implemented as FATE tuples at % Singleton records aren't implemented as FATE tuples at
% all. % all.
@@ -1152,31 +1147,6 @@ coerce_map_to_record(O, N, MemberTypes, Map) ->
single_error({unexpected_fields, O, N, Names}) single_error({unexpected_fields, O, N, Names})
end. 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) -> zip_record_fields(Fields, Map) ->
case lists:mapfoldl(fun zip_record_field/2, {Map, []}, Fields) of case lists:mapfoldl(fun zip_record_field/2, {Map, []}, Fields) of
{_, {_, Missing = [_|_]}} -> {_, {_, Missing = [_|_]}} ->
@@ -1217,20 +1187,10 @@ combine_errors(Broken) ->
%%% FATE to Erlang %%% FATE to Erlang
% Not sure if this is needed... fate_to_erlang shouldn't fail. -spec fate_to_erlang(Type, FATE) -> Erlang
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(), when Type :: annotated_type(),
FATE :: gmb_fate_data:fate_type(), FATE :: gmb_fate_data:fate_type(),
Erlang :: erlang_repr(), Erlang :: erlang_repr().
Errors :: [{Reason, [PathStep]}],
Reason :: term(),
PathStep :: term().
%% @doc %% @doc
%% Convert a FATE-flavored Erlang term into a Sophia-flavored Erlang term %% 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 %% Typically this is called by hakuzaru for you when decoding results from the
@@ -1240,83 +1200,81 @@ coerce_direction(Type, Term, from_fate) ->
%% information. %% information.
fate_to_erlang({_, _, integer}, S) when is_integer(S) -> fate_to_erlang({_, _, integer}, S) when is_integer(S) ->
{ok, S}; S;
fate_to_erlang({_, _, address}, {address, Bin}) -> fate_to_erlang({_, _, address}, {address, Bin}) ->
Address = gmser_api_encoder:encode(account_pubkey, Bin), Address = gmser_api_encoder:encode(account_pubkey, Bin),
{ok, unicode:characters_to_list(Address)}; unicode:characters_to_list(Address);
fate_to_erlang({_, _, contract}, {contract, Bin}) -> fate_to_erlang({_, _, contract}, {contract, Bin}) ->
Address = gmser_api_encoder:encode(contract_pubkey, Bin), Address = gmser_api_encoder:encode(contract_pubkey, Bin),
{ok, unicode:characters_to_list(Address)}; unicode:characters_to_list(Address);
fate_to_erlang({_, _, signature}, Bin) -> fate_to_erlang({_, _, signature}, Bin) ->
Address = gmser_api_encoder:encode(signature, Bin), Address = gmser_api_encoder:encode(signature, Bin),
{ok, unicode:characters_to_list(Address)}; unicode:characters_to_list(Address);
%fate_to_erlang({_, _, channel}, {channel, S}) when is_binary(S) -> %fate_to_erlang({_, _, channel}, {channel, S}) when is_binary(S) ->
%{ok, S}; %S;
fate_to_erlang({_, _, boolean}, true) -> fate_to_erlang({_, _, boolean}, true) ->
{ok, true}; true;
fate_to_erlang({_, _, boolean}, false) -> fate_to_erlang({_, _, boolean}, false) ->
{ok, false}; false;
fate_to_erlang({_, _, string}, Bin) -> fate_to_erlang({_, _, string}, Bin) ->
Str = binary_to_list(Bin), binary_to_list(Bin);
{ok, Str};
fate_to_erlang({_, _, char}, Val) -> fate_to_erlang({_, _, char}, Val) ->
{ok, Val}; Val;
fate_to_erlang({O, N, {bytes, [Count]}}, Bytes) when is_bitstring(Bytes) -> fate_to_erlang({O, N, {bytes, [Count]}}, {bytes, Bytes}) when is_bitstring(Bytes) ->
coerce_bytes(O, N, Count, Bytes); case check_bytes(O, N, Count, Bytes) of
ok -> Bytes;
{error, Reason} -> erlang:exit(Reason)
end;
fate_to_erlang({_, _, bits}, {bits, Num}) -> fate_to_erlang({_, _, bits}, {bits, Num}) ->
{ok, Num}; Num;
fate_to_erlang({_, _, {list, [Type]}}, Data) when is_list(Data) -> fate_to_erlang({_, _, {list, [Type]}}, Data) when is_list(Data) ->
coerce_list(Type, Data, from_fate); Each = fun(Elem) -> fate_to_erlang(Type, Elem) end,
lists:map(Each, Data);
fate_to_erlang({_, _, {map, [KeyType, ValType]}}, Data) when is_map(Data) -> fate_to_erlang({_, _, {map, [KeyType, ValType]}}, Data) when is_map(Data) ->
coerce_map(KeyType, ValType, Data, from_fate); coerce_map_to_erlang(KeyType, ValType, maps:iterator(Data), #{});
fate_to_erlang({O, N, {tuple, ElementTypes}}, {tuple, Data}) -> fate_to_erlang({_, _, {tuple, ElementTypes}}, {tuple, Data}) ->
ElementList = tuple_to_list(Data), ElementList = tuple_to_list(Data),
coerce_tuple(O, N, ElementTypes, ElementList, from_fate); Elems = coerce_elems_to_erlang(ElementTypes, ElementList),
fate_to_erlang({O, N, {variant, Variants}}, {variant, _, Tag, Tuple}) -> list_to_tuple(Elems);
fate_to_erlang({_, _, {variant, Variants}}, {variant, _, Tag, Tuple}) ->
Terms = tuple_to_list(Tuple), Terms = tuple_to_list(Tuple),
{Name, TermTypes} = lists:nth(Tag + 1, Variants), {Name, Types} = lists:nth(Tag + 1, Variants),
coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms, from_fate); Elems = coerce_elems_to_erlang(Types, Terms),
fate_to_erlang({O, N, {record, [SingleMemberType]}}, Data) -> list_to_tuple([Name | Elems]);
fate_to_erlang({_, _, {record, [SingleField]}}, Data) ->
% Singleton records aren't implemented as FATE tuples at all. % Singleton records aren't implemented as FATE tuples at all.
% Pretend they are, so we can get the full error indexing of the coerce_record_to_map([SingleField], [Data], #{});
% non-singletone case. fate_to_erlang({_, _, {record, MemberTypes}}, {tuple, Tuple}) ->
coerce_record_to_map(O, N, [SingleMemberType], {Data}); Terms = tuple_to_list(Tuple),
fate_to_erlang({O, N, {record, MemberTypes}}, {tuple, Tuple}) -> coerce_record_to_map(MemberTypes, Terms, #{});
coerce_record_to_map(O, N, MemberTypes, Tuple);
fate_to_erlang({O, N, {unknown_type, _}}, Data) -> fate_to_erlang({O, N, {unknown_type, _}}, Data) ->
case N of warn_unknown_type(O, N, Data),
already_normalized -> Data;
Message = "Warning: Unknown type ~p. Using term ~p as is.~n", fate_to_erlang({O, N, _}, Data) ->
io:format(Message, [O, Data]); erlang:exit({invalid, O, N, 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}.
type_to_iolist({O, already_normalized, S}) -> coerce_elems_to_erlang(Types, Elems) ->
% Already normalized. Example output: Zipped = lists:zip(Types, Elems),
% type {map, [string, integer]} Each = fun({Type, Elem}) -> fate_to_erlang(Type, Elem) end,
opaque_type_to_iolist(O, S); lists:map(Each, Zipped).
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)]).
opaque_type_to_iolist(N, {record, _}) -> coerce_record_to_map([{Name, Type} | Types], [Term | Terms], Acc) ->
% N is the name of a record definition. Coerced = fate_to_erlang(Type, Term),
io_lib:format("record type ~p", [N]); NewAcc = maps:put(Name, Coerced, Acc),
opaque_type_to_iolist(N, {variant, _}) -> coerce_record_to_map(Types, Terms, NewAcc);
% N is the name of a variant definition. coerce_record_to_map([], [], Acc) ->
io_lib:format("variant type ~p", [N]); Acc.
opaque_type_to_iolist(N, _) ->
% N is some other constructive type. coerce_map_to_erlang(KeyType, ValType, Iter, Acc) ->
io_lib:format("type ~p", [N]). 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.
@@ -1354,7 +1312,7 @@ check_erlang_to_fate(Type, Sophia, Fate) ->
end. end.
check_fate_to_erlang(Type, Fate, Sophia) -> check_fate_to_erlang(Type, Fate, Sophia) ->
{ok, SophiaActual} = fate_to_erlang(Type, Fate), SophiaActual = fate_to_erlang(Type, Fate),
% Now check that the results were what we expected. % Now check that the results were what we expected.
case SophiaActual of case SophiaActual of
Sophia -> Sophia ->
@@ -1452,7 +1410,7 @@ coerce_record_test() ->
coerce_bytes_test() -> coerce_bytes_test() ->
{ok, Type} = annotate_type({tuple, [{bytes, [4]}, {bytes, [any]}]}, #{}), {ok, Type} = annotate_type({tuple, [{bytes, [4]}, {bytes, [any]}]}, #{}),
check_roundtrip(Type, {<<"abcd">>, <<"efghi">>}, {tuple, {<<"abcd">>, <<"efghi">>}}). check_roundtrip(Type, {<<"abcd">>, <<"efghi">>}, {tuple, {{bytes, <<"abcd">>}, {bytes, <<"efghi">>}}}).
coerce_bits_test() -> coerce_bits_test() ->
{ok, Type} = annotate_type(bits, #{}), {ok, Type} = annotate_type(bits, #{}),
@@ -1471,7 +1429,7 @@ coerce_unicode_test() ->
coerce_hash_test() -> coerce_hash_test() ->
{ok, Type} = annotate_type("hash", builtin_typedefs()), {ok, Type} = annotate_type("hash", builtin_typedefs()),
Hash = list_to_binary(lists:seq(1,32)), Hash = list_to_binary(lists:seq(1,32)),
check_roundtrip(Type, Hash, Hash), check_roundtrip(Type, Hash, {bytes, Hash}),
ok. ok.
@@ -1519,10 +1477,7 @@ singleton_record_substitution_test() ->
{ok, {[], GOutput}} = get_function_signature(AACI, "g"), {ok, {[], GOutput}} = get_function_signature(AACI, "g"),
check_roundtrip(GOutput, #{"it" => #{"it" => 123}}, 123), check_roundtrip(GOutput, #{"it" => #{"it" => 123}}, 123),
{ok, {[], HOutput}} = get_function_signature(AACI, "h"), {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() -> tuple_substitution_test() ->
Contract = " Contract = "
src/hz_key_master.erl
+28 -238
View File
@@ -1,43 +1,17 @@
%%% @doc %%% @doc
%%% Hakuzaru Key Functions %%% Key functions
%%% %%%
%%% The Gajumaru's default key type is based on Elliptical Curve Cryptography (ECC). %%% The main reason this is a module of its own is that in the original architecture
%%% The specific curve used is 25519, and the typical key representation is Ed25519. %%% 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
%%% The "Ed" in "Ed25519" stands for Harold Edwards. This form represents %%% code.
%%% 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 %%% @end
-module(hz_key_master). -module(hz_key_master).
-vsn("0.9.2"). -vsn("0.9.2").
-export([make_key/0, make_key/1, encode/1, decode/1]). -export([make_key/1, encode/1, decode/1]).
-export([shared_secret_a/6, shared_secret_b/6, -export([lcg/1]).
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(<<>>) -> make_key(<<>>) ->
Pair = #{public := Public} = ecu_eddsa:sign_keypair(), Pair = #{public := Public} = ecu_eddsa:sign_keypair(),
@@ -151,212 +125,28 @@ sumcheck(Width, Bits) ->
end. end.
-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(), -spec lcg(integer()) -> integer().
B_P_E_PK :: <<_:32*8>>, %% A simple PRNG that fits into 32 bits and is easy to implement anywhere (Kotlin).
B_E_E_PK :: <<_:32*8>>, %% Specifically, it is a "linear congruential generator" of the Lehmer variety.
Protocol :: binary(), %% The constants used are based on recommendations from Park, Miller and Stockmeyer:
Version :: binary(), %% https://www.firstpr.com.au/dsp/rand31/p105-crawford.pdf#page=4
Salt :: binary(),
SS :: <<_:32*8>>.
%% @doc
%% Alice'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 %% The input value should be between 1 and 2^31-1.
%% 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>
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 %% The purpose of this PRNG is for password-based dictionary shuffling.
%% 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) -> lcg(N) ->
B_P_X_SK = ed25519_sk_to_x25519(B_P_E_SK), M = 16#7FFFFFFF,
B_E_X_SK = ed25519_sk_to_x25519(B_E_E_SK), A = 48271,
A_E_X_PK = ed25519_pk_to_x25519(A_E_E_PK), Q = 44488, % M div A
DH_Permanent = crypto:compute_key(ecdh, A_E_X_PK, B_P_X_SK, x25519), R = 3399, % M rem A
DH_Ephemeral = crypto:compute_key(ecdh, A_E_X_PK, B_E_X_SK, x25519), Div = N div Q,
finalize_hkdf(DH_Permanent, DH_Ephemeral, Protocol, Version, Salt). Rem = N rem Q,
S = Rem * A,
finalize_hkdf(DH_Permanent, DH_Ephemeral, Protocol, Version, Salt) -> T = Div * R,
MixedInput = <<DH_Permanent/binary, DH_Ephemeral/binary>>, Result = S - T,
Info = <<Protocol/binary, ":", Version/binary, ":">>, case Result < 0 of
hkdf(sha256, MixedInput, Salt, Info). false -> Result;
true -> Result + M
%% 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. 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
+173 -34
View File
@@ -343,6 +343,12 @@ parse_expression2(_, _, _, Token) ->
unknown_type() -> unknown_type() ->
{unknown_type, already_normalized, 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) -> expect_tokens([], Pos, String) ->
{ok, {Pos, String}}; {ok, {Pos, String}};
expect_tokens([Str | Rest], Pos, String) -> expect_tokens([Str | Rest], Pos, String) ->
@@ -377,11 +383,14 @@ parse_alphanum(Type, Pos, String, ["Bits", "all"], Row, Start, End) ->
typecheck_bits(Type, Pos, String, -1, Row, Start, End); typecheck_bits(Type, Pos, String, -1, Row, Start, End);
parse_alphanum(Type, Pos, String, ["Bits", "none"], Row, Start, End) -> parse_alphanum(Type, Pos, String, ["Bits", "none"], Row, Start, End) ->
typecheck_bits(Type, Pos, String, 0, 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) -> 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 % 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. % an alphanum token can really only be a constructor, or a chain object.
% Constructors start with uppercase characters, so lowercase can only be a % Constructors start with uppercase characters, and we have handled our
% chain object. % made-up 'variant' case explicitly, so the only other lowercase constants
% are serialized chain objects.
try try
case gmser_api_encoder:decode(unicode:characters_to_binary(S)) of case gmser_api_encoder:decode(unicode:characters_to_binary(S)) of
{account_pubkey, Data} -> {account_pubkey, Data} ->
@@ -400,8 +409,8 @@ parse_alphanum(Type, Pos, String, [[C | _] = S], Row, Start, End) when ?IS_LATIN
_:_ -> {error, {unexpected_identifier, S, Row, Start, End}} _:_ -> {error, {unexpected_identifier, S, Row, Start, End}}
end; end;
parse_alphanum(Type, Pos, String, Path, Row, Start, End) -> parse_alphanum(Type, Pos, String, Path, Row, Start, End) ->
% Inversely, chain object prefixes are always lowercase, so any other path % Now having handled all lowercase terms, anything else must be uppercase,
% must be a variant constructor, or invalid. % which is either a variant constructor, or totally invalid.
parse_variant(Type, Pos, String, Path, Row, Start, End). parse_variant(Type, Pos, String, Path, Row, Start, End).
typecheck_integer({_, _, integer}, Pos, String, Value, _, _, _) -> typecheck_integer({_, _, integer}, Pos, String, Value, _, _, _) ->
@@ -731,6 +740,12 @@ parse_variant({O, N, {variant, Variants}}, Pos, String, [Namespace, Constructor]
_ -> _ ->
{error, {invalid_constructor, O, N, Namespace ++ "." ++ Constructor, Row, Start, End}} {error, {invalid_constructor, O, N, Namespace ++ "." ++ Constructor, Row, Start, End}}
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) -> parse_variant({_, _, unknown_type}, _, _, _, Row, Start, End) ->
{error, {unresolved_variant, Row, Start, End}}; {error, {unresolved_variant, Row, Start, End}};
parse_variant({O, N, _}, _, _, _, Row, Start, End) -> parse_variant({O, N, _}, _, _, _, Row, Start, End) ->
@@ -753,8 +768,7 @@ get_typename(Name) ->
parse_variant2(O, N, Variants, Pos, String, Prefix, Constructor, Row, Start, End) -> parse_variant2(O, N, Variants, Pos, String, Prefix, Constructor, Row, Start, End) ->
case lookup_variant(Constructor, Variants, 0) of case lookup_variant(Constructor, Variants, 0) of
{ok, {Tag, ElemTypes}} -> {ok, {Tag, ElemTypes}} ->
GetArity = fun({_, OtherElemTypes}) -> length(OtherElemTypes) end, Arities = get_arities(Variants),
Arities = lists:map(GetArity, Variants),
parse_variant3(Arities, Tag, ElemTypes, Pos, String); parse_variant3(Arities, Tag, ElemTypes, Pos, String);
error -> error ->
{error, {invalid_constructor, O, N, Prefix ++ Constructor, Row, Start, End}} {error, {invalid_constructor, O, N, Prefix ++ Constructor, Row, Start, End}}
@@ -790,6 +804,112 @@ lookup_variant(Ident, [{Ident, ElemTypes} | _], Tag) ->
lookup_variant(Ident, [_ | Rest], Tag) -> lookup_variant(Ident, [_ | Rest], Tag) ->
lookup_variant(Ident, Rest, Tag + 1). 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 %%% Record parsing
parse_record_or_map({_, _, {map, [KeyType, ValueType]}}, Pos, String, _, _) -> parse_record_or_map({_, _, {map, [KeyType, ValueType]}}, Pos, String, _, _) ->
@@ -1027,15 +1147,12 @@ fate_to_iolist(Type, {tuple, Tuple}) ->
_ -> _ ->
tuple_to_iolist([], Tuple) tuple_to_iolist([], Tuple)
end; end;
fate_to_iolist(Type, {variant, _, Tag, Tuple}) -> fate_to_iolist(Type, {variant, Arities, Tag, Tuple}) ->
case Type of case Type of
{O, N, {variant, VariantTypes}} when Tag < length(VariantTypes) -> {O, N, {variant, VariantTypes}} when Tag < length(VariantTypes) ->
variant_to_iolist(O, N, VariantTypes, Tag, Tuple); variant_to_iolist(O, N, VariantTypes, Tag, Tuple);
{O, N, _} -> {_, _, _} ->
% TODO: Make up a special syntax for anonymous variant terms. anonymous_variant_to_iolist(Arities, Tag, Tuple)
erlang:exit({untyped_variant, O, N});
_ ->
erlang:exit({untyped_variant, unknown_type, already_normalized})
end; end;
fate_to_iolist(Type, List) when is_list(List) -> fate_to_iolist(Type, List) when is_list(List) ->
case Type of case Type of
@@ -1130,6 +1247,22 @@ choose_variant_prefix(O, N) ->
[] []
end. 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]) -> multivalue_to_iolist([FirstType | ElemTypes], [FirstTerm | Elems]) ->
FirstTermChars = fate_to_iolist(FirstType, FirstTerm), FirstTermChars = fate_to_iolist(FirstType, FirstTerm),
multivalue_to_iolist(ElemTypes, Elems, FirstTermChars); multivalue_to_iolist(ElemTypes, Elems, FirstTermChars);
@@ -1282,16 +1415,18 @@ check_parser_roundtrip(Sophia) ->
% syntax. Let's do a lenient test. % syntax. Let's do a lenient test.
roundtrip_parser_lenient(unknown_type(), Sophia, Fate). roundtrip_parser_lenient(unknown_type(), Sophia, Fate).
check_parser_with_typedef(Typedef, Sophia) -> check_parser_with_typedef(Typedef, Sophia, UntypedSophia) ->
% Compile the type definitions alongside the usual literal expression. % Compile the type definitions alongside the usual literal expression.
Source = "contract C =\n " ++ Typedef ++ "\n entrypoint f() = " ++ Sophia, Source = "contract C =\n " ++ Typedef ++ "\n entrypoint f() = " ++ Sophia,
{Fate, Type} = compile_entrypoint_value_and_type(Source, "f"), {Fate, Type} = compile_entrypoint_value_and_type(Source, "f"),
% Do a typed parse, as usual, but there are probably record/variant % Do a typed parse, as usual. Variant namespaces can make pretty printing
% definitions in the AACI, so untyped parses probably don't work, and % ambiguous, so make the roundtrip lenient.
% variants often have optional namespaces, so the sophia result might not roundtrip_parser_lenient(Type, Sophia, Fate),
% match exactly, but should still be equivalent. % Do an untyped parse, but using a second special Sophia expression that
roundtrip_parser_lenient(Type, Sophia, Fate). % 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).
anon_types_test() -> anon_types_test() ->
% Integers. % Integers.
@@ -1323,6 +1458,10 @@ anon_types_test() ->
check_parser_roundtrip("(1, [2, 3], (4, 5))"), check_parser_roundtrip("(1, [2, 3], (4, 5))"),
% Map. % Map.
check_parser_roundtrip("{[1] = 2, [3] = 4}"), 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. ok.
@@ -1342,7 +1481,7 @@ string_escape_codes_test() ->
records_test() -> records_test() ->
TypeDef = "record pair = {x: int, y: int}", TypeDef = "record pair = {x: int, y: int}",
Sophia = "{x = 1, y = 2}", Sophia = "{x = 1, y = 2}",
check_parser_with_typedef(TypeDef, Sophia), check_parser_with_typedef(TypeDef, Sophia, "(1, 2)"),
% The above won't run an untyped parse on the expression, but we can. It % The above won't run an untyped parse on the expression, but we can. It
% will error, though. % will error, though.
{error, {unresolved_record, _, _, _}} = parse_literal(unknown_type(), Sophia). {error, {unresolved_record, _, _, _}} = parse_literal(unknown_type(), Sophia).
@@ -1350,11 +1489,11 @@ records_test() ->
variant_test() -> variant_test() ->
TypeDef = "datatype multi('a) = Zero | One('a) | Two('a, 'a)", TypeDef = "datatype multi('a) = Zero | One('a) | Two('a, 'a)",
check_parser_with_typedef(TypeDef, "Zero"), check_parser_with_typedef(TypeDef, "Zero", "variant([0, 1, 2], 0)"),
check_parser_with_typedef(TypeDef, "One(0)"), check_parser_with_typedef(TypeDef, "One(0)", "variant([0, 1, 2], 1, 0)"),
check_parser_with_typedef(TypeDef, "Two(0, 1)"), check_parser_with_typedef(TypeDef, "Two(0, 1)", "variant([0, 1, 2], 2, 0, 1)"),
check_parser_with_typedef(TypeDef, "Two([], [1, 2, 3])"), check_parser_with_typedef(TypeDef, "Two([], [1, 2, 3])", "variant([0, 1, 2], 2, [], [1, 2, 3])"),
check_parser_with_typedef(TypeDef, "C.Zero"), check_parser_with_typedef(TypeDef, "C.Zero", "variant([0, 1, 2], 0)"),
{error, {unresolved_variant, _, _, _}} = parse_literal(unknown_type(), "Zero"), {error, {unresolved_variant, _, _, _}} = parse_literal(unknown_type(), "Zero"),
@@ -1362,10 +1501,10 @@ variant_test() ->
ambiguous_variant_test() -> ambiguous_variant_test() ->
TypeDef = "datatype mytype = C | D", TypeDef = "datatype mytype = C | D",
check_parser_with_typedef(TypeDef, "C"), check_parser_with_typedef(TypeDef, "C", "variant([0, 0], 0)"),
check_parser_with_typedef(TypeDef, "D"), check_parser_with_typedef(TypeDef, "D", "variant([0, 0], 1)"),
check_parser_with_typedef(TypeDef, "C.C"), check_parser_with_typedef(TypeDef, "C.C", "variant([0, 0], 0)"),
check_parser_with_typedef(TypeDef, "C.D"), check_parser_with_typedef(TypeDef, "C.D", "variant([0, 0], 1)"),
ok. ok.
@@ -1410,9 +1549,9 @@ bits_test() ->
singleton_records_test() -> singleton_records_test() ->
TypeDef = "record singleton('a) = {it: 'a}", TypeDef = "record singleton('a) = {it: 'a}",
check_parser_with_typedef(TypeDef, "{it = 123}"), check_parser_with_typedef(TypeDef, "{it = 123}", "123"),
check_parser_with_typedef(TypeDef, "{it = {it = {it = 5}}}"), check_parser_with_typedef(TypeDef, "{it = {it = {it = 5}}}", "5"),
check_parser_with_typedef(TypeDef, "[{it = 1}, {it = 2}, {it = 3}]"), check_parser_with_typedef(TypeDef, "[{it = 1}, {it = 2}, {it = 3}]", "[1, 2, 3]"),
ok. ok.
@@ -1421,9 +1560,9 @@ singleton_variants_test() ->
% actually a special case; singleton variants are in fact wrapped in the % actually a special case; singleton variants are in fact wrapped in the
% FATE too. % FATE too.
TypeDef = "datatype wrapped('a) = Wrap('a)", TypeDef = "datatype wrapped('a) = Wrap('a)",
check_parser_with_typedef(TypeDef, "Wrap(123)"), check_parser_with_typedef(TypeDef, "Wrap(123)", "variant([1], 0, 123)"),
check_parser_with_typedef(TypeDef, "Wrap(Wrap(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)]"), check_parser_with_typedef(TypeDef, "[Wrap(1), Wrap(2), Wrap(3)]", "[variant([1], 0, 1), variant([1], 0, 2), variant([1], 0, 3)]"),
ok. ok.