ALIGN: Rename Object Store to Memory and enrich literate text
This commit is contained in:
@@ -39,7 +39,7 @@ To guarantee long-term stability, org-agent enforces a strict architectural boun
|
|||||||
|
|
||||||
** The Minimalist Harness
|
** The Minimalist Harness
|
||||||
The Lisp microkernel does almost no actual "work." It is a thin, unbreakable harness strictly responsible for three things:
|
The Lisp microkernel does almost no actual "work." It is a thin, unbreakable harness strictly responsible for three things:
|
||||||
1. *The Object Store:* Maintaining the live graph of your Memex in RAM.
|
1. *The Memory:* Maintaining the live graph of your Memex in RAM.
|
||||||
2. *The Communication Protocol:* Managing the secure bridge between the agent and the outside world. While power users can connect natively via Emacs or Vim, the vast majority of users will interact with org-agent exclusively through chat clients (like Telegram, Signal, or Matrix), web dashboards, or a Terminal UI (TUI). The harness doesn't care; it just securely routes the messages.
|
2. *The Communication Protocol:* Managing the secure bridge between the agent and the outside world. While power users can connect natively via Emacs or Vim, the vast majority of users will interact with org-agent exclusively through chat clients (like Telegram, Signal, or Matrix), web dashboards, or a Terminal UI (TUI). The harness doesn't care; it just securely routes the messages.
|
||||||
3. *The Cognitive Loop:* Moving signals through the Perceive -> Probabilistic -> Deterministic -> Dispatch pipeline.
|
3. *The Cognitive Loop:* Moving signals through the Perceive -> Probabilistic -> Deterministic -> Dispatch pipeline.
|
||||||
|
|
||||||
@@ -61,7 +61,7 @@ When the system boots, it parses these single files, mathematically proves their
|
|||||||
** The Anatomy: Three Data Stores
|
** The Anatomy: Three Data Stores
|
||||||
The agent's "mind" is not a transient chat session; it is a durable, stateful architecture consisting of three layers:
|
The agent's "mind" is not a transient chat session; it is a durable, stateful architecture consisting of three layers:
|
||||||
1. *The Linguistic Substrate (Plaintext Files):* The human-readable Source of Truth on your hard drive. You can edit these files in any text editor, and the agent will instantly perceive the changes.
|
1. *The Linguistic Substrate (Plaintext Files):* The human-readable Source of Truth on your hard drive. You can edit these files in any text editor, and the agent will instantly perceive the changes.
|
||||||
2. *The Lisp Object Store (RAM):* The "Active Brain," a live, threaded graph of Lisp objects representing every headline, paragraph, and tag in your Memex. It allows the agent to navigate your life instantly without constantly re-reading files.
|
2. *The Lisp Memory (RAM):* The "Active Brain," a live, threaded graph of Lisp objects representing every headline, paragraph, and tag in your Memex. It allows the agent to navigate your life instantly without constantly re-reading files.
|
||||||
3. *The Telemetry Store (External):* A high-volume database for sub-deterministic sensory data (e.g., smart home logs or system metrics), which the agent monitors and distills.
|
3. *The Telemetry Store (External):* A high-volume database for sub-deterministic sensory data (e.g., smart home logs or system metrics), which the agent monitors and distills.
|
||||||
|
|
||||||
** The Psychology: The 2x2 Cognitive Matrix
|
** The Psychology: The 2x2 Cognitive Matrix
|
||||||
|
|||||||
@@ -26,7 +26,7 @@ docker-compose logs -f
|
|||||||
* Volume Mapping
|
* Volume Mapping
|
||||||
The ~docker-compose.yml~ file automatically mounts your host's ~memex~ directory to ~/memex~ inside the container. This allows the agent to:
|
The ~docker-compose.yml~ file automatically mounts your host's ~memex~ directory to ~/memex~ inside the container. This allows the agent to:
|
||||||
1. Read/Write to your Zettelkasten and GTD files.
|
1. Read/Write to your Zettelkasten and GTD files.
|
||||||
2. Maintain its local state (Object Store, snapshots).
|
2. Maintain its local state (Memory, snapshots).
|
||||||
|
|
||||||
* Troubleshooting
|
* Troubleshooting
|
||||||
** signal-cli Identity
|
** signal-cli Identity
|
||||||
|
|||||||
@@ -15,7 +15,7 @@ Architecture gap. The system lacked an authorization state between "Safe" and "E
|
|||||||
2. **Asynchronous Event:** If flagged, the harness emits an `:approval-required` event.
|
2. **Asynchronous Event:** If flagged, the harness emits an `:approval-required` event.
|
||||||
3. **Flight Plan Skill:** Created `org-skill-bouncer.org` to:
|
3. **Flight Plan Skill:** Created `org-skill-bouncer.org` to:
|
||||||
- Catch the event and create a serialized Org node with state `PLAN`.
|
- Catch the event and create a serialized Org node with state `PLAN`.
|
||||||
- Monitor the Object Store for `APPROVED` states.
|
- Monitor the Memory for `APPROVED` states.
|
||||||
- Re-inject approved actions with the `:approved t` bypass flag.
|
- Re-inject approved actions with the `:approved t` bypass flag.
|
||||||
|
|
||||||
* 2. Design Decision: Org-native Approval
|
* 2. Design Decision: Org-native Approval
|
||||||
@@ -30,4 +30,4 @@ Ensures that the agent's "Flight Plans" are first-class citizens in the Memex, a
|
|||||||
|
|
||||||
* 3. Permanent Learnings
|
* 3. Permanent Learnings
|
||||||
- **Serial Bypass:** Always include a specific bypass flag (e.g., `:approved t`) when re-injecting intercepted actions to prevent infinite interception loops.
|
- **Serial Bypass:** Always include a specific bypass flag (e.g., `:approved t`) when re-injecting intercepted actions to prevent infinite interception loops.
|
||||||
- **Heartbeat Listeners:** Periodic scanning of the Object Store for state transitions is an effective way to implement asynchronous authorization gates without blocking the harness.
|
- **Heartbeat Listeners:** Periodic scanning of the Memory for state transitions is an effective way to implement asynchronous authorization gates without blocking the harness.
|
||||||
|
|||||||
@@ -14,7 +14,7 @@ The ~org-agent~ harness implements a deterministic, tree-aware solution: the **F
|
|||||||
When the harness prepares a prompt for the Probabilistic Engine, it identifies a "Foveal Focus"—typically the specific Org headline or task the user is currently interacting with. This node, along with its immediate children and semantically relevant neighbors, is rendered at "High Resolution," meaning its full body text, properties, and metadata are included in the prompt.
|
When the harness prepares a prompt for the Probabilistic Engine, it identifies a "Foveal Focus"—typically the specific Org headline or task the user is currently interacting with. This node, along with its immediate children and semantically relevant neighbors, is rendered at "High Resolution," meaning its full body text, properties, and metadata are included in the prompt.
|
||||||
|
|
||||||
*** 2. The Peripheral Vision (Low Resolution)
|
*** 2. The Peripheral Vision (Low Resolution)
|
||||||
To maintain global awareness without bloating the context window, the rest of the Memex is rendered at "Low Resolution." The harness recursively walks the Object Store and generates a skeletal outline consisting only of titles and IDs. This gives the LLM a "mental map" of the entire system, allowing it to reference other projects or skills without needing to see their full content until they are explicitly brought into focus.
|
To maintain global awareness without bloating the context window, the rest of the Memex is rendered at "Low Resolution." The harness recursively walks the Memory and generates a skeletal outline consisting only of titles and IDs. This gives the LLM a "mental map" of the entire system, allowing it to reference other projects or skills without needing to see their full content until they are explicitly brought into focus.
|
||||||
|
|
||||||
*** 3. Deterministic Tree-Walking
|
*** 3. Deterministic Tree-Walking
|
||||||
By leveraging Common Lisp's strengths in recursive tree manipulation, the harness can surgically prune the AST before it ever reaches the LLM. This ensures that the structural hierarchy of the Memex is preserved perfectly, even when the content is compressed.
|
By leveraging Common Lisp's strengths in recursive tree manipulation, the harness can surgically prune the AST before it ever reaches the LLM. This ensures that the structural hierarchy of the Memex is preserved perfectly, even when the content is compressed.
|
||||||
@@ -22,7 +22,7 @@ By leveraging Common Lisp's strengths in recursive tree manipulation, the harnes
|
|||||||
** The Context Pipeline
|
** The Context Pipeline
|
||||||
#+begin_src mermaid
|
#+begin_src mermaid
|
||||||
flowchart TD
|
flowchart TD
|
||||||
Store[(Object Store)] --> Filter[Context Query Filter]
|
Store[(Memory)] --> Filter[Context Query Filter]
|
||||||
Filter --> Identification{Identify Foveal ID}
|
Filter --> Identification{Identify Foveal ID}
|
||||||
Identification --> Foveal[Render Focus: Full Content]
|
Identification --> Foveal[Render Focus: Full Content]
|
||||||
Identification --> Peripheral[Render Outline: Titles Only]
|
Identification --> Peripheral[Render Outline: Titles Only]
|
||||||
@@ -32,7 +32,7 @@ flowchart TD
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Context Assembly (context.lisp)
|
* Context Assembly (context.lisp)
|
||||||
The ~context.lisp~ module provides the deterministic functional layer for querying the Object Store and transforming its internal pointers into the precise context strings required for neural reasoning.
|
The ~context.lisp~ module provides the deterministic functional layer for querying the Memory and transforming its internal pointers into the precise context strings required for neural reasoning.
|
||||||
|
|
||||||
** Package Context
|
** Package Context
|
||||||
We begin by ensuring we are executing within the correct isolated package namespace.
|
We begin by ensuring we are executing within the correct isolated package namespace.
|
||||||
@@ -42,11 +42,11 @@ We begin by ensuring we are executing within the correct isolated package namesp
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Querying the Store (context-query-store)
|
** Querying the Store (context-query-store)
|
||||||
A generalized filter for the Object Store. This function allows skills to perform high-level semantic sweeps of the Memex based on tags, TODO states, or Org element types. It returns a list of ~org-object~ structures.
|
A generalized filter for the Memory. This function allows skills to perform high-level semantic sweeps of the Memex based on tags, TODO states, or Org element types. It returns a list of ~org-object~ structures.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
#+begin_src lisp :tangle ../src/context.lisp
|
||||||
(defun context-query-store (&key tag todo-state type)
|
(defun context-query-store (&key tag todo-state type)
|
||||||
"Filters the Object Store based on tags, todo states, or types."
|
"Filters the Memory based on tags, todo states, or types."
|
||||||
(let ((results nil))
|
(let ((results nil))
|
||||||
(maphash (lambda (id obj)
|
(maphash (lambda (id obj)
|
||||||
(declare (ignore id))
|
(declare (ignore id))
|
||||||
@@ -55,7 +55,7 @@ A generalized filter for the Object Store. This function allows skills to perfor
|
|||||||
(when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
|
(when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
|
||||||
(when (and todo-state (not (equal state todo-state))) (setf match nil))
|
(when (and todo-state (not (equal state todo-state))) (setf match nil))
|
||||||
(when match (push obj results))))
|
(when match (push obj results))))
|
||||||
*object-store*)
|
*memory*)
|
||||||
results))
|
results))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@@ -198,7 +198,7 @@ The primary entry point for context generation. This function identifies active
|
|||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
#+begin_src lisp :tangle ../src/context.lisp
|
||||||
(defun context-assemble-global-awareness (&optional signal)
|
(defun context-assemble-global-awareness (&optional signal)
|
||||||
"Produces a high-level skeletal outline of the current Object Store for the LLM."
|
"Produces a high-level skeletal outline of the current Memory for the LLM."
|
||||||
(let* ((payload (when signal (getf signal :payload)))
|
(let* ((payload (when signal (getf signal :payload)))
|
||||||
(foveal-id (when payload (getf payload :target-id)))
|
(foveal-id (when payload (getf payload :target-id)))
|
||||||
(projects (context-get-active-projects))
|
(projects (context-get-active-projects))
|
||||||
@@ -227,7 +227,7 @@ Following the Engineering Standards, the peripheral vision extraction and render
|
|||||||
|
|
||||||
(test test-foveal-rendering
|
(test test-foveal-rendering
|
||||||
"Verify that the foveal target is rendered with content, while siblings are skeletal."
|
"Verify that the foveal target is rendered with content, while siblings are skeletal."
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project")
|
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project")
|
||||||
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
|
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
|
||||||
:raw-content "FOVEAL CONTENT" :contents nil)
|
:raw-content "FOVEAL CONTENT" :contents nil)
|
||||||
@@ -243,7 +243,7 @@ Following the Engineering Standards, the peripheral vision extraction and render
|
|||||||
|
|
||||||
(test test-awareness-budget
|
(test test-awareness-budget
|
||||||
"Verify that context-assemble-global-awareness handles multiple projects."
|
"Verify that context-assemble-global-awareness handles multiple projects."
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project") :contents nil))
|
(ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project") :contents nil))
|
||||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project") :contents nil))
|
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project") :contents nil))
|
||||||
(let ((output (context-assemble-global-awareness)))
|
(let ((output (context-assemble-global-awareness)))
|
||||||
|
|||||||
@@ -33,7 +33,7 @@ The Metabolic Loop is the high-level coordinator of the Org-Agent. It orchestrat
|
|||||||
(setf current-signal (act-gate current-signal)))
|
(setf current-signal (act-gate current-signal)))
|
||||||
(error (c)
|
(error (c)
|
||||||
(harness-log "METABOLISM CRASH: ~a - Initiating Micro-Rollback." c)
|
(harness-log "METABOLISM CRASH: ~a - Initiating Micro-Rollback." c)
|
||||||
(rollback-object-store 0)
|
(rollback-memory 0)
|
||||||
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
||||||
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
||||||
(setf current-signal nil)
|
(setf current-signal nil)
|
||||||
|
|||||||
@@ -1,22 +1,24 @@
|
|||||||
#+TITLE: The Object Store (object-store.lisp)
|
#+TITLE: The System Memory (memory.lisp)
|
||||||
#+AUTHOR: Amr
|
#+AUTHOR: Amr
|
||||||
#+FILETAGS: :harness:memory:
|
#+FILETAGS: :harness:memory:
|
||||||
#+STARTUP: content
|
#+STARTUP: content
|
||||||
|
|
||||||
* The Object Store (object-store.lisp)
|
* The System Memory (memory.lisp)
|
||||||
** Architectural Intent: The Single Address Space
|
** Architectural Intent: The Single Address Space (Live Memory)
|
||||||
|
|
||||||
Traditional architectures rely on external databases (SQLite, Vector DBs) which introduce I/O latency and structural impedance. The org-agent architecture chooses a different path: the Single Address Space.
|
Yes, the Memory module is the cognitive bedrock of the PSF. It is not a database; it is the agent's live, active "brain" state.
|
||||||
|
|
||||||
|
Traditional architectures rely on external databases (SQLite, Vector DBs) which introduce I/O latency and structural impedance. The org-agent architecture chooses a different path: the **Single Address Space**. By treating the entire knowledge base as a graph of Lisp pointers, we achieve microsecond recollection and total structural transparency.
|
||||||
|
|
||||||
- **Pointer-Based Reasoning:** By loading the entire knowledge graph into a live Common Lisp hash table, we achieve microsecond recollection. The harness doesn't "search a file"; it traverses a memory pointer.
|
- **Pointer-Based Reasoning:** By loading the entire knowledge graph into a live Common Lisp hash table, we achieve microsecond recollection. The harness doesn't "search a file"; it traverses a memory pointer.
|
||||||
- **Memory Imaging:** The ability to snapshot the Lisp image allows the agent to resume its entire cognitive state instantly, solving the "Cold Start" problem.
|
- **Memory Imaging:** The ability to snapshot the Lisp image allows the agent to resume its entire cognitive state instantly, solving the "Cold Start" problem.
|
||||||
- **Merkle-Tree Integrity:** Every node in the Object Store is cryptographically hashed. By recursively hashing content and children, the root hash provides a single, immutable fingerprint of the entire system state.
|
- **Merkle-Tree Integrity:** Every node in the Memory is cryptographically hashed. By recursively hashing content and children, the root hash provides a single, immutable fingerprint of the entire system state.
|
||||||
|
|
||||||
** System Architecture
|
** System Architecture
|
||||||
#+begin_src mermaid
|
#+begin_src mermaid
|
||||||
flowchart TD
|
flowchart TD
|
||||||
subgraph LispMachine[Lisp Machine]
|
subgraph LispMachine[Lisp Machine]
|
||||||
H[Harness Pipeline] --> OS[(Object Store)]
|
H[Harness Pipeline] --> OS[(Memory)]
|
||||||
S1[Skill: Architect] --> OS
|
S1[Skill: Architect] --> OS
|
||||||
S2[Skill: Analyst] --> OS
|
S2[Skill: Analyst] --> OS
|
||||||
S3[Skill: GTD] --> OS
|
S3[Skill: GTD] --> OS
|
||||||
@@ -29,15 +31,15 @@ flowchart TD
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Package Context
|
** Package Context
|
||||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(in-package :org-agent)
|
(in-package :org-agent)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** The Object Repository
|
** The Object Repository
|
||||||
The `*object-store*` is the global hash table that holds every Org element by its unique ID. This is the "live RAM" of the agent's memory.
|
The `*memory*` is the global hash table that holds every Org element by its unique ID. This is the "live RAM" of the agent's memory.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defvar *object-store* (make-hash-table :test 'equal))
|
(defvar *memory* (make-hash-table :test 'equal))
|
||||||
|
|
||||||
(defvar *history-store* (make-hash-table :test 'equal)
|
(defvar *history-store* (make-hash-table :test 'equal)
|
||||||
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
|
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
|
||||||
@@ -46,7 +48,7 @@ The `*object-store*` is the global hash table that holds every Org element by it
|
|||||||
** The Data Structure (org-object)
|
** The Data Structure (org-object)
|
||||||
Every element in the Memex (headlines, paragraphs, etc.) is represented by an `org-object` structure. It contains both semantic metadata (attributes, content) and structural metadata (parent/child pointers, Merkle hashes).
|
Every element in the Memex (headlines, paragraphs, etc.) is represented by an `org-object` structure. It contains both semantic metadata (attributes, content) and structural metadata (parent/child pointers, Merkle hashes).
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defstruct org-object
|
(defstruct org-object
|
||||||
id type attributes content vector parent-id children version last-sync hash)
|
id type attributes content vector parent-id children version last-sync hash)
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -54,7 +56,7 @@ Every element in the Memex (headlines, paragraphs, etc.) is represented by an `o
|
|||||||
** Merkle Tree Integrity (compute-merkle-hash)
|
** Merkle Tree Integrity (compute-merkle-hash)
|
||||||
The `compute-merkle-hash` function ensures the cryptographic integrity of the knowledge graph. A node's hash depends on its own properties and the hashes of all its children. This creates a recursive fingerprint where any change to a single note propagates up to the root hash.
|
The `compute-merkle-hash` function ensures the cryptographic integrity of the knowledge graph. A node's hash depends on its own properties and the hashes of all its children. This creates a recursive fingerprint where any change to a single note propagates up to the root hash.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defun compute-merkle-hash (id type attributes content child-hashes)
|
(defun compute-merkle-hash (id type attributes content child-hashes)
|
||||||
"Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes."
|
"Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes."
|
||||||
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
|
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
|
||||||
@@ -71,9 +73,9 @@ The `compute-merkle-hash` function ensures the cryptographic integrity of the kn
|
|||||||
** Ingesting the AST (ingest-ast)
|
** Ingesting the AST (ingest-ast)
|
||||||
The `ingest-ast` function is the primary bridge between the external world (Emacs/JSON) and the internal Lisp machine. It recursively parses an Org-mode Abstract Syntax Tree (AST) into `org-object` structures and registers them in the store.
|
The `ingest-ast` function is the primary bridge between the external world (Emacs/JSON) and the internal Lisp machine. It recursively parses an Org-mode Abstract Syntax Tree (AST) into `org-object` structures and registers them in the store.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defun ingest-ast (ast &optional parent-id)
|
(defun ingest-ast (ast &optional parent-id)
|
||||||
"Parses an Org AST into the recursive Lisp Object Store with Merkle hashing."
|
"Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
|
||||||
(let* ((type (getf ast :type))
|
(let* ((type (getf ast :type))
|
||||||
(props (getf ast :properties))
|
(props (getf ast :properties))
|
||||||
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
|
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
|
||||||
@@ -103,14 +105,14 @@ The `ingest-ast` function is the primary bridge between the external world (Emac
|
|||||||
:hash hash))))
|
:hash hash))))
|
||||||
(unless existing-obj
|
(unless existing-obj
|
||||||
(setf (gethash hash *history-store*) obj))
|
(setf (gethash hash *history-store*) obj))
|
||||||
(setf (gethash id *object-store*) obj)
|
(setf (gethash id *memory*) obj)
|
||||||
id)))
|
id)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Memory Snapshots (snapshot-object-store)
|
** Memory Snapshots (snapshot-memory)
|
||||||
Because objects are stored immutably in the `*history-store*`, a snapshot is a lightweight shallow copy of the active `*object-store*` pointers. The system maintains a rolling buffer of 20 snapshots, allowing for near-instant, zero-cost rollback.
|
Because objects are stored immutably in the `*history-store*`, a snapshot is a lightweight shallow copy of the active `*memory*` pointers. The system maintains a rolling buffer of 20 snapshots, allowing for near-instant, zero-cost rollback.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defvar *object-store-snapshots* nil)
|
(defvar *object-store-snapshots* nil)
|
||||||
|
|
||||||
(defun copy-hash-table (hash-table)
|
(defun copy-hash-table (hash-table)
|
||||||
@@ -120,47 +122,47 @@ Because objects are stored immutably in the `*history-store*`, a snapshot is a l
|
|||||||
(maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
|
(maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
|
||||||
new-table))
|
new-table))
|
||||||
|
|
||||||
(defun snapshot-object-store ()
|
(defun snapshot-memory ()
|
||||||
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
|
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
|
||||||
(let ((snapshot (copy-hash-table *object-store*)))
|
(let ((snapshot (copy-hash-table *memory*)))
|
||||||
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
|
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
|
||||||
(when (> (length *object-store-snapshots*) 20)
|
(when (> (length *object-store-snapshots*) 20)
|
||||||
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
|
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
|
||||||
(harness-log "MEMORY - CoW Object Store snapshot created.")))
|
(harness-log "MEMORY - CoW Memory snapshot created.")))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Memory Rollback (rollback-object-store)
|
** Memory Rollback (rollback-memory)
|
||||||
Restores the state of the Memex from one of the previous snapshots.
|
Restores the state of the Memex from one of the previous snapshots.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defun rollback-object-store (&optional (index 0))
|
(defun rollback-memory (&optional (index 0))
|
||||||
"Restores the Object Store to a previously captured snapshot using immutable history pointers."
|
"Restores the Memory to a previously captured snapshot using immutable history pointers."
|
||||||
(let ((snapshot (nth index *object-store-snapshots*)))
|
(let ((snapshot (nth index *object-store-snapshots*)))
|
||||||
(if snapshot
|
(if snapshot
|
||||||
(progn (setf *object-store* (copy-hash-table (getf snapshot :data)))
|
(progn (setf *memory* (copy-hash-table (getf snapshot :data)))
|
||||||
(harness-log "MEMORY - Object Store rolled back to snapshot ~a" index))
|
(harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
|
||||||
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
|
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Lookup Utilities
|
** Lookup Utilities
|
||||||
Basic functions for retrieving objects by ID or type.
|
Basic functions for retrieving objects by ID or type.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defun lookup-object (id)
|
(defun lookup-object (id)
|
||||||
"Retrieves an object from the store by its unique ID."
|
"Retrieves an object from the store by its unique ID."
|
||||||
(gethash id *object-store*))
|
(gethash id *memory*))
|
||||||
|
|
||||||
(defun list-objects-by-type (type)
|
(defun list-objects-by-type (type)
|
||||||
"Returns a list of all objects matching a specific Org element type."
|
"Returns a list of all objects matching a specific Org element type."
|
||||||
(let ((results nil))
|
(let ((results nil))
|
||||||
(maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *object-store*)
|
(maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *memory*)
|
||||||
results))
|
results))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Structural Helpers
|
** Structural Helpers
|
||||||
Utility functions for AST traversal and path resolution.
|
Utility functions for AST traversal and path resolution.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defun find-headline-missing-id (ast)
|
(defun find-headline-missing-id (ast)
|
||||||
"Traverses an AST to find headlines that lack an :ID: property."
|
"Traverses an AST to find headlines that lack an :ID: property."
|
||||||
(when (listp ast)
|
(when (listp ast)
|
||||||
@@ -174,27 +176,27 @@ Utility functions for AST traversal and path resolution.
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Phase E: Chaos (Verification)
|
* Phase E: Chaos (Verification)
|
||||||
Following the Engineering Standards, the Object Store must be empirically verified through automated testing. The following test suite ensures the mathematical integrity of the Merkle hashes and the behavioral correctness of the immutable versioning and rollback systems.
|
Following the Engineering Standards, the Memory must be empirically verified through automated testing. The following test suite ensures the mathematical integrity of the Merkle hashes and the behavioral correctness of the immutable versioning and rollback systems.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../tests/object-store-tests.lisp
|
#+begin_src lisp :tangle ../tests/memory-tests.lisp
|
||||||
(defpackage :org-agent-object-store-tests
|
(defpackage :org-agent-memory-tests
|
||||||
(:use :cl :fiveam :org-agent)
|
(:use :cl :fiveam :org-agent)
|
||||||
(:export #:object-store-suite))
|
(:export #:memory-suite))
|
||||||
|
|
||||||
(in-package :org-agent-object-store-tests)
|
(in-package :org-agent-memory-tests)
|
||||||
|
|
||||||
(def-suite object-store-suite
|
(def-suite memory-suite
|
||||||
:description "Tests for the Merkle-Tree Object Store.")
|
:description "Tests for the Merkle-Tree Memory.")
|
||||||
|
|
||||||
(in-suite object-store-suite)
|
(in-suite memory-suite)
|
||||||
|
|
||||||
(test merkle-hash-consistency
|
(test merkle-hash-consistency
|
||||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil))
|
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil))
|
||||||
(ast2 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
|
(ast2 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(let ((id1 (ingest-ast ast1)))
|
(let ((id1 (ingest-ast ast1)))
|
||||||
(let ((hash1 (org-object-hash (lookup-object id1))))
|
(let ((hash1 (org-object-hash (lookup-object id1))))
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(let ((id2 (ingest-ast ast2)))
|
(let ((id2 (ingest-ast ast2)))
|
||||||
(let ((hash2 (org-object-hash (lookup-object id2))))
|
(let ((hash2 (org-object-hash (lookup-object id2))))
|
||||||
(is (equal hash1 hash2))))))))
|
(is (equal hash1 hash2))))))))
|
||||||
@@ -203,19 +205,19 @@ Following the Engineering Standards, the Object Store must be empirically verifi
|
|||||||
(let* ((ast-leaf '(:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))
|
(let* ((ast-leaf '(:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))
|
||||||
(ast-root-full '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
(ast-root-full '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
||||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))))
|
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))))
|
||||||
(id-root (progn (clrhash *object-store*) (ingest-ast ast-root-full)))
|
(id-root (progn (clrhash *memory*) (ingest-ast ast-root-full)))
|
||||||
(initial-root-hash (org-object-hash (lookup-object id-root))))
|
(initial-root-hash (org-object-hash (lookup-object id-root))))
|
||||||
|
|
||||||
;; Now ingest a modified version (title change)
|
;; Now ingest a modified version (title change)
|
||||||
(let* ((ast-root-modified '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
(let* ((ast-root-modified '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
||||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf Modified") :contents nil))))
|
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf Modified") :contents nil))))
|
||||||
(id-root-mod (progn (clrhash *object-store*) (ingest-ast ast-root-modified)))
|
(id-root-mod (progn (clrhash *memory*) (ingest-ast ast-root-modified)))
|
||||||
(modified-root-hash (org-object-hash (lookup-object id-root-mod))))
|
(modified-root-hash (org-object-hash (lookup-object id-root-mod))))
|
||||||
(is (not (equal initial-root-hash modified-root-hash))))))
|
(is (not (equal initial-root-hash modified-root-hash))))))
|
||||||
|
|
||||||
(test history-store-immutability
|
(test history-store-immutability
|
||||||
"Verify that *history-store* retains old versions even after *object-store* updates."
|
"Verify that *history-store* retains old versions even after *memory* updates."
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(clrhash *history-store*)
|
(clrhash *history-store*)
|
||||||
(let* ((ast-v1 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 1") :contents nil))
|
(let* ((ast-v1 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 1") :contents nil))
|
||||||
(id-v1 (ingest-ast ast-v1))
|
(id-v1 (ingest-ast ast-v1))
|
||||||
@@ -242,7 +244,7 @@ Following the Engineering Standards, the Object Store must be empirically verifi
|
|||||||
|
|
||||||
(test cow-snapshot-and-rollback
|
(test cow-snapshot-and-rollback
|
||||||
"Verify that lightweight snapshots can accurately restore previous pointer states."
|
"Verify that lightweight snapshots can accurately restore previous pointer states."
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(clrhash *history-store*)
|
(clrhash *history-store*)
|
||||||
(setf *object-store-snapshots* nil)
|
(setf *object-store-snapshots* nil)
|
||||||
|
|
||||||
@@ -251,7 +253,7 @@ Following the Engineering Standards, the Object Store must be empirically verifi
|
|||||||
(hash-v1 (org-object-hash (lookup-object id-v1))))
|
(hash-v1 (org-object-hash (lookup-object id-v1))))
|
||||||
|
|
||||||
;; Take a snapshot at State A
|
;; Take a snapshot at State A
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
|
|
||||||
(let* ((ast-v2 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State B") :contents nil))
|
(let* ((ast-v2 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State B") :contents nil))
|
||||||
(id-v2 (ingest-ast ast-v2))
|
(id-v2 (ingest-ast ast-v2))
|
||||||
@@ -261,7 +263,7 @@ Following the Engineering Standards, the Object Store must be empirically verifi
|
|||||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
|
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
|
||||||
|
|
||||||
;; Rollback to State A (index 0 because we only took 1 snapshot)
|
;; Rollback to State A (index 0 because we only took 1 snapshot)
|
||||||
(rollback-object-store 0)
|
(rollback-memory 0)
|
||||||
|
|
||||||
;; Verify we are back in State A
|
;; Verify we are back in State A
|
||||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v1))
|
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v1))
|
||||||
@@ -7,7 +7,7 @@
|
|||||||
The ~package.lisp~ file defines the public API of the ~org-agent~ harness. It serves as the primary membrane between the deterministic core modules and the dynamic world of skills and actuators.
|
The ~package.lisp~ file defines the public API of the ~org-agent~ harness. It serves as the primary membrane between the deterministic core modules and the dynamic world of skills and actuators.
|
||||||
|
|
||||||
** Architectural Intent: The Package Membrane
|
** Architectural Intent: The Package Membrane
|
||||||
By strictly defining the public interface, we ensure that skills remain decoupled from the harness implementation details. This allows for sovereign replacement of any component (e.g., swapping the Object Store or the Probabilistic Engine) without breaking existing skills.
|
By strictly defining the public interface, we ensure that skills remain decoupled from the harness implementation details. This allows for sovereign replacement of any component (e.g., swapping the Memory or the Probabilistic Engine) without breaking existing skills.
|
||||||
|
|
||||||
#+begin_src mermaid
|
#+begin_src mermaid
|
||||||
flowchart TD
|
flowchart TD
|
||||||
@@ -34,11 +34,11 @@ flowchart TD
|
|||||||
#:harness-log
|
#:harness-log
|
||||||
#:main
|
#:main
|
||||||
|
|
||||||
;; --- Object Store (CLOSOS) ---
|
;; --- Memory (CLOSOS) ---
|
||||||
#:ingest-ast
|
#:ingest-ast
|
||||||
#:lookup-object
|
#:lookup-object
|
||||||
#:list-objects-by-type
|
#:list-objects-by-type
|
||||||
#:*object-store*
|
#:*memory*
|
||||||
#:*history-store*
|
#:*history-store*
|
||||||
#:org-object
|
#:org-object
|
||||||
#:org-object-id
|
#:org-object-id
|
||||||
@@ -51,8 +51,8 @@ flowchart TD
|
|||||||
#:org-object-vector
|
#:org-object-vector
|
||||||
#:org-object-content
|
#:org-object-content
|
||||||
#:org-object-hash
|
#:org-object-hash
|
||||||
#:snapshot-object-store
|
#:snapshot-memory
|
||||||
#:rollback-object-store
|
#:rollback-memory
|
||||||
|
|
||||||
;; --- Context API (Peripheral Vision) ---
|
;; --- Context API (Peripheral Vision) ---
|
||||||
#:context-query-store
|
#:context-query-store
|
||||||
|
|||||||
@@ -5,7 +5,7 @@
|
|||||||
|
|
||||||
* Stage 1: Perceive (perceive.lisp)
|
* Stage 1: Perceive (perceive.lisp)
|
||||||
** Architectural Intent: Sensory Ingestion
|
** Architectural Intent: Sensory Ingestion
|
||||||
The Perceive stage is responsible for data normalization and sensory intake. It takes raw stimuli (from TCP sockets, Signal, or Heartbeats) and updates the global Object Store graph.
|
The Perceive stage is responsible for data normalization and sensory intake. It takes raw stimuli (from TCP sockets, Signal, or Heartbeats) and updates the global Memory graph.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/perceive.lisp
|
#+begin_src lisp :tangle ../src/perceive.lisp
|
||||||
(in-package :org-agent)
|
(in-package :org-agent)
|
||||||
@@ -34,7 +34,7 @@ The Perceive stage is responsible for data normalization and sensory intake. It
|
|||||||
(type (getf signal :type))
|
(type (getf signal :type))
|
||||||
(sensor (getf payload :sensor)))
|
(sensor (getf payload :sensor)))
|
||||||
(harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor"))
|
(harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor"))
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
(cond ((eq type :EVENT)
|
(cond ((eq type :EVENT)
|
||||||
(case sensor
|
(case sensor
|
||||||
(:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast))))
|
(:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast))))
|
||||||
|
|||||||
@@ -44,7 +44,7 @@ This system defines the core "Thin Harness." It includes the protocol, the objec
|
|||||||
(:file "src/engineering-standards")
|
(:file "src/engineering-standards")
|
||||||
(:file "src/communication-validator")
|
(:file "src/communication-validator")
|
||||||
(:file "src/communication")
|
(:file "src/communication")
|
||||||
(:file "src/object-store")
|
(:file "src/memory")
|
||||||
(:file "src/embedding")
|
(:file "src/embedding")
|
||||||
(:file "src/embedding-logic")
|
(:file "src/embedding-logic")
|
||||||
(:file "src/context")
|
(:file "src/context")
|
||||||
@@ -79,7 +79,7 @@ This system contains the empirical tests required by the Engineering Standards.
|
|||||||
(:file "tests/peripheral-vision-tests")
|
(:file "tests/peripheral-vision-tests")
|
||||||
(:file "tests/lisp-validator-tests")
|
(:file "tests/lisp-validator-tests")
|
||||||
(:file "tests/boot-sequence-tests")
|
(:file "tests/boot-sequence-tests")
|
||||||
(:file "tests/object-store-tests")
|
(:file "tests/memory-tests")
|
||||||
(:file "tests/immune-system-tests")
|
(:file "tests/immune-system-tests")
|
||||||
(:file "tests/task-orchestrator-tests")
|
(:file "tests/task-orchestrator-tests")
|
||||||
(:file "tests/self-fix-tests")
|
(:file "tests/self-fix-tests")
|
||||||
@@ -98,7 +98,7 @@ This system contains the empirical tests required by the Engineering Standards.
|
|||||||
(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))
|
||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :org-agent-boot-tests))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :org-agent-boot-tests))
|
||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :object-store-suite :org-agent-object-store-tests))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :memory-suite :org-agent-memory-tests))
|
||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :org-agent-immune-system-tests))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :org-agent-immune-system-tests))
|
||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :task-orchestrator-suite :org-agent-task-orchestrator-tests))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :task-orchestrator-suite :org-agent-task-orchestrator-tests))
|
||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :self-fix-suite :org-agent-self-fix-tests))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :self-fix-suite :org-agent-self-fix-tests))
|
||||||
|
|||||||
@@ -12,7 +12,7 @@
|
|||||||
(:file "src/engineering-standards")
|
(:file "src/engineering-standards")
|
||||||
(:file "src/communication-validator")
|
(:file "src/communication-validator")
|
||||||
(:file "src/communication")
|
(:file "src/communication")
|
||||||
(:file "src/object-store")
|
(:file "src/memory")
|
||||||
(:file "src/embedding")
|
(:file "src/embedding")
|
||||||
(:file "src/embedding-logic")
|
(:file "src/embedding-logic")
|
||||||
(:file "src/context")
|
(:file "src/context")
|
||||||
@@ -42,7 +42,7 @@
|
|||||||
(:file "tests/peripheral-vision-tests")
|
(:file "tests/peripheral-vision-tests")
|
||||||
(:file "tests/lisp-validator-tests")
|
(:file "tests/lisp-validator-tests")
|
||||||
(:file "tests/boot-sequence-tests")
|
(:file "tests/boot-sequence-tests")
|
||||||
(:file "tests/object-store-tests")
|
(:file "tests/memory-tests")
|
||||||
(:file "tests/immune-system-tests")
|
(:file "tests/immune-system-tests")
|
||||||
(:file "tests/task-orchestrator-tests")
|
(:file "tests/task-orchestrator-tests")
|
||||||
(:file "tests/self-fix-tests")
|
(:file "tests/self-fix-tests")
|
||||||
@@ -61,7 +61,7 @@
|
|||||||
(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))
|
||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :org-agent-boot-tests))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :org-agent-boot-tests))
|
||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :object-store-suite :org-agent-object-store-tests))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :memory-suite :org-agent-memory-tests))
|
||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :org-agent-immune-system-tests))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :org-agent-immune-system-tests))
|
||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :task-orchestrator-suite :org-agent-task-orchestrator-tests))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :task-orchestrator-suite :org-agent-task-orchestrator-tests))
|
||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :self-fix-suite :org-agent-self-fix-tests))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :self-fix-suite :org-agent-self-fix-tests))
|
||||||
|
|||||||
@@ -53,7 +53,7 @@ Interfaces for conversational event handling and UI integration. Source of truth
|
|||||||
(in-package :org-agent)
|
(in-package :org-agent)
|
||||||
|
|
||||||
(defun chat-archive-message (text &key (role :user) channel chat-id)
|
(defun chat-archive-message (text &key (role :user) channel chat-id)
|
||||||
"Archives a chat message into the persistent Object Store and triggers a snapshot."
|
"Archives a chat message into the persistent Memory and triggers a snapshot."
|
||||||
(let* ((msg-id (org-id-new))
|
(let* ((msg-id (org-id-new))
|
||||||
(obj (make-org-object
|
(obj (make-org-object
|
||||||
:id msg-id
|
:id msg-id
|
||||||
@@ -61,9 +61,9 @@ Interfaces for conversational event handling and UI integration. Source of truth
|
|||||||
:attributes `(:role ,role :channel ,channel :chat-id ,chat-id :timestamp ,(get-universal-time))
|
:attributes `(:role ,role :channel ,channel :chat-id ,chat-id :timestamp ,(get-universal-time))
|
||||||
:content text
|
:content text
|
||||||
:version (get-universal-time))))
|
:version (get-universal-time))))
|
||||||
(setf (gethash msg-id *object-store*) obj)
|
(setf (gethash msg-id *memory*) obj)
|
||||||
(harness-log "CHAT - Message archived: ~a (~a)" msg-id role)
|
(harness-log "CHAT - Message archived: ~a (~a)" msg-id role)
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
msg-id))
|
msg-id))
|
||||||
|
|
||||||
(defun trigger-skill-chat (context)
|
(defun trigger-skill-chat (context)
|
||||||
|
|||||||
@@ -22,7 +22,7 @@ Securely manage all authentication tokens required for the PSF to operate.
|
|||||||
- *Unified Storage:* Single interface for API keys and Session Cookies.
|
- *Unified Storage:* Single interface for API keys and Session Cookies.
|
||||||
- *Masked Logging:* Ensure credentials never appear in plaintext in `harness-log`.
|
- *Masked Logging:* Ensure credentials never appear in plaintext in `harness-log`.
|
||||||
- *Guided Onboarding:* Retain and improve the Google/Gemini cookie handshake.
|
- *Guided Onboarding:* Retain and improve the Google/Gemini cookie handshake.
|
||||||
- *Persistence:* Securely save credentials to the Object Store via Merkle-Tree snapshots.
|
- *Persistence:* Securely save credentials to the Memory via Merkle-Tree snapshots.
|
||||||
|
|
||||||
* Phase B: Blueprint (PROTOCOL)
|
* Phase B: Blueprint (PROTOCOL)
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
@@ -30,7 +30,7 @@ Securely manage all authentication tokens required for the PSF to operate.
|
|||||||
:END:
|
:END:
|
||||||
|
|
||||||
** 1. Architectural Intent
|
** 1. Architectural Intent
|
||||||
The vault provides a secure lookup table in RAM, backed by the persistent Object Store. Access is restricted to internal kernel requests and explicitly authorized deterministic gates.
|
The vault provides a secure lookup table in RAM, backed by the persistent Memory. Access is restricted to internal kernel requests and explicitly authorized deterministic gates.
|
||||||
|
|
||||||
** 2. Semantic Interfaces
|
** 2. Semantic Interfaces
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
@@ -48,7 +48,7 @@ The vault provides a secure lookup table in RAM, backed by the persistent Object
|
|||||||
|
|
||||||
** 1. Success Criteria
|
** 1. Success Criteria
|
||||||
- [ ] *No Plaintext Leaks:* Log output must use `[REDACTED]` for sensitive values.
|
- [ ] *No Plaintext Leaks:* Log output must use `[REDACTED]` for sensitive values.
|
||||||
- [ ] *Merkle Integration:* Setting a secret must increment the Object Store version.
|
- [ ] *Merkle Integration:* Setting a secret must increment the Memory version.
|
||||||
- [ ] *Dual-Path Auth:* Support both `:api-key` and `:session-cookies`.
|
- [ ] *Dual-Path Auth:* Support both `:api-key` and `:session-cookies`.
|
||||||
- [ ] *Onboarding Verification:* The cookie handshake successfully hydrates the vault.
|
- [ ] *Onboarding Verification:* The cookie handshake successfully hydrates the vault.
|
||||||
|
|
||||||
@@ -56,7 +56,7 @@ The vault provides a secure lookup table in RAM, backed by the persistent Object
|
|||||||
Tests in `tests/vault-tests.lisp` will verify:
|
Tests in `tests/vault-tests.lisp` will verify:
|
||||||
1. Retrieval of keys from both `.env` (fallback) and Vault (primary).
|
1. Retrieval of keys from both `.env` (fallback) and Vault (primary).
|
||||||
2. Redaction of keys in log strings.
|
2. Redaction of keys in log strings.
|
||||||
3. Successful version increment in the Object Store after `vault-set-secret`.
|
3. Successful version increment in the Memory after `vault-set-secret`.
|
||||||
|
|
||||||
* Phase D: Build (Implementation)
|
* Phase D: Build (Implementation)
|
||||||
|
|
||||||
@@ -66,7 +66,7 @@ Tests in `tests/vault-tests.lisp` will verify:
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Vault State
|
** Vault State
|
||||||
We maintain an in-memory hash table for secrets, which is hydrated from and persisted to the Object Store.
|
We maintain an in-memory hash table for secrets, which is hydrated from and persisted to the Memory.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/credentials-vault.lisp
|
#+begin_src lisp :tangle ../src/credentials-vault.lisp
|
||||||
(defvar *vault-memory* (make-hash-table :test 'equal)
|
(defvar *vault-memory* (make-hash-table :test 'equal)
|
||||||
@@ -85,7 +85,7 @@ The `vault-mask-string` function ensures that diagnostic output never contains t
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Retrieval (vault-get-secret)
|
** Retrieval (vault-get-secret)
|
||||||
This function is the secure getter for all system secrets. It prioritizes the Vault (Object Store) and falls back to environment variables for legacy compatibility.
|
This function is the secure getter for all system secrets. It prioritizes the Vault (Memory) and falls back to environment variables for legacy compatibility.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/credentials-vault.lisp
|
#+begin_src lisp :tangle ../src/credentials-vault.lisp
|
||||||
(defun vault-get-secret (provider &key (type :api-key))
|
(defun vault-get-secret (provider &key (type :api-key))
|
||||||
@@ -111,7 +111,7 @@ This function is the secure getter for all system secrets. It prioritizes the Va
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Persistence (vault-set-secret)
|
** Persistence (vault-set-secret)
|
||||||
When a secret is updated, we immediately snapshot the Object Store to ensure the credential change is versioned and durable.
|
When a secret is updated, we immediately snapshot the Memory to ensure the credential change is versioned and durable.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/credentials-vault.lisp
|
#+begin_src lisp :tangle ../src/credentials-vault.lisp
|
||||||
(defun vault-set-secret (provider secret &key (type :api-key))
|
(defun vault-set-secret (provider secret &key (type :api-key))
|
||||||
@@ -119,7 +119,7 @@ When a secret is updated, we immediately snapshot the Object Store to ensure the
|
|||||||
(let ((key (format nil "~a-~a" provider type)))
|
(let ((key (format nil "~a-~a" provider type)))
|
||||||
(setf (gethash key *vault-memory*) secret)
|
(setf (gethash key *vault-memory*) secret)
|
||||||
(harness-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
|
(harness-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
t))
|
t))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@@ -166,14 +166,14 @@ Retained from the legacy Google skill, this provides the instructions for the so
|
|||||||
|
|
||||||
(test test-vault-persistence
|
(test test-vault-persistence
|
||||||
"Verify that setting a secret triggers a snapshot (mock check)."
|
"Verify that setting a secret triggers a snapshot (mock check)."
|
||||||
(let ((old-version (org-agent::org-object-version (gethash "root" *object-store*))))
|
(let ((old-version (org-agent::org-object-version (gethash "root" *memory*))))
|
||||||
(org-agent:vault-set-secret :test "secret-val")
|
(org-agent:vault-set-secret :test "secret-val")
|
||||||
(is (> (org-agent::org-object-version (gethash "root" *object-store*)) old-version))))
|
(is (> (org-agent::org-object-version (gethash "root" *memory*)) old-version))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** 2. Chaos Scenarios
|
** 2. Chaos Scenarios
|
||||||
- *Scenario A (Vault Poisoning):* Inject a malformed session string and verify the `llm-gateway` detects the invalid format and returns a standardized error instead of crashing.
|
- *Scenario A (Vault Poisoning):* Inject a malformed session string and verify the `llm-gateway` detects the invalid format and returns a standardized error instead of crashing.
|
||||||
- *Scenario B (Memory Wipe):* Clear `*vault-memory*` during runtime and verify the vault successfully re-hydrates from the Object Store (or environment fallback).
|
- *Scenario B (Memory Wipe):* Clear `*vault-memory*` during runtime and verify the vault successfully re-hydrates from the Memory (or environment fallback).
|
||||||
|
|
||||||
* Phase F: Memory (RCA)
|
* Phase F: Memory (RCA)
|
||||||
- *[2026-04-09 Thu]:* Consolidated `auth-api-key` and `auth-google-oauth` into this vault. Introduced mandatory masking for all credential-related logging.
|
- *[2026-04-09 Thu]:* Consolidated `auth-api-key` and `auth-google-oauth` into this vault. Introduced mandatory masking for all credential-related logging.
|
||||||
|
|||||||
@@ -19,7 +19,7 @@ Provide a standardized interface for converting text into vector representations
|
|||||||
|
|
||||||
** 2. User Needs
|
** 2. User Needs
|
||||||
- *Text Vectorization:* Convert Org-mode content into high-dimensional vectors.
|
- *Text Vectorization:* Convert Org-mode content into high-dimensional vectors.
|
||||||
- *Similarity Search:* Find semantically related nodes in the Object Store.
|
- *Similarity Search:* Find semantically related nodes in the Memory.
|
||||||
- *Provider Agnosticism:* Support multiple embedding models (Gemini, OpenAI, etc.).
|
- *Provider Agnosticism:* Support multiple embedding models (Gemini, OpenAI, etc.).
|
||||||
|
|
||||||
** 3. Success Criteria
|
** 3. Success Criteria
|
||||||
@@ -98,7 +98,7 @@ Move heavy neural and mathematical logic out of `core.lisp` and `probabilistic.l
|
|||||||
(let ((vec (org-object-vector obj)))
|
(let ((vec (org-object-vector obj)))
|
||||||
(when vec
|
(when vec
|
||||||
(push (cons (cosine-similarity query-vector vec) obj) similarities))))
|
(push (cons (cosine-similarity query-vector vec) obj) similarities))))
|
||||||
*object-store*)
|
*memory*)
|
||||||
(let ((sorted (sort similarities #'> :key #'car)))
|
(let ((sorted (sort similarities #'> :key #'car)))
|
||||||
(subseq sorted 0 (min top-k (length sorted))))))
|
(subseq sorted 0 (min top-k (length sorted))))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -8,7 +8,7 @@
|
|||||||
#+FILETAGS: :system:config:sovereignty:psf:
|
#+FILETAGS: :system:config:sovereignty:psf:
|
||||||
|
|
||||||
* Overview
|
* Overview
|
||||||
The *Environment Configuration Manager* is the source of truth for user preferences. It persists settings (like LLM Model Fleets) into the harness's Object Store, allowing for dynamic runtime reconfiguration without environment variable bloat.
|
The *Environment Configuration Manager* is the source of truth for user preferences. It persists settings (like LLM Model Fleets) into the harness's Memory, allowing for dynamic runtime reconfiguration without environment variable bloat.
|
||||||
|
|
||||||
* Phase A: Demand (PRD)
|
* Phase A: Demand (PRD)
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
@@ -20,7 +20,7 @@ Provide a programmatic and literate interface for managing system-wide settings.
|
|||||||
|
|
||||||
** 2. User Needs
|
** 2. User Needs
|
||||||
- *Fleet Management:* Define preferred models for each LLM provider.
|
- *Fleet Management:* Define preferred models for each LLM provider.
|
||||||
- *Persistence:* Ensure settings survive kernel restarts via the Object Store.
|
- *Persistence:* Ensure settings survive kernel restarts via the Memory.
|
||||||
- *Transparency:* Allow the user to audit current settings via the REPL or Org tables.
|
- *Transparency:* Allow the user to audit current settings via the REPL or Org tables.
|
||||||
|
|
||||||
* Phase B: Blueprint (PROTOCOL)
|
* Phase B: Blueprint (PROTOCOL)
|
||||||
@@ -29,7 +29,7 @@ Provide a programmatic and literate interface for managing system-wide settings.
|
|||||||
:END:
|
:END:
|
||||||
|
|
||||||
** 1. Architectural Intent
|
** 1. Architectural Intent
|
||||||
Define a standardized `CONFIG` object type in the Object Store. Provide getter/setter functions for the "LLM Fleet."
|
Define a standardized `CONFIG` object type in the Memory. Provide getter/setter functions for the "LLM Fleet."
|
||||||
|
|
||||||
** 2. Semantic Interfaces
|
** 2. Semantic Interfaces
|
||||||
|
|
||||||
@@ -38,7 +38,7 @@ Define a standardized `CONFIG` object type in the Object Store. Provide getter/s
|
|||||||
(in-package :org-agent)
|
(in-package :org-agent)
|
||||||
|
|
||||||
(defun set-llm-model (provider model-id)
|
(defun set-llm-model (provider model-id)
|
||||||
"Registers a preferred model for a provider in the Object Store."
|
"Registers a preferred model for a provider in the Memory."
|
||||||
(let ((config-id (format nil "config-llm-~a" (string-downcase (string provider)))))
|
(let ((config-id (format nil "config-llm-~a" (string-downcase (string provider)))))
|
||||||
(let ((obj (make-org-object
|
(let ((obj (make-org-object
|
||||||
:id config-id
|
:id config-id
|
||||||
@@ -46,14 +46,14 @@ Define a standardized `CONFIG` object type in the Object Store. Provide getter/s
|
|||||||
:attributes `(:provider ,provider :model-id ,model-id)
|
:attributes `(:provider ,provider :model-id ,model-id)
|
||||||
:content (format nil "Fleet preference for ~a set to ~a" provider model-id)
|
:content (format nil "Fleet preference for ~a set to ~a" provider model-id)
|
||||||
:version (get-universal-time))))
|
:version (get-universal-time))))
|
||||||
(setf (gethash config-id *object-store*) obj)
|
(setf (gethash config-id *memory*) obj)
|
||||||
(harness-log "CONFIG - Fleet updated: ~a -> ~a" provider model-id)
|
(harness-log "CONFIG - Fleet updated: ~a -> ~a" provider model-id)
|
||||||
t)))
|
t)))
|
||||||
|
|
||||||
(defun get-llm-model (provider &optional default)
|
(defun get-llm-model (provider &optional default)
|
||||||
"Retrieves the preferred model for a provider from the Object Store."
|
"Retrieves the preferred model for a provider from the Memory."
|
||||||
(let* ((config-id (format nil "config-llm-~a" (string-downcase (string provider))))
|
(let* ((config-id (format nil "config-llm-~a" (string-downcase (string provider))))
|
||||||
(obj (gethash config-id *object-store*)))
|
(obj (gethash config-id *memory*)))
|
||||||
(if obj
|
(if obj
|
||||||
(getf (org-object-attributes obj) :model-id)
|
(getf (org-object-attributes obj) :model-id)
|
||||||
default)))
|
default)))
|
||||||
|
|||||||
@@ -27,7 +27,7 @@ Provide a unified, high-integrity interface for background automation and stimul
|
|||||||
- *Predictable Scheduling:* Precise execution of tasks based on cron-strings or intervals.
|
- *Predictable Scheduling:* Precise execution of tasks based on cron-strings or intervals.
|
||||||
- *Reactive Extensions:* Ability to "hook" into system events (save, boot, ingest).
|
- *Reactive Extensions:* Ability to "hook" into system events (save, boot, ingest).
|
||||||
- *Intelligent Dispatch:* Automated complexity tiering to prevent wasted compute.
|
- *Intelligent Dispatch:* Automated complexity tiering to prevent wasted compute.
|
||||||
- *Durable Registry:* All registered hooks and cron-jobs must be persisted to the Object Store.
|
- *Durable Registry:* All registered hooks and cron-jobs must be persisted to the Memory.
|
||||||
|
|
||||||
* Phase B: Blueprint (PROTOCOL)
|
* Phase B: Blueprint (PROTOCOL)
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
@@ -57,7 +57,7 @@ The orchestrator maintains three internal registries (Hooks, Cron, Routing Rules
|
|||||||
** 1. Success Criteria
|
** 1. Success Criteria
|
||||||
- [ ] *Hook Latency:* Triggering a hook with 10 functions must complete in <1ms.
|
- [ ] *Hook Latency:* Triggering a hook with 10 functions must complete in <1ms.
|
||||||
- [ ] *Cron Precision:* Scheduled tasks must fire within 1s of their target window.
|
- [ ] *Cron Precision:* Scheduled tasks must fire within 1s of their target window.
|
||||||
- [ ] *Merkle Persistence:* Adding a hook or cron-job must increment the Object Store version.
|
- [ ] *Merkle Persistence:* Adding a hook or cron-job must increment the Memory version.
|
||||||
- [ ] *Classification Accuracy:* Routine system events must always be classified as `:REFLEX`.
|
- [ ] *Classification Accuracy:* Routine system events must always be classified as `:REFLEX`.
|
||||||
|
|
||||||
** 2. TDD Plan
|
** 2. TDD Plan
|
||||||
@@ -89,7 +89,7 @@ Allows external skills to register logic at system lifecycle points.
|
|||||||
"Registers a function for a named hook. Triggers a Merkle snapshot."
|
"Registers a function for a named hook. Triggers a Merkle snapshot."
|
||||||
(pushnew fn (gethash hook-name *hook-registry*))
|
(pushnew fn (gethash hook-name *hook-registry*))
|
||||||
(harness-log "ORCHESTRATOR - Registered hook function for ~a" hook-name)
|
(harness-log "ORCHESTRATOR - Registered hook function for ~a" hook-name)
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
t)
|
t)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@@ -113,7 +113,7 @@ Registers a recurring task to be executed during heartbeats.
|
|||||||
"Schedules a task for execution. Schedule can be an interval (integer seconds) or 'heartbeat'."
|
"Schedules a task for execution. Schedule can be an interval (integer seconds) or 'heartbeat'."
|
||||||
(setf (gethash task-id *cron-registry*) (list :schedule schedule :fn fn :last-run 0))
|
(setf (gethash task-id *cron-registry*) (list :schedule schedule :fn fn :last-run 0))
|
||||||
(harness-log "ORCHESTRATOR - Scheduled task ~a (~a)" task-id schedule)
|
(harness-log "ORCHESTRATOR - Scheduled task ~a (~a)" task-id schedule)
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
t)
|
t)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
|||||||
@@ -30,7 +30,7 @@ Unify the structural rules and programmatic manipulation of the Org-mode AST.
|
|||||||
:END:
|
:END:
|
||||||
|
|
||||||
** 1. Architectural Intent
|
** 1. Architectural Intent
|
||||||
The memory suite uses a "Functional Core" for AST manipulation. Every transformation (normalization, refactoring) returns a new AST version, which is then persisted to the Object Store.
|
The memory suite uses a "Functional Core" for AST manipulation. Every transformation (normalization, refactoring) returns a new AST version, which is then persisted to the Memory.
|
||||||
|
|
||||||
** 2. Semantic Interfaces
|
** 2. Semantic Interfaces
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
@@ -52,7 +52,7 @@ The memory suite uses a "Functional Core" for AST manipulation. Every transforma
|
|||||||
** 1. Success Criteria
|
** 1. Success Criteria
|
||||||
- [ ] *Round-trip Fidelity:* Org -> JSON -> Org must result in identical text (modulo normalization).
|
- [ ] *Round-trip Fidelity:* Org -> JSON -> Org must result in identical text (modulo normalization).
|
||||||
- [ ] *ID Uniqueness:* No two headlines may share an ID after normalization.
|
- [ ] *ID Uniqueness:* No two headlines may share an ID after normalization.
|
||||||
- [ ] *Merkle Integration:* AST modifications must trigger Object Store snapshots.
|
- [ ] *Merkle Integration:* AST modifications must trigger Memory snapshots.
|
||||||
|
|
||||||
** 2. TDD Plan
|
** 2. TDD Plan
|
||||||
Tests in `tests/memory-suite-tests.lisp` will verify the round-trip conversion and the recursive ID injection logic.
|
Tests in `tests/memory-suite-tests.lisp` will verify the round-trip conversion and the recursive ID injection logic.
|
||||||
|
|||||||
@@ -54,8 +54,8 @@ Define a high-integrity, recursive security sandbox for Lisp execution.
|
|||||||
format concatenate string-downcase string-upcase search
|
format concatenate string-downcase string-upcase search
|
||||||
;; Kernel specifics
|
;; Kernel specifics
|
||||||
org-agent::harness-log
|
org-agent::harness-log
|
||||||
org-agent::snapshot-object-store
|
org-agent::snapshot-memory
|
||||||
org-agent::rollback-object-store
|
org-agent::rollback-memory
|
||||||
org-agent::lookup-object
|
org-agent::lookup-object
|
||||||
org-agent::list-objects-by-type
|
org-agent::list-objects-by-type
|
||||||
org-agent::ingest-ast
|
org-agent::ingest-ast
|
||||||
|
|||||||
@@ -7,7 +7,7 @@
|
|||||||
#+FILETAGS: :context:foveal:peripheral:pruning:psf:
|
#+FILETAGS: :context:foveal:peripheral:pruning:psf:
|
||||||
|
|
||||||
* Overview
|
* Overview
|
||||||
The *Peripheral Vision* skill implements the Foveal-Peripheral Hybrid model for context pruning. It ensures that the LLM receives a semantically relevant and manageable view of the Object Store, preventing context window overflow.
|
The *Peripheral Vision* skill implements the Foveal-Peripheral Hybrid model for context pruning. It ensures that the LLM receives a semantically relevant and manageable view of the Memory, preventing context window overflow.
|
||||||
|
|
||||||
* Phase A: Demand (PRD)
|
* Phase A: Demand (PRD)
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
@@ -95,7 +95,7 @@ Move context pruning and rendering logic out of `context.lisp` to allow for more
|
|||||||
output))
|
output))
|
||||||
|
|
||||||
(defun context-assemble-global-awareness (&optional signal)
|
(defun context-assemble-global-awareness (&optional signal)
|
||||||
"Produces a high-level skeletal outline of the current Object Store for the LLM."
|
"Produces a high-level skeletal outline of the current Memory for the LLM."
|
||||||
(let* ((payload (when signal (getf signal :payload)))
|
(let* ((payload (when signal (getf signal :payload)))
|
||||||
(foveal-id (when payload (getf payload :target-id)))
|
(foveal-id (when payload (getf payload :target-id)))
|
||||||
(foveal-vector (when foveal-id (org-object-vector (lookup-object foveal-id))))
|
(foveal-vector (when foveal-id (org-object-vector (lookup-object foveal-id))))
|
||||||
|
|||||||
@@ -10,7 +10,7 @@
|
|||||||
#+DEPENDS_ON: id:98576df2-c496-4e4a-9acb-0bca514a0305
|
#+DEPENDS_ON: id:98576df2-c496-4e4a-9acb-0bca514a0305
|
||||||
|
|
||||||
* Overview
|
* Overview
|
||||||
The *Self-Fix Agent* is the system's "Repair Mechanism." It takes failure hypotheses, applies surgical code modifications, and verifies them using the Object Store's rollback capabilities.
|
The *Self-Fix Agent* is the system's "Repair Mechanism." It takes failure hypotheses, applies surgical code modifications, and verifies them using the Memory's rollback capabilities.
|
||||||
|
|
||||||
* Phase D: Build (Implementation)
|
* Phase D: Build (Implementation)
|
||||||
|
|
||||||
@@ -28,7 +28,7 @@ The *Self-Fix Agent* is the system's "Repair Mechanism." It takes failure hypoth
|
|||||||
(is-skill (and (stringp (namestring target-file))
|
(is-skill (and (stringp (namestring target-file))
|
||||||
(search "skills/" (namestring target-file)))))
|
(search "skills/" (namestring target-file)))))
|
||||||
|
|
||||||
(org-agent:snapshot-object-store)
|
(org-agent:snapshot-memory)
|
||||||
(org-agent:harness-log "SELF-FIX - Attempting surgical fix on ~a..." target-file)
|
(org-agent:harness-log "SELF-FIX - Attempting surgical fix on ~a..." target-file)
|
||||||
|
|
||||||
(handler-case
|
(handler-case
|
||||||
@@ -50,7 +50,7 @@ The *Self-Fix Agent* is the system's "Repair Mechanism." It takes failure hypoth
|
|||||||
(org-agent:harness-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.")
|
(org-agent:harness-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.")
|
||||||
(with-open-file (out target-file :direction :output :if-exists :supersede)
|
(with-open-file (out target-file :direction :output :if-exists :supersede)
|
||||||
(write-string content out))
|
(write-string content out))
|
||||||
(org-agent:rollback-object-store 0)
|
(org-agent:rollback-memory 0)
|
||||||
nil)))
|
nil)))
|
||||||
(progn
|
(progn
|
||||||
(org-agent:harness-log "SELF-FIX SUCCESS - Applied fix to file.")
|
(org-agent:harness-log "SELF-FIX SUCCESS - Applied fix to file.")
|
||||||
@@ -59,7 +59,7 @@ The *Self-Fix Agent* is the system's "Repair Mechanism." It takes failure hypoth
|
|||||||
(progn (org-agent:harness-log "SELF-FIX FAILURE - File not found.") nil))
|
(progn (org-agent:harness-log "SELF-FIX FAILURE - File not found.") nil))
|
||||||
(error (c)
|
(error (c)
|
||||||
(org-agent:harness-log "SELF-FIX CRASH - ~a. Rolling back." c)
|
(org-agent:harness-log "SELF-FIX CRASH - ~a. Rolling back." c)
|
||||||
(org-agent:rollback-object-store 0)
|
(org-agent:rollback-memory 0)
|
||||||
nil))))
|
nil))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
|||||||
@@ -12,7 +12,7 @@ The *State Persistence Layer* ensures the durability and sovereignty of the agen
|
|||||||
** Deep Reasoning: Protection Against External Tampering
|
** Deep Reasoning: Protection Against External Tampering
|
||||||
While the *Prover* and *Bouncer* protect against internal skill failures, the Merkle-Tree architecture within the State Layer protects against **External Threats** (e.g., a hacker or virus modifying your `.org` files directly on disk).
|
While the *Prover* and *Bouncer* protect against internal skill failures, the Merkle-Tree architecture within the State Layer protects against **External Threats** (e.g., a hacker or virus modifying your `.org` files directly on disk).
|
||||||
|
|
||||||
1. **Skill Hashing:** Every code block and headline in a skill file has a unique Merkle hash recorded in the Object Store.
|
1. **Skill Hashing:** Every code block and headline in a skill file has a unique Merkle hash recorded in the Memory.
|
||||||
2. **Integrity Verification:** Upon loading or reloading a skill, the harness re-calculates the hash and compares it against the "known good" state in the Merkle Tree.
|
2. **Integrity Verification:** Upon loading or reloading a skill, the harness re-calculates the hash and compares it against the "known good" state in the Merkle Tree.
|
||||||
3. **Automatic Lockdown:** If a file has been tampered with externally, the hash mismatch triggers an immediate lockdown. the harness refuses to execute the skill and alerts the Sovereign via Signal/Telegram.
|
3. **Automatic Lockdown:** If a file has been tampered with externally, the hash mismatch triggers an immediate lockdown. the harness refuses to execute the skill and alerts the Sovereign via Signal/Telegram.
|
||||||
|
|
||||||
@@ -25,7 +25,7 @@ While the *Prover* and *Bouncer* protect against internal skill failures, the Me
|
|||||||
Define automated behaviors for knowledge graph serialization, local persistence, and decentralized archival.
|
Define automated behaviors for knowledge graph serialization, local persistence, and decentralized archival.
|
||||||
|
|
||||||
** 2. User Needs
|
** 2. User Needs
|
||||||
- *Instant Recall:* Rapid local loading of the Object Store from a persistent image.
|
- *Instant Recall:* Rapid local loading of the Memory from a persistent image.
|
||||||
- *Decentralized Archival:* Pushing immutable snapshots to IPFS for cross-node sync and sovereignty.
|
- *Decentralized Archival:* Pushing immutable snapshots to IPFS for cross-node sync and sovereignty.
|
||||||
- *Merkle Integrity:* Every save operation must respect and record the Merkle-Tree history.
|
- *Merkle Integrity:* Every save operation must respect and record the Merkle-Tree history.
|
||||||
- *Safety:* Sanitize and validate data during restoration to prevent code injection.
|
- *Safety:* Sanitize and validate data during restoration to prevent code injection.
|
||||||
@@ -36,7 +36,7 @@ Define automated behaviors for knowledge graph serialization, local persistence,
|
|||||||
:END:
|
:END:
|
||||||
|
|
||||||
** 1. Architectural Intent
|
** 1. Architectural Intent
|
||||||
The persistence layer acts as a bridge between the volatile RAM-resident Object Store and permanent storage backends. It provides two adapters: `LOCAL` (fast, SBCL-native) and `IPFS` (sovereign, content-addressed).
|
The persistence layer acts as a bridge between the volatile RAM-resident Memory and permanent storage backends. It provides two adapters: `LOCAL` (fast, SBCL-native) and `IPFS` (sovereign, content-addressed).
|
||||||
|
|
||||||
** 2. Semantic Interfaces
|
** 2. Semantic Interfaces
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
@@ -57,7 +57,7 @@ The persistence layer acts as a bridge between the volatile RAM-resident Object
|
|||||||
|
|
||||||
** 1. Success Criteria
|
** 1. Success Criteria
|
||||||
- [ ] *Speed:* Local image load must be <500ms for a 10k node graph.
|
- [ ] *Speed:* Local image load must be <500ms for a 10k node graph.
|
||||||
- [ ] *Fidelity:* IPFS round-trip must result in a bit-identical Object Store.
|
- [ ] *Fidelity:* IPFS round-trip must result in a bit-identical Memory.
|
||||||
- [ ] *Validation:* Restoration must block any `read-eval` reader macros in content.
|
- [ ] *Validation:* Restoration must block any `read-eval` reader macros in content.
|
||||||
|
|
||||||
** 2. TDD Plan
|
** 2. TDD Plan
|
||||||
@@ -97,8 +97,8 @@ Serializes the Merkle history and current pointers to a Lisp file.
|
|||||||
*history-store*)
|
*history-store*)
|
||||||
;; 2. Dump the current active pointers
|
;; 2. Dump the current active pointers
|
||||||
(maphash (lambda (id obj)
|
(maphash (lambda (id obj)
|
||||||
(print `(setf (gethash ,id *object-store*) (gethash ,(org-object-hash obj) *history-store*)) out))
|
(print `(setf (gethash ,id *memory*) (gethash ,(org-object-hash obj) *history-store*)) out))
|
||||||
*object-store*))
|
*memory*))
|
||||||
t))
|
t))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@@ -120,7 +120,7 @@ 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 `*object-store*` into a JSON-compatible list of alists.
|
Converts the live `*memory*` into a JSON-compatible list of alists.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/state-persistence.lisp
|
#+begin_src lisp :tangle ../src/state-persistence.lisp
|
||||||
(defun persistence-serialize-for-archival ()
|
(defun persistence-serialize-for-archival ()
|
||||||
@@ -139,7 +139,7 @@ Converts the live `*object-store*` into a JSON-compatible list of alists.
|
|||||||
(: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))
|
||||||
*object-store*)
|
*memory*)
|
||||||
objects))
|
objects))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@@ -175,7 +175,7 @@ Restores the graph from IPFS, using a safe parser to prevent injection.
|
|||||||
(handler-case
|
(handler-case
|
||||||
(let* ((response (dex:post ipfs-url))
|
(let* ((response (dex:post ipfs-url))
|
||||||
(data (cl-json:decode-json-from-string response)))
|
(data (cl-json:decode-json-from-string response)))
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(dolist (item data)
|
(dolist (item data)
|
||||||
(let* ((id (cdr (assoc :id item)))
|
(let* ((id (cdr (assoc :id item)))
|
||||||
(obj (make-org-object
|
(obj (make-org-object
|
||||||
@@ -189,7 +189,7 @@ Restores the graph from IPFS, using a safe parser to prevent injection.
|
|||||||
:version (cdr (assoc :version item))
|
:version (cdr (assoc :version item))
|
||||||
:last-sync (cdr (assoc :last-sync item))
|
:last-sync (cdr (assoc :last-sync item))
|
||||||
:hash (cdr (assoc :hash item)))))
|
:hash (cdr (assoc :hash item)))))
|
||||||
(setf (gethash id *object-store*) obj)))
|
(setf (gethash id *memory*) obj)))
|
||||||
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
|
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
|
||||||
t)
|
t)
|
||||||
(error (c)
|
(error (c)
|
||||||
@@ -246,11 +246,11 @@ 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 *object-store*) (make-org-object :id test-id :content "Integrity Check"))
|
(setf (gethash test-id *memory*) (make-org-object :id test-id :content "Integrity Check"))
|
||||||
(org-agent:persistence-dump-local)
|
(org-agent:persistence-dump-local)
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(org-agent:persistence-load-local)
|
(org-agent:persistence-load-local)
|
||||||
(is (equal "Integrity Check" (org-object-content (gethash test-id *object-store*))))))
|
(is (equal "Integrity Check" (org-object-content (gethash test-id *memory*))))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** 2. Chaos Scenarios
|
** 2. Chaos Scenarios
|
||||||
|
|||||||
@@ -19,7 +19,7 @@
|
|||||||
(mode (or (getf payload :mode) :random))
|
(mode (or (getf payload :mode) :random))
|
||||||
(intensity (or (getf payload :intensity) 3)))
|
(intensity (or (getf payload :intensity) 3)))
|
||||||
(harness-log "CHAOS - Commencing stress test (Mode: ~a, Intensity: ~a)" mode intensity)
|
(harness-log "CHAOS - Commencing stress test (Mode: ~a, Intensity: ~a)" mode intensity)
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
(case mode
|
(case mode
|
||||||
(:random (dotimes (i intensity)
|
(:random (dotimes (i intensity)
|
||||||
(let ((failure-type (nth (random 3) '(:test-failure :shell-timeout :llm-error))))
|
(let ((failure-type (nth (random 3) '(:test-failure :shell-timeout :llm-error))))
|
||||||
@@ -27,7 +27,7 @@
|
|||||||
`(:type :EVENT :payload (:sensor :chaos-injection :type ,failure-type))))))
|
`(:type :EVENT :payload (:sensor :chaos-injection :type ,failure-type))))))
|
||||||
(:shell (inject-stimulus
|
(:shell (inject-stimulus
|
||||||
`(:type :EVENT :payload (:sensor :shell-response :cmd "git push" :exit-code 128 :stderr "fatal: network unreachable")))))
|
`(:type :EVENT :payload (:sensor :shell-response :cmd "git push" :exit-code 128 :stderr "fatal: network unreachable")))))
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
(format nil "SUCCESS - Chaos stress test initiated.")))
|
(format nil "SUCCESS - Chaos stress test initiated.")))
|
||||||
|
|
||||||
(defun chaos-enable ()
|
(defun chaos-enable ()
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
(in-package :org-agent)
|
(in-package :org-agent)
|
||||||
|
|
||||||
(defun chat-archive-message (text &key (role :user) channel chat-id)
|
(defun chat-archive-message (text &key (role :user) channel chat-id)
|
||||||
"Archives a chat message into the persistent Object Store and triggers a snapshot."
|
"Archives a chat message into the persistent Memory and triggers a snapshot."
|
||||||
(let* ((msg-id (org-id-new))
|
(let* ((msg-id (org-id-new))
|
||||||
(obj (make-org-object
|
(obj (make-org-object
|
||||||
:id msg-id
|
:id msg-id
|
||||||
@@ -9,9 +9,9 @@
|
|||||||
:attributes `(:role ,role :channel ,channel :chat-id ,chat-id :timestamp ,(get-universal-time))
|
:attributes `(:role ,role :channel ,channel :chat-id ,chat-id :timestamp ,(get-universal-time))
|
||||||
:content text
|
:content text
|
||||||
:version (get-universal-time))))
|
:version (get-universal-time))))
|
||||||
(setf (gethash msg-id *object-store*) obj)
|
(setf (gethash msg-id *memory*) obj)
|
||||||
(harness-log "CHAT - Message archived: ~a (~a)" msg-id role)
|
(harness-log "CHAT - Message archived: ~a (~a)" msg-id role)
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
msg-id))
|
msg-id))
|
||||||
|
|
||||||
(defun trigger-skill-chat (context)
|
(defun trigger-skill-chat (context)
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
(in-package :org-agent)
|
(in-package :org-agent)
|
||||||
|
|
||||||
(defun set-llm-model (provider model-id)
|
(defun set-llm-model (provider model-id)
|
||||||
"Registers a preferred model for a provider in the Object Store."
|
"Registers a preferred model for a provider in the Memory."
|
||||||
(let ((config-id (format nil "config-llm-~a" (string-downcase (string provider)))))
|
(let ((config-id (format nil "config-llm-~a" (string-downcase (string provider)))))
|
||||||
(let ((obj (make-org-object
|
(let ((obj (make-org-object
|
||||||
:id config-id
|
:id config-id
|
||||||
@@ -9,14 +9,14 @@
|
|||||||
:attributes `(:provider ,provider :model-id ,model-id)
|
:attributes `(:provider ,provider :model-id ,model-id)
|
||||||
:content (format nil "Fleet preference for ~a set to ~a" provider model-id)
|
:content (format nil "Fleet preference for ~a set to ~a" provider model-id)
|
||||||
:version (get-universal-time))))
|
:version (get-universal-time))))
|
||||||
(setf (gethash config-id *object-store*) obj)
|
(setf (gethash config-id *memory*) obj)
|
||||||
(harness-log "CONFIG - Fleet updated: ~a -> ~a" provider model-id)
|
(harness-log "CONFIG - Fleet updated: ~a -> ~a" provider model-id)
|
||||||
t)))
|
t)))
|
||||||
|
|
||||||
(defun get-llm-model (provider &optional default)
|
(defun get-llm-model (provider &optional default)
|
||||||
"Retrieves the preferred model for a provider from the Object Store."
|
"Retrieves the preferred model for a provider from the Memory."
|
||||||
(let* ((config-id (format nil "config-llm-~a" (string-downcase (string provider))))
|
(let* ((config-id (format nil "config-llm-~a" (string-downcase (string provider))))
|
||||||
(obj (gethash config-id *object-store*)))
|
(obj (gethash config-id *memory*)))
|
||||||
(if obj
|
(if obj
|
||||||
(getf (org-object-attributes obj) :model-id)
|
(getf (org-object-attributes obj) :model-id)
|
||||||
default)))
|
default)))
|
||||||
|
|||||||
@@ -44,7 +44,7 @@
|
|||||||
output))
|
output))
|
||||||
|
|
||||||
(defun context-assemble-global-awareness (&optional signal)
|
(defun context-assemble-global-awareness (&optional signal)
|
||||||
"Produces a high-level skeletal outline of the current Object Store for the LLM."
|
"Produces a high-level skeletal outline of the current Memory for the LLM."
|
||||||
(let* ((payload (when signal (getf signal :payload)))
|
(let* ((payload (when signal (getf signal :payload)))
|
||||||
(foveal-id (when payload (getf payload :target-id)))
|
(foveal-id (when payload (getf payload :target-id)))
|
||||||
(foveal-vector (when foveal-id (org-object-vector (lookup-object foveal-id))))
|
(foveal-vector (when foveal-id (org-object-vector (lookup-object foveal-id))))
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
(in-package :org-agent)
|
(in-package :org-agent)
|
||||||
|
|
||||||
(defun context-query-store (&key tag todo-state type)
|
(defun context-query-store (&key tag todo-state type)
|
||||||
"Filters the Object Store based on tags, todo states, or types."
|
"Filters the Memory based on tags, todo states, or types."
|
||||||
(let ((results nil))
|
(let ((results nil))
|
||||||
(maphash (lambda (id obj)
|
(maphash (lambda (id obj)
|
||||||
(declare (ignore id))
|
(declare (ignore id))
|
||||||
@@ -10,7 +10,7 @@
|
|||||||
(when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
|
(when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
|
||||||
(when (and todo-state (not (equal state todo-state))) (setf match nil))
|
(when (and todo-state (not (equal state todo-state))) (setf match nil))
|
||||||
(when match (push obj results))))
|
(when match (push obj results))))
|
||||||
*object-store*)
|
*memory*)
|
||||||
results))
|
results))
|
||||||
|
|
||||||
(defun context-get-active-projects ()
|
(defun context-get-active-projects ()
|
||||||
@@ -102,7 +102,7 @@
|
|||||||
path-string))
|
path-string))
|
||||||
|
|
||||||
(defun context-assemble-global-awareness (&optional signal)
|
(defun context-assemble-global-awareness (&optional signal)
|
||||||
"Produces a high-level skeletal outline of the current Object Store for the LLM."
|
"Produces a high-level skeletal outline of the current Memory for the LLM."
|
||||||
(let* ((payload (when signal (getf signal :payload)))
|
(let* ((payload (when signal (getf signal :payload)))
|
||||||
(foveal-id (when payload (getf payload :target-id)))
|
(foveal-id (when payload (getf payload :target-id)))
|
||||||
(projects (context-get-active-projects))
|
(projects (context-get-active-projects))
|
||||||
|
|||||||
@@ -35,7 +35,7 @@
|
|||||||
(let ((key (format nil "~a-~a" provider type)))
|
(let ((key (format nil "~a-~a" provider type)))
|
||||||
(setf (gethash key *vault-memory*) secret)
|
(setf (gethash key *vault-memory*) secret)
|
||||||
(harness-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
|
(harness-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
t))
|
t))
|
||||||
|
|
||||||
(defun vault-onboard-gemini-web ()
|
(defun vault-onboard-gemini-web ()
|
||||||
|
|||||||
@@ -27,11 +27,11 @@
|
|||||||
current-action))
|
current-action))
|
||||||
|
|
||||||
(defun list-objects-with-attribute (attr-key attr-val)
|
(defun list-objects-with-attribute (attr-key attr-val)
|
||||||
"Filters the Object Store for nodes having a specific attribute value."
|
"Filters the Memory for nodes having a specific attribute value."
|
||||||
(let ((results nil))
|
(let ((results nil))
|
||||||
(maphash (lambda (id obj)
|
(maphash (lambda (id obj)
|
||||||
(declare (ignore id))
|
(declare (ignore id))
|
||||||
(when (equal (getf (org-object-attributes obj) attr-key) attr-val)
|
(when (equal (getf (org-object-attributes obj) attr-key) attr-val)
|
||||||
(push obj results)))
|
(push obj results)))
|
||||||
*object-store*)
|
*memory*)
|
||||||
results))
|
results))
|
||||||
|
|||||||
@@ -44,7 +44,7 @@
|
|||||||
(let ((vec (org-object-vector obj)))
|
(let ((vec (org-object-vector obj)))
|
||||||
(when vec
|
(when vec
|
||||||
(push (cons (cosine-similarity query-vector vec) obj) similarities))))
|
(push (cons (cosine-similarity query-vector vec) obj) similarities))))
|
||||||
*object-store*)
|
*memory*)
|
||||||
(let ((sorted (sort similarities #'> :key #'car)))
|
(let ((sorted (sort similarities #'> :key #'car)))
|
||||||
(subseq sorted 0 (min top-k (length sorted))))))
|
(subseq sorted 0 (min top-k (length sorted))))))
|
||||||
|
|
||||||
|
|||||||
@@ -27,5 +27,5 @@
|
|||||||
(defun find-most-similar (query-vector top-k)
|
(defun find-most-similar (query-vector top-k)
|
||||||
"Identifies the top-k most semantically related objects in the store."
|
"Identifies the top-k most semantically related objects in the store."
|
||||||
(let ((similarities nil))
|
(let ((similarities nil))
|
||||||
(maphash (lambda (id obj) (let ((vec (org-object-vector obj))) (when vec (push (cons (cosine-similarity query-vector vec) obj) similarities)))) *object-store*)
|
(maphash (lambda (id obj) (let ((vec (org-object-vector obj))) (when vec (push (cons (cosine-similarity query-vector vec) obj) similarities)))) *memory*)
|
||||||
(let ((sorted (sort similarities #'> :key #'car))) (subseq sorted 0 (min top-k (length sorted))))))
|
(let ((sorted (sort similarities #'> :key #'car))) (subseq sorted 0 (min top-k (length sorted))))))
|
||||||
|
|||||||
@@ -10,7 +10,7 @@
|
|||||||
"Registers a function for a named hook. Triggers a Merkle snapshot."
|
"Registers a function for a named hook. Triggers a Merkle snapshot."
|
||||||
(pushnew fn (gethash hook-name *hook-registry*))
|
(pushnew fn (gethash hook-name *hook-registry*))
|
||||||
(harness-log "ORCHESTRATOR - Registered hook function for ~a" hook-name)
|
(harness-log "ORCHESTRATOR - Registered hook function for ~a" hook-name)
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
t)
|
t)
|
||||||
|
|
||||||
(defun orchestrator-trigger-hook (hook-name &rest args)
|
(defun orchestrator-trigger-hook (hook-name &rest args)
|
||||||
@@ -24,7 +24,7 @@
|
|||||||
"Schedules a task for execution. Schedule can be an interval (integer seconds) or 'heartbeat'."
|
"Schedules a task for execution. Schedule can be an interval (integer seconds) or 'heartbeat'."
|
||||||
(setf (gethash task-id *cron-registry*) (list :schedule schedule :fn fn :last-run 0))
|
(setf (gethash task-id *cron-registry*) (list :schedule schedule :fn fn :last-run 0))
|
||||||
(harness-log "ORCHESTRATOR - Scheduled task ~a (~a)" task-id schedule)
|
(harness-log "ORCHESTRATOR - Scheduled task ~a (~a)" task-id schedule)
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
t)
|
t)
|
||||||
|
|
||||||
(defun orchestrator-process-cron ()
|
(defun orchestrator-process-cron ()
|
||||||
|
|||||||
@@ -7,12 +7,12 @@
|
|||||||
"Returns COUNT random objects from the object-store."
|
"Returns COUNT random objects from the object-store."
|
||||||
(let ((keys nil)
|
(let ((keys nil)
|
||||||
(selected nil))
|
(selected nil))
|
||||||
(maphash (lambda (k v) (declare (ignore v)) (push k keys)) *object-store*)
|
(maphash (lambda (k v) (declare (ignore v)) (push k keys)) *memory*)
|
||||||
(let ((len (length keys)))
|
(let ((len (length keys)))
|
||||||
(when (> len 0)
|
(when (> len 0)
|
||||||
(dotimes (i count)
|
(dotimes (i count)
|
||||||
(let* ((random-key (nth (random len) keys))
|
(let* ((random-key (nth (random len) keys))
|
||||||
(obj (gethash random-key *object-store*)))
|
(obj (gethash random-key *memory*)))
|
||||||
(when obj
|
(when obj
|
||||||
(push obj selected))))))
|
(push obj selected))))))
|
||||||
selected))
|
selected))
|
||||||
|
|||||||
@@ -15,8 +15,8 @@
|
|||||||
format concatenate string-downcase string-upcase search
|
format concatenate string-downcase string-upcase search
|
||||||
;; Kernel specifics
|
;; Kernel specifics
|
||||||
org-agent::harness-log
|
org-agent::harness-log
|
||||||
org-agent::snapshot-object-store
|
org-agent::snapshot-memory
|
||||||
org-agent::rollback-object-store
|
org-agent::rollback-memory
|
||||||
org-agent::lookup-object
|
org-agent::lookup-object
|
||||||
org-agent::list-objects-by-type
|
org-agent::list-objects-by-type
|
||||||
org-agent::ingest-ast
|
org-agent::ingest-ast
|
||||||
|
|||||||
@@ -20,7 +20,7 @@
|
|||||||
(setf current-signal (act-gate current-signal)))
|
(setf current-signal (act-gate current-signal)))
|
||||||
(error (c)
|
(error (c)
|
||||||
(harness-log "METABOLISM CRASH: ~a - Initiating Micro-Rollback." c)
|
(harness-log "METABOLISM CRASH: ~a - Initiating Micro-Rollback." c)
|
||||||
(rollback-object-store 0)
|
(rollback-memory 0)
|
||||||
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
||||||
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
||||||
(setf current-signal nil)
|
(setf current-signal nil)
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
(in-package :org-agent)
|
(in-package :org-agent)
|
||||||
|
|
||||||
(defvar *object-store* (make-hash-table :test 'equal))
|
(defvar *memory* (make-hash-table :test 'equal))
|
||||||
|
|
||||||
(defvar *history-store* (make-hash-table :test 'equal)
|
(defvar *history-store* (make-hash-table :test 'equal)
|
||||||
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
|
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
|
||||||
@@ -21,7 +21,7 @@
|
|||||||
(ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
|
(ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
|
||||||
|
|
||||||
(defun ingest-ast (ast &optional parent-id)
|
(defun ingest-ast (ast &optional parent-id)
|
||||||
"Parses an Org AST into the recursive Lisp Object Store with Merkle hashing."
|
"Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
|
||||||
(let* ((type (getf ast :type))
|
(let* ((type (getf ast :type))
|
||||||
(props (getf ast :properties))
|
(props (getf ast :properties))
|
||||||
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
|
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
|
||||||
@@ -51,7 +51,7 @@
|
|||||||
:hash hash))))
|
:hash hash))))
|
||||||
(unless existing-obj
|
(unless existing-obj
|
||||||
(setf (gethash hash *history-store*) obj))
|
(setf (gethash hash *history-store*) obj))
|
||||||
(setf (gethash id *object-store*) obj)
|
(setf (gethash id *memory*) obj)
|
||||||
id)))
|
id)))
|
||||||
|
|
||||||
(defvar *object-store-snapshots* nil)
|
(defvar *object-store-snapshots* nil)
|
||||||
@@ -63,30 +63,30 @@
|
|||||||
(maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
|
(maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
|
||||||
new-table))
|
new-table))
|
||||||
|
|
||||||
(defun snapshot-object-store ()
|
(defun snapshot-memory ()
|
||||||
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
|
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
|
||||||
(let ((snapshot (copy-hash-table *object-store*)))
|
(let ((snapshot (copy-hash-table *memory*)))
|
||||||
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
|
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
|
||||||
(when (> (length *object-store-snapshots*) 20)
|
(when (> (length *object-store-snapshots*) 20)
|
||||||
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
|
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
|
||||||
(harness-log "MEMORY - CoW Object Store snapshot created.")))
|
(harness-log "MEMORY - CoW Memory snapshot created.")))
|
||||||
|
|
||||||
(defun rollback-object-store (&optional (index 0))
|
(defun rollback-memory (&optional (index 0))
|
||||||
"Restores the Object Store to a previously captured snapshot using immutable history pointers."
|
"Restores the Memory to a previously captured snapshot using immutable history pointers."
|
||||||
(let ((snapshot (nth index *object-store-snapshots*)))
|
(let ((snapshot (nth index *object-store-snapshots*)))
|
||||||
(if snapshot
|
(if snapshot
|
||||||
(progn (setf *object-store* (copy-hash-table (getf snapshot :data)))
|
(progn (setf *memory* (copy-hash-table (getf snapshot :data)))
|
||||||
(harness-log "MEMORY - Object Store rolled back to snapshot ~a" index))
|
(harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
|
||||||
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
|
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
|
||||||
|
|
||||||
(defun lookup-object (id)
|
(defun lookup-object (id)
|
||||||
"Retrieves an object from the store by its unique ID."
|
"Retrieves an object from the store by its unique ID."
|
||||||
(gethash id *object-store*))
|
(gethash id *memory*))
|
||||||
|
|
||||||
(defun list-objects-by-type (type)
|
(defun list-objects-by-type (type)
|
||||||
"Returns a list of all objects matching a specific Org element type."
|
"Returns a list of all objects matching a specific Org element type."
|
||||||
(let ((results nil))
|
(let ((results nil))
|
||||||
(maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *object-store*)
|
(maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *memory*)
|
||||||
results))
|
results))
|
||||||
|
|
||||||
(defun find-headline-missing-id (ast)
|
(defun find-headline-missing-id (ast)
|
||||||
@@ -13,11 +13,11 @@
|
|||||||
#:harness-log
|
#:harness-log
|
||||||
#:main
|
#:main
|
||||||
|
|
||||||
;; --- Object Store (CLOSOS) ---
|
;; --- Memory (CLOSOS) ---
|
||||||
#:ingest-ast
|
#:ingest-ast
|
||||||
#:lookup-object
|
#:lookup-object
|
||||||
#:list-objects-by-type
|
#:list-objects-by-type
|
||||||
#:*object-store*
|
#:*memory*
|
||||||
#:*history-store*
|
#:*history-store*
|
||||||
#:org-object
|
#:org-object
|
||||||
#:org-object-id
|
#:org-object-id
|
||||||
@@ -30,8 +30,8 @@
|
|||||||
#:org-object-vector
|
#:org-object-vector
|
||||||
#:org-object-content
|
#:org-object-content
|
||||||
#:org-object-hash
|
#:org-object-hash
|
||||||
#:snapshot-object-store
|
#:snapshot-memory
|
||||||
#:rollback-object-store
|
#:rollback-memory
|
||||||
|
|
||||||
;; --- Context API (Peripheral Vision) ---
|
;; --- Context API (Peripheral Vision) ---
|
||||||
#:context-query-store
|
#:context-query-store
|
||||||
|
|||||||
@@ -24,7 +24,7 @@
|
|||||||
(type (getf signal :type))
|
(type (getf signal :type))
|
||||||
(sensor (getf payload :sensor)))
|
(sensor (getf payload :sensor)))
|
||||||
(harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor"))
|
(harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor"))
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
(cond ((eq type :EVENT)
|
(cond ((eq type :EVENT)
|
||||||
(case sensor
|
(case sensor
|
||||||
(:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast))))
|
(:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast))))
|
||||||
|
|||||||
@@ -10,7 +10,7 @@
|
|||||||
(is-skill (and (stringp (namestring target-file))
|
(is-skill (and (stringp (namestring target-file))
|
||||||
(search "skills/" (namestring target-file)))))
|
(search "skills/" (namestring target-file)))))
|
||||||
|
|
||||||
(org-agent:snapshot-object-store)
|
(org-agent:snapshot-memory)
|
||||||
(org-agent:harness-log "SELF-FIX - Attempting surgical fix on ~a..." target-file)
|
(org-agent:harness-log "SELF-FIX - Attempting surgical fix on ~a..." target-file)
|
||||||
|
|
||||||
(handler-case
|
(handler-case
|
||||||
@@ -32,7 +32,7 @@
|
|||||||
(org-agent:harness-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.")
|
(org-agent:harness-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.")
|
||||||
(with-open-file (out target-file :direction :output :if-exists :supersede)
|
(with-open-file (out target-file :direction :output :if-exists :supersede)
|
||||||
(write-string content out))
|
(write-string content out))
|
||||||
(org-agent:rollback-object-store 0)
|
(org-agent:rollback-memory 0)
|
||||||
nil)))
|
nil)))
|
||||||
(progn
|
(progn
|
||||||
(org-agent:harness-log "SELF-FIX SUCCESS - Applied fix to file.")
|
(org-agent:harness-log "SELF-FIX SUCCESS - Applied fix to file.")
|
||||||
@@ -41,7 +41,7 @@
|
|||||||
(progn (org-agent:harness-log "SELF-FIX FAILURE - File not found.") nil))
|
(progn (org-agent:harness-log "SELF-FIX FAILURE - File not found.") nil))
|
||||||
(error (c)
|
(error (c)
|
||||||
(org-agent:harness-log "SELF-FIX CRASH - ~a. Rolling back." c)
|
(org-agent:harness-log "SELF-FIX CRASH - ~a. Rolling back." c)
|
||||||
(org-agent:rollback-object-store 0)
|
(org-agent:rollback-memory 0)
|
||||||
nil))))
|
nil))))
|
||||||
|
|
||||||
(def-cognitive-tool :repair-file
|
(def-cognitive-tool :repair-file
|
||||||
|
|||||||
@@ -18,8 +18,8 @@
|
|||||||
*history-store*)
|
*history-store*)
|
||||||
;; 2. Dump the current active pointers
|
;; 2. Dump the current active pointers
|
||||||
(maphash (lambda (id obj)
|
(maphash (lambda (id obj)
|
||||||
(print `(setf (gethash ,id *object-store*) (gethash ,(org-object-hash obj) *history-store*)) out))
|
(print `(setf (gethash ,id *memory*) (gethash ,(org-object-hash obj) *history-store*)) out))
|
||||||
*object-store*))
|
*memory*))
|
||||||
t))
|
t))
|
||||||
|
|
||||||
(defun persistence-load-local ()
|
(defun persistence-load-local ()
|
||||||
@@ -50,7 +50,7 @@
|
|||||||
(: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))
|
||||||
*object-store*)
|
*memory*)
|
||||||
objects))
|
objects))
|
||||||
|
|
||||||
(defun persistence-push-ipfs ()
|
(defun persistence-push-ipfs ()
|
||||||
@@ -76,7 +76,7 @@
|
|||||||
(handler-case
|
(handler-case
|
||||||
(let* ((response (dex:post ipfs-url))
|
(let* ((response (dex:post ipfs-url))
|
||||||
(data (cl-json:decode-json-from-string response)))
|
(data (cl-json:decode-json-from-string response)))
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(dolist (item data)
|
(dolist (item data)
|
||||||
(let* ((id (cdr (assoc :id item)))
|
(let* ((id (cdr (assoc :id item)))
|
||||||
(obj (make-org-object
|
(obj (make-org-object
|
||||||
@@ -90,7 +90,7 @@
|
|||||||
:version (cdr (assoc :version item))
|
:version (cdr (assoc :version item))
|
||||||
:last-sync (cdr (assoc :last-sync item))
|
:last-sync (cdr (assoc :last-sync item))
|
||||||
:hash (cdr (assoc :hash item)))))
|
:hash (cdr (assoc :hash item)))))
|
||||||
(setf (gethash id *object-store*) obj)))
|
(setf (gethash id *memory*) obj)))
|
||||||
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
|
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
|
||||||
t)
|
t)
|
||||||
(error (c)
|
(error (c)
|
||||||
|
|||||||
@@ -33,11 +33,11 @@
|
|||||||
|
|
||||||
(test test-bouncer-approval-reaction
|
(test test-bouncer-approval-reaction
|
||||||
"Verify that the bouncer skill re-injects an action when a plan node is APPROVED."
|
"Verify that the bouncer skill re-injects an action when a plan node is APPROVED."
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(let* ((action '(:type :REQUEST :target :telegram :payload (:text "hello")))
|
(let* ((action '(:type :REQUEST :target :telegram :payload (:text "hello")))
|
||||||
(node-id "plan-1"))
|
(node-id "plan-1"))
|
||||||
;; 1. Setup an APPROVED flight plan node
|
;; 1. Setup an APPROVED flight plan node
|
||||||
(setf (gethash node-id org-agent::*object-store*)
|
(setf (gethash node-id org-agent::*memory*)
|
||||||
(org-agent::make-org-object
|
(org-agent::make-org-object
|
||||||
:id node-id
|
:id node-id
|
||||||
:attributes `(:TITLE "Flight Plan" :TODO "APPROVED" :TAGS ("FLIGHT_PLAN") :ACTION ,(format nil "~s" action))))
|
:attributes `(:TITLE "Flight Plan" :TODO "APPROVED" :TAGS ("FLIGHT_PLAN") :ACTION ,(format nil "~s" action))))
|
||||||
@@ -46,7 +46,7 @@
|
|||||||
(let ((result (org-agent::bouncer-process-approvals)))
|
(let ((result (org-agent::bouncer-process-approvals)))
|
||||||
(is (eq t result))
|
(is (eq t result))
|
||||||
;; The node should now be DONE
|
;; The node should now be DONE
|
||||||
(let ((obj (gethash node-id org-agent::*object-store*)))
|
(let ((obj (gethash node-id org-agent::*memory*)))
|
||||||
(is (equal "DONE" (getf (org-agent:org-object-attributes obj) :TODO)))))))
|
(is (equal "DONE" (getf (org-agent:org-object-attributes obj) :TODO)))))))
|
||||||
|
|
||||||
(test test-bouncer-secret-exposure
|
(test test-bouncer-secret-exposure
|
||||||
|
|||||||
@@ -42,8 +42,8 @@
|
|||||||
"Verify that hash is stable even if properties are sent in different order."
|
"Verify that hash is stable even if properties are sent in different order."
|
||||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "collision" :A "1" :B "2") :contents nil))
|
(let* ((ast1 '(:type :HEADLINE :properties (:ID "collision" :A "1" :B "2") :contents nil))
|
||||||
(ast2 '(:type :HEADLINE :properties (:ID "collision" :B "2" :A "1") :contents nil)))
|
(ast2 '(:type :HEADLINE :properties (:ID "collision" :B "2" :A "1") :contents nil)))
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(let ((h1 (org-object-hash (lookup-object (ingest-ast ast1)))))
|
(let ((h1 (org-object-hash (lookup-object (ingest-ast ast1)))))
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(let ((h2 (org-object-hash (lookup-object (ingest-ast ast2)))))
|
(let ((h2 (org-object-hash (lookup-object (ingest-ast ast2)))))
|
||||||
(is (equal h1 h2))))))
|
(is (equal h1 h2))))))
|
||||||
|
|||||||
@@ -16,7 +16,7 @@
|
|||||||
|
|
||||||
(test test-async-repair-flow
|
(test test-async-repair-flow
|
||||||
"Verify that the pipeline correctly emits and reacts to syntax-error events."
|
"Verify that the pipeline correctly emits and reacts to syntax-error events."
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(let* ((broken-code "(:type :REQUEST :target :tool")
|
(let* ((broken-code "(:type :REQUEST :target :tool")
|
||||||
(error-msg "End of file")
|
(error-msg "End of file")
|
||||||
;; 1. The Stimulus that caused the error
|
;; 1. The Stimulus that caused the error
|
||||||
|
|||||||
@@ -1,21 +1,21 @@
|
|||||||
(defpackage :org-agent-object-store-tests
|
(defpackage :org-agent-memory-tests
|
||||||
(:use :cl :fiveam :org-agent)
|
(:use :cl :fiveam :org-agent)
|
||||||
(:export #:object-store-suite))
|
(:export #:memory-suite))
|
||||||
|
|
||||||
(in-package :org-agent-object-store-tests)
|
(in-package :org-agent-memory-tests)
|
||||||
|
|
||||||
(def-suite object-store-suite
|
(def-suite memory-suite
|
||||||
:description "Tests for the Merkle-Tree Object Store.")
|
:description "Tests for the Merkle-Tree Memory.")
|
||||||
|
|
||||||
(in-suite object-store-suite)
|
(in-suite memory-suite)
|
||||||
|
|
||||||
(test merkle-hash-consistency
|
(test merkle-hash-consistency
|
||||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil))
|
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil))
|
||||||
(ast2 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
|
(ast2 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(let ((id1 (ingest-ast ast1)))
|
(let ((id1 (ingest-ast ast1)))
|
||||||
(let ((hash1 (org-object-hash (lookup-object id1))))
|
(let ((hash1 (org-object-hash (lookup-object id1))))
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(let ((id2 (ingest-ast ast2)))
|
(let ((id2 (ingest-ast ast2)))
|
||||||
(let ((hash2 (org-object-hash (lookup-object id2))))
|
(let ((hash2 (org-object-hash (lookup-object id2))))
|
||||||
(is (equal hash1 hash2))))))))
|
(is (equal hash1 hash2))))))))
|
||||||
@@ -24,19 +24,19 @@
|
|||||||
(let* ((ast-leaf '(:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))
|
(let* ((ast-leaf '(:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))
|
||||||
(ast-root-full '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
(ast-root-full '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
||||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))))
|
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))))
|
||||||
(id-root (progn (clrhash *object-store*) (ingest-ast ast-root-full)))
|
(id-root (progn (clrhash *memory*) (ingest-ast ast-root-full)))
|
||||||
(initial-root-hash (org-object-hash (lookup-object id-root))))
|
(initial-root-hash (org-object-hash (lookup-object id-root))))
|
||||||
|
|
||||||
;; Now ingest a modified version (title change)
|
;; Now ingest a modified version (title change)
|
||||||
(let* ((ast-root-modified '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
(let* ((ast-root-modified '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
||||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf Modified") :contents nil))))
|
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf Modified") :contents nil))))
|
||||||
(id-root-mod (progn (clrhash *object-store*) (ingest-ast ast-root-modified)))
|
(id-root-mod (progn (clrhash *memory*) (ingest-ast ast-root-modified)))
|
||||||
(modified-root-hash (org-object-hash (lookup-object id-root-mod))))
|
(modified-root-hash (org-object-hash (lookup-object id-root-mod))))
|
||||||
(is (not (equal initial-root-hash modified-root-hash))))))
|
(is (not (equal initial-root-hash modified-root-hash))))))
|
||||||
|
|
||||||
(test history-store-immutability
|
(test history-store-immutability
|
||||||
"Verify that *history-store* retains old versions even after *object-store* updates."
|
"Verify that *history-store* retains old versions even after *memory* updates."
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(clrhash *history-store*)
|
(clrhash *history-store*)
|
||||||
(let* ((ast-v1 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 1") :contents nil))
|
(let* ((ast-v1 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 1") :contents nil))
|
||||||
(id-v1 (ingest-ast ast-v1))
|
(id-v1 (ingest-ast ast-v1))
|
||||||
@@ -63,7 +63,7 @@
|
|||||||
|
|
||||||
(test cow-snapshot-and-rollback
|
(test cow-snapshot-and-rollback
|
||||||
"Verify that lightweight snapshots can accurately restore previous pointer states."
|
"Verify that lightweight snapshots can accurately restore previous pointer states."
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(clrhash *history-store*)
|
(clrhash *history-store*)
|
||||||
(setf *object-store-snapshots* nil)
|
(setf *object-store-snapshots* nil)
|
||||||
|
|
||||||
@@ -72,7 +72,7 @@
|
|||||||
(hash-v1 (org-object-hash (lookup-object id-v1))))
|
(hash-v1 (org-object-hash (lookup-object id-v1))))
|
||||||
|
|
||||||
;; Take a snapshot at State A
|
;; Take a snapshot at State A
|
||||||
(snapshot-object-store)
|
(snapshot-memory)
|
||||||
|
|
||||||
(let* ((ast-v2 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State B") :contents nil))
|
(let* ((ast-v2 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State B") :contents nil))
|
||||||
(id-v2 (ingest-ast ast-v2))
|
(id-v2 (ingest-ast ast-v2))
|
||||||
@@ -82,7 +82,7 @@
|
|||||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
|
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
|
||||||
|
|
||||||
;; Rollback to State A (index 0 because we only took 1 snapshot)
|
;; Rollback to State A (index 0 because we only took 1 snapshot)
|
||||||
(rollback-object-store 0)
|
(rollback-memory 0)
|
||||||
|
|
||||||
;; Verify we are back in State A
|
;; Verify we are back in State A
|
||||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v1))
|
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v1))
|
||||||
@@ -9,7 +9,7 @@
|
|||||||
|
|
||||||
(test test-foveal-rendering
|
(test test-foveal-rendering
|
||||||
"Verify that the foveal target is rendered with content, while siblings are skeletal."
|
"Verify that the foveal target is rendered with content, while siblings are skeletal."
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project")
|
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project")
|
||||||
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
|
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
|
||||||
:raw-content "FOVEAL CONTENT" :contents nil)
|
:raw-content "FOVEAL CONTENT" :contents nil)
|
||||||
@@ -25,7 +25,7 @@
|
|||||||
|
|
||||||
(test test-awareness-budget
|
(test test-awareness-budget
|
||||||
"Verify that context-assemble-global-awareness handles multiple projects."
|
"Verify that context-assemble-global-awareness handles multiple projects."
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project") :contents nil))
|
(ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project") :contents nil))
|
||||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project") :contents nil))
|
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project") :contents nil))
|
||||||
(let ((output (context-assemble-global-awareness)))
|
(let ((output (context-assemble-global-awareness)))
|
||||||
|
|||||||
@@ -8,8 +8,8 @@
|
|||||||
(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 *object-store*) (make-org-object :id test-id :content "Integrity Check"))
|
(setf (gethash test-id *memory*) (make-org-object :id test-id :content "Integrity Check"))
|
||||||
(org-agent:persistence-dump-local)
|
(org-agent:persistence-dump-local)
|
||||||
(clrhash *object-store*)
|
(clrhash *memory*)
|
||||||
(org-agent:persistence-load-local)
|
(org-agent:persistence-load-local)
|
||||||
(is (equal "Integrity Check" (org-object-content (gethash test-id *object-store*))))))
|
(is (equal "Integrity Check" (org-object-content (gethash test-id *memory*))))))
|
||||||
|
|||||||
@@ -26,11 +26,11 @@
|
|||||||
|
|
||||||
(test test-perceive-gate
|
(test test-perceive-gate
|
||||||
"Perceive gate should update the object store and normalize signal."
|
"Perceive gate should update the object store and normalize signal."
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
|
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
|
||||||
(result (perceive-gate signal)))
|
(result (perceive-gate signal)))
|
||||||
(is (eq :perceived (getf result :status)))
|
(is (eq :perceived (getf result :status)))
|
||||||
(is (not (null (gethash "test-node" org-agent::*object-store*))))))
|
(is (not (null (gethash "test-node" org-agent::*memory*))))))
|
||||||
|
|
||||||
(test test-decide-gate-safety
|
(test test-decide-gate-safety
|
||||||
"Decide gate should block unsafe LLM proposals."
|
"Decide gate should block unsafe LLM proposals."
|
||||||
@@ -46,7 +46,7 @@
|
|||||||
(test test-pipeline-flow-flat
|
(test test-pipeline-flow-flat
|
||||||
"Verify that process-signal correctly executes a signal through gates."
|
"Verify that process-signal correctly executes a signal through gates."
|
||||||
(setup-mock-skills)
|
(setup-mock-skills)
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(let ((signal (list :type :EVENT :payload (list :sensor :buffer-update))))
|
(let ((signal (list :type :EVENT :payload (list :sensor :buffer-update))))
|
||||||
(process-signal signal)
|
(process-signal signal)
|
||||||
(pass "Pipeline completed execution.")))
|
(pass "Pipeline completed execution.")))
|
||||||
@@ -90,15 +90,15 @@
|
|||||||
|
|
||||||
(test test-global-awareness-assembly
|
(test test-global-awareness-assembly
|
||||||
"Verify that context-assemble-global-awareness reports active projects."
|
"Verify that context-assemble-global-awareness reports active projects."
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(ingest-ast (list :type :HEADLINE :properties (list :ID "proj-1" :TITLE "Project Alpha" :TAGS "project") :contents nil))
|
(ingest-ast (list :type :HEADLINE :properties (list :ID "proj-1" :TITLE "Project Alpha" :TAGS "project") :contents nil))
|
||||||
(let ((awareness (context-assemble-global-awareness)))
|
(let ((awareness (context-assemble-global-awareness)))
|
||||||
(is (search "Project Alpha" awareness))
|
(is (search "Project Alpha" awareness))
|
||||||
(is (search "proj-1" awareness))))
|
(is (search "proj-1" awareness))))
|
||||||
|
|
||||||
(test test-micro-rollback
|
(test test-micro-rollback
|
||||||
"Verify that a pipeline crash triggers an automatic Object Store rollback."
|
"Verify that a pipeline crash triggers an automatic Memory rollback."
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(clrhash org-agent::*history-store*)
|
(clrhash org-agent::*history-store*)
|
||||||
(setf org-agent::*object-store-snapshots* nil)
|
(setf org-agent::*object-store-snapshots* nil)
|
||||||
;; State A
|
;; State A
|
||||||
|
|||||||
@@ -20,10 +20,10 @@
|
|||||||
(test test-task-integrity-parent-child
|
(test test-task-integrity-parent-child
|
||||||
"Verify that task-integrity-check rejects closing a parent with active children."
|
"Verify that task-integrity-check rejects closing a parent with active children."
|
||||||
;; Mocking some objects in the store
|
;; Mocking some objects in the store
|
||||||
(clrhash org-agent::*object-store*)
|
(clrhash org-agent::*memory*)
|
||||||
(setf (gethash "parent-1" org-agent::*object-store*)
|
(setf (gethash "parent-1" org-agent::*memory*)
|
||||||
(org-agent::make-org-object :id "parent-1" :attributes '(:TITLE "Parent Task" :TODO "TODO")))
|
(org-agent::make-org-object :id "parent-1" :attributes '(:TITLE "Parent Task" :TODO "TODO")))
|
||||||
(setf (gethash "child-1" org-agent::*object-store*)
|
(setf (gethash "child-1" org-agent::*memory*)
|
||||||
(org-agent::make-org-object :id "child-1" :attributes '(:TITLE "Child Task" :TODO "TODO" :PARENT "parent-1")))
|
(org-agent::make-org-object :id "child-1" :attributes '(:TITLE "Child Task" :TODO "TODO" :PARENT "parent-1")))
|
||||||
|
|
||||||
(let* ((action '(:type :REQUEST :target :emacs :action :update-node :id "parent-1" :attributes (:TODO "DONE")))
|
(let* ((action '(:type :REQUEST :target :emacs :action :update-node :id "parent-1" :attributes (:TODO "DONE")))
|
||||||
|
|||||||
@@ -11,6 +11,6 @@
|
|||||||
|
|
||||||
(test test-vault-persistence
|
(test test-vault-persistence
|
||||||
"Verify that setting a secret triggers a snapshot (mock check)."
|
"Verify that setting a secret triggers a snapshot (mock check)."
|
||||||
(let ((old-version (org-agent::org-object-version (gethash "root" *object-store*))))
|
(let ((old-version (org-agent::org-object-version (gethash "root" *memory*))))
|
||||||
(org-agent:vault-set-secret :test "secret-val")
|
(org-agent:vault-set-secret :test "secret-val")
|
||||||
(is (> (org-agent::org-object-version (gethash "root" *object-store*)) old-version))))
|
(is (> (org-agent::org-object-version (gethash "root" *memory*)) old-version))))
|
||||||
|
|||||||
Reference in New Issue
Block a user