Merge pull request 'uw-switch-semantics' (#53) from uw-switch-semantics into master
All checks were successful
Gajumaru Serialization Tests / tests (push) Successful in 49m56s

Reviewed-on: #53
This commit is contained in:
Ulf Wiger 2025-04-29 03:57:16 +09:00
commit 4ac7531351
2 changed files with 320 additions and 80 deletions

View File

@ -1,22 +1,32 @@
-module(gmser_dyn).
-export([ encode/1
, encode/2
, encode_typed/2
, encode_typed/3
, decode/1
, decode/2 ]).
-export([ encode/1 %% (Term) -> rlp()
, encode/2 %% (Term, Types) -> rlp()
, encode/3 %% (Term, Vsn, Types) -> rlp()
, encode_typed/2 %% (Type, Term) -> rlp()
, encode_typed/3 %% (Type, Term, Types) -> rlp()
, encode_typed/4 %% (Type, Term, Vsn, Types) -> rlp()
, decode/1 %% (RLP) -> Term
, decode/2 %% (RLP, Types) -> Term
, decode/3 %% (RLP, Vsn, Types) -> Term
, decode_typed/2 %% (Type, RLP) -> Term
, decode_typed/3 %% (Type, RLP, Types) -> Term
, decode_typed/4 ]). %% (Type, RLP, Vsn, Types) -> Term
-export([ serialize/1
, serialize/2
, serialize_typed/2
, serialize_typed/3
, deserialize/1
, deserialize/2 ]).
-export([ serialize/1 %% (Term) -> Bin
, serialize/2 %% (Term, Types) -> Bin
, serialize/3 %% (Term, Vsn, Types) -> Bin
, serialize_typed/2 %% (Type, Term) -> Bin
, serialize_typed/3 %% (Type, Term, Types) -> Bin
, serialize_typed/4 %% (Type, Term, Vsn, Types) -> Bin
, deserialize/1 %% (Bin) -> Term
, deserialize/2 %% (Bin, Types) -> Term
, deserialize/3 ]). %% (Bin, Vsn, Types) -> Term
%% register a type schema, inspect existing schema
-export([ register_types/1
, registered_types/0
, latest_vsn/0
, get_opts/1
, set_opts/1
, set_opts/2
@ -26,7 +36,8 @@
%% Register individual types, or cache labels
-export([ register_type/3
, cache_label/2 ]).
, cache_label/2
]).
-import(gmserialization, [ decode_field/2 ]).
@ -39,46 +50,112 @@
-include_lib("eunit/include/eunit.hrl").
-endif.
serialize(Term) -> rlp_encode(encode(Term)).
serialize(Term, Types) -> rlp_encode(encode(Term, Types)).
serialize_typed(Type, Term) -> rlp_encode(encode_typed(Type, Term)).
serialize_typed(Type, Term, Types) -> rlp_encode(encode_typed(Type, Term, Types)).
serialize(Term) ->
Vsn = latest_vsn(),
rlp_encode(encode_(Term, Vsn, registered_types(Vsn))).
deserialize(Binary) -> decode(rlp_decode(Binary)).
deserialize(Binary, Types) -> decode(rlp_decode(Binary), Types).
serialize(Term, Types) ->
Vsn = types_vsn(Types),
rlp_encode(encode_(Term, Vsn, Types)).
serialize(Term, Vsn, Types) ->
rlp_encode(encode_(Term, Vsn, Types)).
serialize_typed(Type, Term) ->
Vsn = latest_vsn(),
rlp_encode(encode_typed_(Type, Term, Vsn, registered_types(Vsn))).
serialize_typed(Type, Term, Types) ->
Vsn = types_vsn(Types),
rlp_encode(encode_typed_(Type, Term, Vsn, Types)).
serialize_typed(Type, Term, Vsn, Types) ->
rlp_encode(encode_typed_(Type, Term, Vsn, Types)).
deserialize(Binary) ->
Fields0 = rlp_decode(Binary),
case decode_tag_and_vsn(Fields0) of
{0, Vsn, Fields} ->
decode(Fields, Vsn, registered_types(Vsn));
Other ->
error({illegal_serialization, Other})
end.
deserialize(Binary, Types) ->
Vsn0 = maps:get(vsn, Types, undefined),
Fields0 = rlp_decode(Binary),
case decode_tag_and_vsn(Fields0) of
{0, Vsn, Fields} when Vsn0 == undefined; Vsn0 == Vsn ->
decode(Fields, Vsn, Types);
Other ->
error({illegal_serialization, Other})
end.
deserialize(Binary, Vsn, Types) ->
Fields0 = rlp_decode(Binary),
case decode_tag_and_vsn(Fields0) of
{0, Vsn, Fields} ->
decode(Fields, Vsn, Types);
Other ->
error({illegal_serialization, Other})
end.
encode(Term) ->
encode(Term, registered_types()).
Vsn = latest_vsn(),
encode(Term, Vsn, registered_types(Vsn)).
encode(Term, Types) ->
encode(Term, vsn(Types), Types).
encode(Term, types_vsn(Types), Types).
encode(Term, Vsn, Types) ->
encode(Term, Vsn, Types0) ->
Types = assert_vsn(Vsn, Types0),
[ encode_basic(int, 0)
, encode_basic(int, Vsn)
, encode_(Term, Vsn, Types) ].
encode_typed(Type, Term) ->
encode_typed(Type, Term, registered_types()).
Vsn = latest_vsn(),
encode_typed(Type, Term, Vsn, registered_types(Vsn)).
encode_typed(Type, Term, Types) ->
encode_typed(Type, Term, vsn(Types), Types).
encode_typed(Type, Term, types_vsn(Types), Types).
encode_typed(Type, Term, Vsn, Types) ->
encode_typed(Type, Term, Vsn, Types0) ->
Types = assert_vsn(Vsn, Types0),
[ encode_basic(int, 0)
, encode_basic(int, Vsn)
, encode_typed_(Type, Term, Vsn, Types) ].
decode(Fields) ->
decode(Fields, registered_types()).
Vsn = latest_vsn(),
decode(Fields, Vsn, registered_types(Vsn)).
decode(Fields0, Types) ->
decode(Fields, Types) ->
decode(Fields, types_vsn(Types), Types).
decode(Fields0, Vsn, Types0) ->
Types = assert_vsn(Vsn, Types0),
case decode_tag_and_vsn(Fields0) of
{0, Vsn, Fields} ->
decode_(Fields, Vsn, Types);
Other ->
error({illegal_serialization, Other})
error({illegal_encoding, Other})
end.
decode_typed(Type, Fields) ->
Vsn = latest_vsn(),
decode_typed(Type, Fields, Vsn, registered_types(Vsn)).
decode_typed(Type, Fields, Types) ->
decode_typed(Type, Fields, types_vsn(Types), Types).
decode_typed(Type, Fields0, Vsn, Types0) ->
Types = assert_vsn(Vsn, Types0),
case decode_tag_and_vsn(Fields0) of
{0, Vsn, Fields} ->
decode_from_template(Type, Fields, Vsn, Types);
Other ->
error({illegal_encoding, Other})
end.
decode_tag_and_vsn([TagBin, VsnBin, Fields]) ->
@ -86,6 +163,13 @@ decode_tag_and_vsn([TagBin, VsnBin, Fields]) ->
decode_basic(int, VsnBin),
Fields}.
types_vsn(#{vsn := Vsn}) -> Vsn;
types_vsn(_) -> latest_vsn().
assert_vsn(V, #{vsn := V} = Types) -> Types;
assert_vsn(V, #{vsn := Other} ) -> error({version_mismatch, V, Other});
assert_vsn(V, #{} = Types ) -> Types#{vsn => V}.
dynamic_types() ->
#{ vsn => ?VSN
, codes =>
@ -127,15 +211,17 @@ dynamic_types() ->
, options => #{}
}.
vsn(Types) ->
maps:get(vsn, Types, ?VSN).
registered_types() ->
case persistent_term:get({?MODULE, types}, undefined) of
registered_types(latest_vsn()).
registered_types(Vsn) ->
case persistent_term:get(pt_key(), undefined) of
undefined ->
dynamic_types();
Types when is_map(Types) ->
Types
#{latest_vsn := _, types := #{Vsn := Types}} ->
Types;
#{latest_vsn := _, types := _} ->
dynamic_types()
end.
template(TagOrCode, Vsn, Types) ->
@ -213,6 +299,8 @@ encode_maybe_template(#{items := _} = Type, Term, Vsn, Types) ->
end;
encode_maybe_template(#{alt := _} = Type, Term, Vsn, Types) ->
encode_from_template(Type, Term, Vsn, emit(dyn()), Types);
encode_maybe_template(#{switch := _} = Type, Term, Vsn, Types) ->
encode_from_template(Type, Term, Vsn, emit(dyn()), Types);
encode_maybe_template(Pat, Term, Vsn, Types) when is_list(Pat);
is_tuple(Pat) ->
encode_from_template(Pat, Term, emit(dyn()), Vsn, Types);
@ -249,14 +337,19 @@ auto_template(T) ->
decode_from_template(any, Fld, Vsn, Types) ->
decode_(Fld, Vsn, Types);
decode_from_template(#{items := Items}, Fld, Vsn, Types) when is_list(Fld) ->
Zipped = lists:zip(Items, Fld),
Zipped = lists:zipwith(
fun({{K, T}, V}) -> {K, T, V};
({{opt,K,T}, V}) -> {K, T, V}
end, Items, Fld),
lists:foldl(
fun({{K, Type}, V}, Map) ->
fun({K, Type, V}, Map) ->
maps:is_key(K, Map) andalso error(badarg, duplicate_field),
Map#{K => decode_from_template({any,Type}, V, Vsn, Types)}
end, #{}, Zipped);
decode_from_template(#{alt := Alts} = T, Fld, Vsn, Types) when is_list(Alts) ->
decode_alt(Alts, Fld, T, Vsn, Types);
decode_from_template(#{switch := Alts} = T, Fld, Vsn, Types) when is_map(Alts) ->
decode_switch(Alts, Fld, T, Vsn, Types);
decode_from_template(list, Flds, Vsn, Types) ->
[decode_(F, Vsn, Types) || F <- Flds];
decode_from_template(map, Fld, Vsn, Types) ->
@ -296,15 +389,28 @@ encode_from_template(list, L, E, Vsn, Types) when is_list(L) ->
encode_from_template(#{items := Items}, M, E, Vsn, Types) ->
assert_type(is_map(M), map, M),
Emit = noemit(E),
Encode = fun(K, Type, V) ->
[encode_from_template(any, K, Emit, Vsn, Types),
encode_from_template(Type, V, Emit, Vsn, Types)]
end,
emit(E, map, Types,
lists:map(
fun({K, Type}) ->
lists:foldr(
fun({K, Type}, Acc) ->
V = maps:get(K, M),
[encode_from_template(any, K, Emit, Vsn, Types),
encode_from_template(Type, V, Emit, Vsn, Types)]
end, Items));
[Encode(K, Type, V) | Acc];
({opt, K, Type}, Acc) ->
case maps:find(K, M) of
{ok, V} ->
[Encode(K, Type, V) | Acc];
error ->
Acc
end
end, [], Items));
encode_from_template(#{alt := Alts} = T, Term, E, Vsn, Types) when is_list(Alts) ->
encode_alt(Alts, Term, T, E, Vsn, Types);
encode_from_template(#{switch := Alts} = T, Term, E, Vsn, Types) when is_map(Alts),
is_map(Term) ->
encode_switch(Alts, Term, T, E, Vsn, Types);
encode_from_template(map, M, E, Vsn, Types) ->
assert_type(is_map(M), map, M),
Emit = emit(E),
@ -370,6 +476,30 @@ encode_alt_([A|Alts], Term, T, E, Vsn, Types) ->
encode_alt_([], Term, T, _, _, _) ->
error({illegal, T, Term}).
decode_switch(Alts, Fld, T, Vsn, Types) ->
[KFld, VFld] = Fld,
Key = decode_(KFld, Vsn, Types),
case maps:find(Key, Alts) of
{ok, SubType} ->
SubTerm = decode_from_template(SubType, VFld, Vsn, Types),
#{Key => SubTerm};
error ->
error({illegal, T, Fld})
end.
encode_switch(Alts, Term, T, E, Vsn, Types) ->
assert_type(map_size(Term) == 1, singleton_map, Term),
[{Key, Subterm}] = maps:to_list(Term),
case maps:find(Key, Alts) of
{ok, SubType} ->
Enc = encode_from_template(SubType, Subterm, E, Vsn, Types),
emit(E, map, Types,
[[encode_from_template(any, Key, E, Vsn, Types),
Enc]]);
error ->
error({illegal, T, Term})
end.
%% Basically, dynamically encoding a statically defined object
encode_fields([{Field, Type}|TypesLeft],
[{Field, Val}|FieldsLeft], E, Vsn, Types) ->
@ -457,6 +587,9 @@ rlp_encode(Fields) ->
%% Type registration and validation code
register_types(Types) when is_map(Types) ->
register_types(latest_vsn(), Types).
register_types(Vsn, Types) ->
Codes = maps:get(codes, Types, #{}),
Rev = rev_codes(Codes),
Templates = maps:get(templates, Types, #{}),
@ -473,16 +606,49 @@ register_types(Types) when is_map(Types) ->
assert_sizes(Merged),
assert_mappings(Merged),
Merged1 = assert_label_cache(Merged),
put_types(Merged1).
put_types(Vsn, Merged1).
latest_vsn() ->
case persistent_term:get(pt_key(), undefined) of
undefined -> ?VSN;
#{latest_vsn := V} ->
V
end.
pt_key() -> {?MODULE, types}.
put_types(Types) ->
persistent_term:put({?MODULE, types}, Types).
put_types(types_vsn(Types), Types).
put_types(V, Types) ->
K = pt_key(),
Old = case persistent_term:get(K, undefined) of
undefined -> default_types_pt();
Existing -> Existing
end,
put_types_(K, V, Types, Old).
put_types_(K, V, Types, #{latest_vsn := V0, types := Types0} = Old) ->
New = case V > V0 of
true ->
Old#{latest_vsn := V,
types := Types0#{V => Types#{vsn => V}}};
false ->
Old#{types := Types0#{V => Types#{vsn => V}}}
end,
persistent_term:put(K, New).
types_from_list(L) ->
lists:foldl(fun elem_to_type/2, dynamic_types(), L).
types_from_list(L, registered_types()).
register_type(Code, Tag, Template) when is_integer(Code), Code >= 0 ->
#{codes := Codes, rev := Rev, templates := Temps} = Types = registered_types(),
types_from_list(L, Types) ->
gmser_dyn_types:from_list(L, Types).
register_type(Code, Tag, Template) ->
register_type(latest_vsn(), Code, Tag, Template).
register_type(Vsn, Code, Tag, Template) when is_integer(Code), Code >= 0 ->
#{codes := Codes, rev := Rev, templates := Temps} = Types = registered_types(Vsn),
case {is_map_key(Code, Codes), is_map_key(Tag, Rev)} of
{false, false} ->
New = Types#{ codes := Codes#{Code => Tag}
@ -515,37 +681,11 @@ cache_label(Code, Label) when is_integer(Code), Code >= 0, is_atom(Label) ->
{_,true} -> error(code_exists)
end.
elem_to_type({Tag, Code, Template}, Acc) when is_atom(Tag), is_integer(Code) ->
#{codes := Codes, rev := Rev, templates := Temps} = Acc,
case {is_map_key(Tag, Rev), is_map_key(Code, Codes)} of
{false, false} ->
Acc#{ codes := Codes#{Code => Tag}
, rev := Rev#{Tag => Code}
, templates => Temps#{Tag => Template}
};
{true, _} -> error({duplicate_tag, Tag});
{_, true} -> error({duplicate_code, Code})
end;
elem_to_type({labels, Lbls}, Acc) ->
lists:foldl(fun add_label/2, Acc, Lbls);
elem_to_type(Elem, _) ->
error({invalid_type_list_element, Elem}).
add_label({L, Code}, #{labels := Lbls, rev_labels := RevLbls} = Acc)
when is_atom(L), is_integer(Code), Code > 0 ->
case {is_map_key(L, Lbls), is_map_key(Code, RevLbls)} of
{false, false} ->
Acc#{labels := Lbls#{L => Code},
rev_labels := RevLbls#{Code => L}};
{true, _} -> error({duplicate_label, L});
{_, true} -> error({duplicate_label_code, Code})
end;
add_label(Elem, _) ->
error({invalid_label_elem, Elem}).
revert_to_default_types() ->
persistent_term:put({?MODULE, types}, dynamic_types()).
persistent_term:put(pt_key(), default_types_pt()).
default_types_pt() ->
#{latest_vsn => ?VSN, types => #{?VSN => dynamic_types()}}.
assert_sizes(#{codes := Codes, rev := Rev, templates := Ts} = Types) ->
assert_sizes(map_size(Codes), map_size(Rev), map_size(Ts), Types).
@ -660,10 +800,15 @@ dynamic_types_test_() ->
[ ?_test(revert_to_default_types())
, ?_test(t_typed_map())
, ?_test(t_alts())
, ?_test(t_switch())
, ?_test(t_anyints())
, ?_test(t_missing_labels())
].
versioned_types_test_() ->
[ ?_test(t_new_version())
].
t_round_trip(T) ->
?debugVal(T),
?assertMatch({T, T}, {T, decode(encode(T))}).
@ -719,7 +864,6 @@ t_reg_template_vsnd_fun() ->
E = encode_typed(tup2f1, {3,4}),
{3,4} = decode(E),
ok.
t_reg_label_cache() ->
Enc0 = gmser_dyn:encode('1'),
@ -743,7 +887,7 @@ t_reg_label_cache() ->
?assertNotEqual(Enc0a, Enc1a).
t_reg_label_cache2() ->
TFromL = gmser_dyn:types_from_list(
TFromL = types_from_list(
[ {lbl_tup2, 1003, {label, label}}
, {labels,
[{'1', 49}]}
@ -764,14 +908,30 @@ t_reg_options() ->
t_typed_map() ->
Term = #{a => 13, {key,1} => [a]},
Enc = encode_typed(#{items => [{a,int},{{key,1},[label]}]}, Term),
?assertEqual(Term, decode(Enc)).
Items = [{a,int},{{key,1},[label]}],
OptItems = [{opt, b, int} | Items],
Enc = encode_typed(#{items => Items}, Term),
?assertEqual(Term, decode(Enc)),
?assertEqual(Enc, encode_typed(#{items => Items}, Term)),
?assertEqual(Enc, encode_typed(#{items => OptItems}, Term)),
Term1 = Term#{b => 4},
Enc1 = encode_typed(#{items => OptItems}, Term1),
?assertEqual(Term1, decode(Enc1)),
?assertEqual(Enc, encode_typed(#{items => Items}, Term1)).
t_alts() ->
t_round_trip_typed(#{alt => [negint, int]}, -4),
t_round_trip_typed(#{alt => [negint, int]}, 4),
ok.
t_switch() ->
T = #{switch => #{a => int, b => binary}},
t_round_trip_typed(T, #{a => 17}),
t_round_trip_typed(T, #{b => <<"foo">>}),
?assertError({illegal,int,<<"foo">>}, encode_typed(T, #{a => <<"foo">>})),
MMap = #{a => 17, b => <<"foo">>},
?assertError({illegal, singleton_map, MMap}, encode_typed(T, MMap)).
t_anyints() ->
t_round_trip_typed(anyint, -5),
t_round_trip_typed(anyint, 5),
@ -786,4 +946,22 @@ t_missing_labels() ->
true = is_atom(gmser_dyn:decode(EncNewAm, set_opts(#{missing_labels => create}))),
ok.
t_new_version() ->
V = latest_vsn(),
Types0 = registered_types(V),
V1 = V+1,
Types1 = types_from_list([{vsn, V1},
{msg1, 300, {int, int}}], Types0),
T2 = {3,5},
Enc21 = encode_typed(msg1, T2, Types1),
T2 = decode(Enc21, Types1),
V2 = V1+1,
Types2 = types_from_list([{vsn, V2},
{modify, {msg1, {int, int, int}}}], Types1),
Enc21 = encode_typed(msg1, T2, Types1),
?assertError({illegal,{int,int,int},T2}, encode_typed(msg1, T2, Types2)),
T3 = {3,5,7},
Enc32 = encode_typed(msg1, T3, Types2),
T3 = decode(Enc32, Types2).
-endif.

62
src/gmser_dyn_types.erl Normal file
View File

@ -0,0 +1,62 @@
-module(gmser_dyn_types).
-export([ add_type/4
, from_list/2
, expand/1 ]).
-export([ next_code/1 ]).
next_code(#{codes := Codes}) ->
lists:max(maps:keys(Codes)) + 1.
add_type(Tag, Code, Template, Types) ->
elem_to_type({Tag, Code, Template}, Types).
from_list(L, Types) ->
lists:foldl(fun elem_to_type/2, Types, L).
expand(#{vsn := V, templates := Templates0} = Types) ->
Templates =
maps:map(
fun(_, F) when is_function(F, 0) ->
F();
(_, F) when is_function(F, 1) ->
F(V);
(_, T) ->
T
end, Templates0),
Types#{templates := Templates}.
elem_to_type({Tag, Code, Template}, Acc) when is_atom(Tag), is_integer(Code) ->
#{codes := Codes, rev := Rev, templates := Temps} = Acc,
case {is_map_key(Tag, Rev), is_map_key(Code, Codes)} of
{false, false} ->
Acc#{ codes := Codes#{Code => Tag}
, rev := Rev#{Tag => Code}
, templates => Temps#{Tag => Template}
};
{true, _} -> error({duplicate_tag, Tag});
{_, true} -> error({duplicate_code, Code})
end;
elem_to_type({modify, {Tag, Template}}, Acc) ->
#{codes := _, rev := Rev, templates := Templates} = Acc,
_ = maps:get(Tag, Rev),
Templates1 = Templates#{Tag := Template},
Acc#{templates := Templates1};
elem_to_type({labels, Lbls}, Acc) ->
lists:foldl(fun add_label/2, Acc, Lbls);
elem_to_type({vsn, V}, Acc) ->
Acc#{vsn => V};
elem_to_type(Elem, _) ->
error({invalid_type, Elem}).
add_label({L, Code}, #{labels := Lbls, rev_labels := RevLbls} = Acc)
when is_atom(L), is_integer(Code), Code > 0 ->
case {is_map_key(L, Lbls), is_map_key(Code, RevLbls)} of
{false, false} ->
Acc#{labels := Lbls#{L => Code},
rev_labels := RevLbls#{Code => L}};
{true, _} -> error({duplicate_label, L});
{_, true} -> error({duplicate_label_code, Code})
end;
add_label(Elem, _) ->
error({invalid_label, Elem}).