Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m7s
Reports carry an :evidence list, asserted as evidence/3 facts; reviewer-remove rule (highest precedence) lets human review override classification. Proof tree built constructively by re-querying each rule body goal against the same DB with the report id bound, so derivations carry real unification bindings. Append-only audit log records decision + proof + evidence snapshot per decide, monotonic seq, never mutates prior entries. +29 audit tests. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
160 lines
4.0 KiB
Plaintext
160 lines
4.0 KiB
Plaintext
;; lib/mod/schema.sx — report representation + Prolog fact generation.
|
|
;;
|
|
;; A report is a dict {:id :by :about :reason :evidence}. :evidence is a list of
|
|
;; accumulated evidence entries {:kind :val} (human review, automated scanners,
|
|
;; etc.). The engine derives keyword classifications from the reason text and
|
|
;; projects the report, its classifications, and its accumulated evidence into
|
|
;; Prolog facts that policy clauses match against.
|
|
|
|
(define mod/mk-report (fn (id by about reason) {:id id :by by :evidence (list) :about about :reason reason}))
|
|
|
|
(define mod/report-id (fn (r) (get r :id)))
|
|
(define mod/report-by (fn (r) (get r :by)))
|
|
(define mod/report-about (fn (r) (get r :about)))
|
|
(define mod/report-reason (fn (r) (get r :reason)))
|
|
|
|
(define
|
|
mod/report-evidence
|
|
(fn (r) (let ((e (get r :evidence))) (if (nil? e) (list) e))))
|
|
|
|
(define mod/mk-evidence (fn (kind val) {:val val :kind kind}))
|
|
(define mod/evidence-kind (fn (e) (get e :kind)))
|
|
(define mod/evidence-val (fn (e) (get e :val)))
|
|
|
|
(define mod/with-evidence (fn (r evs) {:id (mod/report-id r) :by (mod/report-by r) :evidence evs :about (mod/report-about r) :reason (mod/report-reason r)}))
|
|
|
|
(define
|
|
mod/attach-evidence
|
|
(fn
|
|
(r e)
|
|
(mod/with-evidence r (append (mod/report-evidence r) (list e)))))
|
|
|
|
;; ── substring search (the prolog-loaded env lacks includes?; slice/len do work) ──
|
|
|
|
(define
|
|
mod/contains-at?
|
|
(fn
|
|
(hay needle hl nl pos)
|
|
(if
|
|
(< hl (+ pos nl))
|
|
false
|
|
(if
|
|
(= (slice hay pos (+ pos nl)) needle)
|
|
true
|
|
(mod/contains-at? hay needle hl nl (+ pos 1))))))
|
|
|
|
(define
|
|
mod/str-contains?
|
|
(fn
|
|
(hay needle)
|
|
(let
|
|
((hl (len hay)) (nl (len needle)))
|
|
(if
|
|
(= nl 0)
|
|
true
|
|
(mod/contains-at? hay needle hl nl 0)))))
|
|
|
|
;; ── evidence derivation (keyword classification) ──
|
|
|
|
(define
|
|
mod/spam-keywords
|
|
(list "spam" "buy now" "click here" "free money" "viagra" "limited offer"))
|
|
|
|
(define
|
|
mod/abuse-keywords
|
|
(list "abuse" "harassment" "threat" "slur" "hate speech"))
|
|
|
|
(define
|
|
mod/any?
|
|
(fn (pred coll) (reduce (fn (acc x) (if acc acc (pred x))) false coll)))
|
|
|
|
(define
|
|
mod/reason-matches?
|
|
(fn
|
|
(reason kws)
|
|
(let
|
|
((low (downcase reason)))
|
|
(mod/any? (fn (k) (mod/str-contains? low k)) kws))))
|
|
|
|
(define
|
|
mod/classify-keywords
|
|
(fn
|
|
(r)
|
|
(let
|
|
((reason (mod/report-reason r)) (kinds (list)))
|
|
(begin
|
|
(when
|
|
(mod/reason-matches? reason mod/spam-keywords)
|
|
(append! kinds "spam"))
|
|
(when
|
|
(mod/reason-matches? reason mod/abuse-keywords)
|
|
(append! kinds "abuse"))
|
|
kinds))))
|
|
|
|
(define
|
|
mod/report-count
|
|
(fn
|
|
(about reports)
|
|
(reduce
|
|
(fn
|
|
(acc r)
|
|
(if (= (mod/report-about r) about) (+ acc 1) acc))
|
|
0
|
|
reports)))
|
|
|
|
;; ── Prolog fact projection ──
|
|
|
|
(define
|
|
mod/join-with
|
|
(fn
|
|
(sep items)
|
|
(reduce (fn (acc x) (if (= acc "") x (str acc sep x))) "" items)))
|
|
|
|
(define mod/pl-quote (fn (s) (str "'" s "'")))
|
|
|
|
(define
|
|
mod/classification-facts
|
|
(fn
|
|
(id kinds)
|
|
(mod/join-with
|
|
"\n"
|
|
(map (fn (k) (str "classification(" id ", " k ").")) kinds))))
|
|
|
|
(define
|
|
mod/evidence-facts
|
|
(fn
|
|
(id evs)
|
|
(mod/join-with
|
|
"\n"
|
|
(map
|
|
(fn
|
|
(e)
|
|
(str
|
|
"evidence("
|
|
id
|
|
", "
|
|
(mod/pl-quote (mod/evidence-kind e))
|
|
", "
|
|
(mod/pl-quote (str (mod/evidence-val e)))
|
|
")."))
|
|
evs))))
|
|
|
|
(define
|
|
mod/report-facts
|
|
(fn
|
|
(r count)
|
|
(let
|
|
((id (mod/report-id r))
|
|
(by (mod/pl-quote (mod/report-by r)))
|
|
(about (mod/pl-quote (mod/report-about r))))
|
|
(let
|
|
((cls (mod/classification-facts id (mod/classify-keywords r)))
|
|
(evs (mod/evidence-facts id (mod/report-evidence r))))
|
|
(mod/join-with
|
|
"\n"
|
|
(list
|
|
(str "report(" id ", " by ", " about ").")
|
|
(str "report_count(" about ", " count ").")
|
|
cls
|
|
evs))))))
|