rose-ash/lib/mod/lint.sx

;; lib/mod/lint.sx — static analysis of a policy rule set.
;;
;; Because precedence is "first matching clause wins" (pl-query-one), the rule
;; order has correctness consequences a moderator can get wrong: a rule placed
;; after an unconditional (empty :when) rule can never fire, and a rule set with
;; no unconditional rule may leave some reports undecided. lint-rules surfaces
;; these without running the engine.

(define mod/rule-unconditional? (fn (r) (empty? (mod/rule-when r))))

;; names of rules that follow the first unconditional rule — structurally dead,
;; since the unconditional rule always matches first
(define
  mod/unreachable-rules
  (fn
    (rules)
    (get
      (reduce
        (fn
          (acc r)
          (if
            (get acc :hit)
            {:dead (append (get acc :dead) (list (mod/rule-name r))) :hit true}
            (if (mod/rule-unconditional? r) {:dead (get acc :dead) :hit true} acc)))
        {:dead (list) :hit false}
        rules)
      :dead)))

(define
  mod/has-catchall?
  (fn (rules) (mod/any? mod/rule-unconditional? rules)))

(define
  mod/count-eq
  (fn
    (x lst)
    (reduce (fn (a y) (if (= y x) (+ a 1) a)) 0 lst)))

(define
  mod/duplicate-rule-names
  (fn
    (rules)
    (let
      ((names (map mod/rule-name rules)))
      (mod/distinct
        (reduce
          (fn
            (acc n)
            (if
              (< 1 (mod/count-eq n names))
              (append acc (list n))
              acc))
          (list)
          names)))))

(define mod/lint-rules (fn (rules) {:duplicate-names (mod/duplicate-rule-names rules) :has-catchall (mod/has-catchall? rules) :unreachable (mod/unreachable-rules rules)}))

;; a rule set is well-formed when nothing is dead, it has a catch-all, and rule
;; names are unique
(define
  mod/rules-ok?
  (fn
    (rules)
    (let
      ((l (mod/lint-rules rules)))
      (if
        (empty? (get l :unreachable))
        (if (get l :has-catchall) (empty? (get l :duplicate-names)) false)
        false))))