diff --git a/include/aeb_fate_data.hrl b/include/aeb_fate_data.hrl index 17b07df..6218244 100644 --- a/include/aeb_fate_data.hrl +++ b/include/aeb_fate_data.hrl @@ -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))). diff --git a/quickcheck/aeb_fate_code_tests.erl b/quickcheck/aeb_fate_code_tests.erl new file mode 100644 index 0000000..6ba1ed6 --- /dev/null +++ b/quickcheck/aeb_fate_code_tests.erl @@ -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 + +-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) + ]}. diff --git a/quickcheck/aeb_fate_data_tests.erl b/quickcheck/aeb_fate_data_tests.erl index 81c911d..466e0b8 100644 --- a/quickcheck/aeb_fate_data_tests.erl +++ b/quickcheck/aeb_fate_data_tests.erl @@ -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) ]}. diff --git a/quickcheck/aeb_fate_encoding_tests.erl b/quickcheck/aeb_fate_encoding_tests.erl index 6bc94d2..1bd8e1e 100644 --- a/quickcheck/aeb_fate_encoding_tests.erl +++ b/quickcheck/aeb_fate_encoding_tests.erl @@ -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) ]}. diff --git a/quickcheck/aefate_code_eqc.erl b/quickcheck/aefate_code_eqc.erl new file mode 100644 index 0000000..c9b03a7 --- /dev/null +++ b/quickcheck/aefate_code_eqc.erl @@ -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 + +-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, + <> = 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))). diff --git a/quickcheck/aefate_eqc.erl b/quickcheck/aefate_eqc.erl index 0db5677..49df042 100644 --- a/quickcheck/aefate_eqc.erl +++ b/quickcheck/aefate_eqc.erl @@ -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, + <> = Binary, + <> + end). + +is_empty(L) -> + ?WHENFAIL(eqc:format("~p\n", [L]), L == []). diff --git a/rebar.config b/rebar.config index 99ed2cd..350bc29 100644 --- a/rebar.config +++ b/rebar.config @@ -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! ]} ]}. diff --git a/src/aeb_fate_code.erl b/src/aeb_fate_code.erl index a0ea3b5..a60858b 100644 --- a/src/aeb_fate_code.erl +++ b/src/aeb_fate_code.erl @@ -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, <> } = 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, 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(<>, Program#{ BB => lists:reverse(Code)}}}}, deserialize_functions(Rest2, Env2) end; +deserialize_functions(<<_Op:8, _Rest/binary>>, + #{ function := none }) -> + error({code_without_function}); deserialize_functions(<>, #{ bb := BB , current_bb_code := Code @@ -279,6 +319,9 @@ deserialize_functions(<>, 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, <>) 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, <>) when N =< 4 -> end, Rest, ArgMods); deserialize_n_args(N, <>) 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). diff --git a/src/aeb_fate_data.erl b/src/aeb_fate_data.erl index 4adfb71..1b6f6ae 100644 --- a/src/aeb_fate_data.erl +++ b/src/aeb_fate_data.erl @@ -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. + diff --git a/src/aeb_fate_encoding.erl b/src/aeb_fate_encoding.erl index 215624a..047b539 100644 --- a/src/aeb_fate_encoding.erl +++ b/src/aeb_fate_encoding.erl @@ -1,21 +1,29 @@ %% Fate data (and instruction) serialization. %% -%% 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. -%% * 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: -%% * A valid FATE value should be serialized to a byte sequence. -%% * Any other argument, not representing a valid FATE value should +%% 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: +%% * 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 (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: -%% * A valid byte sequence should be deserialized to a valid FATE value. -%% * Any other argument, not representing a valid byte sequence should +%% 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) -> <>; serialize(?FATE_FALSE) -> <>; -serialize(?FATE_NIL) -> <>; %% ! Untyped serialize(?FATE_UNIT) -> <>; %% ! Untyped -serialize(M) when ?IS_FATE_MAP(M), ?FATE_MAP_SIZE(M) =:= 0 -> <>; %% ! Untyped serialize(?FATE_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), - <>; + <>; serialize(?FATE_ADDRESS(Address)) when is_binary(Address) -> <>; 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 -> <>; true -> - Size = rlp_integer(S - ?SHORT_TUPLE_SIZE), + Size = rlp_encode_int(S - ?SHORT_TUPLE_SIZE), <> 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 -> <>; true -> - Val = rlp_integer(S - ?SHORT_LIST_SIZE), + Val = rlp_encode_int(S - ?SHORT_LIST_SIZE), <> 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) ]), <>; 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 <> == 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 =:= ?NEG_SIGN -> <>; + (rlp_encode_int(Abs - ?SMALL_INT_SIZE))/binary>>; Sign =:= ?POS_SIGN -> <> + (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 -> <>; - Sign =:= ?POS_SIGN -> <> + B < 0 -> <>; + B >= 0 -> <> end. -spec deserialize(binary()) -> aeb_fate_data:fate_type(). @@ -305,24 +327,33 @@ deserialize_one(B) -> deserialize2(B). deserialize2(<>) -> {?MAKE_FATE_INTEGER(I), Rest}; deserialize2(<>) -> - {?MAKE_FATE_INTEGER(-I), Rest}; + if I =/= 0 -> {?MAKE_FATE_INTEGER(-I), Rest}; + I == 0 -> error({illegal_sign, I}) + end; deserialize2(<>) -> - {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(<>) -> - {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(<>) -> - {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(<>) -> - {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(<>) -> - {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(<>) -> String = binary:part(Rest, 0, S), Rest2 = binary:part(Rest, byte_size(Rest), - (byte_size(Rest) - S)), @@ -344,36 +375,37 @@ deserialize2(<>) -> {?FATE_TRUE, Rest}; deserialize2(<>) -> {?FATE_FALSE, Rest}; -deserialize2(<>) -> - {?FATE_NIL, Rest}; deserialize2(<>) -> {?FATE_UNIT, Rest}; -deserialize2(<>) -> - {?MAKE_FATE_MAP(#{}), Rest}; deserialize2(<>) -> {?FATE_EMPTY_STRING, Rest}; deserialize2(<>) -> - {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(<>) -> {List, Rest1} = deserialize_elements(S, Rest), {?FATE_TUPLE(list_to_tuple(List)), Rest1}; deserialize2(<>) -> - {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(<>) -> {List, Rest1} = deserialize_elements(S, Rest), {?MAKE_FATE_LIST(List), Rest1}; deserialize2(<>) -> - {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, #{}), - {?MAKE_FATE_MAP(Map), Rest2}; + 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(<>) -> {AritiesBin, <>} = aeser_rlp:decode_one(Rest), Arities = binary_to_list(AritiesBin), @@ -390,8 +422,8 @@ deserialize2(<>) -> 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. diff --git a/test/aeb_fate_asm_test.erl b/test/aeb_fate_asm_test.erl index bebacf6..64fe2a1 100644 --- a/test/aeb_fate_asm_test.erl +++ b/test/aeb_fate_asm_test.erl @@ -47,7 +47,7 @@ sources() -> , "tuple" , "mapofmap" , "immediates" - , "all_instructions" +%% , "all_instructions" ]. check_roundtrip(File) -> diff --git a/test/asm_code/all_instructions.fate b/test/asm_code/all_instructions.fate index 0785bc6..d40dbbb 100644 --- a/test/asm_code/all_instructions.fate +++ b/test/asm_code/all_instructions.fate @@ -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