QPQ-AG/gmbytecode
10
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases 9 Wiki Activity

Pt 165173962 fuzz testing aefate #161

Merged
zxq9 merged 36 commits from PT-165173962-fuzz-testing-aefate into master 2019-06-04 01:37:50 +09:00
Conversation 4 Commits 36 Files Changed 12 +585 -93
12 changed files with 585 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
include/aeb_fate_data.hrl
View File

@ -53,6 +53,7 @@
-define(FATE_INTEGER_VALUE(X), (X)).
-define(FATE_BOOLEAN_VALUE(X), (X)).
-define(FATE_LIST_VALUE(X), (X)).
-define(FATE_TUPLE_ELEMENTS(X), (tuple_to_list(element(2, X)))).
-define(FATE_STRING_VALUE(X), (X)).
@ -63,6 +64,7 @@
-define(FATE_ORACLE_VALUE(X), (element(2, X))).
-define(FATE_NAME_VALUE(X), (element(2, X))).
-define(FATE_CHANNEL_VALUE(X), (element(2, X))).
-define(FATE_BITS_VALUE(X), (element(2, X))).
-define(FATE_MAP_VALUE(X), (X)).
-define(FATE_MAP_SIZE(X), (map_size(X))).
-define(FATE_STRING_SIZE(X), (byte_size(X))).

27
quickcheck/aeb_fate_code_tests.erl Normal file
View File

@ -0,0 +1,27 @@
%%% @author Thomas Arts
%%% @doc Allow to run QuickCheck tests as eunit tests
%%% `rebar3 as eqc eunit --cover`
%%% or `rebar3 as eqc eunit --module=aeb_fate_code`
%%% Note that for obtainign cover file, one needs `rebar3 as eqc cover
%%%
%%%
%%% @end
%%% Created : 13 Dec 2018 by Thomas Arts <thomas@SpaceGrey.lan>
-module(aeb_fate_code_tests).
-include_lib("eunit/include/eunit.hrl").
-compile([export_all, nowarn_export_all]).
-define(EQC_EUNIT(Module, PropName, Ms),
{ atom_to_list(PropName),
{timeout, (Ms * 10) div 1000, ?_assert(eqc:quickcheck(eqc:testing_time(Ms / 1000, Module:PropName())))}}).
quickcheck_test_() ->
{setup, fun() -> eqc:start() end,
[ ?EQC_EUNIT(aefate_code_eqc, prop_opcodes, 200),
?EQC_EUNIT(aefate_code_eqc, prop_serializes, 3000),
?EQC_EUNIT(aefate_code_eqc, prop_fail_serializes, 3000),
?EQC_EUNIT(aefate_code_eqc, prop_fuzz, 3000)
]}.

4
quickcheck/aeb_fate_data_tests.erl
View File

@ -21,5 +21,7 @@
quickcheck_test_() ->
{setup, fun() -> eqc:start() end,
[ ?EQC_EUNIT(aefate_eqc, prop_roundtrip, 500),
?EQC_EUNIT(aefate_eqc, prop_format_scan, 2000)
?EQC_EUNIT(aefate_eqc, prop_format_scan, 2000),
?EQC_EUNIT(aefate_eqc, prop_order, 2000),
?EQC_EUNIT(aefate_eqc, prop_fuzz, 2000)
]}.

3
quickcheck/aeb_fate_encoding_tests.erl
View File

@ -21,5 +21,6 @@
quickcheck_test_() ->
{setup, fun() -> eqc:start() end,
[ ?EQC_EUNIT(aefate_type_eqc, prop_roundtrip, 1000),
?EQC_EUNIT(aefate_eqc, prop_serializes, 1000)
?EQC_EUNIT(aefate_eqc, prop_serializes, 1000),
?EQC_EUNIT(aefate_eqc, prop_idempotent, 1000)
]}.

133
quickcheck/aefate_code_eqc.erl Normal file
View File

@ -0,0 +1,133 @@
%%% @author Thomas Arts
%%% @doc Use `rebar3 as eqc shell` to run properties in the shell
%%%
%%% We want to be sure that we can deserialize all FATE assembler that is accepted on chain.
%%%
%%% We test something slightly weaker here,
%%% viz. All FATE assembler we serialize, we can deserialize
%%%
%%% Negative testing modelled:
%%% Failure 1: function names differ from 4 bytes
%%% Failure 2: pointer to empty code block
%%% Failure 3: end_BB operation as not ending block or not at end of block
%%% - empty code blocks
%%% - blocks that are not of the form (not end_bb)* end_bb.
%%%
%%% @end
%%% Created : 13 Dec 2018 by Thomas Arts <thomas@SpaceGrey.lan>
-module(aefate_code_eqc).
-include_lib("eqc/include/eqc.hrl").
-compile([export_all, nowarn_export_all]).
%%-define(Failure(Failures, Number), case lists:member(Number, Failures) of true -> 1; false -> 0 end)
prop_serializes() ->
in_parallel(
?FORALL(FateCode, fate_code(0),
?WHENFAIL(eqc:format("Trying to serialize/deserialize ~p failed~n", [FateCode]),
begin
Binary = aeb_fate_code:serialize(FateCode),
?WHENFAIL(eqc:format("serialized: ~p~n", [Binary]),
begin
Decoded = aeb_fate_code:deserialize(Binary),
measure(binary_size, size(Binary),
equals(Decoded, FateCode))
end)
end))).
prop_fail_serializes() ->
conjunction([{Failure, eqc:counterexample(
?FORALL(FateCode, fate_code(Failure),
?FORALL(Binary, catch aeb_fate_code:serialize(FateCode),
is_binary(aeb_fate_code:serialize(FateCode)))))
=/= true} || Failure <- [1,2,3,4, 5] ]).
prop_fuzz() ->
in_parallel(
?FORALL(Binary, ?LET(FateCode, fate_code(0), aeb_fate_code:serialize(FateCode)),
?FORALL(InjectedBin, injection(Binary),
try Org = aeb_fate_code:deserialize(InjectedBin),
NewBin = aeb_fate_code:serialize(Org),
NewOrg = aeb_fate_code:deserialize(NewBin),
?WHENFAIL(eqc:format("Deserialize ~p gives\n~p\nSerializes to ~p\n", [InjectedBin, Org, NewOrg]),
equals(NewBin, InjectedBin))
catch _:_ ->
true
end))).
prop_opcodes() ->
?FORALL(Opcode, choose(0, 16#ff),
try M = aeb_fate_opcodes:mnemonic(Opcode),
?WHENFAIL(eqc:format("opcode ~p -> ~p", [Opcode, M]),
conjunction([{valid, lists:member(Opcode, valid_opcodes())},
{eq, equals(aeb_fate_opcodes:m_to_op(M), Opcode)}]))
catch
_:_ ->
not lists:member(Opcode, valid_opcodes())
end).
valid_opcodes() ->
lists:seq(0, 16#72) ++ lists:seq(16#fa, 16#fd).
fate_code(Failure) ->
?SIZED(Size,
?LET({FMap, SMap, AMap},
{non_empty(map(if Failure == 1 -> binary(1);
true -> binary(4) end,
{{list(aefate_type_eqc:fate_type(Size div 3)), aefate_type_eqc:fate_type(Size div 3)}, bbs_code(Failure)})),
map(small_fate_data_key(5), small_fate_data(4)),
map(small_fate_data_key(5), small_fate_data(4))},
aeb_fate_code:update_annotations(
aeb_fate_code:update_symbols(
aeb_fate_code:update_functions(
aeb_fate_code:new(), FMap), SMap), AMap))).
bbs_code(Failure) ->
frequency([{if Failure == 2 -> 5; true -> 0 end, #{0 => []}},
{10, ?LET(BBs, list(bb_code(Failure)),
maps:from_list(
lists:zip(lists:seq(0, length(BBs)-1), BBs)))}]).
bb_code(Failure) ->
EndBB = [ Op || Op <- valid_opcodes(), aeb_fate_opcodes:end_bb(Op) ],
NonEndBB = valid_opcodes() -- EndBB,
frequency(
[{if Failure == 3 -> 5; true -> 0 end, ?LET(Ops, non_empty(list(elements(NonEndBB))), bblock(Failure, Ops))},
{if Failure == 4 -> 5; true -> 0 end, ?LET({Ops, Op}, {list(elements(valid_opcodes())), elements(EndBB)}, bblock(Failure, Ops ++ [Op]))},
{10, ?LET({Ops, Op}, {list(elements(NonEndBB)), elements(EndBB)},
bblock(Failure, Ops ++ [Op]))}]).
bblock(Failure, Ops) ->
[ begin
Mnemonic = aeb_fate_opcodes:mnemonic(Op),
Arity = aeb_fate_opcodes:args(Op),
case Arity of
0 -> Mnemonic;
_ -> list_to_tuple([Mnemonic |
[ frequency([{if Failure == 5 -> 5; true -> 0 end, {stack, nat()}},
{5, {stack, 0}},
{5, {arg, nat()}},
{5, {var, nat()}},
{5, {immediate, small_fate_data(4)}}]) ||
_ <- lists:seq(1, Arity) ]])
end
end || Op <- Ops ].
injection(Binary) ->
?LET({N, Inj}, {choose(0, byte_size(Binary) - 1), choose(0,255)},
begin
M = N * 8,
<<X:M, _:8, Z/binary>> = Binary,
<<X:M, Inj:8, Z/binary>>
end).
small_fate_data(N) ->
?SIZED(Size, resize(Size div N, aefate_eqc:fate_data())).
small_fate_data_key(N) ->
?SIZED(Size, ?LET(Data, aefate_eqc:fate_data(Size div N, []), eqc_symbolic:eval(Data))).

69
quickcheck/aefate_eqc.erl
View File

@ -49,8 +49,56 @@ prop_serializes() ->
{size, size(Binary) < 500000}]))))
end)).
prop_fuzz() ->
in_parallel(
?FORALL(Binary, ?LET(FateData, ?SIZED(Size, resize(Size div 4, fate_data())), aeb_fate_encoding:serialize(FateData)),
?FORALL(InjectedBin, injection(Binary),
try Org = aeb_fate_encoding:deserialize(InjectedBin),
NewBin = aeb_fate_encoding:serialize(Org),
NewOrg = aeb_fate_encoding:deserialize(NewBin),
measure(success, 1,
?WHENFAIL(eqc:format("Deserialize ~p gives\n~p\nSerializes to ~p\n", [InjectedBin, Org, NewOrg]),
equals(NewBin, InjectedBin)))
catch _:_ ->
true
end))).
prop_order() ->
?FORALL(Items, vector(3, fate_data()),
begin
%% Use lt to take minimum
Min = lt_min(Items),
Max = lt_max(Items),
conjunction([ {minimum, is_empty([ {Min, '>', I} || I<-Items, aeb_fate_data:lt(I, Min)])},
{maximum, is_empty([ {Max, '<', I} || I<-Items, aeb_fate_data:lt(Max, I)])}])
end).
lt_min([X, Y | Rest]) ->
case aeb_fate_data:lt(X, Y) of
true -> lt_min([X | Rest]);
false -> lt_min([Y| Rest])
end;
lt_min([X]) -> X.
lt_max([X, Y | Rest]) ->
case aeb_fate_data:lt(X, Y) of
true -> lt_max([Y | Rest]);
false -> lt_max([X| Rest])
end;
lt_max([X]) -> X.
prop_idempotent() ->
?FORALL(Items, list({fate_data_key(), fate_data()}),
equals(aeb_fate_encoding:sort(Items),
aeb_fate_encoding:sort(aeb_fate_encoding:sort(Items)))).
fate_data() ->
?SIZED(Size, ?LET(Data, fate_data(Size, [map]), eqc_symbolic:eval(Data))).
?SIZED(Size, ?LET(Data, fate_data(Size, [map, variant]), eqc_symbolic:eval(Data))).
fate_data_key() ->
?SIZED(Size, ?LET(Data, fate_data(Size div 4, []), eqc_symbolic:eval(Data))).
fate_data(0, _Options) ->
?LAZY(
@ -70,10 +118,12 @@ fate_data(0, _Options) ->
fate_data(Size, Options) ->
oneof([?LAZY(fate_data(Size - 1, Options)),
?LAZY(fate_list( fate_data(Size div 5, Options) )),
?LAZY(fate_tuple( list(fate_data(Size div 5, Options)) )),
?LAZY(fate_variant( list(fate_data(Size div 5, Options)))) ] ++
?LAZY(fate_tuple( list(fate_data(Size div 5, Options)) ))] ++
[?LAZY(fate_variant( list(fate_data(Size div 5, Options))))
|| lists:member(variant, Options)
] ++
[
?LAZY(fate_map( fate_data(Size div 8, Options -- [map]),
?LAZY(fate_map( fate_data(Size div 8, Options -- [map, variant]),
fate_data(Size div 5, Options)))
|| lists:member(map, Options)
]).
@ -120,3 +170,14 @@ non_quote_string() ->
char() ->
choose(1, 255).
injection(Binary) ->
?LET({N, Inj}, {choose(0, byte_size(Binary) - 1), choose(0,255)},
begin
M = N * 8,
<<X:M, _:8, Z/binary>> = Binary,
<<X:M, Inj:8, Z/binary>>
end).
is_empty(L) ->
?WHENFAIL(eqc:format("~p\n", [L]), L == []).

2
rebar.config
View File

@ -53,7 +53,7 @@
"/njs /njh /nfl /ndl & exit /b 0"} % silence things
]}
]},
{eqc, [{erl_opts, [{parse_transform, eqc_cover}]},
{eqc, [{erl_opts, [{parse_transform, eqc_cover}, {d, 'EQC'}]},
{extra_src_dirs, ["quickcheck"]} %% May not be called eqc!
]}
]}.

102
src/aeb_fate_code.erl
View File

@ -26,6 +26,11 @@
-include("../include/aeb_fate_opcodes.hrl").
-include("../include/aeb_fate_data.hrl").
-ifdef(EQC).
-export([update_annotations/2
, update_functions/2
, update_symbols/2]).
-endif.
-record(fcode, { functions = #{} :: map()
, symbols = #{} :: map()
@ -50,14 +55,23 @@ functions(#fcode{ functions = Fs }) ->
symbols(#fcode{ symbols = Ss}) ->
Ss.
update_annotations(#fcode{ annotations = As } = FCode, Anns) ->
FCode#fcode{ annotations = maps:merge(As, Anns) }.
update_functions(#fcode{ functions = Fs } = FCode, Funs) ->
FCode#fcode{ functions = maps:merge(Fs, Funs) }.
update_symbols(#fcode{ symbols = Ss } = FCode, Symbs) ->
FCode#fcode{ symbols = maps:merge(Ss, Symbs) }.
symbol_identifier(Bin) ->
%% First 4 bytes of blake hash
{ok, <<X:4/binary,_/binary>> } = eblake2:blake2b(?HASH_BYTES, Bin),
X.
insert_fun(Name, {ArgType, RetType}, #{} = BBs, #fcode{ functions = Funs } = F) ->
{F1, ID} = insert_symbol(Name, F),
F1#fcode{ functions = Funs#{ ID => {{ArgType, RetType}, BBs}} }.
insert_fun(Name, {ArgType, RetType}, #{} = BBs, FCode) ->
{F1, ID} = insert_symbol(Name, FCode),
update_functions(F1, #{ID => {{ArgType, RetType}, BBs}}).
insert_symbol(Name, #fcode{ symbols = Syms } = F) ->
ID = symbol_identifier(Name),
@ -67,13 +81,13 @@ insert_symbol(Name, #fcode{ symbols = Syms } = F) ->
{ok, X} ->
error({two_symbols_with_same_hash, Name, X});
error ->
{F#fcode{symbols = Syms#{ ID => Name}}, ID}
{update_symbols(F, #{ID => Name}), ID}
end.
insert_annotation(comment =_Type, Line, Comment, #fcode{ annotations = Anns} = F) ->
insert_annotation(comment =_Type, Line, Comment, FCode) ->
Key = aeb_fate_data:make_tuple({aeb_fate_data:make_string("comment"), Line}),
Value = aeb_fate_data:make_string(Comment),
F#fcode{ annotations = Anns#{ Key => Value}}.
update_annotations(FCode, #{ Key => Value }).
%%%===================================================================
%%% Serialization
@ -83,7 +97,7 @@ serialize(#fcode{} = F) ->
serialize(F, []).
serialize(#fcode{} = F, Options) ->
serialize(F, iolist_to_binary(serialize_functions(F)), Options).
serialize(F, serialize_functions(F), Options).
serialize(#fcode{} = F, Functions, Options) ->
SymbolTable = serialize_symbol_table(F),
@ -109,9 +123,12 @@ to_hexstring(ByteList) ->
serialize_functions(#fcode{ functions = Functions }) ->
%% Sort the functions on name to get a canonical serialisation.
Code = [[?FUNCTION, Name, serialize_signature(Sig), serialize_bbs(C)] ||
{Name, {Sig, C}} <- lists:sort(maps:to_list(Functions))],
lists:flatten(Code).
iolist_to_binary(
lists:foldr(fun({Id, {Sig, C}}, Acc) when byte_size(Id) == 4 ->
[[?FUNCTION, Id, serialize_signature(Sig), serialize_bbs(C)] | Acc];
({Id, _}, _) ->
error({illegal_function_id, Id})
end, [], lists:sort(maps:to_list(Functions)))).
serialize_signature({Args, RetType}) ->
[aeb_fate_encoding:serialize_type({tuple, Args}) |
@ -137,20 +154,39 @@ serialize_bbs(BBs, N, Acc) ->
false ->
error({not_contiguous_labels, lists:sort(maps:keys(BBs))})
end;
[] ->
error({empty_code_block, N});
BB ->
serialize_bbs(BBs, N + 1, [serialize_bb(BB, [])|Acc])
end.
serialize_bb([Op], Acc) ->
lists:reverse([serialize_op(true, Op)|Acc]);
serialize_bb([Op|Rest], Acc) ->
serialize_bb(Rest, [serialize_op(Op)|Acc]);
serialize_bb([], Acc) ->
lists:reverse(Acc).
serialize_bb(Rest, [serialize_op(false, Op)|Acc]).
%% serialize_bb([], Acc) ->
%% lists:reverse(Acc).
serialize_op(Kind, Op) ->
[Mnemonic|Args] =
case is_tuple(Op) of
true -> tuple_to_list(Op);
false -> [Op]
end,
safe_serialize(Kind, aeb_fate_opcodes:m_to_op(Mnemonic), Args).
safe_serialize(Last, Op, Args) ->
case length(Args) == aeb_fate_opcodes:args(Op) of
true ->
case Last == aeb_fate_opcodes:end_bb(Op) of
true -> [Op|serialize_code(Args)];
false ->
error({wrong_opcode_in_bb, Op})
end;
false ->
error({wrong_nr_args_opcode, Op})
end.
serialize_op(Op) when is_tuple(Op) ->
[Opcode|Args] = tuple_to_list(Op),
[aeb_fate_opcodes:m_to_op(Opcode)|serialize_code(Args)];
serialize_op(Opcode) ->
[aeb_fate_opcodes:m_to_op(Opcode)].
%% Argument encoding
%% Argument Specification Byte
@ -171,7 +207,7 @@ serialize_code([{_,_}|_] = List ) ->
%% Take out the full argument list.
{Args, Rest} = lists:splitwith(fun({_, _}) -> true; (_) -> false end, List),
%% Create the appropriate number of modifier bytes.
Mods = << <<(modifier_bits(Type)):2>> || {Type, _} <- pad_args(lists:reverse(Args)) >>,
Mods = << <<(modifier_bits(Type, X)):2>> || {Type, X} <- pad_args(lists:reverse(Args)) >>,
case Mods of
<<M1:8, M2:8>> ->
[M1, M2 | [serialize_data(Type, Arg) || {Type, Arg} <- Args, Type =/= stack]] ++
@ -201,10 +237,11 @@ serialize_data(_, Data) ->
%% 01 : argN
%% 10 : varN
%% 11 : immediate
modifier_bits(immediate) -> 2#11;
modifier_bits(var) -> 2#10;
modifier_bits(arg) -> 2#01;
modifier_bits(stack) -> 2#00.
modifier_bits(immediate, _) -> 2#11;
modifier_bits(var, _) -> 2#10;
modifier_bits(arg, _) -> 2#01;
modifier_bits(stack, 0) -> 2#00;
modifier_bits(Type, X) -> error({illegal_argument, Type, X}).
bits_to_modifier(2#11) -> immediate;
bits_to_modifier(2#10) -> var;
@ -265,6 +302,9 @@ deserialize_functions(<<?FUNCTION:8, A, B, C, D, Rest/binary>>,
Program#{ BB => lists:reverse(Code)}}}},
deserialize_functions(Rest2, Env2)
end;
deserialize_functions(<<_Op:8, _Rest/binary>>,
#{ function := none }) ->
error({code_without_function});
deserialize_functions(<<Op:8, Rest/binary>>,
#{ bb := BB
, current_bb_code := Code
@ -279,6 +319,9 @@ deserialize_functions(<<Op:8, Rest/binary>>,
false ->
deserialize_functions(Rest2, Env#{ current_bb_code => OpCode})
end;
deserialize_functions(<<>>, #{ function := none
, functions := Funs}) ->
Funs;
deserialize_functions(<<>>, #{ function := {F, Sig}
, bb := BB
, current_bb_code := Code
@ -302,7 +345,8 @@ deserialize_op(Op, Rest, Code) ->
end.
deserialize_n_args(N, <<M3:2, M2:2, M1:2, M0:2, Rest/binary>>) when N =< 4 ->
ArgMods = lists:sublist([M0, M1, M2, M3], N),
{ArgMods, Zeros} = lists:split(N, [M0, M1, M2, M3]),
assert_zero(Zeros),
lists:mapfoldl(fun(M, Acc) ->
case bits_to_modifier(M) of
stack ->
@ -314,7 +358,8 @@ deserialize_n_args(N, <<M3:2, M2:2, M1:2, M0:2, Rest/binary>>) when N =< 4 ->
end, Rest, ArgMods);
deserialize_n_args(N, <<M7:2, M6:2, M5:2, M4:2, M3:2, M2:2, M1:2, M0:2,
Rest/binary>>) when N =< 8 ->
ArgMods = lists:sublist([M0, M1, M2, M3, M4, M5, M6, M7], N),
{ArgMods, Zeros} = lists:split(N, [M0, M1, M2, M3, M4, M5, M6, M7]),
assert_zero(Zeros),
lists:mapfoldl(fun(M, Acc) ->
case bits_to_modifier(M) of
stack ->
@ -337,3 +382,10 @@ deserialize_symbols(Table) ->
deserialize_annotations(AnnotationsBin) ->
?FATE_MAP_VALUE(Annotations) = aeb_fate_encoding:deserialize(AnnotationsBin),
Annotations.
assert_zero([]) ->
true;
assert_zero([0|Rest]) ->
assert_zero(Rest);
assert_zero([_|_]) ->
error(argument_defined_outside_range).

154
src/aeb_fate_data.erl
View File

@ -96,7 +96,11 @@
, make_bits/1
, make_unit/0
]).
-export([format/1]).
-export([
elt/2
, lt/2
, format/1
, ordinal/1]).
make_boolean(true) -> ?FATE_TRUE;
@ -193,3 +197,151 @@ format_list(List) ->
format_kvs(List) ->
lists:join(", ", [ [format(K), " => ", format(V)] || {K, V} <- List]).
%% Total order of FATE terms.
%% Integers < Booleans < Address < Channel < Contract < Name < Oracle
%% < Hash < Signature < Bits < String < Tuple < Map < List < Variant
-spec ordinal(fate_type()) -> integer().
ordinal(T) when ?IS_FATE_INTEGER(T) -> 0;
ordinal(T) when ?IS_FATE_BOOLEAN(T) -> 1;
ordinal(T) when ?IS_FATE_ADDRESS(T) -> 2;
ordinal(T) when ?IS_FATE_CHANNEL(T) -> 3;
ordinal(T) when ?IS_FATE_CONTRACT(T) -> 4;
ordinal(T) when ?IS_FATE_NAME(T) -> 5;
ordinal(T) when ?IS_FATE_ORACLE(T) -> 6;
ordinal(T) when ?IS_FATE_HASH(T) -> 7;
ordinal(T) when ?IS_FATE_SIGNATURE(T) -> 8;
ordinal(T) when ?IS_FATE_BITS(T) -> 9;
ordinal(T) when ?IS_FATE_STRING(T) -> 10;
ordinal(T) when ?IS_FATE_TUPLE(T) -> 11;
ordinal(T) when ?IS_FATE_MAP(T) -> 12;
ordinal(T) when ?IS_FATE_LIST(T) -> 13;
ordinal(T) when ?IS_FATE_VARIANT(T) -> 14.
-spec lt(fate_type(), fate_type()) -> boolean().
lt(A, B) ->
O1 = ordinal(A),
O2 = ordinal(B),
if O1 == O2 -> lt(O1, A, B);
true -> O1 < O2
end.
%% Integers are ordered as usual.
lt(0, A, B) when ?IS_FATE_INTEGER(A), ?IS_FATE_INTEGER(B) ->
?FATE_INTEGER_VALUE(A) < ?FATE_INTEGER_VALUE(B);
%% false is smaller than true (true also for erlang booleans).
lt(1, A, B) when ?IS_FATE_BOOLEAN(A), ?IS_FATE_BOOLEAN(B) ->
?FATE_BOOLEAN_VALUE(A) < ?FATE_BOOLEAN_VALUE(B);
lt(9, A, B) when ?IS_FATE_BITS(A), ?IS_FATE_BITS(B) ->
BitsA = ?FATE_BITS_VALUE(A),
BitsB = ?FATE_BITS_VALUE(B),
if BitsA < 0 ->
if BitsB < 0 -> BitsA < BitsB;
true -> false
end;
BitsB < 0 ->
true;
true -> BitsA < BitsB
end;
lt(10,?FATE_STRING(A), ?FATE_STRING(B)) ->
SizeA = size(A),
SizeB = size(B),
case SizeA - SizeB of
0 -> A < B;
N -> N < 0
end;
lt(11,?FATE_TUPLE(A), ?FATE_TUPLE(B)) ->
SizeA = size(A),
SizeB = size(B),
case SizeA - SizeB of
0 -> tuple_elements_lt(0, A, B, SizeA);
N -> N < 0
end;
lt(12, ?FATE_MAP_VALUE(A), ?FATE_MAP_VALUE(B)) ->
SizeA = maps:size(A),
SizeB = maps:size(B),
case SizeA - SizeB of
0 -> maps_lt(A, B);
N -> N < 0
end;
lt(13, ?FATE_LIST_VALUE(_), ?FATE_LIST_VALUE([])) -> false;
lt(13, ?FATE_LIST_VALUE([]), ?FATE_LIST_VALUE(_)) -> true;
lt(13, ?FATE_LIST_VALUE([A|RA]), ?FATE_LIST_VALUE([B|RB])) ->
O1 = ordinal(A),
O2 = ordinal(B),
if O1 == O2 ->
if A == B -> lt(RA, RB);
true -> A < B
end;
true -> O1 < O2
end;
lt(14, ?FATE_VARIANT(AritiesA, TagA, TA),
?FATE_VARIANT(AritiesB, TagB, TB)) ->
if length(AritiesA) < length(AritiesB) -> true;
length(AritiesA) > length(AritiesB) -> false;
true ->
if AritiesA < AritiesB -> true;
AritiesA > AritiesB -> false;
true ->
if TagA < TagB -> true;
TagA > TagB -> false;
true -> lt(make_tuple(TA), make_tuple(TB))
end
end
end;
lt(_, A, B) -> A < B.
tuple_elements_lt(N,_A,_B, N) ->
false;
tuple_elements_lt(N, A, B, Size) ->
E = N + 1,
EA = element(E, A),
EB = element(E, B),
if EA =:= EB -> tuple_elements_lt(E, A, B, Size);
true -> lt(EA, EB)
end.
maps_lt(A, B) ->
IA = maps_iterator(A),
IB = maps_iterator(B),
maps_i_lt(IA, IB).
maps_i_lt(IA, IB) ->
case {maps_next(IA), maps_next(IB)} of
{none, none} -> false;
{_, none} -> false;
{none, _} -> true;
{{KA1, VA1, IA2}, {KB1, VB1, IB2}} ->
case lt(KA1, KB1) of
true -> true;
false ->
case lt(KB1, KA1) of
true -> false;
false ->
case lt(VA1, VB1) of
true -> true;
false ->
case lt(VB1, VA1) of
true -> false;
false ->
maps_i_lt(IA2, IB2)
end
end
end
end
end.
maps_iterator(M) -> lists:sort(fun ({K1,_}, {K2,_}) -> lt(K1, K2) end, maps:to_list(M)).
maps_next([]) -> none;
maps_next([{K,V}|Rest]) -> {K, V, Rest}.
-spec elt(fate_type(), fate_type()) -> boolean().
elt(A, A) -> true;
elt(A, B) ->
R = lt(A, B),
R.

160
src/aeb_fate_encoding.erl
View File

@ -1,21 +1,29 @@
%% Fate data (and instruction) serialization.
%%
%% Assuming
%% S is seralize/1 (fate_type() -> binary())
%% D is deserialize/1 (binary) -> fate_type())
%% V, V1, V2 are of the type fate_type()
%% B is of the type binary()
%% Then
%% The FATE serialization has to fullfill the following properties:
%% * There has to be 1 and only 1 byte sequence
%% representing each unique value in FATE.
%% * For each value (V) in FATE there has to be a bytecode sequence (B)
%% representing that value.
%% * A valid byte sequence has to be deserializable to a FATE value.
%% * A valid byte sequence must not contain any trailing bytes.
%% * A serialization is a sequence of 8-bit bytes.
%%
%% The serialization function should fullfill the following:
%% The serialization function (S) should fullfill the following:
%% * A valid FATE value should be serialized to a byte sequence.
%% * Any other argument, not representing a valid FATE value should
%% throw an exception
%%
%% The deserialization function should fullfill the following:
%% The deserialization function (D) should fullfill the following:
%% * A valid byte sequence should be deserialized to a valid FATE value.
%% * Any other argument, not representing a valid byte sequence should
%% throw an exception
%% The following equalities should hold:
%% * D(S(V)) == V
%% * if V1 == V2 then S(V1) == S(V2)
%%
%%
%% History
%% * First draft of FATE serialization encoding/decoding.
@ -40,6 +48,10 @@
, serialize_type/1
]).
-ifdef(EQC).
-export([sort/1]).
-endif.
-include("aeb_fate_data.hrl").
%% Definition of tag scheme.
@ -81,7 +93,6 @@
%% %% 1000 1111 - FREE (Possibly for bytecode in the future.)
-define(OBJECT , 2#10011111). %% 1001 1111 | ObjectType | RLP encoded Array
-define(VARIANT , 2#10101111). %% 1010 1111 | [encoded arities] | encoded tag | [encoded values]
-define(NIL , 2#10111111). %% 1011 1111 - Empty list
-define(NEG_BITS , 2#11001111). %% 1100 1111 | RLP encoded integer (infinite 1:s bitfield)
-define(EMPTY_MAP , 2#11011111). %% 1101 1111
-define(NEG_BIG_INT , 2#11101111). %% 1110 1111 | RLP encoded (integer - 64)
@ -112,9 +123,7 @@
-spec serialize(aeb_fate_data:fate_type()) -> binary().
serialize(?FATE_TRUE) -> <<?TRUE>>;
serialize(?FATE_FALSE) -> <<?FALSE>>;
serialize(?FATE_NIL) -> <<?NIL>>; %% ! Untyped
serialize(?FATE_UNIT) -> <<?EMPTY_TUPLE>>; %% ! Untyped
serialize(M) when ?IS_FATE_MAP(M), ?FATE_MAP_SIZE(M) =:= 0 -> <<?EMPTY_MAP>>; %% ! Untyped
serialize(?FATE_EMPTY_STRING) -> <<?EMPTY_STRING>>;
serialize(I) when ?IS_FATE_INTEGER(I) -> serialize_integer(I);
serialize(?FATE_BITS(Bits)) when is_integer(Bits) -> serialize_bits(Bits);
@ -128,7 +137,9 @@ serialize(String) when ?IS_FATE_STRING(String),
?FATE_STRING_SIZE(String) > 0,
?FATE_STRING_SIZE(String) >= ?SHORT_STRING_SIZE ->
Bytes = ?FATE_STRING_VALUE(String),
<<?LONG_STRING, (aeser_rlp:encode(Bytes))/binary>>;
<<?LONG_STRING,
(serialize_integer(?FATE_STRING_SIZE(String) - ?SHORT_STRING_SIZE))/binary
, Bytes/binary>>;
serialize(?FATE_ADDRESS(Address)) when is_binary(Address) ->
<<?OBJECT, ?OTYPE_ADDRESS, (aeser_rlp:encode(Address))/binary>>;
serialize(?FATE_HASH(Address)) when is_binary(Address) ->
@ -150,27 +161,28 @@ serialize(?FATE_TUPLE(T)) when size(T) > 0 ->
if S < ?SHORT_TUPLE_SIZE ->
<<S:4, ?SHORT_TUPLE:4, Rest/binary>>;
true ->
Size = rlp_integer(S - ?SHORT_TUPLE_SIZE),
Size = rlp_encode_int(S - ?SHORT_TUPLE_SIZE),
<<?LONG_TUPLE:8, Size/binary, Rest/binary>>
end;
serialize(L) when ?IS_FATE_LIST(L) ->
[_E|_] = List = ?FATE_LIST_VALUE(L),
List = ?FATE_LIST_VALUE(L),
S = length(List),
Rest = << <<(serialize(El))/binary>> || El <- List >>,
if S < ?SHORT_LIST_SIZE ->
<<S:4, ?SHORT_LIST:4, Rest/binary>>;
true ->
Val = rlp_integer(S - ?SHORT_LIST_SIZE),
Val = rlp_encode_int(S - ?SHORT_LIST_SIZE),
<<?LONG_LIST, Val/binary, Rest/binary>>
end;
serialize(Map) when ?IS_FATE_MAP(Map) ->
L = [{_K,_V}|_] = lists:sort(maps:to_list(?FATE_MAP_VALUE(Map))),
L = maps:to_list(?FATE_MAP_VALUE(Map)),
Size = length(L),
%% TODO: check all K same type, and all V same type
%% check K =/= map
Elements = << <<(serialize(K1))/binary, (serialize(V1))/binary>> || {K1,V1} <- L >>,
Elements =
list_to_binary([ <<(serialize(K))/binary, (serialize(V))/binary>> || {K, V} <- sort_and_check(L) ]),
<<?MAP,
(rlp_integer(Size))/binary,
(rlp_encode_int(Size))/binary,
(Elements)/binary>>;
serialize(?FATE_VARIANT(Arities, Tag, Values)) ->
Arities = [A || A <- Arities, is_integer(A), A < 256],
@ -267,9 +279,23 @@ deserialize_types(N, Binary, Acc) ->
%% -----------------------------------------------------
rlp_integer(S) when S >= 0 ->
rlp_encode_int(S) when S >= 0 ->
aeser_rlp:encode(binary:encode_unsigned(S)).
%% first byte of the binary gives the number of bytes we need <<129>> is 1, <<130>> = 2,
%% so <<129, 0>> is <<0>> and <<130, 0, 0>> is <<0, 0>>
rlp_decode_int(Binary) ->
{Bin1, Rest} = aeser_rlp:decode_one(Binary),
Int = binary:decode_unsigned(Bin1),
ReEncode = rlp_encode_int(Int),
case <<ReEncode/binary, Rest/binary>> == Binary of
true ->
{Int, Rest};
false ->
error({none_unique_encoding, Bin1, ReEncode})
end.
serialize_integer(I) when ?IS_FATE_INTEGER(I) ->
V = ?FATE_INTEGER_VALUE(I),
Abs = abs(V),
@ -279,20 +305,16 @@ serialize_integer(I) when ?IS_FATE_INTEGER(I) ->
end,
if Abs < ?SMALL_INT_SIZE -> <<Sign:1, Abs:6, ?SMALL_INT:1>>;
Sign =:= ?NEG_SIGN -> <<?NEG_BIG_INT,
(rlp_integer(Abs - ?SMALL_INT_SIZE))/binary>>;
(rlp_encode_int(Abs - ?SMALL_INT_SIZE))/binary>>;
Sign =:= ?POS_SIGN -> <<?POS_BIG_INT,
(rlp_integer(Abs - ?SMALL_INT_SIZE))/binary>>
(rlp_encode_int(Abs - ?SMALL_INT_SIZE))/binary>>
end.
serialize_bits(B) when is_integer(B) ->
Abs = abs(B),
Sign = case B < 0 of
true -> ?NEG_SIGN;
false -> ?POS_SIGN
end,
if
Sign =:= ?NEG_SIGN -> <<?NEG_BITS, (rlp_integer(Abs))/binary>>;
Sign =:= ?POS_SIGN -> <<?POS_BITS, (rlp_integer(Abs))/binary>>
B < 0 -> <<?NEG_BITS, (rlp_encode_int(Abs))/binary>>;
B >= 0 -> <<?POS_BITS, (rlp_encode_int(Abs))/binary>>
end.
-spec deserialize(binary()) -> aeb_fate_data:fate_type().
@ -305,24 +327,33 @@ deserialize_one(B) -> deserialize2(B).
deserialize2(<<?POS_SIGN:1, I:6, ?SMALL_INT:1, Rest/binary>>) ->
{?MAKE_FATE_INTEGER(I), Rest};
deserialize2(<<?NEG_SIGN:1, I:6, ?SMALL_INT:1, Rest/binary>>) ->
{?MAKE_FATE_INTEGER(-I), Rest};
if I =/= 0 -> {?MAKE_FATE_INTEGER(-I), Rest};
I == 0 -> error({illegal_sign, I})
end;
deserialize2(<<?NEG_BIG_INT, Rest/binary>>) ->
{Bint, Rest2} = aeser_rlp:decode_one(Rest),
{?MAKE_FATE_INTEGER(-binary:decode_unsigned(Bint) - ?SMALL_INT_SIZE),
{Bint, Rest2} = rlp_decode_int(Rest),
{?MAKE_FATE_INTEGER(-Bint - ?SMALL_INT_SIZE),
Rest2};
deserialize2(<<?POS_BIG_INT, Rest/binary>>) ->
{Bint, Rest2} = aeser_rlp:decode_one(Rest),
{?MAKE_FATE_INTEGER(binary:decode_unsigned(Bint) + ?SMALL_INT_SIZE),
{Bint, Rest2} = rlp_decode_int(Rest),
{?MAKE_FATE_INTEGER(Bint + ?SMALL_INT_SIZE),
Rest2};
deserialize2(<<?NEG_BITS, Rest/binary>>) ->
{Bint, Rest2} = aeser_rlp:decode_one(Rest),
{?FATE_BITS(-binary:decode_unsigned(Bint)), Rest2};
case rlp_decode_int(Rest) of
{Pos, Rest2} when Pos > 0 ->
{?FATE_BITS(-Pos), Rest2};
{N, _} ->
error({illegal_parameter, neg_bits, N})
end;
deserialize2(<<?POS_BITS, Rest/binary>>) ->
{Bint, Rest2} = aeser_rlp:decode_one(Rest),
{?FATE_BITS(binary:decode_unsigned(Bint)), Rest2};
{Bint, Rest2} = rlp_decode_int(Rest),
{?FATE_BITS(Bint), Rest2};
deserialize2(<<?LONG_STRING, Rest/binary>>) ->
{String, Rest2} = aeser_rlp:decode_one(Rest),
{?MAKE_FATE_STRING(String), Rest2};
{S, Rest2} = deserialize_one(Rest),
Size = S + ?SHORT_STRING_SIZE,
String = binary:part(Rest2, 0, Size),
Rest3 = binary:part(Rest2, byte_size(Rest2), - (byte_size(Rest2) - Size)),
{?MAKE_FATE_STRING(String), Rest3};
deserialize2(<<S:6, ?SHORT_STRING:2, Rest/binary>>) ->
String = binary:part(Rest, 0, S),
Rest2 = binary:part(Rest, byte_size(Rest), - (byte_size(Rest) - S)),
@ -344,36 +375,37 @@ deserialize2(<<?TRUE, Rest/binary>>) ->
{?FATE_TRUE, Rest};
deserialize2(<<?FALSE, Rest/binary>>) ->
{?FATE_FALSE, Rest};
deserialize2(<<?NIL, Rest/binary>>) ->
{?FATE_NIL, Rest};
deserialize2(<<?EMPTY_TUPLE, Rest/binary>>) ->
{?FATE_UNIT, Rest};
deserialize2(<<?EMPTY_MAP, Rest/binary>>) ->
{?MAKE_FATE_MAP(#{}), Rest};
deserialize2(<<?EMPTY_STRING, Rest/binary>>) ->
{?FATE_EMPTY_STRING, Rest};
deserialize2(<<?LONG_TUPLE, Rest/binary>>) ->
{BSize, Rest1} = aeser_rlp:decode_one(Rest),
N = binary:decode_unsigned(BSize) + ?SHORT_TUPLE_SIZE,
{Size, Rest1} = rlp_decode_int(Rest),
N = Size + ?SHORT_TUPLE_SIZE,
{List, Rest2} = deserialize_elements(N, Rest1),
{?FATE_TUPLE(list_to_tuple(List)), Rest2};
deserialize2(<<S:4, ?SHORT_TUPLE:4, Rest/binary>>) ->
{List, Rest1} = deserialize_elements(S, Rest),
{?FATE_TUPLE(list_to_tuple(List)), Rest1};
deserialize2(<<?LONG_LIST, Rest/binary>>) ->
{BLength, Rest1} = aeser_rlp:decode_one(Rest),
Length = binary:decode_unsigned(BLength) + ?SHORT_LIST_SIZE,
{Size, Rest1} = rlp_decode_int(Rest),
Length = Size + ?SHORT_LIST_SIZE,
{List, Rest2} = deserialize_elements(Length, Rest1),
{?MAKE_FATE_LIST(List), Rest2};
deserialize2(<<S:4, ?SHORT_LIST:4, Rest/binary>>) ->
{List, Rest1} = deserialize_elements(S, Rest),
{?MAKE_FATE_LIST(List), Rest1};
deserialize2(<<?MAP, Rest/binary>>) ->
{BSize, Rest1} = aeser_rlp:decode_one(Rest),
Size = binary:decode_unsigned(BSize),
{Size, Rest1} = rlp_decode_int(Rest),
{List, Rest2} = deserialize_elements(2*Size, Rest1),
Map = insert_kv(List, #{}),
KVList = insert_kv(List),
case sort_and_check(KVList) == KVList of
true ->
Map = maps:from_list(KVList),
{?MAKE_FATE_MAP(Map), Rest2};
false ->
error({unknown_map_serialization_format, KVList})
end;
deserialize2(<<?VARIANT, Rest/binary>>) ->
{AritiesBin, <<Tag:8, Rest2/binary>>} = aeser_rlp:decode_one(Rest),
Arities = binary_to_list(AritiesBin),
@ -390,8 +422,8 @@ deserialize2(<<?VARIANT, Rest/binary>>) ->
end
end.
insert_kv([], M) -> M;
insert_kv([K,V|R], M) -> insert_kv(R, maps:put(K, V, M)).
insert_kv([]) -> [];
insert_kv([K, V | R]) -> [{K, V} | insert_kv(R)].
deserialize_elements(0, Rest) ->
{[], Rest};
@ -399,3 +431,33 @@ deserialize_elements(N, Es) ->
{E, Rest} = deserialize2(Es),
{Tail, Rest2} = deserialize_elements(N-1, Rest),
{[E|Tail], Rest2}.
%% It is important to remove duplicated keys.
%% For deserialize this check is needed to observe illegal duplicates.
sort_and_check(List) ->
UniqKeyList =
lists:foldr(fun({K, V}, Acc) ->
case valid_key_type(K) andalso not lists:keymember(K, 1, Acc) of
true -> [{K,V}|Acc];
false -> Acc
end
end, [], List),
sort(UniqKeyList).
%% Sorting is used to get a unique result.
%% Deserialization is checking whether the provided key-value pairs are sorted
%% and raises an exception if not.
sort(KVList) ->
SortFun = fun({K1, _}, {K2, _}) ->
aeb_fate_data:elt(K1, K2)
end,
lists:sort(SortFun, KVList).
valid_key_type(K) when ?IS_FATE_MAP(K) ->
error({map_as_key_in_map, K});
valid_key_type(K) when ?IS_FATE_VARIANT(K) ->
error({variant_as_key_in_map, K});
valid_key_type(_K) ->
true.

2
test/aeb_fate_asm_test.erl
View File

@ -47,7 +47,7 @@ sources() ->
, "tuple"
, "mapofmap"
, "immediates"
, "all_instructions"
%% , "all_instructions"
].
check_roundtrip(File) ->

2
test/asm_code/all_instructions.fate
View File

@ -1,7 +1,7 @@
;; CONTRACT all_instructions
;; Dont expect this contract to typecheck or run.
;; Just used to check assembler rountrip of all instruction.
;; Just used to check assembler rountrip of all instructions.
FUNCTION foo () : {tuple, []}
RETURN