File Coverage

blib/lib/JSON/Schema/Modern/Vocabulary/Core.pm
Criterion Covered Total %
statement 224 224 100.0
branch 91 102 89.2
condition 36 43 83.7
subroutine 34 34 100.0
pod 0 3 0.0
total 385 406 94.8


line stmt bran cond sub pod time code
1 31     31   21119 use strict;
  31         107  
  31         1117  
2 31     31   228 use warnings;
  31         99  
  31         1818  
3             package JSON::Schema::Modern::Vocabulary::Core;
4             # vim: set ts=8 sts=2 sw=2 tw=100 et :
5             # ABSTRACT: Implementation of the JSON Schema Core vocabulary
6              
7             our $VERSION = '0.571';
8              
9 31     31   933 use 5.020;
  31         212  
10 31     31   262 use Moo;
  31         95  
  31         337  
11 31     31   15361 use strictures 2;
  31         323  
  31         1575  
12 31     31   7811 use stable 0.031 'postderef';
  31         799  
  31         258  
13 31     31   6381 use experimental 'signatures';
  31         176  
  31         169  
14 31     31   2993 use if "$]" >= 5.022, experimental => 're_strict';
  31         136  
  31         406  
15 31     31   3386 no if "$]" >= 5.031009, feature => 'indirect';
  31         112  
  31         364  
16 31     31   1798 no if "$]" >= 5.033001, feature => 'multidimensional';
  31         108  
  31         278  
17 31     31   1754 no if "$]" >= 5.033006, feature => 'bareword_filehandles';
  31         139  
  31         378  
18 31     31   1693 use JSON::Schema::Modern::Utilities qw(is_type abort assert_keyword_type canonical_uri E assert_uri_reference assert_uri jsonp);
  31         107  
  31         3642  
19 31     31   309 use namespace::clean;
  31         98  
  31         384  
20              
21             with 'JSON::Schema::Modern::Vocabulary';
22              
23             sub vocabulary {
24 15     15 0 202 'https://json-schema.org/draft/2019-09/vocab/core' => 'draft2019-09',
25             'https://json-schema.org/draft/2020-12/vocab/core' => 'draft2020-12';
26             }
27              
28 26     26 0 146 sub evaluation_order { 0 }
29              
30 89     89 0 208 sub keywords ($self, $spec_version) {
  89         195  
  89         183  
  89         161  
31             return (
32 89 100       5760 qw($id $schema),
    100          
    100          
    100          
    100          
    100          
33             $spec_version ne 'draft7' ? '$anchor' : (),
34             $spec_version eq 'draft2019-09' ? '$recursiveAnchor' : (),
35             $spec_version eq 'draft2020-12' ? '$dynamicAnchor' : (),
36             '$ref',
37             $spec_version eq 'draft2019-09' ? '$recursiveRef' : (),
38             $spec_version eq 'draft2020-12' ? '$dynamicRef' : (),
39             $spec_version eq 'draft7' ? 'definitions' : qw($vocabulary $comment $defs),
40             );
41             }
42              
43             # adds the following keys to $state during traversal:
44             # - identifiers: an arrayref of tuples:
45             # $uri => { path => $path_to_identifier, canonical_uri => Mojo::URL (absolute when possible) }
46             # this is used by the Document constructor to build its resource_index.
47              
48 1657     1657   2963 sub _traverse_keyword_id ($self, $schema, $state) {
  1657         2857  
  1657         2624  
  1657         2607  
  1657         2664  
49 1657 100 66     5107 return if not assert_keyword_type($state, $schema, 'string')
50             or not assert_uri_reference($state, $schema);
51              
52 1655         6814 my $uri = Mojo::URL->new($schema->{'$id'});
53              
54 1655 100       200461 if ($state->{spec_version} eq 'draft7') {
55 312 100       837 if (length($uri->fragment)) {
56 30 50       241 return E($state, '$id cannot change the base uri at the same time as declaring an anchor')
57             if length($uri->clone->fragment(undef));
58              
59 30         5106 return $self->_traverse_keyword_anchor({ %$schema, $state->{keyword} => $uri->fragment }, $state);
60             }
61             }
62             else {
63 1343 100       3986 return E($state, '$id value "%s" cannot have a non-empty fragment', $schema->{'$id'})
64             if length $uri->fragment;
65             }
66              
67 1623         10738 $uri->fragment(undef);
68 1623 100       11579 return E($state, '$id cannot be empty') if not length $uri;
69              
70 1599 100       274404 $state->{initial_schema_uri} = $uri->is_abs ? $uri : $uri->to_abs($state->{initial_schema_uri});
71 1599         289410 $state->{traversed_schema_path} = $state->{traversed_schema_path}.$state->{schema_path};
72             # we don't set or update document_path because it is identical to traversed_schema_path
73 1599         3542 $state->{schema_path} = '';
74              
75             push $state->{identifiers}->@*,
76             $state->{initial_schema_uri} => {
77             path => $state->{traversed_schema_path},
78             canonical_uri => $state->{initial_schema_uri}->clone,
79             specification_version => $state->{spec_version}, # note! $schema keyword can change this
80             vocabularies => $state->{vocabularies}, # reference, not copy
81             configs => $state->{configs},
82 1599         6692 };
83 1599         167363 return 1;
84             }
85              
86 2887     2887   5128 sub _eval_keyword_id ($self, $data, $schema, $state) {
  2887         5167  
  2887         4785  
  2887         4454  
  2887         4457  
  2887         4481  
87 2887         64302 my $schema_info = $state->{document}->path_to_resource($state->{document_path}.$state->{schema_path});
88             # this should never happen, if the pre-evaluation traversal was performed correctly
89 2887 50       582103 abort($state, 'failed to resolve %s to canonical uri', $state->{keyword}) if not $schema_info;
90              
91 2887         11863 $state->{initial_schema_uri} = $schema_info->{canonical_uri}->clone;
92 2887         251332 $state->{traversed_schema_path} = $state->{traversed_schema_path}.$state->{schema_path};
93 2887         7334 $state->{document_path} = $state->{document_path}.$state->{schema_path};
94 2887         5376 $state->{schema_path} = '';
95 2887         6421 $state->{spec_version} = $schema_info->{specification_version};
96 2887         5896 $state->{vocabularies} = $schema_info->{vocabularies};
97              
98 2887 100       7841 if ($state->{validate_formats}) {
99             $state->{vocabularies} = [
100             map s/^JSON::Schema::Modern::Vocabulary::Format\KAnnotation$/Assertion/r, $state->{vocabularies}->@*
101 251         2514 ];
102 251         1641 require JSON::Schema::Modern::Vocabulary::FormatAssertion;
103             }
104              
105 2887         9950 $state->@{keys $state->{configs}->%*} = values $state->{configs}->%*;
106 2887         7898 push $state->{dynamic_scope}->@*, $state->{initial_schema_uri};
107              
108 2887         11489 return 1;
109             }
110              
111 5561     5561   10341 sub _traverse_keyword_schema ($self, $schema, $state) {
  5561         10616  
  5561         8563  
  5561         8860  
  5561         9480  
112 5561 100 66     17131 return if not assert_keyword_type($state, $schema, 'string') or not assert_uri($state, $schema);
113              
114             # "A JSON Schema resource is a schema which is canonically identified by an absolute URI."
115             # "A resource's root schema is its top-level schema object."
116             # note: we need not be at the document root, but simply adjacent to an $id (or be the at the
117             # document root)
118             return E($state, '$schema can only appear at the schema resource root')
119 5560 100       19190 if length($state->{schema_path});
120              
121 5557         10762 my ($spec_version, $vocabularies);
122              
123 5557 100       110267 if (my $metaschema_info = $state->{evaluator}->_get_metaschema_vocabulary_classes($schema->{'$schema'})) {
124 5513         545983 ($spec_version, $vocabularies) = @$metaschema_info;
125             }
126             else {
127 44         4646 my $schema_info = $state->{evaluator}->_fetch_from_uri($schema->{'$schema'});
128 44 100       203 return E($state, 'EXCEPTION: unable to find resource %s', $schema->{'$schema'}) if not $schema_info;
129              
130             ($spec_version, $vocabularies) = $self->__fetch_vocabulary_data({ %$state,
131             keyword => '$vocabulary', initial_schema_uri => Mojo::URL->new($schema->{'$schema'}),
132 43         367 traversed_schema_path => jsonp($state->{schema_path}, '$schema'),
133             }, $schema_info);
134             }
135              
136 5556 100       15693 return E($state, '"%s" is not a valid metaschema', $schema->{'$schema'}) if not @$vocabularies;
137              
138             # we special-case this because the check in _eval_subschema for older drafts + $ref has already happened
139             return E($state, '$schema and $ref cannot be used together in older drafts')
140 5539 100 100     18215 if exists $schema->{'$ref'} and $spec_version eq 'draft7';
141              
142 5538         16659 $state->@{qw(spec_version vocabularies)} = ($spec_version, $vocabularies);
143              
144             # remember, if we don't have a sibling $id, we must be at the document root with no identifiers
145 5538 100       14874 if ($state->{identifiers}->@*) {
146 552         2127 $state->{identifiers}[-1]->@{qw(specification_version vocabularies)} = $state->@{qw(spec_version vocabularies)};
147             }
148              
149 5538         20751 return 1;
150             }
151              
152 451     451   1070 sub _traverse_keyword_anchor ($self, $schema, $state) {
  451         903  
  451         783  
  451         790  
  451         746  
153 451 50       1390 return if not assert_keyword_type($state, $schema, 'string');
154              
155             return E($state, '%s value "%s" does not match required syntax',
156             $state->{keyword}, ($state->{keyword} eq '$id' ? '#' : '').$schema->{$state->{keyword}})
157             if $state->{spec_version} =~ /^draft(?:7|2019-09)$/
158             and $schema->{$state->{keyword}} !~ /^[A-Za-z][A-Za-z0-9_:.-]*$/
159             or $state->{spec_version} eq 'draft2020-12'
160 451 50 66     6213 and $schema->{$state->{keyword}} !~ /^[A-Za-z_][A-Za-z0-9._-]*$/;
    100 100        
      66        
161              
162 447         1566 my $canonical_uri = canonical_uri($state);
163              
164             push $state->{identifiers}->@*,
165             Mojo::URL->new->to_abs($canonical_uri)->fragment($schema->{$state->{keyword}}) => {
166             path => $state->{traversed_schema_path}.$state->{schema_path},
167             canonical_uri => $canonical_uri,
168             specification_version => $state->{spec_version},
169             vocabularies => $state->{vocabularies}, # reference, not copy
170             configs => $state->{configs},
171 447         1860 };
172 447         140325 return 1;
173             }
174              
175             # we already indexed the $anchor uri, so there is nothing more to do at evaluation time.
176             # we explicitly do NOT set $state->{initial_schema_uri}.
177              
178 131     131   278 sub _traverse_keyword_recursiveAnchor ($self, $schema, $state) {
  131         307  
  131         243  
  131         228  
  131         207  
179 131 50       482 return if not assert_keyword_type($state, $schema, 'boolean');
180              
181             # this is required because the location is used as the base URI for future resolution
182             # of $recursiveRef, and the fragment would be disregarded in the base
183             return E($state, '"$recursiveAnchor" keyword used without "$id"')
184 131 100       2025 if length($state->{schema_path});
185 128         350 return 1;
186             }
187              
188 684     684   1185 sub _eval_keyword_recursiveAnchor ($self, $data, $schema, $state) {
  684         1142  
  684         1229  
  684         979  
  684         1038  
  684         976  
189 684 100 100     2876 return 1 if not $schema->{'$recursiveAnchor'} or exists $state->{recursive_anchor_uri};
190              
191             # record the canonical location of the current position, to be used against future resolution
192             # of a $recursiveRef uri -- as if it was the current location when we encounter a $ref.
193 97         1155 $state->{recursive_anchor_uri} = canonical_uri($state);
194 97         388 return 1;
195             }
196              
197 227     227   1068 sub _traverse_keyword_dynamicAnchor { goto \&_traverse_keyword_anchor }
198              
199             # we already indexed the $dynamicAnchor uri, so there is nothing more to do at evaluation time.
200             # we explicitly do NOT set $state->{initial_schema_uri}.
201              
202 2939     2939   5797 sub _traverse_keyword_ref ($self, $schema, $state) {
  2939         5584  
  2939         4552  
  2939         4580  
  2939         4855  
203 2939 100 66     7981 return if not assert_keyword_type($state, $schema, 'string')
204             or not assert_uri_reference($state, $schema);
205 2911         11347 return 1;
206             }
207              
208 3547     3547   6952 sub _eval_keyword_ref ($self, $data, $schema, $state) {
  3547         6831  
  3547         6314  
  3547         6423  
  3547         5582  
  3547         6133  
209 3547         13230 my $uri = Mojo::URL->new($schema->{'$ref'})->to_abs($state->{initial_schema_uri});
210 3547         2067437 $self->eval_subschema_at_uri($data, $schema, $state, $uri);
211             }
212              
213 197     197   889 sub _traverse_keyword_recursiveRef { goto \&_traverse_keyword_ref }
214              
215 123     123   309 sub _eval_keyword_recursiveRef ($self, $data, $schema, $state) {
  123         271  
  123         255  
  123         210  
  123         223  
  123         180  
216 123         445 my $uri = Mojo::URL->new($schema->{'$recursiveRef'})->to_abs($state->{initial_schema_uri});
217 123         59200 my $schema_info = $state->{evaluator}->_fetch_from_uri($uri);
218 123 50       582 abort($state, 'EXCEPTION: unable to find resource %s', $uri) if not $schema_info;
219              
220 123 100 100     520 if (is_type('boolean', $schema_info->{schema}{'$recursiveAnchor'}) and $schema_info->{schema}{'$recursiveAnchor'}) {
221             $uri = Mojo::URL->new($schema->{'$recursiveRef'})
222 82   33     2391 ->to_abs($state->{recursive_anchor_uri} // $state->{initial_schema_uri});
223             }
224              
225 123         40597 return $self->eval_subschema_at_uri($data, $schema, $state, $uri);
226             }
227              
228 183     183   870 sub _traverse_keyword_dynamicRef { goto \&_traverse_keyword_ref }
229              
230 207     207   483 sub _eval_keyword_dynamicRef ($self, $data, $schema, $state) {
  207         384  
  207         403  
  207         328  
  207         382  
  207         306  
231 207         867 my $uri = Mojo::URL->new($schema->{'$dynamicRef'})->to_abs($state->{initial_schema_uri});
232 207         108115 my $schema_info = $state->{evaluator}->_fetch_from_uri($uri);
233 207 50       21653 abort($state, 'EXCEPTION: unable to find resource %s', $uri) if not $schema_info;
234              
235             # If the initially resolved starting point URI includes a fragment that was created by the
236             # "$dynamicAnchor" keyword, ...
237 207 100 100     671 if (length $uri->fragment and exists $schema_info->{schema}{'$dynamicAnchor'}
      100        
238             and $uri->fragment eq (my $anchor = $schema_info->{schema}{'$dynamicAnchor'})) {
239             # ...the initial URI MUST be replaced by the URI (including the fragment) for the outermost
240             # schema resource in the dynamic scope that defines an identically named fragment with
241             # "$dynamicAnchor".
242 177         2859 foreach my $base_scope ($state->{dynamic_scope}->@*) {
243 279         888 my $test_uri = Mojo::URL->new($base_scope)->fragment($anchor);
244 279         79123 my $dynamic_anchor_subschema_info = $state->{evaluator}->_fetch_from_uri($test_uri);
245 279 100 100     47310 if (($dynamic_anchor_subschema_info->{schema}->{'$dynamicAnchor'}//'') eq $anchor) {
246 168         1109 $uri = $test_uri;
247 168         823 last;
248             }
249             }
250             }
251              
252 207         1405 return $self->eval_subschema_at_uri($data, $schema, $state, $uri);
253             }
254              
255 138     138   337 sub _traverse_keyword_vocabulary ($self, $schema, $state) {
  138         283  
  138         276  
  138         246  
  138         240  
256 138 50       480 return if not assert_keyword_type($state, $schema, 'object');
257              
258             return E($state, '$vocabulary can only appear at the schema resource root')
259 138 100       622 if length($state->{schema_path});
260              
261 137         297 my $valid = 1;
262              
263 137         253 my @vocabulary_classes;
264 137         800 foreach my $uri (sort keys $schema->{'$vocabulary'}->%*) {
265 265 100       3465 $valid = 0, next if not assert_keyword_type({ %$state, _schema_path_suffix => $uri }, $schema, 'boolean');
266 262 100       5921 $valid = 0, next if not assert_uri({ %$state, _schema_path_suffix => $uri }, undef, $uri);
267             }
268              
269             # we cannot return an error here for invalid or incomplete vocabulary lists, because
270             # - the specification vocabulary schemas themselves don't list Core,
271             # - it is possible for a metaschema to $ref to another metaschema that uses an unrecognized
272             # vocabulary uri while still validating those vocabulary keywords (e.g.
273             # https://spec.openapis.org/oas/3.1/schema-base/2021-05-20)
274             # Instead, we will verify these constraints when we actually use the metaschema, in
275             # _traverse_keyword_schema -> __fetch_vocabulary_data
276              
277 137         737 return $valid;
278             }
279              
280             # we do nothing with $vocabulary yet at evaluation time. When we know we are in a metaschema,
281             # we can scan the URIs included here and either abort if a vocabulary is enabled that we do not
282             # understand, or turn on and off certain keyword behaviours based on the boolean values seen.
283              
284 442     442   888 sub _traverse_keyword_comment ($self, $schema, $state) {
  442         929  
  442         831  
  442         739  
  442         836  
285 442 50       1404 return if not assert_keyword_type($state, $schema, 'string');
286 442         1369 return 1;
287             }
288              
289             # we do nothing with $comment at evaluation time, including not collecting its value for annotations.
290              
291 230     230   1154 sub _traverse_keyword_definitions { shift->traverse_object_schemas(@_) }
292 998     998   5777 sub _traverse_keyword_defs { shift->traverse_object_schemas(@_) }
293              
294             # we do nothing directly with $defs at evaluation time, including not collecting its value for
295             # annotations.
296              
297              
298             # translate vocabulary URIs into classes, caching the results (if any)
299 43     43   112 sub __fetch_vocabulary_data ($self, $state, $schema_info) {
  43         93  
  43         91  
  43         81  
  43         85  
300 43 100       200 if (not exists $schema_info->{schema}{'$vocabulary'}) {
301             # "If "$vocabulary" is absent, an implementation MAY determine behavior based on the meta-schema
302             # if it is recognized from the URI value of the referring schema's "$schema" keyword."
303 2         14 my $metaschema_uri = $state->{evaluator}->METASCHEMA_URIS->{$schema_info->{specification_version}};
304 2         48 return $state->{evaluator}->_get_metaschema_vocabulary_classes($metaschema_uri)->@*;
305             }
306              
307 41         120 my $valid = 1;
308 41 100       157 $valid = E($state, '$vocabulary can only appear at the document root') if length $schema_info->{document_path};
309 41 100       165 $valid = E($state, 'metaschemas must have an $id') if not exists $schema_info->{schema}{'$id'};
310              
311 41 100       155 return (undef, []) if not $valid;
312              
313 39         82 my @vocabulary_classes;
314              
315 39         259 foreach my $uri (sort keys $schema_info->{schema}{'$vocabulary'}->%*) {
316 78         1725 my $class_info = $state->{evaluator}->_get_vocabulary_class($uri);
317             $valid = E({ %$state, _schema_path_suffix => $uri }, '"%s" is not a known vocabulary', $uri), next
318 78 100 100     15736 if $schema_info->{schema}{'$vocabulary'}{$uri} and not $class_info;
319              
320 70 100       918 next if not $class_info; # vocabulary is not known, but marked as false in the metaschema
321              
322 62         223 my ($spec_version, $class) = @$class_info;
323             $valid = E({ %$state, _schema_path_suffix => $uri }, '"%s" uses %s, but the metaschema itself uses %s',
324             $uri, $spec_version, $schema_info->{specification_version}), next
325 62 100       255 if $spec_version ne $schema_info->{specification_version};
326              
327 57         170 push @vocabulary_classes, $class;
328             }
329              
330             @vocabulary_classes = sort {
331 39 50       234 $a->evaluation_order <=> $b->evaluation_order
  27 50       136  
332             || ($a->evaluation_order == 999 ? 0
333             : ($valid = E($state, '%s and %s have a conflicting evaluation_order', sort $a, $b)))
334             } @vocabulary_classes;
335              
336 39 100 100     216 $valid = E($state, 'the first vocabulary (by evaluation_order) must be Core')
337             if ($vocabulary_classes[0]//'') ne 'JSON::Schema::Modern::Vocabulary::Core';
338              
339             $state->{evaluator}->_set_metaschema_vocabulary_classes($schema_info->{canonical_uri},
340 39 100       700 [ $schema_info->{specification_version}, \@vocabulary_classes ]) if $valid;
341              
342 39 100       11844 return ($schema_info->{specification_version}, $valid ? \@vocabulary_classes : []);
343             }
344              
345             1;
346              
347             __END__
348              
349             =pod
350              
351             =encoding UTF-8
352              
353             =head1 NAME
354              
355             JSON::Schema::Modern::Vocabulary::Core - Implementation of the JSON Schema Core vocabulary
356              
357             =head1 VERSION
358              
359             version 0.571
360              
361             =head1 DESCRIPTION
362              
363             =for Pod::Coverage vocabulary evaluation_order keywords
364              
365             =for stopwords metaschema
366              
367             Implementation of the JSON Schema Draft 2020-12 "Core" vocabulary, indicated in metaschemas
368             with the URI C<https://json-schema.org/draft/2020-12/vocab/core> and formally specified in
369             L<https://json-schema.org/draft/2020-12/json-schema-core.html#section-8>.
370              
371             Support is also provided for
372              
373             =over 4
374              
375             =item *
376              
377             the equivalent Draft 2019-09 keywords, indicated in metaschemas with the URI C<https://json-schema.org/draft/2019-09/vocab/core> and formally specified in L<https://datatracker.ietf.org/doc/html/draft-handrews-json-schema-02#section-8>.
378              
379             =item *
380              
381             the equivalent Draft 7 keywords that correspond to this vocabulary and are formally specified in L<https://datatracker.ietf.org/doc/html/draft-handrews-json-schema-01>.
382              
383             =back
384              
385             =for stopwords OpenAPI
386              
387             =head1 SUPPORT
388              
389             Bugs may be submitted through L<https://github.com/karenetheridge/JSON-Schema-Modern/issues>.
390              
391             I am also usually active on irc, as 'ether' at C<irc.perl.org> and C<irc.libera.chat>.
392              
393             You can also find me on the L<JSON Schema Slack server|https://json-schema.slack.com> and L<OpenAPI Slack
394             server|https://open-api.slack.com>, which are also great resources for finding help.
395              
396             =head1 AUTHOR
397              
398             Karen Etheridge <ether@cpan.org>
399              
400             =head1 COPYRIGHT AND LICENCE
401              
402             This software is copyright (c) 2020 by Karen Etheridge.
403              
404             This is free software; you can redistribute it and/or modify it under
405             the same terms as the Perl 5 programming language system itself.
406              
407             =cut