diff --git a/org-agent.asd b/org-agent.asd index 0a710f2..4a726f0 100644 --- a/org-agent.asd +++ b/org-agent.asd @@ -8,9 +8,12 @@ :serial t :components ((:file "src/package") (:file "src/protocol") + (:file "src/protocol-validator") (:file "src/object-store") (:file "src/embedding") + (:file "src/embedding-logic") (:file "src/context") + (:file "src/context-logic") (:file "src/skills") (:file "src/neuro") (:file "src/credentials-vault") diff --git a/src/bouncer.lisp b/src/bouncer.lisp index 498a80b..c507eca 100644 --- a/src/bouncer.lisp +++ b/src/bouncer.lisp @@ -1,5 +1,3 @@ -(in-package :org-agent) - (defun bouncer-scan-secrets (text) "Returns the name of the secret found in TEXT, or NIL if clean." (when (and text (stringp text)) diff --git a/src/chaos-logic.lisp b/src/chaos-logic.lisp index 0ec6596..8511ff0 100644 --- a/src/chaos-logic.lisp +++ b/src/chaos-logic.lisp @@ -1,21 +1,43 @@ +(in-package :org-agent) + (defun chaos-inject-error (sensor-type) "Injects a synthetic error into a specific sensor pipeline." - (org-agent:kernel-log "CHAOS - Injecting synthetic error into ~a sensor..." sensor-type) - (org-agent:inject-stimulus + (unless *chaos-enabled-p* + (kernel-log "CHAOS ERROR - Injection blocked. Production gate is ACTIVE.") + (return-from chaos-inject-error nil)) + (kernel-log "CHAOS - Injecting synthetic error into ~a sensor..." sensor-type) + (inject-stimulus `(:type :EVENT :payload (:sensor ,sensor-type :error "SYNTHETIC_CHAOS_ERROR")))) (defun chaos-stress-test (action context) "Executes a randomized stress test by injecting failures into the system." (declare (ignore context)) + (unless *chaos-enabled-p* + (kernel-log "CHAOS ERROR - Stress test blocked. Production gate is ACTIVE.") + (return-from chaos-stress-test "FAILURE - Production gate active.")) (let* ((payload (getf action :payload)) (mode (or (getf payload :mode) :random)) (intensity (or (getf payload :intensity) 3))) - (org-agent:kernel-log "CHAOS - Commencing stress test (Mode: ~a, Intensity: ~a)" mode intensity) + (kernel-log "CHAOS - Commencing stress test (Mode: ~a, Intensity: ~a)" mode intensity) + (snapshot-object-store) (case mode (:random (dotimes (i intensity) (let ((failure-type (nth (random 3) '(:test-failure :shell-timeout :llm-error)))) - (org-agent:inject-stimulus + (inject-stimulus `(:type :EVENT :payload (:sensor :chaos-injection :type ,failure-type)))))) - (:shell (org-agent:inject-stimulus + (:shell (inject-stimulus `(:type :EVENT :payload (:sensor :shell-response :cmd "git push" :exit-code 128 :stderr "fatal: network unreachable"))))) + (snapshot-object-store) (format nil "SUCCESS - Chaos stress test initiated."))) + +(defun chaos-enable () + "Disables the production gate and allows chaos injection." + (setf *chaos-enabled-p* t) + (kernel-log "CHAOS - Production gate DISABLED. Chaos injection is now ALLOWED.") + t) + +(defun chaos-disable () + "Enables the production gate and blocks chaos injection." + (setf *chaos-enabled-p* nil) + (kernel-log "CHAOS - Production gate ENABLED. Chaos injection is now BLOCKED.") + t) diff --git a/src/core.lisp b/src/core.lisp index 549c5ec..beeb991 100644 --- a/src/core.lisp +++ b/src/core.lisp @@ -2,8 +2,14 @@ (defvar *interrupt-flag* nil) +;; MOVED TO package.lisp + (defvar *interrupt-lock* (bt:make-lock "kernel-interrupt-lock")) +;; MOVED TO package.lisp + +;; MOVED TO package.lisp + (defun dispatch-action (action context) "Routes an approved action to its registered physical actuator." (when (and action (listp action)) @@ -13,54 +19,86 @@ (funcall actuator-fn action context) (kernel-log "DISPATCH ERROR: No actuator for ~a" target))))) -(defun inject-stimulus (stimulus &key stream) - "Entry point for all external stimuli." - (let ((signal (list :type (getf stimulus :type) - :payload (getf stimulus :payload) - :status :inbound - :reply-stream stream - :depth 0))) - (bt:make-thread (lambda () (process-signal signal)) :name "signal-processor"))) +(defun kernel-track-telemetry (skill-name duration status) + "Updates performance metrics for a specific skill." + (when skill-name (bt:with-lock-held (*telemetry-lock*) + (let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0)))) + (incf (getf entry :executions)) (incf (getf entry :total-time) duration) + (when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry))))) -(defun process-signal (signal) - "Iterative signal processing pipeline." - (loop - (let ((status (getf signal :status))) - (case status - (:inbound (setq signal (perceive-gate signal))) - (:perceived (setq signal (neuro-gate signal))) - (:reasoned (setq signal (consensus-gate signal))) - (:consensus (setq signal (decide-gate signal))) - (:decided (setq signal (dispatch-gate signal))) - (:dispatched (return-from process-signal signal)) - (t (kernel-log "PIPELINE ERROR: Unknown status ~a" status) - (return-from process-signal signal)))))) +(defun kernel-log (fmt &rest args) + "Records a formatted message to the system log and standard output." + (let ((msg (apply #'format nil fmt args))) + (bt:with-lock-held (*logs-lock*) (push msg *system-logs*) (when (> (length *system-logs*) *max-log-history*) (setf *system-logs* (subseq *system-logs* 0 *max-log-history*)))) + (format t "~a~%" msg) (finish-output))) + +(defun inject-stimulus (raw-message &key stream (depth 0)) + "Enqueues a raw message into the reactive signal pipeline, handling async/sync execution and recovery." + (let* ((payload (getf raw-message :payload)) + (sensor (getf payload :sensor)) + ;; Force Chat and Delegation to be async + (async-p (or (getf payload :async-p) (member sensor '(:chat-message :delegation :user-command))))) + (when stream (setf (getf raw-message :reply-stream) stream)) + (if async-p (bt:make-thread (lambda () (restart-case (handler-bind ((error (lambda (c) (kernel-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event)))) + (process-signal raw-message)) (skip-event () nil))) :name "org-agent-async-task") + (restart-case (handler-bind ((error (lambda (c) (kernel-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event)))) (process-signal raw-message)) + (skip-event () (kernel-log "SYSTEM RECOVERY: Stimulus dropped.~%")))))) + +(defun execute-system-action (action context) + "Processes internal kernel commands like skill creation or environment updates." + (declare (ignore context)) + (let* ((payload (ignore-errors (getf action :payload))) (cmd (ignore-errors (getf payload :action)))) + (case cmd + (:eval (let ((code (getf payload :code))) + (kernel-log "ACTUATOR [System] - Evaluating: ~a" code) + (handler-case (let ((result (eval (read-from-string code)))) + (kernel-log "ACTUATOR [System] - Result: ~s" result) + result) + (error (c) (kernel-log "ACTUATOR ERROR [System] - Eval failed: ~a" c))))) + (:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content)) + (skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent))) (full-path (merge-pathnames filename skills-dir))) + (kernel-log "ACTUATOR [System] - Creating skill ~a..." filename) + (with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out)) + (load-skill-from-org full-path))) + (:set-cascade (setf *provider-cascade* (getf payload :cascade))) + (:message (kernel-log "ACTUATOR [System] - ~a" (getf payload :text))) + (t (kernel-log "ACTUATOR [System] - Unknown command ~s" cmd))))) (defun perceive-gate (signal) - "Stage 1: Context assembly and signal enrichment." + "Initial processing: Normalizes raw stimuli and updates memory." (let* ((payload (getf signal :payload)) + (type (getf signal :type)) (sensor (getf payload :sensor))) - (kernel-log "GATE [Perceive]: ~a (~a)" (getf signal :type) (or sensor "no-sensor")) - (setf (getf signal :context) (context-assemble-global-awareness)) + (kernel-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor")) + (snapshot-object-store) + (cond ((eq type :EVENT) + (case sensor + (:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast)))) + (:point-update (let ((element (getf payload :element))) (when element (ingest-ast element)))) + (:interrupt (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t))))) + ((eq type :RESPONSE) + (kernel-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status)))) (setf (getf signal :status) :perceived) signal)) (defun neuro-gate (signal) - "Stage 2: Neural reasoning (System 1)." - (let* ((context (getf signal :context)) - (skill (find-triggered-skill signal))) - (if skill - (let ((neuro-fn (skill-neuro-prompt skill))) - (if neuro-fn - (let ((proposals (funcall neuro-fn signal))) - (setf (getf signal :proposals) (if (and (listp proposals) (listp (first proposals))) proposals (list proposals)))) - (setf (getf signal :proposals) nil))) - (setf (getf signal :proposals) nil)) - (setf (getf signal :status) :reasoned) + "Associative: Intuition and proposed actions." + (unless (eq (getf signal :type) :EVENT) + (return-from neuro-gate signal)) + (kernel-log "GATE [Associative]: Consulting System 1...") + (let ((thoughts (think signal))) + (setf (getf signal :proposals) (if (and (listp thoughts) (listp (car thoughts))) + thoughts + (if thoughts (list thoughts) nil))) + (setf (getf signal :status) :thought) signal)) (defun resolve-consensus (proposals signal) - "Majority rules implementation." + "Resolves diverging proposals by voting or selecting the safest one." + (declare (ignore signal)) + (kernel-log "CONSENSUS: ~a proposals found. Resolving..." (length proposals)) + ;; Simplified consensus: Majority vote or first safe one + ;; For now, we'll select the proposal that appears most frequently. (let ((counts (make-hash-table :test 'equal))) (dolist (p proposals) (incf (gethash p counts 0))) @@ -84,17 +122,8 @@ (setf (getf signal :status) :consensus) signal)) -(defun delegate-task (task-id recipient &key context) - "Enqueues a task for another agent or background process." - (kernel-log "ORCHESTRATOR: Delegating task ~a to ~a" task-id recipient) - (inject-stimulus (list :type :EVENT - :payload (list :sensor :delegation - :task-id task-id - :recipient recipient - :context context)))) - (defun decide-gate (signal) - "Stage 3: Symbolic verification (System 2)." + "Deliberate: Safety and validation." (let ((candidate (getf signal :candidate))) (if candidate (let* ((normalized-candidate (if (listp candidate) candidate (list :type :RESPONSE :payload (list :text candidate)))) @@ -113,16 +142,102 @@ (case type (:REQUEST (dispatch-action signal signal)) (:EVENT - (when (and approved (eq (getf approved :type) :REQUEST)) - (dispatch-action approved signal)))) + (when approved + (let* ((payload (getf approved :payload)) + (target (getf approved :target)) + (action (or (getf payload :action) (getf approved :action))) + (tool-name (or (getf payload :tool) (getf approved :tool))) + (tool-args (or (getf payload :args) (getf approved :args)))) + (if (and (eq target :tool) (eq action :call)) + (let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tools*))) + (if tool + (handler-case + (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args)) + (result (funcall (cognitive-tool-body tool) clean-args))) + (setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream) + :payload (list :sensor :tool-output :result result :tool tool-name)))) + (error (c) + (setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream) + :payload (list :sensor :tool-error :tool tool-name :message (format nil "~a" c)))))) + (setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream) + :payload (list :sensor :tool-error :message "Tool not found"))))) + (let ((result (dispatch-action approved signal))) + (when (and result (not (member target '(:emacs :system-message)))) + (setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream) + :payload (list :sensor :tool-output :result result :tool approved)))))))))) (setf (getf signal :status) :dispatched) - signal)) + feedback)) + +(defun process-signal (signal) + "The entry point to the Reactive Signal Pipeline." + (let ((current-signal signal)) + (loop while current-signal do + (let ((depth (getf current-signal :depth 0))) + (when (> depth 10) + (kernel-log "PIPELINE ERROR: Max depth reached.") + (return nil)) + (when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) + (kernel-log "PIPELINE: Interrupted.") + (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil)) + (return nil)) + + (handler-case + (progn + (setf current-signal (perceive-gate current-signal)) + (setf current-signal (neuro-gate current-signal)) + (setf current-signal (consensus-gate current-signal)) + (setf current-signal (decide-gate current-signal)) + (setf current-signal (dispatch-gate current-signal))) + (error (c) + (kernel-log "PIPELINE CRASH: ~a - Initiating Micro-Rollback." c) + (rollback-object-store 0) + (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor)))) + (if (or (> depth 2) (member sensor '(:loop-error :tool-error))) + (setf current-signal nil) + (setf current-signal (list :type :EVENT :depth (1+ depth) :reply-stream (getf current-signal :reply-stream) + :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth))))))))))) + +(defun delegate-task (task-id recipient &key context) + "Enqueues a task for another agent or background process." + (kernel-log "ORCHESTRATOR: Delegating task ~a to ~a" task-id recipient) + (inject-stimulus (list :type :EVENT + :payload (list :sensor :delegation + :task-id task-id + :recipient recipient + :context context)))) + +(defvar *heartbeat-thread* nil) + +(defun start-heartbeat (&optional (interval 60)) + "Spawns a thread that periodically injects a heartbeat stimulus." + (setf *heartbeat-thread* + (bt:make-thread + (lambda () + (loop + (sleep interval) + (kernel-log "KERNEL: Heartbeat pulse...") + (inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time)))))) + :name "org-agent-heartbeat"))) + +(defun stop-heartbeat () + "Gracefully terminates the heartbeat pulse thread." + (when (and *heartbeat-thread* (bt:thread-alive-p *heartbeat-thread*)) + (bt:destroy-thread *heartbeat-thread*) + (setf *heartbeat-thread* nil))) + +(defun load-all-skills () + "Deprecated: use initialize-all-skills. Centralized boot orchestrator." + (initialize-all-skills)) (defun main () - "Production entry point for the org-agent daemon." - (load-dotenv) - (initialize-all-skills) - (kernel-log "KERNEL: Org-agent v1.0 starting up...") + "The entry point for the compiled standalone binary." + (let* ((home (uiop:getenv "HOME")) + (env-file (uiop:merge-pathnames* ".local/share/org-agent/.env" (uiop:ensure-directory-pathname home)))) + (if (uiop:file-exists-p env-file) + (progn + (format t "KERNEL: Loading environment from ~a~%" env-file) + (cl-dotenv:load-env env-file)) + (format t "KERNEL ERROR: .env not found at ~a~%" env-file))) (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL") :junk-allowed t)) 60))) (format t "KERNEL: Heartbeat interval set to ~a seconds.~%" interval) (start-daemon :interval interval)) diff --git a/src/llm-gateway.lisp b/src/llm-gateway.lisp index 02c7b03..202109f 100644 --- a/src/llm-gateway.lisp +++ b/src/llm-gateway.lisp @@ -81,14 +81,12 @@ :provider (getf args :provider) :model (getf args :model)))) -(progn - ;; Register all supported backends with the kernel - (dolist (p '(:anthropic :gemini-api :gemini-web :groq :ollama :openai :openrouter)) - (org-agent:register-neuro-backend p (lambda (prompt system-prompt &key model) - (execute-llm-request prompt system-prompt :provider p :model model)))) - - (defskill :skill-llm-gateway - :priority 150 ; Higher than individual old skills - :trigger (lambda (context) nil) - :neuro (lambda (context) nil) - :symbolic (lambda (action context) action))) +(dolist (p '(:anthropic :gemini-api :gemini-web :groq :ollama :openai :openrouter)) + (org-agent:register-neuro-backend p (lambda (prompt system-prompt &key model) + (execute-llm-request prompt system-prompt :provider p :model model)))) + +(defskill :skill-llm-gateway + :priority 150 ; Higher than individual old skills + :trigger (lambda (context) (declare (ignore context)) nil) + :neuro (lambda (context) (declare (ignore context)) nil) + :symbolic (lambda (action context) (declare (ignore context)) action)) diff --git a/src/neuro.lisp b/src/neuro.lisp index baf3843..65388e9 100644 --- a/src/neuro.lisp +++ b/src/neuro.lisp @@ -26,14 +26,16 @@ (list :api-key legacy))))))))) (defvar *neuro-backends* (make-hash-table :test 'equal)) + (defvar *provider-cascade* '(:openrouter :gemini)) -(defvar *consensus-enabled-p* t "If T, ask-neuro queries all backends in parallel.") (defun register-neuro-backend (name fn) (setf (gethash name *neuro-backends*) fn)) (defvar *model-selector-fn* nil "A function called with (provider context) to return a model ID.") -(defun ask-neuro (prompt &key (system-prompt "You are the System 1 engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil)) +(defvar *consensus-enabled-p* t "If T, ask-neuro queries all backends in parallel.") + +(defun ask-neuro (prompt &key (system-prompt "You are the Associative engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil)) "Dispatches a neural request through the provider cascade or parallel consensus." (let ((backends (cond ((and cascade (listp cascade)) cascade) @@ -49,7 +51,7 @@ (when backend-fn (push (bt:make-thread (lambda () - (kernel-log "SYSTEM 1 [Consensus]: Querying backend ~a..." backend) + (kernel-log "ASSOCIATIVE [Consensus]: Querying backend ~a..." backend) (let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context))) (result (ignore-errors (if model @@ -73,7 +75,7 @@ (or (dolist (backend backends) (let ((backend-fn (gethash backend *neuro-backends*))) (when backend-fn - (kernel-log "SYSTEM 1: Attempting backend ~a..." backend) + (kernel-log "ASSOCIATIVE: Attempting backend ~a..." backend) (let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context))) (result (if model (funcall backend-fn prompt system-prompt :model model) @@ -88,13 +90,14 @@ '(:openrouter :gemini)) (defun think (context) - "Invokes the neural System 1 engine to propose a Lisp action based on context." + "Invokes the neural Associative engine to propose a Lisp action based on context. +If consensus is enabled, it returns a list of proposals from different backends." (let ((active-skill (find-triggered-skill context)) (tool-belt (generate-tool-belt-prompt)) (global-context (context-assemble-global-awareness))) (if active-skill (progn - (kernel-log "SYSTEM 1: Engaging skill '~a'~%" (skill-name active-skill)) + (kernel-log "ASSOCIATIVE: Engaging skill '~a'~%" (skill-name active-skill)) (let* ((prompt-generator (skill-neuro-prompt active-skill)) (raw-prompt (when prompt-generator (funcall prompt-generator context))) (full-system-prompt (concatenate 'string @@ -122,7 +125,7 @@ To call a tool, you MUST use: (raw-thoughts (cl-ppcre:split (cl-ppcre:quote-meta-chars "|CONSENSUS-SEP|") thought)) (suggestions nil)) (dolist (raw-thought raw-thoughts) - (kernel-log "SYSTEM 1 RAW: ~a~%" raw-thought) + (kernel-log "ASSOCIATIVE RAW: ~a~%" raw-thought) (let* ((cleaned-thought (let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" raw-thought))) (if match @@ -136,7 +139,7 @@ To call a tool, you MUST use: (list :sensor :syntax-error :code cleaned-thought :error (format nil "~a" c))))))) - (kernel-log "SYSTEM 1 Suggestion: ~a~%" cleaned-thought) + (kernel-log "ASSOCIATIVE Suggestion: ~a~%" cleaned-thought) (when (and suggestion (listp suggestion)) (push suggestion suggestions)))) (if (and *consensus-enabled-p* suggestions) diff --git a/src/package.lisp b/src/package.lisp index 2e9606b..0deb3f6 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -33,9 +33,6 @@ #:rollback-object-store #:send-swarm-packet - ;; --- Self-Fix Agent --- - #:self-fix-apply - ;; --- Context API (Peripheral Vision) --- #:context-query-store #:context-get-active-projects @@ -110,9 +107,8 @@ ;; --- Symbolic Logic --- #:list-objects-with-attribute #:org-id-new - + ;; --- AST Helpers --- - #:find-headline-missing-id ;; --- Environment Config --- diff --git a/src/protocol.lisp b/src/protocol.lisp index 29768c1..eb618ad 100644 --- a/src/protocol.lisp +++ b/src/protocol.lisp @@ -54,7 +54,9 @@ ;; SECURITY: Prevent Reader Macro Injection (e.g. #. ) during deserialization (let ((*read-eval* nil)) - (read-from-string actual-msg))))) + (let ((msg (read-from-string actual-msg))) + (validate-oacp-schema msg) + msg))))) (defun make-hello-message (version) "Construct the standard HELLO handshake message." diff --git a/src/skills.lisp b/src/skills.lisp index 243d142..2867495 100644 --- a/src/skills.lisp +++ b/src/skills.lisp @@ -99,7 +99,7 @@ (dolist (name filenames) (let ((file (gethash (string-downcase name) id-to-file))) (when file (visit file))))) - (nreverse result)))) + result))) (defun validate-lisp-syntax (code-string) "Checks if a string contains valid, readable Common Lisp forms." @@ -187,16 +187,13 @@ (defun initialize-all-skills () "Scans the directory defined by SKILLS_DIR and hot-loads skills using topological order." (let* ((env-path (uiop:getenv "SKILLS_DIR")) - (skills-dir-str (or env-path (namestring (merge-pathnames "projects/org-agent/skills/" (uiop:getcwd))))) + (skills-dir-str (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname))))) (resolved-path (context-resolve-path skills-dir-str)) (skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil))) (unless (and skills-dir (uiop:directory-exists-p skills-dir)) (kernel-log "KERNEL ERROR: Skills directory not found: ~a" skills-dir-str) - ;; Fallback check - (setq skills-dir (uiop:ensure-directory-pathname (merge-pathnames "projects/org-agent/skills/" (uiop:getcwd)))) - (unless (uiop:directory-exists-p skills-dir) - (return-from initialize-all-skills nil))) + (return-from initialize-all-skills nil)) (let ((sorted-files (topological-sort-skills skills-dir))) ;; MANDATE: The Executive Soul must be present diff --git a/src/symbolic.lisp b/src/symbolic.lisp index 80ba1f2..c979203 100644 --- a/src/symbolic.lisp +++ b/src/symbolic.lisp @@ -14,34 +14,36 @@ (return-from task-integrity-check "Blocked by Task Integrity: Active children exist.")))) nil)) +(defun bouncer-check (action) + "Checks if an action requires manual authorization." + (let* ((payload (getf action :payload)) + (target (getf action :target)) + (act (or (getf payload :action) (getf action :action))) + (tool (or (getf payload :tool) (getf action :tool))) + (approved (getf action :approved))) + (when (and (not approved) + (or (and (eq target :tool) (equal tool "shell")) + (and (eq target :emacs) (eq act :eval)) + (and (eq target :tool) (equal tool "repair-file")))) + (return-from bouncer-check t)) + nil)) + (defun decide (proposed-action context) - "The System 2 Safety Gate: validates or rejects proposed neural actions." + "The Deliberate Safety Gate: validates or rejects proposed neural actions." ;; 1. Task Integrity Check (GTD Semantics) (let ((integrity-error (task-integrity-check proposed-action))) (when integrity-error - (kernel-log "SYSTEM 2 [INTEGRITY]: ~a~%" integrity-error) + (kernel-log "DELIBERATE [INTEGRITY]: ~a~%" integrity-error) (return-from decide (list :type :LOG :payload (list :text integrity-error))))) - ;; 2. Bouncer Check (DPI & Authorization) - ;; All actions pass through the Bouncer skill logic first if it's loaded - (let* ((bouncer-skill (gethash "skill-bouncer" *skills-registry*)) - (bouncer-fn (when bouncer-skill (skill-symbolic-fn bouncer-skill)))) - (when bouncer-fn - (let ((bouncer-decision (funcall bouncer-fn proposed-action context))) - (unless (equal bouncer-decision proposed-action) - (kernel-log "SYSTEM 2 [BOUNCER]: Action intercepted.~%") - (return-from decide bouncer-decision))))) + ;; 2. Bouncer Check (Authorization Gate) + (when (bouncer-check proposed-action) + (kernel-log "DELIBERATE [BOUNCER]: Action requires manual approval.~%") + (return-from decide + (list :type :EVENT + :payload (list :sensor :approval-required :action proposed-action)))) - ;; 3. Formal Verification Gate - (let* ((formal-skill (gethash "skill-formal-verification" *skills-registry*)) - (formal-fn (when formal-skill (skill-symbolic-fn formal-skill)))) - (when formal-fn - (let ((formal-decision (funcall formal-fn proposed-action context))) - (unless (equal formal-decision proposed-action) - (kernel-log "SYSTEM 2 [FORMAL]: Action intercepted.~%") - (return-from decide formal-decision))))) - - ;; 4. Skill-specific and Safety Checks + ;; 3. Skill-specific and Safety Checks (let ((active-skill (find-triggered-skill context))) (if (and proposed-action (listp proposed-action) active-skill) (let* ((symbolic-gate (skill-symbolic-fn active-skill)) @@ -54,16 +56,16 @@ (let ((harness-pkg (find-package :org-agent.skills.org-skill-safety-harness))) (when (and code harness-pkg) (unless (ignore-errors (uiop:symbol-call :org-agent.skills.org-skill-safety-harness :safety-harness-validate code)) - (kernel-log "SYSTEM 2 [GLOBAL]: Security violation blocked.~%") + (kernel-log "DELIBERATE [GLOBAL]: Security violation blocked.~%") (return-from decide '(:type :LOG :payload (:text "Blocked by Global Safety Harness"))))))) ;; Skill-specific verification (if symbolic-gate (let ((decision (funcall symbolic-gate proposed-action context))) (if decision - (progn (kernel-log "SYSTEM 2: Verified by skill '~a'.~%" (skill-name active-skill)) decision) - (progn (kernel-log "SYSTEM 2: REJECTED by skill '~a'.~%" (skill-name active-skill)) + (progn (kernel-log "DELIBERATE: Verified by skill '~a'.~%" (skill-name active-skill)) decision) + (progn (kernel-log "DELIBERATE: REJECTED by skill '~a'.~%" (skill-name active-skill)) '(:type :LOG :payload (:text "Action rejected by skill heuristics"))))) - (progn (kernel-log "SYSTEM 2: Verified (Implicitly safe for skill '~a').~%" (skill-name active-skill)) proposed-action))) + (progn (kernel-log "DELIBERATE: Verified (Implicitly safe for skill '~a').~%" (skill-name active-skill)) proposed-action))) proposed-action))) (defun list-objects-with-attribute (attr-key attr-val)