amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

ARCH: Microkernel Decoupling - Moved State Persistence to user-space dynamic skill

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-13 15:48:14 -04:00
parent dcd3a31112
commit 34f59a6e43
19 changed files with 204 additions and 279 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
deploy/docker/Dockerfile
View File

@@ -34,7 +34,7 @@ RUN sbcl --non-interactive \
# Ensure the binary is executable # Ensure the binary is executable
RUN chmod +x /app/org-agent-server RUN chmod +x /app/org-agent-server
# Expose the Harness Communication and Web Dashboard ports # Expose the communication protocol and Web Dashboard ports
EXPOSE 9105 8080 EXPOSE 9105 8080
# The app expects the memex to be mounted here # The app expects the memex to be mounted here

2
docs/quickstart.org
View File

@@ -35,7 +35,7 @@ docker-compose up --build -d
* 4. Interaction Gateways * 4. Interaction Gateways
Once the harness is "Ready", you can interact with it via multiple sensors. Once the harness is "Ready", you can interact with it via multiple sensors.
** Gateway A: Emacs (Harness Communication) ** Gateway A: Emacs (communication protocol)
If you have configured the ~org-agent~ package in Emacs: If you have configured the ~org-agent~ package in Emacs:
1. Open a chat buffer: ~M-x org-agent-chat-open~. 1. Open a chat buffer: ~M-x org-agent-chat-open~.
2. Send: "Are you online, agent?" 2. Send: "Are you online, agent?"

48
literate/communication.org
View File

@@ -1,27 +1,27 @@
#+TITLE: The Harness Communication (communication.lisp) #+TITLE: Communication Protocol (communication.lisp)
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :harness:protocol: #+FILETAGS: :harness:protocol:
#+STARTUP: content #+STARTUP: content
* The Harness Communication (communication.lisp) * Communication Protocol (communication.lisp)
** Architectural Intent: Secure Inter-Process Communication & Deterministic Framing ** Architectural Intent: Secure Inter-Process Communication & Deterministic Framing
Yes, the Harness Communication is fundamentally about **Communication**. It defines the exact physical and semantic boundaries for how the isolated Lisp environment talks to the outside world. The **communication protocol** defines the exact physical and semantic boundaries for how the isolated Lisp environment talks to the outside world.
The ~org-agent~ harness operates as a perfectly deterministic, highly secure computational engine. When communicating with external processes or actuators—such as an Emacs client, a web dashboard, or a remote Shell script—the harness cannot rely on unpredictable, "loose" data streams. The system operates as a perfectly deterministic, highly secure computational engine. When communicating with external processes or actuators—such as an Emacs client, a web dashboard, or a remote Shell script—it cannot rely on unpredictable, "loose" data streams.
Streaming raw Lisp or JSON over a TCP socket is inherently fragile. If a multi-megabyte Org Abstract Syntax Tree (AST) is fragmented by the operating system's network stack during transmission, a standard stream parser might attempt to evaluate an incomplete string, leading to immediate crashes or desynchronization. Streaming raw Lisp or JSON over a TCP socket is inherently fragile. If a multi-megabyte Org Abstract Syntax Tree (AST) is fragmented by the operating system's network stack during transmission, a standard stream parser might attempt to evaluate an incomplete string, leading to immediate crashes or desynchronization.
To solve this, we implement the **Harness Communication**, which enforces absolute deterministic boundaries around every message. To solve this, we implement the **communication protocol**, which enforces absolute deterministic boundaries around every message.
*** 1. Physical Boundary: Hex-Length Prefixing *** 1. Physical Boundary: Hex-Length Prefixing
Every message crossing the wire is prefixed with a strict 6-character hexadecimal length string (zero-padded). This creates an unbreakable physical boundary. The harness reads exactly the number of bytes specified by the hex length. It will never under-read (crashing on a partial form) and never over-read (consuming bytes meant for the next message). Every message crossing the wire is prefixed with a strict 6-character hexadecimal length string (zero-padded). This creates an unbreakable physical boundary. The system reads exactly the number of bytes specified by the hex length. It will never under-read (crashing on a partial form) and never over-read (consuming bytes meant for the next message).
*** 2. Actuator-Agnosticism ("Dumb Terminal" Architecture) *** 2. Actuator-Agnosticism ("Dumb Terminal" Architecture)
The protocol keeps the Lisp harness completely agnostic of its clients. The harness does not care if the client is written in Emacs Lisp, Python, or Rust. Any environment capable of calculating a byte length and opening a TCP socket can interface with the Lisp Machine. The protocol keeps the Lisp environment completely agnostic of its clients. The system does not care if the client is written in Emacs Lisp, Python, or Rust. Any environment capable of calculating a byte length and opening a TCP socket can interface with the Lisp Machine.
*** 3. Preventing Reader Macro Injection *** 3. Preventing Reader Macro Injection
Common Lisp's ~read-from-string~ is extremely powerful but dangerous; it allows "reader macros" (like ~#.~) which execute code during the parsing phase. The Harness Communication mandates that ~*read-eval*~ is explicitly bound to ~nil~ before any network data is parsed, physically preventing arbitrary code execution. Common Lisp's ~read-from-string~ is extremely powerful but dangerous; it allows "reader macros" (like ~#.~) which execute code during the parsing phase. The communication protocol mandates that ~*read-eval*~ is explicitly bound to ~nil~ before any network data is parsed, physically preventing arbitrary code execution.
** Message Framing Logic ** Message Framing Logic
#+begin_src mermaid #+begin_src mermaid
@@ -31,23 +31,23 @@ flowchart LR
B --> C[Hex Prefix: 6 Chars] B --> C[Hex Prefix: 6 Chars]
C --> D[Concatenate: Length + List] C --> D[Concatenate: Length + List]
end end
D -- TCP Socket --> Harness D -- TCP Socket --> System
subgraph Harness subgraph System
Harness --> E[Read 6 Hex Chars] System --> E[Read 6 Hex Chars]
E --> F[Read Exact Byte Count] E --> F[Read Exact Byte Count]
F --> G[Parse S-Expression] F --> G[Parse S-Expression]
end end
#+end_src #+end_src
** Package Context ** Package Context
We ensure all protocol logic resides within the isolated harness namespace. We ensure all protocol logic resides within the isolated system namespace.
#+begin_src lisp :tangle ../src/communication.lisp #+begin_src lisp :tangle ../src/communication.lisp
(in-package :org-agent) (in-package :org-agent)
#+end_src #+end_src
** Actuator Registry ** Actuator Registry
The harness maintains a decoupled registry of target actuators. This allows the system to route messages to Emacs, the Shell, or Web Gateways without hardcoding the routing logic into the protocol itself. The system maintains a decoupled registry of target actuators. This allows the system to route messages to Emacs, the Shell, or Web Gateways without hardcoding the routing logic into the protocol itself.
#+begin_src lisp :tangle ../src/communication.lisp #+begin_src lisp :tangle ../src/communication.lisp
(defvar *actuator-registry* (make-hash-table :test 'equal) (defvar *actuator-registry* (make-hash-table :test 'equal)
@@ -59,17 +59,17 @@ The harness maintains a decoupled registry of target actuators. This allows the
#+end_src #+end_src
** Message Framing (frame-message) ** Message Framing (frame-message)
The ~frame-message~ function prepares an outgoing Lisp string for transmission. It calculates the byte length, converts it into a 6-character padded hex string, and prefixes it. If ~HARNESS_PROTOCOL_ENFORCE_HMAC~ is enabled in the environment, it also prepends a cryptographic signature to ensure the message hasn't been tampered with. The ~frame-message~ function prepares an outgoing Lisp string for transmission. It calculates the byte length, converts it into a 6-character padded hex string, and prefixes it. If ~COMMUNICATION_PROTOCOL_ENFORCE_HMAC~ is enabled in the environment, it also prepends a cryptographic signature to ensure the message hasn't been tampered with.
#+begin_src lisp :tangle ../src/communication.lisp #+begin_src lisp :tangle ../src/communication.lisp
(defun frame-message (msg-string) (defun frame-message (msg-string)
"Prefixes MSG-STRING with a 6-character hex length. "Prefixes MSG-STRING with a 6-character hex length.
If security is enabled, prefixes a 64-char HMAC-SHA256 signature." If security is enabled, prefixes a 64-char HMAC-SHA256 signature."
(let ((len (length msg-string)) (let ((len (length msg-string))
(enforce-hmac (uiop:getenv "HARNESS_PROTOCOL_ENFORCE_HMAC"))) (enforce-hmac (uiop:getenv "COMMUNICATION_PROTOCOL_ENFORCE_HMAC")))
(if (and enforce-hmac (string-equal enforce-hmac "true")) (if (and enforce-hmac (string-equal enforce-hmac "true"))
(let ((secret (uiop:getenv "HARNESS_PROTOCOL_HMAC_SECRET"))) (let ((secret (uiop:getenv "COMMUNICATION_PROTOCOL_HMAC_SECRET")))
(unless secret (error "HARNESS_PROTOCOL_HMAC_SECRET is required when security is enabled.")) (unless secret (error "COMMUNICATION_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let* ((key (ironclad:ascii-string-to-byte-array secret)) (let* ((key (ironclad:ascii-string-to-byte-array secret))
(hmac (ironclad:make-mac :hmac key :sha256)) (hmac (ironclad:make-mac :hmac key :sha256))
(payload-bytes (ironclad:ascii-string-to-byte-array msg-string))) (payload-bytes (ironclad:ascii-string-to-byte-array msg-string)))
@@ -87,11 +87,11 @@ Parsing is the high-security inverse of framing. This function acts as the final
"Extracts and parses the S-expression from a framed string securely." "Extracts and parses the S-expression from a framed string securely."
(when (< (length framed-string) 6) (when (< (length framed-string) 6)
(error "Framed string too short")) (error "Framed string too short"))
(let* ((enforce-hmac (uiop:getenv "HARNESS_PROTOCOL_ENFORCE_HMAC")) (let* ((enforce-hmac (uiop:getenv "COMMUNICATION_PROTOCOL_ENFORCE_HMAC"))
(use-hmac (and enforce-hmac (string-equal enforce-hmac "true"))) (use-hmac (and enforce-hmac (string-equal enforce-hmac "true")))
(prefix-len (if use-hmac 70 6))) (prefix-len (if use-hmac 70 6)))
(when (< (length framed-string) prefix-len) (when (< (length framed-string) prefix-len)
(error "Framed string too short for Harness Communication prefix")) (error "Framed string too short for communication protocol prefix"))
(let* ((len-str (subseq framed-string 0 6)) (let* ((len-str (subseq framed-string 0 6))
(signature (when use-hmac (subseq framed-string 6 70))) (signature (when use-hmac (subseq framed-string 6 70)))
@@ -103,25 +103,25 @@ Parsing is the high-security inverse of framing. This function acts as the final
(error "Message length mismatch. Expected ~a, got ~a" expected-len (length actual-msg))) (error "Message length mismatch. Expected ~a, got ~a" expected-len (length actual-msg)))
(when use-hmac (when use-hmac
(let ((secret (uiop:getenv "HARNESS_PROTOCOL_HMAC_SECRET"))) (let ((secret (uiop:getenv "COMMUNICATION_PROTOCOL_HMAC_SECRET")))
(unless secret (error "HARNESS_PROTOCOL_HMAC_SECRET is required when security is enabled.")) (unless secret (error "COMMUNICATION_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let* ((key (ironclad:ascii-string-to-byte-array secret)) (let* ((key (ironclad:ascii-string-to-byte-array secret))
(hmac (ironclad:make-mac :hmac key :sha256)) (hmac (ironclad:make-mac :hmac key :sha256))
(payload-bytes (ironclad:ascii-string-to-byte-array actual-msg))) (payload-bytes (ironclad:ascii-string-to-byte-array actual-msg)))
(ironclad:update-mac hmac payload-bytes) (ironclad:update-mac hmac payload-bytes)
(let ((expected-signature (ironclad:byte-array-to-hex-string (ironclad:produce-mac hmac)))) (let ((expected-signature (ironclad:byte-array-to-hex-string (ironclad:produce-mac hmac))))
(unless (string-equal signature expected-signature) (unless (string-equal signature expected-signature)
(error "Harness Communication Integrity Failure: HMAC mismatch")))))) (error "communication protocol Integrity Failure: HMAC mismatch"))))))
;; SECURITY: Disable the reader's ability to execute code during parsing ;; SECURITY: Disable the reader's ability to execute code during parsing
(let ((*read-eval* nil)) (let ((*read-eval* nil))
(let ((msg (read-from-string actual-msg))) (let ((msg (read-from-string actual-msg)))
(validate-harness-protocol-schema msg) (validate-communication-protocol-schema msg)
msg))))) msg)))))
#+end_src #+end_src
** Handshaking (make-hello-message) ** Handshaking (make-hello-message)
Every session begins with a standard ~HELLO~ handshake, allowing the harness to announce its capabilities and protocol version to the connecting client. Every session begins with a standard ~HELLO~ handshake, allowing the system to announce its capabilities and protocol version to the connecting client.
#+begin_src lisp :tangle ../src/communication.lisp #+begin_src lisp :tangle ../src/communication.lisp
(defun make-hello-message (version) (defun make-hello-message (version)

2
literate/memory.org
View File

@@ -26,7 +26,7 @@ flowchart TD
H -- Pointers --> S2 H -- Pointers --> S2
end end
subgraph IPCSlow[External Layer] subgraph IPCSlow[External Layer]
E[Emacs / Actuators] -. Harness Communication .-> H E[Emacs / Actuators] -. communication protocol .-> H
end end
#+end_src #+end_src

7
literate/package.org
View File

@@ -11,7 +11,7 @@ By strictly defining the public interface, we ensure that skills remain decouple
#+begin_src mermaid #+begin_src mermaid
flowchart TD flowchart TD
External[Actuators / Clients] -- Harness Communication --> Package[Package Membrane: API] External[Actuators / Clients] -- communication protocol --> Package[Package Membrane: API]
Skills[Dynamic Skills] -- API Calls --> Package Skills[Dynamic Skills] -- API Calls --> Package
Package --> Internal[Harness Internal Modules] Package --> Internal[Harness Internal Modules]
style Package fill:#f9f,stroke:#333,stroke-width:4px style Package fill:#f9f,stroke:#333,stroke-width:4px
@@ -22,11 +22,11 @@ flowchart TD
(defpackage :org-agent (defpackage :org-agent
(:use :cl) (:use :cl)
(:export (:export
;; --- Harness Communication --- ;; --- communication protocol ---
#:frame-message #:frame-message
#:parse-message #:parse-message
#:make-hello-message #:make-hello-message
#:validate-harness-protocol-schema #:validate-communication-protocol-schema
;; --- Daemon Lifecycle --- ;; --- Daemon Lifecycle ---
#:start-daemon #:start-daemon
@@ -41,6 +41,7 @@ flowchart TD
#:*memory* #:*memory*
#:*history-store* #:*history-store*
#:org-object #:org-object
#:make-org-object
#:org-object-id #:org-object-id
#:org-object-type #:org-object-type
#:org-object-attributes #:org-object-attributes

4
literate/system-definition.org
View File

@@ -36,7 +36,7 @@ This system defines the core "Thin Harness." It includes the protocol, the objec
:version "0.1.0" :version "0.1.0"
:license "MIT" :license "MIT"
:description "The Probabilistic-Deterministic Lisp Machine Harness" :description "The Probabilistic-Deterministic Lisp Machine Harness"
:depends-on (:usocket :cl-json :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str) :depends-on (:usocket ::bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json)
:serial t :serial t
:components ((:file "src/package") :components ((:file "src/package")
(:file "src/skills") (:file "src/skills")
@@ -93,7 +93,7 @@ This system contains the empirical tests required by the Engineering Standards.
(:file "tests/playwright-tests") (:file "tests/playwright-tests")
(:file "tests/chaos-qa")) (:file "tests/chaos-qa"))
:perform (test-op (o s) :perform (test-op (o s)
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :harness-protocol-suite :org-agent-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :communication-protocol-suite :org-agent-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :org-agent-pipeline-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :org-agent-pipeline-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :vision-suite :org-agent-peripheral-vision-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :vision-suite :org-agent-peripheral-vision-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :org-agent-safety-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :org-agent-safety-tests))

4
org-agent.asd
View File

@@ -4,7 +4,7 @@
:version "0.1.0" :version "0.1.0"
:license "MIT" :license "MIT"
:description "The Probabilistic-Deterministic Lisp Machine Harness" :description "The Probabilistic-Deterministic Lisp Machine Harness"
:depends-on (:usocket :cl-json :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str) :depends-on (:usocket ::bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json)
:serial t :serial t
:components ((:file "src/package") :components ((:file "src/package")
(:file "src/skills") (:file "src/skills")
@@ -56,7 +56,7 @@
(:file "tests/playwright-tests") (:file "tests/playwright-tests")
(:file "tests/chaos-qa")) (:file "tests/chaos-qa"))
:perform (test-op (o s) :perform (test-op (o s)
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :harness-protocol-suite :org-agent-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :communication-protocol-suite :org-agent-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :org-agent-pipeline-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :org-agent-pipeline-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :vision-suite :org-agent-peripheral-vision-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :vision-suite :org-agent-peripheral-vision-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :org-agent-safety-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :org-agent-safety-tests))

34
skills/org-skill-protocol-validator.org
View File

@@ -1,13 +1,13 @@
:PROPERTIES: :PROPERTIES:
:ID: org-skill-harness-protocol-validator :ID: org-skill-communication-protocol-validator
:CREATED: [2026-04-12 Sun 14:35] :CREATED: [2026-04-12 Sun 14:35]
:END: :END:
#+TITLE: SKILL: Harness Communication Schema Validator (Universal Literate Note) #+TITLE: SKILL: Communication Protocol Schema Validator (Universal Literate Note)
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :protocol:harness-protocol:security:validation:psf: #+FILETAGS: :protocol:communication-protocol:security:validation:psf:
* Overview * Overview
The *Harness Communication Schema Validator* skill provides deep structural validation for all messages entering the org-agent kernel. It ensures that every property list adheres to a strict schema, preventing malformed data from causing harness-level errors. The *Communication Protocol Schema Validator* skill provides deep structural validation for all messages entering the org-agent kernel. It ensures that every property list adheres to a strict schema, preventing malformed data from causing harness-level errors.
* Phase A: Demand (PRD) * Phase A: Demand (PRD)
:PROPERTIES: :PROPERTIES:
@@ -15,7 +15,7 @@ The *Harness Communication Schema Validator* skill provides deep structural vali
:END: :END:
** 1. Purpose ** 1. Purpose
Enforce a formal grammar for the Org-Agent Control Protocol (Harness Communication). Enforce a formal grammar for the Org-Agent Control Protocol (communication protocol).
** 2. User Needs ** 2. User Needs
- *Type Safety:* Ensure mandatory keys (e.g., `:type`, `:payload`) are present. - *Type Safety:* Ensure mandatory keys (e.g., `:type`, `:payload`) are present.
@@ -38,7 +38,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
** 2. Semantic Interfaces ** 2. Semantic Interfaces
#+begin_src lisp #+begin_src lisp
(defun validate-harness-protocol-schema (msg) (defun validate-communication-protocol-schema (msg)
"Returns T if the message is valid, NIL (and signals error) otherwise.") "Returns T if the message is valid, NIL (and signals error) otherwise.")
#+end_src #+end_src
@@ -48,44 +48,44 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
#+begin_src lisp :tangle ../src/communication-validator.lisp #+begin_src lisp :tangle ../src/communication-validator.lisp
(in-package :org-agent) (in-package :org-agent)
(defun validate-harness-protocol-schema (msg) (defun validate-communication-protocol-schema (msg)
"Strict structural validation for incoming Harness Communication messages." "Strict structural validation for incoming communication protocol messages."
(unless (listp msg) (unless (listp msg)
(error "Harness Communication Schema Error: Message must be a property list (got ~s)" (type-of msg))) (error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(let ((type (getf msg :type))) (let ((type (getf msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG)) (unless (member type '(:REQUEST :EVENT :RESPONSE :LOG))
(error "Harness Communication Schema Error: Invalid message type '~a'" type)) (error "Communication Protocol Schema Error: Invalid message type '~a'" type))
(case type (case type
(:REQUEST (:REQUEST
(unless (getf msg :target) (unless (getf msg :target)
(error "Harness Communication Schema Error: REQUEST missing mandatory :target")) (error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
(unless (getf msg :payload) (unless (getf msg :payload)
(error "Harness Communication Schema Error: REQUEST missing mandatory :payload"))) (error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
(:EVENT (:EVENT
(let ((payload (getf msg :payload))) (let ((payload (getf msg :payload)))
(unless (and payload (listp payload)) (unless (and payload (listp payload))
(error "Harness Communication Schema Error: EVENT missing or invalid :payload")) (error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
(unless (or (getf payload :action) (getf payload :sensor)) (unless (or (getf payload :action) (getf payload :sensor))
(error "Harness Communication Schema Error: EVENT payload must contain :action or :sensor")))) (error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
(:RESPONSE (:RESPONSE
(unless (getf msg :payload) (unless (getf msg :payload)
(error "Harness Communication Schema Error: RESPONSE missing mandatory :payload")))) (error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
t)) t))
#+end_src #+end_src
* Registration * Registration
#+begin_src lisp :tangle ../src/communication-validator.lisp #+begin_src lisp :tangle ../src/communication-validator.lisp
(defskill :skill-harness-protocol-validator (defskill :skill-communication-protocol-validator
:priority 95 :priority 95
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received))) :trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
:probabilistic nil :probabilistic nil
:deterministic (lambda (action ctx) :deterministic (lambda (action ctx)
(declare (ignore ctx)) (declare (ignore ctx))
(validate-harness-protocol-schema action) (validate-communication-protocol-schema action)
action)) action))
#+end_src #+end_src

120
skills/org-skill-state-persistence.org
View File

@@ -66,14 +66,14 @@ Tests in `tests/persistence-tests.lisp` will verify the local dump/load cycle an
* Phase D: Build (Implementation) * Phase D: Build (Implementation)
** Package Context ** Package Context
#+begin_src lisp :tangle ../src/state-persistence.lisp #+begin_src lisp
(in-package :org-agent) ;; Skill logic is evaluated in a jailed package by the Harness.
#+end_src #+end_src
** Helper: Local State Path ** Helper: Local State Path
Ensures we have a standardized location for local memory images. Ensures we have a standardized location for local memory images.
#+begin_src lisp :tangle ../src/state-persistence.lisp #+begin_src lisp
(defun persistence-get-local-path () (defun persistence-get-local-path ()
"Returns the path to the local memory image file." "Returns the path to the local memory image file."
(let ((state-dir (or (uiop:getenv "SYSTEM_DIR") "system/"))) (let ((state-dir (or (uiop:getenv "SYSTEM_DIR") "system/")))
@@ -83,7 +83,7 @@ Ensures we have a standardized location for local memory images.
** Local Image Dump (persistence-dump-local) ** Local Image Dump (persistence-dump-local)
Serializes the Merkle history and current pointers to a Lisp file. Serializes the Merkle history and current pointers to a Lisp file.
#+begin_src lisp :tangle ../src/state-persistence.lisp #+begin_src lisp
(defun persistence-dump-local () (defun persistence-dump-local ()
"Serializes the entire history store and current pointers to a local Lisp image." "Serializes the entire history store and current pointers to a local Lisp image."
(let ((image-file (persistence-get-local-path))) (let ((image-file (persistence-get-local-path)))
@@ -105,7 +105,7 @@ Serializes the Merkle history and current pointers to a Lisp file.
** Local Image Load (persistence-load-local) ** Local Image Load (persistence-load-local)
Restores the state from the local disk. Restores the state from the local disk.
#+begin_src lisp :tangle ../src/state-persistence.lisp #+begin_src lisp
(defun persistence-load-local () (defun persistence-load-local ()
"Loads the memory image from local disk." "Loads the memory image from local disk."
(let ((image-file (persistence-get-local-path))) (let ((image-file (persistence-get-local-path)))
@@ -120,44 +120,47 @@ Restores the state from the local disk.
#+end_src #+end_src
** IPFS Serialization (persistence-serialize-for-archival) ** IPFS Serialization (persistence-serialize-for-archival)
Converts the live `*memory*` into a JSON-compatible list of alists. Converts the live `*memory*` into a list of Lisp Property Lists (Plists) for sovereign, homoiconic transport.
#+begin_src lisp :tangle ../src/state-persistence.lisp #+begin_src lisp
(defun persistence-serialize-for-archival () (defun persistence-serialize-for-archival ()
"Serializes the entire object-store for IPFS/JSON transport." "Serializes the entire memory for IPFS transport as native S-Expressions."
(let ((objects nil)) (let ((objects nil))
(maphash (lambda (id obj) (maphash (lambda (id obj)
(declare (ignore id)) (declare (ignore id))
(push `((:id . ,(org-object-id obj)) (push (list :id (org-object-id obj)
(:type . ,(format nil "~s" (org-object-type obj))) :type (org-object-type obj)
(:attributes . ,(loop for (k v) on (org-object-attributes obj) by #'cddr :attributes (org-object-attributes obj)
collect (cons (format nil "~a" k) (format nil "~a" v)))) :content (org-object-content obj)
(:content . ,(org-object-content obj)) :parent-id (org-object-parent-id obj)
(:parent-id . ,(org-object-parent-id obj)) :children (org-object-children obj)
(:children . ,(org-object-children obj)) :version (org-object-version obj)
(:version . ,(org-object-version obj)) :last-sync (org-object-last-sync obj)
(:last-sync . ,(org-object-last-sync obj)) :hash (org-object-hash obj))
(:hash . ,(org-object-hash obj)))
objects)) objects))
*memory*) *memory*)
objects)) objects))
#+end_src #+end_src
** IPFS Push (persistence-push-ipfs) ** IPFS Push (persistence-push-ipfs)
Pushes the serialized knowledge graph to the decentralized network. Pushes the serialized knowledge graph to the decentralized network as a Lisp string.
#+begin_src lisp :tangle ../src/state-persistence.lisp #+begin_src lisp
(defun persistence-push-ipfs () (defun persistence-push-ipfs ()
"Serializes the store and pushes it to IPFS, returning the CID." "Serializes the store and pushes it to IPFS as a Lisp text block, returning the CID."
(let* ((data (persistence-serialize-for-archival)) (let* ((data (persistence-serialize-for-archival))
(json-payload (cl-json:encode-json-to-string data)) (lisp-payload (format nil "~s" data))
(ipfs-url "http://127.0.0.1:5001/api/v0/add")) (ipfs-url "http://127.0.0.1:5001/api/v0/add"))
(handler-case (handler-case
(let* ((response (dex:post ipfs-url (let* ((response (dex:post ipfs-url
:content `(("file" . ,json-payload)) :content `(("file" . ,lisp-payload))
:headers '(("Content-Type" . "multipart/form-data")))) :headers '(("Content-Type" . "multipart/form-data"))))
(result (cl-json:decode-json-from-string response)) (result-str (flexi-streams:octets-to-string response))
(cid (cdr (assoc :hash result)))) (start-idx (search "\"Hash\":\"" result-str))
(cid (when start-idx
(let* ((val-start (+ start-idx 8))
(val-end (position #\" result-str :start val-start)))
(subseq result-str val-start val-end)))))
(harness-log "PERSISTENCE - Checkpoint to IPFS successful. CID: ~a" cid) (harness-log "PERSISTENCE - Checkpoint to IPFS successful. CID: ~a" cid)
cid) cid)
(error (c) (error (c)
@@ -166,32 +169,33 @@ Pushes the serialized knowledge graph to the decentralized network.
#+end_src #+end_src
** IPFS Restore (persistence-restore-ipfs) ** IPFS Restore (persistence-restore-ipfs)
Restores the graph from IPFS, using a safe parser to prevent injection. Restores the graph from IPFS, using `read-from-string` with `*read-eval* nil` to prevent injection.
#+begin_src lisp :tangle ../src/state-persistence.lisp #+begin_src lisp
(defun persistence-restore-ipfs (cid) (defun persistence-restore-ipfs (cid)
"Fetches data from IPFS and safely hydrates the object-store." "Fetches data from IPFS and safely hydrates the memory."
(let ((ipfs-url (format nil "http://127.0.0.1:5001/api/v0/cat?arg=~a" cid))) (let ((ipfs-url (format nil "http://127.0.0.1:5001/api/v0/cat?arg=~a" cid)))
(handler-case (handler-case
(let* ((response (dex:post ipfs-url)) (let* ((response (dex:post ipfs-url))
(data (cl-json:decode-json-from-string response))) (payload-str (flexi-streams:octets-to-string response)))
(clrhash *memory*) (let ((*read-eval* nil))
(dolist (item data) (let ((data (read-from-string payload-str)))
(let* ((id (cdr (assoc :id item))) (clrhash *memory*)
(obj (make-org-object (dolist (item data)
:id id (let* ((id (getf item :id))
:type (read-from-string (cdr (assoc :type item))) (obj (make-org-object
:attributes (loop for attr in (cdr (assoc :attributes item)) :id id
append (list (intern (string-upcase (car attr)) :keyword) (cdr attr))) :type (getf item :type)
:content (cdr (assoc :content item)) :attributes (getf item :attributes)
:parent-id (cdr (assoc :parent-id item)) :content (getf item :content)
:children (cdr (assoc :children item)) :parent-id (getf item :parent-id)
:version (cdr (assoc :version item)) :children (getf item :children)
:last-sync (cdr (assoc :last-sync item)) :version (getf item :version)
:hash (cdr (assoc :hash item))))) :last-sync (getf item :last-sync)
(setf (gethash id *memory*) obj))) :hash (getf item :hash))))
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid) (setf (gethash id *memory*) obj)))
t) (harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
t)))
(error (c) (error (c)
(harness-log "PERSISTENCE ERROR - IPFS restoration failed: ~a" c) (harness-log "PERSISTENCE ERROR - IPFS restoration failed: ~a" c)
nil)))) nil))))
@@ -200,19 +204,18 @@ Restores the graph from IPFS, using a safe parser to prevent injection.
** Cognitive Tools ** Cognitive Tools
Expose persistence capabilities to the neural Probabilistic Engine. Expose persistence capabilities to the neural Probabilistic Engine.
#+begin_src lisp :tangle ../src/state-persistence.lisp #+begin_src lisp
(progn (progn
(def-cognitive-tool :checkpoint-memory "Creates both a local image and a decentralized IPFS snapshot." (def-cognitive-tool :checkpoint-memory "Creates both a local image and a decentralized IPFS snapshot." nil
:parameters nil
:body (lambda (args) :body (lambda (args)
(declare (ignore args)) (declare (ignore args))
(persistence-dump-local) (persistence-dump-local)
(let ((cid (persistence-push-ipfs))) (let ((cid (persistence-push-ipfs)))
(format nil "Local dump complete. IPFS CID: ~a" (or cid "FAILED"))))) (format nil "Local dump complete. IPFS CID: ~a" (or cid "FAILED")))))
(def-cognitive-tool :restore-memory "Restores the state from a specific source." (def-cognitive-tool :restore-memory "Restores the state from a specific source."
:parameters ((:source :type :keyword :description "Either :LOCAL or :IPFS") ((:source :type :keyword :description "Either :LOCAL or :IPFS")
(:cid :type :string :description "Required if source is :IPFS")) (:cid :type :string :description "Required if source is :IPFS"))
:body (lambda (args) :body (lambda (args)
(case (getf args :source) (case (getf args :source)
(:local (if (persistence-load-local) "Restored from disk." "Local restore failed.")) (:local (if (persistence-load-local) "Restored from disk." "Local restore failed."))
@@ -220,7 +223,7 @@ Expose persistence capabilities to the neural Probabilistic Engine.
#+end_src #+end_src
** Registration ** Registration
#+begin_src lisp :tangle ../src/state-persistence.lisp #+begin_src lisp
(defskill :skill-state-persistence (defskill :skill-state-persistence
:priority 100 :priority 100
:trigger (lambda (ctx) :trigger (lambda (ctx)
@@ -235,7 +238,7 @@ Expose persistence capabilities to the neural Probabilistic Engine.
* Phase E: Chaos (Verification) * Phase E: Chaos (Verification)
** 1. Unit Tests (FiveAM) ** 1. Unit Tests (FiveAM)
#+begin_src lisp :tangle ../tests/persistence-tests.lisp #+begin_src lisp
(defpackage :org-agent-persistence-tests (defpackage :org-agent-persistence-tests
(:use :cl :fiveam :org-agent)) (:use :cl :fiveam :org-agent))
(in-package :org-agent-persistence-tests) (in-package :org-agent-persistence-tests)
@@ -245,11 +248,16 @@ Expose persistence capabilities to the neural Probabilistic Engine.
(test test-local-roundtrip (test test-local-roundtrip
"Ensure RAM -> Disk -> RAM preserves data integrity." "Ensure RAM -> Disk -> RAM preserves data integrity."
(let ((test-id "persist-test-1")) (let ((test-id "persist-test-1")
(setf (gethash test-id *memory*) (make-org-object :id test-id :content "Integrity Check")) (test-hash "fake-hash-123"))
(let ((obj (make-org-object :id test-id :content "Integrity Check" :hash test-hash)))
(setf (gethash test-hash *history-store*) obj)
(setf (gethash test-id *memory*) obj))
(org-agent:persistence-dump-local) (org-agent:persistence-dump-local)
(clrhash *memory*) (clrhash *memory*)
(clrhash *history-store*)
(org-agent:persistence-load-local) (org-agent:persistence-load-local)
(is (not (null (gethash test-id *memory*))))
(is (equal "Integrity Check" (org-object-content (gethash test-id *memory*)))))) (is (equal "Integrity Check" (org-object-content (gethash test-id *memory*))))))
#+end_src #+end_src

39
src/communication-validator.lisp Normal file
View File

@@ -0,0 +1,39 @@
(in-package :org-agent)
(defun validate-communication-protocol-schema (msg)
"Strict structural validation for incoming communication protocol messages."
(unless (listp msg)
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(let ((type (getf msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG))
(error "Communication Protocol Schema Error: Invalid message type '~a'" type))
(case type
(:REQUEST
(unless (getf msg :target)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
(unless (getf msg :payload)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
(:EVENT
(let ((payload (getf msg :payload)))
(unless (and payload (listp payload))
(error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
(unless (or (getf payload :action) (getf payload :sensor))
(error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
(:RESPONSE
(unless (getf msg :payload)
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
t))
(defskill :skill-communication-protocol-validator
:priority 95
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
:probabilistic nil
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(validate-communication-protocol-schema action)
action))

18
src/communication.lisp
View File

@@ -11,10 +11,10 @@
"Prefixes MSG-STRING with a 6-character hex length. "Prefixes MSG-STRING with a 6-character hex length.
If security is enabled, prefixes a 64-char HMAC-SHA256 signature." If security is enabled, prefixes a 64-char HMAC-SHA256 signature."
(let ((len (length msg-string)) (let ((len (length msg-string))
(enforce-hmac (uiop:getenv "HARNESS_PROTOCOL_ENFORCE_HMAC"))) (enforce-hmac (uiop:getenv "COMMUNICATION_PROTOCOL_ENFORCE_HMAC")))
(if (and enforce-hmac (string-equal enforce-hmac "true")) (if (and enforce-hmac (string-equal enforce-hmac "true"))
(let ((secret (uiop:getenv "HARNESS_PROTOCOL_HMAC_SECRET"))) (let ((secret (uiop:getenv "COMMUNICATION_PROTOCOL_HMAC_SECRET")))
(unless secret (error "HARNESS_PROTOCOL_HMAC_SECRET is required when security is enabled.")) (unless secret (error "COMMUNICATION_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let* ((key (ironclad:ascii-string-to-byte-array secret)) (let* ((key (ironclad:ascii-string-to-byte-array secret))
(hmac (ironclad:make-mac :hmac key :sha256)) (hmac (ironclad:make-mac :hmac key :sha256))
(payload-bytes (ironclad:ascii-string-to-byte-array msg-string))) (payload-bytes (ironclad:ascii-string-to-byte-array msg-string)))
@@ -27,11 +27,11 @@
"Extracts and parses the S-expression from a framed string securely." "Extracts and parses the S-expression from a framed string securely."
(when (< (length framed-string) 6) (when (< (length framed-string) 6)
(error "Framed string too short")) (error "Framed string too short"))
(let* ((enforce-hmac (uiop:getenv "HARNESS_PROTOCOL_ENFORCE_HMAC")) (let* ((enforce-hmac (uiop:getenv "COMMUNICATION_PROTOCOL_ENFORCE_HMAC"))
(use-hmac (and enforce-hmac (string-equal enforce-hmac "true"))) (use-hmac (and enforce-hmac (string-equal enforce-hmac "true")))
(prefix-len (if use-hmac 70 6))) (prefix-len (if use-hmac 70 6)))
(when (< (length framed-string) prefix-len) (when (< (length framed-string) prefix-len)
(error "Framed string too short for Harness Communication prefix")) (error "Framed string too short for communication protocol prefix"))
(let* ((len-str (subseq framed-string 0 6)) (let* ((len-str (subseq framed-string 0 6))
(signature (when use-hmac (subseq framed-string 6 70))) (signature (when use-hmac (subseq framed-string 6 70)))
@@ -43,20 +43,20 @@
(error "Message length mismatch. Expected ~a, got ~a" expected-len (length actual-msg))) (error "Message length mismatch. Expected ~a, got ~a" expected-len (length actual-msg)))
(when use-hmac (when use-hmac
(let ((secret (uiop:getenv "HARNESS_PROTOCOL_HMAC_SECRET"))) (let ((secret (uiop:getenv "COMMUNICATION_PROTOCOL_HMAC_SECRET")))
(unless secret (error "HARNESS_PROTOCOL_HMAC_SECRET is required when security is enabled.")) (unless secret (error "COMMUNICATION_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let* ((key (ironclad:ascii-string-to-byte-array secret)) (let* ((key (ironclad:ascii-string-to-byte-array secret))
(hmac (ironclad:make-mac :hmac key :sha256)) (hmac (ironclad:make-mac :hmac key :sha256))
(payload-bytes (ironclad:ascii-string-to-byte-array actual-msg))) (payload-bytes (ironclad:ascii-string-to-byte-array actual-msg)))
(ironclad:update-mac hmac payload-bytes) (ironclad:update-mac hmac payload-bytes)
(let ((expected-signature (ironclad:byte-array-to-hex-string (ironclad:produce-mac hmac)))) (let ((expected-signature (ironclad:byte-array-to-hex-string (ironclad:produce-mac hmac))))
(unless (string-equal signature expected-signature) (unless (string-equal signature expected-signature)
(error "Harness Communication Integrity Failure: HMAC mismatch")))))) (error "communication protocol Integrity Failure: HMAC mismatch"))))))
;; SECURITY: Disable the reader's ability to execute code during parsing ;; SECURITY: Disable the reader's ability to execute code during parsing
(let ((*read-eval* nil)) (let ((*read-eval* nil))
(let ((msg (read-from-string actual-msg))) (let ((msg (read-from-string actual-msg)))
(validate-harness-protocol-schema msg) (validate-communication-protocol-schema msg)
msg))))) msg)))))
(defun make-hello-message (version) (defun make-hello-message (version)

12
src/org-agent.el
View File

@@ -12,7 +12,7 @@
;; org-agent provides a Probabilistic-Deterministic Lisp Machine interface for Emacs. ;; org-agent provides a Probabilistic-Deterministic Lisp Machine interface for Emacs.
;; It acts as the sensor/actuator array, communicating with a persistent ;; It acts as the sensor/actuator array, communicating with a persistent
;; Common Lisp daemon over a high-speed Harness Communication socket. ;; Common Lisp daemon over a high-speed communication protocol socket.
;;; Code: ;;; Code:
@@ -100,7 +100,7 @@ will assume you have started it manually (e.g., via SBCL)."
(message "org-agent: Killed daemon process."))) (message "org-agent: Killed daemon process.")))
(defun org-agent--filter (proc string) (defun org-agent--filter (proc string)
"Handle incoming Harness Communication messages from the daemon via PROC with STRING." "Handle incoming communication protocol messages from the daemon via PROC with STRING."
(let ((buf (process-buffer proc))) (let ((buf (process-buffer proc)))
(when (buffer-live-p buf) (when (buffer-live-p buf)
(with-current-buffer buf (with-current-buffer buf
@@ -109,7 +109,7 @@ will assume you have started it manually (e.g., via SBCL)."
(org-agent--process-buffer buf proc))))) (org-agent--process-buffer buf proc)))))
(defun org-agent--process-buffer (buffer &optional proc) (defun org-agent--process-buffer (buffer &optional proc)
"Process the Harness Communication message BUFFER, optionally using PROC." "Process the communication protocol message BUFFER, optionally using PROC."
(with-current-buffer buffer (with-current-buffer buffer
(goto-char (point-min)) (goto-char (point-min))
(while (>= (buffer-size) 6) (while (>= (buffer-size) 6)
@@ -127,13 +127,13 @@ will assume you have started it manually (e.g., via SBCL)."
(setq msg-len 1000000)))))) ; Break loop (setq msg-len 1000000)))))) ; Break loop
(defun org-agent--plist-get (plist prop) (defun org-agent--plist-get (plist prop)
"Case-insensitive keyword lookup for Harness Communication compatibility." "Case-insensitive keyword lookup for communication protocol compatibility."
(or (plist-get plist prop) (or (plist-get plist prop)
(plist-get plist (intern (upcase (symbol-name prop)))) (plist-get plist (intern (upcase (symbol-name prop))))
(plist-get plist (intern (downcase (symbol-name prop)))))) (plist-get plist (intern (downcase (symbol-name prop))))))
(defun org-agent--handle-message (proc plist) (defun org-agent--handle-message (proc plist)
"Route and execute incoming Harness Communication messages from PROC using PLIST." "Route and execute incoming communication protocol messages from PROC using PLIST."
(let ((type (org-agent--plist-get plist :type)) (let ((type (org-agent--plist-get plist :type))
(id (org-agent--plist-get plist :id)) (id (org-agent--plist-get plist :id))
(payload (or (org-agent--plist-get plist :payload) plist))) (payload (or (org-agent--plist-get plist :payload) plist)))
@@ -190,7 +190,7 @@ will assume you have started it manually (e.g., via SBCL)."
(message "org-agent: Connection lost."))) (message "org-agent: Connection lost.")))
(defun org-agent-send (plist) (defun org-agent-send (plist)
"Send a Lisp PLIST to the daemon using Harness Communication framing." "Send a Lisp PLIST to the daemon using communication protocol framing."
(let* ((msg (prin1-to-string plist)) (let* ((msg (prin1-to-string plist))
(len (length msg)) (len (length msg))
(framed (format "%06x%s" len msg))) (framed (format "%06x%s" len msg)))

5
src/package.lisp
View File

@@ -1,11 +1,11 @@
(defpackage :org-agent (defpackage :org-agent
(:use :cl) (:use :cl)
(:export (:export
;; --- Harness Communication --- ;; --- communication protocol ---
#:frame-message #:frame-message
#:parse-message #:parse-message
#:make-hello-message #:make-hello-message
#:validate-harness-protocol-schema #:validate-communication-protocol-schema
;; --- Daemon Lifecycle --- ;; --- Daemon Lifecycle ---
#:start-daemon #:start-daemon
@@ -20,6 +20,7 @@
#:*memory* #:*memory*
#:*history-store* #:*history-store*
#:org-object #:org-object
#:make-org-object
#:org-object-id #:org-object-id
#:org-object-type #:org-object-type
#:org-object-attributes #:org-object-attributes

22
src/protocol-validator.lisp
View File

@@ -1,39 +1,39 @@
(in-package :org-agent) (in-package :org-agent)
(defun validate-harness-protocol-schema (msg) (defun validate-communication-protocol-schema (msg)
"Strict structural validation for incoming Harness Communication messages." "Strict structural validation for incoming communication protocol messages."
(unless (listp msg) (unless (listp msg)
(error "Harness Communication Schema Error: Message must be a property list (got ~s)" (type-of msg))) (error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(let ((type (getf msg :type))) (let ((type (getf msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG)) (unless (member type '(:REQUEST :EVENT :RESPONSE :LOG))
(error "Harness Communication Schema Error: Invalid message type '~a'" type)) (error "Communication Protocol Schema Error: Invalid message type '~a'" type))
(case type (case type
(:REQUEST (:REQUEST
(unless (getf msg :target) (unless (getf msg :target)
(error "Harness Communication Schema Error: REQUEST missing mandatory :target")) (error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
(unless (getf msg :payload) (unless (getf msg :payload)
(error "Harness Communication Schema Error: REQUEST missing mandatory :payload"))) (error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
(:EVENT (:EVENT
(let ((payload (getf msg :payload))) (let ((payload (getf msg :payload)))
(unless (and payload (listp payload)) (unless (and payload (listp payload))
(error "Harness Communication Schema Error: EVENT missing or invalid :payload")) (error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
(unless (or (getf payload :action) (getf payload :sensor)) (unless (or (getf payload :action) (getf payload :sensor))
(error "Harness Communication Schema Error: EVENT payload must contain :action or :sensor")))) (error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
(:RESPONSE (:RESPONSE
(unless (getf msg :payload) (unless (getf msg :payload)
(error "Harness Communication Schema Error: RESPONSE missing mandatory :payload")))) (error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
t)) t))
(defskill :skill-harness-protocol-validator (defskill :skill-communication-protocol-validator
:priority 95 :priority 95
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received))) :trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
:probabilistic nil :probabilistic nil
:deterministic (lambda (action ctx) :deterministic (lambda (action ctx)
(declare (ignore ctx)) (declare (ignore ctx))
(validate-harness-protocol-schema action) (validate-communication-protocol-schema action)
action)) action))

125
src/state-persistence.lisp
View File

@@ -1,125 +0,0 @@
(in-package :org-agent)
(defun persistence-get-local-path ()
"Returns the path to the local memory image file."
(let ((state-dir (or (uiop:getenv "SYSTEM_DIR") "system/")))
(merge-pathnames "state/memory-image.lisp" state-dir)))
(defun persistence-dump-local ()
"Serializes the entire history store and current pointers to a local Lisp image."
(let ((image-file (persistence-get-local-path)))
(ensure-directories-exist image-file)
(harness-log "PERSISTENCE - Dumping local image to ~a..." (uiop:native-namestring image-file))
(with-open-file (out image-file :direction :output :if-exists :supersede)
(format out "(in-package :org-agent)~%")
;; 1. Dump all immutable objects in the history store
(maphash (lambda (hash obj)
(print `(setf (gethash ,hash *history-store*) ,obj) out))
*history-store*)
;; 2. Dump the current active pointers
(maphash (lambda (id obj)
(print `(setf (gethash ,id *memory*) (gethash ,(org-object-hash obj) *history-store*)) out))
*memory*))
t))
(defun persistence-load-local ()
"Loads the memory image from local disk."
(let ((image-file (persistence-get-local-path)))
(if (uiop:file-exists-p image-file)
(progn
(harness-log "PERSISTENCE - Loading local image...")
(load image-file)
t)
(progn
(harness-log "PERSISTENCE ERROR - Local image not found.")
nil))))
(defun persistence-serialize-for-archival ()
"Serializes the entire object-store for IPFS/JSON transport."
(let ((objects nil))
(maphash (lambda (id obj)
(declare (ignore id))
(push `((:id . ,(org-object-id obj))
(:type . ,(format nil "~s" (org-object-type obj)))
(:attributes . ,(loop for (k v) on (org-object-attributes obj) by #'cddr
collect (cons (format nil "~a" k) (format nil "~a" v))))
(:content . ,(org-object-content obj))
(:parent-id . ,(org-object-parent-id obj))
(:children . ,(org-object-children obj))
(:version . ,(org-object-version obj))
(:last-sync . ,(org-object-last-sync obj))
(:hash . ,(org-object-hash obj)))
objects))
*memory*)
objects))
(defun persistence-push-ipfs ()
"Serializes the store and pushes it to IPFS, returning the CID."
(let* ((data (persistence-serialize-for-archival))
(json-payload (cl-json:encode-json-to-string data))
(ipfs-url "http://127.0.0.1:5001/api/v0/add"))
(handler-case
(let* ((response (dex:post ipfs-url
:content `(("file" . ,json-payload))
:headers '(("Content-Type" . "multipart/form-data"))))
(result (cl-json:decode-json-from-string response))
(cid (cdr (assoc :hash result))))
(harness-log "PERSISTENCE - Checkpoint to IPFS successful. CID: ~a" cid)
cid)
(error (c)
(harness-log "PERSISTENCE ERROR - IPFS push failed: ~a" c)
nil))))
(defun persistence-restore-ipfs (cid)
"Fetches data from IPFS and safely hydrates the object-store."
(let ((ipfs-url (format nil "http://127.0.0.1:5001/api/v0/cat?arg=~a" cid)))
(handler-case
(let* ((response (dex:post ipfs-url))
(data (cl-json:decode-json-from-string response)))
(clrhash *memory*)
(dolist (item data)
(let* ((id (cdr (assoc :id item)))
(obj (make-org-object
:id id
:type (read-from-string (cdr (assoc :type item)))
:attributes (loop for attr in (cdr (assoc :attributes item))
append (list (intern (string-upcase (car attr)) :keyword) (cdr attr)))
:content (cdr (assoc :content item))
:parent-id (cdr (assoc :parent-id item))
:children (cdr (assoc :children item))
:version (cdr (assoc :version item))
:last-sync (cdr (assoc :last-sync item))
:hash (cdr (assoc :hash item)))))
(setf (gethash id *memory*) obj)))
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
t)
(error (c)
(harness-log "PERSISTENCE ERROR - IPFS restoration failed: ~a" c)
nil))))
(progn
(def-cognitive-tool :checkpoint-memory "Creates both a local image and a decentralized IPFS snapshot."
:parameters nil
:body (lambda (args)
(declare (ignore args))
(persistence-dump-local)
(let ((cid (persistence-push-ipfs)))
(format nil "Local dump complete. IPFS CID: ~a" (or cid "FAILED")))))
(def-cognitive-tool :restore-memory "Restores the state from a specific source."
:parameters ((:source :type :keyword :description "Either :LOCAL or :IPFS")
(:cid :type :string :description "Required if source is :IPFS"))
:body (lambda (args)
(case (getf args :source)
(:local (if (persistence-load-local) "Restored from disk." "Local restore failed."))
(:ipfs (if (persistence-restore-ipfs (getf args :cid)) "Restored from network." "IPFS restore failed."))))))
(defskill :skill-state-persistence
:priority 100
:trigger (lambda (ctx)
(let ((sensor (getf (getf ctx :payload) :sensor)))
(member sensor '(:heartbeat :manual-persist))))
:probabilistic nil
:deterministic (lambda (action ctx)
(persistence-dump-local)
action))

16
system/state/memory-image.lisp Normal file
View File

@@ -0,0 +1,16 @@
(in-package :org-agent)
(SETF (GETHASH "fake-hash-123" *HISTORY-STORE*)
#S(ORG-OBJECT
:ID "persist-test-1"
:TYPE NIL
:ATTRIBUTES NIL
:CONTENT "Integrity Check"
:VECTOR NIL
:PARENT-ID NIL
:CHILDREN NIL
:VERSION NIL
:LAST-SYNC NIL
:HASH "fake-hash-123"))
(SETF (GETHASH "persist-test-1" *MEMORY*)
(GETHASH "fake-hash-123" *HISTORY-STORE*))

6
tests/communication-tests.lisp
View File

@@ -2,9 +2,9 @@
(:use :cl :fiveam :org-agent)) (:use :cl :fiveam :org-agent))
(in-package :org-agent-tests) (in-package :org-agent-tests)
(def-suite harness-protocol-suite (def-suite communication-protocol-suite
:description "Test suite for org-agent Communication Protocol (Harness Communication)") :description "Test suite for org-agent Communication Protocol (communication protocol)")
(in-suite harness-protocol-suite) (in-suite communication-protocol-suite)
(test test-framing (test test-framing
"Verify that messages are correctly prefixed with a 6-character hex length." "Verify that messages are correctly prefixed with a 6-character hex length."

2
tests/org-agent-test.el
View File

@@ -15,7 +15,7 @@
(should (string= "000014(:type :EVENT :id 1)" captured-framed))))) (should (string= "000014(:type :EVENT :id 1)" captured-framed)))))
(ert-deftest test-org-agent-parsing () (ert-deftest test-org-agent-parsing ()
"Verify that the filter correctly parses Harness Communication framed messages." "Verify that the filter correctly parses communication protocol framed messages."
(let ((mock-buffer (generate-new-buffer " *org-agent-test*")) (let ((mock-buffer (generate-new-buffer " *org-agent-test*"))
(received-plist nil)) (received-plist nil))
(cl-letf (((symbol-function 'org-agent--handle-message) (cl-letf (((symbol-function 'org-agent--handle-message)

15
tests/persistence-tests.lisp
View File

@@ -1,15 +0,0 @@
(defpackage :org-agent-persistence-tests
(:use :cl :fiveam :org-agent))
(in-package :org-agent-persistence-tests)
(def-suite persistence-suite :description "Tests for State Persistence Layer.")
(in-suite persistence-suite)
(test test-local-roundtrip
"Ensure RAM -> Disk -> RAM preserves data integrity."
(let ((test-id "persist-test-1"))
(setf (gethash test-id *memory*) (make-org-object :id test-id :content "Integrity Check"))
(org-agent:persistence-dump-local)
(clrhash *memory*)
(org-agent:persistence-load-local)
(is (equal "Integrity Check" (org-object-content (gethash test-id *memory*))))))