acl: Phase 3 explanation + audit, 35 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
explain.sx reconstructs a canonical proof tree (first-rule, first-solution)
by goal-directed search over the saturated db, since Datalog keeps no
provenance; depth-capped for cyclic safety. acl-explain returns
{:allowed? :proof :reason} with the blocking eff_deny proof on denial.
audit.sx is an append-only decision log (monotonic seq, disk serializer).
api gains acl/explain, acl/audit, acl/audit-tail.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -25,7 +25,21 @@
|
||||
(set! acl-current-db (acl-build-db (list))))
|
||||
acl-current-db)))
|
||||
|
||||
;; Public decision against the current db.
|
||||
;; Public decision against the current db (pure, no logging).
|
||||
(define
|
||||
acl/permit?
|
||||
(fn (subj act res) (acl-permit? (acl-ensure-db!) subj act res)))
|
||||
|
||||
;; Decision-with-proof against the current db. See lib/acl/explain.sx.
|
||||
(define
|
||||
acl/explain
|
||||
(fn (subj act res) (acl-explain (acl-ensure-db!) subj act res)))
|
||||
|
||||
;; Audited decision: logs the outcome to the append-only audit log and returns
|
||||
;; the boolean. See lib/acl/audit.sx.
|
||||
(define
|
||||
acl/audit
|
||||
(fn (subj act res) (acl-audit-decide! (acl-ensure-db!) subj act res)))
|
||||
|
||||
;; Recent audited decisions (chronological).
|
||||
(define acl/audit-tail (fn (n) (acl-audit-tail n)))
|
||||
|
||||
82
lib/acl/audit.sx
Normal file
82
lib/acl/audit.sx
Normal file
@@ -0,0 +1,82 @@
|
||||
;; lib/acl/audit.sx — append-only decision log.
|
||||
;;
|
||||
;; Every decision routed through acl-audit-decide! is appended to an in-memory
|
||||
;; log with a monotonic sequence number (no wall-clock — deterministic and
|
||||
;; testable; a host can stamp time at the serializer boundary). The log is
|
||||
;; append-only: there is no mutate or delete, only append, tail, clear, and
|
||||
;; serialize-for-disk.
|
||||
|
||||
(define acl-audit-log (list))
|
||||
(define acl-audit-seq 0)
|
||||
|
||||
(define
|
||||
acl-audit-clear!
|
||||
(fn
|
||||
()
|
||||
(do (set! acl-audit-log (list)) (set! acl-audit-seq 0) nil)))
|
||||
|
||||
;; Append a decision record. Returns the record.
|
||||
(define
|
||||
acl-audit-record!
|
||||
(fn
|
||||
(subj act res allowed?)
|
||||
(let
|
||||
((entry {:allowed? allowed? :act act :subj subj :res res :seq acl-audit-seq}))
|
||||
(do
|
||||
(set! acl-audit-seq (+ acl-audit-seq 1))
|
||||
(append! acl-audit-log entry)
|
||||
entry))))
|
||||
|
||||
;; Decide against db, log the outcome, and return the boolean. This is the
|
||||
;; audited path; acl-permit? remains the pure, side-effect-free decision.
|
||||
(define
|
||||
acl-audit-decide!
|
||||
(fn
|
||||
(db subj act res)
|
||||
(let
|
||||
((allowed? (acl-permit? db subj act res)))
|
||||
(do (acl-audit-record! subj act res allowed?) allowed?))))
|
||||
|
||||
(define acl-audit-count (fn () (len acl-audit-log)))
|
||||
|
||||
;; Most recent n entries (in chronological order). n >= log size returns all.
|
||||
(define
|
||||
acl-audit-tail
|
||||
(fn
|
||||
(n)
|
||||
(let
|
||||
((total (len acl-audit-log)))
|
||||
(if
|
||||
(<= total n)
|
||||
acl-audit-log
|
||||
(acl-audit-drop acl-audit-log (- total n))))))
|
||||
|
||||
(define
|
||||
acl-audit-drop
|
||||
(fn
|
||||
(xs k)
|
||||
(if (<= k 0) xs (acl-audit-drop (rest xs) (- k 1)))))
|
||||
|
||||
;; Serialize the whole log to a disk-ready string: one record per line,
|
||||
;; "seq\tsubj\tact\tres\tallowed?". A host writes this; reload is out of scope.
|
||||
(define
|
||||
acl-audit-serialize
|
||||
(fn
|
||||
()
|
||||
(reduce
|
||||
(fn
|
||||
(acc e)
|
||||
(str
|
||||
acc
|
||||
(get e :seq)
|
||||
"\t"
|
||||
(get e :subj)
|
||||
"\t"
|
||||
(get e :act)
|
||||
"\t"
|
||||
(get e :res)
|
||||
"\t"
|
||||
(get e :allowed?)
|
||||
"\n"))
|
||||
""
|
||||
acl-audit-log)))
|
||||
@@ -17,10 +17,13 @@ PRELOADS=(
|
||||
lib/acl/schema.sx
|
||||
lib/acl/facts.sx
|
||||
lib/acl/engine.sx
|
||||
lib/acl/explain.sx
|
||||
lib/acl/audit.sx
|
||||
lib/acl/api.sx
|
||||
)
|
||||
|
||||
SUITES=(
|
||||
"direct:lib/acl/tests/direct.sx:(acl-direct-tests-run!)"
|
||||
"inherit:lib/acl/tests/inherit.sx:(acl-inherit-tests-run!)"
|
||||
"explain:lib/acl/tests/explain.sx:(acl-explain-tests-run!)"
|
||||
)
|
||||
|
||||
125
lib/acl/explain.sx
Normal file
125
lib/acl/explain.sx
Normal file
@@ -0,0 +1,125 @@
|
||||
;; lib/acl/explain.sx — proof-tree reconstruction over the saturated db.
|
||||
;;
|
||||
;; lib/datalog/ records derived facts but not their provenance, so the proof is
|
||||
;; reconstructed here by goal-directed search over the *saturated* db: for a
|
||||
;; ground goal we find the first ACL rule (in rule order) whose body holds, take
|
||||
;; the first solution binding its remaining variables, and recurse on each body
|
||||
;; literal. Negated literals are recorded as verified `:neg-ok` leaves.
|
||||
;;
|
||||
;; CANONICAL DERIVATION: the Datalog derivation graph is a DAG (a fact may hold
|
||||
;; many ways). We pick ONE canonical proof — first matching rule, first solution
|
||||
;; — matching the rule order in lib/acl/engine.sx (direct/EDB rules first). A
|
||||
;; depth cap guards against pathological cyclic data producing unbounded search.
|
||||
;;
|
||||
;; A proof node is one of:
|
||||
;; {:fact <lit> :via "edb"} — base EDB fact
|
||||
;; {:fact <lit> :rule <head> :body (<node|negleaf> ...)} — derived
|
||||
;; {:neg-ok <lit>} — negation verified to fail
|
||||
;; {:fact <lit> :truncated true} — depth cap hit
|
||||
|
||||
(define acl-proof-max-depth 64)
|
||||
|
||||
;; Substitute a body literal, descending into {:neg ...} dicts (dl-apply-subst
|
||||
;; does not recurse into dicts, which would leak the neg's free vars).
|
||||
(define
|
||||
acl-subst-lit
|
||||
(fn
|
||||
(lit s)
|
||||
(if
|
||||
(and (dict? lit) (has-key? lit :neg))
|
||||
{:neg (dl-apply-subst (get lit :neg) s)}
|
||||
(dl-apply-subst lit s))))
|
||||
|
||||
(define
|
||||
acl-lit-edb?
|
||||
(fn
|
||||
(lit)
|
||||
(and
|
||||
(list? lit)
|
||||
(> (len lit) 0)
|
||||
(symbol? (first lit))
|
||||
(has-key? acl-edb-arity (symbol->string (first lit))))))
|
||||
|
||||
(define
|
||||
acl-subst-zip!
|
||||
(fn
|
||||
(d ks vs)
|
||||
(when
|
||||
(> (len ks) 0)
|
||||
(do
|
||||
(dict-set! d (symbol->string (first ks)) (first vs))
|
||||
(acl-subst-zip! d (rest ks) (rest vs))))))
|
||||
|
||||
;; Bind a rule head's variables to a ground goal's arguments (positional).
|
||||
(define
|
||||
acl-bind-head
|
||||
(fn
|
||||
(head goal)
|
||||
(let
|
||||
((d {}))
|
||||
(do (acl-subst-zip! d (rest head) (rest goal)) d))))
|
||||
|
||||
(define
|
||||
acl-subst-union
|
||||
(fn
|
||||
(a b)
|
||||
(let
|
||||
((d {}))
|
||||
(do
|
||||
(for-each (fn (k) (dict-set! d k (get a k))) (keys a))
|
||||
(for-each (fn (k) (dict-set! d k (get b k))) (keys b))
|
||||
d))))
|
||||
|
||||
(define acl-prove (fn (db goal) (acl-prove-d db goal 0)))
|
||||
|
||||
(define
|
||||
acl-prove-d
|
||||
(fn
|
||||
(db goal depth)
|
||||
(cond
|
||||
((> depth acl-proof-max-depth) {:truncated true :fact goal})
|
||||
((acl-lit-edb? goal)
|
||||
(if (> (len (dl-query db goal)) 0) {:via "edb" :fact goal} nil))
|
||||
(else (acl-prove-rules db goal acl-rules depth)))))
|
||||
|
||||
(define
|
||||
acl-prove-rules
|
||||
(fn
|
||||
(db goal rules depth)
|
||||
(if
|
||||
(= (len rules) 0)
|
||||
nil
|
||||
(let
|
||||
((p (dl-rule-from-list (first rules))))
|
||||
(if
|
||||
(= (first (get p :head)) (first goal))
|
||||
(let
|
||||
((hs (acl-bind-head (get p :head) goal)))
|
||||
(let
|
||||
((qbody (map (fn (l) (acl-subst-lit l hs)) (get p :body))))
|
||||
(let
|
||||
((sols (dl-query db qbody)))
|
||||
(if
|
||||
(> (len sols) 0)
|
||||
(acl-prove-build db goal p hs (first sols) depth)
|
||||
(acl-prove-rules db goal (rest rules) depth)))))
|
||||
(acl-prove-rules db goal (rest rules) depth))))))
|
||||
|
||||
(define
|
||||
acl-prove-build
|
||||
(fn
|
||||
(db goal p hs sol depth)
|
||||
(let ((full (acl-subst-union hs sol))) {:body (map (fn (l) (let ((g (acl-subst-lit l full))) (if (and (dict? g) (has-key? g :neg)) {:neg-ok (get g :neg)} (acl-prove-d db g (+ depth 1))))) (get p :body)) :rule (get p :head) :fact goal})))
|
||||
|
||||
;; Public decision-with-proof. Returns:
|
||||
;; {:allowed? <bool> :proof <node|nil> :reason <eff_deny proof|nil>}
|
||||
;; When permitted, :proof is the permit derivation. When denied, :proof is nil
|
||||
;; and :reason carries the blocking eff_deny proof if one exists (an explicit or
|
||||
;; inherited deny), else nil (simply no grant).
|
||||
(define
|
||||
acl-explain
|
||||
(fn
|
||||
(db subj act res)
|
||||
(let
|
||||
((proof (acl-prove db (list (quote permit) subj act res))))
|
||||
(if (= proof nil) {:allowed? false :proof nil :reason (acl-prove db (list (quote eff_deny) subj act res))} {:allowed? true :proof proof :reason nil}))))
|
||||
@@ -1,11 +1,12 @@
|
||||
{
|
||||
"lang": "acl",
|
||||
"total_passed": 54,
|
||||
"total_passed": 89,
|
||||
"total_failed": 0,
|
||||
"total": 54,
|
||||
"total": 89,
|
||||
"suites": [
|
||||
{"name":"direct","passed":24,"failed":0,"total":24},
|
||||
{"name":"inherit","passed":30,"failed":0,"total":30}
|
||||
{"name":"inherit","passed":30,"failed":0,"total":30},
|
||||
{"name":"explain","passed":35,"failed":0,"total":35}
|
||||
],
|
||||
"generated": "2026-06-06T16:35:53+00:00"
|
||||
"generated": "2026-06-06T16:46:37+00:00"
|
||||
}
|
||||
|
||||
@@ -1,8 +1,9 @@
|
||||
# acl scoreboard
|
||||
|
||||
**54 / 54 passing** (0 failure(s)).
|
||||
**89 / 89 passing** (0 failure(s)).
|
||||
|
||||
| Suite | Passed | Total | Status |
|
||||
|-------|--------|-------|--------|
|
||||
| direct | 24 | 24 | ok |
|
||||
| inherit | 30 | 30 | ok |
|
||||
| explain | 35 | 35 | ok |
|
||||
|
||||
316
lib/acl/tests/explain.sx
Normal file
316
lib/acl/tests/explain.sx
Normal file
@@ -0,0 +1,316 @@
|
||||
;; lib/acl/tests/explain.sx — Phase 3: proof correctness + audit completeness.
|
||||
|
||||
(define acl-et-pass 0)
|
||||
(define acl-et-fail 0)
|
||||
(define acl-et-failures (list))
|
||||
|
||||
;; Name-based deep equality. The host `=` compares symbols by interned
|
||||
;; identity, which is unstable across substitution/saturation; comparing by
|
||||
;; name (as the datalog suite does) makes structural assertions deterministic.
|
||||
(define
|
||||
acl-et-eq?
|
||||
(fn
|
||||
(a b)
|
||||
(cond
|
||||
((and (list? a) (list? b))
|
||||
(and (= (len a) (len b)) (acl-et-eq-l? a b 0)))
|
||||
((and (dict? a) (dict? b))
|
||||
(let
|
||||
((ka (keys a)) (kb (keys b)))
|
||||
(and (= (len ka) (len kb)) (acl-et-eq-d? a b ka 0))))
|
||||
((and (symbol? a) (symbol? b))
|
||||
(= (symbol->string a) (symbol->string b)))
|
||||
(else (= a b)))))
|
||||
|
||||
(define
|
||||
acl-et-eq-l?
|
||||
(fn
|
||||
(a b i)
|
||||
(cond
|
||||
((>= i (len a)) true)
|
||||
((not (acl-et-eq? (nth a i) (nth b i))) false)
|
||||
(else (acl-et-eq-l? a b (+ i 1))))))
|
||||
|
||||
(define
|
||||
acl-et-eq-d?
|
||||
(fn
|
||||
(a b ka i)
|
||||
(cond
|
||||
((>= i (len ka)) true)
|
||||
((let ((k (nth ka i))) (not (acl-et-eq? (get a k) (get b k))))
|
||||
false)
|
||||
(else (acl-et-eq-d? a b ka (+ i 1))))))
|
||||
|
||||
(define
|
||||
acl-et-check!
|
||||
(fn
|
||||
(name got expected)
|
||||
(if
|
||||
(acl-et-eq? got expected)
|
||||
(set! acl-et-pass (+ acl-et-pass 1))
|
||||
(do
|
||||
(set! acl-et-fail (+ acl-et-fail 1))
|
||||
(append!
|
||||
acl-et-failures
|
||||
(str name "\n expected: " expected "\n got: " got))))))
|
||||
|
||||
;; --- proof-tree walkers ---
|
||||
|
||||
;; True if EDB fact `target` appears as a base leaf anywhere in the proof.
|
||||
(define
|
||||
acl-et-has-leaf?
|
||||
(fn
|
||||
(node target)
|
||||
(cond
|
||||
((= node nil) false)
|
||||
((and (dict? node) (has-key? node :via))
|
||||
(acl-et-eq? (get node :fact) target))
|
||||
((and (dict? node) (has-key? node :body))
|
||||
(acl-et-any-leaf? (get node :body) target))
|
||||
(else false))))
|
||||
|
||||
(define
|
||||
acl-et-any-leaf?
|
||||
(fn
|
||||
(nodes target)
|
||||
(cond
|
||||
((= (len nodes) 0) false)
|
||||
((acl-et-has-leaf? (first nodes) target) true)
|
||||
(else (acl-et-any-leaf? (rest nodes) target)))))
|
||||
|
||||
;; True if the proof records a verified negation (deny did not fire).
|
||||
(define
|
||||
acl-et-has-negok?
|
||||
(fn
|
||||
(node)
|
||||
(cond
|
||||
((= node nil) false)
|
||||
((and (dict? node) (has-key? node :neg-ok)) true)
|
||||
((and (dict? node) (has-key? node :body))
|
||||
(acl-et-any-negok? (get node :body)))
|
||||
(else false))))
|
||||
|
||||
(define
|
||||
acl-et-any-negok?
|
||||
(fn
|
||||
(nodes)
|
||||
(cond
|
||||
((= (len nodes) 0) false)
|
||||
((acl-et-has-negok? (first nodes)) true)
|
||||
(else (acl-et-any-negok? (rest nodes))))))
|
||||
|
||||
(define
|
||||
acl-et-run-all!
|
||||
(fn
|
||||
()
|
||||
(do
|
||||
(let
|
||||
((db (acl-build-db (list (acl-grant (quote u) (quote read) (quote p))))))
|
||||
(let
|
||||
((e (acl-explain db (quote u) (quote read) (quote p))))
|
||||
(do
|
||||
(acl-et-check! "direct: allowed?" (get e :allowed?) true)
|
||||
(acl-et-check!
|
||||
"direct: proof root fact"
|
||||
(get (get e :proof) :fact)
|
||||
(list (quote permit) (quote u) (quote read) (quote p)))
|
||||
(acl-et-check!
|
||||
"direct: grant leaf present"
|
||||
(acl-et-has-leaf?
|
||||
(get e :proof)
|
||||
(list (quote grant) (quote u) (quote read) (quote p)))
|
||||
true)
|
||||
(acl-et-check!
|
||||
"direct: negation verified"
|
||||
(acl-et-has-negok? (get e :proof))
|
||||
true)
|
||||
(acl-et-check!
|
||||
"direct: reason nil when allowed"
|
||||
(get e :reason)
|
||||
nil))))
|
||||
(let
|
||||
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-member-of (quote team) (quote org)) (acl-grant (quote org) (quote read) (quote doc))))))
|
||||
(let
|
||||
((e (acl-explain db (quote alice) (quote read) (quote doc))))
|
||||
(do
|
||||
(acl-et-check! "group: allowed?" (get e :allowed?) true)
|
||||
(acl-et-check!
|
||||
"group: member_of alice leaf"
|
||||
(acl-et-has-leaf?
|
||||
(get e :proof)
|
||||
(list (quote member_of) (quote alice) (quote team)))
|
||||
true)
|
||||
(acl-et-check!
|
||||
"group: member_of team leaf"
|
||||
(acl-et-has-leaf?
|
||||
(get e :proof)
|
||||
(list (quote member_of) (quote team) (quote org)))
|
||||
true)
|
||||
(acl-et-check!
|
||||
"group: grant org leaf at base"
|
||||
(acl-et-has-leaf?
|
||||
(get e :proof)
|
||||
(list (quote grant) (quote org) (quote read) (quote doc)))
|
||||
true))))
|
||||
(let
|
||||
((db (acl-build-db (list (acl-child-of (quote sec) (quote book)) (acl-grant (quote u) (quote read) (quote book))))))
|
||||
(let
|
||||
((e (acl-explain db (quote u) (quote read) (quote sec))))
|
||||
(do
|
||||
(acl-et-check! "resource: allowed?" (get e :allowed?) true)
|
||||
(acl-et-check!
|
||||
"resource: child_of leaf"
|
||||
(acl-et-has-leaf?
|
||||
(get e :proof)
|
||||
(list (quote child_of) (quote sec) (quote book)))
|
||||
true)
|
||||
(acl-et-check!
|
||||
"resource: grant on parent leaf"
|
||||
(acl-et-has-leaf?
|
||||
(get e :proof)
|
||||
(list (quote grant) (quote u) (quote read) (quote book)))
|
||||
true))))
|
||||
(let
|
||||
((db (acl-build-db (list (acl-member-of (quote bob) (quote editor)) (acl-role-grant (quote editor) (quote edit) (quote page1))))))
|
||||
(let
|
||||
((e (acl-explain db (quote bob) (quote edit) (quote page1))))
|
||||
(do
|
||||
(acl-et-check! "role: allowed?" (get e :allowed?) true)
|
||||
(acl-et-check!
|
||||
"role: member_of leaf"
|
||||
(acl-et-has-leaf?
|
||||
(get e :proof)
|
||||
(list (quote member_of) (quote bob) (quote editor)))
|
||||
true)
|
||||
(acl-et-check!
|
||||
"role: role_grant leaf"
|
||||
(acl-et-has-leaf?
|
||||
(get e :proof)
|
||||
(list
|
||||
(quote role_grant)
|
||||
(quote editor)
|
||||
(quote edit)
|
||||
(quote page1)))
|
||||
true))))
|
||||
(let
|
||||
((db (acl-build-db (list (acl-grant (quote u) (quote edit) (quote p)) (acl-deny (quote u) (quote edit) (quote p))))))
|
||||
(let
|
||||
((e (acl-explain db (quote u) (quote edit) (quote p))))
|
||||
(do
|
||||
(acl-et-check! "deny: not allowed" (get e :allowed?) false)
|
||||
(acl-et-check! "deny: no proof" (get e :proof) nil)
|
||||
(acl-et-check!
|
||||
"deny: reason root is eff_deny"
|
||||
(get (get e :reason) :fact)
|
||||
(list (quote eff_deny) (quote u) (quote edit) (quote p)))
|
||||
(acl-et-check!
|
||||
"deny: reason has deny leaf"
|
||||
(acl-et-has-leaf?
|
||||
(get e :reason)
|
||||
(list (quote deny) (quote u) (quote edit) (quote p)))
|
||||
true))))
|
||||
(let
|
||||
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote alice) (quote read) (quote doc)) (acl-deny (quote team) (quote read) (quote doc))))))
|
||||
(let
|
||||
((e (acl-explain db (quote alice) (quote read) (quote doc))))
|
||||
(do
|
||||
(acl-et-check!
|
||||
"inherited deny: not allowed"
|
||||
(get e :allowed?)
|
||||
false)
|
||||
(acl-et-check!
|
||||
"inherited deny: reason has member_of leaf"
|
||||
(acl-et-has-leaf?
|
||||
(get e :reason)
|
||||
(list (quote member_of) (quote alice) (quote team)))
|
||||
true)
|
||||
(acl-et-check!
|
||||
"inherited deny: reason has group deny leaf"
|
||||
(acl-et-has-leaf?
|
||||
(get e :reason)
|
||||
(list (quote deny) (quote team) (quote read) (quote doc)))
|
||||
true))))
|
||||
(let
|
||||
((db (acl-build-db (list))))
|
||||
(let
|
||||
((e (acl-explain db (quote u) (quote read) (quote p))))
|
||||
(do
|
||||
(acl-et-check! "no grant: not allowed" (get e :allowed?) false)
|
||||
(acl-et-check! "no grant: proof nil" (get e :proof) nil)
|
||||
(acl-et-check! "no grant: reason nil" (get e :reason) nil))))
|
||||
(let
|
||||
((db (acl-build-db (list (acl-grant (quote u) (quote read) (quote p)) (acl-deny (quote u) (quote edit) (quote p))))))
|
||||
(do
|
||||
(acl-audit-clear!)
|
||||
(acl-et-check! "audit: starts empty" (acl-audit-count) 0)
|
||||
(acl-et-check!
|
||||
"audit decide allowed returns true"
|
||||
(acl-audit-decide! db (quote u) (quote read) (quote p))
|
||||
true)
|
||||
(acl-et-check!
|
||||
"audit decide denied returns false"
|
||||
(acl-audit-decide! db (quote u) (quote edit) (quote p))
|
||||
false)
|
||||
(acl-audit-decide! db (quote u) (quote comment) (quote p))
|
||||
(acl-et-check!
|
||||
"audit: count after three decisions"
|
||||
(acl-audit-count)
|
||||
3)
|
||||
(acl-et-check!
|
||||
"audit: tail size respects n"
|
||||
(len (acl-audit-tail 2))
|
||||
2)
|
||||
(acl-et-check!
|
||||
"audit: tail returns most recent"
|
||||
(get (first (acl-audit-tail 1)) :act)
|
||||
(quote comment))
|
||||
(acl-et-check!
|
||||
"audit: first record seq is 0"
|
||||
(get (first (acl-audit-tail 3)) :seq)
|
||||
0)
|
||||
(acl-et-check!
|
||||
"audit: allowed flag recorded"
|
||||
(get (first (acl-audit-tail 3)) :allowed?)
|
||||
true)
|
||||
(acl-et-check!
|
||||
"audit: serialize line count"
|
||||
(len (acl-et-lines (acl-audit-serialize)))
|
||||
3)
|
||||
(acl-audit-clear!)
|
||||
(acl-et-check!
|
||||
"audit: clear resets count"
|
||||
(acl-audit-count)
|
||||
0))))))
|
||||
|
||||
;; count newline-terminated lines in a serialized log
|
||||
(define acl-et-lines (fn (s) (acl-et-count-nl s 0 0)))
|
||||
(define
|
||||
acl-et-count-nl
|
||||
(fn
|
||||
(s i n)
|
||||
(if
|
||||
(>= i (len s))
|
||||
(if (= n 0) (list) (acl-et-rangelist n))
|
||||
(acl-et-count-nl
|
||||
s
|
||||
(+ i 1)
|
||||
(if (= (slice s i (+ i 1)) "\n") (+ n 1) n)))))
|
||||
(define
|
||||
acl-et-rangelist
|
||||
(fn
|
||||
(n)
|
||||
(if
|
||||
(<= n 0)
|
||||
(list)
|
||||
(cons n (acl-et-rangelist (- n 1))))))
|
||||
|
||||
(define
|
||||
acl-explain-tests-run!
|
||||
(fn
|
||||
()
|
||||
(do
|
||||
(set! acl-et-pass 0)
|
||||
(set! acl-et-fail 0)
|
||||
(set! acl-et-failures (list))
|
||||
(acl-et-run-all!)
|
||||
{:failures acl-et-failures :total (+ acl-et-pass acl-et-fail) :passed acl-et-pass :failed acl-et-fail})))
|
||||
Reference in New Issue
Block a user