QPQ-AG/gmconfig
9
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Initial commit

Browse Source
This commit is contained in:
Ulf Wiger 2025-02-24 22:17:41 +01:00
commit b40b7ddef4
6 changed files with 2085 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
LICENSE Normal file
View File

@ -0,0 +1,16 @@
ISC License
Copyright (c) 2025, QPQ AG
Copyright (c) 2017, aeternity developers
Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
PERFORMANCE OF THIS SOFTWARE.

21
rebar.config Normal file
View File

@ -0,0 +1,21 @@
%% -*- mode: erlang; erlang-indent-level: 4; indent-tabs-mode: nil -*-
{erl_opts, [debug_info]}.
{plugins, [rebar3_hex]}.
{deps, [
{zj, {git, "https://gitlab.com/zxq9/zj.git", {tag, "1.1.2"}}}
, {yamerl, "0.10.0"}
, {setup, "2.1.2"}
]}.
{profiles, [
{test, [{deps, [{meck, "0.9.2"}]}]}
]}.
{xref_checks, [undefined_function_calls, undefined_functions,
locals_not_used,
deprecated_function_calls, deprecated_functions]}.
{dialyzer, [ {warnings, [unknown]}
, {base_plt_apps, [erts, kernel, stdlib, yamerl, zj, setup]}
]}.

15
rebar.lock Normal file
View File

@ -0,0 +1,15 @@
{"1.2.0",
[{<<"setup">>,{pkg,<<"setup">>,<<"2.1.2">>},0},
{<<"yamerl">>,{pkg,<<"yamerl">>,<<"0.10.0">>},0},
{<<"zj">>,
{git,"https://gitlab.com/zxq9/zj.git",
{ref,"090a43d23edc481695664f16763f147a78c45afc"}},
0}]}.
[
{pkg_hash,[
{<<"setup">>, <<"43C0BBFE9160DE7925BF2FC2FE4396A99DC4EE1B73F0DC46ACC3F10E27B07A9C">>},
{<<"yamerl">>, <<"4FF81FEE2F1F6A46F1700C0D880B24D193DDB74BD14EF42CB0BCF46E81EF2F8E">>}]},
{pkg_hash_ext,[
{<<"setup">>, <<"596713D48D8241DF31821C08A9F7BAAF3E7CDD042C8396BC956CC7AE056925DC">>},
{<<"yamerl">>, <<"346ADB2963F1051DC837A2364E4ACF6EB7D80097C0F53CBDC3046EC8EC4B4E6E">>}]}
].

17
src/gmconfig.app.src Normal file
View File

@ -0,0 +1,17 @@
%% -*- mode: erlang; erlang-indent-level: 4; indent-tabs-mode: nil -*-
{application, gmconfig,
[{description, "Gajumaru configuration management support"},
{vsn, "0.1.0"},
{registered, []},
{application,
[
kernel
, stdlib
, zj
]},
{env, []},
{modules, []},
{maintainers, ["QPQ IaaS AG"]},
{licensens, ["ISC"]},
{links, [{"gitea", "https://git.qpq.swiss/gmconfig"}]}
]}.

1057
src/gmconfig.erl Normal file
View File

File diff suppressed because it is too large Load Diff

959
src/gmconfig_schema_utils.erl Normal file
View File

@ -0,0 +1,959 @@
%% -*- mode: erlang; erlang-indent-level: 4; indent-tabs-mode: nil -*-
-module(gmconfig_schema_utils).
-export([get_config/0,
set_config/1,
get_schema/0,
get_schema/1, %% (Default)
set_schema/1,
schema/1, %% (Path)
schema/2, %% (Path, Schema)
schema/3, %% (Path, Schema, Opts)
clear/0,
expand_schema/1]).
-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()
]).
-export([in_properties/2]).
-type json_string() :: binary().
-type json_int() :: integer().
-type json_num() :: number().
-type json_null() :: 'null'.
-type json_bool() :: boolean().
-type json_simple() :: json_null() | json_string() | json_int() | json_num()
| json_bool().
-type json_object() :: #{json_string() => json()}.
-type json_array() :: [json()].
-type json() :: json_simple() | json_array() | json_object().
-type json_type() :: null | boolean | string | number | integer
| object | array.
-type schema() :: json().
-record(st, { s :: schema() %% schema
, r :: schema() %% root schema
, p = []
, a = [] %% annotations
, v :: json() | undefined %% value
}).
-type st() :: #st{}.
-spec set_schema(schema()) -> ok.
set_schema(Schema) ->
persistent_term:put({?MODULE, '$schema'}, Schema).
-spec get_config() -> json().
get_config() ->
persistent_term:get({?MODULE, '$config'}, #{}).
-spec set_config(schema()) -> ok.
set_config(Config) ->
persistent_term:put({?MODULE, '$config'}, Config).
-spec get_schema() -> schema().
get_schema() ->
persistent_term:get({?MODULE, '$schema'}).
-spec get_schema(Default) -> schema() | Default.
get_schema(Default) ->
persistent_term:get({?MODULE, '$schema'}, Default).
clear() ->
persistent_term:erase({?MODULE,'$schema'}),
persistent_term:erase({?MODULE,'$config'}),
ok.
-spec update_config(json()) -> json().
update_config(Cfg) ->
OldCfg = get_config(),
Schema = get_schema(),
Res = merge(Cfg, OldCfg, #st{s = Schema,
r = Schema }),
set_config(Res),
Res.
-spec merge(json(), json()) -> json().
merge(A, B) ->
merge(A, B, get_schema()).
-spec merge(json(), json(), schema() | st()) -> json().
merge(A, B, #st{} = St) ->
merge_(A, B, St);
merge(A, B, Schema) ->
merge_(A, B, #st{s = Schema, r = Schema}).
%% Neither the JSON spec or the JSON-Schema spec are very helpful
%% regarding what takes precedence if dynamically evaluated parts
%% conflict with the base schema. The jsonschemavalidator.net version
%% is actually non-deterministic in this regard. So let's just pick one
%% approach that seems sensible.
%%
-spec schema_prop(Prop, State, SubSchemas, Default) -> json()
when Prop :: json_string()
, State :: st()
, SubSchemas :: [st()]
, Default :: json().
schema_prop(P, Schema, Ss, Default) ->
case any_schema_prop(P, Schema, Ss) of
{ok, V} ->
V;
error ->
Default
end.
any_schema_prop(P, S0, [S|Ss]) ->
case schema_prop_find(P, S) of
{ok, _} = Ok -> Ok;
error ->
any_schema_prop(P, S0, Ss)
end;
any_schema_prop(P, S, []) ->
schema_prop_find(P, S).
schema_prop_find(P, #st{s = S, r = RS}) when is_map(S) ->
case maps:find(P, S) of
{ok, #{<<"$ref">> := Sub} = M} when map_size(M) == 1 ->
D = expand_ref(Sub, RS),
{ok, D};
Other -> Other
end;
%% schema_find(P, #st{s = S}) when is_map(S) ->
%% maps:find(P, S);
schema_prop_find(_, _) ->
error.
schema_get(P, #st{s = S}, Default) when is_map(S) ->
maps:get(P, S, Default);
schema_get(_, _, Default) ->
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(_) -> #{}.
-spec merge_(json(), json(), st()) -> json().
merge_(A, B, #st{} = St) ->
Ss = schemas_from_dynamic_eval(A, St),
case schema_prop(<<"readOnly">>, St, Ss, false) of
true when B == null ->
valid(A, St);
true ->
fail(read_only, St);
false ->
merge_(A, B, St, Ss)
end.
merge_(A, B, St, Ss) ->
Type = get_type(St, Ss, A),
case Type of
object ->
update_object(A, B, St, Ss);
_ ->
valid(A, Type, St, Ss)
end.
update_semantics(A, St, Ss) ->
case maps:find(<<"$updateSemantics">>, schema_map(A)) of
{ok, _} = Ok ->
{Ok, object};
error ->
{any_schema_prop(<<"updateSemantics">>, St, Ss), schema}
end.
remove_semantic_props(O, Sem, Where) when is_map(O) ->
Recursive = case {Sem, Where} of
{{ok, <<"replace">>}, object} -> true;
_ -> false
end,
remove_props(O, [<<"$updateSemantics">>], Recursive);
remove_semantic_props(Other, _, _) ->
Other.
remove_props(O, Keys, Recurse) when is_map(O) ->
if Recurse ->
maps:map(fun(_, V) ->
remove_props(V, Keys, Recurse)
end, maps:without(Keys, O));
true ->
maps:without(Keys, O)
end;
remove_props(Other, _, _) ->
Other.
get_type(#st{} = St, Value) ->
Ss = schemas_from_dynamic_eval(Value, St),
get_type(St, Ss, Value).
get_type(#st{} = St, Ss, Value) ->
case any_schema_prop(<<"type">>, St, Ss) of
{ok, TBin} ->
select_type(TBin, Value, St);
error ->
try infer_type(Value)
catch
_:_ ->
fail(invalid, St)
end
end.
select_type(TBin, Value, St) ->
case TBin of
<<"null">> -> null;
<<"boolean">> -> boolean;
<<"object">> -> object;
<<"array">> -> array;
<<"number">> -> number;
<<"integer">> -> integer;
<<"string">> -> string;
Types when is_list(Types) ->
pick_a_type(Types, Value, St);
_ ->
fail(invalid_schema, St)
end.
infer_type(V) ->
if is_map(V) -> object;
is_integer(V) -> integer;
is_number(V) -> number;
is_boolean(V) -> boolean;
is_binary(V) -> string;
is_list(V) -> array;
V == null -> null
end.
-spec pick_a_type([json_string()], json(), st()) -> json_type().
pick_a_type([H|T], Value, St) ->
case H of
<<"object">> when is_map(Value) -> object;
<<"array">> when is_list(Value) -> array;
<<"number">> when is_number(Value) -> number;
<<"integer">> when is_integer(Value) -> integer;
<<"string">> when is_binary(Value) -> string;
<<"boolean">> when is_boolean(Value) -> boolean;
_ -> pick_a_type(T, Value, St)
end;
pick_a_type([], Value, St) ->
fail(wrong_type, St#st{v = Value}).
%% Updating objects is the tricky bit. We need to check for anyOf, etc.
%% since we can't simply join elements from disjunct schemas.
-spec update_object(json(), json_object(), st(), [st()]) -> json_object().
update_object(A0, B, St, Ss) ->
{Sem, Where} = update_semantics(A0, St, Ss),
A = remove_semantic_props(A0, Sem, Where),
case Sem of
{ok, <<"replace">>} ->
valid(A, object, St, Ss);
{ok, <<"merge">>} ->
update_object_(A, B, St, Ss);
{ok, <<"suggest">>} ->
if B == null; map_size(B) == 0 ->
valid(A, object, St, Ss);
true ->
update_object_(A, B, St, Ss)
end;
error ->
if is_map(A), is_map(B) ->
update_object_(A, B, St, Ss);
true ->
valid(A, object, St, Ss)
end
end.
update_object_(New, Old, St, Ss) ->
Dyn = acc_props(Ss),
SsOld = schemas_from_dynamic_eval(Old, St),
PropSchemas = [{P, prop_schema(P, Dyn, St)} || P <- maps:keys(New)],
try do_update_object(New, Old, St, PropSchemas)
catch
error:E when Ss =/= SsOld ->
%% Merging failed. Try replacing. If this fails,
%% go with the error raised by the first attempt.
try valid(New, object, St, Ss)
catch
error:_ ->
error(E)
end
end.
do_update_object(New, Old, St, PropSchemas) ->
Res = lists:foldl(
fun({P, S}, Acc) ->
S1 = push_path(P, S),
V = maps:get(P, New),
case maps:find(P, Old) of
{ok, OldV} ->
Acc#{P => merge(V, OldV, S1)};
error ->
Acc#{P => valid(V, S1)}
end
end, Old, PropSchemas),
valid(Res, object, St).
valid(V) ->
valid(V, get_schema()).
valid(V, #st{} = St) ->
valid_(V, St#st{v = V});
valid(V, Schema) ->
valid(V, #st{p = [], s = Schema, r = Schema, v = V}).
valid_(V, #st{s = true}) -> V;
valid_(_, #st{s = false} = St) -> fail(invalid, St);
valid_(V, St) ->
Type = get_type(St, V),
valid(V, Type, St).
valid(V, _, #st{s = true}) -> V;
valid(_, _, #st{s = false} = St) -> fail(invalid, St);
valid(V, Type, St) ->
%% 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),
valid(V, Type, St, Ss).
valid(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.
case Type of
object -> valid_object(V, push_path(object, St), Ss);
integer -> valid_number(V, integer, push_path(integer, St), Ss);
number -> valid_number(V, number, push_path(number, St), Ss);
string -> valid_string(V, push_path(string, St), Ss);
array -> valid_array(V, push_path(array, St), Ss);
boolean -> valid_boolean(V, push_path(boolean, St), Ss);
null -> valid_null(V, push_path(null, St), Ss)
end.
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
_ -> split_valid(V, Ix+1, St, Ss, [{Ix,S}|Yes], No)
catch
error:Err ->
split_valid(V, Ix+1, St, Ss, Yes, [{Ix, Err}|No])
end;
split_valid(_, _, _, [], Yes, No) ->
{lists:reverse(Yes), lists:reverse(No)}.
-spec valid_const(any(), json_type(), st(), [st()]) -> json().
valid_const(V, Type, St, Ss) ->
case any_schema_prop(<<"const">>, St, Ss) of
error -> V;
{ok, C} ->
case is_equal(Type, V, C) of
true -> ok;
false ->
fail(not_in_enum, push_path(const, St))
end
end.
valid_enum(V, Type, St, Ss) ->
case any_schema_prop(<<"enum">>, St, Ss) of
error -> V;
{ok, En} ->
case lists:any(fun(X) ->
is_equal(Type, V, X)
end, En) of
true -> V;
false ->
fail(not_in_enum, push_path(enum, St))
end
end.
-spec valid_object(any(), st(), [st()]) -> json_object().
valid_object(O, #st{s = true}, []) -> O;
valid_object(_, #st{s = false} = St, []) -> fail(invalid, St);
valid_object(O, St, Ss) when is_map(O) ->
Dyn = acc_props(Ss),
PropSchemas = [{P, prop_schema(P, Dyn, St)} || P <- maps:keys(O)],
MinP = schema_prop(<<"minProperties">>, St, Ss, 0),
OSz = length(PropSchemas),
MaxP = schema_prop(<<"maxProperties">>, St, Ss, OSz),
assert(fun(Sz) -> Sz >= MinP end, OSz,
min_properties, push_path(min_properties, St)),
assert(fun(Sz) -> Sz =< MaxP end, OSz,
max_properties, push_path(max_properties, St)),
Required = schema_prop(<<"required">>, St, Ss, []),
case [P || P <- Required, not lists:keymember(P, 1, PropSchemas)] of
[] -> ok;
RPs -> fail(required, add_anno(RPs, push_path(required, St)))
end,
lists:foreach(
fun({P, #st{} = S}) ->
valid(maps:get(P, O), push_path(P, S))
end, PropSchemas),
O;
valid_object(_, St, _) ->
fail(wrong_type, 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(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}, _) ->
null;
valid_null(_, St, _) ->
fail(wrong_type, St).
valid_string(S, #st{s = true}, []) -> S;
valid_string(_, #st{s = false} = St, []) -> fail(invalid, St);
valid_string(S, St, Ss) when is_binary(S) ->
P = schema_prop(<<"pattern">>, St, Ss, <<>>),
try re:run(S, P, []) of
{match, _} -> ok;
nomatch -> fail(no_match, St)
catch
error:_ -> fail(no_match, St)
end,
Sz = byte_size(S),
Lmin = schema_prop(<<"minLength">>, St, Ss, 0),
Lmax = schema_prop(<<"maxLength">>, St, Ss, Sz),
assert_min(Sz, Lmin, min_length, St),
assert_max(Sz, Lmax, max_length, St),
S;
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, 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 ->
%% The spec says:
%%
%% "6.2.1. multipleOf
%% The value of "multipleOf" MUST be a number, strictly greater than 0.
%%
%% A numeric instance is valid only if division by
%% this keyword's value results in an integer."
%%
%% Not sure how to implement (or use!) this reliably without
%% forcing both I and X to be integers, so this is what we'll do.
assert_schema(fun pos_int/1, X, push_path(multipleOf, St)),
St1 = add_anno(X, push_path(multipleOf, St)),
try I rem X of
0 -> ok;
_ -> fail(not_a_multiple, St1)
catch
_:_ ->
fail(not_a_multiple, St1)
end
end,
Min = schema_prop(<<"minimum">>, St, Ss, I),
Max = schema_prop(<<"maximum">>, St, Ss, I),
test_range('>=', Max, I, add_anno(Max, push_path(maximum, St))),
test_range('=<', Min, I, add_anno(Min, push_path(minimum, St))),
EMin = schema_prop(<<"exclusiveMinimum">>, St, Ss, I-1),
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).
valid_array(A, #st{s = true}, []) -> A;
valid_array(_, #st{s = false} = St, []) -> fail(invalid, St);
valid_array(A, #st{} = St, Ss) when is_list(A) ->
Len = length(A),
MaxIs = schema_prop(<<"maxItems">>, St, Ss, Len),
MinIs = schema_prop(<<"minItems">>, St, Ss, 0),
assert_schema(fun non_neg_int/1, MaxIs, push_path(maxItems, St)),
assert_schema(fun non_neg_int/1, MinIs, push_path(minItems, St)),
test_range('>=', MaxIs, Len, add_anno(MaxIs, push_path(maxItems, St))),
test_range('=<', MinIs, Len, add_anno(MinIs, push_path(minItems, St))),
Uniq = schema_prop(<<"uniqueItems">>, St, Ss, false),
assert_schema(fun is_boolean/1, Uniq, push_path(uniqueItems, St)),
[assert(fun uniqueItems/1, A, not_unique, push_path(uniqueItems, St)) || Uniq],
PfxItems = any_schema_prop(<<"prefixItems">>, St, Ss),
case any_schema_prop(<<"items">>, St, Ss) of
{ok, Is} ->
case PfxItems of
{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}));
error ->
check_items(A, push_path(items, St#st{s = Is}))
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}));
error ->
ok
end
end,
case any_schema_prop(<<"contains">>, St, Ss) of
{ok, Cs} ->
check_contains(A, push_path(contains, St#st{s = Cs}),
schema_prop(<<"minContains">>, St, Ss, null),
schema_prop(<<"maxContains">>, St, Ss, null));
error ->
ok
end,
A;
valid_array(_, St, _) ->
fail(wrong_type, St).
test_range(Op, X, I, St) ->
assert_schema(fun is_number/1, X, St),
try erlang:Op(X, I) of
true -> ok;
false -> fail(not_in_range, St)
catch
error:_ ->
fail(not_in_range, St)
end.
-spec check_prefix_items([schema()], [json()], schema(), st()) -> ok.
check_prefix_items(Is, A, Items, St) when is_list(Is), is_list(A) ->
check_prefix_items(Is, A, 0, Items, St);
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})),
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(A, St) ->
check_items(A, 0, St).
check_items([H|T], Ix, St) ->
_ = valid(H, push_path(Ix, St)),
check_items(T, Ix+1, St);
check_items([], _, _) ->
ok.
check_contains(A, St, Min, Max) ->
check_contains(A, 0, St, Min, Max, [], []).
check_contains([H|T], Ix, St, Min, Max, Yes, No) ->
try valid(H, push_path(Ix, St)) of
_ -> check_contains(T, Ix+1, St, Min, Max, [Ix|Yes], No)
catch
error:_ ->
check_contains(T, Ix+1, St, Min, Max, Yes, [Ix|No])
end;
check_contains([], _, St, Min, Max, Yes, _No) ->
case {Yes, Min, Max} of
{[_|_], null, null} ->
ok;
{[], null, _} ->
fail(contains, St);
_ ->
YesLen = length(Yes),
if is_integer(Max) ->
_ = valid(YesLen,
push_path(max,
St#st{s = #{<<"maximum">> => Max}}));
true -> ok
end,
if is_integer(Min) ->
_ = valid(YesLen,
push_path(min,
St#st{s = #{<<"minimum">> => Min}}));
true ->
ok
end
end.
prop_schema(P, Dyn, St) ->
try_props([fun() -> in_dyn(P, Dyn, St) end,
fun() -> in_properties(P, St) end,
fun() -> in_patternprops(P, St) end,
fun() -> in_additionalprops(P, St) end,
fun() -> unevaluated_or_true(St) end
]).
try_props([F|Fs]) ->
case F() of
{ok, S} -> S;
error ->
try_props(Fs)
end;
try_props([]) ->
%% If we don't find anything, validation doesn't fail.
%% (empty schema validates everything)
true.
in_dyn(P, Dyn, St) ->
case maps:find(P, Dyn) of
{ok, S1} ->
{ok, add_anno(dynamic_eval, St#st{s = S1})};
error ->
error
end.
in_properties(P, St) ->
case maps:find(P, schema_get(<<"properties">>, St, #{})) of
{ok, S1} ->
{ok, add_anno(properties, St#st{s = S1})};
error ->
error
end.
in_patternprops(P, S) ->
case any_pattern(schema_get(<<"patternProperties">>, S, #{}), P) of
{ok, S1} ->
{ok, add_anno(patternProperties, S#st{s = S1})};
error ->
error
end.
in_additionalprops(_, St) ->
case schema_prop_find(<<"additionalProperties">>, St) of
error -> error;
{ok, S} ->
{ok, add_anno(additionalProperties, St#st{s = S})}
end.
unevaluated_or_true(St) ->
case schema_prop_find(<<"unevaluatedProperties">>, St) of
error -> {ok, add_anno(no_unevaluated, St#st{s = true})};
{ok, S} ->
{ok, add_anno(unevaluated, St#st{s = S})}
end.
any_pattern(Ps, P) ->
I = maps:iterator(Ps),
any_pattern_(maps:next(I), P).
any_pattern_(none, _) ->
error;
any_pattern_({Pat, Schema, I}, P) ->
case re:run(P, Pat, []) of
{match, _} ->
{ok, Schema};
nomatch ->
any_pattern_(maps:next(I), P)
end.
schemas_from_dynamic_eval(Obj, #st{s = Schema} = St) ->
SMap = schema_map(Schema),
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];
{_, FailedSs} ->
fail(failing_schemas, add_anno(FailedSs, St1))
end;
(<<"anyOf">>, Ss, Acc) ->
St1 = push_path(anyOf, St),
case split_valid(Obj, St1, Ss) of
{[_|_] = ValidSs, _} ->
Acc ++ [St1#st{s = S} || {_, S} <- ValidSs];
{[], FailedSs} ->
fail(no_matching_schema, add_anno(FailedSs, St1))
end;
(<<"oneOf">>, Ss, Acc) ->
St1 = push_path(oneOf, St),
case split_valid(Obj, St1, Ss) of
{[{_, S}], _} ->
Acc ++ [St1#st{s = S}];
{[_|_] = MoreValid, _} ->
ValidIxs = [I || {I,_} <- MoreValid],
fail(more_than_one, add_anno({valid, ValidIxs}, St1));
{[], _} ->
fail(no_matching_schema, St1)
end;
(<<"if">>, S, Acc) ->
St1 = push_path('if', St),
try valid(Obj, St1#st{s = S}) of
_ ->
Sthen =
push_path(
'then', St1#st{s = maps:get(<<"then">>, SMap, #{})}),
_ = valid(Obj, Sthen),
Acc ++ [Sthen]
catch
error:_ ->
Selse =
push_path(
'else', St1#st{s = maps:get(<<"else">>, SMap, #{})}),
_ = valid(Obj, Selse),
Acc ++ [Selse]
end;
(<<"not">>, S, Acc) ->
Snot = push_path('not', St#st{s = S}),
try valid(Obj, Snot) of
_ -> fail(invalid, Snot)
catch
error:_ ->
Acc
end;
(_, _, Acc) -> Acc
end, [], SMap).
acc_props(Ss) ->
lists:foldl(
fun(#st{} = S, Acc1) ->
case schema_prop_find(<<"properties">>, S) of
error -> Acc1;
{ok, Ps} ->
maps:merge(Acc1, Ps)
end
end, #{}, Ss).
push_path(Ps, #st{p = P0} = St) when is_list(Ps) ->
%% Assume Ps is in reverse order
St#st{p = Ps ++ P0};
push_path(P, #st{p = P0} = St) ->
St#st{p = [P|P0]}.
add_anno(A, #st{a = Ann} = St) ->
St#st{a = [A|Ann]}.
assert_schema(F, X, St) ->
assert(F, X, invalid_schema, St).
assert_type(F, X, St) ->
assert(F, X, wrong_type, St).
fail(Error, #st{p = Path0, a = Ann, v = Val, s = S}) ->
error(#{e => Error, p => lists:reverse(Path0),
a => Ann, v => Val, s => S}).
is_equal(_Type, A, B) ->
A == B.
assert(F, X, Err, #st{} = St) when is_function(F, 1) ->
assert(fun() -> F(X) end, Err, St).
assert(F, Err, St) when is_function(F, 0) ->
try F() of
true -> ok;
false -> fail(Err, St)
catch
error:_ ->
fail(Err, St)
end.
assert_min(V, Min, EInfo, St) ->
assert(fun(X) -> X >= Min end, V, EInfo, St).
assert_max(V, Min, EInfo, St) ->
assert(fun(X) -> X =< Min end, V, EInfo, St).
-spec non_neg_int(any()) -> boolean().
non_neg_int(I) ->
is_integer(I) andalso I >= 0.
-spec pos_int(any()) -> boolean().
pos_int(I) ->
is_integer(I) andalso I > 0.
uniqueItems(L) ->
USorted = lists:usort(L),
[] == L -- USorted.
expand_schema(S0) ->
S = expand_definitions(S0),
expand_schema(S, S).
expand_definitions(#{<<"definitions">> := D} = S) ->
S#{<<"definitions">> := expand_schema(D, S)}.
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.
%% The identifier for the embedded schema is the value of $id
%%resolved against the Base URI of the schema it appears in.
%% A schema document that includes embedded schemas is called a
%% Compound Schema Document. Each schema with an $id in a
%% Compound Schema Document is called a Schema Resource.
S1 = case maps:find(<<"$id">>, S) of
{ok, _} ->
S;
error ->
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(S, S0) when is_list(S) ->
[expand_schema(E, S0) || E <- S];
expand_schema(S, _) ->
S.
expand_schema_(K, #{<<"$ref">> := Path} = V, Acc, S0) when map_size(V) == 1 ->
D = expand_ref(Path, S0),
Acc#{K => D};
expand_schema_(K, V, Acc, S0) ->
Acc#{K => expand_schema(V, S0)}.
expand_ref(R, _, #{follow_refs := false}) ->
R;
expand_ref(R, S, _) ->
expand_ref(R, S).
expand_ref(<<"#">>, S) ->
%% The $ref keyword may be used to create recursive schemas that refer to themselves.
%% This done by using `{"$ref" : "#"}`
S;
expand_ref(<<"#/", Path/binary>>, S) ->
Key = filename:split(Path),
case schema(Key, S, #{follow_refs => false}) of
{ok, #{<<"$ref">> := _}} ->
%% a $ref referring to another $ref could cause an infinite loop
%% in the resolver, and is explicitly disallowed.
%%
%% Example:
%% {
%% "$defs": {
%% "alice": { "$ref": "#/$defs/bob" },
%% "bob": { "$ref": "#/$defs/alice" }
%% }
%% }
%%
error(nested_references);
{ok, Def} ->
Def;
undefined ->
error(unknown_ref, [Path])
end.
schema(Path) ->
schema(Path, get_schema()).
schema(Path, Schema) ->
schema(Path, Schema, #{follow_refs => true}).
schema(Path, Schema, Opts) ->
schema_(Path, Schema, Schema, Opts).
schema_([H|T], Schema, RootSchema0, Opts) ->
RootSchema = set_rootschema(Schema, RootSchema0),
case Schema of
#{<<"$schema">> := _, <<"properties">> := #{H := Tree}} ->
schema_find(T, Tree, RootSchema, Opts);
#{'$schema' := _, properties := #{H := Tree}} ->
schema_find(T, Tree, RootSchema, Opts);
#{H := Tree} ->
schema_find(T, Tree, RootSchema, Opts);
_ ->
undefined
end;
schema_([], Schema, _, _) ->
{ok, Schema};
schema_(Key, Schema, RootSchema, Opts) ->
case maps:find(Key, Schema) of
{ok, #{<<"$ref">> := R} = S1} when map_size(S1) == 1 ->
case maps:get(follow_refs, Opts, true) of
true ->
D = expand_ref(R, RootSchema, Opts),
{ok, D};
false ->
{ok, S1}
end;
{ok, _} = Ok -> Ok;
error -> undefined
end.
schema_find([H|T], S, RS, Opts) ->
case S of
#{<<"properties">> := #{H := Tree}} ->
schema_find(T, Tree, set_rootschema(Tree, RS), Opts);
#{<<"patternProperties">> := Tree} ->
schema_match(H, Tree, T, RS, Opts);
#{properties := #{H := Tree}} ->
schema_find(T, Tree, set_rootschema(Tree, RS), Opts);
#{patternProperties := Tree} ->
schema_match(H, Tree, T, RS, Opts);
Map when is_map(Map) ->
case maps:find(H, Map) of
{ok, #{<<"$ref">> := R} = M} when map_size(M) == 1 ->
case maps:get(follow_refs, Opts, true) of
true ->
D = expand_ref(R, RS, Opts),
schema_find(T, D, RS, Opts);
false ->
schema_find(T, M, RS, Opts)
end;
{ok, Tree} ->
schema_find(T, Tree, RS, Opts);
error ->
undefined
end;
_ ->
schema_inspect([H|T], S, RS, Opts)
end;
schema_find([], S, _, _) ->
{ok, S}.
schema_match(P, Tree, T, RS, Opts) ->
case any_pattern(Tree, P) of
{ok, SubTree} ->
schema_find(T, SubTree, set_rootschema(SubTree, RS), Opts);
error ->
undefined
end.
set_rootschema(#{<<"$id">> := _} = S, _) ->
S;
set_rootschema(_, S) ->
S.
schema_inspect([H|T], S, RS, Opts) ->
case S of
#{<<"properties">> := #{<<"oneOf">> := Alts}} ->
case map_list_search(H, Alts) of
false ->
undefined;
#{H := Tree} ->
schema_find(T, Tree, set_rootschema(Tree, RS), Opts)
end;
#{properties := #{oneOf := Alts}} ->
case map_list_search(H, Alts) of
false ->
undefined;
#{H := Tree} ->
schema_find(T, Tree, set_rootschema(Tree, RS), Opts)
end;
_ ->
undefined
end.
map_list_search(K, [H|T]) ->
case maps:is_key(K, H) of
true ->
H;
false ->
map_list_search(K, T)
end;
map_list_search(_, []) ->
false.