kibi-core 0.22.5 → 0.24.0

package/src/claim_obligations.pl

@@ -0,0 +1,378 @@
+% Module: claim_obligations
+% implements REQ-kibi-claim-bound-proofs
+%
+% What a certificate has to establish for it to prove one requirement claim.
+% A claim is grounded by exactly one typed fact; the obligation is derived
+% from that fact, so a certificate proves the claim's own content instead of
+% a label its test chose:
+%
+%   set fact (value_type set, or the legacy allowed_values string "a|b|c")
+%       exhaustive, typecheck  the domain is exactly the fact's set
+%   numeric fact (value_type int or number, a comparison operator)
+%       arithmetic, smt        the certificate's claim is the fact's constraint
+%                              (negated for polarity forbid)
+%
+% Any other pairing that appears in the table with a different proof kind is
+% incompatible (a set fact under arithmetic, a numeric fact under
+% exhaustive).  A fact kind with no derivation at all (boolean placeholders,
+% predicates, rules, other strings) can only be attested: the test author
+% says the certificate expresses the claim, and Kibi never counts that as
+% proved.
+
+:- module(claim_obligations, [
+    claim_obligation/3,
+    fact_obligation/3,
+    obligation_equal/2,
+    proof_contract_claim_candidates_json/1,
+    proof_contract_claim_issues_json/1,
+    test_claim_obligations_json/4
+]).
+
+:- use_module(library(http/json)).
+:- use_module(library(apply)).
+:- use_module(library(lists)).
+:- use_module('kb.pl').
+
+%% fact_obligation(+FactId, +ProofKind, -Result)
+% Result is obligation(Dict), attested, or incompatible(Reason).
+fact_obligation(FactId, ProofKind, Result) :-
+    (   fact_set(FactId, Members)
+    ->  (   memberchk(ProofKind, [exhaustive, typecheck])
+        ->  Result = obligation(_{kind: "set_equals", members: Members})
+        ;   format(string(Reason),
+                   "~w is a set fact, which an ~w certificate cannot express (use exhaustive or typecheck)",
+                   [FactId, ProofKind]),
+            Result = incompatible(Reason)
+        )
+    ;   fact_numeric_constraint(FactId, Variable, ValueType, Operator, Value)
+    ->  (   memberchk(ProofKind, [arithmetic, smt])
+        ->  Result = obligation(_{kind: "numeric_constraint", variable: Variable,
+                                  value_type: ValueType, operator: Operator, value: Value})
+        ;   (   ProofKind == typecheck -> Article = a ; Article = an ),
+            format(string(Reason),
+                   "~w is a numeric fact, which ~w ~w certificate cannot express (use arithmetic or smt)",
+                   [FactId, Article, ProofKind]),
+            Result = incompatible(Reason)
+        )
+    ;   Result = attested
+    ).
+
+%% claim_obligation(+ReqId, +ClaimKey, +ProofKind, -Result)
+% As fact_obligation/3 for the fact grounding ClaimKey in ReqId, with the
+% fact id: obligation(FactId, Dict), attested(FactId), incompatible(FactId,
+% Reason), or unresolved(Reason) when the claim cannot be named by a proof.
+claim_obligation(ReqId-ClaimKey, ProofKind, Result) :-
+    (   \+ requirement_claim_status(ReqId, ClaimKey, _)
+    ->  format(string(Reason), "~w is not a claim of ~w", [ClaimKey, ReqId]),
+        Result = unresolved(Reason)
+    ;   requirement_claim_status(ReqId, ClaimKey, nonlogical)
+    ->  format(string(Reason),
+               "claim ~w of ~w is nonlogical: a nonlogical span is context, not a claim to prove",
+               [ClaimKey, ReqId]),
+        Result = unresolved(Reason)
+    ;   requirement_claim_status(ReqId, ClaimKey, Status),
+        Status \== modeled
+    ->  format(string(Reason), "claim ~w of ~w is ~w; resolve it before proving it",
+               [ClaimKey, ReqId, Status]),
+        Result = unresolved(Reason)
+    ;   \+ claim_fact(ReqId, ClaimKey, _)
+    ->  format(string(Reason), "claim ~w of ~w has no grounding fact", [ClaimKey, ReqId]),
+        Result = unresolved(Reason)
+    ;   claim_fact(ReqId, ClaimKey, FactId),
+        fact_obligation(FactId, ProofKind, FactResult),
+        (   FactResult = obligation(Dict)
+        ->  Result = obligation(FactId, Dict)
+        ;   FactResult == attested
+        ->  Result = attested(FactId)
+        ;   FactResult = incompatible(Reason)
+        ->  Result = incompatible(FactId, Reason)
+        )
+    ).
+
+%% obligation_equal(+Left, +Right)
+% Two obligations (dicts, possibly read back from a receipt) ask the same.
+obligation_equal(Left, Right) :-
+    obligation_key(Left, Key),
+    obligation_key(Right, Key).
+
+obligation_key(Obligation, set(Members)) :-
+    dict_text(Obligation, kind, "set_equals"),
+    get_dict(members, Obligation, Raw),
+    is_list(Raw),
+    maplist(text_string, Raw, Strings),
+    sort(Strings, Members),
+    !.
+obligation_key(Obligation, numeric(Variable, Type, Operator, Value)) :-
+    dict_text(Obligation, kind, "numeric_constraint"),
+    dict_text(Obligation, variable, Variable),
+    dict_text(Obligation, value_type, Type),
+    dict_text(Obligation, operator, Operator),
+    get_dict(value, Obligation, Raw),
+    number_value(Raw, Value).
+
+dict_text(Dict, Key, String) :-
+    is_dict(Dict),
+    get_dict(Key, Dict, Raw),
+    text_string(Raw, String).
+
+number_value(Raw, Value) :- number(Raw), !, Value is Raw * 1.0.
+number_value(Raw, Value) :-
+    text_string(Raw, String),
+    number_string(Number, String),
+    Value is Number * 1.0.
+
+text_string(Raw, String) :- string(Raw), !, String = Raw.
+text_string(Raw, String) :- atom(Raw), !, atom_string(Raw, String).
+text_string(Raw, String) :- number(Raw), !, number_string(Raw, String).
+text_string(^^(Raw, _), String) :- !, text_string(Raw, String).
+
+% The members of a set fact, sorted and unique.
+fact_set(FactId, Members) :-
+    kb_entity(FactId, fact, Props),
+    prop_atom(Props, fact_kind, property_value),
+    (   prop_atom(Props, value_type, set)
+    ->  memberchk(value_set=Raw, Props),
+        kb:normalize_term_atom_list(Raw, Atoms)
+    ;   prop_atom(Props, property_key, allowed_values),
+        \+ (memberchk(value_type=RawType, Props),
+            kb:normalize_term_atom(RawType, Type),
+            Type \== string),
+        memberchk(value_string=RawValue, Props),
+        kb:unwrap_rdf_value(RawValue, Value),
+        text_string(Value, Joined),
+        split_string(Joined, "|", " ", Parts),
+        exclude(==(""), Parts, NonEmpty),
+        maplist([S, A]>>atom_string(A, S), NonEmpty, Atoms)
+    ),
+    (   prop_atom(Props, operator, Operator) -> Operator == eq ; true ),
+    \+ prop_atom(Props, polarity, forbid),
+    maplist([A, S]>>atom_string(A, S), Atoms, Strings),
+    sort(Strings, Members),
+    Members \== [].
+
+% A numeric property_value fact as one constraint on its property, negated
+% for polarity forbid (forbid gt 5 means the value must be at most 5).
+fact_numeric_constraint(FactId, Variable, ValueType, Operator, Value) :-
+    kb:fact_property_tuple(FactId, _Subject, Property, Op0, Type0, Raw, _Unit, _Scope, Polarity),
+    memberchk(Type0-ValueType, [int-"int", number-"real"]),
+    memberchk(Op0, [eq, neq, lt, lte, gt, gte]),
+    number_value(Raw, Float),
+    (   ValueType == "int", Float =:= truncate(Float)
+    ->  Value is truncate(Float)
+    ;   Value = Float
+    ),
+    (   Polarity == forbid
+    ->  negated_operator(Op0, Op)
+    ;   Op = Op0
+    ),
+    atom_string(Op, Operator),
+    atom_string(Property, Variable).
+
+negated_operator(eq, neq).
+negated_operator(neq, eq).
+negated_operator(lt, gte).
+negated_operator(lte, gt).
+negated_operator(gt, lte).
+negated_operator(gte, lt).
+
+prop_atom(Props, Key, Atom) :-
+    memberchk(Key=Raw, Props),
+    kb:normalize_term_atom(Raw, Atom).
+
+% The status of a claim in the requirement's semantic inventory.
+% With ClaimKey unbound it enumerates the claims; the first entry for a key
+% wins.
+requirement_claim_status(ReqId, ClaimKey, Status) :-
+    nonvar(ClaimKey),
+    !,
+    once(inventory_claim_status(ReqId, ClaimKey, Status0)),
+    Status = Status0.
+requirement_claim_status(ReqId, ClaimKey, Status) :-
+    findall(Key-S, inventory_claim_status(ReqId, Key, S), Pairs),
+    first_per_key(Pairs, [], Unique),
+    member(ClaimKey-Status, Unique).
+
+first_per_key([], Acc, Unique) :- reverse(Acc, Unique).
+first_per_key([Key-S|Rest], Acc, Unique) :-
+    (   memberchk(Key-_, Acc)
+    ->  first_per_key(Rest, Acc, Unique)
+    ;   first_per_key(Rest, [Key-S|Acc], Unique)
+    ).
+
+inventory_claim_status(ReqId, ClaimKey, Status) :-
+    kb_entity(ReqId, req, Props),
+    memberchk(semantic_inventory=Raw, Props),
+    inventory_list(Raw, Entries),
+    member(Entry, Entries),
+    entry_field(Entry, claim_key, RawKey),
+    kb:normalize_term_atom(RawKey, ClaimKey),
+    entry_field(Entry, status, RawStatus),
+    kb:normalize_term_atom(RawStatus, Status).
+
+inventory_list(Raw, Entries) :- is_list(Raw), !, Entries = Raw.
+inventory_list(^^(Raw, _), Entries) :- !, inventory_list(Raw, Entries).
+inventory_list(Raw, Entries) :-
+    (   string(Raw) ; atom(Raw) ),
+    catch(atom_json_dict(Raw, Parsed, [value_string_as(string)]), _, fail),
+    is_list(Parsed),
+    !,
+    Entries = Parsed.
+inventory_list(Raw, Entries) :-
+    (   string(Raw) ; atom(Raw) ),
+    catch(term_string(Parsed, Raw), _, fail),
+    is_list(Parsed),
+    !,
+    Entries = Parsed.
+inventory_list(_, []).
+
+entry_field(Entry, Key, Value) :-
+    is_dict(Entry), !,
+    get_dict(Key, Entry, Value).
+entry_field(Entry, Key, Value) :-
+    is_list(Entry),
+    memberchk(Key=Value, Entry).
+
+% The fact grounding a claim: the same claim_key, linked from the
+% requirement through requires_property, requires_predicate or requires_rule.
+claim_fact(ReqId, ClaimKey, FactId) :-
+    member(Relation, [requires_property, requires_predicate, requires_rule]),
+    kb_relationship(Relation, ReqId, FactId),
+    kb_entity(FactId, fact, Props),
+    prop_atom(Props, claim_key, ClaimKey),
+    !.
+
+% Current requirements a test reaches through the scenarios it verifies.
+test_requirement(TestId, ReqId) :-
+    (   kb_relationship(validates, TestId, ScenarioId)
+    ;   kb_relationship(verified_by, ScenarioId, TestId)
+    ),
+    kb_relationship(specified_by, ReqId, ScenarioId),
+    kb:current_req(ReqId).
+
+%% test_claim_obligations_json(+TestId, +ClaimKeysJson, +ProofKind, -Json)
+% For `kibi prove`: one row per claim key and requirement the test reaches,
+% {claim_key, requirement_id, fact_id?, result, obligation?, reason?}, with
+% result obligation, attested, incompatible or unresolved.  A key no reached
+% requirement declares gives one unresolved row without requirement_id.
+test_claim_obligations_json(TestId0, KeysJson, Kind0, Json) :-
+    kb:normalize_term_atom(TestId0, TestId),
+    kb:normalize_term_atom(Kind0, Kind),
+    atom_json_term(KeysJson, Keys0, []),
+    maplist([K, A]>>(text_string(K, S), atom_string(A, S)), Keys0, Keys),
+    findall(ReqId, test_requirement(TestId, ReqId), ReqIds0),
+    sort(ReqIds0, ReqIds),
+    foldl(key_rows(Kind, ReqIds), Keys, [], RowsRev),
+    reverse(RowsRev, Rows),
+    with_output_to(string(Json), json_write_dict(current_output, Rows, [width(0)])).
+
+key_rows(Kind, ReqIds, Key, Acc0, Acc) :-
+    findall(ReqId,
+        (member(ReqId, ReqIds), requirement_claim_status(ReqId, Key, _)),
+        Owners),
+    atom_string(Key, KeyString),
+    (   Owners == []
+    ->  format(string(Reason),
+               "claim ~w is not a claim of any current requirement this test reaches through its scenarios",
+               [Key]),
+        Acc = [_{claim_key: KeyString, result: "unresolved", reason: Reason}|Acc0]
+    ;   foldl(owner_row(Kind, Key, KeyString), Owners, Acc0, Acc)
+    ).
+
+owner_row(Kind, Key, KeyString, ReqId, Acc0, [Row|Acc0]) :-
+    atom_string(ReqId, ReqString),
+    claim_obligation(ReqId-Key, Kind, Result),
+    Base = _{claim_key: KeyString, requirement_id: ReqString},
+    (   Result = obligation(FactId, Obligation)
+    ->  atom_string(FactId, FactString),
+        Row = Base.put(_{result: "obligation", fact_id: FactString, obligation: Obligation})
+    ;   Result = attested(FactId)
+    ->  atom_string(FactId, FactString),
+        Row = Base.put(_{result: "attested", fact_id: FactString})
+    ;   Result = incompatible(FactId, Reason)
+    ->  atom_string(FactId, FactString),
+        Row = Base.put(_{result: "incompatible", fact_id: FactString, reason: Reason})
+    ;   Result = unresolved(Reason),
+        Row = Base.put(_{result: "unresolved", reason: Reason})
+    ).
+
+%% proof_contract_claim_issues_json(-Json)
+% For the proof-contract-claims rule: one row {test_id, claim_key?, reason}
+% per certificate-kind proof contract that names no claims in proves, and
+% per claim key it names that no certificate of its kind could prove
+% (not a modeled claim of a reached requirement, no grounding fact, or a
+% fact the kind cannot express).  An attested claim is not an issue here:
+% it is reported as attested, and never counts as proved.
+proof_contract_claim_issues_json(Json) :-
+    findall(Row, proof_contract_claim_issue(Row), Rows0),
+    sort(Rows0, Rows),
+    with_output_to(string(Json), json_write_dict(current_output, Rows, [width(0)])).
+
+certificate_kind(exhaustive).
+certificate_kind(typecheck).
+certificate_kind(arithmetic).
+certificate_kind(smt).
+
+test_certificate_contract(TestId, Kind, Contract) :-
+    kb_entity(TestId, test, Props),
+    memberchk(proof_contract=Raw, Props),
+    contract_dict(Raw, Contract),
+    get_dict(kind, Contract, RawKind),
+    text_string(RawKind, KindString),
+    atom_string(Kind, KindString),
+    certificate_kind(Kind).
+
+contract_dict(^^(Raw, _), Dict) :- !, contract_dict(Raw, Dict).
+contract_dict(Dict, Dict) :- is_dict(Dict), !.
+contract_dict(Raw, Dict) :-
+    (   atom(Raw) ; string(Raw) ),
+    catch(atom_json_dict(Raw, Dict, [value_string_as(string)]), _, fail),
+    is_dict(Dict).
+
+proof_contract_claim_issue(_{test_id: TestString, reason: Reason}) :-
+    test_certificate_contract(TestId, Kind, Contract),
+    \+ ( get_dict(proves, Contract, Proves), is_list(Proves), Proves \== [] ),
+    atom_string(TestId, TestString),
+    format(string(Reason),
+           "the ~w proof contract names no claims in proves, so its certificate proves nothing about a requirement",
+           [Kind]).
+proof_contract_claim_issue(_{test_id: TestString, claim_key: KeyString, reason: Reason}) :-
+    test_certificate_contract(TestId, Kind, Contract),
+    get_dict(proves, Contract, Proves),
+    is_list(Proves),
+    Proves \== [],
+    atom_json_term(KeysJson, Proves, []),
+    test_claim_obligations_json(TestId, KeysJson, Kind, RowsJson),
+    atom_json_dict(RowsJson, Rows, [value_string_as(string)]),
+    member(Row, Rows),
+    get_dict(result, Row, Result),
+    memberchk(Result, ["unresolved", "incompatible"]),
+    atom_string(TestId, TestString),
+    get_dict(claim_key, Row, KeyString),
+    get_dict(reason, Row, Reason).
+
+%% proof_contract_claim_candidates_json(-Json)
+% For the schema 12 migration: one row {test_id, kind, candidates} per
+% certificate-kind proof contract without proves, where candidates are the
+% claims {claim_key, requirement_id, fact_id} of current requirements the
+% test reaches whose grounding fact derives an obligation for its kind.  The
+% migration pins proves only when exactly one claim is a candidate.
+proof_contract_claim_candidates_json(Json) :-
+    findall(Row, proof_contract_claim_candidates(Row), Rows0),
+    sort(Rows0, Rows),
+    with_output_to(string(Json), json_write_dict(current_output, Rows, [width(0)])).
+
+proof_contract_claim_candidates(_{test_id: TestString, kind: KindString, candidates: Candidates}) :-
+    test_certificate_contract(TestId, Kind, Contract),
+    \+ ( get_dict(proves, Contract, Proves), is_list(Proves), Proves \== [] ),
+    findall(_{claim_key: KeyString, requirement_id: ReqString, fact_id: FactString},
+        (   test_requirement(TestId, ReqId),
+            requirement_claim_status(ReqId, ClaimKey, modeled),
+            claim_obligation(ReqId-ClaimKey, Kind, obligation(FactId, _)),
+            atom_string(ClaimKey, KeyString),
+            atom_string(ReqId, ReqString),
+            atom_string(FactId, FactString)
+        ),
+        Candidates0),
+    sort(Candidates0, Candidates),
+    atom_string(TestId, TestString),
+    atom_string(Kind, KindString).

package/src/code_certificates.pl

@@ -0,0 +1,297 @@
+% Module: code_certificates
+% implements REQ-kibi-code-proof-kinds
+%
+% Re-checks the kibi.code-certificate.v1 a certificate-kind proof contract
+% leaves in its receipt.  A receipt counts as proved only when its
+% certificate re-checks here, so a test that claims to have covered every
+% case cannot earn proved by saying so.  The checks never search:
+%
+%   exhaustive  The domain lists at least one member, no member twice, and
+%               the results name every member exactly once, each passed.
+%               (Kibi checks at ingest that the proof imported the domain
+%               from its source instead of hand-listing it.)
+%   typecheck   The witness names a file and its sha256 and the compiler
+%               that accepted it; the outcome is passed.  (Kibi checks at
+%               ingest that the witness is the file in the workspace and
+%               imports the domain.)
+%   arithmetic  The assumptions on one variable are satisfiable and entail
+%               the claim, decided exactly by intervals.pl: the assumptions
+%               plus the negated claim admit no value.
+%   smt         The query asks (check-sat) and the solver answered unsat.
+%               (Kibi re-runs the solver on the query at ingest.)
+%
+% The digest a receipt records is the sha256 of the certificate's canonical
+% JSON as canonical_json/2 below spells it. The CLI records the digest this
+% module returns at ingest, so ingest and every later re-check hash the
+% certificate the same way.
+
+:- module(code_certificates, [
+    code_certificate_check/2,
+    code_certificate_digest/2,
+    code_certificate_check_json/2
+]).
+
+:- use_module(library(http/json)).
+:- use_module(library(crypto)).
+:- use_module(library(apply)).
+:- use_module(library(lists)).
+:- use_module('intervals.pl', [
+    numeric_constraints_satisfiable/2,
+    numeric_constraint_entailed/3
+]).
+
+code_certificate_version("kibi.code-certificate.v1").
+
+%% code_certificate_check(+Certificate, -Result)
+% Result is ok or rejected(Reason) with Reason a string naming what failed.
+code_certificate_check(Certificate, Result) :-
+    (   catch(certificate_problem(Certificate, Reason), _, (Reason = "the certificate is malformed"))
+    ->  Result = rejected(Reason)
+    ;   Result = ok
+    ).
+
+%% code_certificate_digest(+Certificate, -Digest)
+code_certificate_digest(Certificate, Digest) :-
+    canonical_json(Certificate, Json),
+    crypto_data_hash(Json, Digest, [algorithm(sha256), encoding(utf8)]).
+
+%% code_certificate_check_json(+CertificateJson, -ResultJson)
+% Entry point for the CLI: {"accepted": true, "digest": D} or
+% {"accepted": false, "reason": R}.
+code_certificate_check_json(CertificateJson, ResultJson) :-
+    (   catch(atom_json_dict(CertificateJson, Certificate, [value_string_as(string)]), _, fail),
+        is_dict(Certificate)
+    ->  code_certificate_check(Certificate, Result),
+        code_certificate_digest(Certificate, Digest),
+        (   Result == ok
+        ->  Out = _{accepted: true, digest: Digest}
+        ;   Result = rejected(Reason),
+            Out = _{accepted: false, digest: Digest, reason: Reason}
+        )
+    ;   Out = _{accepted: false, reason: "the certificate is not a JSON object"}
+    ),
+    with_output_to(string(ResultJson), json_write_dict(current_output, Out, [width(0)])).
+
+% certificate_problem(+Certificate, -Reason) succeeds with the first problem.
+certificate_problem(Certificate, Reason) :-
+    \+ is_dict(Certificate), !,
+    Reason = "the certificate is not an object".
+certificate_problem(Certificate, Reason) :-
+    code_certificate_version(Version),
+    \+ get_dict(version, Certificate, Version), !,
+    format(string(Reason), "the certificate version is not ~w", [Version]).
+certificate_problem(Certificate, Reason) :-
+    \+ (get_dict(test_id, Certificate, TestId), nonempty_string(TestId)), !,
+    Reason = "the certificate names no test_id".
+certificate_problem(Certificate, Reason) :-
+    (   get_dict(kind, Certificate, KindString), string(KindString)
+    ->  atom_string(Kind, KindString)
+    ;   Kind = none
+    ),
+    (   kind_problem(Kind, Certificate, Reason0)
+    ->  Reason = Reason0
+    ;   \+ memberchk(Kind, [exhaustive, typecheck, arithmetic, smt])
+    ->  Reason = "the certificate kind is not exhaustive, typecheck, arithmetic or smt"
+    ).
+
+kind_problem(exhaustive, Certificate, Reason) :-
+    field(Certificate, domain, Domain),
+    field(Domain, symbol_id, Symbol),
+    field(Domain, members, Members),
+    field(Certificate, results, Results),
+    (   \+ is_dict(Domain)
+    ->  Reason = "the certificate has no domain"
+    ;   \+ nonempty_string(Symbol)
+    ->  Reason = "the domain names no symbol_id"
+    ;   \+ (is_list(Members), Members \== [])
+    ->  Reason = "the domain lists no members"
+    ;   \+ maplist(nonempty_string, Members)
+    ->  Reason = "every domain member must be a non-empty string"
+    ;   msort(Members, Sorted), sort(Members, Unique), Sorted \== Unique
+    ->  Reason = "the domain lists a member twice"
+    ;   \+ is_list(Results)
+    ->  Reason = "the certificate has no results"
+    ;   \+ maplist(result_row, Results)
+    ->  Reason = "every result must name a member and an outcome"
+    ;   findall(M, (member(Row, Results), get_dict(member, Row, M)), Named),
+        msort(Named, NamedSorted),
+        msort(Members, MembersSorted),
+        NamedSorted \== MembersSorted
+    ->  Reason = "the results do not name every domain member exactly once"
+    ;   member(Row, Results),
+        get_dict(outcome, Row, Outcome),
+        Outcome \== "passed"
+    ->  get_dict(member, Row, Failed),
+        format(string(Reason), "member ~w did not pass", [Failed])
+    ).
+kind_problem(typecheck, Certificate, Reason) :-
+    field(Certificate, witness, Witness),
+    field(Witness, path, Path),
+    field(Witness, sha256, Hash),
+    field(Certificate, domain, Domain),
+    field(Domain, symbol_id, Symbol),
+    field(Certificate, compiler, Compiler),
+    field(Compiler, name, Name),
+    field(Compiler, version, CompilerVersion),
+    field(Certificate, outcome, Outcome),
+    (   \+ nonempty_string(Path)
+    ->  Reason = "the certificate names no witness path"
+    ;   \+ sha256_string(Hash)
+    ->  Reason = "the witness has no sha256"
+    ;   \+ nonempty_string(Symbol)
+    ->  Reason = "the certificate names no domain symbol_id"
+    ;   \+ (nonempty_string(Name), nonempty_string(CompilerVersion))
+    ->  Reason = "the certificate names no compiler and version"
+    ;   Outcome \== "passed"
+    ->  Reason = "the type checker did not accept the witness"
+    ).
+kind_problem(arithmetic, Certificate, Reason) :-
+    field(Certificate, variable, Variable),
+    field(Certificate, value_type, Type),
+    field(Certificate, assumptions, Assumptions),
+    field(Certificate, claim, Claim),
+    (   \+ nonempty_string(Variable)
+    ->  Reason = "the certificate names no variable"
+    ;   \+ memberchk(Type, ["int", "real"])
+    ->  Reason = "value_type must be int or real"
+    ;   \+ (is_list(Assumptions), Assumptions \== [])
+    ->  Reason = "the certificate states no assumptions"
+    ;   \+ maplist(arithmetic_constraint(_), Assumptions, _)
+    ->  Reason = "every assumption must be {operator, value} with a comparison operator and a number"
+    ;   \+ arithmetic_constraint(_, Claim, _)
+    ->  Reason = "the claim must be {operator, value} with a comparison operator and a number"
+    ;   maplist(arithmetic_constraint(X), Assumptions, Premises),
+        arithmetic_constraint(X, Claim, Goal),
+        integer_variables(Type, X, Integers),
+        (   \+ numeric_constraints_satisfiable(Premises, Integers)
+        ->  Reason = "the assumptions admit no value, so the claim holds vacuously"
+        ;   \+ numeric_constraint_entailed(Premises, Goal, Integers)
+        ->  Reason = "the assumptions do not entail the claim: some value satisfies them and breaks it"
+        )
+    ).
+kind_problem(smt, Certificate, Reason) :-
+    field(Certificate, solver, Solver),
+    field(Solver, name, Name),
+    field(Solver, version, SolverVersion),
+    field(Certificate, query, Query),
+    field(Certificate, result, Result),
+    (   \+ (nonempty_string(Name), nonempty_string(SolverVersion))
+    ->  Reason = "the certificate names no solver and version"
+    ;   \+ nonempty_string(Query)
+    ->  Reason = "the certificate has no query"
+    ;   \+ sub_string(Query, _, _, _, "(check-sat)")
+    ->  Reason = "the query never asks (check-sat)"
+    ;   Result \== "unsat"
+    ->  Reason = "the solver did not answer unsat"
+    ).
+
+% field(+Dict, +Key, -Value): the value, or '$missing' when absent.
+field(Dict, Key, Value) :-
+    (   is_dict(Dict), get_dict(Key, Dict, Value0)
+    ->  Value = Value0
+    ;   Value = '$missing'
+    ).
+
+result_row(Row) :-
+    is_dict(Row),
+    get_dict(member, Row, _),
+    get_dict(outcome, Row, _).
+
+arithmetic_constraint(X, Row, c(Op, X, Value)) :-
+    is_dict(Row),
+    get_dict(operator, Row, OpString),
+    string(OpString),
+    atom_string(Op, OpString),
+    memberchk(Op, [eq, neq, lt, lte, gt, gte]),
+    get_dict(value, Row, Value),
+    number(Value).
+
+integer_variables("int", X, [X]).
+integer_variables("real", _, []).
+
+nonempty_string(Value) :-
+    string(Value),
+    Value \== "".
+
+sha256_string(Value) :-
+    string(Value),
+    string_length(Value, 64),
+    string_codes(Value, Codes),
+    forall(member(C, Codes), (code_type(C, digit) ; between(0'a, 0'f, C))).
+
+% The canonical JSON is spelled out here rather than left to json_write, so
+% it does not depend on the stream encoding or on how a key was read (a YAML
+% key and a JSON key for the same text are the same key): object keys sorted
+% by code point, no whitespace, ", \ and the JSON control escapes, other
+% control characters and every non-ASCII character as \u escapes of their
+% UTF-16 code units, integers in decimal.
+canonical_json(Value, Json) :-
+    is_dict(Value), !,
+    dict_pairs(Value, _, Pairs0),
+    maplist(string_keyed, Pairs0, Pairs1),
+    keysort(Pairs1, Pairs),
+    maplist(canonical_pair, Pairs, Parts),
+    atomics_to_string(Parts, ",", Body),
+    format(string(Json), "{~s}", [Body]).
+canonical_json(Value, Json) :-
+    is_list(Value), !,
+    maplist(canonical_json, Value, Parts),
+    atomics_to_string(Parts, ",", Body),
+    format(string(Json), "[~s]", [Body]).
+canonical_json(Value, Json) :-
+    string(Value), !,
+    canonical_string(Value, Json).
+canonical_json(Value, Json) :-
+    integer(Value), !,
+    format(string(Json), "~d", [Value]).
+canonical_json(Value, Json) :-
+    memberchk(Value, [true, false, null]), !,
+    atom_string(Value, Json).
+canonical_json(Value, Json) :-
+    atom(Value), !,
+    atom_string(Value, String),
+    canonical_string(String, Json).
+canonical_json(Value, Json) :-
+    with_output_to(string(Json), json_write(current_output, Value, [width(0)])).
+
+% Keys as code lists, so keysort orders them by code point whatever the
+% reader made of them (an atom, or a small integer for a numeric key).
+string_keyed(Key-Value, Codes-Value) :-
+    format(string(String), "~w", [Key]),
+    string_codes(String, Codes).
+
+canonical_pair(Codes-Value, Json) :-
+    string_codes(Key, Codes),
+    canonical_string(Key, KeyJson),
+    canonical_json(Value, ValueJson),
+    format(string(Json), "~s:~s", [KeyJson, ValueJson]).
+
+canonical_string(String, Json) :-
+    string_codes(String, Codes),
+    phrase(escaped_codes(Codes), Escaped),
+    string_codes(Body, Escaped),
+    format(string(Json), "\"~s\"", [Body]).
+
+escaped_codes([]) --> [].
+escaped_codes([C|Cs]) --> escaped_code(C), escaped_codes(Cs).
+
+escaped_code(0'") --> !, "\\\"".
+escaped_code(0'\\) --> !, "\\\\".
+escaped_code(0'\b) --> !, "\\b".
+escaped_code(0'\f) --> !, "\\f".
+escaped_code(0'\n) --> !, "\\n".
+escaped_code(0'\r) --> !, "\\r".
+escaped_code(0'\t) --> !, "\\t".
+escaped_code(C) --> { C >= 0x20, C =< 0x7e }, !, [C].
+escaped_code(C) -->
+    { C > 0xffff }, !,
+    { V is C - 0x10000,
+      High is 0xd800 + (V >> 10),
+      Low is 0xdc00 + (V /\ 0x3ff) },
+    unit_escape(High),
+    unit_escape(Low).
+escaped_code(C) --> unit_escape(C).
+
+unit_escape(Unit) -->
+    { format(codes(Codes), "\\u~|~`0t~16r~4+", [Unit]) },
+    Codes.