v0.7.2: wire tag severity into dispatcher-check — TDD

dispatcher-privacy-severity replaces binary dispatcher-check-privacy-tags.
Three-tier: :block (reject), :warn (log+allow), :log (silent).
Wired into dispatcher-check vector 5.

- security-dispatcher: dispatcher-privacy-severity fn, +3 tests
  Updated vector 5 in dispatcher-check with severity branching.
- Core: 88/88

lisp/security-dispatcher.lisp

@@ -130,6 +130,18 @@ Severity: :block (filter), :warn (log+include), :log (silent record).")
   "Return the severity keyword for TAG, or NIL if not found."
   (cdr (assoc tag *tag-categories* :test #'string-equal)))
 
+(defun dispatcher-privacy-severity (tags-list)
+  "Return the highest-severity tag match: :block > :warn > :log, or nil."
+  (when (and tags-list (listp tags-list))
+    (let ((highest nil))
+      (dolist (tag tags-list)
+        (let ((sev (tag-category-severity tag)))
+          (when (or (eq sev :block)
+                    (and (eq sev :warn) (not (eq highest :block)))
+                    (and (eq sev :log) (null highest)))
+            (setf highest sev))))
+      highest)))
+
 (tag-categories-load)
 
 (defun dispatcher-check-text-for-privacy (text)
@@ -306,12 +318,21 @@ Eleven checks: 0=REPL-lint (warn-only), 1=lisp-validation, 2=secret-path,
                :payload (list :level :error
                               :text (format nil "Action blocked: Potential exposure of '~a'" secret-name)))))
 
-      ;; Vector 5: Privacy-tagged content in action
-      ((and tags (dispatcher-check-privacy-tags tags))
-       (log-message "PRIVACY VIOLATION: Action contains privacy-tagged content")
-       (list :type :LOG
-             :payload (list :level :warn
-                            :text "Action blocked: Content tagged with privacy filter.")))
+       ;; Vector 5: Privacy-tagged content (severity tiers)
+       ((and tags (fboundp 'dispatcher-privacy-severity))
+        (let ((severity (dispatcher-privacy-severity tags)))
+          (cond
+            ((eq severity :block)
+             (log-message "PRIVACY VIOLATION: Blocked by @tag — ~a" tags)
+             (list :type :LOG
+                   :payload (list :level :error
+                                  :text (format nil "Action blocked: Content tagged with privacy filter (~a)." tags))))
+            ((eq severity :warn)
+             (log-message "PRIVACY WARNING: @tag ~a (allowed with warning)" tags)
+             action)
+            ((eq severity :log)
+             (log-message "PRIVACY: @tag ~a (logged)" tags)
+             action))))
 
       ;; Vector 6: Text leaks privacy tag names
       ((and text (dispatcher-check-text-for-privacy text))
@@ -568,6 +589,21 @@ Recognized formats:
   "Contract v0.7.2: unknown tag returns nil."
   (is (null (passepartout::tag-category-severity "@nonexistent-xxxx"))))
 
+(test test-privacy-severity-block
+  "v0.7.2: dispatcher-privacy-severity returns :block for block-tagged content."
+  (setf passepartout::*tag-categories* '(("@personal" . :block)))
+  (is (eq :block (passepartout::dispatcher-privacy-severity '("@personal")))))
+
+(test test-privacy-severity-warn
+  "v0.7.2: dispatcher-privacy-severity returns :warn for warn-tagged content."
+  (setf passepartout::*tag-categories* '(("@draft" . :warn)))
+  (is (eq :warn (passepartout::dispatcher-privacy-severity '("@draft")))))
+
+(test test-privacy-severity-nil
+  "v0.7.2: dispatcher-privacy-severity returns nil for untagged content."
+  (setf passepartout::*tag-categories* nil)
+  (is (null (passepartout::dispatcher-privacy-severity '("public")))))
+
 (test test-safe-tool-read-only-auto-approve
   "Contract v0.7.2: read-only tools pass dispatcher-check unconditionally."
   (setf (gethash "test-ro-tool" passepartout::*cognitive-tool-registry*)

org/security-dispatcher.org

@@ -266,6 +266,18 @@ Severity: :block (filter), :warn (log+include), :log (silent record).")
   "Return the severity keyword for TAG, or NIL if not found."
   (cdr (assoc tag *tag-categories* :test #'string-equal)))
 
+(defun dispatcher-privacy-severity (tags-list)
+  "Return the highest-severity tag match: :block > :warn > :log, or nil."
+  (when (and tags-list (listp tags-list))
+    (let ((highest nil))
+      (dolist (tag tags-list)
+        (let ((sev (tag-category-severity tag)))
+          (when (or (eq sev :block)
+                    (and (eq sev :warn) (not (eq highest :block)))
+                    (and (eq sev :log) (null highest)))
+            (setf highest sev))))
+      highest)))
+
 (tag-categories-load)
 #+end_src
 ** dispatcher-check-text-for-privacy
@@ -480,12 +492,21 @@ Eleven checks: 0=REPL-lint (warn-only), 1=lisp-validation, 2=secret-path,
                :payload (list :level :error
                               :text (format nil "Action blocked: Potential exposure of '~a'" secret-name)))))
 
-      ;; Vector 5: Privacy-tagged content in action
-      ((and tags (dispatcher-check-privacy-tags tags))
-       (log-message "PRIVACY VIOLATION: Action contains privacy-tagged content")
-       (list :type :LOG
-             :payload (list :level :warn
-                            :text "Action blocked: Content tagged with privacy filter.")))
+       ;; Vector 5: Privacy-tagged content (severity tiers)
+       ((and tags (fboundp 'dispatcher-privacy-severity))
+        (let ((severity (dispatcher-privacy-severity tags)))
+          (cond
+            ((eq severity :block)
+             (log-message "PRIVACY VIOLATION: Blocked by @tag — ~a" tags)
+             (list :type :LOG
+                   :payload (list :level :error
+                                  :text (format nil "Action blocked: Content tagged with privacy filter (~a)." tags))))
+            ((eq severity :warn)
+             (log-message "PRIVACY WARNING: @tag ~a (allowed with warning)" tags)
+             action)
+            ((eq severity :log)
+             (log-message "PRIVACY: @tag ~a (logged)" tags)
+             action))))
 
       ;; Vector 6: Text leaks privacy tag names
       ((and text (dispatcher-check-text-for-privacy text))
@@ -811,6 +832,21 @@ Recognized formats:
   "Contract v0.7.2: unknown tag returns nil."
   (is (null (passepartout::tag-category-severity "@nonexistent-xxxx"))))
 
+(test test-privacy-severity-block
+  "v0.7.2: dispatcher-privacy-severity returns :block for block-tagged content."
+  (setf passepartout::*tag-categories* '(("@personal" . :block)))
+  (is (eq :block (passepartout::dispatcher-privacy-severity '("@personal")))))
+
+(test test-privacy-severity-warn
+  "v0.7.2: dispatcher-privacy-severity returns :warn for warn-tagged content."
+  (setf passepartout::*tag-categories* '(("@draft" . :warn)))
+  (is (eq :warn (passepartout::dispatcher-privacy-severity '("@draft")))))
+
+(test test-privacy-severity-nil
+  "v0.7.2: dispatcher-privacy-severity returns nil for untagged content."
+  (setf passepartout::*tag-categories* nil)
+  (is (null (passepartout::dispatcher-privacy-severity '("public")))))
+
 (test test-safe-tool-read-only-auto-approve
   "Contract v0.7.2: read-only tools pass dispatcher-check unconditionally."
   (setf (gethash "test-ro-tool" passepartout::*cognitive-tool-registry*)