Validator extensions, zomp vsn 0.2.0 (#5)

Co-authored-by: Ulf Wiger <ulf@wiger.net>
Reviewed-on: #5
This commit was merged in pull request #5.
This commit is contained in:
2026-05-14 17:00:02 +09:00
parent 09093f729f
commit 08287da7b7
14 changed files with 770 additions and 55 deletions
+200 -50
View File
@@ -1,5 +1,6 @@
%% -*- mode: erlang; erlang-indent-level: 4; indent-tabs-mode: nil -*-
-module(gmconfig_schema_utils).
-vsn("0.2.0").
-export([get_config/0,
@@ -7,20 +8,28 @@
get_schema/0,
get_schema/1, %% (Default)
set_schema/1,
use_schema/1,
use_schema/2,
schema/1, %% (Path)
schema/2, %% (Path, Schema)
schema/3, %% (Path, Schema, Opts)
clear/0,
expand_schema/1]).
expand_ref/2,
expand_schema/1, %% (Schema) %% expand whole schema
expand_schema/2]). %% (SubSchema, RootSchema)
-export([ update_config/1 %% (Map) -> ok
, merge/2 %% (Item1, Item2) -> Item3
, merge/3 %% (Item1, Item2, Schema) -> Item3
, valid/1 %% (Item) -> Item | error()
, valid/2 %% (Item, Schema) -> Item | error()
, validate/3 %% (Item, Schema, Opts) -> Item | error().
]).
-export([in_properties/2]).
-export([normalize/0,
normalize/1]).
-type json_string() :: binary().
-type json_int() :: integer().
-type json_num() :: number().
@@ -37,15 +46,26 @@
-type schema() :: json().
-type ext_fun() :: fun( (json(), schema()) -> any() | no_return() ).
-type extensions() :: #{ binary() => ext_fun() }.
-type options() :: #{coerce => boolean(),
enum_to_atom => boolean(),
extensions => extensions() }.
-record(st, { s :: schema() %% schema
, r :: schema() %% root schema
, p = []
, a = [] %% annotations
, v :: json() | undefined %% value
, d = undefined :: list() | 'undefined' %% dynamic eval
, opts = #{} :: options()
}).
-type st() :: #st{}.
-export_type([ schema/0, json/0 ]).
-include_lib("kernel/include/logger.hrl").
-spec set_schema(schema()) -> ok.
set_schema(Schema) ->
@@ -67,6 +87,26 @@ get_schema() ->
get_schema(Default) ->
persistent_term:get({?MODULE, '$schema'}, Default).
-spec use_schema(schema() | st()) -> st().
use_schema(#st{} = St) -> St;
use_schema(S) -> #st{s = S, r = S}.
use_schema(Schema, RootSchema) ->
#st{s = Schema, r = RootSchema}.
normalize() ->
normalize(get_schema()).
normalize(S) when is_map(S) ->
#{bin_key(K) => normalize(V) || K := V <- S};
normalize(S) when is_list(S) ->
[normalize(Sx) || Sx <- S];
normalize(S) ->
S.
bin_key(A) when is_atom(A) -> atom_to_binary(A, utf8);
bin_key(B) when is_binary(B) -> B.
clear() ->
persistent_term:erase({?MODULE,'$schema'}),
persistent_term:erase({?MODULE,'$config'}),
@@ -138,12 +178,12 @@ schema_get(_, _, Default) ->
%% let us pattern-match on a schema map
%% all schemas that are not a map are converted to the empty map.
schema_map(Map) when is_map(Map) -> Map;
schema_map(_) -> #{}.
schema_map(Map, _) when is_map(Map) -> Map;
schema_map(_, _) -> #{}.
-spec merge_(json(), json(), st()) -> json().
merge_(A, B, #st{} = St) ->
Ss = schemas_from_dynamic_eval(A, St),
merge_(A, B, #st{} = St0) ->
{Ss, St} = schemas_from_dynamic_eval(A, St0#st{d = undefined}),
case schema_prop(<<"readOnly">>, St, Ss, false) of
true when B == null ->
valid(A, St);
@@ -163,7 +203,7 @@ merge_(A, B, St, Ss) ->
end.
update_semantics(A, St, Ss) ->
case maps:find(<<"$updateSemantics">>, schema_map(A)) of
case maps:find(<<"$updateSemantics">>, schema_map(A, St)) of
{ok, _} = Ok ->
{Ok, object};
error ->
@@ -190,9 +230,9 @@ remove_props(O, Keys, Recurse) when is_map(O) ->
remove_props(Other, _, _) ->
Other.
get_type(#st{} = St, Value) ->
Ss = schemas_from_dynamic_eval(Value, St),
get_type(St, Ss, Value).
get_type(#st{} = St0, Value) ->
{Ss, St} = schemas_from_dynamic_eval(Value, St0),
{get_type(St, Ss, Value), St}.
get_type(#st{} = St, Ss, Value) ->
case any_schema_prop(<<"type">>, St, Ss) of
@@ -272,7 +312,7 @@ update_object(A0, B, St, Ss) ->
update_object_(New, Old, St, Ss) ->
Dyn = acc_props(Ss),
SsOld = schemas_from_dynamic_eval(Old, St),
{SsOld, _} = schemas_from_dynamic_eval(Old, St#st{d = undefined}),
PropSchemas = [{P, prop_schema(P, Dyn, St)} || P <- maps:keys(New)],
try do_update_object(New, Old, St, PropSchemas)
catch
@@ -300,6 +340,55 @@ do_update_object(New, Old, St, PropSchemas) ->
end, Old, PropSchemas),
valid(Res, object, St).
validate(V, Schema, Opts) when is_map(Opts) ->
St0 = use_schema(Schema),
St = St0#st{opts = Opts},
V1 = valid(V, St),
case Opts of
#{enum_to_atom := true} ->
convert_enums(V1, St);
_ ->
V1
end.
convert_enums(V, St0) when is_binary(V) ->
case get_type(St0, V) of
{string, St} ->
{Ss, St1} = schemas_from_dynamic_eval(V, St),
case any_schema_prop(<<"enum">>, St1, Ss) of
{ok, _} ->
binary_to_atom(V, utf8);
_ ->
V
end;
_ ->
V
end;
convert_enums(V, St0) when is_map(V) ->
{Ss, St} = schemas_from_dynamic_eval(V, St0),
Dyn = acc_props(Ss),
maps:map(
fun(P, Vp) ->
PSchema = prop_schema(P, Dyn, St),
convert_enums(Vp, push_path(P, s(PSchema, St)))
end, V);
convert_enums(V, St0) when is_list(V) ->
{Ss,St} = schemas_from_dynamic_eval(V, St0),
case any_schema_prop(<<"items">>, St, Ss) of
{ok, Is} ->
[convert_enums(Vi, push_path(items, s(Is, St)))
|| Vi <- V];
error ->
case any_schema_prop(<<"prefixItems">>, St, Ss) of
{ok, PfxIs} ->
[convert_enums(Vi, push_path(prefixItems, s(PfxIs, St)))
|| Vi <- V];
error ->
V
end
end;
convert_enums(V, _) ->
V.
valid(V) ->
valid(V, get_schema()).
@@ -311,21 +400,21 @@ valid(V, Schema) ->
valid_(V, #st{s = true}) -> V;
valid_(_, #st{s = false} = St) -> fail(invalid, St);
valid_(V, St) ->
Type = get_type(St, V),
valid_(V, St0) ->
{Type, St} = get_type(St0, V),
valid(V, Type, St).
valid(V, _, #st{s = true}) -> V;
valid(_, _, #st{s = false} = St) -> fail(invalid, St);
valid(V, Type, St) ->
valid(V, Type, St0) ->
%% We run dynamic eval to find conditional parts of the schema.
%% we keep these in a separate list.
Ss = schemas_from_dynamic_eval(V, St),
{Ss,St} = schemas_from_dynamic_eval(V, St0),
valid(V, Type, St, Ss).
valid(V, Type, St, Ss) ->
valid_const(V, Type, St, Ss),
valid_enum(V, Type, St, Ss),
_ = valid_const(V, Type, St, Ss),
_ = valid_enum(V, Type, St, Ss),
%% Dynamic eval returns a list of matching schemas
%% We pass them along as they may contain properties,
%% but `V` has already been validated against them.
@@ -342,7 +431,7 @@ valid(V, Type, St, Ss) ->
split_valid(V, St, Ss) ->
split_valid(V, 0, St, Ss, [], []).
split_valid(V, Ix, St, [S|Ss], Yes, No) ->
try valid(V, push_path(Ix, St#st{s = S})) of
try valid(V, push_path(Ix, s(S, St))) of
_ -> split_valid(V, Ix+1, St, Ss, [{Ix,S}|Yes], No)
catch
error:Err ->
@@ -370,7 +459,8 @@ valid_enum(V, Type, St, Ss) ->
case lists:any(fun(X) ->
is_equal(Type, V, X)
end, En) of
true -> V;
true ->
V;
false ->
fail(not_in_enum, push_path(enum, St))
end
@@ -396,7 +486,7 @@ valid_object(O, St, Ss) when is_map(O) ->
end,
lists:foreach(
fun({P, #st{} = S}) ->
valid(maps:get(P, O), push_path(P, S))
valid(maps:get(P, O), push_path(P, S#st{d = undefined}))
end, PropSchemas),
O;
valid_object(_, St, _) ->
@@ -405,12 +495,15 @@ valid_object(_, St, _) ->
-spec valid_boolean(json(), st(), [st()]) -> json_bool().
valid_boolean(V, #st{s = true}, []) -> V;
valid_boolean(_, #st{s = false} = St, []) -> fail(invalid, St);
valid_boolean(<<"true">> , #st{opts = #{coerce := true}}, _) -> true;
valid_boolean(<<"false">>, #st{opts = #{coerce := true}}, _) -> false;
valid_boolean(V, St, _) ->
assert_type(fun is_boolean/1, V, St),
V.
valid_null(N, #st{s = true}, []) -> N;
valid_null(_, #st{s = false} = St, []) -> fail(invalid, St);
valid_null(<<"null">>, #st{s = null, opts = #{coerce := true}}, _) -> null;
valid_null(null, #st{s = null}, _) ->
null;
valid_null(_, St, _) ->
@@ -432,15 +525,28 @@ valid_string(S, St, Ss) when is_binary(S) ->
Lmax = schema_prop(<<"maxLength">>, St, Ss, Sz),
assert_min(Sz, Lmin, min_length, St),
assert_max(Sz, Lmax, max_length, St),
S;
valid_enum(S, string, St, Ss);
valid_string(_, St, _) ->
fail(wrong_type, St).
valid_number(N, _, #st{s = true}, []) -> N;
valid_number(_, _, #st{s = false} = St, []) -> fail(invalid, St);
valid_number(I, Sub, #st{opts = #{coerce := true}} = St, Ss) when is_binary(I) ->
try coerce_num(Sub, I) of
I1 ->
valid_number_(I1, Sub, St#st{v = I1}, Ss)
catch
error:_ ->
fail(wrong_type, St)
end;
valid_number(I, Sub, St, Ss) when is_number(I) ->
[assert_type(fun is_integer/1, I, St) || Sub == integer],
valid_number_(I, Sub, St, Ss);
valid_number(_, _, St, _) ->
fail(wrong_type, St).
valid_number_(I, Sub, St, Ss) when is_number(I) ->
[assert_type(fun is_integer/1, I, St) || Sub == integer],
case any_schema_prop(<<"multipleOf">>, St, Ss) of
error -> ok;
{ok, X} when is_integer(X), X > 0 ->
@@ -473,9 +579,16 @@ valid_number(I, Sub, St, Ss) when is_number(I) ->
EMax = schema_prop(<<"exclusiveMaximum">>, St, Ss, I+1),
test_range('>', EMax, I, add_anno(EMax, push_path(exclusiveMaximum, St))),
test_range('<', EMin, I, add_anno(EMin, push_path(exclusiveMinimum, St))),
I;
valid_number(_, _, St, _) ->
fail(wrong_type, St).
I.
coerce_num(integer, I) when is_binary(I) ->
binary_to_integer(I);
coerce_num(number, I) when is_binary(I) ->
try binary_to_integer(I)
catch
error:_ ->
binary_to_float(I)
end.
valid_array(A, #st{s = true}, []) -> A;
valid_array(_, #st{s = false} = St, []) -> fail(invalid, St);
@@ -497,23 +610,23 @@ valid_array(A, #st{} = St, Ss) when is_list(A) ->
{ok, PfxIs} ->
assert_schema(fun is_list/1, PfxIs, push_path(prefixItems, St)),
check_prefix_items(
PfxIs, A, Is, push_path(prefixItems, St#st{s = PfxIs}));
PfxIs, A, Is, push_path(prefixItems, s(PfxIs, St)));
error ->
check_items(A, push_path(items, St#st{s = Is}))
check_items(A, push_path(items, s(Is, St)))
end;
error ->
case PfxItems of
{ok, PfxIs} ->
assert_schema(fun is_list/1, PfxIs, push_path(prefixItems, St)),
check_prefix_items(
PfxIs, A, true, push_path(prefixItems, St#st{s = PfxIs}));
PfxIs, A, true, push_path(prefixItems, s(PfxIs, St)));
error ->
ok
end
end,
case any_schema_prop(<<"contains">>, St, Ss) of
{ok, Cs} ->
check_contains(A, push_path(contains, St#st{s = Cs}),
check_contains(A, push_path(contains, s(Cs, St)),
schema_prop(<<"minContains">>, St, Ss, null),
schema_prop(<<"maxContains">>, St, Ss, null));
error ->
@@ -540,12 +653,12 @@ check_prefix_items(_, _, _, St) ->
fail(invalid, St).
check_prefix_items([I|Is], [H|T], Ix, Items, St) ->
_ = valid(H, push_path(Ix, St#st{s = I})),
_ = valid(H, push_path(Ix, s(I, St))),
check_prefix_items(Is, T, Ix+1, Items, St);
check_prefix_items(_, [], _, _, _) ->
ok;
check_prefix_items([], Rest, Ix, Items, St) ->
check_items(Rest, Ix, push_path(items, St#st{s = Items})).
check_items(Rest, Ix, push_path(items, s(Items, St))).
check_items(A, St) ->
check_items(A, 0, St).
@@ -577,13 +690,13 @@ check_contains([], _, St, Min, Max, Yes, _No) ->
if is_integer(Max) ->
_ = valid(YesLen,
push_path(max,
St#st{s = #{<<"maximum">> => Max}}));
s(#{<<"maximum">> => Max}, St)));
true -> ok
end,
if is_integer(Min) ->
_ = valid(YesLen,
push_path(min,
St#st{s = #{<<"minimum">> => Min}}));
s(#{<<"minimum">> => Min}, St)));
true ->
ok
end
@@ -660,14 +773,26 @@ any_pattern_({Pat, Schema, I}, P) ->
any_pattern_(maps:next(I), P)
end.
schemas_from_dynamic_eval(Obj, #st{s = Schema} = St) ->
SMap = schema_map(Schema),
maybe_expand_ref(#st{s = S} = St) ->
case S of
#{<<"$ref">> := Ref} = R when map_size(R) == 1 ->
St#st{s = expand_ref(Ref, St#st.r)};
_ ->
St
end.
schemas_from_dynamic_eval(_, #st{d = Ss} = St) when Ss =/= undefined ->
{Ss, St};
schemas_from_dynamic_eval(Obj, #st{s = Schema} = St0) ->
St = maybe_expand_ref(St0),
SMap = schema_map(Schema, St),
Ss =
maps:fold(
fun(<<"allOf">>, Ss, Acc) ->
St1 = push_path(allOf, St),
case split_valid(Obj, St, Ss) of
{ValidSs, []} ->
Acc ++ [St1#st{s = S} || {_, S} <- ValidSs];
Acc ++ [s(S, St1) || {_, S} <- ValidSs];
{_, FailedSs} ->
fail(failing_schemas, add_anno(FailedSs, St1))
end;
@@ -675,7 +800,7 @@ schemas_from_dynamic_eval(Obj, #st{s = Schema} = St) ->
St1 = push_path(anyOf, St),
case split_valid(Obj, St1, Ss) of
{[_|_] = ValidSs, _} ->
Acc ++ [St1#st{s = S} || {_, S} <- ValidSs];
Acc ++ [s(S, St1) || {_, S} <- ValidSs];
{[], FailedSs} ->
fail(no_matching_schema, add_anno(FailedSs, St1))
end;
@@ -683,7 +808,7 @@ schemas_from_dynamic_eval(Obj, #st{s = Schema} = St) ->
St1 = push_path(oneOf, St),
case split_valid(Obj, St1, Ss) of
{[{_, S}], _} ->
Acc ++ [St1#st{s = S}];
Acc ++ [s(S, St1)];
{[_|_] = MoreValid, _} ->
ValidIxs = [I || {I,_} <- MoreValid],
fail(more_than_one, add_anno({valid, ValidIxs}, St1));
@@ -692,31 +817,49 @@ schemas_from_dynamic_eval(Obj, #st{s = Schema} = St) ->
end;
(<<"if">>, S, Acc) ->
St1 = push_path('if', St),
try valid(Obj, St1#st{s = S}) of
try valid(Obj, s(S, St1)) of
_ ->
Sthen =
push_path(
'then', St1#st{s = maps:get(<<"then">>, SMap, #{})}),
'then', s(maps:get(<<"then">>, SMap, #{}), St1)),
_ = valid(Obj, Sthen),
Acc ++ [Sthen]
catch
error:_ ->
Selse =
push_path(
'else', St1#st{s = maps:get(<<"else">>, SMap, #{})}),
'else', s(maps:get(<<"else">>, SMap, #{}), St1)),
_ = valid(Obj, Selse),
Acc ++ [Selse]
end;
(<<"not">>, S, Acc) ->
Snot = push_path('not', St#st{s = S}),
Snot = push_path('not', s(S, St)),
try valid(Obj, Snot) of
_ -> fail(invalid, Snot)
catch
error:_ ->
Acc
end;
(_, _, Acc) -> Acc
end, [], SMap).
(<<"x-", _/binary>> = Prop, SExt, Acc) ->
case St#st.opts of
#{extensions := #{Prop := ExtF}} ->
St1 = push_path(Prop, St),
call_extension(ExtF, Obj, SExt, Prop, St1),
Acc;
_ ->
Acc
end;
(_, _, Acc) ->
Acc
end, [], SMap),
{Ss, St#st{d = Ss}}.
call_extension(F, Obj, S, Prop, St) ->
try F(Obj, S)
catch
error:E ->
fail(extended_check, add_anno({Prop, E}, St))
end.
acc_props(Ss) ->
lists:foldl(
@@ -728,6 +871,9 @@ acc_props(Ss) ->
end
end, #{}, Ss).
s(S, #st{} = St) ->
St#st{s = S, d = undefined}.
push_path(Ps, #st{p = P0} = St) when is_list(Ps) ->
%% Assume Ps is in reverse order
St#st{p = Ps ++ P0};
@@ -780,13 +926,15 @@ uniqueItems(L) ->
USorted = lists:usort(L),
[] == L -- USorted.
expand_schema(S0) ->
S = expand_definitions(S0),
expand_schema(S) ->
%% S = expand_definitions(S0),
expand_schema(S, S).
expand_definitions(#{<<"definitions">> := D} = S) ->
S#{<<"definitions">> := expand_schema(D, S)}.
%% expand_definitions(#{<<"definitions">> := D} = S) ->
%% S#{<<"definitions">> := expand_schema(D, S)}.
expand_schema(#{<<"$ref">> := Path} = V, S0) when map_size(V) == 1 ->
expand_schema(expand_ref(Path, S0), S0);
expand_schema(S, S0) when is_map(S) ->
%% https://json-schema.org/understanding-json-schema/structuring#dollarref
%% When $id is used in a subschema, it indicates an embedded schema.
@@ -802,9 +950,9 @@ expand_schema(S, S0) when is_map(S) ->
S0
end,
maps:fold(fun(K, V, Acc) -> expand_schema_(K, V, Acc, S1) end, #{}, S);
expand_schema([#{<<"$ref">> := Path} = V], S0) when map_size(V) == 1 ->
D = expand_ref(Path, S0),
[D];
%% expand_schema([#{<<"$ref">> := Path} = V], S0) when map_size(V) == 1 ->
%% D = expand_ref(Path, S0),
%% [expand_schema(D, S0)];
expand_schema(S, S0) when is_list(S) ->
[expand_schema(E, S0) || E <- S];
expand_schema(S, _) ->
@@ -853,6 +1001,8 @@ schema(Path) ->
schema(Path, Schema) ->
schema(Path, Schema, #{follow_refs => true}).
schema(Path, #st{s = Schema, r = RootSchema}, Opts) ->
schema_(Path, Schema, RootSchema, Opts);
schema(Path, Schema, Opts) ->
schema_(Path, Schema, Schema, Opts).