kibi-core 0.6.0 → 0.6.1

package/package.json

@@ -1,6 +1,6 @@
 {
   "name": "kibi-core",
-  "version": "0.6.0",
+  "version": "0.6.1",
   "private": false,
   "description": "Core Prolog modules and RDF graph logic for Kibi",
   "type": "module",

package/src/derived_chr.pl

@@ -0,0 +1,65 @@
+% Module: derived_chr
+% Internal CHR pilot for bounded derived validation facts.
+
+:- module(derived_chr, [
+    derive_chr_facts/0,
+    clear_chr_facts/0,
+    derived_coverage_gap/2,
+    derived_symbol_gap/2
+]).
+
+:- use_module(library(chr)).
+:- use_module('kb.pl').
+
+:- chr_constraint seen_must_req/1, seen_scenario/1, seen_test/1,
+    seen_production_symbol/1, seen_symbol_req_coverage/1.
+
+:- dynamic derived_coverage_gap/2.
+:- dynamic derived_symbol_gap/2.
+:- dynamic snapshot_must_req/1.
+:- dynamic snapshot_scenario/1.
+:- dynamic snapshot_test/1.
+:- dynamic snapshot_production_symbol/1.
+:- dynamic snapshot_symbol_req_coverage/1.
+
+seen_must_req(Req) <=> assertz(snapshot_must_req(Req)).
+seen_scenario(Req) <=> assertz(snapshot_scenario(Req)).
+seen_test(Req) <=> assertz(snapshot_test(Req)).
+seen_production_symbol(Symbol) <=> assertz(snapshot_production_symbol(Symbol)).
+seen_symbol_req_coverage(Symbol) <=> assertz(snapshot_symbol_req_coverage(Symbol)).
+
+clear_chr_facts :-
+    retractall(derived_coverage_gap(_, _)),
+    retractall(derived_symbol_gap(_, _)),
+    retractall(snapshot_must_req(_)),
+    retractall(snapshot_scenario(_)),
+    retractall(snapshot_test(_)),
+    retractall(snapshot_production_symbol(_)),
+    retractall(snapshot_symbol_req_coverage(_)).
+
+derive_chr_facts :-
+    clear_chr_facts,
+    forall(kb:must_requirement(Req), seen_must_req(Req)),
+    forall(kb:has_scenario(Req), seen_scenario(Req)),
+    forall(kb:has_test(Req), seen_test(Req)),
+    forall(kb:production_symbol(Symbol), seen_production_symbol(Symbol)),
+    forall(kb:production_symbol_covered_for_requirement(Symbol, _), seen_symbol_req_coverage(Symbol)),
+    derive_coverage_gaps,
+    derive_symbol_gaps.
+
+derive_coverage_gaps :-
+    forall(
+        (   snapshot_must_req(Req),
+            \+ snapshot_scenario(Req),
+            \+ snapshot_test(Req)
+        ),
+        assertz(derived_coverage_gap(Req, missing_scenario_and_test))
+    ).
+
+derive_symbol_gaps :-
+    forall(
+        (   snapshot_production_symbol(Symbol),
+            \+ snapshot_symbol_req_coverage(Symbol)
+        ),
+        assertz(derived_symbol_gap(Symbol, no_qualifying_production_coverage))
+    ).

package/src/discovery.pl

@@ -8,6 +8,7 @@
 ]).
 
 :- use_module(library(http/json)).
+:- use_module(library(aggregate)).
 :- use_module('kb.pl').
 :- use_module('status.pl', [status_meta_dict/1]).
 :- use_module('../schema/relationships.pl', [relationship_type/1]).
@@ -90,10 +91,9 @@ relationship_counts(Id, CountsDict) :-
     dict_pairs(CountsDict, relationship_counts, Pairs).
 
 relationship_count(Id, Relationship, Count) :-
-    findall(1,
+    aggregate_all(count,
         (kb_relationship(Relationship, Id, _); kb_relationship(Relationship, _, Id)),
-        Matches),
-    length(Matches, Count).
+        Count).
 
 coverage_rows(req, Tags, IncludePassing, IncludeTransitive, Rows, Summary) :-
     !,

package/src/sparql_client.pl

@@ -0,0 +1,150 @@
+% Module: kibi_sparql_client
+% Explicit remote SPARQL client wrapper.
+
+:- module(kibi_sparql_client, [
+    remote_sparql_select_json/4
+]).
+
+:- use_module(library(error)).
+:- use_module(library(http/json)).
+:- use_module(library(semweb/sparql_client)).
+
+remote_sparql_select_json(Endpoint, Query, Options, JsonString) :-
+    validate_non_empty_atom(endpoint, Endpoint),
+    validate_non_empty_atom(query, Query),
+    validate_remote_endpoint(Endpoint),
+    validate_select_query(Query),
+    validate_sparql_options(Options, SparqlOptions),
+    sparql_query(Query, Rows, [endpoint(Endpoint), variable_names(Variables)|SparqlOptions]),
+    maplist(row_json(Variables), Rows, JsonRows),
+    with_output_to(string(JsonString), json_write_dict(current_output, _{rows: JsonRows}, [])).
+
+validate_non_empty_atom(Name, Value) :-
+    must_be(atom, Value),
+    (   Value == ''
+    ->  throw(error(domain_error(non_empty_atom, Name), _))
+    ;   true
+    ).
+
+validate_remote_endpoint(Endpoint) :-
+    (   sub_atom(Endpoint, 0, _, _, 'http://')
+    ;   sub_atom(Endpoint, 0, _, _, 'https://')
+    ),
+    endpoint_host(Endpoint, Host),
+    \+ local_or_private_host(Host),
+    !.
+validate_remote_endpoint(Endpoint) :-
+    (   sub_atom(Endpoint, 0, _, _, 'http://')
+    ;   sub_atom(Endpoint, 0, _, _, 'https://')
+    ),
+    !,
+    throw(error(domain_error(public_remote_endpoint, Endpoint), _)).
+validate_remote_endpoint(Endpoint) :-
+    throw(error(domain_error(remote_http_endpoint, Endpoint), _)).
+
+validate_select_query(Query) :-
+    normalize_space(atom(Normalized), Query),
+    downcase_atom(Normalized, Lower),
+    sub_atom(Lower, 0, 6, After, 'select'),
+    (   After =:= 0
+    ;   sub_atom(Lower, 6, 1, _, ' ')
+    ;   sub_atom(Lower, 6, 1, _, '*')
+    ),
+    !.
+validate_select_query(Query) :-
+    throw(error(domain_error(sparql_select_query, Query), _)).
+
+endpoint_host(Endpoint, Host) :-
+    strip_endpoint_scheme(Endpoint, WithoutScheme),
+    segment_before(WithoutScheme, '/', WithoutPath),
+    segment_before(WithoutPath, '?', WithoutQuery),
+    segment_before(WithoutQuery, '#', Authority),
+    strip_userinfo(Authority, HostWithPort),
+    strip_port(HostWithPort, Host0),
+    downcase_atom(Host0, Host).
+
+strip_endpoint_scheme(Endpoint, WithoutScheme) :-
+    sub_atom(Endpoint, 0, 7, _, 'http://'),
+    !,
+    sub_atom(Endpoint, 7, _, 0, WithoutScheme).
+strip_endpoint_scheme(Endpoint, WithoutScheme) :-
+    sub_atom(Endpoint, 0, 8, _, 'https://'),
+    sub_atom(Endpoint, 8, _, 0, WithoutScheme).
+
+segment_before(Atom, Delimiter, Segment) :-
+    sub_atom(Atom, Before, _, _, Delimiter),
+    !,
+    sub_atom(Atom, 0, Before, _, Segment).
+segment_before(Atom, _Delimiter, Atom).
+
+strip_userinfo(Authority, HostWithPort) :-
+    sub_atom(Authority, _, _, After, '@'),
+    !,
+    sub_atom(Authority, _, After, 0, HostWithPort).
+strip_userinfo(Authority, Authority).
+
+strip_port(HostWithPort, Host) :-
+    sub_atom(HostWithPort, 0, 1, _, '['),
+    sub_atom(HostWithPort, 1, Length, _, ']'),
+    !,
+    sub_atom(HostWithPort, 1, Length, _, Host).
+strip_port(HostWithPort, Host) :-
+    segment_before(HostWithPort, ':', Host).
+
+local_or_private_host(localhost).
+local_or_private_host('0.0.0.0').
+local_or_private_host('::1').
+local_or_private_host(Host) :-
+    sub_atom(Host, _, _, 0, '.localhost').
+local_or_private_host(Host) :-
+    sub_atom(Host, 0, _, _, '127.').
+local_or_private_host(Host) :-
+    sub_atom(Host, 0, _, _, '10.').
+local_or_private_host(Host) :-
+    sub_atom(Host, 0, _, _, '192.168.').
+local_or_private_host(Host) :-
+    sub_atom(Host, 0, _, _, '169.254.').
+local_or_private_host(Host) :-
+    sub_atom(Host, 0, _, _, 'fe80:').
+local_or_private_host(Host) :-
+    sub_atom(Host, 0, 2, _, Prefix),
+    memberchk(Prefix, ['fc', 'fd']).
+local_or_private_host(Host) :-
+    sub_atom(Host, 0, _, _, '172.'),
+    atomic_list_concat([_, SecondAtom|_], '.', Host),
+    atom_number(SecondAtom, Second),
+    Second >= 16,
+    Second =< 31.
+
+validate_sparql_options([], []).
+validate_sparql_options([result_format(json)|Rest], SparqlOptions) :-
+    !,
+    validate_sparql_options(Rest, SparqlOptions).
+validate_sparql_options([timeout(Timeout)|Rest], [timeout(Timeout)|SparqlOptions]) :-
+    !,
+    validate_sparql_options(Rest, SparqlOptions).
+validate_sparql_options([Option|_], _) :-
+    throw(error(domain_error(sparql_client_option, Option), _)).
+
+row_json(Variables, Row, Dict) :-
+    Row =.. [row|Values],
+    pairs_json(Variables, Values, Pairs),
+    dict_create(Dict, row, Pairs).
+
+pairs_json([], [], []).
+pairs_json([Variable|Variables], [Value|Values], [Variable-JsonValue|Pairs]) :-
+    sparql_value_json(Value, JsonValue),
+    pairs_json(Variables, Values, Pairs).
+
+sparql_value_json(Value, JsonValue) :-
+    atomic(Value),
+    !,
+    JsonValue = Value.
+sparql_value_json(literal(Value), JsonValue) :-
+    !,
+    sparql_value_json(Value, JsonValue).
+sparql_value_json(type(_Type, Value), JsonValue) :-
+    !,
+    sparql_value_json(Value, JsonValue).
+sparql_value_json(Value, JsonValue) :-
+    term_string(Value, JsonValue).