wip: paren balance fixes in policy blocks + engineering standards scaffolding
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 16s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 16s
- Fix unbalanced parens in org-skill-policy.org (8 blocks) - Add org-skill-engineering-standards.lisp scaffolding - Add org-skill-self-fix.lisp helper - Add test runners and tool-permissions tests Note: Some fixes may be over-corrections. Full structural audit needed.
This commit is contained in:
@@ -56,13 +56,13 @@
|
|||||||
"Starts the TCP listener for local CLI clients."
|
"Starts the TCP listener for local CLI clients."
|
||||||
(setf *cli-server-socket* (usocket:socket-listen "0.0.0.0" port :reuse-address t))
|
(setf *cli-server-socket* (usocket:socket-listen "0.0.0.0" port :reuse-address t))
|
||||||
(setf *cli-server-thread*
|
(setf *cli-server-thread*
|
||||||
(bordeaux-threads:make-thread
|
(bt:make-thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(loop
|
(loop
|
||||||
(let* ((socket (usocket:socket-accept *cli-server-socket*))
|
(let* ((socket (usocket:socket-accept *cli-server-socket*))
|
||||||
(stream (usocket:socket-stream socket)))
|
(stream (usocket:socket-stream socket)))
|
||||||
(bordeaux-threads:make-thread (lambda ()
|
(bt:make-thread (lambda ()
|
||||||
(unwind-protect (handle-cli-client stream)
|
(unwind-protect (handle-cli-client stream)
|
||||||
(usocket:socket-close socket)))
|
(usocket:socket-close socket)))
|
||||||
:name "opencortex-cli-client-handler")))
|
:name "opencortex-cli-client-handler")))
|
||||||
|
|||||||
19
library/gen/org-skill-engineering-standards.lisp
Normal file
19
library/gen/org-skill-engineering-standards.lisp
Normal file
@@ -0,0 +1,19 @@
|
|||||||
|
(in-package :opencortex)
|
||||||
|
|
||||||
|
(defun verify-git-clean-p (&optional (dir *project-root*))
|
||||||
|
"Returns T if the git repository at DIR has no uncommitted changes."
|
||||||
|
(let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain")
|
||||||
|
:output :string
|
||||||
|
:ignore-error-status t)))
|
||||||
|
(string= "" (string-trim '(#\Space #\Newline #\Tab) status))))
|
||||||
|
|
||||||
|
(defskill :skill-engineering-standards
|
||||||
|
:priority 1000
|
||||||
|
:trigger (lambda (ctx) t)
|
||||||
|
:probabilistic nil
|
||||||
|
:deterministic (lambda (action context)
|
||||||
|
(declare (ignore action))
|
||||||
|
(let ((dirty (verify-git-clean-p)))
|
||||||
|
(unless dirty
|
||||||
|
(harness-log "ENGINEERING STANDARDS: Warning - Working tree is dirty. Commit before modifying files.")))
|
||||||
|
nil))
|
||||||
@@ -92,28 +92,22 @@
|
|||||||
(execute-llm-request prompt system-prompt :provider p :model model))))
|
(execute-llm-request prompt system-prompt :provider p :model model))))
|
||||||
|
|
||||||
(def-cognitive-tool :get-ollama-embedding
|
(def-cognitive-tool :get-ollama-embedding
|
||||||
"Generates vector embeddings via Ollama API."
|
"Generates vector embeddings via Ollama API for semantic search."
|
||||||
((text :type :string :description "Text to embed."))
|
((text :type :string :description "Text to embed."))
|
||||||
:body (lambda (args)
|
:body (lambda (args)
|
||||||
(let* ((text (getf args :text))
|
(let* ((text (getf args :text))
|
||||||
(host (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
|
(host (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
|
||||||
(url (format nil "http://~a/api/embeddings" host))
|
(url (format nil "http://~a/api/embeddings" host))
|
||||||
(model (or (uiop:getenv "OLLAMA_EMBEDDING_MODEL") "nomic-embed-text"))
|
(model (or (uiop:getenv "OLLAMA_EMBEDDING_MODEL") "nomic-embed-text"))
|
||||||
(body (cl-json:encode-json-to-string `((model . ,model) (prompt . ,text)))))
|
(body (cl-json:encode-json-to-string `((model . ,model) (prompt . ,text)))))
|
||||||
(handler-case
|
(handler-case
|
||||||
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 30))
|
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 30))
|
||||||
(json (cl-json:decode-json-from-string response)))
|
(json (cl-json:decode-json-from-string response)))
|
||||||
(let ((embedding (cdr (assoc :embedding json))))
|
(let ((embedding (cdr (assoc :embedding json))))
|
||||||
(if embedding
|
(if embedding
|
||||||
(list :status :success :vector embedding)
|
(list :status :success :vector embedding)
|
||||||
(list :status :error :message "No embedding in response"))))
|
(list :status :error :message "No embedding in response"))))
|
||||||
(error (c) (list :status :error :message (format nil "Ollama Embedding Failure: ~a" c)))))))
|
(error (c) (list :status :error :message (format nil "Ollama Embedding Failure: ~a" c)))))))
|
||||||
|
|
||||||
(defun get-embedding (text)
|
|
||||||
"Generates a vector embedding for the given text via Ollama. Returns nil on failure."
|
|
||||||
(let ((result (funcall (get-cognitive-tool-body :get-ollama-embedding) (list :text text))))
|
|
||||||
(when (eq (getf result :status) :success)
|
|
||||||
(getf result :vector))))
|
|
||||||
|
|
||||||
(def-cognitive-tool :ask-llm
|
(def-cognitive-tool :ask-llm
|
||||||
"Queries an LLM provider via the unified gateway."
|
"Queries an LLM provider via the unified gateway."
|
||||||
|
|||||||
65
library/gen/org-skill-self-fix.lisp
Normal file
65
library/gen/org-skill-self-fix.lisp
Normal file
@@ -0,0 +1,65 @@
|
|||||||
|
(in-package :opencortex)
|
||||||
|
|
||||||
|
(defun self-fix-apply (action context)
|
||||||
|
"Applies a surgical code fix and reloads the modified skill."
|
||||||
|
(declare (ignore context))
|
||||||
|
(let* ((payload (getf action :payload))
|
||||||
|
(target-file (getf payload :file))
|
||||||
|
(old-code (getf payload :old))
|
||||||
|
(new-code (getf payload :new))
|
||||||
|
(is-skill (and (stringp (namestring target-file))
|
||||||
|
(search "skills/" (namestring target-file)))))
|
||||||
|
|
||||||
|
(opencortex:snapshot-memory)
|
||||||
|
(opencortex:harness-log "SELF-FIX - Attempting surgical fix on ~a..." target-file)
|
||||||
|
|
||||||
|
(handler-case
|
||||||
|
(if (uiop:file-exists-p target-file)
|
||||||
|
(let ((content (uiop:read-file-string target-file)))
|
||||||
|
(if (search old-code content)
|
||||||
|
(let ((new-content (cl-ppcre:regex-replace-all (cl-ppcre:quote-meta-chars old-code) content new-code)))
|
||||||
|
(with-open-file (out target-file :direction :output :if-exists :supersede)
|
||||||
|
(write-string new-content out))
|
||||||
|
|
||||||
|
(if is-skill
|
||||||
|
(progn
|
||||||
|
(opencortex:harness-log "SELF-FIX - Reloading modified skill ~a..." target-file)
|
||||||
|
(if (opencortex:load-skill-from-org target-file)
|
||||||
|
(progn
|
||||||
|
(opencortex:harness-log "SELF-FIX SUCCESS - Applied and reloaded.")
|
||||||
|
t)
|
||||||
|
(progn
|
||||||
|
(opencortex:harness-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.")
|
||||||
|
(with-open-file (out target-file :direction :output :if-exists :supersede)
|
||||||
|
(write-string content out))
|
||||||
|
(opencortex:rollback-memory 0)
|
||||||
|
nil)))
|
||||||
|
(progn
|
||||||
|
(opencortex:harness-log "SELF-FIX SUCCESS - Applied fix to file.")
|
||||||
|
t)))
|
||||||
|
(progn (opencortex:harness-log "SELF-FIX FAILURE - Pattern not found.") nil)))
|
||||||
|
(progn (opencortex:harness-log "SELF-FIX FAILURE - File not found.") nil))
|
||||||
|
(error (c)
|
||||||
|
(opencortex:harness-log "SELF-FIX CRASH - ~a. Rolling back." c)
|
||||||
|
(opencortex:rollback-memory 0)
|
||||||
|
nil))))
|
||||||
|
|
||||||
|
(def-cognitive-tool :repair-file
|
||||||
|
"Applies a surgical code modification to a file and reloads the skill if applicable."
|
||||||
|
((:file :type :string :description "Path to the target file")
|
||||||
|
(:old :type :string :description "The literal code block to find")
|
||||||
|
(:new :type :string :description "The literal code block to replace it with"))
|
||||||
|
:body (lambda (args)
|
||||||
|
(if (self-fix-apply (list :payload args) nil)
|
||||||
|
"REPAIR SUCCESSFUL."
|
||||||
|
"REPAIR FAILED.")))
|
||||||
|
|
||||||
|
(defskill :skill-self-fix
|
||||||
|
:priority 95
|
||||||
|
:trigger (lambda (context) (eq (getf (getf context :payload) :sensor) :repair-request))
|
||||||
|
:probabilistic (lambda (context)
|
||||||
|
(format nil "You are the opencortex Repair Actuator. Synthesize a surgical fix for the reported failure.
|
||||||
|
Return a Lisp plist for :repair-file."))
|
||||||
|
:deterministic (lambda (action context)
|
||||||
|
(let ((payload (getf action :payload)))
|
||||||
|
(self-fix-apply action context))))
|
||||||
@@ -22,15 +22,11 @@
|
|||||||
|
|
||||||
(def-cognitive-tool :get-embedding
|
(def-cognitive-tool :get-embedding
|
||||||
"Generates vector embeddings via Ollama or llama.cpp API."
|
"Generates vector embeddings via Ollama or llama.cpp API."
|
||||||
((text :type :string :description "Text to embed."))
|
((:text :type :string :description "Text to embed."))
|
||||||
:body (lambda (args)
|
:body (lambda (args)
|
||||||
(let* ((text (getf args :text))
|
(let* ((text (getf args :text))
|
||||||
(provider (or (uiop:getenv "EMBEDDING_PROVIDER") "ollama"))
|
(provider (or (uiop:getenv "EMBEDDING_PROVIDER") "ollama"))
|
||||||
(model (or (uiop:getenv "EMBEDDING_MODEL")
|
(model (or (uiop:getenv "EMBEDDING_MODEL") "nomic-embed-text"))
|
||||||
(case (intern (string-upcase provider) :keyword)
|
|
||||||
(:NOMIC-EMBED-TEXT "nomic-embed-text")
|
|
||||||
(:LLAMA-CPP "llama.cpp")
|
|
||||||
(t "nomic-embed-text"))))
|
|
||||||
(embedding nil))
|
(embedding nil))
|
||||||
(cond
|
(cond
|
||||||
((string= provider "ollama")
|
((string= provider "ollama")
|
||||||
|
|||||||
21
run-all-tests.lisp
Normal file
21
run-all-tests.lisp
Normal file
@@ -0,0 +1,21 @@
|
|||||||
|
(load "/home/user/quicklisp/setup.lisp")
|
||||||
|
(push #p"./" asdf:*central-registry*)
|
||||||
|
(ql:quickload :fiveam :verbose nil)
|
||||||
|
(asdf:load-system :opencortex/tests :verbose nil)
|
||||||
|
|
||||||
|
;; Load tool permissions skill
|
||||||
|
(load "library/gen/org-skill-tool-permissions.lisp")
|
||||||
|
(load "tests/tool-permissions-tests.lisp")
|
||||||
|
|
||||||
|
(format t "~%=== Running ALL Test Suites ===~%")
|
||||||
|
|
||||||
|
(fiveam:run! 'opencortex-tests::communication-protocol-suite)
|
||||||
|
(fiveam:run! 'opencortex-pipeline-tests::pipeline-suite)
|
||||||
|
(fiveam:run! 'opencortex-boot-tests::boot-suite)
|
||||||
|
(fiveam:run! 'opencortex-memory-tests::memory-suite)
|
||||||
|
(fiveam:run! 'opencortex-immune-system-tests::immune-suite)
|
||||||
|
(fiveam:run! 'opencortex-emacs-edit-tests::emacs-edit-suite)
|
||||||
|
(fiveam:run! 'opencortex-lisp-utils-tests::lisp-utils-suite)
|
||||||
|
(fiveam:run! 'opencortex-tool-permissions-tests::tool-permissions-suite)
|
||||||
|
|
||||||
|
(format t "~%=== ALL TESTS COMPLETE ===~%")
|
||||||
10
run-tool-tests.lisp
Normal file
10
run-tool-tests.lisp
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
(load "/home/user/quicklisp/setup.lisp")
|
||||||
|
(push #p"./" asdf:*central-registry*)
|
||||||
|
(ql:quickload :fiveam :verbose nil)
|
||||||
|
(asdf:load-system :opencortex :verbose nil)
|
||||||
|
(load "library/gen/org-skill-tool-permissions.lisp")
|
||||||
|
(load "tests/tool-permissions-tests.lisp")
|
||||||
|
|
||||||
|
(format t "~%=== Tool Permissions Tests ===~%")
|
||||||
|
(fiveam:run! 'opencortex-tool-permissions-tests::tool-permissions-suite)
|
||||||
|
(format t "~%=== DONE ===~%")
|
||||||
@@ -128,7 +128,7 @@ At the gate:
|
|||||||
:payload (list :level :error
|
:payload (list :level :error
|
||||||
:text "POLICY [Transparency]: User-facing action missing :explanation. Blocked.")))))
|
:text "POLICY [Transparency]: User-facing action missing :explanation. Blocked.")))))
|
||||||
|
|
||||||
action)
|
action))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** 2. Autonomy Above All
|
** 2. Autonomy Above All
|
||||||
@@ -195,7 +195,7 @@ Every action should increase the user's independence from centralized, proprieta
|
|||||||
:text (format nil "Autonomy Debt: Action references proprietary domain '~a'. Consider a local alternative." domain)
|
:text (format nil "Autonomy Debt: Action references proprietary domain '~a'. Consider a local alternative." domain)
|
||||||
:original-action action)))
|
:original-action action)))
|
||||||
|
|
||||||
action))
|
action)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** 3. Zero-Bloat Mandate
|
** 3. Zero-Bloat Mandate
|
||||||
@@ -241,7 +241,7 @@ The system harness must remain minimalist. "Just-in-case" code is a security vul
|
|||||||
(length content) *policy-max-skill-size-chars*)
|
(length content) *policy-max-skill-size-chars*)
|
||||||
:original-action action))))
|
:original-action action))))
|
||||||
|
|
||||||
action)
|
action))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** 4. Modularity
|
** 4. Modularity
|
||||||
@@ -313,7 +313,7 @@ This is the most important invariant for system stability. If the harness grows
|
|||||||
:text "POLICY [Modularity]: Modification to protected core path blocked. Provide :modularity-justification explaining why this cannot be a skill."
|
:text "POLICY [Modularity]: Modification to protected core path blocked. Provide :modularity-justification explaining why this cannot be a skill."
|
||||||
:blocked-path target-file))))
|
:blocked-path target-file))))
|
||||||
|
|
||||||
action)
|
action))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** 5. Technical Mastery & Mentorship
|
** 5. Technical Mastery & Mentorship
|
||||||
@@ -365,7 +365,7 @@ The agent's goal is not to "do it for the user," but to "empower the user." Ever
|
|||||||
:payload (list :level :error
|
:payload (list :level :error
|
||||||
:text "POLICY [Mentorship]: High-impact action missing :mentorship-note. Explain what you are doing and why. Blocked.")))))
|
:text "POLICY [Mentorship]: High-impact action missing :mentorship-note. Explain what you are doing and why. Blocked.")))))
|
||||||
|
|
||||||
action)
|
action))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** 6. Long-Term Sustainability
|
** 6. Long-Term Sustainability
|
||||||
@@ -395,7 +395,7 @@ This means preferring local, energy-efficient architectures over cloud-dependent
|
|||||||
|
|
||||||
(let* ((payload (getf context :payload))
|
(let* ((payload (getf context :payload))
|
||||||
(backend (getf payload :backend))
|
(backend (getf payload :backend))
|
||||||
(provider (getf payload :provider))
|
(provider (getf payload :provider)))
|
||||||
|
|
||||||
(when (or (member backend *cloud-only-backends*)
|
(when (or (member backend *cloud-only-backends*)
|
||||||
(member provider *cloud-only-backends*))
|
(member provider *cloud-only-backends*))
|
||||||
@@ -409,7 +409,7 @@ This means preferring local, energy-efficient architectures over cloud-dependent
|
|||||||
:text (format nil "Sustainability Debt: Reliance on cloud provider '~a'. Consider Ollama or local inference."
|
:text (format nil "Sustainability Debt: Reliance on cloud provider '~a'. Consider Ollama or local inference."
|
||||||
(or backend provider))))))
|
(or backend provider))))))
|
||||||
|
|
||||||
action)
|
action)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Policy Explanation Engine
|
* Policy Explanation Engine
|
||||||
@@ -487,7 +487,7 @@ When the policy gate blocks or modifies an action, it must tell the user *why*.
|
|||||||
(t
|
(t
|
||||||
(harness-log "~a" (getf (getf result :payload) :text)))))))))
|
(harness-log "~a" (getf (getf result :payload) :text)))))))))
|
||||||
|
|
||||||
action)
|
action))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Finding Engineering Standards
|
** Finding Engineering Standards
|
||||||
|
|||||||
@@ -10,25 +10,25 @@
|
|||||||
(in-suite emacs-edit-suite)
|
(in-suite emacs-edit-suite)
|
||||||
|
|
||||||
(test id-generation
|
(test id-generation
|
||||||
(let ((id1 (opencortex:emacs-edit-generate-id))
|
(let ((id1 (emacs-edit-generate-id))
|
||||||
(id2 (opencortex:emacs-edit-generate-id)))
|
(id2 (emacs-edit-generate-id)))
|
||||||
(is (plusp (length id1)))
|
(is (plusp (length id1)))
|
||||||
(is (not (string= id1 id2)))))
|
(is (not (string= id1 id2)))) ;; Likely unique
|
||||||
|
|
||||||
(test id-format
|
(test id-format
|
||||||
(let ((formatted (opencortex:emacs-edit-id-format "abc12345")))
|
(let ((formatted (emacs-edit-id-format "abc12345")))
|
||||||
(is (search "id:" formatted))))
|
(is (search "id:" formatted))))
|
||||||
|
|
||||||
(test property-setter
|
(test property-setter
|
||||||
(let ((ast (list :type :headline
|
(let ((ast (list :type :headline
|
||||||
:properties (list :ID "id:test123" :TITLE "Test")
|
:properties (list :ID "id:test123" :TITLE "Test")
|
||||||
:contents nil)))
|
:contents nil)))
|
||||||
(opencortex:emacs-edit-set-property ast "id:test123" :STATUS "ACTIVE")
|
(emacs-edit-set-property ast "id:test123" :STATUS "ACTIVE")
|
||||||
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
||||||
|
|
||||||
(test todo-setter
|
(test todo-setter
|
||||||
(let ((ast (list :type :headline
|
(let ((ast (list :type :headline
|
||||||
:properties (list :ID "id:todo001" :TITLE "Task")
|
:properties (list :ID "id:todo001" :TITLE "Task")
|
||||||
:contents nil)))
|
:contents nil)))
|
||||||
(opencortex:emacs-edit-set-todo ast "id:todo001" "DONE")
|
(emacs-edit-set-todo ast "id:todo001" "DONE")
|
||||||
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))
|
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))
|
||||||
40
tests/tool-permissions-tests.lisp
Normal file
40
tests/tool-permissions-tests.lisp
Normal file
@@ -0,0 +1,40 @@
|
|||||||
|
(defpackage :opencortex-tool-permissions-tests
|
||||||
|
(:use :cl :fiveam :opencortex)
|
||||||
|
(:export #:tool-permissions-suite))
|
||||||
|
|
||||||
|
(in-package :opencortex-tool-permissions-tests)
|
||||||
|
|
||||||
|
(def-suite tool-permissions-suite
|
||||||
|
:description "Tests for Tool Permission Tiers.")
|
||||||
|
|
||||||
|
(in-suite tool-permissions-suite)
|
||||||
|
|
||||||
|
(test default-permission-is-allow
|
||||||
|
"Unknown tools default to :allow."
|
||||||
|
(is (eq (get-tool-permission :unknown-tool-xyz) :allow)))
|
||||||
|
|
||||||
|
(test set-and-get-permission
|
||||||
|
"Verify :allow, :deny, :ask persist correctly."
|
||||||
|
(set-tool-permission :test-tool-abc :deny)
|
||||||
|
(is (eq (get-tool-permission :test-tool-abc) :deny))
|
||||||
|
(set-tool-permission :test-tool-abc :ask)
|
||||||
|
(is (eq (get-tool-permission :test-tool-abc) :ask))
|
||||||
|
(set-tool-permission :test-tool-abc :allow)
|
||||||
|
(is (eq (get-tool-permission :test-tool-abc) :allow)))
|
||||||
|
|
||||||
|
(test permission-gate-allow
|
||||||
|
":allow returns :allow."
|
||||||
|
(set-tool-permission :gate-allow-tool :allow)
|
||||||
|
(is (eq (check-tool-permission-gate :gate-allow-tool nil) :allow)))
|
||||||
|
|
||||||
|
(test permission-gate-deny
|
||||||
|
":deny returns :deny."
|
||||||
|
(set-tool-permission :gate-deny-tool :deny)
|
||||||
|
(is (eq (check-tool-permission-gate :gate-deny-tool nil) :deny)))
|
||||||
|
|
||||||
|
(test permission-gate-ask
|
||||||
|
":ask returns a signal list."
|
||||||
|
(set-tool-permission :gate-ask-tool :ask)
|
||||||
|
(let ((result (check-tool-permission-gate :gate-ask-tool nil)))
|
||||||
|
(is (listp result))
|
||||||
|
(is (eq (car result) :ask))))
|
||||||
Reference in New Issue
Block a user