diff --git a/doc/erlang.png b/doc/cusom/erlang.png similarity index 100% rename from doc/erlang.png rename to doc/cusom/erlang.png diff --git a/doc/stylesheet.css b/doc/cusom/stylesheet.css similarity index 100% rename from doc/stylesheet.css rename to doc/cusom/stylesheet.css diff --git a/doc/overview.edoc b/doc/overview.edoc index 92b0715..2587cf4 100644 --- a/doc/overview.edoc +++ b/doc/overview.edoc @@ -1,5 +1,5 @@ @author Craig Everett [https://git.qpq.swiss/QPQ-AG/hakuzaru] -@version 0.8.0 +@version 0.9.0 @title Hakuzaru: Gajumaru blockchain bindings for Erlang @doc diff --git a/ebin/hakuzaru.app b/ebin/hakuzaru.app index 3ddf070..50bd67f 100644 --- a/ebin/hakuzaru.app +++ b/ebin/hakuzaru.app @@ -3,7 +3,7 @@ {included_applications,[]}, {applications,[stdlib,kernel]}, {description,"Gajumaru interoperation library"}, - {vsn,"0.8.3"}, + {vsn,"0.9.0"}, {modules,[hakuzaru,hz,hz_fetcher,hz_format,hz_grids, hz_key_master,hz_man,hz_sup]}, {mod,{hakuzaru,[]}}]}. diff --git a/src/hakuzaru.erl b/src/hakuzaru.erl index 482e5fc..ddd67a9 100644 --- a/src/hakuzaru.erl +++ b/src/hakuzaru.erl @@ -6,7 +6,7 @@ %%% @end -module(hakuzaru). --vsn("0.8.3"). +-vsn("0.9.0"). -author("Craig Everett "). -copyright("Craig Everett "). -license("GPL-3.0-or-later"). diff --git a/src/hz.erl b/src/hz.erl index 2216daa..e90ef00 100644 --- a/src/hz.erl +++ b/src/hz.erl @@ -23,7 +23,7 @@ %%% @end -module(hz). --vsn("0.8.3"). +-vsn("0.9.0"). -author("Craig Everett "). -copyright("Craig Everett "). -license("GPL-3.0-or-later"). @@ -65,14 +65,13 @@ contract_create_built/8, contract_create/8, prepare_contract/1, - prepare_aaci/1, cache_aaci/2, lookup_aaci/1, aaci_lookup_spec/2, contract_call/5, contract_call/6, contract_call/10, - decode_bytearray_fate/1, decode_bytearray/2, + decode_bytearray/2, spend/5, spend/10, sign_tx/2, sign_tx/3, sign_message/2, verify_signature/3, @@ -273,8 +272,7 @@ chain_nodes() -> %% transactions are submitted is called the "sticky node". This is the first node %% (head position) in the list of nodes submitted to the chain when `chain_nodes/1' %% is called. If using multiple nodes but the sticky node should also be used for -%% read-only queries, submit the sticky node at the head of the list and again in -%% the tail. +%% read-only queries, put the sticky node in the list twice. chain_nodes(List) when is_list(List) -> hz_man:chain_nodes(List). @@ -285,7 +283,7 @@ chain_nodes(List) when is_list(List) -> %% Check whether TLS is in use. The typical situation is to not use TLS as nodes that %% serve as part of the backend of an application are typically run in the same %% backend network as the application service. When accessing chain nodes over the WAN -%% however, TLS is strongly recommended to avoid a MITM attack. +%% however, TLS is recommended to avoid a MitM attack. %% %% In this version of Hakuzaru TLS is either on or off for all nodes, making a mixed %% infrastructure complicated to support without two Hakuzaru instances. This will @@ -300,7 +298,7 @@ tls() -> -spec tls(boolean()) -> ok. %% @doc %% Set TLS true or false. That's what a boolean is, by the way, `true' or `false'. -%% This is a condescending comment. That means I am talking down to you. +%% This is a condescending comment. That means to talk down to someone. %% %% TLS defaults to `false'. @@ -344,7 +342,8 @@ timeout(MS) -> %% NOTE: %% This will return the currently synced height, which may be different than the %% actual current top of the entire chain if the node being queried is still syncing -%% (has not yet caught up with the chain). +%% (has not yet caught up with the chain). More complete information, including +%% whether the node is currently syncing, can be gained from a `status()' query. top_height() -> case top_block() of @@ -357,7 +356,7 @@ top_height() -> when TopBlock :: microblock_header(), Reason :: chain_error(). %% @doc -%% Returns the current block height as an integer. +%% Returns the current top block of the chain. top_block() -> request("/v3/headers/top"). @@ -387,7 +386,7 @@ kb_current() -> kb_current_hash() -> case request("/v3/key-blocks/current/hash") of {ok, #{"reason" := Reason}} -> {error, Reason}; - {ok, #{"hash" := Hash}} -> {ok, Hash}; + {ok, #{"hash" := Hash}} -> {ok, Hash}; Error -> Error end. @@ -445,10 +444,6 @@ kb_by_height(Height) -> result(request(["/v3/key-blocks/height/", StringN])). -%kb_insert(KeyblockData) -> -% request("/v3/key-blocks", KeyblockData). - - -spec mb_header(ID) -> {ok, MB_Header} | {error, Reason} when ID :: microblock_hash(), MB_Header :: microblock_header(), @@ -608,12 +603,6 @@ next_nonce(AccountID) -> {ok, #{"reason" := Reason}} -> {error, Reason}; Error -> Error end. -% case request_sticky(["/v3/accounts/", AccountID]) of -% {ok, #{"nonce" := Nonce}} -> {ok, Nonce + 1}; -% {ok, #{"reason" := "Account not found"}} -> {ok, 1}; -% {ok, #{"reason" := Reason}} -> {error, Reason}; -% Error -> Error -% end. -spec dry_run(TX) -> {ok, Result} | {error, Reason} @@ -692,8 +681,10 @@ decode_bytearray_fate(EncodedStr) -> Encoded = unicode:characters_to_binary(EncodedStr), {contract_bytearray, Binary} = gmser_api_encoder:decode(Encoded), case Binary of - <<>> -> {ok, none}; - <<"Out of gas">> -> {error, out_of_gas}; + <<>> -> + {ok, none}; + <<"Out of gas">> -> + {error, out_of_gas}; _ -> % FIXME there may be other errors that are encoded directly into % the byte array. We could try and catch to at least return @@ -702,8 +693,9 @@ decode_bytearray_fate(EncodedStr) -> {ok, Object} end. --spec decode_bytearray(Type, EncodedStr) -> {ok, Result} | {error, Reason} - when Type :: term(), +-spec decode_bytearray(EncodedStr, Format) -> {ok, Result} | {error, Reason} + when Format :: fate | sophia | {sophia, Type} | {erlang, Type}, + Type :: term(), EncodedStr :: binary() | string(), Result :: none | term(), Reason :: term(). @@ -714,13 +706,18 @@ decode_bytearray_fate(EncodedStr) -> %% must be the result type of the same function in the same AACI that was used %% to create the transaction that EncodedStr came from. -decode_bytearray(Type, EncodedStr) -> +decode_bytearray(EncodedStr, Format) -> case decode_bytearray_fate(EncodedStr) of {ok, none} -> {ok, none}; - {ok, Object} -> coerce(Type, Object, from_fate); + {ok, FATE} -> decode_bytearray2(FATE, Format); {error, Reason} -> {error, Reason} end. +decode_bytearray2(FATE, fate) -> FATE; +decode_bytearray2(FATE, sophia) -> hz_sophia:fate_to_list(FATE); +decode_bytearray2(FATE, {sophia, Type}) -> hz_sophia:fate_to_list(Type, FATE); +decode_bytearray2(FATE, {erlang, Type}) -> hz_aaci:fate_to_erlang(Type, FATE). + to_binary(S) when is_binary(S) -> S; to_binary(S) when is_list(S) -> list_to_binary(S). @@ -786,20 +783,39 @@ contract_code(ID) -> end. --spec contract_source(ID) -> {ok, Bytecode} | {error, Reason} - when ID :: contract_id(), - Bytecode :: contract_byte_array(), +-spec contract_source(ID) -> Result + when ID :: contract_id(), + Result :: {ok, Source} + | {project, Bundle} + | {error, Reason}, + Source :: string(), + Bundle :: [{FilePath :: string(), Contents :: binary()}], Reason :: chain_error() | string(). %% @doc %% Retrieve the code of a contract as represented on chain. contract_source(ID) -> case request(["/v3/contracts/", ID, "/source"]) of - {ok, #{"source" := Source}} -> {ok, Source}; + {ok, #{"source" := Blobby}} -> extract(list_to_binary(Blobby)); {ok, #{"reason" := Reason}} -> {error, Reason}; Error -> Error end. +extract(Blobby) -> + case gmser_api_encoder:safe_decode(bytearray, Blobby) of + {ok, TarBaby} -> extract2(TarBaby); + {error, invalid_encoding} -> {ok, Blobby} + end. + +extract2(TarBaby) -> + case erl_tar:extract({binary, TarBaby}, [memory, compressed]) of + {ok, Bundle} -> + {project, Bundle}; + Error -> + io:format("Dis chit happen: ~tp~n", [Error]), + {ok, TarBaby} + end. + -spec contract_poi(ID) -> {ok, Bytecode} | {error, Reason} when ID :: contract_id(), @@ -893,7 +909,10 @@ result(Received) -> Received. -spec contract_create(CreatorID, Path, InitArgs) -> Result when CreatorID :: unicode:chardata(), Path :: file:filename(), - InitArgs :: [string()], + InitArgs :: [string()] + | {erlang, [term()]} + | {fate, [term()]} + | {sophia, [string()]}, Result :: {ok, CreateTX} | {error, Reason}, CreateTX :: binary(), Reason :: file:posix() | term(). @@ -919,16 +938,19 @@ contract_create(CreatorID, Path, InitArgs) -> -spec contract_create(CreatorID, Nonce, - Amount, TTL, Gas, GasPrice, + Gas, GasPrice, Amount, TTL, Path, InitArgs) -> Result when CreatorID :: pubkey(), Nonce :: pos_integer(), - Amount :: non_neg_integer(), - TTL :: non_neg_integer(), Gas :: pos_integer(), GasPrice :: pos_integer(), + Amount :: non_neg_integer(), + TTL :: non_neg_integer(), Path :: file:filename(), - InitArgs :: [string()], + InitArgs :: [string()] + | {erlang, [term()]} + | {fate, [term()]} + | {sophia, [string()]}, Result :: {ok, CreateTX} | {error, Reason}, CreateTX :: binary(), Reason :: term(). @@ -960,24 +982,6 @@ contract_create(CreatorID, Path, InitArgs) -> %% querying your Gajumaru node (via `hz:next_nonce(CallerID)', for example). %% %%
  • -%% Amount: -%% All Gajumaru transactions can carry an "amount" spent from the origin account -%% (in this case the `CallerID') to the destination. In a "Spend" transaction this -%% is the only value that really matters, but in a contract call the utility is -%% quite different, as you can pay money into a contract and have that -%% contract hold it (for future payouts, to be held in escrow, as proof of intent -%% to purchase or engage in an auction, whatever). Typically this value is 0, but -%% of course there are very good reasons why it should be set to a non-zero value -%% in the case of calls related to contract-governed payment systems. -%%
    • -%%
  • -%% TTL: -%% This stands for "Time-To-Live", meaning the height beyond which this element is -%% considered to be eligible for garbage collection (and therefore inaccessible!). -%% The TTL can be extended by a "live extension" transaction (basically pay for the -%% data to remain alive longer). -%%
    • -%%
  • %% Gas: %% This number sets a limit on the maximum amount of computation the caller is willing %% to pay for on the chain. @@ -1010,6 +1014,24 @@ contract_create(CreatorID, Path, InitArgs) -> %% transaction, thus making miners more likely to prioritize the high value ones. %%
    • %%
  • +%% Amount: +%% All Gajumaru transactions can carry an "amount" spent from the origin account +%% (in this case the `CallerID') to the destination. In a "Spend" transaction this +%% is the only value that really matters, but in a contract call the utility is +%% quite different, as you can pay money into a contract and have that +%% contract hold it (for future payouts, to be held in escrow, as proof of intent +%% to purchase or engage in an auction, whatever). Typically this value is 0, but +%% of course there are very good reasons why it should be set to a non-zero value +%% in the case of calls related to contract-governed payment systems. +%%
    • +%%
  • +%% TTL: +%% This stands for "Time-To-Live", meaning the height beyond which this element is +%% considered to be eligible for garbage collection (and therefore inaccessible!). +%% The TTL can be extended by a "live extension" transaction (basically pay for the +%% data to remain alive longer). +%%
    • +%%
  • %% ACI: %% This is the compiled contract's metadata. It provides the information necessary %% for the contract call data to be formed in a way that the Gajumaru runtime will @@ -1033,8 +1055,9 @@ contract_create(CreatorID, Path, InitArgs) -> %%
  • %% Args: %% This is a list of the arguments to provide to the function, listed in order -%% according to the function's spec, and represented as strings (that is, an integer -%% argument of `10' must be cast to the textual representation `"10"'). +%% according to the function's spec. Arguments can be represented as a list of +%% Sophia literals (a simple list of strings), or alternately as a list of compatible +%% Erlang, FATE or Sophia terms wrapped in a tuple which specifies the representation. %%
    • %% %% As should be obvious from the above description, it is pretty helpful to have a @@ -1042,9 +1065,10 @@ contract_create(CreatorID, Path, InitArgs) -> %% if you do not already have a copy, and can check the spec of a function before %% trying to form a contract call. -contract_create(CreatorID, Nonce, Amount, TTL, Gas, GasPrice, Path, InitArgs) -> +contract_create(CreatorID, Nonce, Gas, GasPrice, Amount, TTL, Path, InitArgs) -> case file:read_file(Path) of {ok, Source} -> + Name = filename:basename(Path), Dir = filename:dirname(Path), {ok, CWD} = file:get_cwd(), SrcDir = so_utils:canonical_dir(Path), @@ -1053,18 +1077,19 @@ contract_create(CreatorID, Nonce, Amount, TTL, Gas, GasPrice, Path, InitArgs) -> {src_file, Path}, {src_dir, SrcDir}, {include, {file_system, [CWD, so_utils:canonical_dir(Dir)]}}], - contract_create2(CreatorID, Nonce, Amount, TTL, Gas, GasPrice, - Source, Options, InitArgs); + contract_create2(CreatorID, Nonce, Gas, GasPrice, Amount, TTL, + Name, Source, Options, InitArgs); Error -> Error end. -contract_create2(CreatorID, Nonce, Amount, TTL, Gas, GasPrice, Source, Options, InitArgs) -> +contract_create2(CreatorID, Nonce, Gas, GasPrice, Amount, TTL, Name, Source, Options, InitArgs) -> case so_compiler:from_string(Source, Options) of {ok, Compiled} -> - contract_create_built(CreatorID, Nonce, Amount, TTL, Gas, GasPrice, - Compiled, InitArgs); + Named = maps:put(contract_name, Name, Compiled), + contract_create_built(CreatorID, Nonce, Gas, GasPrice, Amount, TTL, + Named, InitArgs); Error -> Error end. @@ -1073,7 +1098,10 @@ contract_create2(CreatorID, Nonce, Amount, TTL, Gas, GasPrice, Source, Options, -spec contract_create_built(CreatorID, Compiled, InitArgs) -> Result when CreatorID :: unicode:chardata(), Compiled :: map(), - InitArgs :: [string()], + InitArgs :: [string()] + | {erlang, [term()]} + | {fate, [term()]} + | {sophia, [string()]}, Result :: {ok, CreateTX} | {error, Reason}, CreateTX :: binary(), Reason :: file:posix() | bad_fun_name | aaci_not_found | term(). @@ -1091,36 +1119,56 @@ contract_create_built(CreatorID, Compiled, InitArgs) -> Gas = 500000, GasPrice = min_gas_price(), contract_create_built(CreatorID, Nonce, - Amount, TTL, Gas, GasPrice, + Gas, GasPrice, Amount, TTL, Compiled, InitArgs); Error -> Error end. -contract_create_built(CreatorID, Nonce, Amount, TTL, Gas, GasPrice, Compiled, InitArgs) -> - AACI = prepare_aaci(maps:get(aci, Compiled)), +-spec contract_create_built(CreatorID, Nonce, Gas, GasPrice, Amount, TTL, Compiled, InitArgs) -> Result + when CreatorID :: unicode:chardata(), + Nonce :: pos_integer(), + Gas :: pos_integer(), + GasPrice :: pos_integer(), + Amount :: non_neg_integer(), + TTL :: non_neg_integer(), + Compiled :: map(), + InitArgs :: [string()] + | {erlang, [term()]} + | {fate, [term()]} + | {sophia, [string()]}, + Result :: {ok, CreateTX} | {error, Reason}, + CreateTX :: binary(), + Reason :: file:posix() | bad_fun_name | aaci_not_found | term(). +%% @doc +%% See `contract_create/8' for detailed information on argument types. +%% The `Compiled' argument is the output of contract compilation and replaces the `File' +%% argument in `contract_create/8'. + +contract_create_built(CreatorID, Nonce, Gas, GasPrice, Amount, TTL, Compiled, InitArgs) -> + AACI = hz_aaci:prepare(maps:get(aci, Compiled)), case encode_call_data(AACI, "init", InitArgs) of {ok, CallData} -> - assemble_calldata(CreatorID, Nonce, Amount, TTL, Gas, GasPrice, - Compiled, CallData); + assemble_calldata(CreatorID, Nonce, Gas, GasPrice, Amount, TTL, Compiled, CallData); Error -> Error end. -assemble_calldata(CreatorID, Nonce, Amount, TTL, Gas, GasPrice, Compiled, CallData) -> +assemble_calldata(CreatorID, Nonce, Gas, GasPrice, Amount, TTL, Compiled, CallData) -> PK = unicode:characters_to_binary(CreatorID), try {account_pubkey, OwnerID} = gmser_api_encoder:decode(PK), - assemble_calldata2(OwnerID, Nonce, Amount, TTL, Gas, GasPrice, Compiled, CallData) + assemble_calldata2(OwnerID, Nonce, Gas, GasPrice, Amount, TTL, Compiled, CallData) catch - Error:Reason -> {Error, Reason} + Error:Reason:Stack -> + {Error, {Reason, Stack}} end. -assemble_calldata2(OwnerID, Nonce, Amount, TTL, Gas, GasPrice, Compiled, CallData) -> - Code = gmser_contract_code:serialize(Compiled), - Source = unicode:characters_to_binary(maps:get(contract_source, Compiled, <<>>)), +assemble_calldata2(OwnerID, Nonce, Gas, GasPrice, Amount, TTL, Compiled, CallData) -> + Compressed = #{contract_source := Bundle} = bundle_source(Compiled), + Code = gmser_contract_code:serialize(Compressed), VM = 1, ABI = 1, <> = <>, @@ -1130,7 +1178,7 @@ assemble_calldata2(OwnerID, Nonce, Amount, TTL, Gas, GasPrice, Compiled, CallDat [{owner_id, gmser_id:create(account, OwnerID)}, {nonce, Nonce}, {code, Code}, - {source, Source}, + {source, Bundle}, {ct_version, CTVersion}, {ttl, TTL}, {deposit, 0}, @@ -1157,6 +1205,43 @@ assemble_calldata2(OwnerID, Nonce, Amount, TTL, Gas, GasPrice, Compiled, CallDat error:Reason -> {error, Reason} end. +bundle_source(Compiled) -> + case maps:find(contract_source, Compiled) of + {ok, Source} -> bundle_source2(unicode:characters_to_binary(Source), Compiled); + error -> <<>> + end. + +bundle_source2(Source, Compiled) -> + File = unicode:characters_to_list(maps:get(contract_name, Compiled, "contract.aes")), + TempDir = temp_dir(), + TgzName = File ++ ".tgz", + TarGzPath = filename:join(TempDir, TgzName), + ok = filelib:ensure_dir(TarGzPath), + {ok, CWD} = file:get_cwd(), + ok = file:set_cwd(TempDir), + ok = erl_tar:create(TarGzPath, [{File, Source}], [compressed]), + {ok, TgzBin} = file:read_file(TarGzPath), + ok = file:set_cwd(CWD), + ok = file:del_dir_r(TempDir), + {ok, Hash} = eblake2:blake2b(32, TgzBin), + Compiled#{contract_source => TgzBin, source_hash => Hash}. + +temp_dir() -> + case erlang:function_exported(zx_lib, path, 3) of + true -> + TS = integer_to_list(erlang:system_time()), + filename:join(zx_lib:path(tmp, "otpr", "hakuzaru"), TS); + false -> + temp_dir(os:type()) + end. + +temp_dir({unix, _}) -> + string:trim(os:cmd("mktemp -d")); +temp_dir({win32, _}) -> + Temp = os:getenv("TEMP"), + TS = integer_to_list(erlang:system_time()), + filename:join([Temp, "hakuzaru", TS]). + -spec read_aci(Path) -> Result when Path :: file:filename(), @@ -1193,7 +1278,10 @@ read_aci(Path) -> AACI :: aaci() | {aaci, Label :: term()}, ConID :: unicode:chardata(), Fun :: string(), - Args :: [string()], + Args :: [string()] + | {erlang, [term()]} + | {fate, [term()]} + | {sophia, [string()]}, Result :: {ok, CallTX} | {error, Reason}, CallTX :: binary(), Reason :: term(). @@ -1228,7 +1316,10 @@ contract_call(CallerID, AACI, ConID, Fun, Args) -> AACI :: aaci() | {aaci, Label :: term()}, ConID :: unicode:chardata(), Fun :: string(), - Args :: [string()], + Args :: [string()] + | {erlang, [term()]} + | {fate, [term()]} + | {sophia, [string()]}, Result :: {ok, CallTX} | {error, Reason}, CallTX :: binary(), Reason :: term(). @@ -1266,7 +1357,10 @@ contract_call(CallerID, Gas, AACI, ConID, Fun, Args) -> AACI :: aaci() | {aaci, Label :: term()}, ConID :: unicode:chardata(), Fun :: string(), - Args :: [string()], + Args :: [string()] + | {erlang, [term()]} + | {fate, [term()]} + | {sophia, [string()]}, Result :: {ok, CallTX} | {error, Reason}, CallTX :: binary(), Reason :: term(). @@ -1363,8 +1457,9 @@ contract_call(CallerID, Gas, AACI, ConID, Fun, Args) -> %%
  • %% Args: %% This is a list of the arguments to provide to the function, listed in order -%% according to the function's spec, and represented as strings (that is, an integer -%% argument of `10' must be cast to the textual representation `"10"'). +%% according to the function's spec. Arguments can be represented as a list of +%% Sophia literals (a simple list of strings), or alternately as a list of compatible +%% Erlang, FATE or Sophia terms wrapped in a tuple which specifies the representation. %%
    • %% %% As should be obvious from the above description, it is pretty helpful to have a @@ -1438,779 +1533,10 @@ contract_call4(PK, Nonce, Gas, GasPrice, Amount, TTL, CK, CallData) -> prepare_contract(File) -> case so_compiler:file(File, [{aci, json}]) of - {ok, #{aci := ACI}} -> {ok, prepare_aaci(ACI)}; + {ok, #{aci := ACI}} -> {ok, hz_aaci:prepare(ACI)}; Error -> Error end. -prepare_aaci(ACI) -> - % We want to take the types represented by the ACI, things like N1.T(N2.T), - % and dereference them down to concrete types like - % {tuple, [integer, string]}. Our type dereferencing algorithms - % shouldn't act directly on the JSON-based structures that the compiler - % gives us, though, though, so before we do the analysis, we should strip - % the ACI down to a list of 'opaque' type defintions and function specs. - {Name, OpaqueSpecs, TypeDefs} = convert_aci_types(ACI), - - % Now that we have the opaque types, we can dereference the function specs - % down to the concrete types they actually represent. We annotate each - % subexpression of this concrete type with other info too, in case it helps - % make error messages easier to understand. - InternalTypeDefs = maps:merge(builtin_typedefs(), TypeDefs), - Specs = annotate_function_specs(OpaqueSpecs, InternalTypeDefs, #{}), - - {aaci, Name, Specs, TypeDefs}. - -convert_aci_types(ACI) -> - % Find the main contract, so we can get the specifications of its - % entrypoints. - [{NameBin, SpecDefs}] = - [{N, F} - || #{contract := #{kind := contract_main, - functions := F, - name := N}} <- ACI], - Name = binary_to_list(NameBin), - % Turn these specifications into opaque types that we can reason about. - Specs = lists:map(fun convert_function_spec/1, SpecDefs), - - % These specifications can reference other type definitions from the main - % contract and any other namespaces, so extract these types and convert - % them too. - TypeDefTree = lists:map(fun convert_namespace_typedefs/1, ACI), - % The tree structure of the ACI naturally leads to a tree of opaque types, - % but we want a map, so flatten it out before we continue. - TypeDefMap = collect_opaque_types(TypeDefTree, #{}), - - % This is all the information we actually need from the ACI, the rest is - % just pre-compute and acceleration. - {Name, Specs, TypeDefMap}. - -convert_function_spec(#{name := NameBin, arguments := Args, returns := Result}) -> - Name = binary_to_list(NameBin), - ArgTypes = lists:map(fun convert_arg/1, Args), - ResultType = opaque_type([], Result), - {Name, ArgTypes, ResultType}. - -convert_arg(#{name := NameBin, type := TypeDef}) -> - Name = binary_to_list(NameBin), - Type = opaque_type([], TypeDef), - {Name, Type}. - -convert_namespace_typedefs(#{namespace := NS}) -> - Name = namespace_name(NS), - convert_typedefs(NS, Name); -convert_namespace_typedefs(#{contract := NS}) -> - Name = namespace_name(NS), - ImplicitTypes = convert_implicit_types(NS, Name), - ExplicitTypes = convert_typedefs(NS, Name), - [ImplicitTypes, ExplicitTypes]. - -namespace_name(#{name := NameBin}) -> - binary_to_list(NameBin). - -convert_implicit_types(#{state := StateDefACI}, Name) -> - StateDefOpaque = opaque_type([], StateDefACI), - [{Name, [], contract}, - {Name ++ ".state", [], StateDefOpaque}]; -convert_implicit_types(_, Name) -> - [{Name, [], contract}]. - -convert_typedefs(#{typedefs := TypeDefs}, Name) -> - convert_typedefs_loop(TypeDefs, Name ++ ".", []). - -% Take a namespace that has already had a period appended, and use that as a -% prefix to convert and annotate a list of types. -convert_typedefs_loop([], _NamePrefix, Converted) -> - Converted; -convert_typedefs_loop([Next | Rest], NamePrefix, Converted) -> - #{name := NameBin, vars := ParamDefs, typedef := DefACI} = Next, - Name = NamePrefix ++ binary_to_list(NameBin), - Params = [binary_to_list(Param) || #{name := Param} <- ParamDefs], - Def = opaque_type(Params, DefACI), - convert_typedefs_loop(Rest, NamePrefix, [Converted, {Name, Params, Def}]). - -collect_opaque_types([], Types) -> - Types; -collect_opaque_types([L | R], Types) -> - NewTypes = collect_opaque_types(L, Types), - collect_opaque_types(R, NewTypes); -collect_opaque_types({Name, Params, Def}, Types) -> - maps:put(Name, {Params, Def}, Types). - -% Convert an ACI type defintion/spec into the 'opaque type' representation that -% our dereferencing algorithms can reason about. -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; -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(_, #{bytes := Count}) -> - {bytes, [Count]}; -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 any builtins that aren't qualified by a namespace in Sophia. -% Everything else stays as a string, user-defined or not. -opaque_type_name(<<"int">>) -> integer; -opaque_type_name(<<"bool">>) -> boolean; -opaque_type_name(<<"bits">>) -> bits; -opaque_type_name(<<"char">>) -> char; -opaque_type_name(<<"string">>) -> string; -opaque_type_name(<<"address">>) -> address; -opaque_type_name(<<"signature">>) -> signature; -opaque_type_name(<<"contract">>) -> contract; -opaque_type_name(<<"list">>) -> list; -opaque_type_name(<<"map">>) -> map; -% I'm not sure how to produce channels in Sophia source, but they seem to exist -% in gmb still. -opaque_type_name(<<"channel">>) -> channel; -opaque_type_name(Name) -> binary_to_list(Name). - -builtin_typedefs() -> - #{"unit" => {[], {tuple, []}}, - "void" => {[], {variant, []}}, - "hash" => {[], {bytes, [32]}}, - "option" => {["'T"], {variant, [{"None", []}, - {"Some", [{var, "'T"}]}]}}, - "Chain.ttl" => {[], {variant, [{"FixedTTL", [integer]}, - {"RelativeTTL", [integer]}]}}, - "AENS.pointee" => {[], {variant, [{"AccountPt", [address]}, - {"OraclePt", [address]}, - {"ContractPt", [address]}, - {"ChannelPt", [address]}]}}, - "AENS.name" => {[], {variant, [{"Name", [address, - "Chain.ttl", - {map, [string, "AENS.pointee"]}]}]}}, - "AENSv2.pointee" => {[], {variant, [{"AccountPt", [address]}, - {"OraclePt", [address]}, - {"ContractPt", [address]}, - {"ChannelPt", [address]}, - {"DataPt", [{bytes, [any]}]}]}}, - "AENSv2.name" => {[], {variant, [{"Name", [address, - "Chain.ttl", - {map, [string, "AENSv2.pointee"]}]}]}}, - "Chain.ga_meta_tx" => {[], {variant, [{"GAMetaTx", [address, integer]}]}}, - "Chain.paying_for_tx" => {[], {variant, [{"PayingForTx", [address, integer]}]}}, - "Chain.base_tx" => {[], {variant, [{"SpendTx", [address, integer, string]}, - {"OracleRegisterTx", []}, - {"OracleQueryTx", []}, - {"OracleResponseTx", []}, - {"OracleExtendTx", []}, - {"NamePreclaimTx", []}, - {"NameClaimTx", ["hash"]}, - {"NameUpdateTx", [string]}, - {"NameRevokeTx", ["hash"]}, - {"NameTransferTx", [address, string]}, - {"ChannelCreateTx", [address]}, - {"ChannelDepositTx", [address, integer]}, - {"ChannelWithdrawTx", [address, integer]}, - {"ChannelForceProgressTx", [address]}, - {"ChannelCloseMutualTx", [address]}, - {"ChannelCloseSoloTx", [address]}, - {"ChannelSlashTx", [address]}, - {"ChannelSettleTx", [address]}, - {"ChannelSnapshotSoloTx", [address]}, - {"ContractCreateTx", [integer]}, - {"ContractCallTx", [address, integer]}, - {"GAAttachTx", []}]}}, - "Chain.tx" => {[], {record, [{"paying_for", {"option", ["Chain.paying_for_tx"]}}, - {"ga_metas", {list, ["Chain.ga_meta_tx"]}}, - {"actor", address}, - {"fee", integer}, - {"ttl", integer}, - {"tx", "Chain.base_tx"}]}}, - "MCL_BLS12_381.fr" => {[], {bytes, [32]}}, - "MCL_BLS12_381.fp" => {[], {bytes, [48]}} - }. - -% 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 gmbytecode 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 dereferenced -% 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 dereferenced 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. - -annotate_function_specs([], _Types, Specs) -> - Specs; -annotate_function_specs([{Name, ArgsOpaque, ResultOpaque} | Rest], Types, Specs) -> - {ok, Args} = annotate_bindings(ArgsOpaque, Types, []), - {ok, Result} = annotate_type(ResultOpaque, Types), - NewSpecs = maps:put(Name, {Args, Result}, Specs), - annotate_function_specs(Rest, Types, NewSpecs). - -annotate_type(T, Types) -> - case normalize_opaque_type(T, Types) of - {ok, AlreadyNormalized, NOpaque, NExpanded} -> - annotate_type2(T, AlreadyNormalized, NOpaque, NExpanded, Types); - Error -> - Error - end. - -annotate_type2(T, _, _, unknown_type, _) -> - % If a type is unknown, then it should not be reported as the normalized - % name. - {ok, {T, unknown_type, unknown_type}}; -annotate_type2(T, AlreadyNormalized, NOpaque, NExpanded, Types) -> - case annotate_type_subexpressions(NExpanded, Types) of - {ok, Flat} -> - case AlreadyNormalized of - true -> {ok, {T, already_normalized, Flat}}; - false -> {ok, {T, NOpaque, Flat}} - end; - Error -> - Error - end. - -annotate_types([T | Rest], Types, Acc) -> - case annotate_type(T, Types) of - {ok, Type} -> annotate_types(Rest, Types, [Type | Acc]); - Error -> Error - end; -annotate_types([], _Types, Acc) -> - {ok, lists:reverse(Acc)}. - -annotate_type_subexpressions(PrimitiveType, _Types) when is_atom(PrimitiveType) -> - {ok, PrimitiveType}; -annotate_type_subexpressions({bytes, [Count]}, _Types) -> - % bytes is weird, because it has an argument, but that argument isn't an - % opaque type. - {ok, {bytes, [Count]}}; -annotate_type_subexpressions({variant, VariantsOpaque}, Types) -> - case annotate_variants(VariantsOpaque, Types, []) of - {ok, Variants} -> {ok, {variant, Variants}}; - Error -> Error - end; -annotate_type_subexpressions({record, FieldsOpaque}, Types) -> - case annotate_bindings(FieldsOpaque, Types, []) of - {ok, Fields} -> {ok, {record, Fields}}; - Error -> Error - end; -annotate_type_subexpressions({T, ElemsOpaque}, Types) -> - case annotate_types(ElemsOpaque, Types, []) of - {ok, Elems} -> {ok, {T, Elems}}; - Error -> Error - end. - -annotate_bindings([{Name, T} | Rest], Types, Acc) -> - case annotate_type(T, Types) of - {ok, Type} -> annotate_bindings(Rest, Types, [{Name, Type} | Acc]); - Error -> Error - end; -annotate_bindings([], _Types, Acc) -> - {ok, lists:reverse(Acc)}. - -annotate_variants([{Name, Elems} | Rest], Types, Acc) -> - case annotate_types(Elems, Types, []) of - {ok, ElemsFlat} -> annotate_variants(Rest, Types, [{Name, ElemsFlat} | Acc]); - Error -> Error - end; -annotate_variants([], _Types, Acc) -> - {ok, lists:reverse(Acc)}. - -% This function evaluates type aliases in a loop, until eventually a usable -% definition is found. -normalize_opaque_type(T, Types) -> normalize_opaque_type(T, Types, true). - -% 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(T, _Types, IsFirst) when is_atom(T) -> - % Once we have eliminated the above rewrite cases, all other cases are - % handled explicitly by the coerce logic, and so are considered normalized. - {ok, IsFirst, T, T}; -normalize_opaque_type(Type = {T, _}, _Types, IsFirst) when is_atom(T) -> - % Once we have eliminated the above rewrite cases, all other cases are - % handled explicitly by the coerce logic, and so are considered normalized. - {ok, IsFirst, Type, Type}; -normalize_opaque_type(T, Types, IsFirst) when is_list(T) -> - % Lists/strings indicate userspace types, which may require arg - % substitutions. Convert to an explicit but empty arg list, for uniformity. - normalize_opaque_type({T, []}, Types, IsFirst); -normalize_opaque_type({T, TypeArgs}, Types, IsFirst) when is_list(T) -> - case maps:find(T, Types) of - error -> - % We couldn't find this named type... Keep building the AACI, but - % mark this type expression as unknown, so that FATE coercions - % aren't attempted. - {ok, IsFirst, {T, TypeArgs}, unknown_type}; - {ok, {TypeParamNames, Definition}} -> - % We have a definition for this type, including names for whatever - % args we have been given. Subtitute our args into this. - NewType = substitute_opaque_type(TypeParamNames, Definition, TypeArgs), - % Now continue on to see if we need to restart the loop or not. - normalize_opaque_type2(IsFirst, {T, TypeArgs}, NewType, Types) - end. - -normalize_opaque_type2(IsFirst, PrevType, NextType = {variant, _}, _) -> - % We have reduced to a variant. Report the type name as the normalized - % type, but also provide the variant definition itself as the candidate - % flattened type for further annotation. - {ok, IsFirst, PrevType, NextType}; -normalize_opaque_type2(IsFirst, PrevType, NextType = {record, _}, _) -> - % We have reduced to a record. Report the type name as the normalized - % type, but also provide the record definition itself as the candidate - % flattened type for further annotation. - {ok, IsFirst, PrevType, NextType}; -normalize_opaque_type2(_, _, NextType, Types) -> - % Not a variant or record yet, so go back to the start of the loop. - % It will no longer be the first iteration. - normalize_opaque_type(NextType, Types, false). - -% Perform a beta-reduction on a type expression. -substitute_opaque_type([], Definition, _) -> - % There are no parameters to substitute. This is the simplest way of - % defining type aliases, records, and variants, so we should make sure to - % short circuit all the recursive descent logic, since it won't actually - % do anything. - Definition; -substitute_opaque_type(TypeParamNames, Definition, TypeArgs) -> - % Bundle the param names alongside the args that we want to substitute, so - % that we can keyfind the one list. - Bindings = lists:zip(TypeParamNames, TypeArgs), - substitute_opaque_type(Bindings, Definition). - -substitute_opaque_type(Bindings, {var, VarName}) -> - case lists:keyfind(VarName, 1, Bindings) of - {_, TypeArg} -> TypeArg; - % No valid ACI will create this case. Regardless, the user should - % still be able to specify arbitrary gmb FATE terms for whatever this - % is meant to be. - false -> unknown_type - end; -substitute_opaque_type(Bindings, {variant, Variants}) -> - Each = fun({VariantName, Elements}) -> - NewElements = substitute_opaque_types(Bindings, Elements), - {VariantName, NewElements} - end, - NewVariants = lists:map(Each, Variants), - {variant, NewVariants}; -substitute_opaque_type(Bindings, {record, Fields}) -> - Each = fun({FieldName, FieldType}) -> - NewType = substitute_opaque_type(Bindings, FieldType), - {FieldName, NewType} - end, - NewFields = lists:map(Each, Fields), - {record, NewFields}; -substitute_opaque_type(Bindings, {Connective, Args}) -> - NewArgs = substitute_opaque_types(Bindings, Args), - {Connective, NewArgs}; -substitute_opaque_type(_Bindings, Type) -> - Type. - -substitute_opaque_types(Bindings, Types) -> - Each = fun(Type) -> substitute_opaque_type(Bindings, Type) end, - lists:map(Each, Types). - -coerce_bindings(VarTypes, Terms, Direction) -> - DefLength = length(VarTypes), - ArgLength = length(Terms), - if - DefLength =:= ArgLength -> coerce_zipped_bindings(lists:zip(VarTypes, Terms), Direction, arg); - DefLength > ArgLength -> {error, too_few_args}; - DefLength < ArgLength -> {error, too_many_args} - end. - -coerce_zipped_bindings(Bindings, Direction, Tag) -> - coerce_zipped_bindings(Bindings, Direction, Tag, [], []). - -coerce_zipped_bindings([Next | Rest], Direction, Tag, Good, Broken) -> - {{ArgName, Type}, Term} = Next, - case coerce(Type, Term, Direction) of - {ok, NewTerm} -> - coerce_zipped_bindings(Rest, Direction, Tag, [NewTerm | Good], Broken); - {error, Errors} -> - Wrapped = wrap_errors({Tag, ArgName}, Errors), - coerce_zipped_bindings(Rest, Direction, Tag, Good, [Wrapped | Broken]) - end; -coerce_zipped_bindings([], _, _, Good, []) -> - {ok, lists:reverse(Good)}; -coerce_zipped_bindings([], _, _, _, Broken) -> - {error, combine_errors(Broken)}. - -wrap_errors(Location, Errors) -> - F = fun({Error, Path}) -> - {Error, [Location | Path]} - end, - lists:map(F, Errors). - -combine_errors(Broken) -> - F = fun(NextErrors, Acc) -> - NextErrors ++ Acc - end, - lists:foldl(F, [], Broken). - -coerce({_, _, integer}, S, _) when is_integer(S) -> - {ok, S}; -coerce({O, N, integer}, S, to_fate) when is_list(S) -> - try - Val = list_to_integer(S), - {ok, Val} - catch - error:badarg -> single_error({invalid, O, N, S}) - end; -coerce({O, N, address}, S, to_fate) -> - coerce_chain_object(O, N, address, account_pubkey, S); -coerce({_, _, address}, {address, Bin}, from_fate) -> - Address = gmser_api_encoder:encode(account_pubkey, Bin), - {ok, unicode:characters_to_list(Address)}; -coerce({O, N, contract}, S, to_fate) -> - coerce_chain_object(O, N, contract, contract_pubkey, S); -coerce({_, _, contract}, {contract, Bin}, from_fate) -> - Address = gmser_api_encoder:encode(contract_pubkey, Bin), - {ok, unicode:characters_to_list(Address)}; -coerce({_, _, signature}, S, to_fate) when is_binary(S) andalso (byte_size(S) =:= 64) -> - % Usually to pass a binary in, you need to wrap it as {raw, Binary}, but - % since sg_... strings OR hex blobs can be used as signatures in Sophia, we - % special case this case based on the length. Even if a binary starts with - % "sg_", 64 characters is not enough to represent a 64 byte signature, so - % the most optimistic interpretation is to use the binary directly. - {ok, S}; -coerce({O, N, signature}, S, to_fate) -> - coerce_chain_object(O, N, signature, signature, S); -coerce({_, _, signature}, Bin, from_fate) -> - Address = gmser_api_encoder:encode(signature, Bin), - {ok, unicode:characters_to_list(Address)}; -%coerce({_, _, channel}, S, to_fate) when is_binary(S) -> - %{ok, {channel, S}}; -%coerce({_, _, channel}, {channel, S}, from_fate) when is_binary(S) -> - %{ok, S}; -coerce({_, _, boolean}, true, _) -> - {ok, true}; -coerce({_, _, boolean}, "true", _) -> - {ok, true}; -coerce({_, _, boolean}, false, _) -> - {ok, false}; -coerce({_, _, boolean}, "false", _) -> - {ok, false}; -coerce({O, N, boolean}, S, _) -> - single_error({invalid, O, N, S}); -coerce({O, N, string}, Str, Direction) -> - Result = case Direction of - to_fate -> unicode:characters_to_binary(Str); - from_fate -> unicode:characters_to_list(Str) - end, - case Result of - {error, _, _} -> - single_error({invalid, O, N, Str}); - {incomplete, _, _} -> - single_error({invalid, O, N, Str}); - StrBin -> - {ok, StrBin} - end; -coerce({_, _, char}, Val, _Direction) when is_integer(Val) -> - {ok, Val}; -coerce({O, N, char}, Str, to_fate) -> - Result = unicode:characters_to_list(Str), - case Result of - {error, _, _} -> - single_error({invalid, O, N, Str}); - {incomplete, _, _} -> - single_error({invalid, O, N, Str}); - [C] -> - {ok, C}; - _ -> - single_error({invalid, O, N, Str}) - end; -coerce({O, N, {bytes, [Count]}}, Bytes, _Direction) when is_bitstring(Bytes) -> - coerce_bytes(O, N, Count, Bytes); -coerce({_, _, bits}, {bits, Num}, from_fate) -> - {ok, Num}; -coerce({_, _, bits}, Num, to_fate) when is_integer(Num) -> - {ok, {bits, Num}}; -coerce({_, _, bits}, Bits, to_fate) when is_bitstring(Bits) -> - Size = bit_size(Bits), - <> = Bits, - {ok, {bits, IntValue}}; -coerce({_, _, {list, [Type]}}, Data, Direction) when is_list(Data) -> - coerce_list(Type, Data, Direction); -coerce({_, _, {map, [KeyType, ValType]}}, Data, Direction) when is_map(Data) -> - coerce_map(KeyType, ValType, Data, Direction); -coerce({O, N, {tuple, ElementTypes}}, Data, to_fate) when is_tuple(Data) -> - ElementList = tuple_to_list(Data), - coerce_tuple(O, N, ElementTypes, ElementList, to_fate); -coerce({O, N, {tuple, ElementTypes}}, {tuple, Data}, from_fate) -> - ElementList = tuple_to_list(Data), - coerce_tuple(O, N, ElementTypes, ElementList, from_fate); -coerce({O, N, {variant, Variants}}, Data, to_fate) 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, to_fate); - not_found -> - ValidNames = [Valid || {Valid, _} <- Variants], - single_error({invalid_variant, O, N, Name, ValidNames}) - end; -coerce({O, N, {variant, Variants}}, Name, to_fate) when is_list(Name) -> - coerce({O, N, {variant, Variants}}, {Name}, to_fate); -coerce({O, N, {variant, Variants}}, {variant, _, Tag, Tuple}, from_fate) -> - Terms = tuple_to_list(Tuple), - {Name, TermTypes} = lists:nth(Tag + 1, Variants), - coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms, from_fate); -coerce({O, N, {record, MemberTypes}}, Map, to_fate) when is_map(Map) -> - coerce_map_to_record(O, N, MemberTypes, Map); -coerce({O, N, {record, MemberTypes}}, {tuple, Tuple}, from_fate) -> - coerce_record_to_map(O, N, MemberTypes, Tuple); -coerce({O, N, {unknown_type, _}}, 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}; -coerce({O, N, _}, Data, from_fate) -> - case N of - already_normalized -> - io:format("Warning: Unimplemented type ~p.~nUsing term as is:~n~p~n", [O, Data]); - _ -> - io:format("Warning: Unimplemented type ~p (i.e. ~p).~nUsing term as is:~n~p~n", [O, N, Data]) - end, - {ok, Data}; -coerce({O, N, _}, Data, _) -> single_error({invalid, O, N, Data}). - -coerce_bytes(O, N, _, Bytes) when bit_size(Bytes) rem 8 /= 0 -> - single_error({partial_bytes, O, N, bit_size(Bytes)}); -coerce_bytes(_, _, any, Bytes) -> - {ok, Bytes}; -coerce_bytes(O, N, Count, Bytes) when byte_size(Bytes) /= Count -> - single_error({incorrect_size, O, N, Bytes}); -coerce_bytes(_, _, _, Bytes) -> - {ok, Bytes}. - -coerce_chain_object(_, _, _, _, {raw, Binary}) -> - {ok, Binary}; -coerce_chain_object(O, N, T, Tag, S) -> - case decode_chain_object(Tag, S) of - {ok, Data} -> {ok, coerce_chain_object2(T, Data)}; - {error, Reason} -> single_error({Reason, O, N, S}) - end. - -coerce_chain_object2(address, Data) -> {address, Data}; -coerce_chain_object2(contract, Data) -> {contract, Data}; -coerce_chain_object2(signature, Data) -> Data. - -decode_chain_object(Tag, S) -> - try - case gmser_api_encoder:decode(unicode:characters_to_binary(S)) of - {Tag, Data} -> {ok, Data}; - {_, _} -> {error, wrong_prefix} - end - catch - error:missing_prefix -> {error, missing_prefix}; - error:incorrect_size -> {error, incorrect_size} - end. - -coerce_list(Type, Elements, Direction) -> - % 0 index since it represents a sophia list - coerce_list(Type, Elements, Direction, 0, [], []). - -coerce_list(Type, [Next | Rest], Direction, Index, Good, Broken) -> - case coerce(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, Direction, Index + 1, Good, [Wrapped | Broken]) - end; -coerce_list(_Type, [], _, _, Good, []) -> - {ok, lists:reverse(Good)}; -coerce_list(_, [], _, _, _, Broken) -> - {error, combine_errors(Broken)}. - -coerce_map(KeyType, ValType, Data, Direction) -> - coerce_map(KeyType, ValType, maps:iterator(Data), Direction, #{}, []). - -coerce_map(KeyType, ValType, Remaining, Direction, Good, Broken) -> - case maps:next(Remaining) of - {K, V, RemainingAfter} -> - coerce_map2(KeyType, ValType, RemainingAfter, Direction, Good, Broken, K, V); - none -> - coerce_map_finish(Good, Broken) - end. - -coerce_map2(KeyType, ValType, Remaining, Direction, Good, Broken, K, V) -> - case coerce(KeyType, K, Direction) of - {ok, 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, Direction, Good, [Wrapped | Broken], K, V, error) - end. - -coerce_map3(KeyType, ValType, Remaining, Direction, Good, Broken, K, V, KFATE) -> - case coerce(ValType, V, Direction) of - {ok, VFATE} -> - NewGood = Good#{KFATE => VFATE}, - coerce_map(KeyType, ValType, Remaining, Direction, NewGood, Broken); - {error, Errors} -> - Wrapped = wrap_errors({map_value, K}, Errors), - coerce_map(KeyType, ValType, Remaining, Direction, Good, [Wrapped | Broken]) - end. - -coerce_map_finish(Good, []) -> - {ok, Good}; -coerce_map_finish(_, Broken) -> - {error, combine_errors(Broken)}. - -lookup_variant(Name, Variants) -> lookup_variant(Name, Variants, 0). - -lookup_variant(Name, [{Name, Terms} | _], Tag) -> - {Tag, Terms}; -lookup_variant(Name, [_ | Rest], Tag) -> - lookup_variant(Name, Rest, Tag + 1); -lookup_variant(_Name, [], _Tag) -> - not_found. - -coerce_tuple(O, N, TermTypes, Terms, Direction) -> - case coerce_tuple_elements(TermTypes, Terms, Direction, tuple_element) of - {ok, 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} -> - single_error({tuple_too_many_terms, O, N, list_to_tuple(Terms)}); - Errors -> Errors - end. - -% Wraps a single error in a list, along with an empty path, so that other -% accumulating error handlers can work with it. -single_error(Reason) -> - {error, [{Reason, []}]}. - -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_tuple_elements(TermTypes, Terms, Direction, adt_element) of - {ok, 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} -> - single_error({adt_too_many_terms, O, N, Name, TermTypes, Terms}); - Errors -> Errors - end. - -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_tuple_elements(Types, Terms, Direction, Tag, 0, [], []). - -coerce_tuple_elements([Type | Types], [Term | Terms], Direction, Tag, Index, Good, Broken) -> - case coerce(Type, Term, Direction) of - {ok, Value} -> - coerce_tuple_elements(Types, Terms, Direction, Tag, Index + 1, [Value | Good], Broken); - {error, Errors} -> - Wrapped = wrap_errors({Tag, Index}, Errors), - coerce_tuple_elements(Types, Terms, Direction, Tag, Index + 1, Good, [Wrapped | Broken]) - end; -coerce_tuple_elements([], [], _, _, _, Good, []) -> - {ok, lists:reverse(Good)}; -coerce_tuple_elements([], [], _, _, _, _, Broken) -> - {error, combine_errors(Broken)}; -coerce_tuple_elements(_, [], _, _, _, _, _) -> - {error, too_few_terms}; -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, to_fate, field) of - {ok, Converted} -> - {ok, {tuple, list_to_tuple(Converted)}}; - Errors -> - Errors - end; - {error, {missing_fields, Missing}} -> - single_error({missing_fields, O, N, Missing}); - {error, {unexpected_fields, Unexpected}} -> - Names = [Name || {Name, _} <- maps:to_list(Unexpected)], - single_error({unexpected_fields, O, N, Names}) - end. - -coerce_record_to_map(O, N, MemberTypes, Tuple) -> - Names = [Name || {Name, _} <- MemberTypes], - Types = [Type || {_, Type} <- 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}); - Errors -> - Errors - 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 cache_aaci(Label, AACI) -> ok when Label :: term(), AACI :: aaci(). @@ -2244,14 +1570,11 @@ lookup_aaci(Label) -> %% prepare_contract/1. This type information, particularly the return type, is %% useful for calling decode_bytearray/2. -aaci_lookup_spec({aaci, _, FunDefs, _}, Fun) -> - case maps:find(Fun, FunDefs) of - A = {ok, _} -> A; - error -> {error, bad_fun_name} - end; +aaci_lookup_spec(AACI = {aaci, _, _, _}, Fun) -> + hz_aaci:get_function_signature(AACI, Fun); aaci_lookup_spec({aaci, Label}, Fun) -> case hz_man:lookup_aaci(Label) of - {ok, AACI} -> aaci_lookup_spec(AACI, Fun); + {ok, AACI} -> hz_aaci:get_function_signature(AACI, Fun); error -> {error, aaci_not_found} end. @@ -2276,7 +1599,7 @@ min_gas_price() -> %% This function always returns 200,000 in the current version. min_gas() -> - 200000. + 200_000. encode_call_data({aaci, _ContractName, FunDefs, _TypeDefs}, Fun, Args) -> @@ -2290,11 +1613,34 @@ encode_call_data({aaci, Label}, Fun, Args) -> error -> {error, aaci_not_found} end. -encode_call_data2(ArgDef, Fun, Args) -> - case coerce_bindings(ArgDef, Args, to_fate) of +encode_call_data2(ArgDef, Fun, {sophia, Args}) -> + case convert(ArgDef, Args) of + {ok, Converted} -> gmb_fate_abi:create_calldata(Fun, Converted); + Errors -> Errors + end; +encode_call_data2(ArgDef, Fun, {erlang, Args}) -> + case hz_aaci:erlang_args_to_fate(ArgDef, Args) of {ok, Coerced} -> gmb_fate_abi:create_calldata(Fun, Coerced); - Errors -> Errors - end. + Errors -> Errors + end; +encode_call_data2(_, Fun, {fate, Args}) -> + % TODO: This should probably be moved back closer to the initiating call. + % 2026-02-13: Craig + gmb_fate_abi:create_calldata(Fun, Args); +encode_call_data2(ArgDef, Fun, Args) -> + encode_call_data2(ArgDef, Fun, {sophia, Args}). + +convert(Defs, Args) -> convert(Defs, Args, 1, [], []). + +convert([{Name, Def} | Defs], [Arg | Args], Nth, Terms, Errors) -> + case hz_sophia:parse_literal(Def, Arg) of + {ok, Term} -> convert(Defs, Args, Nth + 1, [Term | Terms], Errors); + {error, Reason} -> convert(Defs, Args, Nth + 1, Terms, [{Nth, Name, Reason} | Errors]) + end; +convert([], [], _, Terms, []) -> + {ok, lists:reverse(Terms)}; +convert([], [], _, _, Errors) -> + {error, Errors}. sign_tx(Unsigned, SecKey) -> @@ -2612,308 +1958,3 @@ binary_sig_prefix() -> <<"Gajumaru Signed Binary:">>. % /v3/debug/token-supply/height/{height} % /v3/debug/crash - -%%% Simple coerce/3 tests - -% Round trip coerce run for the eunit tests below. If these results don't match -% then the test should fail. -try_coerce(Type, Sophia, Fate) -> - % Run both first, to see if they fail to produce any result. - {ok, FateActual} = coerce(Type, Sophia, to_fate), - {ok, SophiaActual} = coerce(Type, Fate, from_fate), - % Now check that the results were what we expected. - case FateActual of - Fate -> - ok; - _ -> - erlang:error({to_fate_failed, Fate, FateActual}) - end, - case SophiaActual of - Sophia -> - ok; - _ -> - erlang:error({from_fate_failed, Sophia, SophiaActual}) - end, - % Finally, check that the FATE result is something that gmb understands. - gmb_fate_encoding:serialize(Fate), - ok. - -coerce_int_test() -> - {ok, Type} = annotate_type(integer, #{}), - try_coerce(Type, 123, 123). - -coerce_address_test() -> - {ok, Type} = annotate_type(address, #{}), - try_coerce(Type, - "ak_2FTnrGfV8qsfHpaSEHpBrziioCpwwzLqSevHqfxQY3PaAAdARx", - {address, <<164,136,155,90,124,22,40,206,255,76,213,56,238,123, - 167,208,53,78,40,235,2,163,132,36,47,183,228,151,9, - 210,39,214>>}). - -coerce_contract_test() -> - {ok, Type} = annotate_type(contract, #{}), - try_coerce(Type, - "ct_2FTnrGfV8qsfHpaSEHpBrziioCpwwzLqSevHqfxQY3PaAAdARx", - {contract, <<164,136,155,90,124,22,40,206,255,76,213,56,238,123, - 167,208,53,78,40,235,2,163,132,36,47,183,228,151,9, - 210,39,214>>}). - -coerce_signature_test() -> - {ok, Type} = annotate_type(signature, #{}), - try_coerce(Type, - "sg_XDyF8LJC4tpMyAySvpaG1f5V9F2XxAbRx9iuVjvvdNMwVracLhzAuXhRM5kXAFtpwW1DCHuz5jGehUayCah4jub32Ti2n", - <<231,4,97,129,16,173,37,42,194,249,28,94,134,163,208,84,22,135, - 169,85,212,142,14,12,233,252,97,50,193,158,229,51,123,206,222, - 249,2,3,85,173,106,150,243,253,89,128,248,52,195,140,95,114, - 233,110,119,143,206,137,124,36,63,154,85,7>>). - -coerce_signature_binary_test() -> - {ok, Type} = annotate_type(signature, #{}), - Binary = <<231,4,97,129,16,173,37,42,194,249,28,94,134,163,208,84,22,135, - 169,85,212,142,14,12,233,252,97,50,193,158,229,51,123,206,222, - 249,2,3,85,173,106,150,243,253,89,128,248,52,195,140,95,114, - 233,110,119,143,206,137,124,36,63,154,85,7>>, - {ok, Binary} = coerce(Type, {raw, Binary}, to_fate), - {ok, Binary} = coerce(Type, Binary, to_fate), - ok. - -coerce_bool_test() -> - {ok, Type} = annotate_type(boolean, #{}), - try_coerce(Type, true, true), - try_coerce(Type, false, false). - -coerce_string_test() -> - {ok, Type} = annotate_type(string, #{}), - try_coerce(Type, "hello world", <<"hello world">>). - -coerce_list_test() -> - {ok, Type} = annotate_type({list, [string]}, #{}), - try_coerce(Type, ["hello world", [65, 32, 65]], [<<"hello world">>, <<65, 32, 65>>]). - -coerce_map_test() -> - {ok, Type} = annotate_type({map, [string, {list, [integer]}]}, #{}), - try_coerce(Type, #{"a" => "a", "b" => "b"}, #{<<"a">> => "a", <<"b">> => "b"}). - -coerce_tuple_test() -> - {ok, Type} = annotate_type({tuple, [integer, string]}, #{}), - try_coerce(Type, {123, "456"}, {tuple, {123, <<"456">>}}). - -coerce_variant_test() -> - {ok, Type} = annotate_type({variant, [{"A", [integer]}, - {"B", [integer, integer]}]}, - #{}), - try_coerce(Type, {"A", 123}, {variant, [1, 2], 0, {123}}), - try_coerce(Type, {"B", 456, 789}, {variant, [1, 2], 1, {456, 789}}). - -coerce_option_test() -> - {ok, Type} = annotate_type({"option", [integer]}, builtin_typedefs()), - try_coerce(Type, {"None"}, {variant, [0, 1], 0, {}}), - try_coerce(Type, {"Some", 1}, {variant, [0, 1], 1, {1}}). - -coerce_record_test() -> - {ok, Type} = annotate_type({record, [{"a", integer}, {"b", integer}]}, #{}), - try_coerce(Type, #{"a" => 123, "b" => 456}, {tuple, {123, 456}}). - -coerce_bytes_test() -> - {ok, Type} = annotate_type({tuple, [{bytes, [4]}, {bytes, [any]}]}, #{}), - try_coerce(Type, {<<"abcd">>, <<"efghi">>}, {tuple, {<<"abcd">>, <<"efghi">>}}). - -coerce_bits_test() -> - {ok, Type} = annotate_type(bits, #{}), - try_coerce(Type, 5, {bits, 5}). - -coerce_char_test() -> - {ok, Type} = annotate_type(char, #{}), - try_coerce(Type, $?, $?). - -coerce_unicode_test() -> - {ok, Type} = annotate_type(char, #{}), - % Latin Small Letter C with cedilla and acute - {ok, $ḉ} = coerce(Type, <<"ḉ"/utf8>>, to_fate), - ok. - -coerce_hash_test() -> - {ok, Type} = annotate_type("hash", builtin_typedefs()), - Hash = list_to_binary(lists:seq(1,32)), - try_coerce(Type, Hash, Hash), - ok. - - - -%%% Complex AACI paramter and namespace tests - -aaci_from_string(String) -> - case so_compiler:from_string(String, [{aci, json}]) of - {ok, #{aci := ACI}} -> {ok, prepare_aaci(ACI)}; - Error -> Error - end. - -namespace_coerce_test() -> - Contract = " - namespace N = - record pair = { a : int, b : int } - - contract C = - entrypoint f(): N.pair = { a = 1, b = 2 } - ", - {ok, AACI} = aaci_from_string(Contract), - {ok, {[], Output}} = aaci_lookup_spec(AACI, "f"), - try_coerce(Output, #{"a" => 123, "b" => 456}, {tuple, {123, 456}}). - -record_substitution_test() -> - Contract = " - contract C = - record pair('t) = { a : 't, b : 't } - entrypoint f(): pair(int) = { a = 1, b = 2 } - ", - {ok, AACI} = aaci_from_string(Contract), - {ok, {[], Output}} = aaci_lookup_spec(AACI, "f"), - try_coerce(Output, #{"a" => 123, "b" => 456}, {tuple, {123, 456}}). - -tuple_substitution_test() -> - Contract = " - contract C = - type triple('t1, 't2) = int * 't1 * 't2 - entrypoint f(): triple(int, string) = (1, 2, \"hello\") - ", - {ok, AACI} = aaci_from_string(Contract), - {ok, {[], Output}} = aaci_lookup_spec(AACI, "f"), - try_coerce(Output, {1, 2, "hello"}, {tuple, {1, 2, <<"hello">>}}). - -variant_substitution_test() -> - Contract = " - contract C = - datatype adt('a, 'b) = Left('a, 'b) | Right('b, int) - entrypoint f(): adt(string, int) = Left(\"hi\", 1) - ", - {ok, AACI} = aaci_from_string(Contract), - {ok, {[], Output}} = aaci_lookup_spec(AACI, "f"), - try_coerce(Output, {"Left", "hi", 1}, {variant, [2, 2], 0, {<<"hi">>, 1}}), - try_coerce(Output, {"Right", 2, 3}, {variant, [2, 2], 1, {2, 3}}). - -nested_coerce_test() -> - Contract = " - contract C = - type pair('t) = 't * 't - record r = { f1 : pair(int), f2: pair(string) } - entrypoint f(): r = { f1 = (1, 2), f2 = (\"a\", \"b\") } - ", - {ok, AACI} = aaci_from_string(Contract), - {ok, {[], Output}} = aaci_lookup_spec(AACI, "f"), - try_coerce(Output, - #{ "f1" => {1, 2}, "f2" => {"a", "b"}}, - {tuple, {{tuple, {1, 2}}, {tuple, {<<"a">>, <<"b">>}}}}). - -state_coerce_test() -> - Contract = " - contract C = - type state = int - entrypoint init(): state = 0 - ", - {ok, AACI} = aaci_from_string(Contract), - {ok, {[], Output}} = aaci_lookup_spec(AACI, "init"), - try_coerce(Output, 0, 0). - -param_test() -> - Contract = " - contract C = - type state = int - entrypoint init(x): state = x - ", - {ok, AACI} = aaci_from_string(Contract), - {ok, {[{"x", Input}], Output}} = aaci_lookup_spec(AACI, "init"), - try_coerce(Input, 0, 0), - try_coerce(Output, 0, 0). - -%%% Obscure Sophia types where we should check the AACI as well - -obscure_aaci_test() -> - Contract = " - include \"Set.aes\" - contract C = - entrypoint options(): option(int) = None - entrypoint fixed_bytes(): bytes(4) = #DEADBEEF - entrypoint any_bytes(): bytes() = Bytes.to_any_size(#112233) - entrypoint bits(): bits = Bits.all - entrypoint character(): char = 'a' - entrypoint hash(): hash = #00112233445566778899AABBCCDDEEFF00112233445566778899AABBCCDDEEFF - entrypoint unit(): unit = () - - entrypoint ttl(x): Chain.ttl = FixedTTL(x) - entrypoint paying_for(x, y): Chain.paying_for_tx = Chain.PayingForTx(x, y) - entrypoint ga_meta_tx(x, y): Chain.ga_meta_tx = Chain.GAMetaTx(x, y) - entrypoint base_tx(x, y, z): Chain.base_tx = Chain.SpendTx(x, y, z) - entrypoint tx(a, b, c, d, e, f): Chain.tx = - {paying_for = a, - ga_metas = b, - actor = c, - fee = d, - ttl = e, - tx = f} - - entrypoint pointee(x): AENS.pointee = AENS.AccountPt(x) - entrypoint name(x, y, z): AENS.name = AENS.Name(x, y, z) - entrypoint pointee2(x): AENSv2.pointee = AENSv2.DataPt(x) - entrypoint name2(x, y, z): AENSv2.name = AENSv2.Name(x, y, z) - - entrypoint fr(x): MCL_BLS12_381.fr = x - entrypoint fp(x): MCL_BLS12_381.fp = x - - entrypoint set(): Set.set(int) = Set.new() - - ", - {ok, AACI} = aaci_from_string(Contract), - - {ok, {[], {{bytes, [4]}, _, _}}} = aaci_lookup_spec(AACI, "fixed_bytes"), - {ok, {[], {{bytes, [any]}, _, _}}} = aaci_lookup_spec(AACI, "any_bytes"), - {ok, {[], {bits, _, _}}} = aaci_lookup_spec(AACI, "bits"), - {ok, {[], {char, _, _}}} = aaci_lookup_spec(AACI, "character"), - - {ok, {[], {{"option", [integer]}, _, {variant, [{"None", []}, {"Some", [_]}]}}}} = aaci_lookup_spec(AACI, "options"), - {ok, {[], {"hash", _, {bytes, [32]}}}} = aaci_lookup_spec(AACI, "hash"), - {ok, {[], {"unit", _, {tuple, []}}}} = aaci_lookup_spec(AACI, "unit"), - - {ok, {_, {"Chain.ttl", _, {variant, _}}}} = aaci_lookup_spec(AACI, "ttl"), - {ok, {_, {"Chain.paying_for_tx", _, {variant, _}}}} = aaci_lookup_spec(AACI, "paying_for"), - {ok, {_, {"Chain.ga_meta_tx", _, {variant, _}}}} = aaci_lookup_spec(AACI, "ga_meta_tx"), - {ok, {_, {"Chain.base_tx", _, {variant, _}}}} = aaci_lookup_spec(AACI, "base_tx"), - {ok, {_, {"Chain.tx", _, {record, _}}}} = aaci_lookup_spec(AACI, "tx"), - - {ok, {_, {"AENS.pointee", _, {variant, _}}}} = aaci_lookup_spec(AACI, "pointee"), - {ok, {_, {"AENS.name", _, {variant, _}}}} = aaci_lookup_spec(AACI, "name"), - {ok, {_, {"AENSv2.pointee", _, {variant, _}}}} = aaci_lookup_spec(AACI, "pointee2"), - {ok, {_, {"AENSv2.name", _, {variant, _}}}} = aaci_lookup_spec(AACI, "name2"), - - {ok, {_, {"MCL_BLS12_381.fr", _, {bytes, [32]}}}} = aaci_lookup_spec(AACI, "fr"), - {ok, {_, {"MCL_BLS12_381.fp", _, {bytes, [48]}}}} = aaci_lookup_spec(AACI, "fp"), - - {ok, {[], {{"Set.set", [integer]}, _, {record, [{"to_map", _}]}}}} = aaci_lookup_spec(AACI, "set"), - - ok. - -name_coerce_test() -> - AddrSoph = "ak_2FTnrGfV8qsfHpaSEHpBrziioCpwwzLqSevHqfxQY3PaAAdARx", - AddrFate = {address, <<164,136,155,90,124,22,40,206,255,76,213,56,238,123, - 167,208,53,78,40,235,2,163,132,36,47,183,228,151,9, - 210,39,214>>}, - {ok, TTL} = annotate_type("Chain.ttl", builtin_typedefs()), - TTLSoph = {"FixedTTL", 0}, - TTLFate = {variant, [1, 1], 0, {0}}, - try_coerce(TTL, TTLSoph, TTLFate), - {ok, Pointee} = annotate_type("AENS.pointee", builtin_typedefs()), - PointeeSoph = {"AccountPt", AddrSoph}, - PointeeFate = {variant, [1, 1, 1, 1], 0, {AddrFate}}, - try_coerce(Pointee, PointeeSoph, PointeeFate), - {ok, Name} = annotate_type("AENS.name", builtin_typedefs()), - NameSoph = {"Name", AddrSoph, TTLSoph, #{"myname" => PointeeSoph}}, - NameFate = {variant, [3], 0, {AddrFate, TTLFate, #{<<"myname">> => PointeeFate}}}, - try_coerce(Name, NameSoph, NameFate). - -void_coerce_test() -> - % Void itself can't be represented, but other types built out of void are - % valid. - {ok, NonOption} = annotate_type({"option", ["void"]}, builtin_typedefs()), - try_coerce(NonOption, {"None"}, {variant, [0, 1], 0, {}}), - {ok, NonList} = annotate_type({list, ["void"]}, builtin_typedefs()), - try_coerce(NonList, [], []). - diff --git a/src/hz_aaci.erl b/src/hz_aaci.erl new file mode 100644 index 0000000..de28f55 --- /dev/null +++ b/src/hz_aaci.erl @@ -0,0 +1,1269 @@ +%%% @doc +%%% Sophia datatype manipulations for Hakuzaru +%%% +%%% Sophia and FATE are two subtly different machine languages with two +%%% different type systems. Application developers probably think about their +%%% smart contracts in terms of the Sophia types, but the node will only accept +%%% the corresponding FATE types, and both of these type systems result in +%%% different erlang terms for representing the same thing. This module defines +%%% the conversion between these different representations of the same data. +%%% @end + +-module(hz_aaci). +-vsn("0.9.0"). +-author("Jarvis Carroll "). +-copyright("Craig Everett "). +-license("GPL-3.0-or-later"). + +% Contract call and serialization interface functions +-export([prepare_from_file/1, + prepare/1, + erlang_to_fate/2, + fate_to_erlang/2, + erlang_args_to_fate/2, + get_function_signature/2]). + +%%% Types + +-export_type([aaci/0, annotated_type/0, erlang_repr/0]). + +-include_lib("eunit/include/eunit.hrl"). + +-type aaci() :: {aaci, string(), #{string() => function_spec()}, #{string() => typedef()}}. +-type function_spec() :: {[{string(), annotated_type()}], annotated_type()}. +-type typedef() :: {[string()], typedef_rhs()}. + +-type annotated_type() :: {opaque_type(), already_normalized | opaque_type(), builtin_type(annotated_type())}. +-type builtin_type(T) :: {bytes, [integer() | any]} + | {record, [{string(), T}]} + | {variant, [{string(), [T]}]} + | {tuple, [T]} + | {list, [T]} + | {map, [T]} + | integer + | boolean + | bits + | char + | string + | address + | signature + | contract + | channel + | unknown_type. + +-type opaque_type() :: string() | {string(), [opaque_type()]} | builtin_type(opaque_type()). + +-type typedef_rhs() :: {var, string()} | string() | {string(), [opaque_type()]} | builtin_type(typedef_rhs()). + +-type erlang_repr() :: integer() + | string() + | boolean() + | binary() + | tuple() % Tuples, variants, or raw addresses + | [erlang_repr()] + | #{erlang_repr() => erlang_repr()}. + +%%% ACI/AACI + +-spec prepare_from_file(Path) -> {ok, AACI} | {error, Reason} + when Path :: file:filename(), + AACI :: aaci(), + Reason :: term(). +%% @doc +%% Compile a contract and extract the function spec meta for use in future formation +%% of calldata + +prepare_from_file(Path) -> + case so_compiler:file(Path, [{aci, json}]) of + {ok, #{aci := ACI}} -> {ok, prepare(ACI)}; + Error -> Error + end. + +-spec prepare(ACI) -> AACI + when ACI :: term(), + AACI :: aaci(). + +prepare(ACI) -> + % We want to take the types represented by the ACI, things like N1.T(N2.T), + % and dereference them down to concrete types like + % {tuple, [integer, string]}. Our type dereferencing algorithms + % shouldn't act directly on the JSON-based structures that the compiler + % gives us, though, though, so before we do the analysis, we should strip + % the ACI down to a list of 'opaque' type defintions and function specs. + {Name, OpaqueSpecs, TypeDefs} = convert_aci_types(ACI), + + % Now that we have the opaque types, we can dereference the function specs + % down to the concrete types they actually represent. We annotate each + % subexpression of this concrete type with other info too, in case it helps + % make error messages easier to understand. + InternalTypeDefs = maps:merge(builtin_typedefs(), TypeDefs), + Specs = annotate_function_specs(OpaqueSpecs, InternalTypeDefs, #{}), + + {aaci, Name, Specs, TypeDefs}. + +-spec convert_aci_types(ACI) -> {Name, OpaqueSpecs, TypeDefs} + when ACI :: term(), + Name :: string(), + OpaqueSpecs :: [{string(), [{string(), opaque_type()}], opaque_type()}], + TypeDefs :: #{string() => typedef()}. + +convert_aci_types(ACI) -> + % Find the main contract, so we can get the specifications of its + % entrypoints. + [{NameBin, SpecDefs}] = + [{N, F} + || #{contract := #{kind := contract_main, + functions := F, + name := N}} <- ACI], + Name = binary_to_list(NameBin), + % Turn these specifications into opaque types that we can reason about. + Specs = lists:map(fun convert_function_spec/1, SpecDefs), + + % These specifications can reference other type definitions from the main + % contract and any other namespaces, so extract these types and convert + % them too. + TypeDefTree = lists:map(fun convert_namespace_typedefs/1, ACI), + % The tree structure of the ACI naturally leads to a tree of opaque types, + % but we want a map, so flatten it out before we continue. + TypeDefMap = collect_opaque_types(TypeDefTree, #{}), + + % This is all the information we actually need from the ACI, the rest is + % just pre-compute and acceleration. + {Name, Specs, TypeDefMap}. + +convert_function_spec(#{name := NameBin, arguments := Args, returns := Result}) -> + Name = binary_to_list(NameBin), + ArgTypes = lists:map(fun convert_arg/1, Args), + ResultType = opaque_type([], Result), + {Name, ArgTypes, ResultType}. + +convert_arg(#{name := NameBin, type := TypeDef}) -> + Name = binary_to_list(NameBin), + Type = opaque_type([], TypeDef), + {Name, Type}. + +convert_namespace_typedefs(#{namespace := NS}) -> + Name = namespace_name(NS), + convert_typedefs(NS, Name); +convert_namespace_typedefs(#{contract := NS}) -> + Name = namespace_name(NS), + ImplicitTypes = convert_implicit_types(NS, Name), + ExplicitTypes = convert_typedefs(NS, Name), + [ImplicitTypes, ExplicitTypes]. + +namespace_name(#{name := NameBin}) -> + binary_to_list(NameBin). + +convert_implicit_types(#{state := StateDefACI}, Name) -> + StateDefOpaque = opaque_type([], StateDefACI), + [{Name, [], contract}, + {Name ++ ".state", [], StateDefOpaque}]; +convert_implicit_types(_, Name) -> + [{Name, [], contract}]. + +convert_typedefs(#{typedefs := TypeDefs}, Name) -> + convert_typedefs_loop(TypeDefs, Name ++ ".", []). + +% Take a namespace that has already had a period appended, and use that as a +% prefix to convert and annotate a list of types. +convert_typedefs_loop([], _NamePrefix, Converted) -> + Converted; +convert_typedefs_loop([Next | Rest], NamePrefix, Converted) -> + #{name := NameBin, vars := ParamDefs, typedef := DefACI} = Next, + Name = NamePrefix ++ binary_to_list(NameBin), + Params = [binary_to_list(Param) || #{name := Param} <- ParamDefs], + Def = opaque_type(Params, DefACI), + convert_typedefs_loop(Rest, NamePrefix, [Converted, {Name, Params, Def}]). + +-spec collect_opaque_types(Tree, TypeDefs) -> TypeDefs + when Tree :: typedef_tree(), + TypeDefs :: #{string() => typedef()}. + +-type typedef_tree() :: {string(), [string()], typedef_rhs()} | list(typedef_tree()). + +collect_opaque_types([], Types) -> + Types; +collect_opaque_types([L | R], Types) -> + NewTypes = collect_opaque_types(L, Types), + collect_opaque_types(R, NewTypes); +collect_opaque_types({Name, Params, Def}, Types) -> + maps:put(Name, {Params, Def}, Types). + +%%% ACI Type -> Opaque Type + +-spec opaque_type(Params, ACIType) -> Opaque + when Params :: [string()], + ACIType :: binary() | map(), + Opaque :: typedef_rhs(). + +% Convert an ACI type defintion/spec into the 'opaque type' representation that +% our dereferencing algorithms can reason about. +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; +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(_, #{bytes := Count}) -> + {bytes, [Count]}; +opaque_type(Params, Pair) when is_map(Pair) -> + [{Name, TypeArgs}] = maps:to_list(Pair), + {opaque_type_name(Name), [opaque_type(Params, Arg) || Arg <- TypeArgs]}. + +-spec opaque_type_name(binary()) -> atom() | string(). + +% Atoms for any builtins that aren't qualified by a namespace in Sophia. +% Everything else stays as a string, user-defined or not. +opaque_type_name(<<"int">>) -> integer; +opaque_type_name(<<"bool">>) -> boolean; +opaque_type_name(<<"bits">>) -> bits; +opaque_type_name(<<"char">>) -> char; +opaque_type_name(<<"string">>) -> string; +opaque_type_name(<<"address">>) -> address; +opaque_type_name(<<"signature">>) -> signature; +opaque_type_name(<<"contract">>) -> contract; +opaque_type_name(<<"list">>) -> list; +opaque_type_name(<<"map">>) -> map; +% I'm not sure how to produce channels in Sophia source, but they seem to exist +% in gmb still. +opaque_type_name(<<"channel">>) -> channel; +opaque_type_name(Name) -> binary_to_list(Name). + +builtin_typedefs() -> + #{"unit" => {[], {tuple, []}}, + "void" => {[], {variant, []}}, + "hash" => {[], {bytes, [32]}}, + "option" => {["'T"], {variant, [{"None", []}, + {"Some", [{var, "'T"}]}]}}, + "Chain.ttl" => {[], {variant, [{"FixedTTL", [integer]}, + {"RelativeTTL", [integer]}]}}, + "AENS.pointee" => {[], {variant, [{"AccountPt", [address]}, + {"OraclePt", [address]}, + {"ContractPt", [address]}, + {"ChannelPt", [address]}]}}, + "AENS.name" => {[], {variant, [{"Name", [address, + "Chain.ttl", + {map, [string, "AENS.pointee"]}]}]}}, + "AENSv2.pointee" => {[], {variant, [{"AccountPt", [address]}, + {"OraclePt", [address]}, + {"ContractPt", [address]}, + {"ChannelPt", [address]}, + {"DataPt", [{bytes, [any]}]}]}}, + "AENSv2.name" => {[], {variant, [{"Name", [address, + "Chain.ttl", + {map, [string, "AENSv2.pointee"]}]}]}}, + "Chain.ga_meta_tx" => {[], {variant, [{"GAMetaTx", [address, integer]}]}}, + "Chain.paying_for_tx" => {[], {variant, [{"PayingForTx", [address, integer]}]}}, + "Chain.base_tx" => {[], {variant, [{"SpendTx", [address, integer, string]}, + {"OracleRegisterTx", []}, + {"OracleQueryTx", []}, + {"OracleResponseTx", []}, + {"OracleExtendTx", []}, + {"NamePreclaimTx", []}, + {"NameClaimTx", ["hash"]}, + {"NameUpdateTx", [string]}, + {"NameRevokeTx", ["hash"]}, + {"NameTransferTx", [address, string]}, + {"ChannelCreateTx", [address]}, + {"ChannelDepositTx", [address, integer]}, + {"ChannelWithdrawTx", [address, integer]}, + {"ChannelForceProgressTx", [address]}, + {"ChannelCloseMutualTx", [address]}, + {"ChannelCloseSoloTx", [address]}, + {"ChannelSlashTx", [address]}, + {"ChannelSettleTx", [address]}, + {"ChannelSnapshotSoloTx", [address]}, + {"ContractCreateTx", [integer]}, + {"ContractCallTx", [address, integer]}, + {"GAAttachTx", []}]}}, + "Chain.tx" => {[], {record, [{"paying_for", {"option", ["Chain.paying_for_tx"]}}, + {"ga_metas", {list, ["Chain.ga_meta_tx"]}}, + {"actor", address}, + {"fee", integer}, + {"ttl", integer}, + {"tx", "Chain.base_tx"}]}}, + "MCL_BLS12_381.fr" => {[], {bytes, [32]}}, + "MCL_BLS12_381.fp" => {[], {bytes, [48]}} + }. + +%%% Opaque Type -> Accelerated 'Annotated' Type + +% 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 gmbytecode 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 dereferenced +% 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 dereferenced 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. + +annotate_function_specs([], _Types, Specs) -> + Specs; +annotate_function_specs([{Name, ArgsOpaque, ResultOpaque} | Rest], Types, Specs) -> + {ok, Args} = annotate_bindings(ArgsOpaque, Types, []), + {ok, Result} = annotate_type(ResultOpaque, Types), + NewSpecs = maps:put(Name, {Args, Result}, Specs), + annotate_function_specs(Rest, Types, NewSpecs). + +-spec annotate_type(Opaque, Types) -> {ok, Annotated} | {error, Reason} + when Opaque :: opaque_type(), + Types :: #{string() => typedef()}, + Annotated :: annotated_type(), + Reason :: none(). + +annotate_type(T, Types) -> + case normalize_opaque_type(T, Types) of + {ok, AlreadyNormalized, NOpaque, NExpanded} -> + annotate_type2(T, AlreadyNormalized, NOpaque, NExpanded, Types); + Error -> + Error + end. + +annotate_type2(T, _, _, unknown_type, _) -> + % If a type is unknown, then it should not be reported as the normalized + % name. + {ok, {T, unknown_type, unknown_type}}; +annotate_type2(T, AlreadyNormalized, NOpaque, NExpanded, Types) -> + case annotate_type_subexpressions(NExpanded, Types) of + {ok, Flat} -> + case AlreadyNormalized of + true -> {ok, {T, already_normalized, Flat}}; + false -> {ok, {T, NOpaque, Flat}} + end; + Error -> + Error + end. + +annotate_types([T | Rest], Types, Acc) -> + case annotate_type(T, Types) of + {ok, Type} -> annotate_types(Rest, Types, [Type | Acc]); + Error -> Error + end; +annotate_types([], _Types, Acc) -> + {ok, lists:reverse(Acc)}. + +annotate_type_subexpressions(PrimitiveType, _Types) when is_atom(PrimitiveType) -> + {ok, PrimitiveType}; +annotate_type_subexpressions({bytes, [Count]}, _Types) -> + % bytes is weird, because it has an argument, but that argument isn't an + % opaque type. + {ok, {bytes, [Count]}}; +annotate_type_subexpressions({variant, VariantsOpaque}, Types) -> + case annotate_variants(VariantsOpaque, Types, []) of + {ok, Variants} -> {ok, {variant, Variants}}; + Error -> Error + end; +annotate_type_subexpressions({record, FieldsOpaque}, Types) -> + case annotate_bindings(FieldsOpaque, Types, []) of + {ok, Fields} -> {ok, {record, Fields}}; + Error -> Error + end; +annotate_type_subexpressions({T, ElemsOpaque}, Types) -> + case annotate_types(ElemsOpaque, Types, []) of + {ok, Elems} -> {ok, {T, Elems}}; + Error -> Error + end. + +annotate_bindings([{Name, T} | Rest], Types, Acc) -> + case annotate_type(T, Types) of + {ok, Type} -> annotate_bindings(Rest, Types, [{Name, Type} | Acc]); + Error -> Error + end; +annotate_bindings([], _Types, Acc) -> + {ok, lists:reverse(Acc)}. + +annotate_variants([{Name, Elems} | Rest], Types, Acc) -> + case annotate_types(Elems, Types, []) of + {ok, ElemsFlat} -> annotate_variants(Rest, Types, [{Name, ElemsFlat} | Acc]); + Error -> Error + end; +annotate_variants([], _Types, Acc) -> + {ok, lists:reverse(Acc)}. + +% This function evaluates type aliases in a loop, until eventually a usable +% definition is found. +normalize_opaque_type(T, Types) -> normalize_opaque_type(T, Types, true). + +% 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(T, _Types, IsFirst) when is_atom(T) -> + % Once we have eliminated the above rewrite cases, all other cases are + % handled explicitly by the coerce logic, and so are considered normalized. + {ok, IsFirst, T, T}; +normalize_opaque_type(Type = {T, _}, _Types, IsFirst) when is_atom(T) -> + % Once we have eliminated the above rewrite cases, all other cases are + % handled explicitly by the coerce logic, and so are considered normalized. + {ok, IsFirst, Type, Type}; +normalize_opaque_type(T, Types, IsFirst) when is_list(T) -> + % Lists/strings indicate userspace types, which may require arg + % substitutions. Convert to an explicit but empty arg list, for uniformity. + normalize_opaque_type({T, []}, Types, IsFirst); +normalize_opaque_type({T, TypeArgs}, Types, IsFirst) when is_list(T) -> + case maps:find(T, Types) of + error -> + % We couldn't find this named type... Keep building the AACI, but + % mark this type expression as unknown, so that FATE coercions + % aren't attempted. + {ok, IsFirst, {T, TypeArgs}, unknown_type}; + {ok, {TypeParamNames, Definition}} -> + % We have a definition for this type, including names for whatever + % args we have been given. Subtitute our args into this. + NewType = substitute_opaque_type(TypeParamNames, Definition, TypeArgs), + % Now continue on to see if we need to restart the loop or not. + normalize_opaque_type2(IsFirst, {T, TypeArgs}, NewType, Types) + end. + +normalize_opaque_type2(IsFirst, PrevType, NextType = {variant, _}, _) -> + % We have reduced to a variant. Report the type name as the normalized + % type, but also provide the variant definition itself as the candidate + % flattened type for further annotation. + {ok, IsFirst, PrevType, NextType}; +normalize_opaque_type2(IsFirst, PrevType, NextType = {record, _}, _) -> + % We have reduced to a record. Report the type name as the normalized + % type, but also provide the record definition itself as the candidate + % flattened type for further annotation. + {ok, IsFirst, PrevType, NextType}; +normalize_opaque_type2(_, _, NextType, Types) -> + % Not a variant or record yet, so go back to the start of the loop. + % It will no longer be the first iteration. + normalize_opaque_type(NextType, Types, false). + +% Perform a beta-reduction on a type expression. +substitute_opaque_type([], Definition, _) -> + % There are no parameters to substitute. This is the simplest way of + % defining type aliases, records, and variants, so we should make sure to + % short circuit all the recursive descent logic, since it won't actually + % do anything. + Definition; +substitute_opaque_type(TypeParamNames, Definition, TypeArgs) -> + % Bundle the param names alongside the args that we want to substitute, so + % that we can keyfind the one list. + Bindings = lists:zip(TypeParamNames, TypeArgs), + substitute_opaque_type(Bindings, Definition). + +substitute_opaque_type(Bindings, {var, VarName}) -> + case lists:keyfind(VarName, 1, Bindings) of + {_, TypeArg} -> TypeArg; + % No valid ACI will create this case. Regardless, the user should + % still be able to specify arbitrary gmb FATE terms for whatever this + % is meant to be. + false -> unknown_type + end; +substitute_opaque_type(Bindings, {variant, Variants}) -> + Each = fun({VariantName, Elements}) -> + NewElements = substitute_opaque_types(Bindings, Elements), + {VariantName, NewElements} + end, + NewVariants = lists:map(Each, Variants), + {variant, NewVariants}; +substitute_opaque_type(Bindings, {record, Fields}) -> + Each = fun({FieldName, FieldType}) -> + NewType = substitute_opaque_type(Bindings, FieldType), + {FieldName, NewType} + end, + NewFields = lists:map(Each, Fields), + {record, NewFields}; +substitute_opaque_type(Bindings, {Connective, Args}) -> + NewArgs = substitute_opaque_types(Bindings, Args), + {Connective, NewArgs}; +substitute_opaque_type(_Bindings, Type) -> + Type. + +substitute_opaque_types(Bindings, Types) -> + Each = fun(Type) -> substitute_opaque_type(Bindings, Type) end, + lists:map(Each, Types). + +%%% Erlang to FATE + +-spec erlang_args_to_fate(VarTypes, Terms) -> {ok, FATE} | {error, Errors} + when VarTypes :: [{string(), annotated_type()}], + Terms :: [erlang_repr()], + FATE :: gmb_fate_data:fate_type(), + Errors :: [{Reason, [PathStep]}], + Reason :: term(), + PathStep :: term(). + +erlang_args_to_fate(VarTypes, Terms) -> + DefLength = length(VarTypes), + ArgLength = length(Terms), + if + 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. + +-spec erlang_to_fate(Type, Erlang) -> {ok, FATE} | {error, Errors} + when Type :: annotated_type(), + FATE :: gmb_fate_data:fate_type(), + Erlang :: erlang_repr(), + Errors :: [{Reason, [PathStep]}], + Reason :: term(), + PathStep :: term(). + +erlang_to_fate({_, _, integer}, S) when is_integer(S) -> + {ok, S}; +erlang_to_fate({O, N, integer}, S) when is_list(S) -> + try + Val = list_to_integer(S), + {ok, Val} + catch + error:badarg -> single_error({invalid, O, N, S}) + end; +erlang_to_fate({O, N, address}, S) -> + coerce_chain_object(O, N, address, account_pubkey, S); +erlang_to_fate({O, N, contract}, S) -> + coerce_chain_object(O, N, contract, contract_pubkey, S); +erlang_to_fate({_, _, signature}, S) when is_binary(S) andalso (byte_size(S) =:= 64) -> + % Usually to pass a binary in, you need to wrap it as {raw, Binary}, but + % since sg_... strings OR hex blobs can be used as signatures in Sophia, we + % special case this case based on the length. Even if a binary starts with + % "sg_", 64 characters is not enough to represent a 64 byte signature, so + % the most optimistic interpretation is to use the binary directly. + {ok, S}; +erlang_to_fate({O, N, signature}, S) -> + coerce_chain_object(O, N, signature, signature, S); +%erlang_to_fate({_, _, channel}, S) when is_binary(S) -> + %{ok, {channel, S}}; +erlang_to_fate({_, _, boolean}, true) -> + {ok, true}; +erlang_to_fate({_, _, boolean}, "true") -> + {ok, true}; +erlang_to_fate({_, _, boolean}, false) -> + {ok, false}; +erlang_to_fate({_, _, boolean}, "false") -> + {ok, false}; +erlang_to_fate({O, N, string}, Str) -> + case unicode:characters_to_binary(Str) of + {error, _, _} -> + single_error({invalid, O, N, Str}); + {incomplete, _, _} -> + single_error({invalid, O, N, Str}); + StrBin -> + {ok, StrBin} + end; +erlang_to_fate({_, _, char}, Val) when is_integer(Val) -> + {ok, Val}; +erlang_to_fate({O, N, char}, Str) -> + Result = unicode:characters_to_list(Str), + case Result of + {error, _, _} -> + single_error({invalid, O, N, Str}); + {incomplete, _, _} -> + single_error({invalid, O, N, Str}); + [C] -> + {ok, C}; + _ -> + single_error({invalid, O, N, Str}) + end; +erlang_to_fate({O, N, {bytes, [Count]}}, Bytes) when is_bitstring(Bytes) -> + 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) -> + Size = bit_size(Bits), + <> = Bits, + {ok, {bits, IntValue}}; +erlang_to_fate({_, _, {list, [Type]}}, Data) when is_list(Data) -> + coerce_list(Type, Data, to_fate); +erlang_to_fate({_, _, {map, [KeyType, ValType]}}, Data) when is_map(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, 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, to_fate); + not_found -> + ValidNames = [Valid || {Valid, _} <- Variants], + single_error({invalid_variant, O, N, Name, ValidNames}) + end; +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) -> + 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}). + +coerce_chain_object(_, _, _, _, {raw, Binary}) -> + {ok, Binary}; +coerce_chain_object(O, N, T, Tag, S) -> + case decode_chain_object(Tag, S) of + {ok, Data} -> {ok, coerce_chain_object2(T, Data)}; + {error, Reason} -> single_error({Reason, O, N, S}) + end. + +coerce_chain_object2(address, Data) -> {address, Data}; +coerce_chain_object2(contract, Data) -> {contract, Data}; +coerce_chain_object2(signature, Data) -> Data. + +decode_chain_object(Tag, S) -> + try + case gmser_api_encoder:decode(unicode:characters_to_binary(S)) of + {Tag, Data} -> {ok, Data}; + {_, _} -> {error, wrong_prefix} + end + catch + error:missing_prefix -> {error, missing_prefix}; + error:incorrect_size -> {error, incorrect_size} + end. + +coerce_bytes(O, N, _, Bytes) when bit_size(Bytes) rem 8 /= 0 -> + single_error({partial_bytes, O, N, bit_size(Bytes)}); +coerce_bytes(_, _, any, Bytes) -> + {ok, Bytes}; +coerce_bytes(O, N, Count, Bytes) when byte_size(Bytes) /= Count -> + single_error({incorrect_size, O, N, Bytes}); +coerce_bytes(_, _, _, Bytes) -> + {ok, Bytes}. + +coerce_zipped_bindings(Bindings, Direction, Tag) -> + coerce_zipped_bindings(Bindings, Direction, Tag, [], []). + +coerce_zipped_bindings([Next | Rest], Direction, Tag, Good, Broken) -> + {{ArgName, Type}, Term} = Next, + case coerce_direction(Type, Term, Direction) of + {ok, NewTerm} -> + coerce_zipped_bindings(Rest, Direction, Tag, [NewTerm | Good], Broken); + {error, Errors} -> + Wrapped = wrap_errors({Tag, ArgName}, Errors), + coerce_zipped_bindings(Rest, Direction, Tag, Good, [Wrapped | Broken]) + end; +coerce_zipped_bindings([], _, _, Good, []) -> + {ok, lists:reverse(Good)}; +coerce_zipped_bindings([], _, _, _, Broken) -> + {error, combine_errors(Broken)}. + +coerce_list(Type, Elements, Direction) -> + % 0 index since it represents a sophia list + coerce_list(Type, Elements, Direction, 0, [], []). + +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, Direction, Index + 1, Good, [Wrapped | Broken]) + end; +coerce_list(_Type, [], _, _, Good, []) -> + {ok, lists:reverse(Good)}; +coerce_list(_, [], _, _, _, Broken) -> + {error, combine_errors(Broken)}. + +coerce_map(KeyType, ValType, Data, Direction) -> + coerce_map(KeyType, ValType, maps:iterator(Data), Direction, #{}, []). + +coerce_map(KeyType, ValType, Remaining, Direction, Good, Broken) -> + case maps:next(Remaining) of + {K, V, RemainingAfter} -> + coerce_map2(KeyType, ValType, RemainingAfter, Direction, Good, Broken, K, V); + none -> + coerce_map_finish(Good, Broken) + end. + +coerce_map2(KeyType, ValType, Remaining, Direction, Good, Broken, K, V) -> + case coerce_direction(KeyType, K, Direction) of + {ok, 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, Direction, Good, [Wrapped | Broken], K, V, error) + end. + +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, Direction, NewGood, Broken); + {error, Errors} -> + Wrapped = wrap_errors({map_value, K}, Errors), + coerce_map(KeyType, ValType, Remaining, Direction, Good, [Wrapped | Broken]) + end. + +coerce_map_finish(Good, []) -> + {ok, Good}; +coerce_map_finish(_, Broken) -> + {error, combine_errors(Broken)}. + +lookup_variant(Name, Variants) -> lookup_variant(Name, Variants, 0). + +lookup_variant(Name, [{Name, Terms} | _], Tag) -> + {Tag, Terms}; +lookup_variant(Name, [_ | Rest], Tag) -> + lookup_variant(Name, Rest, Tag + 1); +lookup_variant(_Name, [], _Tag) -> + not_found. + +coerce_tuple(O, N, TermTypes, Terms, Direction) -> + case coerce_tuple_elements(TermTypes, Terms, Direction, tuple_element) of + {ok, 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} -> + single_error({tuple_too_many_terms, O, N, list_to_tuple(Terms)}); + Errors -> Errors + end. + +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_tuple_elements(TermTypes, Terms, Direction, adt_element) of + {ok, 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} -> + single_error({adt_too_many_terms, O, N, Name, TermTypes, Terms}); + Errors -> Errors + end. + +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_tuple_elements(Types, Terms, Direction, Tag, 0, [], []). + +coerce_tuple_elements([Type | Types], [Term | Terms], Direction, Tag, Index, Good, Broken) -> + case coerce_direction(Type, Term, Direction) of + {ok, Value} -> + coerce_tuple_elements(Types, Terms, Direction, Tag, Index + 1, [Value | Good], Broken); + {error, Errors} -> + Wrapped = wrap_errors({Tag, Index}, Errors), + coerce_tuple_elements(Types, Terms, Direction, Tag, Index + 1, Good, [Wrapped | Broken]) + end; +coerce_tuple_elements([], [], _, _, _, Good, []) -> + {ok, lists:reverse(Good)}; +coerce_tuple_elements([], [], _, _, _, _, Broken) -> + {error, combine_errors(Broken)}; +coerce_tuple_elements(_, [], _, _, _, _, _) -> + {error, too_few_terms}; +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, to_fate, field) of + {ok, Converted} -> + {ok, {tuple, list_to_tuple(Converted)}}; + Errors -> + Errors + end; + {error, {missing_fields, Missing}} -> + single_error({missing_fields, O, N, Missing}); + {error, {unexpected_fields, Unexpected}} -> + Names = [Name || {Name, _} <- maps:to_list(Unexpected)], + 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}); + Errors -> + Errors + 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. + +% Wraps a single error in a list, along with an empty path, so that other +% accumulating error handlers can work with it. +single_error(Reason) -> + {error, [{Reason, []}]}. + +wrap_errors(Location, Errors) -> + F = fun({Error, Path}) -> + {Error, [Location | Path]} + end, + lists:map(F, Errors). + +combine_errors(Broken) -> + F = fun(NextErrors, Acc) -> + NextErrors ++ Acc + end, + lists:foldl(F, [], Broken). + + +%%% FATE to 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(), + Errors :: [{Reason, [PathStep]}], + Reason :: term(), + PathStep :: term(). + +fate_to_erlang({_, _, integer}, S) when is_integer(S) -> + {ok, S}; +fate_to_erlang({_, _, address}, {address, Bin}) -> + Address = gmser_api_encoder:encode(account_pubkey, Bin), + {ok, unicode:characters_to_list(Address)}; +fate_to_erlang({_, _, contract}, {contract, Bin}) -> + Address = gmser_api_encoder:encode(contract_pubkey, Bin), + {ok, unicode:characters_to_list(Address)}; +fate_to_erlang({_, _, signature}, Bin) -> + Address = gmser_api_encoder:encode(signature, Bin), + {ok, unicode:characters_to_list(Address)}; +%fate_to_erlang({_, _, channel}, {channel, S}) when is_binary(S) -> + %{ok, S}; +fate_to_erlang({_, _, boolean}, true) -> + {ok, true}; +fate_to_erlang({_, _, boolean}, false) -> + {ok, false}; +fate_to_erlang({_, _, string}, Bin) -> + Str = binary_to_list(Bin), + {ok, Str}; +fate_to_erlang({_, _, char}, Val) -> + {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}) -> + {ok, Num}; +fate_to_erlang({_, _, {list, [Type]}}, Data) when is_list(Data) -> + coerce_list(Type, Data, from_fate); +fate_to_erlang({_, _, {map, [KeyType, ValType]}}, Data) when is_map(Data) -> + coerce_map(KeyType, ValType, Data, from_fate); +fate_to_erlang({O, N, {tuple, ElementTypes}}, {tuple, Data}) -> + ElementList = tuple_to_list(Data), + coerce_tuple(O, N, ElementTypes, ElementList, from_fate); +fate_to_erlang({O, N, {variant, Variants}}, {variant, _, Tag, Tuple}) -> + Terms = tuple_to_list(Tuple), + {Name, TermTypes} = lists:nth(Tag + 1, Variants), + coerce_variant2(O, N, Variants, Name, Tag, TermTypes, Terms, from_fate); +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) -> + 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({O, N, _}, Data) -> + case N of + already_normalized -> + io:format("Warning: Unimplemented type ~p.~nUsing term as is:~n~p~n", [O, Data]); + _ -> + io:format("Warning: Unimplemented type ~p (i.e. ~p).~nUsing term as is:~n~p~n", [O, N, Data]) + end, + {ok, Data}. + + + +%%% AACI Getters + +-spec get_function_signature(AACI, Fun) -> {ok, Type} | {error, Reason} + when AACI :: aaci(), + Fun :: binary() | string(), + Type :: {term(), term()}, % FIXME + Reason :: bad_fun_name. + +%% @doc +%% Look up the type information of a given function, in the AACI provided by +%% prepare_contract/1. This type information, particularly the return type, is +%% useful for calling decode_bytearray/2. + +get_function_signature({aaci, _, FunDefs, _}, Fun) -> + case maps:find(Fun, FunDefs) of + {ok, A} -> {ok, A}; + error -> {error, bad_fun_name} + end. + + +%%% Simple FATE/erlang tests + +check_erlang_to_fate(Type, Sophia, Fate) -> + {ok, FateActual} = erlang_to_fate(Type, Sophia), + case FateActual of + Fate -> + ok; + _ -> + erlang:error({to_fate_failed, Fate, FateActual}) + end. + +check_fate_to_erlang(Type, Fate, Sophia) -> + {ok, SophiaActual} = fate_to_erlang(Type, Fate), + % Now check that the results were what we expected. + case SophiaActual of + Sophia -> + ok; + _ -> + erlang:error({from_fate_failed, Sophia, SophiaActual}) + end. + +% Round trip coerce run for the eunit tests below. If these results don't match +% then the test should fail. +check_roundtrip(Type, Sophia, Fate) -> + check_erlang_to_fate(Type, Sophia, Fate), + check_fate_to_erlang(Type, Fate, Sophia), + + % Finally, check that the FATE result is something that gmb understands. + gmb_fate_encoding:serialize(Fate), + ok. + +coerce_int_test() -> + {ok, Type} = annotate_type(integer, #{}), + check_roundtrip(Type, 123, 123). + +coerce_address_test() -> + {ok, Type} = annotate_type(address, #{}), + check_roundtrip(Type, + "ak_2FTnrGfV8qsfHpaSEHpBrziioCpwwzLqSevHqfxQY3PaAAdARx", + {address, <<164,136,155,90,124,22,40,206,255,76,213,56,238,123, + 167,208,53,78,40,235,2,163,132,36,47,183,228,151,9, + 210,39,214>>}). + +coerce_contract_test() -> + {ok, Type} = annotate_type(contract, #{}), + check_roundtrip(Type, + "ct_2FTnrGfV8qsfHpaSEHpBrziioCpwwzLqSevHqfxQY3PaAAdARx", + {contract, <<164,136,155,90,124,22,40,206,255,76,213,56,238,123, + 167,208,53,78,40,235,2,163,132,36,47,183,228,151,9, + 210,39,214>>}). + +coerce_signature_test() -> + {ok, Type} = annotate_type(signature, #{}), + check_roundtrip(Type, + "sg_XDyF8LJC4tpMyAySvpaG1f5V9F2XxAbRx9iuVjvvdNMwVracLhzAuXhRM5kXAFtpwW1DCHuz5jGehUayCah4jub32Ti2n", + <<231,4,97,129,16,173,37,42,194,249,28,94,134,163,208,84,22,135, + 169,85,212,142,14,12,233,252,97,50,193,158,229,51,123,206,222, + 249,2,3,85,173,106,150,243,253,89,128,248,52,195,140,95,114, + 233,110,119,143,206,137,124,36,63,154,85,7>>). + +coerce_signature_binary_test() -> + {ok, Type} = annotate_type(signature, #{}), + Binary = <<231,4,97,129,16,173,37,42,194,249,28,94,134,163,208,84,22,135, + 169,85,212,142,14,12,233,252,97,50,193,158,229,51,123,206,222, + 249,2,3,85,173,106,150,243,253,89,128,248,52,195,140,95,114, + 233,110,119,143,206,137,124,36,63,154,85,7>>, + {ok, Binary} = erlang_to_fate(Type, {raw, Binary}), + {ok, Binary} = erlang_to_fate(Type, Binary), + ok. + +coerce_bool_test() -> + {ok, Type} = annotate_type(boolean, #{}), + check_roundtrip(Type, true, true), + check_roundtrip(Type, false, false). + +coerce_string_test() -> + {ok, Type} = annotate_type(string, #{}), + check_roundtrip(Type, "hello world", <<"hello world">>). + +coerce_list_test() -> + {ok, Type} = annotate_type({list, [string]}, #{}), + check_roundtrip(Type, ["hello world", [65, 32, 65]], [<<"hello world">>, <<65, 32, 65>>]). + +coerce_map_test() -> + {ok, Type} = annotate_type({map, [string, {list, [integer]}]}, #{}), + check_roundtrip(Type, #{"a" => "a", "b" => "b"}, #{<<"a">> => "a", <<"b">> => "b"}). + +coerce_tuple_test() -> + {ok, Type} = annotate_type({tuple, [integer, string]}, #{}), + check_roundtrip(Type, {123, "456"}, {tuple, {123, <<"456">>}}). + +coerce_variant_test() -> + {ok, Type} = annotate_type({variant, [{"A", [integer]}, + {"B", [integer, integer]}]}, + #{}), + check_roundtrip(Type, {"A", 123}, {variant, [1, 2], 0, {123}}), + check_roundtrip(Type, {"B", 456, 789}, {variant, [1, 2], 1, {456, 789}}). + +coerce_option_test() -> + {ok, Type} = annotate_type({"option", [integer]}, builtin_typedefs()), + check_roundtrip(Type, {"None"}, {variant, [0, 1], 0, {}}), + check_roundtrip(Type, {"Some", 1}, {variant, [0, 1], 1, {1}}). + +coerce_record_test() -> + {ok, Type} = annotate_type({record, [{"a", integer}, {"b", integer}]}, #{}), + check_roundtrip(Type, #{"a" => 123, "b" => 456}, {tuple, {123, 456}}). + +coerce_bytes_test() -> + {ok, Type} = annotate_type({tuple, [{bytes, [4]}, {bytes, [any]}]}, #{}), + check_roundtrip(Type, {<<"abcd">>, <<"efghi">>}, {tuple, {<<"abcd">>, <<"efghi">>}}). + +coerce_bits_test() -> + {ok, Type} = annotate_type(bits, #{}), + check_roundtrip(Type, 5, {bits, 5}). + +coerce_char_test() -> + {ok, Type} = annotate_type(char, #{}), + check_roundtrip(Type, $?, $?). + +coerce_unicode_test() -> + {ok, Type} = annotate_type(char, #{}), + % Latin Small Letter C with cedilla and acute + {ok, $ḉ} = erlang_to_fate(Type, <<"ḉ"/utf8>>), + ok. + +coerce_hash_test() -> + {ok, Type} = annotate_type("hash", builtin_typedefs()), + Hash = list_to_binary(lists:seq(1,32)), + check_roundtrip(Type, Hash, Hash), + ok. + + +%%% Complex AACI paramter and namespace tests + +aaci_from_string(String) -> + case so_compiler:from_string(String, [{aci, json}]) of + {ok, #{aci := ACI}} -> {ok, prepare(ACI)}; + Error -> Error + end. + +namespace_coerce_test() -> + Contract = " + namespace N = + record pair = { a : int, b : int } + + contract C = + entrypoint f(): N.pair = { a = 1, b = 2 } + ", + {ok, AACI} = aaci_from_string(Contract), + {ok, {[], Output}} = get_function_signature(AACI, "f"), + check_roundtrip(Output, #{"a" => 123, "b" => 456}, {tuple, {123, 456}}). + +record_substitution_test() -> + Contract = " + contract C = + record pair('t) = { a : 't, b : 't } + entrypoint f(): pair(int) = { a = 1, b = 2 } + ", + {ok, AACI} = aaci_from_string(Contract), + {ok, {[], Output}} = get_function_signature(AACI, "f"), + check_roundtrip(Output, #{"a" => 123, "b" => 456}, {tuple, {123, 456}}). + +tuple_substitution_test() -> + Contract = " + contract C = + type triple('t1, 't2) = int * 't1 * 't2 + entrypoint f(): triple(int, string) = (1, 2, \"hello\") + ", + {ok, AACI} = aaci_from_string(Contract), + {ok, {[], Output}} = get_function_signature(AACI, "f"), + check_roundtrip(Output, {1, 2, "hello"}, {tuple, {1, 2, <<"hello">>}}). + +variant_substitution_test() -> + Contract = " + contract C = + datatype adt('a, 'b) = Left('a, 'b) | Right('b, int) + entrypoint f(): adt(string, int) = Left(\"hi\", 1) + ", + {ok, AACI} = aaci_from_string(Contract), + {ok, {[], Output}} = get_function_signature(AACI, "f"), + check_roundtrip(Output, {"Left", "hi", 1}, {variant, [2, 2], 0, {<<"hi">>, 1}}), + check_roundtrip(Output, {"Right", 2, 3}, {variant, [2, 2], 1, {2, 3}}). + +nested_coerce_test() -> + Contract = " + contract C = + type pair('t) = 't * 't + record r = { f1 : pair(int), f2: pair(string) } + entrypoint f(): r = { f1 = (1, 2), f2 = (\"a\", \"b\") } + ", + {ok, AACI} = aaci_from_string(Contract), + {ok, {[], Output}} = get_function_signature(AACI, "f"), + check_roundtrip(Output, + #{ "f1" => {1, 2}, "f2" => {"a", "b"}}, + {tuple, {{tuple, {1, 2}}, {tuple, {<<"a">>, <<"b">>}}}}). + +state_coerce_test() -> + Contract = " + contract C = + type state = int + entrypoint init(): state = 0 + ", + {ok, AACI} = aaci_from_string(Contract), + {ok, {[], Output}} = get_function_signature(AACI, "init"), + check_roundtrip(Output, 0, 0). + +param_test() -> + Contract = " + contract C = + type state = int + entrypoint init(x): state = x + ", + {ok, AACI} = aaci_from_string(Contract), + {ok, {[{"x", Input}], Output}} = get_function_signature(AACI, "init"), + check_roundtrip(Input, 0, 0), + check_roundtrip(Output, 0, 0). + +%%% Obscure Sophia types where we should check the AACI as well + +obscure_aaci_test() -> + Contract = " + include \"Set.aes\" + contract C = + entrypoint options(): option(int) = None + entrypoint fixed_bytes(): bytes(4) = #DEADBEEF + entrypoint any_bytes(): bytes() = Bytes.to_any_size(#112233) + entrypoint bits(): bits = Bits.all + entrypoint character(): char = 'a' + entrypoint hash(): hash = #00112233445566778899AABBCCDDEEFF00112233445566778899AABBCCDDEEFF + entrypoint unit(): unit = () + + entrypoint ttl(x): Chain.ttl = FixedTTL(x) + entrypoint paying_for(x, y): Chain.paying_for_tx = Chain.PayingForTx(x, y) + entrypoint ga_meta_tx(x, y): Chain.ga_meta_tx = Chain.GAMetaTx(x, y) + entrypoint base_tx(x, y, z): Chain.base_tx = Chain.SpendTx(x, y, z) + entrypoint tx(a, b, c, d, e, f): Chain.tx = + {paying_for = a, + ga_metas = b, + actor = c, + fee = d, + ttl = e, + tx = f} + + entrypoint pointee(x): AENS.pointee = AENS.AccountPt(x) + entrypoint name(x, y, z): AENS.name = AENS.Name(x, y, z) + entrypoint pointee2(x): AENSv2.pointee = AENSv2.DataPt(x) + entrypoint name2(x, y, z): AENSv2.name = AENSv2.Name(x, y, z) + + entrypoint fr(x): MCL_BLS12_381.fr = x + entrypoint fp(x): MCL_BLS12_381.fp = x + + entrypoint set(): Set.set(int) = Set.new() + + ", + {ok, AACI} = aaci_from_string(Contract), + + {ok, {[], {{bytes, [4]}, _, _}}} = get_function_signature(AACI, "fixed_bytes"), + {ok, {[], {{bytes, [any]}, _, _}}} = get_function_signature(AACI, "any_bytes"), + {ok, {[], {bits, _, _}}} = get_function_signature(AACI, "bits"), + {ok, {[], {char, _, _}}} = get_function_signature(AACI, "character"), + + {ok, {[], {{"option", [integer]}, _, {variant, [{"None", []}, {"Some", [_]}]}}}} = get_function_signature(AACI, "options"), + {ok, {[], {"hash", _, {bytes, [32]}}}} = get_function_signature(AACI, "hash"), + {ok, {[], {"unit", _, {tuple, []}}}} = get_function_signature(AACI, "unit"), + + {ok, {_, {"Chain.ttl", _, {variant, _}}}} = get_function_signature(AACI, "ttl"), + {ok, {_, {"Chain.paying_for_tx", _, {variant, _}}}} = get_function_signature(AACI, "paying_for"), + {ok, {_, {"Chain.ga_meta_tx", _, {variant, _}}}} = get_function_signature(AACI, "ga_meta_tx"), + {ok, {_, {"Chain.base_tx", _, {variant, _}}}} = get_function_signature(AACI, "base_tx"), + {ok, {_, {"Chain.tx", _, {record, _}}}} = get_function_signature(AACI, "tx"), + + {ok, {_, {"AENS.pointee", _, {variant, _}}}} = get_function_signature(AACI, "pointee"), + {ok, {_, {"AENS.name", _, {variant, _}}}} = get_function_signature(AACI, "name"), + {ok, {_, {"AENSv2.pointee", _, {variant, _}}}} = get_function_signature(AACI, "pointee2"), + {ok, {_, {"AENSv2.name", _, {variant, _}}}} = get_function_signature(AACI, "name2"), + + {ok, {_, {"MCL_BLS12_381.fr", _, {bytes, [32]}}}} = get_function_signature(AACI, "fr"), + {ok, {_, {"MCL_BLS12_381.fp", _, {bytes, [48]}}}} = get_function_signature(AACI, "fp"), + + {ok, {[], {{"Set.set", [integer]}, _, {record, [{"to_map", _}]}}}} = get_function_signature(AACI, "set"), + + ok. + +name_coerce_test() -> + AddrSoph = "ak_2FTnrGfV8qsfHpaSEHpBrziioCpwwzLqSevHqfxQY3PaAAdARx", + AddrFate = {address, <<164,136,155,90,124,22,40,206,255,76,213,56,238,123, + 167,208,53,78,40,235,2,163,132,36,47,183,228,151,9, + 210,39,214>>}, + {ok, TTL} = annotate_type("Chain.ttl", builtin_typedefs()), + TTLSoph = {"FixedTTL", 0}, + TTLFate = {variant, [1, 1], 0, {0}}, + check_roundtrip(TTL, TTLSoph, TTLFate), + {ok, Pointee} = annotate_type("AENS.pointee", builtin_typedefs()), + PointeeSoph = {"AccountPt", AddrSoph}, + PointeeFate = {variant, [1, 1, 1, 1], 0, {AddrFate}}, + check_roundtrip(Pointee, PointeeSoph, PointeeFate), + {ok, Name} = annotate_type("AENS.name", builtin_typedefs()), + NameSoph = {"Name", AddrSoph, TTLSoph, #{"myname" => PointeeSoph}}, + NameFate = {variant, [3], 0, {AddrFate, TTLFate, #{<<"myname">> => PointeeFate}}}, + check_roundtrip(Name, NameSoph, NameFate). + +void_coerce_test() -> + % Void itself can't be represented, but other types built out of void are + % valid. + {ok, NonOption} = annotate_type({"option", ["void"]}, builtin_typedefs()), + check_roundtrip(NonOption, {"None"}, {variant, [0, 1], 0, {}}), + {ok, NonList} = annotate_type({list, ["void"]}, builtin_typedefs()), + check_roundtrip(NonList, [], []). + diff --git a/src/hz_fetcher.erl b/src/hz_fetcher.erl index f78d566..33e5de7 100644 --- a/src/hz_fetcher.erl +++ b/src/hz_fetcher.erl @@ -1,5 +1,5 @@ -module(hz_fetcher). --vsn("0.8.3"). +-vsn("0.9.0"). -author("Craig Everett "). -copyright("Craig Everett "). -license("MIT"). diff --git a/src/hz_format.erl b/src/hz_format.erl index 07b9896..39ca2df 100644 --- a/src/hz_format.erl +++ b/src/hz_format.erl @@ -21,7 +21,7 @@ %%% @end -module(hz_format). --vsn("0.8.3"). +-vsn("0.9.0"). -author("Craig Everett "). -copyright("Craig Everett "). -license("GPL-3.0-or-later"). diff --git a/src/hz_grids.erl b/src/hz_grids.erl index e444afe..f19fdfd 100644 --- a/src/hz_grids.erl +++ b/src/hz_grids.erl @@ -37,7 +37,7 @@ %%% @end -module(hz_grids). --vsn("0.8.3"). +-vsn("0.9.0"). -export([url/2, url/3, url/4, parse/1, req/2, req/3, req/4]). diff --git a/src/hz_key_master.erl b/src/hz_key_master.erl index 66f54a8..ccc4bc4 100644 --- a/src/hz_key_master.erl +++ b/src/hz_key_master.erl @@ -8,8 +8,7 @@ %%% @end -module(hz_key_master). --vsn("0.8.3"). - +-vsn("0.9.0"). -export([make_key/1, encode/1, decode/1]). -export([lcg/1]). diff --git a/src/hz_man.erl b/src/hz_man.erl index 7a5a4f1..49c0375 100644 --- a/src/hz_man.erl +++ b/src/hz_man.erl @@ -9,7 +9,7 @@ %%% @end -module(hz_man). --vsn("0.8.3"). +-vsn("0.9.0"). -behavior(gen_server). -author("Craig Everett "). -copyright("Craig Everett "). diff --git a/src/hz_sophia.erl b/src/hz_sophia.erl new file mode 100644 index 0000000..70995a6 --- /dev/null +++ b/src/hz_sophia.erl @@ -0,0 +1,1459 @@ +-module(hz_sophia). +-vsn("0.9.0"). +-author("Jarvis Carroll "). +-copyright("Jarvis Carroll "). +-license("GPL-3.0-or-later"). + +-export([parse_literal/1, parse_literal/2]). +-export([fate_to_list/1, fate_to_list/2, fate_to_iolist/1, fate_to_iolist/2]). + +-include_lib("eunit/include/eunit.hrl"). + + +-spec parse_literal(Sophia) -> {ok, FATE} | {error, Reason} + when Sophia :: string(), + FATE :: gmb_fate_data:fate_type(), + Reason :: term(). + +parse_literal(String) -> + parse_literal(unknown_type(), String). + +-spec parse_literal(Type, Sophia) -> {ok, FATE} | {error, Reason} + when Type :: hz_aaci:annotated_type(), + Sophia :: string(), + FATE :: gmb_fate_data:fate_type(), + Reason :: term(). + +parse_literal(Type, String) -> + case parse_expression(Type, {1, 1}, String) of + {ok, {Result, NewPos, NewString}} -> + parse_literal2(Result, NewPos, NewString); + {error, Reason} -> + {error, Reason} + end. + +parse_literal2(Result, Pos, String) -> + % We have parsed a valid expression. Now check that the string ends. + case next_token(Pos, String) of + {ok, {{eof, _, _, _, _, _}, _, _}} -> + {ok, Result}; + {ok, {Token, _, _}} -> + unexpected_token(Token); + {error, Reason} -> + {error, Reason} + end. + +%%% Tokenizer + +-define(IS_LATIN_UPPER(C), (((C) >= $A) and ((C) =< $Z))). +-define(IS_LATIN_LOWER(C), (((C) >= $a) and ((C) =< $z))). +-define(IS_ALPHA(C), (?IS_LATIN_UPPER(C) or ?IS_LATIN_LOWER(C) or ((C) == $_))). +-define(IS_NUM(C), (((C) >= $0) and ((C) =< $9))). +-define(IS_ALPHANUM(C), (?IS_ALPHA(C) or ?IS_NUM(C) or ((C) == $.))). +-define(IS_HEX(C), (?IS_NUM(C) or (((C) >= $A) and ((C) =< $F)) or (((C) >= $a) and ((C) =< $f)))). + +next_token({Row, Col}, []) -> + {ok, {{eof, "", [], Row, Col, Col}, {Row, Col}, []}}; +next_token({Row, Col}, " " ++ Rest) -> + next_token({Row, Col + 1}, Rest); +next_token({Row, Col}, "\t" ++ Rest) -> + next_token({Row, Col + 1}, Rest); +next_token({Row, _}, "\r\n" ++ Rest) -> + next_token({Row + 1, 1}, Rest); +next_token({Row, _}, "\r" ++ Rest) -> + next_token({Row + 1, 1}, Rest); +next_token({Row, _}, "\n" ++ Rest) -> + next_token({Row + 1, 1}, Rest); +next_token(Pos, [C | _] = String) when ?IS_ALPHA(C) -> + alphanum_token(Pos, Pos, String, []); +next_token(Pos, [C | _] = String) when ?IS_NUM(C) -> + num_token(Pos, Pos, String, [], 0); +next_token({Row, Col}, [$#, C | Rest]) when ?IS_HEX(C) -> + bytes_token({Row, Col}, {Row, Col + 1}, [C | Rest], "#", []); +next_token({Row, Col}, "\"" ++ Rest) -> + string_token({Row, Col}, {Row, Col + 1}, Rest, "\"", <<>>); +next_token({Row, Col}, "'" ++ Rest) -> + character_token({Row, Col}, {Row, Col + 1}, Rest, "'"); +next_token({Row, Col}, [Char | Rest]) -> + Token = {character, [Char], Char, Row, Col, Col}, + {ok, {Token, {Row, Col + 1}, Rest}}. + +alphanum_token(Start, {Row, Col}, [C | Rest], Acc) when ?IS_ALPHANUM(C) -> + alphanum_token(Start, {Row, Col + 1}, Rest, [C | Acc]); +alphanum_token({_, Start}, {Row, End}, String, Acc) -> + AlphaString = lists:reverse(Acc), + Path = string:split(AlphaString, ".", all), + Token = {alphanum, AlphaString, Path, Row, Start, End - 1}, + {ok, {Token, {Row, End}, String}}. + +num_token(Start, {Row, Col}, [C | Rest], Chars, Value) when ?IS_NUM(C) -> + NewValue = Value * 10 + (C - $0), + num_token(Start, {Row, Col + 1}, Rest, [C | Chars], NewValue); +num_token(Start, {Row, Col}, [$_, C | Rest], Chars, Value) when ?IS_NUM(C) -> + NewValue = Value * 10 + (C - $0), + num_token(Start, {Row, Col + 2}, Rest, [C, $_ | Chars], NewValue); +num_token({_, Start}, {Row, End}, String, Chars, Value) -> + NumString = lists:reverse(Chars), + Token = {integer, NumString, Value, Row, Start, End - 1}, + {ok, {Token, {Row, End}, String}}. + +bytes_token(Start, {Row, Col}, [C | Rest], Chars, Digits) when ?IS_HEX(C) -> + Digit = convert_digit(C), + bytes_token(Start, {Row, Col + 1}, Rest, [C | Chars], [Digit | Digits]); +bytes_token(Start, {Row, Col}, [$_, C | Rest], Chars, Digits) when ?IS_HEX(C) -> + Digit = convert_digit(C), + bytes_token(Start, {Row, Col + 1}, Rest, [C, $_ | Chars], [Digit | Digits]); +bytes_token({_, Start}, {Row, End}, String, Chars, Digits) -> + BytesString = lists:reverse(Chars), + Value = reverse_combine_nibbles(Digits, <<>>), + Token = {bytes, BytesString, Value, Row, Start, End - 1}, + {ok, {Token, {Row, End}, String}}. + +convert_digit(C) when C >= $0, C =< $9 -> + C - $0; +convert_digit(C) when C >= $A, C =< $Z -> + C - $A + 10; +convert_digit(C) when C >= $a, C =< $z -> + C - $a + 10. + +reverse_combine_nibbles([D1, D2 | Rest], Acc) -> + NewAcc = <>, + reverse_combine_nibbles(Rest, NewAcc); +reverse_combine_nibbles([D1], Acc) -> + <<0:4, D1:4, Acc/binary>>; +reverse_combine_nibbles([], Acc) -> + Acc. + +string_token({_, Start}, {Row, Col}, [$" | Rest], SourceChars, Value) -> + SourceStr = lists:reverse([$" | SourceChars]), + Token = {string, SourceStr, Value, Row, Start, Col}, + {ok, {Token, {Row, Col + 1}, Rest}}; +string_token({_, Start}, {Row, Col}, [], SourceChars, _) -> + SourceStr = lists:reverse(SourceChars), + {error, {unclosed_string_literal, SourceStr, Start, Row, Col - 1}}; +string_token({_, Start}, {Row, Col}, [$\r | _], SourceChars, _) -> + SourceStr = lists:reverse(SourceChars), + {error, {unclosed_string_literal, SourceStr, Start, Row, Col - 1}}; +string_token({_, Start}, {Row, Col}, [$\n | _], SourceChars, _) -> + SourceStr = lists:reverse(SourceChars), + {error, {unclosed_string_literal, SourceStr, Start, Row, Col - 1}}; +string_token(Start, Pos, String, SourceChars, Value) -> + case parse_char(Start, Pos, String, SourceChars) of + {ok, {Char, NewSourceChars, NewPos, NewString}} -> + % TODO: ERTS probably had to convert this FROM utf8 at some point, + % so why bother, if we need to convert it back? I guess we could + % accept iolists if we really wanted to waste time on this point... + NewValue = <>, + string_token(Start, NewPos, NewString, NewSourceChars, NewValue); + {error, Reason} -> + {error, Reason} + end. + +character_token({_, Start}, {Row, Col}, [], SourceChars) -> + SourceStr = lists:reverse(SourceChars), + {error, {unclosed_character_literal, SourceStr, Start, Row, Col - 1}}; +character_token({_, Start}, {Row, Col}, [$\r | _], SourceChars) -> + SourceStr = lists:reverse(SourceChars), + {error, {unclosed_character_literal, SourceStr, Start, Row, Col - 1}}; +character_token({_, Start}, {Row, Col}, [$\n | _], SourceChars) -> + SourceStr = lists:reverse(SourceChars), + {error, {unclosed_character_literal, SourceStr, Start, Row, Col - 1}}; +character_token(Start, Pos, String, SourceChars) -> + case parse_char(Start, Pos, String, SourceChars) of + {ok, {Char, NewSourceChars, NewPos, NewString}} -> + character_token2(Start, NewPos, NewString, NewSourceChars, Char); + {error, Reason} -> + {error, Reason} + end. + +character_token2({_, Start}, {Row, Col}, [$' | Rest], SourceChars, Value) -> + SourceStr = lists:reverse([$' | SourceChars]), + Token = {char_literal, SourceStr, Value, Row, Start, Col}, + {ok, {Token, {Row, Col + 1}, Rest}}; +character_token2({_, Start}, {Row, Col}, _, SourceChars, _) -> + SourceStr = lists:reverse(SourceChars), + {error, {unclosed_character_literal, SourceStr, Start, Row, Col - 1}}. + +parse_char(Start, {Row, Col}, "\\x{" ++ String, SourceChars) -> + escape_long_hex_code(Start, {Row, Col + 3}, String, "{x\\" ++ SourceChars, 0); +parse_char(_, {Row, Col}, [$\\, $x, A, B | String], SourceChars) when ?IS_HEX(A), ?IS_HEX(B) -> + Byte = convert_digit(A) * 16 + convert_digit(B), + {ok, {Byte, [B, A, $x, $\\ | SourceChars], {Row, Col + 4}, String}}; +parse_char({Row, Start}, {Row, Col}, [$\\, C | Rest], SourceChars) -> + case unescape_char(C) of + {ok, ByteVal} -> + {ok, {ByteVal, [C, $\ | SourceChars], {Row, Col + 2}, Rest}}; + error -> + {error, {invalid_escape_code, [$\\, C], Row, Start, Col + 1}} + end; +parse_char(_, {Row, Col}, [C | Rest], SourceChars) -> + {ok, {C, [C | SourceChars], {Row, Col + 1}, Rest}}. + +escape_long_hex_code(_, {Row, Col}, "}" ++ String, SourceChars, Value) -> + {ok, {Value, "}" ++ SourceChars, {Row, Col + 1}, String}}; +escape_long_hex_code(Start, {Row, Col}, [C | String], SourceChars, Value) when ?IS_HEX(C) -> + NewSourceChars = [C | SourceChars], + NewValue = 16 * Value + convert_digit(C), + escape_long_hex_code(Start, {Row, Col + 1}, String, NewSourceChars, NewValue); +escape_long_hex_code(_, {Row, Col}, [C | _], _, _) -> + {error, {invalid_hexadecimal, [C], Row, Col}}; +escape_long_hex_code(_, Pos, [], SourceChars, Value) -> + % Just return as if the escape code were closed, and let the string parser + % produce an unclosed string error instead. + {ok, {Value, SourceChars, Pos, []}}. + +unescape_char($b) -> {ok, $\b}; +unescape_char($e) -> {ok, $\e}; +unescape_char($f) -> {ok, $\f}; +unescape_char($n) -> {ok, $\n}; +unescape_char($r) -> {ok, $\r}; +unescape_char($t) -> {ok, $\t}; +unescape_char($v) -> {ok, $\v}; +% Technically \" and \' are only valid inside their own quote characters, not +% each other, but whatever, we will just be permissive here. +unescape_char($") -> {ok, $\"}; +unescape_char($') -> {ok, $\'}; +unescape_char($\\) -> {ok, $\\}; +unescape_char(_) -> error. + +% Not needed until later, but we'll put it here for symmetry. +escape_char($\b) -> "\\b"; +escape_char($\e) -> "\\e"; +escape_char($\f) -> "\\f"; +escape_char($\n) -> "\\n"; +escape_char($\r) -> "\\r"; +escape_char($\t) -> "\\t"; +escape_char($\v) -> "\\v"; +escape_char($\") -> "\\\""; +escape_char($\\) -> "\\\\"; +escape_char(I) -> I. + +%%% Sophia Literal Parser + +%%% This parser is a simple recursive descent parser, written explicitly in +%%% erlang. +%%% +%%% There are no infix operators in the subset we want to parse, so recursive +%%% descent is fine with no special tricks, no shunting yard algorithm, no +%%% parser generators, etc. +%%% +%%% If we were writing this in C then we might want to work iteratively with an +%%% array of finite state machines, i.e. with a pushdown automaton, instead of +%%% using recursion. This is a tried and true method of making fast parsers. +%%% Recall, however, that the BEAM *is* a stack machine, written in C, so +%%% rather than writing confusing iterative code in Erlang, to simulate a +%%% pushdown automaton inside another simulated stack machine... we should just +%%% write the recursive code, thus programming the BEAM to implement the +%%% pushdown automaton that we want. + +parse_expression(Type, Pos, String) -> + case next_token(Pos, String) of + {ok, {Token, NewPos, NewString}} -> + parse_expression2(Type, NewPos, NewString, Token); + {error, Reason} -> + {error, Reason} + end. + +parse_expression2(Type, Pos, String, {integer, _, Value, Row, Start, End}) -> + typecheck_integer(Type, Pos, String, Value, Row, Start, End); +parse_expression2(Type, Pos, String, {character, "-", _, _, _, _}) -> + case next_token(Pos, String) of + {ok, {{integer, _, Value, Row, Start, End}, NewPos, NewString}} -> + typecheck_integer(Type, NewPos, NewString, -Value, Row, Start, End); + {error, Reason} -> + {error, Reason} + end; +parse_expression2(Type, Pos, String, {bytes, _, Value, Row, Start, End}) -> + Len = byte_size(Value), + Result = {bytes, Value}, + case Type of + {_, _, {bytes, [any]}} -> + {ok, {Result, Pos, String}}; + {_, _, {bytes, [Len]}} -> + {ok, {Result, Pos, String}}; + {_, _, {bytes, [ExpectedLen]}} -> + {error, {bytes_wrong_size, ExpectedLen, Len, Row, Start, End}}; + {_, _, bits} -> + Size = bit_size(Value), + <> = Value, + {ok, {{bits, IntValue}, Pos, String}}; + {_, _, unknown_type} -> + {ok, {Result, Pos, String}}; + {O, N, _} -> + {error, {wrong_type, O, N, {bytes, [Len]}, Row, Start, End}} + end; +parse_expression2(Type, Pos, String, {string, _, Value, Row, Start, End}) -> + case Type of + {_, _, string} -> + {ok, {Value, Pos, String}}; + {_, _, unknown_type} -> + {ok, {Value, Pos, String}}; + {O, N, _} -> + {error, {wrong_type, O, N, string, Row, Start, End}} + end; +parse_expression2(Type, Pos, String, {char_literal, _, Value, Row, Start, End}) -> + case Type of + {_, _, char} -> + {ok, {Value, Pos, String}}; + {_, _, unknown_type} -> + {ok, {Value, Pos, String}}; + {O, N, _} -> + {error, {wrong_type, O, N, char, Row, Start, End}} + end; +parse_expression2(Type, Pos, String, {character, "[", _, Row, Start, _}) -> + parse_list(Type, Pos, String, Row, Start); +parse_expression2(Type, Pos, String, {character, "(", _, _, _, _}) -> + parse_tuple(Type, Pos, String); +parse_expression2(Type, Pos, String, {character, "{", _, Row, Start, _}) -> + parse_record_or_map(Type, Pos, String, Row, Start); +parse_expression2(Type, Pos, String, {alphanum, _, Path, Row, Start, End}) -> + parse_alphanum(Type, Pos, String, Path, Row, Start, End); +parse_expression2(_, _, _, {eof, _, _, _, _, _}) -> + {error, unexpected_end_of_file}; +parse_expression2(_, _, _, Token) -> + unexpected_token(Token). + +unknown_type() -> + {unknown_type, already_normalized, unknown_type}. + +expect_tokens([], Pos, String) -> + {ok, {Pos, String}}; +expect_tokens([Str | Rest], Pos, String) -> + case next_token(Pos, String) of + {ok, {{_, Str, _, _, _, _}, NewPos, NewString}} -> + expect_tokens(Rest, NewPos, NewString); + {ok, {Token, _, _}} -> + unexpected_token(Token, Str); + {error, Reason} -> + {error, Reason} + end. + +unexpected_token(Token, _Expected) -> + % I don't know if this is a good idea, but sometimes there are only one or + % two tokens that could have worked, which might make for simple + % non-technical error messages. I don't know how to format that yet, + % though. + unexpected_token(Token). + +unexpected_token({eof, _, _, _, _, _}) -> + {error, expression_incomplete}; +unexpected_token({_, S, _, Row, Start, End}) -> + {error, {unexpected_token, S, Row, Start, End}}. + +%%% Ambiguous Chain Object vs Identifier Parsing + +parse_alphanum(Type, Pos, String, ["true"], Row, Start, End) -> + typecheck_bool(Type, Pos, String, true, Row, Start, End); +parse_alphanum(Type, Pos, String, ["false"], Row, Start, End) -> + typecheck_bool(Type, Pos, String, false, Row, Start, End); +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, [[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, so lowercase can only be a + % chain object. + try + case gmser_api_encoder:decode(unicode:characters_to_binary(S)) of + {account_pubkey, Data} -> + typecheck_address(Type, Pos, String, Data, Row, Start, End); + {contract_pubkey, Data} -> + typecheck_contract(Type, Pos, String, Data, Row, Start, End); + {signature, Data} -> + typecheck_signature(Type, Pos, String, Data, Row, Start, End); + {_, _} -> + % Only a few chain objects are recognized by Sophia. The rest + % are interpreted as identifiers, so we might as well give the + % same sort of error that the compiler would give. + {error, {unexpected_identifier, S, Row, Start, End}} + end + catch + _:_ -> {error, {unexpected_identifier, S, Row, Start, End}} + end; +parse_alphanum(Type, Pos, String, Path, Row, Start, End) -> + % 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, _, _, _) -> + {ok, {Value, Pos, String}}; +typecheck_integer({_, _, unknown_type}, Pos, String, Value, _, _, _) -> + {ok, {Value, Pos, String}}; +typecheck_integer({_, _, bits}, Pos, String, Value, _, _, _) -> + {ok, {{bits, Value}, Pos, String}}; +typecheck_integer({O, N, _}, _, _, _, Row, Start, End) -> + {error, {wrong_type, O, N, integer, Row, Start, End}}. + +typecheck_bool({_, _, unknown_type}, Pos, String, Value, _, _, _) -> + {ok, {Value, Pos, String}}; +typecheck_bool({_, _, boolean}, Pos, String, Value, _, _, _) -> + {ok, {Value, Pos, String}}; +typecheck_bool({O, N, _}, _, _, _, Row, Start, End) -> + {error, {wrong_type, O, N, boolean, Row, Start, End}}. + +typecheck_bits({_, _, unknown_type}, Pos, String, Value, _, _, _) -> + {ok, {{bits, Value}, Pos, String}}; +typecheck_bits({_, _, bits}, Pos, String, Value, _, _, _) -> + {ok, {{bits, Value}, Pos, String}}; +typecheck_bits({O, N, _}, _, _, _, Row, Start, End) -> + {error, {wrong_type, O, N, bits, Row, Start, End}}. + +typecheck_address({_, _, address}, Pos, String, Data, _, _, _) -> + {ok, {{address, Data}, Pos, String}}; +typecheck_address({_, _, contract}, Pos, String, Data, _, _, _) -> + % The compiler would type error, but we should be lenient here. + {ok, {{contract, Data}, Pos, String}}; +typecheck_address({_, _, unknown_type}, Pos, String, Data, _, _, _) -> + {ok, {{address, Data}, Pos, String}}; +typecheck_address({O, N, _}, _, _, _, Row, Start, End) -> + {error, {wrong_type, O, N, address, Row, Start, End}}. + +typecheck_contract({_, _, contract}, Pos, String, Data, _, _, _) -> + {ok, {{contract, Data}, Pos, String}}; +typecheck_contract({_, _, address}, Pos, String, Data, _, _, _) -> + % The compiler would type error, but we should be lenient here. + {ok, {{address, Data}, Pos, String}}; +typecheck_contract({_, _, unknown_type}, Pos, String, Data, _, _, _) -> + {ok, {{contract, Data}, Pos, String}}; +typecheck_contract({O, N, _}, _, _, _, Row, Start, End) -> + {error, {wrong_type, O, N, contract, Row, Start, End}}. + +typecheck_signature({_, _, signature}, Pos, String, Data, _, _, _) -> + {ok, {{bytes, Data}, Pos, String}}; +typecheck_signature({_, _, {bytes, [64]}}, Pos, String, Data, _, _, _) -> + % The compiler would probably type-error, but whatever. + {ok, {{bytes, Data}, Pos, String}}; +typecheck_signature({_, _, {bytes, [any]}}, Pos, String, Data, _, _, _) -> + % The compiler would probably type-error, but whatever. + {ok, {{bytes, Data}, Pos, String}}; +typecheck_signature({_, _, unknown_type}, Pos, String, Data, _, _, _) -> + {ok, {{bytes, Data}, Pos, String}}; +typecheck_signature({O, N, _}, _, _, _, Row, Start, End) -> + {error, {wrong_type, O, N, signature, Row, Start, End}}. + + +%%% List Parsing + +parse_list({_, _, {list, [Inner]}}, Pos, String, _, _) -> + parse_list2(Inner, Pos, String); +parse_list({_, _, unknown_type}, Pos, String, _, _) -> + parse_list2(unknown_type(), Pos, String); +parse_list({O, N, _}, _, _, Row, Start) -> + {error, {wrong_type, O, N, list, Row, Start, Start}}. + +parse_list2(Inner, Pos, String) -> + case parse_list_loop(Inner, Pos, String, "]", []) of + {ok, {Result, _, _, NewPos, NewString}} -> + {ok, {Result, NewPos, NewString}}; + {error, Reason} -> + {error, Reason} + end. + +parse_list_loop(Inner, Pos, String, CloseChar, Acc) -> + case next_token(Pos, String) of + {ok, {{character, CloseChar, _, Row, Col, _}, NewPos, NewString}} -> + {ok, {lists:reverse(Acc), true, {Row, Col}, NewPos, NewString}}; + {ok, {Token, NewPos, NewString}} -> + parse_list_loop2(Inner, NewPos, NewString, CloseChar, Acc, Token); + {error, Reason} -> + {error, Reason} + end. + +parse_list_loop2(Inner, Pos, String, CloseChar, Acc, Token) -> + case parse_expression2(Inner, Pos, String, Token) of + {ok, {Value, NewPos, NewString}} -> + parse_list_loop3(Inner, NewPos, NewString, CloseChar, [Value | Acc]); + {error, Reason} -> + Wrapper = choose_list_error_wrapper(CloseChar), + % TODO: Are tuple indices off by one from list indices? + Wrapped = wrap_error(Reason, {Wrapper, length(Acc)}), + {error, Wrapped} + end. + +parse_list_loop3(Inner, Pos, String, CloseChar, Acc) -> + case next_token(Pos, String) of + {ok, {{character, CloseChar, _, Row, Col, _}, NewPos, NewString}} -> + {ok, {lists:reverse(Acc), false, {Row, Col}, NewPos, NewString}}; + {ok, {{character, ",", _, _, _, _}, NewPos, NewString}} -> + parse_list_loop(Inner, NewPos, NewString, CloseChar, Acc); + {ok, {Token, _, _}} -> + unexpected_token(Token, CloseChar); + {error, Reason} -> + {error, Reason} + end. + +choose_list_error_wrapper("]") -> list_element; +choose_list_error_wrapper(")") -> tuple_element. + +%%% Ambiguous Parenthesis Parsing + +parse_tuple({_, _, unknown_type}, Pos, String) -> + % An untyped tuple is a list of untyped terms, and weirdly our list parser + % works perfectly for that, as long as we change the closing character to + % be ")" instead of "]". + case parse_list_loop(unknown_type(), Pos, String, ")", []) of + {ok, {[Inner], false, _, NewPos, NewString}} -> + % In Sophia, trailing commas are invalid, and so all singleton + % tuples are unwrapped, and translated into the inner type. + {ok, {Inner, NewPos, NewString}}; + {ok, {TermList, _, _, NewPos, NewString}} -> + Result = {tuple, list_to_tuple(TermList)}, + {ok, {Result, NewPos, NewString}}; + {error, Reason} -> + {error, Reason} + end; +parse_tuple(Type, Pos, String) -> + % Typed tuple parsing is quite complex, because we also want to support + % normal parentheses for grouping. It's not strictly necessary for + % inputting data, since we don't have any infix operators in simple + % data/term notation, but the alternatives are to generate singleton tuples + % naively, (which are impossible to generate from Sophia,) or to hard error + % on singleton tuples! Being faithful to Sophia is clearly nice! + + % Count how many ambiguous parens there are, including the one we already + % saw. + case count_open_parens(Pos, String, 1) of + {ok, {Count, Token, NewPos, NewString}} -> + % Compare that to the amount of nesting tuple connectives are in + % the type we are expected to produce. + {ExcessCount, HeadType, Tails} = extract_tuple_type_info(Count, Type, []), + % Now work out what to do with all this information. + parse_tuple2(ExcessCount, HeadType, Tails, NewPos, NewString, Token); + {error, Reason} -> + {error, Reason} + end. + +count_open_parens(Pos, String, Count) -> + case next_token(Pos, String) of + {ok, {{character, "(", _, _, _, _}, NewPos, NewString}} -> + count_open_parens(NewPos, NewString, Count + 1); + {ok, {Token, NewPos, NewString}} -> + {ok, {Count, Token, NewPos, NewString}}; + {error, Reason} -> + {error, Reason} + end. + +extract_tuple_type_info(ParenCount, {_, _, {tuple, [Head | Rest]}}, Tails) when ParenCount > 0 -> + % Have an open paren, and a tuple type. We need to go deeper! + extract_tuple_type_info(ParenCount - 1, Head, [Rest | Tails]); +extract_tuple_type_info(ParenCount, HeadType, Tails) -> + % No parens, or no more (non-empty) tuples. Stop! + {ParenCount, HeadType, Tails}. + +parse_tuple2(_, {_, _, unknown_type}, [_ | _], _, _, _) -> + {error, "Parsing of tuples with known lengths but unknown contents is not yet implemented."}; +parse_tuple2(ExcessCount, HeadType, Tails, Pos, String, {character, ")", _, Row, Col, _}) -> + parse_empty_tuple(ExcessCount, HeadType, Tails, Pos, String, Row, Col); +parse_tuple2(ExcessCount, HeadType, Tails, Pos, String, Token) -> + % Finished with parentheses for now, try and parse an expression out, to + % get our head term. + case parse_expression2(HeadType, Pos, String, Token) of + {ok, {Result, NewPos, NewString}} -> + % Got a head term. Now try to build all the other tuple layers. + parse_tuple_tails(ExcessCount, Result, Tails, NewPos, NewString); + {error, Reason} -> + % TODO: Wrap errors here too. + {error, Reason} + end. + +parse_empty_tuple(0, _, Tails, _, _, Row, Col) -> + % There are zero excess parens, meaning all our parens are tuples. Get the + % top one. + [Tail | _] = Tails, + % We expected some nonzero number of elements before the close paren, but + % got zero. + ExpectCount = 1 + length(Tail), + {error, {not_enough_elements, ExpectCount, 0, Row, Col}}; +parse_empty_tuple(ExcessCount, {_, _, {tuple, []}}, Tails, Pos, String, _, _) -> + % If we have some ambiguous parentheses left, we now know one of them is + % this empty tuple. + HeadTerm = {tuple, {}}, + NewExcessCount = ExcessCount - 1, + % Now continue the loop as if it were an integer or something, in the head + % position. + parse_tuple_tails(NewExcessCount, HeadTerm, Tails, Pos, String); +parse_empty_tuple(_, {HeadO, HeadN, _}, _, _, _, Row, Col) -> + % We were expecting a head term of a different type! + {error, {wrong_type, HeadO, HeadN, unit, Row, Col, Col}}. + +parse_tuple_tails(0, HeadTerm, [], Pos, String) -> + % No open parens left, no tuples left to build, we are done! + {ok, {HeadTerm, Pos, String}}; +parse_tuple_tails(ExcessCount, HeadTerm, Tails, Pos, String) -> + % The ambiguous case, where we have a mix of tuple parens, and grouping + % parens. We want to peek at the next token, to see if it closes a grouping + % paren. + case next_token(Pos, String) of + {ok, {{character, ")", _, Row, Col, _}, NewPos, NewString}} -> + % It is grouping! Try closing a grouping paren. + parse_tuple_tails_paren(ExcessCount, HeadTerm, Tails, NewPos, NewString, Row, Col); + {ok, {{character, ",", _, Row, Col, _}, NewPos, NewString}} -> + % It is a real tuple! Try parsing a tuple. + parse_tuple_tails_comma(ExcessCount, HeadTerm, Tails, NewPos, NewString, Row, Col); + {ok, {Token, _, _}} -> + % Anything else is just a boring parse error we can complain about. + unexpected_token(Token, ")"); + {error, Reason} -> + {error, Reason} + end. + +parse_tuple_tails_paren(0, _, [[] | _], _, _, Row, Col) -> + % A singleton tuple was expected, but a grouping paren was given. In theory + % we could be permissive here, but we were asked to do type checking, and + % this is a type error. The type error itself is a bit hard to reproduce, + % but we do know exactly what the fix is, so let's report that instead. + {error, {expected_trailing_comma, Row, Col}}; +parse_tuple_tails_paren(0, _, [Tail | _], _, _, Row, Col) -> + % A tuple (of more than one elements) was expected, but a grouping paren + % was given. Again, the type error is hard to produce, but the actual + % solution is simple; add more elements. + ExpectCount = length(Tail) + 1, + GotCount = 1, + {error, {not_enough_elements, ExpectCount, GotCount, Row, Col}}; +parse_tuple_tails_paren(ExcessCount, HeadTerm, Tails, Pos, String, _, _) -> + % We were expecting some grouping parens, and now we know that one of them + % was in fact grouping. Good. + parse_tuple_tails(ExcessCount - 1, HeadTerm, Tails, Pos, String). + +parse_tuple_tails_comma(_, _, [], _, _, Row, Col) -> + % No more tuples, so commas are invalid. It's hard to describe the type + % error that a comma would actually produce, so instead let's just give + % the user the actual solution to their problems, which is to remove the + % comma. + {error, {expected_close_paren, Row, Col}}; +parse_tuple_tails_comma(ExcessCount, HeadTerm, Tails, Pos, String, _, _) -> + % If there are no tails then we would have exited into the "grouping parens + % only" case, so we know this works: + [TailTypes | ParentTails] = Tails, + % Now we can parse this tuple as a tuple. + case parse_multivalue(TailTypes, Pos, String, [HeadTerm]) of + {ok, {Terms, NewPos, NewString}} -> + NewHead = {tuple, list_to_tuple(Terms)}, + % Then continue the loop, with whatever parent tuple types this + % tuple is meant to be a part of. + parse_tuple_tails(ExcessCount, NewHead, ParentTails, NewPos, NewString); + {error, Reason} -> + % TODO: wrap errors? + {error, Reason} + end. + +%%% Unambiguous Tuple/Variant Parsing + +parse_multivalue(ElemTypes, Pos, String, Acc) -> + case next_token(Pos, String) of + {ok, {{character, ")", _, Row2, Start2, _}, NewPos, NewString}} -> + check_multivalue_long_enough(ElemTypes, NewPos, NewString, Row2, Start2, Acc); + {ok, {Token, NewPos, NewString}} -> + parse_multivalue2(ElemTypes, NewPos, NewString, Acc, Token); + {error, Reason} -> + {error, Reason} + end. + +parse_multivalue2([Next | Rest], Pos, String, Acc, Token) -> + case parse_expression2(Next, Pos, String, Token) of + {ok, {Value, NewPos, NewString}} -> + parse_multivalue3(Rest, NewPos, NewString, [Value | Acc]); + {error, Reason} -> + Wrapper = choose_list_error_wrapper(")"), + % TODO: Are tuple indices off by one from list indices? + Wrapped = wrap_error(Reason, {Wrapper, length(Acc)}), + {error, Wrapped} + end; +parse_multivalue2([], Pos, String, Acc, Token) -> + count_multivalue_excess(Pos, String, Acc, Token). + +parse_multivalue3(ElemTypes, Pos, String, Acc) -> + case next_token(Pos, String) of + {ok, {{character, ")", _, Row2, Start2, _}, NewPos, NewString}} -> + check_multivalue_long_enough(ElemTypes, NewPos, NewString, Row2, Start2, Acc); + {ok, {{character, ",", _, _, _, _}, NewPos, NewString}} -> + parse_multivalue(ElemTypes, NewPos, NewString, Acc); + {ok, {Token, _, _}} -> + unexpected_token(Token, ")"); + {error, Reason} -> + {error, Reason} + end. + +count_multivalue_excess(Pos, String, TypedAcc, Token) -> + ExpectedLen = length(TypedAcc), + case parse_list_loop2(unknown_type(), Pos, String, ")", TypedAcc, Token) of + {ok, {TermList, _, {Row, Col}, _, _}} -> + ActualLen = length(TermList), + {error, {too_many_elements, ExpectedLen, ActualLen, Row, Col}}; + {error, Reason} -> + {error, Reason} + end. + +check_multivalue_long_enough([], Pos, String, _, _, Acc) -> + {ok, {lists:reverse(Acc), Pos, String}}; +check_multivalue_long_enough(Remaining, _, _, Row, Col, Got) -> + GotCount = length(Got), + ExpectCount = length(Remaining) + GotCount, + {error, {not_enough_elements, ExpectCount, GotCount, Row, Col}}. + +%%% Variant parsing + +parse_variant({O, N, {variant, Variants}}, Pos, String, [Ident], Row, Start, End) -> + parse_variant2(O, N, Variants, Pos, String, "", Ident, Row, Start, End); +parse_variant({O, N, {variant, Variants}}, Pos, String, [Namespace, Constructor], Row, Start, End) -> + case get_typename(O, N) of + [Namespace, _] -> + parse_variant2(O, N, Variants, Pos, String, Namespace ++ ".", Constructor, Row, Start, End); + _ -> + {error, {invalid_constructor, O, N, Namespace ++ "." ++ Constructor, Row, Start, End}} + end; +parse_variant({_, _, unknown_type}, _, _, _, Row, Start, End) -> + {error, {unresolved_variant, Row, Start, End}}; +parse_variant({O, N, _}, _, _, _, Row, Start, End) -> + % In normal code, identifiers can have many meanings, which can result in + % lots of different errors. In constant/immediate/normalized Sophia terms + % we know identifiers are always variants, so we can type error if any + % other type was expected. + {error, {wrong_type, O, N, variant, Row, Start, End}}. + +get_typename(O, already_normalized) -> + get_typename(O); +get_typename(_, N) -> + get_typename(N). + +get_typename({Name, _}) -> + string:split(Name, ".", all); +get_typename(Name) -> + string:split(Name, ".", all). + +parse_variant2(O, N, Variants, Pos, String, Prefix, Constructor, Row, Start, End) -> + case lookup_variant(Constructor, Variants, 0) of + {ok, {Tag, ElemTypes}} -> + 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}} + end. + +parse_variant3(Arities, Tag, [], Pos, String) -> + % Parsing of 0-arity variants is different. + Result = {variant, Arities, Tag, {}}, + {ok, {Result, Pos, String}}; +parse_variant3(Arities, Tag, ElemTypes, Pos, String) -> + case next_token(Pos, String) of + {ok, {{character, "(", _, _, _, _}, NewPos, NewString}} -> + parse_variant4(Arities, Tag, ElemTypes, NewPos, NewString); + {ok, {Token, _, _}} -> + unexpected_token(Token, "("); + {error, Reason} -> + {error, Reason} + end. + +parse_variant4(Arities, Tag, ElemTypes, Pos, String) -> + case parse_multivalue(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. + +lookup_variant(_, [], _) -> + error; +lookup_variant(Ident, [{Ident, ElemTypes} | _], Tag) -> + {ok, {Tag, ElemTypes}}; +lookup_variant(Ident, [_ | Rest], Tag) -> + lookup_variant(Ident, Rest, Tag + 1). + +%%% Record parsing + +parse_record_or_map({_, _, {map, [KeyType, ValueType]}}, Pos, String, _, _) -> + parse_map(KeyType, ValueType, Pos, String, #{}); +parse_record_or_map({_, _, {record, Fields}}, Pos, String, _, _) -> + parse_record(Fields, Pos, String, #{}); +parse_record_or_map({_, _, unknown_type}, Pos, String, _, _) -> + case next_token(Pos, String) of + {ok, {{character, "}", _, _, _, _}, NewPos, NewString}} -> + {ok, {#{}, NewPos, NewString}}; + {ok, {{character, "[", _, _, _, _}, NewPos, NewString}} -> + parse_map2(unknown_type(), unknown_type(), NewPos, NewString, #{}); + {ok, {{alphanum, _, _, Row, Start, End}, _, _}} -> + {error, {unresolved_record, Row, Start, End}}; + {ok, {Token, _, _}} -> + unexpected_token(Token, "}"); + {error, Reason} -> + {error, Reason} + end; +parse_record_or_map({O, N, _}, _, _, Row, Start) -> + {error, {wrong_type, O, N, map, Row, Start, Start}}. + +parse_record(Fields, Pos, String, Acc) -> + case next_token(Pos, String) of + {ok, {{alphanum, Ident, _, Row, Start, End}, NewPos, NewString}} -> + parse_record2(Fields, NewPos, NewString, Acc, Ident, Row, Start, End); + {ok, {{character, "}", _, Row, Start, End}, NewPos, NewString}} -> + parse_record_end(Fields, NewPos, NewString, Acc, Row, Start, End); + {ok, {Token, _, _}} -> + unexpected_token(Token, "}"); + {error, Reason} -> + {error, Reason} + end. + +parse_record2(Fields, Pos, String, Acc, Ident, Row, Start, End) -> + case lists:keyfind(Ident, 1, Fields) of + {_, Type} -> + parse_record3(Fields, Pos, String, Acc, Ident, Row, Start, End, Type); + false -> + {error, {invalid_field, Ident, Row, Start, End}} + end. + +parse_record3(Fields, Pos, String, Acc, Ident, Row, Start, End, Type) -> + case maps:is_key(Ident, Acc) of + false -> + parse_record4(Fields, Pos, String, Acc, Ident, Type); + true -> + {error, {field_already_present, Ident, Row, Start, End}} + end. + +parse_record4(Fields, Pos, String, Acc, Ident, Type) -> + case expect_tokens(["="], Pos, String) of + {ok, {NewPos, NewString}} -> + parse_record5(Fields, NewPos, NewString, Acc, Ident, Type); + {error, Reason} -> + {error, Reason} + end. + +parse_record5(Fields, Pos, String, Acc, Ident, Type) -> + case parse_expression(Type, Pos, String) of + {ok, {Result, NewPos, NewString}} -> + NewAcc = maps:put(Ident, Result, Acc), + parse_record6(Fields, NewPos, NewString, NewAcc); + {error, Reason} -> + wrap_error(Reason, {record_field, Ident}) + end. + +parse_record6(Fields, Pos, String, Acc) -> + case next_token(Pos, String) of + {ok, {{character, ",", _, _, _, _}, NewPos, NewString}} -> + parse_record(Fields, NewPos, NewString, Acc); + {ok, {{character, "}", _, Row, Start, End}, NewPos, NewString}} -> + parse_record_end(Fields, NewPos, NewString, Acc, Row, Start, End); + {ok, {Token, _, _}} -> + unexpected_token(Token, "}"); + {error, Reason} -> + {error, Reason} + end. + +parse_record_end(Fields, Pos, String, FieldValues, Row, Start, End) -> + case parse_record_final_loop(Fields, FieldValues, []) of + {ok, Result} -> + {ok, {Result, Pos, String}}; + {error, {missing_field, Name}} -> + {error, {missing_field, Name, Row, Start, End}} + end. + +parse_record_final_loop([{Name, _} | Rest], FieldValues, Acc) -> + case maps:find(Name, FieldValues) of + {ok, Value} -> + parse_record_final_loop(Rest, FieldValues, [Value | Acc]); + error -> + {error, {missing_field, Name}} + end; +parse_record_final_loop([], _, [Field]) -> + % Singleton records are type-checked in Sophia, but unwrapped in the + % resulting FATE. + {ok, Field}; +parse_record_final_loop([], _, FieldsReverse) -> + Fields = lists:reverse(FieldsReverse), + Tuple = list_to_tuple(Fields), + {ok, {tuple, Tuple}}. + + +%%% Map Parsing + +parse_map(KeyType, ValueType, Pos, String, Acc) -> + case next_token(Pos, String) of + {ok, {{character, "[", _, _, _, _}, NewPos, NewString}} -> + parse_map2(KeyType, ValueType, NewPos, NewString, Acc); + {ok, {{character, "}", _, _, _, _}, NewPos, NewString}} -> + {ok, {Acc, NewPos, NewString}}; + {ok, {Token, _, _}} -> + unexpected_token(Token, "}"); + {error, Reason} -> + {error, Reason} + end. + +parse_map2(KeyType, ValueType, Pos, String, Acc) -> + case parse_expression(KeyType, Pos, String) of + {ok, {Result, NewPos, NewString}} -> + parse_map3(KeyType, ValueType, NewPos, NewString, Acc, Result); + {error, Reason} -> + wrap_error(Reason, {map_key, maps:size(Acc)}) + end. + +parse_map3(KeyType, ValueType, Pos, String, Acc, Key) -> + case expect_tokens(["]", "="], Pos, String) of + {ok, {NewPos, NewString}} -> + parse_map4(KeyType, ValueType, NewPos, NewString, Acc, Key); + {error, Reason} -> + {error, Reason} + end. + +parse_map4(KeyType, ValueType, Pos, String, Acc, Key) -> + case parse_expression(ValueType, Pos, String) of + {ok, {Result, NewPos, NewString}} -> + NewAcc = maps:put(Key, Result, Acc), + parse_map5(KeyType, ValueType, NewPos, NewString, NewAcc); + {error, Reason} -> + {error, Reason} + end. + +parse_map5(KeyType, ValueType, Pos, String, Acc) -> + case next_token(Pos, String) of + {ok, {{character, ",", _, _, _, _}, NewPos, NewString}} -> + parse_map(KeyType, ValueType, NewPos, NewString, Acc); + {ok, {{character, "}", _, _, _, _}, NewPos, NewString}} -> + {ok, {Acc, NewPos, NewString}}; + {ok, {Token, _, _}} -> + unexpected_token(Token, "}"); + {error, Reason} -> + {error, Reason} + end. + +% TODO +wrap_error(Reason, _) -> Reason. + +%%% Pretty Printing + +-spec fate_to_list(FATE) -> Sophia + when FATE :: gmb_fate_data:fate_type(), + Sophia :: string(). + +fate_to_list(Term) -> + fate_to_list(unknown_type(), Term). + +-spec fate_to_list(Type, FATE) -> Sophia + when Type :: hz_aaci:annotated_type(), + FATE :: gmb_fate_data:fate_type(), + Sophia :: string(). + +fate_to_list(Type, Term) -> + IOList = fate_to_iolist(Type, Term), + unicode:characters_to_list(IOList). + +-spec fate_to_iolist(FATE) -> Sophia + when FATE :: gmb_fate_data:fate_type(), + Sophia :: iolist(). + +fate_to_iolist(Term) -> + fate_to_iolist(unknown_type(), Term). + +-spec fate_to_iolist(Type, FATE) -> Sophia + when Type :: hz_aaci:annotated_type(), + FATE :: gmb_fate_data:fate_type(), + Sophia :: iolist(). + +% Special case for singleton records, since they are erased during compilation. +fate_to_iolist({_, _, {record, [{FieldName, FieldType}]}}, Term) -> + singleton_record_to_iolist(FieldName, FieldType, Term); +% Aggregate types, where we should check if there is useful type information to +% act on. Case logic is made explicit so that the default cases stand out. +fate_to_iolist(Type, {tuple, Tuple}) -> + case Type of + {_, _, {record, FieldTypes}} -> + record_to_iolist(FieldTypes, Tuple); + {_, _, {tuple, ElemTypes}} -> + tuple_to_iolist(ElemTypes, Tuple); + _ -> + tuple_to_iolist([], Tuple) + end; +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); + {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 + {_, _, {list, [InnerType]}} -> + list_to_iolist(InnerType, List); + _ -> + list_to_iolist(unknown_type(), List) + end; +fate_to_iolist(Type, Map) when is_map(Map) -> + case Type of + {_, _, {map, [K, V]}} -> + map_to_iolist(K, V, Map); + _ -> + map_to_iolist(unknown_type(), unknown_type(), Map) + end; +% Other FATE types, where no recursion is needed, but type information could +% influence the format that is used. +fate_to_iolist(_, true) -> + "true"; +fate_to_iolist(_, false) -> + "false"; +fate_to_iolist(_, {bits, 0}) -> + "Bits.none"; +fate_to_iolist(_, {bits, -1}) -> + "Bits.all"; +fate_to_iolist(_, {bits, I}) when I > 0 -> + ["#", integer_to_list(I, 16)]; +fate_to_iolist(_, {bits, I}) when I < 0 -> + integer_to_list(I, 10); +fate_to_iolist({_, _, char}, $') -> + % Special case since it needs to be escaped in char literals. + "'\\''"; +fate_to_iolist({_, _, char}, $") -> + % Special case since it does NOT need to be escaped in char literals. + "'\"'"; +fate_to_iolist({_, _, char}, I) when is_integer(I) -> + [$', escape_char(I), $']; +fate_to_iolist(_, I) when is_integer(I) -> + integer_to_list(I); +fate_to_iolist(_, {address, Addr}) -> + gmser_api_encoder:encode(account_pubkey, Addr); +fate_to_iolist(_, {contract, Addr}) -> + gmser_api_encoder:encode(contract_pubkey, Addr); +fate_to_iolist(_, {bytes, Bytes}) -> + Size = bit_size(Bytes), + <> = Bytes, + ["#", integer_to_list(IntValue, 16)]; +fate_to_iolist(_, Bytes) when is_binary(Bytes) -> + escape_string(Bytes). + +escape_string(Binary) -> + escape_string(Binary, []). + +escape_string(<>, Acc) -> + NewAcc = [Acc, escape_char(C)], + escape_string(Rest, NewAcc); +escape_string(<<>>, Acc) -> + [$", Acc, $"]. + +tuple_to_iolist([ElemType], {Elem}) -> + Inner = fate_to_iolist(ElemType, Elem), + ["(", Inner, ",)"]; +tuple_to_iolist(_, {Elem}) -> + Inner = fate_to_iolist(unknown_type(), Elem), + ["(", Inner, ",)"]; +tuple_to_iolist(ElemTypes, Tuple) -> + Elems = tuple_to_list(Tuple), + Multivalue = multivalue_to_iolist(ElemTypes, Elems), + ["(", Multivalue, ")"]. + +list_to_iolist(InnerType, Elems) -> + InnerChars = list_elems_to_iolist(InnerType, Elems), + ["[", InnerChars, "]"]. + +variant_to_iolist(O, N, Variants, Tag, Tuple) -> + Prefix = choose_variant_prefix(O, N), + {Name, ElemTypes} = lists:nth(Tag + 1, Variants), + case tuple_size(Tuple) of + 0 -> + [Prefix, Name]; + _ -> + Elems = tuple_to_list(Tuple), + Multivalue = multivalue_to_iolist(ElemTypes, Elems), + [Prefix, Name, "(", Multivalue, ")"] + end. + +choose_variant_prefix(O, N) -> + case get_typename(O, N) of + [Namespace, _] -> + [Namespace, "."]; + _ -> + [] + end. + +multivalue_to_iolist([FirstType | ElemTypes], [FirstTerm | Elems]) -> + FirstTermChars = fate_to_iolist(FirstType, FirstTerm), + multivalue_to_iolist(ElemTypes, Elems, FirstTermChars); +multivalue_to_iolist(_, Elems) -> + list_elems_to_iolist(unknown_type(), Elems). + +multivalue_to_iolist([NextType | RestTypes], [NextTerm | RestTerms], Acc) -> + NextTermChars = fate_to_iolist(NextType, NextTerm), + multivalue_to_iolist(RestTypes, RestTerms, [Acc, ", ", NextTermChars]); +multivalue_to_iolist(_, Elems, Acc) -> + list_elems_to_iolist(unknown_type(), Elems, Acc). + +list_elems_to_iolist(Type, [FirstTerm | Rest]) -> + FirstTermChars = fate_to_iolist(Type, FirstTerm), + list_elems_to_iolist(Type, Rest, FirstTermChars); +list_elems_to_iolist(_, []) -> + "". + +list_elems_to_iolist(Type, [Next | Rest], Acc) -> + NextChars = fate_to_iolist(Type, Next), + list_elems_to_iolist(Type, Rest, [Acc, ", ", NextChars]); +list_elems_to_iolist(_, [], Acc) -> + Acc. + +singleton_record_to_iolist(FieldName, FieldType, Term) -> + FieldChars = fate_to_iolist(FieldType, Term), + ["{", FieldName, " = ", FieldChars, "}"]. + +record_to_iolist(FieldTypes, Tuple) -> + case length(FieldTypes) == tuple_size(Tuple) of + true -> + Chars = record_fields_to_iolist(FieldTypes, tuple_to_list(Tuple)), + ["{", Chars, "}"]; + false -> + tuple_to_iolist([], Tuple) + end. + +record_fields_to_iolist([{Name, Type} | FieldTypes], [Term | Terms]) -> + TermChars = fate_to_iolist(Type, Term), + record_fields_to_iolist(FieldTypes, Terms, [Name, " = ", TermChars]); +record_fields_to_iolist(_, []) -> + "". + +record_fields_to_iolist([{Name, Type} | FieldTypes], [Term | Terms], Acc) -> + TermChars = fate_to_iolist(Type, Term), + NewAcc = [Acc, ", ", Name, " = ", TermChars], + record_fields_to_iolist(FieldTypes, Terms, NewAcc); +record_fields_to_iolist(_, [], Acc) -> + Acc. + +map_to_iolist(K, V, Map) -> + Iter = maps:iterator(Map), + case maps:next(Iter) of + {KeyTerm, ValTerm, Rest} -> + KChars = fate_to_iolist(K, KeyTerm), + VChars = fate_to_iolist(V, ValTerm), + RestChars = map_to_iolist_inner(K, V, Rest, ["[", KChars, "] = ", VChars]), + ["{", RestChars, "}"]; + none -> + "{}" + end. + +map_to_iolist_inner(K, V, Iter, Acc) -> + case maps:next(Iter) of + {KeyTerm, ValTerm, Rest} -> + KChars = fate_to_iolist(K, KeyTerm), + VChars = fate_to_iolist(V, ValTerm), + map_to_iolist_inner(K, V, Rest, [Acc, ", [", KChars, "] = ", VChars]); + none -> + Acc + end. + +%%% Tests + +check_sophia_to_fate(Type, Sophia, Fate) -> + case parse_literal(Type, Sophia) of + {ok, Fate} -> + ok; + Result -> + erlang:error({to_fate_failed, Sophia, Fate, Result}) + end. + +check_fate_to_sophia(Type, Fate, Sophia) -> + case fate_to_list(Type, Fate) of + Sophia -> + ok; + Result -> + erlang:error({to_sophia_failed, Fate, Sophia, Result}) + end. + +roundtrip_parser(Type, Sophia, Fate) -> + check_sophia_to_fate(Type, Sophia, Fate), + check_fate_to_sophia(Type, Fate, Sophia), + + ok. + +% These test function names are getting ridiculous... I might want to optarg +% them or something, but, whatever, it's test code. +roundtrip_parser_lenient(Type, Sophia, Fate) -> + check_sophia_to_fate(Type, Sophia, Fate), + case fate_to_list(Type, Fate) of + Sophia -> + ok; + SophiaActual -> + check_sophia_to_fate(Type, SophiaActual, Fate) + end. + +compile_entrypoint_value_and_type(Source, Entrypoint) -> + {ok, #{fate_code := FateCode, aci := ACI}} = so_compiler:from_string(Source, [{aci, json}]), + + % Find the fcode for the correct entrypoint. + {fcode, Bodies, NamesMap, _} = FateCode, + Names = maps:to_list(NamesMap), + Name = unicode:characters_to_binary(Entrypoint), + {Hash, Name} = lists:keyfind(Name, 2, Names), + {_, _, Code} = maps:get(Hash, Bodies), + FATE = extract_return_value(Code), + + % Generate the AACI, and get the AACI type info for the correct entrypoint. + AACI = hz_aaci:prepare(ACI), + {ok, {_, Type}} = hz_aaci:get_function_signature(AACI, "f"), + + {FATE, Type}. + +extract_return_value(#{0 := [{'RETURNR', {immediate, FATE}}]}) -> + FATE; +extract_return_value(Code) -> + erlang:exit({invalid_literal_fcode, Code}). + +check_parser(Sophia) -> + % Compile the literal using the compiler, to check that it is valid Sophia + % syntax, and to get an AACI object to pass to the parser. + Source = "contract C = entrypoint f() = " ++ Sophia, + {Fate, Type} = compile_entrypoint_value_and_type(Source, "f"), + + % Check that when we parse the term we get the same value as the Sophia + % compiler. Also check that the pretty printer gives the same string back. + check_sophia_to_fate(unknown_type(), Sophia, Fate), + + % Then, once we know that the term is correct, make sure that it is still + % accepted *with* type info. Don't bother roundtripping this, since the + % pretty printer doesn't enforce types anyway. + check_sophia_to_fate(Type, Sophia, Fate). + +check_parser_roundtrip(Sophia) -> + Source = "contract C = entrypoint f() = " ++ Sophia, + {Fate, Type} = compile_entrypoint_value_and_type(Source, "f"), + roundtrip_parser(Type, Sophia, Fate), + % Without type information we might get a more generic result in Sophia + % syntax. Let's do a lenient test. + roundtrip_parser_lenient(unknown_type(), Sophia, Fate). + +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, 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. + check_parser_roundtrip("123"), + check_parser("1_2_3"), + check_parser_roundtrip("-123"), + % Booleans. + check_parser_roundtrip("true"), + check_parser_roundtrip("false"), + check_parser_roundtrip("[true, false]"), + % Bytes. + check_parser_roundtrip("#DEAD000BEEF"), + check_parser("#DE_AD0_00B_EEF"), + % Strings. + check_parser_roundtrip("\"hello world\""), + % The Sophia compiler doesn't handle this right, but we should still. + %check_parser_roundtrip("\"ÿ\""), + %check_parser_roundtrip("\"♣\""), + % Characters. + check_parser_roundtrip("'A'"), + check_parser_roundtrip("['a', ' ', '[']"), + %check_parser_roundtrip("'ÿ'"), + %check_parser_roundtrip("'♣'"), + % List of integers. + check_parser_roundtrip("[1, 2, 3]"), + % List of lists. + check_parser_roundtrip("[[], [1], [2, 3]]"), + % Tuple. + check_parser_roundtrip("(1, [2, 3], (4, 5))"), + % Map. + check_parser_roundtrip("{[1] = 2, [3] = 4}"), + + ok. + +string_escape_codes_test() -> + check_parser_roundtrip("\" \\b\\e\\f\\n\\r\\t\\v\\\"\\\\ \""), + check_parser("\"\\x00\\x11\\x77\\x4a\\x4A\""), + check_parser("\"\\x{0}\\x{7}\\x{7F}\\x{07F}\\x{007F}\\x{0007F}\\x{0000007F}\""), + check_parser_roundtrip("\"'\""), + + check_parser_roundtrip("['\\b', '\\e', '\\f', '\\n', '\\r', '\\t', '\\v', '\"', '\\'', '\\\\']"), + check_parser("['\\x00', '\\x11', '\\x77', '\\x4a', '\\x4A']"), + check_parser("['\\x{0}', '\\x{7}', '\\x{7F}', '\\x{07F}', '\\x{007F}', '\\x{0007F}', '\\x{0000007F}']"), + check_parser_roundtrip("'\"'"), + + ok. + +records_test() -> + TypeDef = "record pair = {x: int, y: int}", + Sophia = "{x = 1, y = 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). + +variant_test() -> + TypeDef = "datatype multi('a) = Zero | One('a) | Two('a, 'a)", + + 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"), + + ok. + +ambiguous_variant_test() -> + TypeDef = "datatype mytype = C | D", + 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. + +namespace_variant_test() -> + Term = "[N.A, N.B]", + Source = "namespace N = datatype mytype = A | B\ncontract C = entrypoint f() = " ++ Term, + {Fate, VariantType} = compile_entrypoint_value_and_type(Source, "f"), + roundtrip_parser(VariantType, Term, Fate), + + ok. + +chain_objects_test() -> + % Address, + check_parser_roundtrip("ak_2FTnrGfV8qsfHpaSEHpBrziioCpwwzLqSevHqfxQY3PaAAdARx"), + % Two different forms of signature, + check_parser("sg_XDyF8LJC4tpMyAySvpaG1f5V9F2XxAbRx9iuVjvvdNMwVracLhzAuXhRM5kXAFtpwW1DCHuz5jGehUayCah4jub32Ti2n"), + check_parser("#00112233445566778899AABBCCDDEEFF_00112233445566778899AABBCCDDEEFF_00112233445566778899AABBCCDDEEFF_00112233445566778899AABBCCDDEEFF"), + check_parser_roundtrip("#112233445566778899AABBCCDDEEFF00112233445566778899AABBCCDDEEFF00112233445566778899AABBCCDDEEFF00112233445566778899AABBCCDDEEFF"), + + % We have to build a totally custom contract example in order to get an + % AACI and return value for parsing contract addresses. This is because the + % compiler demands that contract addresses be type checked according to the + % logic of "contract oriented programming", including covariance, etc. and + % "contract oriented programming" is not very compatible with ML style type + % inference. + Contract = "ct_2FTnrGfV8qsfHpaSEHpBrziioCpwwzLqSevHqfxQY3PaAAdARx", + Source = "contract C = entrypoint f(): C = " ++ Contract, + {Fate, ContractType} = compile_entrypoint_value_and_type(Source, "f"), + roundtrip_parser(ContractType, Contract, Fate), + roundtrip_parser(unknown_type(), Contract, Fate), + + ok. + +bits_test() -> + check_parser_roundtrip("Bits.all"), + check_parser_roundtrip("Bits.none"), + {_, Type} = compile_entrypoint_value_and_type("contract C = entrypoint f() = Bits.all", "f"), + roundtrip_parser_lenient(Type, "5", {bits, 5}), + roundtrip_parser(Type, "-5", {bits, -5}), + roundtrip_parser(Type, "#123", {bits, 256 + 32 + 3}), + ok. + +singleton_records_test() -> + TypeDef = "record singleton('a) = {it: 'a}", + 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. + +singleton_variants_test() -> + % Similar tests to the singleton records, but this time there isn't + % 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)"), + check_parser_with_typedef(TypeDef, "Wrap(Wrap(123))"), + check_parser_with_typedef(TypeDef, "[Wrap(1), Wrap(2), Wrap(3)]"), + + ok. + +excess_parens_test() -> + % 'singleton' parens are another special case, but unlike singleton + % records, which exist in the type system, singleton parens aren't tuples + % at all! They are just grouping, for arithmetic. For example. + check_parser("(123)"), + check_parser("[1, (2), ((3))]"), + % Where this gets tricky, though, is when grouping parens are mixed with + % tuple parens. E.g. this list of three tuples should all parse to the same + % result. + check_parser("[((1, 2)), ((1), 2), (((1), 2))]"), + % Including multiple nestings of tuples and grouping, interleaved. + check_parser("((((1), ((2, 3)))), 4)"), + % Also empty tuples exist! + check_parser_roundtrip("()"), + check_parser_roundtrip("(((), ()), ((), ()))"), + check_parser("(((((), ())), ()))"), + + ok. + +lexer_offset_test() -> + % Test that various tokens report their position correctly. + {error, {unexpected_token, "456", 1, 5, 7}} = parse_literal("123 456"), + {error, {unexpected_token, "[", 1, 5, 5}} = parse_literal("123 [0]"), + {error, {unexpected_token, "ABC", 1, 5, 7}} = parse_literal("123 ABC"), + {error, {unexpected_token, "#AA", 1, 5, 7}} = parse_literal("123 #AA"), + {error, {unexpected_token, "\"x\"", 1, 5, 7}} = parse_literal("123 \"x\""), + {error, {unexpected_token, "\"\\x{123}\"", 1, 5, 13}} = parse_literal("123 \"\\x{123}\""), + + % Check that the tokenizer knows its position correctly *after* various + % tokens. + {error, {unexpected_token, "123", 1, 5, 7}} = parse_literal("[0] 123"), + ABCType = {"mytype", already_normalized, {variant, [{"ABC", []}]}}, + {error, {unexpected_token, "123", 1, 5, 7}} = parse_literal(ABCType, "ABC 123"), + {error, {unexpected_token, "123", 1, 5, 7}} = parse_literal("#AA 123"), + {error, {unexpected_token, "123", 1, 5, 7}} = parse_literal("\"x\" 123"), + {error, {unexpected_token, "123", 1, 11, 13}} = parse_literal("\"\\x{123}\" 123"), + + % Check that the tokenizer accounts for various line separators correctly. + {error, {unexpected_token, "ABC", 2, 1, 3}} = parse_literal("123\nABC"), + {error, {unexpected_token, "ABC", 2, 1, 3}} = parse_literal("123\r\nABC"), + {error, {unexpected_token, "ABC", 2, 1, 3}} = parse_literal("123\rABC"), + + ok. + +parser_offset_test() -> + {_, Type} = compile_entrypoint_value_and_type("contract C = entrypoint f() = ((1, 2), (3, 4))", "f"), + + {error, {not_enough_elements, 2, 1, 1, 8}} = parse_literal(Type, "((1, 2))"), + {error, {not_enough_elements, 2, 1, 1, 10}} = parse_literal(Type, "(((1, 2)))"), + {error, {too_many_elements, 2, 3, 1, 24}} = parse_literal(Type, "((1, 2), (3, 4), (5, 6))"), + {error, {too_many_elements, 2, 3, 1, 10}} = parse_literal(Type, "((1, 2, 3), (4, 5))"), + + ok. + +singleton_test() -> + % The Sophia compiler would never generate this, but it is a valid type + % within the FATE virtual machine, and it is possible to represent within + % the ACI itself. + SingletonACI = #{tuple => [<<"int">>]}, + + % Build an AACI around this, and run it through the AACI machinery. + Function = #{name => <<"f">>, + arguments => [], + stateful => false, + payable => false, + returns => SingletonACI}, + ACI = [#{contract => #{functions => [Function], + name => <<"C">>, + kind => contract_main, + payable => false, + typedefs => []}}], + {aaci, "C", #{"f" := {[], SingletonType}}, _} = hz_aaci:prepare(ACI), + + % Now let's do some testing with this weird type, to see if we handle it + % correctly. + {ok, {tuple, {1}}} = parse_literal(SingletonType, "(1,)"), + "(1,)" = fate_to_list(SingletonType, {tuple, {1}}), + % Some ambiguous nesting parens, for fun. + {ok, {tuple, {1}}} = parse_literal(SingletonType, "(((1),))"), + % No trailing comma should give an error. + {error, {expected_trailing_comma, 1, 3}} = parse_literal(SingletonType, "(1)"), + % All of the above should behave the same in untyped contexts: + {ok, {tuple, {1}}} = parse_literal(unknown_type(), "(1,)"), + "(1,)" = fate_to_list(unknown_type(), {tuple, {1}}), + {ok, {tuple, {1}}} = parse_literal(unknown_type(), "(((1),))"), + {ok, 1} = parse_literal(unknown_type(), "(1)"), + + % Also if we wanted an integer, the singleton is NOT dropped, so is also an + % error. + {error, {expected_close_paren, 1, 3}} = parse_literal({integer, already_normalized, integer}, "(1,)"), + + ok. diff --git a/src/hz_sup.erl b/src/hz_sup.erl index d60ccbf..eabb584 100644 --- a/src/hz_sup.erl +++ b/src/hz_sup.erl @@ -9,7 +9,7 @@ %%% @end -module(hz_sup). --vsn("0.8.3"). +-vsn("0.9.0"). -behaviour(supervisor). -author("Craig Everett "). -copyright("Craig Everett "). diff --git a/zomp.meta b/zomp.meta index ffd766f..0fa8075 100644 --- a/zomp.meta +++ b/zomp.meta @@ -4,7 +4,7 @@ {prefix,"hz"}. {desc,"Gajumaru interoperation library"}. {author,"Craig Everett"}. -{package_id,{"otpr","hakuzaru",{0,8,3}}}. +{package_id,{"otpr","hakuzaru",{0,9,0}}}. {deps,[{"otpr","sophia",{9,0,0}}, {"otpr","gmserialization",{0,1,3}}, {"otpr","gmbytecode",{3,4,1}},