diff --git a/bindings/erlang/src/vanillae.erl b/bindings/erlang/src/vanillae.erl index f7247bd..da1e308 100644 --- a/bindings/erlang/src/vanillae.erl +++ b/bindings/erlang/src/vanillae.erl @@ -1276,69 +1276,462 @@ prepare_contract(File) -> end. prepare_aaci(ACI) -> + % NOTE this will also pick up the main contract; as a result the main + % contract extraction later on shouldn't bother with typedefs. + Contracts = [{N, T} || #{contract := #{name := N, + typedefs := T}} <- ACI], + Types = simplify_contract_types(Contracts, #{}), + [{NameBin, SpecDefs}] = [{N, F} || #{contract := #{kind := contract_main, functions := F, name := N}} <- ACI], Name = binary_to_list(NameBin), - Specs = lists:foldl(fun simplify_specs/2, #{}, SpecDefs), - {aaci, Name, Specs}. + Specs = simplify_specs(SpecDefs, #{}, Types), + {aaci, Name, Specs, Types}. -simplify_specs(#{name := NameBin, arguments := ArgDefs}, Specs) -> +simplify_contract_types([], Types) -> Types; +simplify_contract_types([{NameBin, TypeDefs} | Rest], Types) -> Name = binary_to_list(NameBin), - ArgTypes = lists:map(fun simplify_args/1, ArgDefs), - maps:put(Name, ArgTypes, Specs). + Types2 = maps:put(Name, {[], contract}, Types), + Types3 = simplify_typedefs(TypeDefs, Types2, Name ++ "."), + simplify_contract_types(Rest, Types3). -simplify_args(#{name := NameBin, type := TypeBin}) -> +simplify_typedefs([], Types, _NamePrefix) -> Types; +simplify_typedefs([Next | Rest], Types, NamePrefix) -> + #{name := NameBin, vars := ParamDefs, typedef := T} = Next, + Name = NamePrefix ++ binary_to_list(NameBin), + Params = [binary_to_list(Param) || #{name := Param} <- ParamDefs], + Type = opaque_type(Params, T), + NewTypes = maps:put(Name, {Params, Type}, Types), + simplify_typedefs(Rest, NewTypes, NamePrefix). + +simplify_specs([], Specs, _Types) -> Specs; +simplify_specs([#{name := NameBin, arguments := ArgDefs} | Rest], Specs, Types) -> Name = binary_to_list(NameBin), - Type = type(TypeBin), + ArgTypes = [simplify_args(Arg, Types) || Arg <- ArgDefs], + NewSpecs = maps:put(Name, ArgTypes, Specs), + simplify_specs(Rest, NewSpecs, Types). + +simplify_args(#{name := NameBin, type := TypeDef}, Types) -> + Name = binary_to_list(NameBin), + % FIXME We should make this error more informative, and continue + % propogating it up, so that the user can provide their own ACI and find + % out whether it worked or not. At that point ACI -> AACI could almost be a + % module or package of its own. + {ok, Type} = type(TypeDef, Types), {Name, Type}. -type(<<"int">>) -> integer; -type(<<"address">>) -> address; -type(<<"contract">>) -> contract; -type(<<"bool">>) -> boolean; -type(Name) -> binary_to_list(Name). -%type(#{<<"list">> := T}) -> {list, type(T)}; -%type(#{<<"tuple">> := T}) -> {tuple, type(T)}; -%type(#{<<"map">> := {K, V}} -> {map, type(K), type(V)}; -%type(<<"string">>) -> string; +% Type preparation has two goals. First, we need a data structure that can be +% traversed quickly, to take sophia-esque erlang expressions and turn them into +% fate-esque erlang expressions that aebytecode can serialize. Second, we need +% partially substituted names, so that error messages can be generated for why +% "foobar" is not valid as the third field of a `bazquux`, because the third +% field is supposed to be `option(integer)`, not `string`. +% +% To achieve this we need three representations of each type expression, which +% together form an 'annotated type'. First, we need the fully opaque name, +% "bazquux", then we need the normalized name, which is an opaque name with the +% bare-minimum substitution needed to make the outer-most type-constructor an +% identifiable built-in, ADT, or record type, and then we need the flattened +% type, which is the raw {variant, [{Name, Fields}, ...]} or +% {record, [{Name, Type}]} expression that can be used in actual Sophia->FATE +% coercion. The type sub-expressions in these flattened types will each be +% fully annotated as well, i.e. they will each contain *all three* of the above +% representations, so that coercion of subexpressions remains fast AND +% informative. +% +% In a lot of cases the opaque type given will already be normalized, in which +% case either the normalized field or the non-normalized field of an annotated +% type can simple be the atom `already_normalized`, which means error messages +% can simply render the normalized type expression and know that the error will +% make sense. -coerce({{ArgName, integer}, S}, {Good, Broken}) -> - try - N = list_to_integer(S), - {[N | Good], Broken} - catch - error:Reason -> {Good, [{ArgName, Reason} | Broken]} +type(T, Types) -> + O = opaque_type([], T), + flatten_opaque_type(O, Types). + +opaque_type(Params, NameBin) when is_binary(NameBin) -> + Name = opaque_type_name(NameBin), + case not is_atom(Name) and lists:member(Name, Params) of + false -> Name; + true -> {var, Name} end; -coerce({{ArgName, address}, S}, {Good, Broken}) -> +opaque_type(Params, #{record := FieldDefs}) -> + Fields = [{binary_to_list(Name), opaque_type(Params, Type)} + || #{name := Name, type := Type} <- FieldDefs], + {record, Fields}; +opaque_type(Params, #{variant := VariantDefs}) -> + 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}) -> + {tuple, [opaque_type(Params, Type) || Type <- TypeDefs]}; +opaque_type(Params, Pair) when is_map(Pair) -> + [{Name, TypeArgs}] = maps:to_list(Pair), + {opaque_type_name(Name), [opaque_type(Params, Arg) || Arg <- TypeArgs]}. + +% atoms for builtins, lists for user defined types +opaque_type_name(<<"int">>) -> integer; +opaque_type_name(<<"address">>) -> address; +opaque_type_name(<<"contract">>) -> contract; +opaque_type_name(<<"bool">>) -> boolean; +opaque_type_name(<<"option">>) -> option; +opaque_type_name(<<"list">>) -> list; +opaque_type_name(<<"map">>) -> map; +opaque_type_name(<<"string">>) -> string; +opaque_type_name(Name) -> binary_to_list(Name). + +flatten_opaque_type(T, Types) -> + case normalize_opaque_type(T, Types) of + {ok, AlreadyNormalized, NOpaque, NExpanded} -> + flatten_opaque_type2(T, AlreadyNormalized, NOpaque, NExpanded, + Types); + Error -> Error + end. + +flatten_opaque_type2(T, AlreadyNormalized, NOpaque, NExpanded, Types) -> + case flatten_normalized_type(NExpanded, Types) of + {ok, Flat} -> + case AlreadyNormalized of + true -> {ok, {T, already_normalized, Flat}}; + false -> {ok, {T, NOpaque, Flat}} + end; + Error -> Error + end. + +flatten_opaque_types([T | Rest], Types, Acc) -> + case flatten_opaque_type(T, Types) of + {ok, Type} -> flatten_opaque_types(Rest, Types, [Type | Acc]); + Error -> Error + end; +flatten_opaque_types([], _Types, Acc) -> + {ok, lists:reverse(Acc)}. + +flatten_opaque_bindings([{Name, T} | Rest], Types, Acc) -> + case flatten_opaque_type(T, Types) of + {ok, Type} -> flatten_opaque_bindings(Rest, Types, [{Name, Type} | Acc]); + Error -> Error + end; +flatten_opaque_bindings([], _Types, Acc) -> + {ok, lists:reverse(Acc)}. + +flatten_opaque_variants([{Name, Elems} | Rest], Types, Acc) -> + case flatten_opaque_types(Elems, Types, []) of + {ok, ElemsFlat} -> + flatten_opaque_variants(Rest, Types, [{Name, ElemsFlat} | Acc]); + Error -> Error + end; +flatten_opaque_variants([], _Types, Acc) -> + {ok, lists:reverse(Acc)}. + +flatten_normalized_type(PrimitiveType, _Types) when is_atom(PrimitiveType) -> + {ok, PrimitiveType}; +flatten_normalized_type({variant, VariantsOpaque}, Types) -> + case flatten_opaque_variants(VariantsOpaque, Types, []) of + {ok, Variants} -> {ok, {variant, Variants}}; + Error -> Error + end; +flatten_normalized_type({record, FieldsOpaque}, Types) -> + case flatten_opaque_bindings(FieldsOpaque, Types, []) of + {ok, Fields} -> {ok, {record, Fields}}; + Error -> Error + end; +flatten_normalized_type({T, ElemsOpaque}, Types) -> + case flatten_opaque_types(ElemsOpaque, Types, []) of + {ok, Elems} -> {ok, {T, Elems}}; + Error -> Error + end. + +normalize_opaque_type(T, Types) -> + case type_is_expanded(T) of + false -> normalize_opaque_type(T, Types, true); + true -> {ok, true, T, T} + end. + +% FIXME detect infinite loops +% FIXME detect builtins with the wrong number of arguments +% FIXME should nullary types have an empty list of arguments added before now? +normalize_opaque_type({option, [T]}, _Types, IsFirst) -> + % Just like user-made ADTs, 'option' is considered part of the type, and so + % options are considered normalised. + {ok, IsFirst, {option, [T]}, {variant, [{"None", []}, {"Some", [T]}]}}; +normalize_opaque_type(T, Types, IsFirst) when is_list(T) -> + normalize_opaque_type({T, []}, Types, IsFirst); +normalize_opaque_type({T, TypeArgs}, Types, IsFirst) when is_list(T) -> + case maps:get(T, Types, not_found) of + %{error, invalid_aci}; % FIXME more info + % FIXME We don't understand lookups from other scopes, so we can't + % really prove that the user is wrong, so just assume it is a type that + % we don't understand. + not_found -> {ok, IsFirst, {T, TypeArgs}, {unknown_type, TypeArgs}}; + {TypeParamNames, Definition} -> + Bindings = lists:zip(TypeParamNames, TypeArgs), + normalize_opaque_type2(T, TypeArgs, Types, IsFirst, Bindings, Definition) + end. + +normalize_opaque_type2(T, TypeArgs, Types, IsFirst, Bindings, Definition) -> + SubResult = case Bindings of + [] -> {ok, Definition}; + _ -> substitute_opaque_type(Bindings, Definition) + end, + case SubResult of + % Type names were already normalized if they were ADTs or records, + % since for those connectives the name is considered part of the type. + {ok, NextT = {variant, _}} -> {ok, IsFirst, {T, TypeArgs}, NextT}; + {ok, NextT = {record, _}} -> {ok, IsFirst, {T, TypeArgs}, NextT}; + % Everything else has to be substituted down to a built-in connective + % to be considered normalized. + {ok, NextT} -> normalize_opaque_type3(NextT, Types); + Error -> Error + end. + +% while this does look like normalize_opaque_type/2, it sets IsFirst to false +% instead of true, and is part of the loop, instead of being an initial +% condition for the loop. +normalize_opaque_type3(NextT, Types) -> + case type_is_expanded(NextT) of + false -> normalize_opaque_type(NextT, Types, false); + true -> {ok, false, NextT, NextT} + end. + +% Strings indicate names that should be substituted. Atoms indicate built in +% types, which don't need to be expanded, except for option. +type_is_expanded({option, _}) -> false; +type_is_expanded(X) when is_atom(X) -> true; +type_is_expanded({X, _}) when is_atom(X) -> true; +type_is_expanded(_) -> false. + +% Skip traversal if there is nothing to substitute. This will often be the +% most common case. +substitute_opaque_type(Bindings, {var, VarName}) -> + case lists:keyfind(VarName, 1, Bindings) of + false -> {error, invalid_aci}; + {_, TypeArg} -> {ok, TypeArg} + end; +substitute_opaque_type(Bindings, {Connective, Args}) -> + case substitute_opaque_types(Bindings, Args, []) of + {ok, Result} -> {ok, {Connective, Result}}; + Error -> Error + end; +substitute_opaque_type(_Bindings, Type) -> {ok, Type}. + +substitute_opaque_types(Bindings, [Next | Rest], Acc) -> + case substitute_opaque_type(Bindings, Next) of + {ok, Result} -> substitute_opaque_types(Bindings, Rest, [Result | Acc]); + Error -> Error + end; +substitute_opaque_types(_Bindings, [], Acc) -> + {ok, lists:reverse(Acc)}. + +coerce_bindings(VarTypes, Terms) -> + DefLength = length(VarTypes), + ArgLength = length(Terms), + if + DefLength =:= ArgLength -> coerce_zipped_bindings(lists:zip(VarTypes, Terms)); + DefLength > ArgLength -> {error, too_few_args}; + DefLength < ArgLength -> {error, too_many_args} + end. + +coerce_zipped_bindings(Bindings) -> + case lists:foldl(fun coerce_step/2, {[], []}, Bindings) of + {Coerced, []} -> + {ok, lists:reverse(Coerced)}; + {_, Errors} -> + {error, {args, lists:reverse(Errors)}} + end. + +coerce_step({{ArgName, AnnotatedType}, Term}, {Good, Broken}) -> + case coerce(AnnotatedType, Term) of + {ok, FATETerm} -> {[FATETerm | Good], Broken}; + {error, Error} -> {Good, [{ArgName, Error} | Broken]} + end. + +coerce({_, _, integer}, S) when is_integer(S) -> + {ok, S}; +coerce({O, N, integer}, S) when is_list(S) -> + try + Val = list_to_integer(S), + {ok, Val} + catch + error:badarg -> {error, {invalid, O, N, S}} + end; +coerce({O, N, address}, S) -> try case aeser_api_encoder:decode(unicode:characters_to_binary(S)) of - {account_pubkey, Key} -> {[{address, Key} | Good], Broken}; - _ -> {Good, [{ArgName, bad_pubkey} | Broken]} + {account_pubkey, Key} -> {ok, {address, Key}}; + _ -> {error, bad_pubkey} end catch - error:Reason -> {Good, [{ArgName, Reason} | Broken]} + error:_ -> {error, {invalid, O, N, S}} end; -coerce({{ArgName, contract}, S}, {Good, Broken}) -> +coerce({O, N, contract}, S) -> try case aeser_api_encoder:decode(unicode:characters_to_binary(S)) of - R = {contract_bytearray, _} -> {[R | Good], Broken}; - _ -> {Good, [{ArgName, bad_contract} | Broken]} + {contract_pubkey, Key} -> {ok, {contract, Key}}; + _ -> {error, bad_contract} end catch - error:Reason -> {Good, [{ArgName, Reason} | Broken]} + error:_ -> {error, {invalid, O, N, S}} end; -coerce({{_, bool}, true}, {Good, Broken}) -> - {[true | Good], Broken}; -coerce({{_, bool}, false}, {Good, Broken}) -> - {[false | Good], Broken}; -coerce({{ArgName, bool}, _}, {Good, Broken}) -> - {Good, [{ArgName, not_bool} | Broken]}; -coerce({_, S}, {Good, Broken}) -> - {[S | Good], Broken}. +coerce({_, _, boolean}, true) -> + {ok, true}; +coerce({_, _, boolean}, false) -> + {ok, false}; +coerce({_, _, boolean}, _) -> + {error, not_bool}; +coerce({O, N, string}, Str) -> + case unicode:characters_to_binary(Str) of + {error, _, _} -> + {error, invalid_string, O, N, Str}; + {incomplete, _, _} -> + {error, invalid_string, O, N, Str}; + StrBin -> + {ok, StrBin} + end; +coerce({_, _, {list, [Type]}}, Data) when is_list(Data) -> + coerce_list(Type, Data, []); +coerce({_, _, {map, [KeyType, ValType]}}, Data) when is_map(Data) -> + coerce_map(KeyType, ValType, maps:iterator(Data), #{}); +coerce({O, N, {tuple, ElementTypes}}, Data) when is_tuple(Data) -> + ElementList = tuple_to_list(Data), + coerce_tuple(O, N, ElementTypes, ElementList); +coerce({O, N, {variant, Variants}}, Data) when is_tuple(Data), tuple_size(Data) > 0 -> + [Name | Fields] = tuple_to_list(Data), + case lookup_variant(Name, Variants) of + {Tag, FieldTypes} -> + coerce_variant2(O, N, Variants, Name, Tag, FieldTypes, Fields); + not_found -> + ValidNames = [Valid || {Valid, _} <- Variants], + {error, {adt_invalid, O, N, Name, ValidNames}} + end; +coerce({O, N, {variant, Variants}}, Name) when is_list(Name) -> + coerce({O, N, {variant, Variants}}, {Name}); +coerce({O, N, {record, Fields}}, Map) when is_map(Map) -> + coerce_map_to_record(O, N, Fields, Map); +coerce({O, N, {unknown_type, _}}, Data) -> + case N of + already_normalized -> + io:format("Warning: Unknown type ~p. Using term ~p as is.~n", [O, Data]); + _ -> + io:format("Warning: Unknown type ~p (i.e. ~p). Using term ~p as is.~n", [O, N, Data]) + end, + {ok, Data}; +coerce({O, N, _}, Data) -> {error, {invalid, O, N, Data}}. +coerce_list(Type, [Next | Rest], Acc) -> + case coerce(Type, Next) of + {ok, Coerced} -> coerce_list(Type, Rest, [Coerced | Acc]); + Error -> Error + end; +coerce_list(_Type, [], Acc) -> + {ok, lists:reverse(Acc)}. + +coerce_map(KeyType, ValType, Remaining, Acc) -> + case maps:next(Remaining) of + {K, V, RemainingAfter} -> + coerce_map2(KeyType, ValType, RemainingAfter, Acc, K, V); + none -> {ok, Acc} + end. + +coerce_map2(KeyType, ValType, Remaining, Acc, K, V) -> + case coerce(KeyType, K) of + {ok, KFATE} -> + coerce_map3(KeyType, ValType, Remaining, Acc, KFATE, V); + Error -> Error + end. + +coerce_map3(KeyType, ValType, Remaining, Acc, KFATE, V) -> + case coerce(ValType, V) of + {ok, VFATE} -> + NewAcc = Acc#{KFATE => VFATE}, + coerce_map(KeyType, ValType, Remaining, NewAcc); + Error -> Error + end. + +lookup_variant(Name, Variants) -> lookup_variant(Name, Variants, 0). + +lookup_variant(Name, [{Name, Fields} | _], Tag) -> {Tag, Fields}; +lookup_variant(Name, [_ | Rest], Tag) -> + lookup_variant(Name, Rest, Tag + 1); +lookup_variant(_Name, [], _Tag) -> + not_found. + +coerce_tuple(O, N, FieldTypes, Fields) -> + case coerce_tuple_elements(FieldTypes, Fields, []) of + {ok, FATETuple} -> + {ok, {tuple, FATETuple}}; + {error, too_few_terms} -> + {error, {tuple_too_few_terms, O, N, FieldTypes, Fields}}; + {error, too_many_terms} -> + {error, {tuple_too_many_terms, O, N, FieldTypes, Fields}}; + Error -> Error + end. + +coerce_variant2(O, N, Variants, Name, Tag, FieldTypes, Fields) -> + case coerce_tuple_elements(FieldTypes, Fields, []) of + {ok, FATETuple} -> + Arities = [length(VariantTerms) + || {_, VariantTerms} <- Variants], + {ok, {variant, Arities, Tag, FATETuple}}; + {error, too_few_terms} -> + {error, {adt_too_few_terms, O, N, Name, FieldTypes, Fields}}; + {error, too_many_terms} -> + {error, {adt_too_many_terms, O, N, Name, FieldTypes, Fields}}; + Error -> Error + end. + +coerce_tuple_elements([Type | Types], [Field | Fields], Acc) -> + case coerce(Type, Field) of + {ok, Value} -> coerce_tuple_elements(Types, Fields, [Value | Acc]); + Error -> Error + end; +coerce_tuple_elements([], [], Acc) -> + {ok, list_to_tuple(lists:reverse(Acc))}; +coerce_tuple_elements(_, [], _) -> + {error, too_few_terms}; +coerce_tuple_elements([], _, _) -> + {error, too_many_terms}. + +coerce_map_to_record(O, N, Fields, Map) -> + case zip_record_fields(Fields, Map) of + {ok, Zipped} -> + case coerce_zipped_bindings(Zipped) of + {ok, FATEFields} -> + {ok, {tuple, list_to_tuple(FATEFields)}}; + Error -> Error % FIXME when do we wrap errors vs propogate + % them? Hard to say until we actually render + % them. + end; + {error, {missing_fields, Missing}} -> + {error, {missing_fields, O, N, Missing}}; + {error, {unexpected_fields, Unexpected}} -> + Names = [Name || {Name, _} <- maps:to_list(Unexpected)], + {error, {unexpected_fields, O, N, Names}} + end. + +zip_record_fields(Fields, Map) -> + case lists:mapfoldl(fun zip_record_field/2, {Map, []}, Fields) of + {_, {_, Missing = [_|_]}} -> + {error, {missing_fields, lists:reverse(Missing)}}; + {_, {Remaining, _}} when map_size(Remaining) > 0 -> + {error, {unexpected_fields, Remaining}}; + {Zipped, _} -> + {ok, Zipped} + end. + +zip_record_field({Name, Type}, {Remaining, Missing}) -> + case maps:take(Name, Remaining) of + {Term, RemainingAfter} -> + ZippedTerm = {{Name, Type}, Term}, + {ZippedTerm, {RemainingAfter, Missing}}; + error -> + {missing, {Remaining, [Name | Missing]}} + end. -spec min_gas_price() -> integer(). %% @doc @@ -1384,32 +1777,18 @@ min_fee() -> 200000000000000. -encode_call_data({aaci, _, FunDefs}, Fun, Args) -> +encode_call_data({aaci, _ContractName, FunDefs, _TypeDefs}, Fun, Args) -> case maps:find(Fun, FunDefs) of {ok, ArgDef} -> encode_call_data2(ArgDef, Fun, Args); error -> {error, bad_fun_name} end. encode_call_data2(ArgDef, Fun, Args) -> - DefLength = length(ArgDef), - ArgLength = length(Args), - if - DefLength =:= ArgLength -> encode_call_data3(ArgDef, Fun, Args); - DefLength > ArgLength -> {error, too_few_args}; - DefLength < ArgLength -> {error, too_many_args} + case coerce_bindings(ArgDef, Args) of + {ok, Coerced} -> aeb_fate_abi:create_calldata(Fun, Coerced); + Error -> Error end. -encode_call_data3(ArgDef, Fun, Args) -> - Binding = lists:zip(ArgDef, Args), - case lists:foldl(fun coerce/2, {[], []}, Binding) of - {Coerced, []} -> - Reversed = lists:reverse(Coerced), - aeb_fate_abi:create_calldata(Fun, Reversed); - {_, Errors} -> - {error, {args, lists:reverse(Errors)}} - end. - - verify_signature(Sig, Message, PubKey) -> case aeser_api_encoder:decode(PubKey) of {account_pubkey, PK} -> verify_signature2(Sig, Message, PK);