-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>>,<>],[[<>,[<<49>>]],[<>,[<<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.