Compare commits
19 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 6daad4974c | |||
| d323fb0f52 | |||
| ea3a5453f2 | |||
| 75bc52ede3 | |||
| 29619f08b7 | |||
| af46223163 | |||
| 9cafdd2b0f | |||
| 6d429aa6a4 | |||
| 3585dbe534 | |||
| 9a7a2a98c4 | |||
| 9fc89c0c22 | |||
| 23c13f607e | |||
| 8bc79d3b3f | |||
| 3fae9a2edd | |||
| a3b19747b6 | |||
| f8e9333b4b | |||
| eaccd50764 | |||
| 9fd8dbd1a6 | |||
| e595991616 |
+4
-3
@@ -1,5 +1,6 @@
|
|||||||
@author Craig Everett <craigeverett@qpq.swiss> [https://git.qpq.swiss/QPQ-AG/hakuzaru]
|
@author Craig Everett <craigeverett@qpq.swiss> [https://zxq9.com]
|
||||||
@version 0.9.1
|
@author Jarvis Carrol <jarviscarrol@qpq.swiss> [https://jarviscarroll.net/]
|
||||||
|
@version 0.9.2
|
||||||
@title Hakuzaru: Gajumaru blockchain bindings for Erlang
|
@title Hakuzaru: Gajumaru blockchain bindings for Erlang
|
||||||
|
|
||||||
@doc
|
@doc
|
||||||
@@ -21,7 +22,7 @@ After startup `hz_man' must be given the address and port of a list of Gajumaru
|
|||||||
Note that the service nodes will need to have the dry-run endpoint enabled and the internal service query port made available in order to provide dry-runs and transaction submission.
|
Note that the service nodes will need to have the dry-run endpoint enabled and the internal service query port made available in order to provide dry-runs and transaction submission.
|
||||||
|
|
||||||
When configuring chain nodes a list of nodes should be provided.
|
When configuring chain nodes a list of nodes should be provided.
|
||||||
To avoid sync issues in the case of fast transaction formation/submission to the chain, only one node from the list of chain nodes is used for submitting transactions and querying `next_nonce/1`.
|
To avoid sync issues in the case of fast transaction formation/submission to the chain, only one node from the list of chain nodes is used for submitting transactions and querying `next_nonce/1'.
|
||||||
This node is called "the sticky node".
|
This node is called "the sticky node".
|
||||||
|
|
||||||
The first node in the list of chain nodes provided during configuration is designated as the sticky node.
|
The first node in the list of chain nodes provided during configuration is designated as the sticky node.
|
||||||
|
|||||||
+1
-1
@@ -3,7 +3,7 @@
|
|||||||
{included_applications,[]},
|
{included_applications,[]},
|
||||||
{applications,[stdlib,kernel]},
|
{applications,[stdlib,kernel]},
|
||||||
{description,"Gajumaru interoperation library"},
|
{description,"Gajumaru interoperation library"},
|
||||||
{vsn,"0.9.1"},
|
{vsn,"0.9.2"},
|
||||||
{modules,[hakuzaru,hz,hz_aaci,hz_fetcher,hz_format,hz_grids,
|
{modules,[hakuzaru,hz,hz_aaci,hz_fetcher,hz_format,hz_grids,
|
||||||
hz_key_master,hz_man,hz_sophia,hz_sup]},
|
hz_key_master,hz_man,hz_sophia,hz_sup]},
|
||||||
{mod,{hakuzaru,[]}}]}.
|
{mod,{hakuzaru,[]}}]}.
|
||||||
|
|||||||
+1
-1
@@ -6,7 +6,7 @@
|
|||||||
%%% @end
|
%%% @end
|
||||||
|
|
||||||
-module(hakuzaru).
|
-module(hakuzaru).
|
||||||
-vsn("0.9.1").
|
-vsn("0.9.2").
|
||||||
-author("Craig Everett <ceverett@tsuriai.jp>").
|
-author("Craig Everett <ceverett@tsuriai.jp>").
|
||||||
-copyright("Craig Everett <ceverett@tsuriai.jp>").
|
-copyright("Craig Everett <ceverett@tsuriai.jp>").
|
||||||
-license("GPL-3.0-or-later").
|
-license("GPL-3.0-or-later").
|
||||||
|
|||||||
+72
-11
@@ -23,7 +23,7 @@
|
|||||||
%%% @end
|
%%% @end
|
||||||
|
|
||||||
-module(hz).
|
-module(hz).
|
||||||
-vsn("0.9.1").
|
-vsn("0.9.2").
|
||||||
-author("Craig Everett <ceverett@tsuriai.jp>").
|
-author("Craig Everett <ceverett@tsuriai.jp>").
|
||||||
-copyright("Craig Everett <ceverett@tsuriai.jp>").
|
-copyright("Craig Everett <ceverett@tsuriai.jp>").
|
||||||
-license("GPL-3.0-or-later").
|
-license("GPL-3.0-or-later").
|
||||||
@@ -45,7 +45,7 @@
|
|||||||
acc/1, acc_at_height/2, acc_at_block_id/2,
|
acc/1, acc_at_height/2, acc_at_block_id/2,
|
||||||
acc_pending_txs/1,
|
acc_pending_txs/1,
|
||||||
next_nonce/1,
|
next_nonce/1,
|
||||||
dry_run/1, dry_run/2, dry_run/3, dry_run_map/1,
|
dry_run/1, dry_run/2, dry_run/3, % dry_run_map/1,
|
||||||
tx/1, tx_info/1,
|
tx/1, tx_info/1,
|
||||||
post_tx/1,
|
post_tx/1,
|
||||||
contract/1, contract_code/1, contract_source/1,
|
contract/1, contract_code/1, contract_source/1,
|
||||||
@@ -125,13 +125,14 @@
|
|||||||
% "info" => contract_byte_array(),
|
% "info" => contract_byte_array(),
|
||||||
% "miner" => account_id(),
|
% "miner" => account_id(),
|
||||||
% "nonce" => non_neg_integer(),
|
% "nonce" => non_neg_integer(),
|
||||||
% "pow" => [non_neg_integer()],
|
|
||||||
% "prev_hash" => microblock_hash(),
|
% "prev_hash" => microblock_hash(),
|
||||||
% "prev_key_hash" => keyblock_hash(),
|
% "prev_key_hash" => keyblock_hash(),
|
||||||
|
% "seal" => #{"data" => [int()],
|
||||||
|
% "signature" => signature()}
|
||||||
% "state_hash" => block_state_hash(),
|
% "state_hash" => block_state_hash(),
|
||||||
% "target" => non_neg_integer(),
|
% "target" => non_neg_integer(),
|
||||||
% "time" => non_neg_integer(),
|
% "time" => non_neg_integer(),
|
||||||
% "version" => 5}.
|
% "version" => 1}.
|
||||||
% </pre>
|
% </pre>
|
||||||
-type microblock_header() :: #{string() => term()}.
|
-type microblock_header() :: #{string() => term()}.
|
||||||
% <pre>
|
% <pre>
|
||||||
@@ -353,7 +354,7 @@ top_height() ->
|
|||||||
|
|
||||||
|
|
||||||
-spec top_block() -> {ok, TopBlock} | {error, Reason}
|
-spec top_block() -> {ok, TopBlock} | {error, Reason}
|
||||||
when TopBlock :: microblock_header(),
|
when TopBlock :: microblock_header() | keyblock(),
|
||||||
Reason :: chain_error().
|
Reason :: chain_error().
|
||||||
%% @doc
|
%% @doc
|
||||||
%% Returns the header of the current top block.
|
%% Returns the header of the current top block.
|
||||||
@@ -661,9 +662,10 @@ dry_run(TX, Accounts, KBHash) ->
|
|||||||
request("/v3/dry_run", JSON).
|
request("/v3/dry_run", JSON).
|
||||||
|
|
||||||
|
|
||||||
dry_run_map(Map) ->
|
% TODO
|
||||||
JSON = zj:binary_encode(Map),
|
%dry_run_map(Map) ->
|
||||||
request("/v3/dry_run", JSON).
|
% JSON = zj:binary_encode(Map),
|
||||||
|
% request("/v3/dry_run", JSON).
|
||||||
|
|
||||||
|
|
||||||
-spec decode_bytearray_fate(EncodedStr) -> {ok, Result} | {error, Reason}
|
-spec decode_bytearray_fate(EncodedStr) -> {ok, Result} | {error, Reason}
|
||||||
@@ -813,8 +815,10 @@ extract2(TarBaby) ->
|
|||||||
{ok, Source};
|
{ok, Source};
|
||||||
{ok, Bundle} ->
|
{ok, Bundle} ->
|
||||||
{project, Bundle};
|
{project, Bundle};
|
||||||
|
{error,invalid_tar_checksum} ->
|
||||||
|
{ok, TarBaby};
|
||||||
Error ->
|
Error ->
|
||||||
io:format("Dis chit happen: ~tp~n", [Error]),
|
ok = io:format("erl_tar:extract/2 error: ~tp~n", [Error]),
|
||||||
{ok, TarBaby}
|
{ok, TarBaby}
|
||||||
end.
|
end.
|
||||||
|
|
||||||
@@ -1650,6 +1654,14 @@ convert([], [], _, Terms, []) ->
|
|||||||
convert([], [], _, _, Errors) ->
|
convert([], [], _, _, Errors) ->
|
||||||
{error, Errors}.
|
{error, Errors}.
|
||||||
|
|
||||||
|
-spec sign_tx(Unsigned, SecKey) -> Result
|
||||||
|
when Unsigned :: string(),
|
||||||
|
SecKey :: binary(),
|
||||||
|
Result :: {ok, SignedTX} | {error, Reason},
|
||||||
|
SignedTX :: binary(),
|
||||||
|
Reason :: chain_error().
|
||||||
|
%% @doc
|
||||||
|
%% Signs transaction data with the provided secret key for the currently selected network.
|
||||||
|
|
||||||
sign_tx(Unsigned, SecKey) ->
|
sign_tx(Unsigned, SecKey) ->
|
||||||
case network_id() of
|
case network_id() of
|
||||||
@@ -1657,6 +1669,15 @@ sign_tx(Unsigned, SecKey) ->
|
|||||||
Error -> Error
|
Error -> Error
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
-spec sign_tx(Unsigned, SecKey, NetworkID) -> SignedTX
|
||||||
|
when Unsigned :: string(),
|
||||||
|
SecKey :: binary(),
|
||||||
|
NetworkID :: string(),
|
||||||
|
SignedTX :: binary().
|
||||||
|
%% @doc
|
||||||
|
%% Signs transaction data with the provided secret key using the provided network ID.
|
||||||
|
|
||||||
sign_tx(Unsigned, SecKey, MNetworkID) ->
|
sign_tx(Unsigned, SecKey, MNetworkID) ->
|
||||||
UnsignedBin = unicode:characters_to_binary(Unsigned),
|
UnsignedBin = unicode:characters_to_binary(Unsigned),
|
||||||
NetworkID = unicode:characters_to_binary(MNetworkID),
|
NetworkID = unicode:characters_to_binary(MNetworkID),
|
||||||
@@ -1676,10 +1697,21 @@ sign_tx(Unsigned, SecKey, MNetworkID) ->
|
|||||||
gmser_api_encoder:encode(transaction, SignedTX).
|
gmser_api_encoder:encode(transaction, SignedTX).
|
||||||
|
|
||||||
|
|
||||||
spend(SenderID, SecKey, ReceipientID, Amount, Payload) ->
|
-spec spend(SenderID, SecKey, RecipientID, Amount, Payload) -> {ok, Result} | {error, Reason}
|
||||||
|
when SenderID :: string(),
|
||||||
|
SecKey :: binary(),
|
||||||
|
RecipientID :: string(),
|
||||||
|
Amount :: non_neg_integer(),
|
||||||
|
Payload :: binary(),
|
||||||
|
Result :: term(), % FIXME
|
||||||
|
Reason :: chain_error() | string().
|
||||||
|
%% @doc
|
||||||
|
%% Forms a spend transaction and submits it to the chain.
|
||||||
|
|
||||||
|
spend(SenderID, SecKey, RecipientID, Amount, Payload) ->
|
||||||
case status() of
|
case status() of
|
||||||
{ok, #{"top_block_height" := Height, "network_id" := NetworkID}} ->
|
{ok, #{"top_block_height" := Height, "network_id" := NetworkID}} ->
|
||||||
spend(SenderID, SecKey, ReceipientID, Amount, Payload, Height, NetworkID);
|
spend(SenderID, SecKey, RecipientID, Amount, Payload, Height, NetworkID);
|
||||||
Error ->
|
Error ->
|
||||||
Error
|
Error
|
||||||
end.
|
end.
|
||||||
@@ -1706,6 +1738,23 @@ spend(SenderID, SecKey, RecipientID, Amount, Payload, Height, NetworkID) ->
|
|||||||
end.
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
-spec spend(SenderID, SecKey, RecipientID, Amount,
|
||||||
|
GasPrice, Gas, TTL, Nonce, Payload, NetworkID) -> {ok, Result} | {error, Reason}
|
||||||
|
when SenderID :: string(),
|
||||||
|
SecKey :: binary(),
|
||||||
|
RecipientID :: string(),
|
||||||
|
Amount :: non_neg_integer(),
|
||||||
|
GasPrice :: pos_integer(),
|
||||||
|
Gas :: pos_integer(),
|
||||||
|
TTL :: non_neg_integer(),
|
||||||
|
Nonce :: non_neg_integer(),
|
||||||
|
Payload :: binary(),
|
||||||
|
NetworkID :: unicode:chardata(),
|
||||||
|
Result :: term(), % FIXME
|
||||||
|
Reason :: chain_error() | string().
|
||||||
|
%% @doc
|
||||||
|
%% Forms a spend transaction and submits it to the chain.
|
||||||
|
|
||||||
spend(SenderID,
|
spend(SenderID,
|
||||||
SecKey,
|
SecKey,
|
||||||
RecipientID,
|
RecipientID,
|
||||||
@@ -1818,6 +1867,10 @@ spend3(DSenderID,
|
|||||||
when Message :: binary(),
|
when Message :: binary(),
|
||||||
SecKey :: binary(),
|
SecKey :: binary(),
|
||||||
Sig :: binary().
|
Sig :: binary().
|
||||||
|
%% @doc
|
||||||
|
%% Accepts a string to be signed, prepends the prefix `"Gajumaru Signed Message:\n"',
|
||||||
|
%% encodes the string with `vencode/1', then hashes the encoded message and signs the
|
||||||
|
%% hash.
|
||||||
|
|
||||||
sign_message(Message, SecKey) ->
|
sign_message(Message, SecKey) ->
|
||||||
Prefix = message_sig_prefix(),
|
Prefix = message_sig_prefix(),
|
||||||
@@ -1896,6 +1949,12 @@ eu(N, Size) ->
|
|||||||
when Binary :: binary(),
|
when Binary :: binary(),
|
||||||
SecKey :: binary(),
|
SecKey :: binary(),
|
||||||
Sig :: binary().
|
Sig :: binary().
|
||||||
|
%% @doc
|
||||||
|
%% This procedure signs an arbitrary binary blob with a special binary prefix
|
||||||
|
%% attached. The reason for the binary prefix is to prevent signing of dangerous
|
||||||
|
%% binaries which could be used to authorized dangerous actions on chain.
|
||||||
|
%% The signature target becomes: `<<"Gajumaru Signed Binary:", Binary/binary>>'
|
||||||
|
%% before being hashed, and then the resulting hash is signed.
|
||||||
|
|
||||||
sign_binary(Binary, SecKey) ->
|
sign_binary(Binary, SecKey) ->
|
||||||
Prefix = binary_sig_prefix(),
|
Prefix = binary_sig_prefix(),
|
||||||
@@ -1910,6 +1969,8 @@ sign_binary(Binary, SecKey) ->
|
|||||||
PubKey :: pubkey(),
|
PubKey :: pubkey(),
|
||||||
Result :: {ok, Outcome :: boolean()}
|
Result :: {ok, Outcome :: boolean()}
|
||||||
| {error, Reason :: term()}.
|
| {error, Reason :: term()}.
|
||||||
|
%% @doc
|
||||||
|
%% Verifies a signature created with the `sign_binary/2' function.
|
||||||
|
|
||||||
verify_bin_signature(Sig, Binary, PubKey) ->
|
verify_bin_signature(Sig, Binary, PubKey) ->
|
||||||
case gmser_api_encoder:decode(PubKey) of
|
case gmser_api_encoder:decode(PubKey) of
|
||||||
|
|||||||
+555
-247
File diff suppressed because it is too large
Load Diff
+9
-1
@@ -1,5 +1,13 @@
|
|||||||
|
%%% @private
|
||||||
|
%%% Hakuzaru Request Fetcher
|
||||||
|
%%%
|
||||||
|
%%% This module defines the request workers.
|
||||||
|
%%% Each request to a remote chain node is handled by a worker that is spawned
|
||||||
|
%%% to handle it and terminates on completion.
|
||||||
|
%%% @end
|
||||||
|
|
||||||
-module(hz_fetcher).
|
-module(hz_fetcher).
|
||||||
-vsn("0.9.1").
|
-vsn("0.9.2").
|
||||||
-author("Craig Everett <ceverett@tsuriai.jp>").
|
-author("Craig Everett <ceverett@tsuriai.jp>").
|
||||||
-copyright("Craig Everett <ceverett@tsuriai.jp>").
|
-copyright("Craig Everett <ceverett@tsuriai.jp>").
|
||||||
-license("MIT").
|
-license("MIT").
|
||||||
|
|||||||
+18
-1
@@ -21,7 +21,7 @@
|
|||||||
%%% @end
|
%%% @end
|
||||||
|
|
||||||
-module(hz_format).
|
-module(hz_format).
|
||||||
-vsn("0.9.1").
|
-vsn("0.9.2").
|
||||||
-author("Craig Everett <ceverett@tsuriai.jp>").
|
-author("Craig Everett <ceverett@tsuriai.jp>").
|
||||||
-copyright("Craig Everett <ceverett@tsuriai.jp>").
|
-copyright("Craig Everett <ceverett@tsuriai.jp>").
|
||||||
-license("GPL-3.0-or-later").
|
-license("GPL-3.0-or-later").
|
||||||
@@ -462,9 +462,26 @@ ranks(heresy) ->
|
|||||||
["k ", "m ", "b ", "t ", "q ", "e ", "z ", "y ", "r ", "Q "].
|
["k ", "m ", "b ", "t ", "q ", "e ", "z ", "y ", "r ", "Q "].
|
||||||
|
|
||||||
|
|
||||||
|
-spec mark(Unit) -> Mark
|
||||||
|
when Unit :: gaju | puck,
|
||||||
|
Mark :: $木 | $本.
|
||||||
|
%% @doc
|
||||||
|
%% Retrieve the unicode codepoint for the `gaju' mark (木) or the `puck' mark (本).
|
||||||
|
|
||||||
mark(gaju) -> $木;
|
mark(gaju) -> $木;
|
||||||
mark(puck) -> $本.
|
mark(puck) -> $本.
|
||||||
|
|
||||||
|
|
||||||
|
-spec one(Unit) -> Pucks
|
||||||
|
when Unit :: gaju | puck,
|
||||||
|
Pucks :: 1_000_000_000_000_000_000 | 1.
|
||||||
|
%% @doc
|
||||||
|
%% Quickly resolve the number of pucks in a given unit.
|
||||||
|
%%
|
||||||
|
%% The number of pucks in a gaju is so large that it can be a little bit annoying
|
||||||
|
%% to remember the exact amount. This is a helper to simplify this when writing
|
||||||
|
%% an app against the hakuzaru library when dealing in either unit.
|
||||||
|
|
||||||
one(gaju) -> 1_000_000_000_000_000_000;
|
one(gaju) -> 1_000_000_000_000_000_000;
|
||||||
one(puck) -> 1.
|
one(puck) -> 1.
|
||||||
|
|
||||||
|
|||||||
+34
-2
@@ -37,7 +37,7 @@
|
|||||||
%%% @end
|
%%% @end
|
||||||
|
|
||||||
-module(hz_grids).
|
-module(hz_grids).
|
||||||
-vsn("0.9.1").
|
-vsn("0.9.2").
|
||||||
-export([url/2, url/3, url/4, parse/1, req/2, req/3, req/4]).
|
-export([url/2, url/3, url/4, parse/1, req/2, req/3, req/4]).
|
||||||
|
|
||||||
|
|
||||||
@@ -47,7 +47,7 @@
|
|||||||
Result :: {ok, GRIDS} | uri_string:uri_error(),
|
Result :: {ok, GRIDS} | uri_string:uri_error(),
|
||||||
GRIDS :: uri_string:uri_string().
|
GRIDS :: uri_string:uri_string().
|
||||||
%% @doc
|
%% @doc
|
||||||
%% Takes
|
%% Takes an instruction and an HTTP endpoint location and forms a GRIDS URL.
|
||||||
|
|
||||||
url(Instruction, HTTP) ->
|
url(Instruction, HTTP) ->
|
||||||
case uri_string:parse(HTTP) of
|
case uri_string:parse(HTTP) of
|
||||||
@@ -134,6 +134,8 @@ qwargs(Amount, Payload) ->
|
|||||||
Amount :: non_neg_integer(),
|
Amount :: non_neg_integer(),
|
||||||
Payload :: binary(),
|
Payload :: binary(),
|
||||||
URL :: string().
|
URL :: string().
|
||||||
|
%% @doc
|
||||||
|
%% Translate a GRIDS URL into an Erlang terms instruction.
|
||||||
|
|
||||||
parse(GRIDS) ->
|
parse(GRIDS) ->
|
||||||
case uri_string:parse(GRIDS) of
|
case uri_string:parse(GRIDS) of
|
||||||
@@ -190,13 +192,43 @@ l_to_i(S) ->
|
|||||||
end.
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
-spec req(Type, Message) -> Format
|
||||||
|
when Type :: sign | tx | ack,
|
||||||
|
Message :: string() | binary(),
|
||||||
|
Format :: map().
|
||||||
|
%% @doc
|
||||||
|
%% @equiv req(Type, Message, false)
|
||||||
|
|
||||||
req(Type, Message) ->
|
req(Type, Message) ->
|
||||||
req(Type, Message, false).
|
req(Type, Message, false).
|
||||||
|
|
||||||
|
|
||||||
|
-spec req(Type, Message, ID) -> Format
|
||||||
|
when Type :: sign | tx | ack,
|
||||||
|
Message :: string() | binary(),
|
||||||
|
ID :: false | string() | binary(),
|
||||||
|
Format :: map().
|
||||||
|
%% @doc
|
||||||
|
%% Creates a GRIDS message format with the current `NetworkID'.
|
||||||
|
%%
|
||||||
|
%% The `ID' parameter indicates which key the requestee should sign with or
|
||||||
|
%% is `false' to indicate that which key to sign with is up to the requestee.
|
||||||
|
%% @equiv req(Type, Message, ID, CurrentNetworkID)
|
||||||
|
|
||||||
req(Type, Message, ID) ->
|
req(Type, Message, ID) ->
|
||||||
{ok, NetworkID} = hz:network_id(),
|
{ok, NetworkID} = hz:network_id(),
|
||||||
req(Type, Message, ID, NetworkID).
|
req(Type, Message, ID, NetworkID).
|
||||||
|
|
||||||
|
|
||||||
|
-spec req(Type, Message, ID, NetworkID) -> Format
|
||||||
|
when Type :: sign | tx | ack,
|
||||||
|
Message :: string() | binary(),
|
||||||
|
ID :: false | string() | binary(),
|
||||||
|
NetworkID :: string() | binary(),
|
||||||
|
Format :: map().
|
||||||
|
%% @doc
|
||||||
|
%% Creates a GRIDS message format.
|
||||||
|
|
||||||
req(sign, Message, ID, NetworkID) ->
|
req(sign, Message, ID, NetworkID) ->
|
||||||
#{"grids" => 1,
|
#{"grids" => 1,
|
||||||
"chain" => "gajumaru",
|
"chain" => "gajumaru",
|
||||||
|
|||||||
@@ -8,7 +8,7 @@
|
|||||||
%%% @end
|
%%% @end
|
||||||
|
|
||||||
-module(hz_key_master).
|
-module(hz_key_master).
|
||||||
-vsn("0.9.1").
|
-vsn("0.9.2").
|
||||||
|
|
||||||
-export([make_key/1, encode/1, decode/1]).
|
-export([make_key/1, encode/1, decode/1]).
|
||||||
-export([lcg/1]).
|
-export([lcg/1]).
|
||||||
|
|||||||
+1
-2
@@ -9,7 +9,7 @@
|
|||||||
%%% @end
|
%%% @end
|
||||||
|
|
||||||
-module(hz_man).
|
-module(hz_man).
|
||||||
-vsn("0.9.1").
|
-vsn("0.9.2").
|
||||||
-behavior(gen_server).
|
-behavior(gen_server).
|
||||||
-author("Craig Everett <ceverett@tsuriai.jp>").
|
-author("Craig Everett <ceverett@tsuriai.jp>").
|
||||||
-copyright("Craig Everett <ceverett@tsuriai.jp>").
|
-copyright("Craig Everett <ceverett@tsuriai.jp>").
|
||||||
@@ -172,7 +172,6 @@ start_link() ->
|
|||||||
%% preparatory work necessary for proper function.
|
%% preparatory work necessary for proper function.
|
||||||
|
|
||||||
init(none) ->
|
init(none) ->
|
||||||
ok = io:format("hz_man starting.~n"),
|
|
||||||
State = #s{},
|
State = #s{},
|
||||||
{ok, State}.
|
{ok, State}.
|
||||||
|
|
||||||
|
|||||||
+246
-45
@@ -1,29 +1,31 @@
|
|||||||
-module(hz_sophia).
|
-module(hz_sophia).
|
||||||
-vsn("0.9.1").
|
-vsn("0.9.2").
|
||||||
-author("Jarvis Carroll <spiveehere@gmail.com>").
|
-author("Jarvis Carroll <spiveehere@gmail.com>").
|
||||||
-copyright("Jarvis Carroll <spiveehere@gmail.com>").
|
-copyright("Jarvis Carroll <spiveehere@gmail.com>").
|
||||||
-license("GPL-3.0-or-later").
|
-license("GPL-3.0-or-later").
|
||||||
|
|
||||||
-export([parse_literal/1, parse_literal/2]).
|
-export([parse_literal/2, parse_literal/1]).
|
||||||
-export([fate_to_list/1, fate_to_list/2, fate_to_iolist/1, fate_to_iolist/2]).
|
-export([fate_to_list/1, fate_to_list/2, fate_to_iolist/1, fate_to_iolist/2]).
|
||||||
|
|
||||||
-include_lib("eunit/include/eunit.hrl").
|
-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}
|
-spec parse_literal(Type, Sophia) -> {ok, FATE} | {error, Reason}
|
||||||
when Type :: hz_aaci:annotated_type(),
|
when Type :: hz_aaci:annotated_type(),
|
||||||
Sophia :: string(),
|
Sophia :: string(),
|
||||||
FATE :: gmb_fate_data:fate_type(),
|
FATE :: gmb_fate_data:fate_type(),
|
||||||
Reason :: term().
|
Reason :: term().
|
||||||
|
|
||||||
|
%% @doc
|
||||||
|
%% Parse a typed Sophia expression into a FATE term
|
||||||
|
%% The Sophia expression must consist only of literals, thus making a 'Sophia
|
||||||
|
%% term', which means no arithmetic, no function calls, no variables, etc.
|
||||||
|
%% The FATE term is in the format that gmbytecode expects as input, for forming
|
||||||
|
%% contract calls, etc. Used by the hz module to implement the 'sophia' format.
|
||||||
|
%%
|
||||||
|
%% The function takes type information retrieved from the AACI data structure,
|
||||||
|
%% which is used to interpret record types and variant types, but is also used
|
||||||
|
%% to check inputs and generate errors.
|
||||||
|
|
||||||
parse_literal(Type, String) ->
|
parse_literal(Type, String) ->
|
||||||
case parse_expression(Type, {1, 1}, String) of
|
case parse_expression(Type, {1, 1}, String) of
|
||||||
{ok, {Result, NewPos, NewString}} ->
|
{ok, {Result, NewPos, NewString}} ->
|
||||||
@@ -43,6 +45,29 @@ parse_literal2(Result, Pos, String) ->
|
|||||||
{error, Reason}
|
{error, Reason}
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
-spec parse_literal(Sophia) -> {ok, FATE} | {error, Reason}
|
||||||
|
when Sophia :: string(),
|
||||||
|
FATE :: gmb_fate_data:fate_type(),
|
||||||
|
Reason :: term().
|
||||||
|
|
||||||
|
%% @doc
|
||||||
|
%% Parse an untyped Sophia expression into a FATE term
|
||||||
|
%% Like `parse_literal/2', but will not produce type errors. This function can
|
||||||
|
%% still produce parsing errors, and can produce errors when variants or
|
||||||
|
%% records are encountered, since they can't be parsed unless you have type
|
||||||
|
%% information.
|
||||||
|
%%
|
||||||
|
%% Note that since records are implemented as tuples, if you are trying to call
|
||||||
|
%a function that you know takes a record, but you don't have type information
|
||||||
|
%% available in the context where the expression is being passed, then tuples
|
||||||
|
%% can be used instead. This does not work if you have type information,
|
||||||
|
%% though, as tuples and records are different Sophia/AACI types.
|
||||||
|
|
||||||
|
parse_literal(String) ->
|
||||||
|
parse_literal(unknown_type(), String).
|
||||||
|
|
||||||
|
|
||||||
%%% Tokenizer
|
%%% Tokenizer
|
||||||
|
|
||||||
-define(IS_LATIN_UPPER(C), (((C) >= $A) and ((C) =< $Z))).
|
-define(IS_LATIN_UPPER(C), (((C) >= $A) and ((C) =< $Z))).
|
||||||
@@ -228,6 +253,8 @@ escape_char($\") -> "\\\"";
|
|||||||
escape_char($\\) -> "\\\\";
|
escape_char($\\) -> "\\\\";
|
||||||
escape_char(I) -> I.
|
escape_char(I) -> I.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
%%% Sophia Literal Parser
|
%%% Sophia Literal Parser
|
||||||
|
|
||||||
%%% This parser is a simple recursive descent parser, written explicitly in
|
%%% This parser is a simple recursive descent parser, written explicitly in
|
||||||
@@ -316,6 +343,12 @@ parse_expression2(_, _, _, Token) ->
|
|||||||
unknown_type() ->
|
unknown_type() ->
|
||||||
{unknown_type, already_normalized, unknown_type}.
|
{unknown_type, already_normalized, unknown_type}.
|
||||||
|
|
||||||
|
int_type() ->
|
||||||
|
{integer, already_normalized, integer}.
|
||||||
|
|
||||||
|
int_list_type() ->
|
||||||
|
{{list, [integer]}, alread_normalized, {list, [int_type()]}}.
|
||||||
|
|
||||||
expect_tokens([], Pos, String) ->
|
expect_tokens([], Pos, String) ->
|
||||||
{ok, {Pos, String}};
|
{ok, {Pos, String}};
|
||||||
expect_tokens([Str | Rest], Pos, String) ->
|
expect_tokens([Str | Rest], Pos, String) ->
|
||||||
@@ -350,11 +383,14 @@ parse_alphanum(Type, Pos, String, ["Bits", "all"], Row, Start, End) ->
|
|||||||
typecheck_bits(Type, Pos, String, -1, Row, Start, End);
|
typecheck_bits(Type, Pos, String, -1, Row, Start, End);
|
||||||
parse_alphanum(Type, Pos, String, ["Bits", "none"], Row, Start, End) ->
|
parse_alphanum(Type, Pos, String, ["Bits", "none"], Row, Start, End) ->
|
||||||
typecheck_bits(Type, Pos, String, 0, Row, Start, End);
|
typecheck_bits(Type, Pos, String, 0, Row, Start, End);
|
||||||
|
parse_alphanum(Type, Pos, String, ["variant"], Row, Start, End) ->
|
||||||
|
parse_anonymous_variant(Type, Pos, String, Row, Start, End);
|
||||||
parse_alphanum(Type, Pos, String, [[C | _] = S], Row, Start, End) when ?IS_LATIN_LOWER(C) ->
|
parse_alphanum(Type, Pos, String, [[C | _] = S], Row, Start, End) when ?IS_LATIN_LOWER(C) ->
|
||||||
% From a programming perspective, we are trying to parse a constant, so
|
% From a programming perspective, we are trying to parse a constant, so
|
||||||
% an alphanum token can really only be a constructor, or a chain object.
|
% an alphanum token can really only be a constructor, or a chain object.
|
||||||
% Constructors start with uppercase characters, so lowercase can only be a
|
% Constructors start with uppercase characters, and we have handled our
|
||||||
% chain object.
|
% made-up 'variant' case explicitly, so the only other lowercase constants
|
||||||
|
% are serialized chain objects.
|
||||||
try
|
try
|
||||||
case gmser_api_encoder:decode(unicode:characters_to_binary(S)) of
|
case gmser_api_encoder:decode(unicode:characters_to_binary(S)) of
|
||||||
{account_pubkey, Data} ->
|
{account_pubkey, Data} ->
|
||||||
@@ -373,8 +409,8 @@ parse_alphanum(Type, Pos, String, [[C | _] = S], Row, Start, End) when ?IS_LATIN
|
|||||||
_:_ -> {error, {unexpected_identifier, S, Row, Start, End}}
|
_:_ -> {error, {unexpected_identifier, S, Row, Start, End}}
|
||||||
end;
|
end;
|
||||||
parse_alphanum(Type, Pos, String, Path, Row, Start, End) ->
|
parse_alphanum(Type, Pos, String, Path, Row, Start, End) ->
|
||||||
% Inversely, chain object prefixes are always lowercase, so any other path
|
% Now having handled all lowercase terms, anything else must be uppercase,
|
||||||
% must be a variant constructor, or invalid.
|
% which is either a variant constructor, or totally invalid.
|
||||||
parse_variant(Type, Pos, String, Path, Row, Start, End).
|
parse_variant(Type, Pos, String, Path, Row, Start, End).
|
||||||
|
|
||||||
typecheck_integer({_, _, integer}, Pos, String, Value, _, _, _) ->
|
typecheck_integer({_, _, integer}, Pos, String, Value, _, _, _) ->
|
||||||
@@ -704,6 +740,12 @@ parse_variant({O, N, {variant, Variants}}, Pos, String, [Namespace, Constructor]
|
|||||||
_ ->
|
_ ->
|
||||||
{error, {invalid_constructor, O, N, Namespace ++ "." ++ Constructor, Row, Start, End}}
|
{error, {invalid_constructor, O, N, Namespace ++ "." ++ Constructor, Row, Start, End}}
|
||||||
end;
|
end;
|
||||||
|
parse_variant({_, _, unknown_type}, Pos, String, ["None"], _, _, _) ->
|
||||||
|
% Special case for None without type info.
|
||||||
|
parse_variant3([0, 1], 0, [], Pos, String);
|
||||||
|
parse_variant({_, _, unknown_type}, Pos, String, ["Some"], _, _, _) ->
|
||||||
|
% Also a special case for Some.
|
||||||
|
parse_variant3([0, 1], 1, [unknown_type()], Pos, String);
|
||||||
parse_variant({_, _, unknown_type}, _, _, _, Row, Start, End) ->
|
parse_variant({_, _, unknown_type}, _, _, _, Row, Start, End) ->
|
||||||
{error, {unresolved_variant, Row, Start, End}};
|
{error, {unresolved_variant, Row, Start, End}};
|
||||||
parse_variant({O, N, _}, _, _, _, Row, Start, End) ->
|
parse_variant({O, N, _}, _, _, _, Row, Start, End) ->
|
||||||
@@ -726,8 +768,7 @@ get_typename(Name) ->
|
|||||||
parse_variant2(O, N, Variants, Pos, String, Prefix, Constructor, Row, Start, End) ->
|
parse_variant2(O, N, Variants, Pos, String, Prefix, Constructor, Row, Start, End) ->
|
||||||
case lookup_variant(Constructor, Variants, 0) of
|
case lookup_variant(Constructor, Variants, 0) of
|
||||||
{ok, {Tag, ElemTypes}} ->
|
{ok, {Tag, ElemTypes}} ->
|
||||||
GetArity = fun({_, OtherElemTypes}) -> length(OtherElemTypes) end,
|
Arities = get_arities(Variants),
|
||||||
Arities = lists:map(GetArity, Variants),
|
|
||||||
parse_variant3(Arities, Tag, ElemTypes, Pos, String);
|
parse_variant3(Arities, Tag, ElemTypes, Pos, String);
|
||||||
error ->
|
error ->
|
||||||
{error, {invalid_constructor, O, N, Prefix ++ Constructor, Row, Start, End}}
|
{error, {invalid_constructor, O, N, Prefix ++ Constructor, Row, Start, End}}
|
||||||
@@ -763,6 +804,112 @@ lookup_variant(Ident, [{Ident, ElemTypes} | _], Tag) ->
|
|||||||
lookup_variant(Ident, [_ | Rest], Tag) ->
|
lookup_variant(Ident, [_ | Rest], Tag) ->
|
||||||
lookup_variant(Ident, Rest, Tag + 1).
|
lookup_variant(Ident, Rest, Tag + 1).
|
||||||
|
|
||||||
|
get_arities(Variants) ->
|
||||||
|
GetArity = fun({_, OtherElemTypes}) -> length(OtherElemTypes) end,
|
||||||
|
lists:map(GetArity, Variants).
|
||||||
|
|
||||||
|
parse_anonymous_variant({O, N, {variant, Variants}}, Pos, String, _, _, _) ->
|
||||||
|
parse_anonymous_variant2({O, N, {variant, Variants}}, Pos, String);
|
||||||
|
parse_anonymous_variant({O, N, unknown_type}, Pos, String, _, _, _) ->
|
||||||
|
parse_anonymous_variant2({O, N, unknown_type}, Pos, String);
|
||||||
|
parse_anonymous_variant({O, N, _}, _, _, Row, Start, End) ->
|
||||||
|
{error, {wrong_type, O, N, variant, Row, Start, End}}.
|
||||||
|
|
||||||
|
parse_anonymous_variant2(Type, Pos, String) ->
|
||||||
|
case expect_tokens(["("], Pos, String) of
|
||||||
|
{ok, {NewPos, NewString}} ->
|
||||||
|
parse_anonymous_variant3(Type, NewPos, NewString);
|
||||||
|
{error, Reason} ->
|
||||||
|
{error, Reason}
|
||||||
|
end.
|
||||||
|
|
||||||
|
parse_anonymous_variant3(Type, Pos, String) ->
|
||||||
|
case parse_arities(Type, Pos, String) of
|
||||||
|
{ok, {Arities, NewPos, NewString}} ->
|
||||||
|
parse_anonymous_variant4(Type, NewPos, NewString, Arities);
|
||||||
|
{error, Reason} ->
|
||||||
|
{error, Reason}
|
||||||
|
end.
|
||||||
|
|
||||||
|
parse_anonymous_variant4(Type, Pos, String, Arities) ->
|
||||||
|
case expect_tokens([","], Pos, String) of
|
||||||
|
{ok, {NewPos, NewString}} ->
|
||||||
|
parse_anonymous_variant5(Type, NewPos, NewString, Arities);
|
||||||
|
{error, Reason} ->
|
||||||
|
{error, Reason}
|
||||||
|
end.
|
||||||
|
|
||||||
|
parse_anonymous_variant5(Type, Pos, String, Arities) ->
|
||||||
|
case parse_anonymous_tag(Pos, String, Arities) of
|
||||||
|
{ok, {Tag, NewPos, NewString}} ->
|
||||||
|
parse_anonymous_variant6(Type, NewPos, NewString, Arities, Tag);
|
||||||
|
{error, Reason} ->
|
||||||
|
{error, Reason}
|
||||||
|
end.
|
||||||
|
|
||||||
|
parse_anonymous_variant6(Type, Pos, String, Arities, Tag) ->
|
||||||
|
ElemTypes = infer_anonymous_variant_elem_types(Type, Arities, Tag),
|
||||||
|
case parse_multivalue3(ElemTypes, Pos, String, []) of
|
||||||
|
{ok, {Terms, NewPos, NewString}} ->
|
||||||
|
Result = {variant, Arities, Tag, list_to_tuple(Terms)},
|
||||||
|
{ok, {Result, NewPos, NewString}};
|
||||||
|
{error, Reason} ->
|
||||||
|
{error, Reason}
|
||||||
|
end.
|
||||||
|
|
||||||
|
parse_arities(Type, Pos, String) ->
|
||||||
|
case next_token(Pos, String) of
|
||||||
|
{ok, {Token, NewPos, NewString}} ->
|
||||||
|
parse_arities2(Type, NewPos, NewString, Token);
|
||||||
|
{error, Reason} ->
|
||||||
|
{error, Reason}
|
||||||
|
end.
|
||||||
|
|
||||||
|
parse_arities2(Type, Pos, String, Token = {_, _, _, Row, Start, _}) ->
|
||||||
|
case parse_expression2(int_list_type(), Pos, String, Token) of
|
||||||
|
{ok, {Arities, NewPos, NewString}} ->
|
||||||
|
parse_arities3(Type, NewPos, NewString, Arities, Row, Start);
|
||||||
|
{error, Reason} ->
|
||||||
|
{error, Reason}
|
||||||
|
end.
|
||||||
|
|
||||||
|
parse_arities3({O, N, {variant, Variants}}, Pos, String, Arities, Row, Start) ->
|
||||||
|
ExpectedArities = get_arities(Variants),
|
||||||
|
case Arities == ExpectedArities of
|
||||||
|
true ->
|
||||||
|
{ok, {Arities, Pos, String}};
|
||||||
|
false ->
|
||||||
|
{error, {wrong_arities, O, N, Arities, Row, Start}}
|
||||||
|
end;
|
||||||
|
parse_arities3(_, Pos, String, Arities, _, _) ->
|
||||||
|
{ok, {Arities, Pos, String}}.
|
||||||
|
|
||||||
|
parse_anonymous_tag(Pos, String, Arities) ->
|
||||||
|
case next_token(Pos, String) of
|
||||||
|
{ok, {Token, NewPos, NewString}} ->
|
||||||
|
parse_anonymous_tag2(NewPos, NewString, Arities, Token);
|
||||||
|
{error, Reason} ->
|
||||||
|
{error, Reason}
|
||||||
|
end.
|
||||||
|
|
||||||
|
parse_anonymous_tag2(Pos, String, Arities, Token = {_, _, _, Row, Start, End}) ->
|
||||||
|
TagCount = length(Arities),
|
||||||
|
case parse_expression2(int_type(), Pos, String, Token) of
|
||||||
|
{ok, {Tag, _, _}} when Tag < 0 ->
|
||||||
|
{error, {negative_tag, Tag, Row, Start, End}};
|
||||||
|
{ok, {Tag, _, _}} when Tag >= TagCount ->
|
||||||
|
{error, {invalid_tag, Tag, TagCount, Row, Start, End}};
|
||||||
|
Result ->
|
||||||
|
Result
|
||||||
|
end.
|
||||||
|
|
||||||
|
infer_anonymous_variant_elem_types({_, _, {variant, Variants}}, _, Tag) ->
|
||||||
|
{_Name, ElemTypes} = lists:nth(Tag + 1, Variants),
|
||||||
|
ElemTypes;
|
||||||
|
infer_anonymous_variant_elem_types({_, _, unknown_type}, Arities, Tag) ->
|
||||||
|
Arity = lists:nth(Tag + 1, Arities),
|
||||||
|
lists:duplicate(Arity, unknown_type()).
|
||||||
|
|
||||||
%%% Record parsing
|
%%% Record parsing
|
||||||
|
|
||||||
parse_record_or_map({_, _, {map, [KeyType, ValueType]}}, Pos, String, _, _) ->
|
parse_record_or_map({_, _, {map, [KeyType, ValueType]}}, Pos, String, _, _) ->
|
||||||
@@ -927,6 +1074,19 @@ wrap_error(Reason, _) -> Reason.
|
|||||||
when FATE :: gmb_fate_data:fate_type(),
|
when FATE :: gmb_fate_data:fate_type(),
|
||||||
Sophia :: string().
|
Sophia :: string().
|
||||||
|
|
||||||
|
%% @doc
|
||||||
|
%% Print a FATE term from gmbytecode in Sophia syntax
|
||||||
|
%% FATE terms usually come from using gmbytecode to decode the result of an
|
||||||
|
%% on-chain transaction.
|
||||||
|
%%
|
||||||
|
%% This function does not use any type information to interpret the data, and
|
||||||
|
%% so can make mistakes. It's okay for interpreting tuples, lists, maps,
|
||||||
|
%% integers, and strings, but it will misinterpret the types of records and
|
||||||
|
%% unicode characters, and will crash the process if variants are encountered.
|
||||||
|
%%
|
||||||
|
%% `fate_to_list/2' should be used whenever possible, especially since
|
||||||
|
%% transaction results are type checked by nodes at runtime.
|
||||||
|
|
||||||
fate_to_list(Term) ->
|
fate_to_list(Term) ->
|
||||||
fate_to_list(unknown_type(), Term).
|
fate_to_list(unknown_type(), Term).
|
||||||
|
|
||||||
@@ -935,10 +1095,27 @@ fate_to_list(Term) ->
|
|||||||
FATE :: gmb_fate_data:fate_type(),
|
FATE :: gmb_fate_data:fate_type(),
|
||||||
Sophia :: string().
|
Sophia :: string().
|
||||||
|
|
||||||
|
|
||||||
|
%% @doc
|
||||||
|
%% Print a FATE term from gmbytecode in Sophia syntax
|
||||||
|
%% Like `fate_to_list/1', but now type information from the AACI data structure
|
||||||
|
%% can be provided, in order to correctly interpret types like records,
|
||||||
|
%% variants, and unicode characters. If the type information you provide is
|
||||||
|
%% incorrect for the FATE term provided, then the function will fall back to
|
||||||
|
%% untyped pretty printing like in fate_to_list/1, but this is not recommended,
|
||||||
|
%% as correct type information should always be available.
|
||||||
|
|
||||||
fate_to_list(Type, Term) ->
|
fate_to_list(Type, Term) ->
|
||||||
IOList = fate_to_iolist(Type, Term),
|
IOList = fate_to_iolist(Type, Term),
|
||||||
unicode:characters_to_list(IOList).
|
unicode:characters_to_list(IOList).
|
||||||
|
|
||||||
|
%% @doc
|
||||||
|
%% Print a FATE term in Sophia syntax, without concatenating
|
||||||
|
%% The `fate_to_list/1' function builds an iolist, and then concatenates it into
|
||||||
|
%% a list. If you are going to put the term into a bigger iolist directly
|
||||||
|
%% after, or write it to a streaming device, then it can save effort and memory
|
||||||
|
%% to just use the iolist directly.
|
||||||
|
|
||||||
-spec fate_to_iolist(FATE) -> Sophia
|
-spec fate_to_iolist(FATE) -> Sophia
|
||||||
when FATE :: gmb_fate_data:fate_type(),
|
when FATE :: gmb_fate_data:fate_type(),
|
||||||
Sophia :: iolist().
|
Sophia :: iolist().
|
||||||
@@ -951,6 +1128,11 @@ fate_to_iolist(Term) ->
|
|||||||
FATE :: gmb_fate_data:fate_type(),
|
FATE :: gmb_fate_data:fate_type(),
|
||||||
Sophia :: iolist().
|
Sophia :: iolist().
|
||||||
|
|
||||||
|
%% @doc
|
||||||
|
%% Print a FATE term in Sophia syntax, without concatenating
|
||||||
|
%% Prints using type information, like `fate_to_list/2', but without spending
|
||||||
|
%% time or memory concatenating the result into a list, like fate_to_iolist/1.
|
||||||
|
|
||||||
% Special case for singleton records, since they are erased during compilation.
|
% Special case for singleton records, since they are erased during compilation.
|
||||||
fate_to_iolist({_, _, {record, [{FieldName, FieldType}]}}, Term) ->
|
fate_to_iolist({_, _, {record, [{FieldName, FieldType}]}}, Term) ->
|
||||||
singleton_record_to_iolist(FieldName, FieldType, Term);
|
singleton_record_to_iolist(FieldName, FieldType, Term);
|
||||||
@@ -965,15 +1147,12 @@ fate_to_iolist(Type, {tuple, Tuple}) ->
|
|||||||
_ ->
|
_ ->
|
||||||
tuple_to_iolist([], Tuple)
|
tuple_to_iolist([], Tuple)
|
||||||
end;
|
end;
|
||||||
fate_to_iolist(Type, {variant, _, Tag, Tuple}) ->
|
fate_to_iolist(Type, {variant, Arities, Tag, Tuple}) ->
|
||||||
case Type of
|
case Type of
|
||||||
{O, N, {variant, VariantTypes}} when Tag < length(VariantTypes) ->
|
{O, N, {variant, VariantTypes}} when Tag < length(VariantTypes) ->
|
||||||
variant_to_iolist(O, N, VariantTypes, Tag, Tuple);
|
variant_to_iolist(O, N, VariantTypes, Tag, Tuple);
|
||||||
{O, N, _} ->
|
{_, _, _} ->
|
||||||
% TODO: Make up a special syntax for anonymous variant terms.
|
anonymous_variant_to_iolist(Arities, Tag, Tuple)
|
||||||
erlang:exit({untyped_variant, O, N});
|
|
||||||
_ ->
|
|
||||||
erlang:exit({untyped_variant, unknown_type, already_normalized})
|
|
||||||
end;
|
end;
|
||||||
fate_to_iolist(Type, List) when is_list(List) ->
|
fate_to_iolist(Type, List) when is_list(List) ->
|
||||||
case Type of
|
case Type of
|
||||||
@@ -1068,6 +1247,22 @@ choose_variant_prefix(O, N) ->
|
|||||||
[]
|
[]
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
% We don't have type information, but the Sophia programming language doesn't
|
||||||
|
% have syntax for anonymous variants, so we have to make a syntax up. This
|
||||||
|
% syntax is also supported when parsing terms, so that the output of one
|
||||||
|
% contract call can be fed easily into another contract call.
|
||||||
|
anonymous_variant_to_iolist(Arities, Tag, Tuple) ->
|
||||||
|
% Extract the elements of the tuple.
|
||||||
|
Elems = tuple_to_list(Tuple),
|
||||||
|
|
||||||
|
% Turn the arities, tag, and elements into an iolist.
|
||||||
|
AritiesStr = list_to_iolist(int_type(), Arities),
|
||||||
|
TagStr = integer_to_list(Tag),
|
||||||
|
FullTermsStr = list_elems_to_iolist(unknown_type(), Elems, [AritiesStr, ", ", TagStr]),
|
||||||
|
|
||||||
|
% Wrap that iolist in the anonymous 'variant' constructor.
|
||||||
|
["variant(", FullTermsStr, ")"].
|
||||||
|
|
||||||
multivalue_to_iolist([FirstType | ElemTypes], [FirstTerm | Elems]) ->
|
multivalue_to_iolist([FirstType | ElemTypes], [FirstTerm | Elems]) ->
|
||||||
FirstTermChars = fate_to_iolist(FirstType, FirstTerm),
|
FirstTermChars = fate_to_iolist(FirstType, FirstTerm),
|
||||||
multivalue_to_iolist(ElemTypes, Elems, FirstTermChars);
|
multivalue_to_iolist(ElemTypes, Elems, FirstTermChars);
|
||||||
@@ -1220,16 +1415,18 @@ check_parser_roundtrip(Sophia) ->
|
|||||||
% syntax. Let's do a lenient test.
|
% syntax. Let's do a lenient test.
|
||||||
roundtrip_parser_lenient(unknown_type(), Sophia, Fate).
|
roundtrip_parser_lenient(unknown_type(), Sophia, Fate).
|
||||||
|
|
||||||
check_parser_with_typedef(Typedef, Sophia) ->
|
check_parser_with_typedef(Typedef, Sophia, UntypedSophia) ->
|
||||||
% Compile the type definitions alongside the usual literal expression.
|
% Compile the type definitions alongside the usual literal expression.
|
||||||
Source = "contract C =\n " ++ Typedef ++ "\n entrypoint f() = " ++ Sophia,
|
Source = "contract C =\n " ++ Typedef ++ "\n entrypoint f() = " ++ Sophia,
|
||||||
{Fate, Type} = compile_entrypoint_value_and_type(Source, "f"),
|
{Fate, Type} = compile_entrypoint_value_and_type(Source, "f"),
|
||||||
|
|
||||||
% Do a typed parse, as usual, but there are probably record/variant
|
% Do a typed parse, as usual. Variant namespaces can make pretty printing
|
||||||
% definitions in the AACI, so untyped parses probably don't work, and
|
% ambiguous, so make the roundtrip lenient.
|
||||||
% variants often have optional namespaces, so the sophia result might not
|
roundtrip_parser_lenient(Type, Sophia, Fate),
|
||||||
% match exactly, but should still be equivalent.
|
% Do an untyped parse, but using a second special Sophia expression that
|
||||||
roundtrip_parser_lenient(Type, Sophia, Fate).
|
% doesn't require type info to parse. This one *doesn't* need to be
|
||||||
|
% lenient, since we are specifying a distinct sophia expression.
|
||||||
|
roundtrip_parser(unknown_type(), UntypedSophia, Fate).
|
||||||
|
|
||||||
anon_types_test() ->
|
anon_types_test() ->
|
||||||
% Integers.
|
% Integers.
|
||||||
@@ -1261,6 +1458,10 @@ anon_types_test() ->
|
|||||||
check_parser_roundtrip("(1, [2, 3], (4, 5))"),
|
check_parser_roundtrip("(1, [2, 3], (4, 5))"),
|
||||||
% Map.
|
% Map.
|
||||||
check_parser_roundtrip("{[1] = 2, [3] = 4}"),
|
check_parser_roundtrip("{[1] = 2, [3] = 4}"),
|
||||||
|
% Option.
|
||||||
|
check_parser_roundtrip("None"),
|
||||||
|
check_parser_roundtrip("Some(1)"),
|
||||||
|
check_parser_roundtrip("Some([1, 2, 3])"),
|
||||||
|
|
||||||
ok.
|
ok.
|
||||||
|
|
||||||
@@ -1280,7 +1481,7 @@ string_escape_codes_test() ->
|
|||||||
records_test() ->
|
records_test() ->
|
||||||
TypeDef = "record pair = {x: int, y: int}",
|
TypeDef = "record pair = {x: int, y: int}",
|
||||||
Sophia = "{x = 1, y = 2}",
|
Sophia = "{x = 1, y = 2}",
|
||||||
check_parser_with_typedef(TypeDef, Sophia),
|
check_parser_with_typedef(TypeDef, Sophia, "(1, 2)"),
|
||||||
% The above won't run an untyped parse on the expression, but we can. It
|
% The above won't run an untyped parse on the expression, but we can. It
|
||||||
% will error, though.
|
% will error, though.
|
||||||
{error, {unresolved_record, _, _, _}} = parse_literal(unknown_type(), Sophia).
|
{error, {unresolved_record, _, _, _}} = parse_literal(unknown_type(), Sophia).
|
||||||
@@ -1288,11 +1489,11 @@ records_test() ->
|
|||||||
variant_test() ->
|
variant_test() ->
|
||||||
TypeDef = "datatype multi('a) = Zero | One('a) | Two('a, 'a)",
|
TypeDef = "datatype multi('a) = Zero | One('a) | Two('a, 'a)",
|
||||||
|
|
||||||
check_parser_with_typedef(TypeDef, "Zero"),
|
check_parser_with_typedef(TypeDef, "Zero", "variant([0, 1, 2], 0)"),
|
||||||
check_parser_with_typedef(TypeDef, "One(0)"),
|
check_parser_with_typedef(TypeDef, "One(0)", "variant([0, 1, 2], 1, 0)"),
|
||||||
check_parser_with_typedef(TypeDef, "Two(0, 1)"),
|
check_parser_with_typedef(TypeDef, "Two(0, 1)", "variant([0, 1, 2], 2, 0, 1)"),
|
||||||
check_parser_with_typedef(TypeDef, "Two([], [1, 2, 3])"),
|
check_parser_with_typedef(TypeDef, "Two([], [1, 2, 3])", "variant([0, 1, 2], 2, [], [1, 2, 3])"),
|
||||||
check_parser_with_typedef(TypeDef, "C.Zero"),
|
check_parser_with_typedef(TypeDef, "C.Zero", "variant([0, 1, 2], 0)"),
|
||||||
|
|
||||||
{error, {unresolved_variant, _, _, _}} = parse_literal(unknown_type(), "Zero"),
|
{error, {unresolved_variant, _, _, _}} = parse_literal(unknown_type(), "Zero"),
|
||||||
|
|
||||||
@@ -1300,10 +1501,10 @@ variant_test() ->
|
|||||||
|
|
||||||
ambiguous_variant_test() ->
|
ambiguous_variant_test() ->
|
||||||
TypeDef = "datatype mytype = C | D",
|
TypeDef = "datatype mytype = C | D",
|
||||||
check_parser_with_typedef(TypeDef, "C"),
|
check_parser_with_typedef(TypeDef, "C", "variant([0, 0], 0)"),
|
||||||
check_parser_with_typedef(TypeDef, "D"),
|
check_parser_with_typedef(TypeDef, "D", "variant([0, 0], 1)"),
|
||||||
check_parser_with_typedef(TypeDef, "C.C"),
|
check_parser_with_typedef(TypeDef, "C.C", "variant([0, 0], 0)"),
|
||||||
check_parser_with_typedef(TypeDef, "C.D"),
|
check_parser_with_typedef(TypeDef, "C.D", "variant([0, 0], 1)"),
|
||||||
|
|
||||||
ok.
|
ok.
|
||||||
|
|
||||||
@@ -1348,9 +1549,9 @@ bits_test() ->
|
|||||||
|
|
||||||
singleton_records_test() ->
|
singleton_records_test() ->
|
||||||
TypeDef = "record singleton('a) = {it: 'a}",
|
TypeDef = "record singleton('a) = {it: 'a}",
|
||||||
check_parser_with_typedef(TypeDef, "{it = 123}"),
|
check_parser_with_typedef(TypeDef, "{it = 123}", "123"),
|
||||||
check_parser_with_typedef(TypeDef, "{it = {it = {it = 5}}}"),
|
check_parser_with_typedef(TypeDef, "{it = {it = {it = 5}}}", "5"),
|
||||||
check_parser_with_typedef(TypeDef, "[{it = 1}, {it = 2}, {it = 3}]"),
|
check_parser_with_typedef(TypeDef, "[{it = 1}, {it = 2}, {it = 3}]", "[1, 2, 3]"),
|
||||||
|
|
||||||
ok.
|
ok.
|
||||||
|
|
||||||
@@ -1359,9 +1560,9 @@ singleton_variants_test() ->
|
|||||||
% actually a special case; singleton variants are in fact wrapped in the
|
% actually a special case; singleton variants are in fact wrapped in the
|
||||||
% FATE too.
|
% FATE too.
|
||||||
TypeDef = "datatype wrapped('a) = Wrap('a)",
|
TypeDef = "datatype wrapped('a) = Wrap('a)",
|
||||||
check_parser_with_typedef(TypeDef, "Wrap(123)"),
|
check_parser_with_typedef(TypeDef, "Wrap(123)", "variant([1], 0, 123)"),
|
||||||
check_parser_with_typedef(TypeDef, "Wrap(Wrap(123))"),
|
check_parser_with_typedef(TypeDef, "Wrap(Wrap(123))", "variant([1], 0, variant([1], 0, 123))"),
|
||||||
check_parser_with_typedef(TypeDef, "[Wrap(1), Wrap(2), Wrap(3)]"),
|
check_parser_with_typedef(TypeDef, "[Wrap(1), Wrap(2), Wrap(3)]", "[variant([1], 0, 1), variant([1], 0, 2), variant([1], 0, 3)]"),
|
||||||
|
|
||||||
ok.
|
ok.
|
||||||
|
|
||||||
|
|||||||
+1
-1
@@ -9,7 +9,7 @@
|
|||||||
%%% @end
|
%%% @end
|
||||||
|
|
||||||
-module(hz_sup).
|
-module(hz_sup).
|
||||||
-vsn("0.9.1").
|
-vsn("0.9.2").
|
||||||
-behaviour(supervisor).
|
-behaviour(supervisor).
|
||||||
-author("Craig Everett <zxq9@zxq9.com>").
|
-author("Craig Everett <zxq9@zxq9.com>").
|
||||||
-copyright("Craig Everett <zxq9@zxq9.com>").
|
-copyright("Craig Everett <zxq9@zxq9.com>").
|
||||||
|
|||||||
@@ -1,10 +1,10 @@
|
|||||||
{name,"Hakuzaru"}.
|
{name,"Hakuzaru"}.
|
||||||
{type,app}.
|
{type,app}.
|
||||||
{modules,[]}.
|
{modules,[]}.
|
||||||
{author,"Craig Everett"}.
|
|
||||||
{prefix,"hz"}.
|
{prefix,"hz"}.
|
||||||
|
{author,"Craig Everett"}.
|
||||||
{desc,"Gajumaru interoperation library"}.
|
{desc,"Gajumaru interoperation library"}.
|
||||||
{package_id,{"otpr","hakuzaru",{0,9,1}}}.
|
{package_id,{"otpr","hakuzaru",{0,9,2}}}.
|
||||||
{deps,[{"otpr","sophia",{9,0,0}},
|
{deps,[{"otpr","sophia",{9,0,0}},
|
||||||
{"otpr","gmserialization",{0,1,3}},
|
{"otpr","gmserialization",{0,1,3}},
|
||||||
{"otpr","gmbytecode",{3,4,1}},
|
{"otpr","gmbytecode",{3,4,1}},
|
||||||
|
|||||||
Reference in New Issue
Block a user