QPQ-AG/gmserialization
11
0
Fork 0
Code Issues Pull Requests 1 Actions Packages Projects Releases 2 Wiki Activity
gmserialization/src/gmser_dyn.erl
Ulf Wiger 00699b08b7
All checks were successful
Gajumaru Serialization Tests / tests (push) Successful in -3m56s
Details
Fix OTP 28 dialyzer warnings, rewrite gmser_dyn decoder 
gmser_dyn no longer tries to compress output by omitting type tags.
Decoding streams using custom template codes can either use 'strict'
decoding, in which case matching templates must be registered on the
decoding end; in `strict => false` mode, the stream can still be decoded
without valudation if the custom template is missing.
2026-02-18 21:10:43 +01:00

1318 lines
44 KiB
Erlang
Raw Blame History

-module(gmser_dyn).
-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 %% (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 %% updates stored types
, registered_types/0 %% -"-
, registered_types/1 %% -"-
, add_types/1 %% Returns updated types
, add_types/2 %% -"-
, add_types/3 %% -"-
, latest_vsn/0 %% -"-
, get_opts/1
, set_opts/1
, set_opts/2
, types_from_list/1
, revert_to_default_types/0
, dynamic_types/0 ]).
%% Register individual types, or cache labels
-export([ register_type/3
, cache_label/2
]).
-import(gmserialization, [ decode_field/2 ]).
-type tag() :: atom().
-type code() :: pos_integer().
-type basic_type() :: anyint
| negint
| int
| binary
| bool
| list
| map
| tuple
| id
| label.
-type key() :: term().
-type alt_type() :: #{alt := template()}.
-type list_type() :: #{list := template()}.
-type switch_type() :: #{switch := [{any(), template()}]}.
-type tuple_type() :: tuple().
-type items_type() :: #{items := [{key(), template()} | {opt, key(), template()}]}.
-type fields_type() :: [{key(), template()}].
-type template() :: basic_type()
| alt_type()
| list_type()
| switch_type()
| tuple_type()
| items_type()
| fields_type().
-type types() :: #{ vsn := pos_integer()
, codes := #{code() => tag()}
, rev := #{tag() => code()}
, templates := #{tag() => template()}
, labels := #{atom() => code()}
, rev_labels := #{code() => atom()}
, options := #{atom() => any()}
}.
-export_type([ tag/0
, code/0
, basic_type/0
, key/0
, alt_type/0
, switch_type/0
, list_type/0
, tuple_type/0
, items_type/0
, fields_type/0
, template/0
, types/0
]).
-define(VSN, 1).
-include_lib("kernel/include/logger.hrl").
-ifdef(TEST).
-compile(nowarn_export_all).
-compile(export_all).
-include_lib("eunit/include/eunit.hrl").
-endif.
serialize(Term) ->
Vsn = latest_vsn(),
rlp_encode(encode(Term, Vsn, registered_types(Vsn))).
serialize(Term, Types0) ->
Types = proper_types(Types0),
Vsn = types_vsn(Types),
rlp_encode(encode(Term, Vsn, Types)).
serialize(Term, Vsn, Types) ->
rlp_encode(encode(Term, Vsn, proper_types(Types, Vsn))).
serialize_typed(Type, Term) ->
Vsn = latest_vsn(),
rlp_encode(encode_typed(Type, Term, Vsn, registered_types(Vsn))).
serialize_typed(Type, Term, Types0) ->
Types = proper_types(Types0),
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, proper_types(Types, Vsn))).
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, Types0) ->
Types = proper_types(Types0),
Vsn0 = types_vsn(Types),
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, Types0) ->
Types = proper_types(Types0),
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) ->
Vsn = latest_vsn(),
encode(Term, Vsn, registered_types(Vsn)).
encode(Term, Types0) ->
Types = proper_types(Types0),
encode(Term, types_vsn(Types), Types).
encode(Term, Vsn, Types0) ->
Types = proper_types(Types0, Vsn),
[ encode_basic(int, 0)
, encode_basic(int, Vsn)
, encode_(Term, Vsn, Types) ].
encode_typed(Type, Term) ->
Vsn = latest_vsn(),
encode_typed(Type, Term, Vsn, registered_types(Vsn)).
encode_typed(Type, Term, Types0) ->
Types = proper_types(Types0),
encode_typed(Type, Term, types_vsn(Types), Types).
encode_typed(Type, Term, Vsn, Types0) ->
Types = proper_types(Types0, Vsn),
[ encode_basic(int, 0)
, encode_basic(int, Vsn)
, encode_typed_(Type, Term, Vsn, Types) ].
decode(Fields) ->
Vsn = latest_vsn(),
decode(Fields, Vsn, registered_types(Vsn)).
decode(Fields, Types0) ->
Types = proper_types(Types0),
decode(Fields, types_vsn(Types), Types).
decode(Fields0, Vsn, Types0) ->
Types = proper_types(Types0, Vsn),
case decode_tag_and_vsn(Fields0) of
{0, Vsn, Fields} ->
decode_(Fields, Vsn, Types);
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, Types0) ->
Types = proper_types(Types0),
decode_typed(Type, Fields, types_vsn(Types), Types).
decode_typed(Type, Fields0, Vsn, Types0) ->
Types = proper_types(Types0, Vsn),
case decode_tag_and_vsn(Fields0) of
{0, Vsn, Fields} ->
decode_typed_(Type, Fields, Vsn, Types);
Other ->
error({illegal_encoding, Other})
end.
decode_([[TemplateCodeBin, CodeBin], Fld], Vsn, #{codes := Codes} = Types) ->
TemplateCode = decode_basic(int, TemplateCodeBin),
Code = decode_basic(int, CodeBin),
case is_map_key(Code, Codes) of
true ->
Template = template(Code, Vsn, Types),
decode_from_template(Template, Code, Fld, Vsn, Types);
false ->
case option(strict, Types) of
true -> error({unknown_template, TemplateCode});
false ->
Template = template(Code, Vsn, Types),
decode_from_template(Template, Code, Fld, Vsn, Types)
end
end;
decode_([CodeBin, Flds], Vsn, Types) when is_binary(CodeBin) ->
Code = decode_basic(int, CodeBin),
Template = template(Code, Vsn, Types),
decode_from_template(Template, Code, Flds, Vsn, Types).
decode_typed_(Type, [[TCodeBin, CodeBin], Fld], Vsn, #{codes := Codes} = Types) ->
TCode = decode_basic(int, TCodeBin),
Code = decode_basic(int, CodeBin),
case maps:find(TCode, Codes) of
{ok, Type} ->
TTemplate = template(TCode, Vsn, Types),
decode_from_template(TTemplate, Code, Fld, Vsn, Types);
{ok, TType} ->
Template = type_to_template(Type, Vsn, Types),
case is_subtype(TType, Template) of
true ->
decode_from_template(Template, Code, Fld, Vsn, Types);
false ->
TTemplate = template(TCode, Vsn, Types),
T1 = decode_from_template(TTemplate, Code, Fld, Vsn, Types),
T2 = decode_from_template(Template, Code, Fld, Vsn, Types),
if T1 =:= T2 -> T1;
true ->
error(badarg)
end
end;
error ->
case option(strict, Types) of
true ->
error(missing_template);
false ->
decode_typed_(Type, Code, Fld, Vsn, Types)
end
end;
decode_typed_(Type, [CodeBin, Fld], Vsn, Types) when is_binary(CodeBin) ->
Code = decode_basic(int, CodeBin),
decode_typed_(Type, Code, Fld, Vsn, Types).
decode_typed_(Type, Code, Fld, Vsn, Types) when is_map(Type) ->
Template = template(Code, Vsn, Types),
case {Type, Template} of
{#{items := _}, map} -> decode_from_template(Type, Code, Fld, Vsn, Types);
{#{items := _}, items} -> decode_from_template(Type, Code, Fld, Vsn, Types);
{#{alt := _}, _} -> decode_from_template(Type, Code, Fld, Vsn, Types);
{#{switch:= _}, map} -> decode_from_template(Type, Code, Fld, Vsn, Types);
{#{list := _}, _} -> decode_from_template(Type, Code, Fld, Vsn, Types);
_ ->
error(badarg)
end;
decode_typed_(Type, Code, Fld, Vsn, Types) when is_tuple(Type); is_list(Type) ->
decode_from_template(Type, Code, Fld, Vsn, Types);
decode_typed_(Type, Code, Fld, Vsn, Types) ->
Template = template(Type, Vsn, Types),
case template(Code, Vsn, Types) of
Template ->
decode_from_template(Template, Code, Fld, Vsn, Types);
_ ->
error(badarg)
end.
decode_tag_and_vsn([TagBin, VsnBin, Fields]) ->
{decode_basic(int, TagBin),
decode_basic(int, VsnBin),
Fields}.
proper_types(undefined) ->
registered_types(latest_vsn());
proper_types(#{} = Types) ->
Types.
proper_types(undefined, Vsn) ->
registered_types(Vsn);
proper_types(#{} = Types, Vsn) ->
assert_vsn(Vsn, Types).
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}.
-define(ANYINT, 246).
-define(NEGINT, 247).
-define(INT, 248).
-define(BINARY, 249).
-define(BOOL, 250).
-define(LIST, 251).
-define(MAP, 252).
-define(TUPLE, 253).
-define(ID, 254).
-define(LABEL, 255).
-define(CODES, #{ 246 => anyint
, 247 => negint
, 248 => int
, 249 => binary
, 250 => bool
, 251 => list
, 252 => map
, 253 => tuple
, 254 => id
, 255 => label}).
-define(REV, #{ anyint => ?ANYINT
, negint => ?NEGINT
, int => ?INT
, binary => ?BINARY
, bool => ?BOOL
, list => ?LIST
, map => ?MAP
, tuple => ?TUPLE
, id => ?ID
, label => ?LABEL }).
-define(TEMPLATES, #{ anyint => #{alt => [negint, int]}
, negint => negint
, int => int
, binary => binary
, bool => bool
, list => list
, map => map
, tuple => tuple
, id => id
, label => label
}).
-define(OPTIONS, #{ missing_labels => fail
, strict => true }).
dynamic_types() ->
#{ vsn => ?VSN
, codes => ?CODES
, rev => ?REV
, labels => #{}
, rev_labels => #{}
, templates => ?TEMPLATES
, options => ?OPTIONS
}.
is_custom_template(T) ->
not is_core_template(T).
is_core_template(T) -> is_map_key(T, ?TEMPLATES).
registered_types() ->
registered_types(latest_vsn()).
registered_types(Vsn) ->
case persistent_term:get(pt_key(), undefined) of
undefined ->
dynamic_types();
#{latest_vsn := _, types := #{Vsn := Types}} ->
Types;
#{latest_vsn := _, types := _} ->
dynamic_types()
end.
type_to_template(T, Vsn, Types) when is_atom(T); is_integer(T) ->
template(T, Vsn, Types);
type_to_template(Type, _Vsn, _Types) ->
Type.
is_subtype(T, T) -> true;
is_subtype(map, #{items := _}) -> true;
is_subtype(map, #{switch := _}) -> true;
is_subtype(tuple, T) when is_tuple(T) -> true;
is_subtype(list, L) when is_list(L) -> true;
is_subtype(_, #{alt := _}) -> true;
is_subtype(anyint, int) -> true;
is_subtype(_, _) ->
false.
template(any, _, _) -> any;
template(TagOrCode, Vsn, Types) ->
Template = get_template(TagOrCode, Types),
dyn_template_(Template, Vsn).
get_template(Code, #{codes := Codes, templates := Ts}) when is_integer(Code) ->
Tag = maps:get(Code, Codes),
maps:get(Tag, Ts);
get_template(Tag, #{templates := Ts}) when is_atom(Tag) ->
maps:get(Tag, Ts).
dyn_template_(T, Vsn) ->
T1 = if is_function(T, 0) -> T();
is_function(T, 1) -> T(Vsn);
true -> T
end,
resolved_template(T1).
resolved_template(T) ->
if
is_map(T) -> T;
is_list(T) -> T;
is_tuple(T) -> T;
is_atom(T) ->
case is_core_template(T) of
true -> T;
false ->
error(unresolved_template)
end
end.
find_cached_label(Lbl, #{labels := Lbls}) ->
maps:find(Lbl, Lbls).
encode_(Term, Vsn, Types) ->
Template = auto_template(Term),
encode_from_template(Template, Term, Vsn, Types).
%% To control when to emit type codes:
%% If the template is predefined, it's 'not dynamic' (nodyn(E)).
%% If we are encoding against a type that's part of a predefined template,
%% we typically don't emit the type code, except at the very top.
%% So: emit type codes if the 'emit' bit is set, or if the 'dyn' bit is set.
%% emit() -> 2#01.
%% dyn() -> 2#10.
%% emit(E) -> E bor 2#01.
%% noemit(E) -> E band 2#10.
%% dyn(E) -> E bor 2#10.
%% nodyn(E) -> E band 2#01.
encode_typed_(Type, Term, Vsn, #{codes := Codes, rev := Rev} = Types) ->
case (is_map_key(Type, Codes) orelse is_map_key(Type, Rev)) of
true ->
encode_typed_1(Type, Term, Vsn, Types);
false ->
encode_maybe_template(Type, Term, Vsn, Types)
end.
encode_typed_1(any, Term, Vsn, Types) ->
encode_(Term, Vsn, Types);
encode_typed_1(Code, Term, Vsn, #{codes := Codes} = Types) when is_map_key(Code, Codes) ->
Tag = maps:get(Code, Codes),
Template = template(Code, Vsn, Types),
Fld = encode_from_template(Template, Term, Vsn, Types),
case is_custom_template(Tag) of
true ->
[CodeI, FldI] = Fld,
[[encode_basic(int, Code), CodeI], FldI];
false ->
encode_from_template(Template, Term, Vsn, Types)
end;
encode_typed_1(Tag, Term, Vsn, #{templates := Ts, rev := Rev} = Types)
when is_map_key(Tag, Ts) ->
Template = dyn_template_(maps:get(Tag, Ts), Vsn),
Code = maps:get(Tag, Rev),
Fld = encode_from_template(Template, Term, Vsn, Types),
case is_custom_template(Tag) of
true ->
[CodeI, FldI] = Fld,
[[encode_basic(int,Code), CodeI], FldI];
false ->
Fld
end;
encode_typed_1(MaybeTemplate, Term, Vsn, Types) ->
encode_maybe_template(MaybeTemplate, Term, Vsn, Types).
encode_maybe_template(#{items := _} = Type, Term, Vsn, Types) ->
case is_map(Term) of
true ->
encode_from_template(Type, Term, Vsn, Types);
false ->
error({invalid, Type, Term})
end;
encode_maybe_template(#{alt := _} = Type, Term, Vsn, Types) ->
encode_from_template(Type, Term, Vsn, Types);
encode_maybe_template(#{switch := _} = Type, Term, Vsn, Types) ->
encode_from_template(Type, Term, Vsn, Types);
encode_maybe_template(#{list := _} = Type, Term, Vsn, Types) ->
encode_from_template(Type, Term, Vsn, Types);
encode_maybe_template(Pat, Term, Vsn, Types) when is_list(Pat);
is_tuple(Pat) ->
encode_from_template(Pat, Term, Vsn, Types);
encode_maybe_template(Other, Term, _Vsn, _Types) ->
error({illegal_template, Other, Term}).
auto_template({id,Tag,V}) when Tag == account
; Tag == name
; Tag == commitment
; Tag == contract
; Tag == channel
; Tag == associate_chain
; Tag == entry ->
if is_binary(V) -> id;
true ->
%% close, but no cigar
tuple
end;
auto_template(T) ->
if is_map(T) -> map;
is_list(T) -> list;
is_tuple(T) -> tuple;
is_binary(T) -> binary;
is_boolean(T) -> bool;
is_atom(T) -> label; % binary_to_existing_atom()
is_integer(T),
T >= 0 -> int;
is_integer(T),
T < 0 -> negint;
true ->
error({invalid_type, T})
end.
decode_from_template(any, _Code, Fld, Vsn, Types) ->
decode_(Fld, Vsn, Types);
decode_from_template(#{items := Items}, _, Fld, Vsn, Types) when is_list(Fld) ->
Zipped = dec_zip_items(Items, Fld, Vsn, Types),
lists:foldl(
fun({K, Type, V}, Map) ->
case maps:is_key(K, Map) of
true -> error(duplicate_key);
false ->
Map#{K => decode_typed_(Type, V, Vsn, Types)}
end
end, #{}, Zipped);
decode_from_template(#{alt := Alts} = T, Code, Fld, Vsn, Types) when is_list(Alts) ->
decode_alt(Alts, Code, Fld, T, Vsn, Types);
decode_from_template(#{switch := Alts} = T, Code, Fld, Vsn, Types) when is_map(Alts) ->
decode_switch(Alts, Code, Fld, T, Vsn, Types);
decode_from_template(#{list := Type}, ?LIST, Fld, Vsn, Types) ->
[decode_typed_(Type, F, Vsn, Types) || F <- Fld];
decode_from_template(list, _, Flds, Vsn, Types) ->
[decode_(F, Vsn, Types) || F <- Flds];
decode_from_template(map, ?MAP, TupleFields, Vsn, Types) ->
Items = lists:map(fun([Ke, Ve]) ->
{decode_(Ke, Vsn, Types), decode_(Ve, Vsn, Types)}
end, TupleFields),
maps:from_list(Items);
decode_from_template(tuple, _, Fld, Vsn, Types) ->
Items = [decode_(F, Vsn, Types) || F <- Fld],
list_to_tuple(Items);
decode_from_template(Type, _, Fields, Vsn, Types) when is_list(Type) ->
decode_fields(Type, Fields, Vsn, Types);
%% Zipped = lists:zip(Type, Fields, fail),
%% [decode_typed_(T, F, Vsn, Types)
%% || {T, F} <- Zipped];
decode_from_template(Type, _, V, Vsn, Types) when is_tuple(Type) ->
Zipped = lists:zip(tuple_to_list(Type), V),
Items = [decode_typed_(T1, V1, Vsn, Types) || {T1, V1} <- Zipped],
list_to_tuple(Items);
decode_from_template(label, ?LABEL, [C], _, #{rev_labels := RLbls}) ->
Code = decode_basic(int, C),
maps:get(Code, RLbls);
decode_from_template(Type, Code, Fld, Vsn, Types) when Type == int
; Type == negint
; Type == binary
; Type == bool
; Type == id
; Type == label ->
case template(Code, Vsn, Types) of
Type ->
decode_basic(Type, Fld, Types);
_ ->
error(badarg)
end.
dec_zip_items([{K, T}|Is], [{K1, VEnc}|Fs], Vsn, Types) ->
if K =:= K1 ->
[{K, T, VEnc} | dec_zip_items(Is, Fs, Vsn, Types)];
true ->
error(illegal_map)
end;
dec_zip_items([{K, T}|Is], [[KEnc, VEnc]|Fs], Vsn, Types) ->
case decode_(KEnc, Vsn, Types) of
K ->
[{K, T, VEnc} | dec_zip_items(Is, Fs, Vsn, Types)];
_ ->
error(illegal_map)
end;
dec_zip_items([{opt, K, T}|Is], [{K, VEnc}|Fs], Vsn, Types) ->
[{K, T, VEnc} | dec_zip_items(Is, Fs, Vsn, Types)];
dec_zip_items([{opt, K, T}|Is], [[KEnc,VEnc]|Fs], Vsn, Types) ->
case decode_(KEnc, Vsn, Types) of
K ->
[{K, T, VEnc} | dec_zip_items(Is, Fs, Vsn, Types)];
OtherK ->
dec_zip_items(Is, [{OtherK, VEnc}|Fs], Vsn, Types)
end;
dec_zip_items([], [], _, _) ->
[].
encode_from_template(any, V, Vsn, Types) ->
encode_(V, Vsn, Types);
encode_from_template(list, L, Vsn, Types) when is_list(L) ->
assert_type(is_list(L), list, L),
emit(list, Types,
[encode_(V, Vsn, Types) || V <- L]);
encode_from_template(#{items := Items}, M, Vsn, Types) ->
assert_type(is_map(M), map, M),
Encode = fun(K, Type, V) ->
[encode_from_template(any, K, Vsn, Types),
encode_from_template(Type, V, Vsn, Types)]
end,
emit(map, Types,
lists:foldr(
fun({K, Type}, Acc) ->
V = maps:get(K, M),
[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, Vsn, Types) when is_list(Alts) ->
encode_alt(Alts, Term, T, Vsn, Types);
encode_from_template(#{switch := Alts} = T, Term, Vsn, Types) when is_map(Alts),
is_map(Term) ->
encode_switch(Alts, Term, T, Vsn, Types);
encode_from_template(map, M, Vsn, Types) ->
assert_type(is_map(M), map, M),
emit(map, Types,
[[encode_from_template(any, K, Vsn, Types),
encode_from_template(any, V, Vsn, Types)]
|| {K, V} <- lists:sort(maps:to_list(M))]);
encode_from_template(tuple, T, Vsn, Types) ->
assert_type(is_tuple(T), tuple, T),
emit(tuple, Types,
[encode_(V, Vsn, Types) || V <- tuple_to_list(T)]);
encode_from_template(T, V, Vsn, Types) when is_tuple(T) ->
assert_type(is_tuple(V), T, V),
assert_type(tuple_size(T) =:= tuple_size(V), T, V),
Zipped = lists:zip(tuple_to_list(T), tuple_to_list(V)),
emit(tuple, Types,
[encode_from_template(T1, V1, Vsn, Types) || {T1, V1} <- Zipped]);
encode_from_template(#{list := Type} = T, List, Vsn, Types) ->
assert_type(is_list(List), T, List),
emit(list, Types,
[encode_from_template(Type, V, Vsn, Types) || V <- List]);
encode_from_template(Type, List, Vsn, Types) when is_list(Type), is_list(List) ->
emit(list, Types, encode_fields(Type, List, Vsn, Types));
encode_from_template(label, V, _, Types) ->
assert_type(is_atom(V), label, V),
case find_cached_label(V, Types) of
error ->
encode_basic(label, V, Types);
{ok, Code} when is_integer(Code) ->
emit(label, Types,
[encode_basic(int, Code)])
end;
encode_from_template(Type, V, _, Types) when Type == id
; Type == binary
; Type == bool
; Type == int
; Type == negint
; Type == label ->
encode_basic(Type, V, Types);
encode_from_template(Type, V, Vsn, Types) ->
encode_typed_(Type, V, Vsn, Types).
assert_type(true, _, _) -> ok;
assert_type(_, Type, V) -> error({illegal, Type, V}).
decode_alt([A|Alts], Code, Fld, T, Vsn, Types) ->
try decode_typed_(A, Code, Fld, Vsn, Types)
catch error:_ ->
decode_alt(Alts, Code, Fld, T, Vsn, Types)
end;
decode_alt([], _Code, Fld, T, _, _) ->
error({illegal, T, Fld}).
encode_alt(Alts, Term, T, Vsn, Types) ->
%% Since we don't know which type may match, treat as dynamic.
encode_alt_(Alts, Term, T, Vsn, Types).
encode_alt_([A|Alts], Term, T, Vsn, Types) ->
try encode_from_template(A, Term, Vsn, Types)
catch error:_ ->
encode_alt_(Alts, Term, T, Vsn, Types)
end;
encode_alt_([], Term, T, _, _) ->
error({illegal, T, Term}).
decode_switch(Alts, Code, Fld, T, Vsn, Types) ->
case is_map_type(Code, Vsn, Types) of
true ->
case Fld of
[[KFld, VFld]] ->
Key = decode_(KFld, Vsn, Types),
case maps:find(Key, Alts) of
{ok, SubType} ->
SubTerm = decode_typed_(SubType, VFld, Vsn, Types),
#{Key => SubTerm};
error ->
error({illegal, T, Fld})
end;
_ ->
error({illegal, T, Fld})
end;
false ->
error({illegal, T, Fld})
end.
is_map_type(Code, Vsn, Types) ->
case template(Code, Vsn, Types) of
map -> true;
#{items := _} -> true;
#{switch := _} -> true;
T ->
case maps:get(T, maps:get(templates, Types)) of
map -> true;
T -> false;
Other when is_atom(Other) ->
is_map_type(T, Vsn, Types);
_ -> false
end
end.
encode_switch(Alts, Term, T, 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, Vsn, Types),
emit(map, Types,
[[encode_from_template(any, Key, Vsn, Types), Enc]]);
error ->
error({illegal, T, Term})
end.
%% Basically, dynamically encoding a statically defined object
encode_fields([{Field, Type}|TypesLeft],
[{Field, Val}|FieldsLeft], Vsn, Types) ->
KType = auto_template(Field),
[ encode_from_template({KType, Type}, {Field, Val}, Vsn, Types)
| encode_fields(TypesLeft, FieldsLeft, Vsn, Types)];
encode_fields([{_Field, _Type} = FT|_TypesLeft],
[Val |_FieldsLeft], _Vsn, _Types) ->
error({illegal_field, FT, Val});
encode_fields([Type|TypesLeft],
[Val |FieldsLeft], Vsn, Types) when is_atom(Type) ->
%% Not sure about this ...
[ encode_from_template(Type, Val, Vsn, Types)
| encode_fields(TypesLeft, FieldsLeft, Vsn, Types)];
encode_fields([], [], _, _) ->
[].
decode_fields([{Tag, Type}|TypesLeft],
[Field |FieldsLeft], Vsn, Types) ->
[ {Tag, decode_from_template(Type, 0, Field, Vsn, Types)}
| decode_fields(TypesLeft, FieldsLeft, Vsn, Types)];
decode_fields([], [], _, _) ->
[].
emit(Tag, Types, Enc) ->
[emit_code(Tag, Types), Enc].
emit_code(Tag, #{rev := Tags}) ->
encode_basic(int, maps:get(Tag, Tags)).
decode_basic(Type, [Tag,V], #{codes := Codes} = Types) ->
case decode_basic(int, Tag) of
Code when map_get(Code, Codes) == Type ->
decode_basic_(Type, V, Types);
_ ->
error(illegal)
end;
decode_basic(Type, V, Types) ->
decode_basic_(Type, V, Types).
decode_basic_(label, Fld, #{options := #{missing_labels := Opt}}) ->
Bin = decode_basic(binary, Fld),
case Opt of
create -> binary_to_atom(Bin, utf8);
fail -> binary_to_existing_atom(Bin, utf8);
convert ->
try binary_to_existing_atom(Bin, utf8)
catch
error:_ -> Bin
end
end;
decode_basic_(Type, Fld, _) ->
decode_basic(Type, Fld).
decode_basic(label, Fld) ->
binary_to_existing_atom(decode_basic(binary, Fld), utf8);
decode_basic(negint, Fld) ->
I = gmserialization:decode_field(int, Fld),
-I;
decode_basic(Type, Fld) ->
gmserialization:decode_field(Type, Fld).
encode_basic(negint, I, Types) when is_integer(I), I < 0 ->
[emit_code(negint, Types), gmserialization:encode_field(int, -I)];
encode_basic(Tag, V, Types) ->
[emit_code(Tag, Types), encode_basic(Tag, V)].
encode_basic(label, A) when is_atom(A) ->
encode_basic(binary, atom_to_binary(A, utf8));
encode_basic(Type, Fld) ->
gmserialization:encode_field(Type, Fld).
rlp_decode(Bin) ->
gmser_rlp:decode(Bin).
rlp_encode(Fields) ->
gmser_rlp:encode(Fields).
%% ===========================================================================
%% Type registration and validation code
register_types(Types) when is_map(Types) ->
register_types(latest_vsn(), Types).
register_types(Vsn, Types) ->
Result = add_types(Vsn, Types),
put_types(Vsn, Result).
add_types(Types) ->
add_types(?VSN, Types).
add_types(Vsn, Types) ->
add_types(Vsn, Types, dynamic_types()).
add_types(Vsn, Types, PrevTypes) ->
Codes = maps:get(codes, Types, #{}),
Rev = rev_codes(Codes),
Templates = maps:get(templates, Types, #{}),
Labels = maps:get(labels, Types, #{}),
RevLabels = rev_codes(Labels),
Options = maps:get(options, Types, #{}),
#{codes := Codes0, rev := Rev0, labels := Labels0, rev_labels := RevLabels0,
templates := Templates0, options := Options0} = PrevTypes,
Merged = #{ codes => maps:merge(Codes0, Codes)
, rev => maps:merge(Rev0, Rev)
, templates => maps:merge(Templates0, Templates)
, options => maps:merge(Options0, Options)
, labels => maps:merge(Labels0, Labels)
, rev_labels => maps:merge(RevLabels0, RevLabels) },
assert_sizes(Merged),
assert_mappings(Merged),
assert_label_cache(Merged),
assert_resolved_templates(Vsn, Merged).
latest_vsn() ->
case persistent_term:get(pt_key(), undefined) of
undefined -> ?VSN;
#{latest_vsn := V} ->
V
end.
pt_key() -> {?MODULE, types}.
put_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) ->
types_from_list(L, 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}
, rev := Rev#{Tag => Code}
, templates := Temps#{Tag => Template} },
put_types(New),
New;
{true, _} -> error(code_exists);
{_, true} -> error(tag_exists)
end.
set_opts(Opts) ->
set_opts(Opts, registered_types()).
set_opts(Opts, Types) ->
Types#{options => Opts}.
option(O, #{options := Opts}) ->
case Opts of
#{O := V} -> V;
_ -> default_option(O)
end.
default_option(O) ->
case dynamic_types() of
#{options := #{O := V}} -> V;
_ -> undefined
end.
get_opts(#{options := Opts}) ->
Opts.
cache_label(Code, Label) when is_integer(Code), Code >= 0, is_atom(Label) ->
#{labels := Lbls, rev_labels := RevLbls} = Types = registered_types(),
case {is_map_key(Label, Lbls), is_map_key(Code, RevLbls)} of
{false, false} ->
New = Types#{ labels := Lbls#{Label => Code}
, rev_labels := RevLbls#{Code => Label} },
put_types(New),
New;
{true,_} -> error(label_exists);
{_,true} -> error(code_exists)
end.
revert_to_default_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).
assert_sizes(Sz, Sz, Sz, _) ->
ok;
assert_sizes(Sz, RSz, Sz, Types) when RSz =/= Sz ->
%% Wrong size reverse mapping must mean duplicate mappings
%% We auto-generate the reverse-mappings, so we know there aren't
%% too many of them
?LOG_ERROR("Reverse mapping size doesn't match codes size", []),
Codes = maps:get(codes, Types),
CodeVals = maps:values(Codes),
Duplicates = CodeVals -- lists:usort(CodeVals),
error({duplicate_mappings, Duplicates, Types});
assert_sizes(Sz, _, TSz, Types) when Sz > TSz ->
?LOG_ERROR("More codes than templates", []),
Tags = maps:keys(maps:get(rev, Types)),
Templates = maps:get(templates, Types),
Missing = [T || T <- Tags,
not is_map_key(T, Templates)],
error({missing_mappings, Missing, Types});
assert_sizes(Sz, _, TSz, Types) when TSz > Sz ->
%% More mappings than codes. May not be horrible.
%% We check that all codes have mappings elsewhere.
?LOG_WARNING("More templates than codes in ~p", [Types]),
ok.
assert_mappings(#{rev := Rev, templates := Ts} = Types) ->
Tags = maps:keys(Rev),
case [T || T <- Tags,
not is_map_key(T, Ts)] of
[] ->
ok;
Missing ->
?LOG_ERROR("Missing templates for ~p", [Missing]),
error({missing_templates, Missing, Types})
end.
assert_resolved_templates(Vsn, #{templates := Ts} = Types) ->
_ = [template(T, Vsn, Types) || T <- maps:keys(Ts)],
Types.
assert_label_cache(#{labels := Labels} = Types) ->
Ls = maps:keys(Labels),
case [L || L <- Ls, not is_atom(L)] of
[] -> ok;
_NonAtoms ->
error(non_atoms_in_label_cache)
end,
Rev = [{C,L} || {L,C} <- maps:to_list(Labels)],
case [C || {C,_} <- Rev, not is_integer(C)] of
[] -> ok;
_NonInts -> error(non_integer_label_cache_codes)
end,
RevLabels = maps:from_list(Rev),
case map_size(RevLabels) == map_size(Labels) of
true ->
Types#{rev_labels => RevLabels};
false ->
error(non_unique_label_cache_codes)
end.
rev_codes(Codes) ->
L = maps:to_list(Codes),
maps:from_list([{V, K} || {K, V} <- L]).
%% ===========================================================================
%% Unit tests
-ifdef(TEST).
trace() ->
dbg:tracer(),
dbg:tpl(?MODULE, x),
dbg:p(all, [c]).
notrace() ->
dbg:ctpl('_'),
dbg:stop().
round_trip_test_() ->
[?_test(t_round_trip(T)) ||
T <- t_sample_types()
].
ser_round_trip_test_() ->
[?_test(t_ser_round_trip(T)) ||
T <- t_sample_types()
].
t_sample_types() ->
[ 5
, -5
, <<"a">>
, [1,2,3]
, {<<"a">>,1}
, #{<<"a">> => 1}
, [#{1 => <<"c">>, [17] => true}]
, true
].
user_types_test_() ->
{foreach,
fun() ->
revert_to_default_types()
end,
fun(_) ->
revert_to_default_types()
end,
[ ?_test(t_reg_typed_tuple())
, ?_test(t_reg_chain_objects_array())
, ?_test(t_reg_template_fun())
, ?_test(t_reg_template_vsnd_fun())
, ?_test(t_reg_label_cache())
, ?_test(t_reg_label_cache2())
, ?_test(t_reg_map())
, ?_test(t_reg_options())
]}.
dynamic_types_test_() ->
[ ?_test(revert_to_default_types())
, ?_test(t_typed_map())
, ?_test(t_typed_list())
, ?_test(t_alts())
, ?_test(t_switch())
, ?_test(t_anyints())
, ?_test(t_missing_labels())
].
versioned_types_test_() ->
[ ?_test(t_new_version())
].
consistency_test_() ->
[?_test(t_full_round_trip(Type, Term))
|| {Type, Term} <-
lists:flatmap(
fun({Type, Terms}) ->
[{Type,T} || T <- Terms]
end, full_round_trip_terms())].
full_round_trip_terms() ->
[
{ #{items => [{a, binary}]}, [#{a => <<"foo">>}] }
, { #{items => [ {a, int}
, {opt, b, int}
, {c, int} ]}, [ #{a => 1, b => 2, c => 3}
, #{a => 1, c => 3} ] }
, { #{alt => [int, label]}, [ 1, a ] }
, { #{switch => #{ a => int, b => binary }}, [ #{a => 17}
, #{b => <<"foo">>} ]}
].
t_full_round_trip(Type, Term) ->
?debugFmt("Type = ~p, Term = ~p", [Type, Term]),
Types = dynamic_types(),
ETyped = encode_typed(Type, Term, Types),
Types1 = gmser_dyn_types:add_type(mytype, 1030, Type, Types),
EReg = encode_typed(mytype, Term, Types1),
DTyped = decode_typed(Type, ETyped, Types),
?debugFmt("DTyped = ~p", [DTyped]),
DReg = decode_typed(mytype, EReg, Types1),
?assertEqual(Term, DTyped),
?assertEqual(Term, DReg),
DDynT = decode(ETyped),
?assertEqual(Term, DDynT),
try decode(EReg)
catch
error:_ ->
ok
end.
t_round_trip(T) ->
?debugVal(T),
?assertMatch({T, T}, {T, decode(encode(T))}).
t_ser_round_trip(T) ->
Data = serialize(T),
?debugFmt("Data (~p) = ~p~n", [T, Data]),
?assertMatch({T, T}, {T, deserialize(Data)}).
t_round_trip_typed(Type, T) ->
?debugVal(T),
?assertMatch({T, T}, {T, decode(encode_typed(Type, T))}).
t_reg_typed_tuple() ->
Type = {int, int, int},
MyTypes = #{ codes => #{ 1001 => int_tup3 }
, templates => #{ int_tup3 => Type }
},
register_types(MyTypes),
GoodTerm = {2,3,4},
?debugFmt("Type: ~p, GoodTerm = ~p", [Type, GoodTerm]),
Enc = encode_typed(int_tup3, GoodTerm),
GoodTerm = decode(Enc),
t_bad_typed_encode(int_tup3, {1,2,<<"a">>}, {illegal,int,<<"a">>}),
t_bad_typed_encode(int_tup3, {1,2,3,4}, {illegal, {int,int,int}, {1,2,3,4}}).
t_bad_typed_encode(Type, Term, Error) ->
try encode_typed(Type, Term),
error({expected_error, Error})
catch
error:Error ->
ok
end.
t_reg_chain_objects_array() ->
Template = [{foo, {int, binary}}, {bar, #{list => {int, int}}}, {baz, {int}}],
?debugFmt("Template = ~p", [Template]),
MyTypes = #{ codes => #{ 1002 => coa }
, templates => #{ coa => Template } },
register_types(MyTypes),
Values = [{foo, {1, <<"foo">>}}, {bar, [{1, 2}, {3, 4}, {5, 6}]}, {baz, {1}}],
?debugFmt("Values = ~p", [Values]),
Enc = encode_typed(coa, Values),
Values = decode(Enc).
t_reg_template_fun() ->
Template = fun() -> {int,int} end,
New = register_type(1010, tup2f0, Template),
?debugFmt("New = ~p", [New]),
E = encode_typed(tup2f0, {3,4}),
{3,4} = decode(E),
ok.
t_reg_template_vsnd_fun() ->
Template = fun(1) -> {int,int} end,
New = register_type(1011, tup2f1, Template),
?debugFmt("New = ~p", [New]),
E = encode_typed(tup2f1, {3,4}),
{3,4} = decode(E),
ok.
t_reg_label_cache() ->
Enc0 = gmser_dyn:encode('1'),
?debugFmt("Enc0 (no cache): ~w", [Enc0]),
MyTypes1 = #{codes => #{1003 => lbl_tup2}, templates => #{ lbl_tup2 => {label,label} }},
register_types(MyTypes1),
Enc0a = gmser_dyn:encode_typed(lbl_tup2, {'1','1'}),
?debugFmt("Enc0a (no cache): ~w", [Enc0a]),
{'1','1'} = gmser_dyn:decode(Enc0a),
MyTypes2 = MyTypes1#{labels => #{'1' => 49}}, % atom_to_list('1') == [49]
register_types(MyTypes2),
Enc1 = gmser_dyn:encode('1'),
Enc1a = gmser_dyn:encode_typed(lbl_tup2, {'1','1'}),
?debugFmt("Enc1 (w/ cache): ~w", [Enc1]),
?debugFmt("Enc1a (w/ cache): ~w", [Enc1a]),
{'1','1'} = gmser_dyn:decode(Enc1a),
true = Enc0 =/= Enc1,
Enc2 = gmser_dyn:encode_typed(label, '1'),
?debugFmt("Enc2 (typed): ~w", [Enc2]),
?assertEqual(Enc2, Enc1),
?assertNotEqual(Enc0a, Enc1a).
t_reg_label_cache2() ->
TFromL = types_from_list(
[ {lbl_tup2, 1003, {label, label}}
, {labels,
[{'1', 49}]}
]),
?debugFmt("TFromL = ~w", [TFromL]),
register_types(TFromL),
Tup = {'1', '1'},
Enc = gmser_dyn:encode_typed(lbl_tup2, Tup),
[<<0>>,<<1>>,[[<<3,235>>,<<?TUPLE>>],[[<<?LABEL>>,[<<49>>]],[<<?LABEL>>,[<<49>>]]]]] = Enc,
_Tup = gmser_dyn:decode(Enc).
t_reg_map() ->
Types =
#{codes => #{1013 => my_map},
templates => #{my_map => #{items => [{a, label},
{b, int}]}}
},
register_types(Types),
Enc0 = gmser_dyn:encode_typed(my_map, #{a => foo, b => 17}),
#{a := foo, b := 17} = gmser_dyn:decode(Enc0),
ok.
t_reg_options() ->
register_types(set_opts(#{missing_labels => convert})),
[Dyn,Vsn,[Am,<<"random">>]] = gmser_dyn:encode(random),
EncNewAm = [Dyn,Vsn,[Am,<<"foo12345">>]],
<<"foo12345">> = gmser_dyn:decode(EncNewAm),
ok.
t_typed_map() ->
Term = #{a => 13, {key,1} => [a]},
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_typed_list() ->
Term = [1,2,3,4],
encode_typed(#{list => int}, Term),
ok.
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),
ok.
t_missing_labels() ->
[Dyn,Vsn,[Am,<<"random">>]] = gmser_dyn:encode(random),
EncNewAm = [Dyn,Vsn,[Am,<<"flurbee">>]],
?assertError(badarg, gmser_dyn:decode(EncNewAm)),
?assertError(badarg, gmser_dyn:decode(EncNewAm, set_opts(#{missing_labels => fail}))),
<<"flurbee">> = gmser_dyn:decode(EncNewAm, set_opts(#{missing_labels => convert})),
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.
Reference in New Issue View Git Blame Copy Permalink