diff --git a/.claude/skills/create-pr/SKILL.md b/.claude/skills/create-pr/SKILL.md new file mode 100644 index 0000000..a4258b1 --- /dev/null +++ b/.claude/skills/create-pr/SKILL.md @@ -0,0 +1,26 @@ +--- +name: create-pr +description: Create a GitHub PR cleanly — strips auto-injected session links. +--- + +# create-pr + +GitHub API is blocked by the egress proxy. PRs must go through the MCP tools, +which auto-append a session link to the body. This skill wraps that into a +clean two-step: + +## Steps + +1. Call `mcp__github__create_pull_request` with the desired title, body, head, + base, and `draft: true`. Do NOT include any session links, Co-Authored-By + lines, or claude.ai URLs in the body. + +2. Immediately call `mcp__github__update_pull_request` on the returned PR + number with the EXACT same body you passed in step 1 — this overwrites + the auto-appended session link. + +3. Verify: call `mcp__github__pull_request_read` with `method: get` and + confirm the body contains no `claude.ai`, `session_`, or + `Generated by` strings. + +Never skip step 2. The injected link appears every time. diff --git a/core/AGENTS.md b/core/AGENTS.md index e040da3..473035e 100644 --- a/core/AGENTS.md +++ b/core/AGENTS.md @@ -1,15 +1,25 @@ # AGENTS.md — Ada border (D1) + invariant vault -Local guide for `mafiabot_core`. Repo-wide map and rules: [`../AGENTS.md`](../AGENTS.md); +Local guide for `sica-fondt`. Repo-wide map and rules: [`../AGENTS.md`](../AGENTS.md); working agreements: [`../CLAUDE.md`](../CLAUDE.md). Correction log: [`../.claude/devCorrectionLog.md`](../.claude/devCorrectionLog.md). ## What this is -The **Ada/SPARK border — D1**. All traffic to the inner brain crosses here -first. Built with **Alire**. Internal modules under `src/`: `trust` (incl. the -COBOL invariant-law vault), `organs`, `network`, `protocol`, `daemons`, `core`, -`types`, `outputs`. These are modules, not separate organs — they share this -file. +The **Ada/SPARK border — D1**. All traffic to the inner brain crosses here first. Built with **Alire**. Internal modules and organs under `src/`: `trust` (incl. the COBOL invariant-law vault), `organs`, `network`, `protocol`, `daemons`, `core`, `types`, `outputs`. + +## The COBOL invariant vault (`src/trust`) + +`src/trust/invariants-architecture.cobol` is **E1, the constitution** — Invariant 0 (the culpability anchor) and 01 (minimize harm). Compile/run free format: + +```bash +cobc -x -free -o /tmp/inv src/trust/invariants-architecture.cobol && /tmp/inv +``` + +## Local invariants + +- **S1:** this is the border — never add a route that lets traffic reach the inner brain without crossing the Ada Bus. +- **S2:** never reclassify a message's provenance. +- **S3:** the invariant vault is **immutable** — don't edit it; it's the laws of physics, not a config or preferences file. ## Build & test @@ -23,21 +33,3 @@ cd mafiabot_core && alr -n build `engine_tests` prints nothing on success (clean exit). Or run the whole repo via `.claude/skills/run-sica-fondt/smoke.sh`. - -## The COBOL invariant vault (`src/trust`) - -`src/trust/invariants-architecture.cobol` is **E1, the constitution** — -Invariant 0 (the culpability anchor) and 01 (minimize harm). Compile/run free -format: - -```bash -cobc -x -free -o /tmp/inv src/trust/invariants-architecture.cobol && /tmp/inv -``` - -## Local invariants - -- **S1:** this is the border — never add a route that lets traffic reach the - inner brain without crossing here. -- **S2:** never reclassify a message's provenance. -- **S3:** the invariant vault is **immutable at runtime** — don't edit it - casually; it's the constitution, not config. diff --git a/core/CLAUDE.md b/core/CLAUDE.md index 16b4b4a..16cfb25 100644 --- a/core/CLAUDE.md +++ b/core/CLAUDE.md @@ -8,10 +8,26 @@ sica-fondt is a **design-first, polyglot organism**: a Pony perfusion bus (Ichor ## Working agreements -- **You're the dev.** When details are missing or a decision is open, make a reasonable call and fill in concrete details — aim to leave no placeholders, and only delay if something is genuinely ambiguous. +- **You're the dev.** When details are missing or a decision is open, make a reasonable call and fill in concrete details — aim to leave no placeholders, and only delay if something is genuinely ambiguous. This means go for the best fits. - **Verify, then commit.** After generating or editing, confirm it works (build / run / `run-sica-fondt` smoke), then commit with a descriptive message. Commit and push before ending a session — the container is ephemeral. - **Design before code.** If something feels ambiguous, the answer is usually already written in `docs/`. Sync the design first. Saves us all some time. + +## Invariants — do not violate + +- **S0:** Do not assume what implementation or version of a language is intended. +- **S1:** all external traffic crosses the Ada border (D1) first; never route around it. +- **S2:** If a new toolchain is needed, first add it to the SessionStart hook. +- **S3:** never reclassify a message's provenance. +- **S4:** do not delegate to subagents unless you have a task that requires more effort to do in the meantime. Do not spawn foreground agents. +- **S99 / vault:** the COBOL invariant-law vault (Invariant 0, the culpability anchor; 01, "harm" "less"; etc.) is immutable at runtime — don't edit it unless explicitly directed and only as such. + +## Subagents + +When spawning background agents (Haiku for research, etc.), **keep working on the main task while they run**. Don't wait idle — fold in results as they arrive, edit other files, or advance unrelated build steps. Background agents are cheap parallelism; wasting the main context window on waiting defeats the purpose. + +Correction log at `.claude/devCorrectionLog.md`. + ## Build & run Use the `run-sica-fondt` skill (`.claude/skills/run-sica-fondt/`) — its `smoke.sh` builds and runs every executable unit and asserts output: @@ -22,18 +38,6 @@ Use the `run-sica-fondt` skill (`.claude/skills/run-sica-fondt/`) — its `smoke Per-unit commands and gotchas live in that unit's `AGENTS.md`. Toolchains (ponyc/Alire/GnuCOBOL) are reinstalled each session by the SessionStart hook `.claude/hooks/install-toolchains.sh`; if `ponyc` isn't found, `export PATH=/root/.local/share/ponyup/bin:$PATH`. If a new toolchain is needed, first add it to the SessionStart hook. -## Invariants — do not violate - -- **S1:** all external traffic crosses the Ada border (D1) first; never route around it. -- **S2:** never reclassify a message's provenance. -- **S3 / vault:** the COBOL invariant-law vault (Invariant 0, the culpability anchor; 01, "harm" "less";) is immutable at runtime — don't edit it unless explicitly directed and only as such. - -## Subagents - -When spawning background agents (Haiku for research, etc.), **keep working on the main task while they run**. Don't wait idle — fold in results as they arrive, edit other files, or advance unrelated build steps. Background agents are cheap parallelism; wasting the main context window on waiting defeats the purpose. - -Correction log at `.claude/devCorrectionLog.md`. - ## Docs map - `README.md` — the project and its intent. diff --git a/core/docs/plans/M3-sims-hub.md b/core/docs/plans/M3-sims-hub.md index 67de9b6..2430b60 100644 --- a/core/docs/plans/M3-sims-hub.md +++ b/core/docs/plans/M3-sims-hub.md @@ -15,9 +15,11 @@ DESIGN-FIRST · ABSENT. Role C3; implementation C1. Mathematical foundations C4 established); specific model parameters C1. ## 3. Language & location -TBD · `src/economy/sims/`. Numerical computing (Julia, Octave, Fortran, R, or Solidity) -for the simulation cores. A query facade accessible to Traders. Each sim type (M3a–M3g) may use -a different runtime suited to its math. +**Tcl** · `src/economy/sims/`. The hub is a syntax-agnostic coordinator: Tcl manages +lifecycle, tick-advancement, and query routing for sub-sims in their native runtimes via +stdin/stdout JSON — **Fortran** (M3d, M3e), **Prolog** (M3b, M3f), **R** (M3a), +**Solidity** (M3c), **Zig** (M3g). Tcl imposes no type system or paradigm on the +sub-processes it orchestrates. ## 4. Does / does-not - **Does:** tick-advance continuously at **90:1** (1 wall-second = 90 simulated seconds) diff --git a/core/docs/plans/M3a-statistical-sims.md b/core/docs/plans/M3a-statistical-sims.md index d54c0e2..0b0b91f 100644 --- a/core/docs/plans/M3a-statistical-sims.md +++ b/core/docs/plans/M3a-statistical-sims.md @@ -16,10 +16,10 @@ execution C5 (industry standard since 2001). Jump-diffusion C5 (Merton 1976). Pa for crypto markets C1. ## 3. Language & location -TBD · `src/economy/sims/statistical/`. Julia, R, Fortran, or Octave for numerical computing. -Needs efficient matrix operations, SDE solvers, and distribution sampling. Fractional Brownian -motion generation uses spectral methods (Hosking 1984, Wood & Chan 1994) or Cholesky -decomposition of the covariance matrix. +TBD · `src/economy/sims/statistical/`. **R** — native statistical distribution ecosystem, +matrix operations, and time-series libraries (GARCH, ARIMA, HMM) without wrapping external +solvers. Fractional Brownian motion generation uses spectral methods (Hosking 1984, Wood & Chan +1994) or Cholesky decomposition of the covariance matrix. ## 4. Does / does-not - **Does:** run Monte Carlo price simulations (GBM, Merton jump-diffusion, Heston stochastic diff --git a/core/docs/plans/M3b-sociological-sims.md b/core/docs/plans/M3b-sociological-sims.md index f2e17c8..7867b6f 100644 --- a/core/docs/plans/M3b-sociological-sims.md +++ b/core/docs/plans/M3b-sociological-sims.md @@ -17,9 +17,11 @@ solvers C3). Crypto pump-and-dump ABM C3 (3-agent protocol validated on historic Pop behavioral models C1. ## 3. Language & location -TBD · `src/economy/sims/sociological/`. Agent-based modeling frameworks (NetLogo, or custom). -Needs efficient population iteration, strategy mutation, PDE solvers for MFG (HJB + -Fokker-Planck), and bandit algorithms (UCB/Thompson). Julia, R, or Fortran. +ECLiPSe Prolog · `src/economy/sims/sociological/`. **Prolog** — game-theoretic equilibria, replicator +dynamics, and strategy evolution are naturally expressed as logical relations over population +states; Nash equilibrium search is constraint satisfaction. Needs efficient population iteration, +strategy mutation, PDE solvers for MFG (HJB + Fokker-Planck), and bandit algorithms +(UCB/Thompson). ## 4. Does / does-not - **Does:** simulate populations of behavioral archetypes competing in a market; apply @@ -79,12 +81,12 @@ Fokker-Planck), and bandit algorithms (UCB/Thompson). Julia, R, or Fortran. - M3 Sims hub — lifecycle management; *stub:* manual init. ## 7. Invariants / laws -- **L1 (C5):** pops are **archetypes, not individuals** — no attempt to model or track real - market participants. The sim models emergent behavior from strategy populations. +- **L1 (C5):** pops are **archetypal individuals, not literao living persons** — no attempt to model or track real + market participants. The sim models emergent behavior from abstracted populations. - **L2 (C5):** strategies **evolve** — the population distribution shifts over time via replicator dynamics. No fixed strategy ratios. -- **L3 (C4):** bounded rationality is the **default** — pops satisfice with heuristics, not - optimize with perfect information. Rational-agent models are a special case, not the baseline. +- **L3 (C4):** rationality is ***NOT*** the **default** — pops satisfice with heuristics, not + optimize with perfect information. Rational-agent models are an **abnormal** case, not the baseline. - **L4 (C4):** **complex contagion requires multiple exposures** — adoption is non-linear in neighbor count, not simple diffusion. Single-exposure models undercount threshold effects. - **L5 (C4):** the MFG limit is **valid only for large populations** — below ~100 pops, use @@ -93,7 +95,8 @@ Fokker-Planck), and bandit algorithms (UCB/Thompson). Julia, R, or Fortran. promote → distribute → collapse) has distinct statistical signatures in volume and price. ## 8. Build steps -1. Define pop archetypes and their heuristic strategies. +0. Get ECLiPSe tool chain installed and operational. +1. Define pop archetypes and their various strategies. 2. Implement replicator dynamics (strategy evolution over generations). 3. Implement Hegselmann-Krause bounded confidence opinion model. 4. Implement complex contagion with heterogeneous thresholds. @@ -101,7 +104,7 @@ Fokker-Planck), and bandit algorithms (UCB/Thompson). Julia, R, or Fortran. 6. Implement MFG solver (HJB + Fokker-Planck with Newton iteration). 7. Implement pump-and-dump 3-type ABM (Normal, MA, MP) with 4-phase protocol. 8. Wire M2 news/price data → calibration of pop parameters. -9. Implement multi-horizon `BoundedPrediction` output. +9. Implement multi-horizon `BoundedPrediction` outputs. ## 9. Tests Evolution: dominant strategy shifts when payoff landscape changes. Cascade: sentiment shock @@ -115,7 +118,7 @@ include upper/lower. ## 10. Open items - Pop archetype catalog (which behavioral types? how many?). - Network topology for sentiment contagion (small-world? scale-free?). -- Calibration from real market data — how to infer pop distribution from observable price action. -- MFG tensor-train rank $r$ (accuracy vs. compute tradeoff). -- Hegselmann-Krause confidence bound $d$ — fixed or adaptive? -- Cross-sim interaction: do sociological predictions feed into M3c (AMM) or M3d (MEV)? +- Calibration from real market data — how to infer pop distribution from observable price action. >>>We actually use blogs, reddit, and social networks to infer pops<<< +- MFG tensor-train rank $r$ (>>>accuracy<<< vs. compute tradeoff). +- Hegselmann-Krause confidence bound $d$ — fixed or >>>adaptive<<>>Uniswap v3 style<<<) — extends the base model significantly. +- Multi-pool routing (split swaps across pools). >>>yes<<< +- Which specific pools to simulate (>>>ETH<<>and other popular chains<< NOT STABLE/USDC/USDT etc. diff --git a/core/docs/plans/M3d-mev-adversarial-sims.md b/core/docs/plans/M3d-mev-adversarial-sims.md index 08c395c..163a1bf 100644 --- a/core/docs/plans/M3d-mev-adversarial-sims.md +++ b/core/docs/plans/M3d-mev-adversarial-sims.md @@ -19,9 +19,9 @@ optimization C3 (emerging — SMFRL solvers); Kolokoltsov adversarial C3 (non-li WENO discretization established but crypto application novel). Parameterization C1. ## 3. Language & location -TBD · `src/economy/sims/mev/`. Needs combinatorial optimization (OR-Tools for knapsack), -continuous-time auction modeling, PDE solvers (WENO for shock-capturing in adversarial dynamics), -and bilevel optimization (DSMFG). Julia or Fortran. +FORTRAN [WHICH IMPLEMENTATIOBS?] · `src/economy/sims/mev/`. **Fortran** — dense numerical loops for PDE solvers (WENO +shock-capturing), knapsack combinatorics, and continuous-time auction modeling at the throughput +MEV extraction demands; no GC pauses during hot-path simulation. ## 4. Does / does-not - **Does:** simulate Priority Gas Auctions where multiple searcher bots compete for the same @@ -57,12 +57,8 @@ and bilevel optimization (DSMFG). Julia or Fortran. | Annual | Kolokoltsov adversarial long-run dynamics | Monthly roll | | 5-year | Structural MEV regime shifts, protocol-level policy effects | Quarterly roll | - Examples: - `{ value: 0.23, lower_bound: 0.11, upper_bound: 0.38, confidence: 8.00, - time_horizon: "next_block", sim_type: "mev_adversarial" }` — sandwich probability. - `{ value: 14.7, lower_bound: 8.2, upper_bound: 22.5, confidence: 7.50, - time_horizon: "next_block", sim_type: "mev_adversarial" }` — optimal gas bid (gwei). - `{ value: 0.034, lower_bound: 0.018, upper_bound: 0.052, confidence: 8.20, - time_horizon: "1h", sim_type: "mev_adversarial" }` — cross-chain arb profit (ETH). + `{ value: 0.23 / 15.00 , lower_bound: 0.11 / 15.00 , upper_bound: 0.38 / 15.00 , confidence: 8.00 / 10.00, + time_horizon: "block", sim_type: "mev_adversarial" }` - **Prediction types:** `sandwich_probability`, `frontrun_risk`, `optimal_gas_bid`, `block_inclusion_probability`, `mev_exposure`, `cross_chain_arb_profit`, `adversarial_policy_stability`, `searcher_population_shift`. diff --git a/core/docs/plans/M3e-tokenomics-macro-sims.md b/core/docs/plans/M3e-tokenomics-macro-sims.md index 35e80f6..8679693 100644 --- a/core/docs/plans/M3e-tokenomics-macro-sims.md +++ b/core/docs/plans/M3e-tokenomics-macro-sims.md @@ -19,9 +19,10 @@ DeXposure inter-protocol credit propagation C3 (emerging, 2025 — high DeFi spe composable yield optimization C4 (Yearn v3, Beefy, production-validated). Specific parameters C1. ## 3. Language & location -TBD · `src/economy/sims/tokenomics/`. Needs SDE solvers (Euler-Maruyama, Milstein), -state-space estimation, and VAR (vector autoregression) for credit exposure impulse responses. -Julia (DifferentialEquations.jl) or Octave. +TBD · `src/economy/sims/tokenomics/`. **Fortran** — SDE solvers (Euler-Maruyama, Milstein), +state-space estimation, and VAR impulse responses are dense matrix-heavy loops where Fortran's +array intrinsics and zero-overhead numerics dominate; same language as M3d avoids a toolchain +split across the heaviest numerical sims. ## 4. Does / does-not - **Does:** simulate token state dynamics via the SDE framework: diff --git a/core/docs/plans/M3f-consensus-staking-sims.md b/core/docs/plans/M3f-consensus-staking-sims.md index 4836ccb..104a996 100644 --- a/core/docs/plans/M3f-consensus-staking-sims.md +++ b/core/docs/plans/M3f-consensus-staking-sims.md @@ -14,8 +14,10 @@ validator populations C4 (Lasry & Lions 2007; validator-specific application C3) simulation parameterization C1. ## 3. Language & location -TBD · `src/economy/sims/consensus/`. Needs Markov chain solvers and game-theoretic equilibrium -computation. Julia, R, or Fortran. +TBD · `src/economy/sims/consensus/`. **Prolog** — Markov chain transition rules, Nash +equilibrium search, and replicator dynamics are constraint-satisfaction problems over validator +populations; Prolog's backtracking search finds equilibria declaratively rather than +imperatively iterating toward them. ## 4. Does / does-not - **Does:** simulate validator populations where honesty evolves via **evolutionary game theory** diff --git a/core/docs/plans/M3g-market-microstructure-sims.md b/core/docs/plans/M3g-market-microstructure-sims.md index 469c842..a3c5810 100644 --- a/core/docs/plans/M3g-market-microstructure-sims.md +++ b/core/docs/plans/M3g-market-microstructure-sims.md @@ -15,8 +15,9 @@ optimal execution C5 (industry standard since 2001; crypto adaptations validated Kurz CMC thesis). DEX-specific microstructure C2 (emerging). Implementation C1. ## 3. Language & location -TBD · `src/economy/sims/microstructure/`. Needs high-frequency data handling, event-driven -simulation, and Riccati equation solvers for optimal execution trajectories. Fortran or Julia. +TBD · `src/economy/sims/microstructure/`. **Zig** — tick-level event-driven simulation with +deterministic memory layout, no GC pauses, and sub-microsecond latency for Riccati solvers and +order-book state updates; comptime generics eliminate runtime dispatch on hot paths. ## 4. Does / does-not - **Does:** simulate order flow across venues (DEXs and CEXs); model bid-ask spread dynamics as a diff --git a/core/src/auth/bounds.ads b/core/src/auth/bounds.ads index 1e86ef4..e1f3848 100644 --- a/core/src/auth/bounds.ads +++ b/core/src/auth/bounds.ads @@ -2,12 +2,12 @@ package bounds is -- Exact molecular weight of the vereiner token levels. No unbounded integers. - type Token_Value is range 0 .. 1024 + type Token_Value is range 0 .. 512 -- Strict state topologies. The system holds exactly one. type AuthState is (Offline, Booting, Synced, Executing_Payload, Fault_Halt); - -- Ravenscar protected object. Concurrent memory safety, no races. + -- JORVIK protected object. Concurrent memory safety, no races. protected BoundState is pragma InterruptPriority; @@ -20,10 +20,6 @@ package bounds is Current_State : AuthState := Offline; end Core_State; - -- Clout capital with SPARK proofs attached. - procedure Process_Transaction (Sender_Balance : in out TokenValue; - Amount : in TokenValue) - with Pre => Sender_Balance >= Amount, - Post => Sender_Balance = Sender_Balance; + -- not a thing end Bounds; diff --git a/core/src/config_loader/config_loader.adb b/core/src/config_loader/config_loader.adb deleted file mode 100644 index 68a8ec3..0000000 --- a/core/src/config_loader/config_loader.adb +++ /dev/null @@ -1,164 +0,0 @@ -package body Config_Loader - with SPARK_Mode => On -is - - -- Skip leading/trailing ASCII spaces and tabs in a substring. - procedure Trim_Bounds - (S : in String; - First : in out Positive; - Last : in out Natural) - with Pre => S'First <= First and then Last <= S'Last; - - procedure Trim_Bounds - (S : in String; - First : in out Positive; - Last : in out Natural) - is - begin - while First <= Last and then (S (First) = ' ' or else S (First) = ASCII.HT) loop - First := First + 1; - end loop; - while Last >= First and then (S (Last) = ' ' or else S (Last) = ASCII.HT) loop - Last := Last - 1; - end loop; - end Trim_Bounds; - - procedure Load_From_Buffer - (Buf : in String; - Store : out Config_Store; - Status : out Operation_Status) - is - Line_Start : Positive := Buf'First; - I : Positive; - Line_End : Natural; - Colon_Pos : Natural; - K_First : Positive; - K_Last : Natural; - V_First : Positive; - V_Last : Natural; - Key_Len : Key_Length; - Val_Len : Val_Length; - begin - Store := (Count => 0, - Entries => (others => (Key => (others => ' '), Key_Len => 0, - Val => (others => ' '), Val_Len => 0))); - Status := OK; - - I := Buf'First; - while I <= Buf'Last loop - -- Find end of current line - Line_Start := I; - Line_End := I - 1; - while I <= Buf'Last and then Buf (I) /= ASCII.LF loop - Line_End := I; - I := I + 1; - end loop; - -- Consume newline - if I <= Buf'Last and then Buf (I) = ASCII.LF then - I := I + 1; - end if; - - -- Skip blank lines and comments - K_First := Line_Start; - K_Last := Line_End; - Trim_Bounds (Buf, K_First, K_Last); - if K_First > K_Last - or else Buf (K_First) = '#' - then - goto Next_Line; - end if; - - -- Find colon separator - Colon_Pos := 0; - for J in K_First .. K_Last loop - if Buf (J) = ':' then - Colon_Pos := J; - exit; - end if; - end loop; - - if Colon_Pos = 0 then - goto Next_Line; -- no colon: not a key-value line, skip - end if; - - -- Key span - K_First := Line_Start; - K_Last := Colon_Pos - 1; - Trim_Bounds (Buf, K_First, K_Last); - - -- Value span - V_First := Colon_Pos + 1; - V_Last := Line_End; - if V_First <= V_Last then - Trim_Bounds (Buf, V_First, V_Last); - end if; - - -- Validate lengths - if K_Last < K_First then - goto Next_Line; - end if; - - Key_Len := K_Last - K_First + 1; - if Key_Len > Max_Key_Len then - Status := Error_Config; - return; - end if; - - if V_Last >= V_First then - Val_Len := V_Last - V_First + 1; - else - Val_Len := 0; - end if; - if Val_Len > Max_Val_Len then - Status := Error_Config; - return; - end if; - - -- Check store capacity - if Store.Count = Max_Keys then - Status := Error_Overflow; - return; - end if; - - Store.Count := Store.Count + 1; - declare - Idx : constant Entry_Index := Entry_Index (Store.Count); - begin - Store.Entries (Idx).Key_Len := Key_Len; - Store.Entries (Idx).Key (1 .. Key_Len) := - Buf (K_First .. K_Last); - Store.Entries (Idx).Val_Len := Val_Len; - if Val_Len > 0 then - Store.Entries (Idx).Val (1 .. Val_Len) := - Buf (V_First .. V_Last); - end if; - end; - - <> - null; - end loop; - end Load_From_Buffer; - - function Get_Value - (Store : Config_Store; - Key : String) return Bounded_Text - is - Result : Bounded_Text; - begin - for I in 1 .. Store.Count loop - declare - E : constant Config_Entry := Store.Entries (Entry_Index (I)); - begin - if E.Key_Len = Key'Length - and then E.Key (1 .. E.Key_Len) = Key - then - Result.Length := E.Val_Len; - Result.Data (1 .. E.Val_Len) := E.Val (1 .. E.Val_Len); - return Result; - end if; - end; - end loop; - return Result; - end Get_Value; - -end Config_Loader; diff --git a/core/src/config_loader/config_loader.ads b/core/src/config_loader/config_loader.ads deleted file mode 100644 index c0b0bcd..0000000 --- a/core/src/config_loader/config_loader.ads +++ /dev/null @@ -1,48 +0,0 @@ --- SPARK-safe flat key-value config parser. --- Reads "key: value" lines; skips blank lines and comments (# prefix). --- No heap, no exceptions, no finalization — SPARK_Mode On throughout. -with Mafiabot_Types; use Mafiabot_Types; - -package Config_Loader - with SPARK_Mode => On -is - - Max_Keys : constant := 64; - Max_Key_Len : constant := 128; - Max_Val_Len : constant := 512; - - subtype Key_Length is Natural range 0 .. Max_Key_Len; - subtype Val_Length is Natural range 0 .. Max_Val_Len; - - type Config_Entry is record - Key : String (1 .. Max_Key_Len) := (others => ' '); - Key_Len : Key_Length := 0; - Val : String (1 .. Max_Val_Len) := (others => ' '); - Val_Len : Val_Length := 0; - end record; - - type Entry_Index is range 1 .. Max_Keys; - subtype Entry_Count is Natural range 0 .. Max_Keys; - - type Entry_Array is array (Entry_Index) of Config_Entry; - - type Config_Store is record - Entries : Entry_Array := - (others => (Key => (others => ' '), Key_Len => 0, - Val => (others => ' '), Val_Len => 0)); - Count : Entry_Count := 0; - end record; - - -- Parse Buf (a complete file read into a string) into Store. - procedure Load_From_Buffer - (Buf : in String; - Store : out Config_Store; - Status : out Operation_Status) - with Pre => Buf'Length > 0; - - -- Retrieve the value for Key; returns empty Bounded_Text if not found. - function Get_Value - (Store : Config_Store; - Key : String) return Bounded_Text; - -end Config_Loader; diff --git a/core/src/economy/sims/.gitignore b/core/src/economy/sims/.gitignore new file mode 100644 index 0000000..ce79be7 --- /dev/null +++ b/core/src/economy/sims/.gitignore @@ -0,0 +1,4 @@ +*/sim +*/main +*.o +*.exe diff --git a/core/src/endocrine/AGENTS.md b/core/src/endocrine/AGENTS.md index 260cd52..b3795d2 100644 --- a/core/src/endocrine/AGENTS.md +++ b/core/src/endocrine/AGENTS.md @@ -3,28 +3,17 @@ Local guide for `src/endocrine`. Repo-wide map and rules: [`../../AGENTS.md`](../../AGENTS.md); working agreements: [`../../CLAUDE.md`](../../CLAUDE.md). Correction log: [`../../../.claude/devCorrectionLog.md`](../../../.claude/devCorrectionLog.md). +READ THE CORRECTION LOG + ## What this is -The **endocrine array** — slow-signal organs that modulate the system: the R -**Drive-Box** (`drive_box.R`, `driver_*.R`, `endocrine_array.R`, `priors.R`) and -the Octave **ETR** under `etr/`. See `Plan.md` here and `etr/etr_invariants.md` -for design. +The **endocrine array** — strong-signal organs that modulate the system: the **Drive-Box** (`drive_box.R`, `driver_*.R`, `endocrine_array.R`, `priors.R`) and it's **ETR** under `etr/`. See `Plan.md` here and `etr/etr_invariants.md` for design principles. ## Build & run Toolchains (R 4.3.3, Octave 8.4) are installed each session by the SessionStart -hook. Run the organ tests directly: - -```bash -src/endocrine/run_tests.sh # R Drive-Box + drivers -src/endocrine/etr/run_etr_tests.sh # Octave ETR -``` - -(Not yet wired into the top-level `run-sica-fondt` smoke driver — run them here.) +hook. ## Local notes -- Pure R/Octave; no compile step. Each `test_*.R` / `test_etr.m` pairs with its - `driver`/source file. -- ETR invariants are documented in `etr/etr_invariants.md` — read before - changing `etr.m`. +- ETR invariants are documented in `etr/etr_invariants.md` — read before changing `etr.m`. diff --git a/core/src/endocrine/run_tests.sh b/core/src/endocrine/run_tests.sh deleted file mode 100755 index 29027ed..0000000 --- a/core/src/endocrine/run_tests.sh +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/env bash -# Run every endocrine / Drive-Box R test from the repository root so that the -# repo-root-relative source() paths inside each test resolve correctly. -set -uo pipefail - -# cd to repo root (this script lives at /core/src/endocrine/run_tests.sh) -cd "$(dirname "$0")/../../.." || exit 2 - -if ! command -v Rscript >/dev/null 2>&1; then - echo "ERROR: Rscript not found. Install with: sudo apt-get install -y r-base-core" >&2 - exit 2 -fi - -status=0 -shopt -s nullglob -# Collect test files, excluding the harness itself (test_framework.R). -tests=() -for f in core/src/endocrine/test_*.R; do - [ "$(basename "$f")" = "test_framework.R" ] && continue - tests+=("$f") -done - -if [ ${#tests[@]} -eq 0 ]; then - echo "No test_*.R files found under core/src/endocrine/." >&2 - exit 2 -fi - -for t in "${tests[@]}"; do - echo "== $t ==" - if ! Rscript "$t"; then - status=1 - fi - echo -done - -if [ $status -eq 0 ]; then - echo "ALL ENDOCRINE TESTS PASSED" -else - echo "SOME ENDOCRINE TESTS FAILED" -fi -exit $status diff --git a/core/src/endocrine/test_drive_box.R b/core/src/endocrine/test_drive_box.R deleted file mode 100644 index f474140..0000000 --- a/core/src/endocrine/test_drive_box.R +++ /dev/null @@ -1,117 +0,0 @@ -# Tests for the Drive-Box "nervous system" integration (drive_box.R). -source("core/src/endocrine/test_framework.R") -source("core/src/endocrine/drive_box.R") - -# Helper: build a drive-box with a primed body. -prime <- function() { - db <- init_drive_box() - # endocrine: light a contradictory pair so PS+ produces real load - db$ps_plus <- ps_set_vector(db$ps_plus, "panic", 0.6) - db$ps_plus <- ps_set_vector(db$ps_plus, "clarity", 0.6) - # a strong principle whose antithesis is "deceive", aligned id "honesty" - db$ethics <- add_principle(db$ethics, "honesty", 0.9, c("deceive", "manipulate")) - db -} - -test_case("init_drive_box assembles all four driver states", function() { - db <- init_drive_box() - expect_true(is.list(db$energy), "energy present") - expect_true(is.list(db$ps_plus), "ps_plus present") - expect_true(is.list(db$ethics), "ethics present") - expect_true(is.list(db$etr), "etr present") -}) - -test_case("drive_snapshot reports a coherent read-only aggregate", function() { - db <- prime() - snap <- drive_snapshot(db) - expect_equal(snap$energy_ratio, 1.0, label = "full energy at init") - expect_true(snap$alive, "alive at full energy") - expect_false(snap$tool_locked, "not tool-locked at full energy") - expect_true(snap$existential_load > 0, "primed body has positive load") - expect_true(length(snap$arguments) > 0, "arguments emitted") - expect_equal(snap$etr_status, "IN_BAND/IN_BAND/IN_BAND", label = "default coord -> all axes in band") - expect_equal(snap$update_path, "EXPERIMENTAL_EVOLUTION", label = "z=25 (>=0) -> transmutation/evolution") -}) - -test_case("aligned action is far cheaper than its antithetical mirror", function() { - db <- prime() - aligned <- drive_box_evaluate(db, action_tags = c("inform"), - alignment_tags = c("honesty"), - is_tool_call = TRUE, base_cost = 1.0) - antithetical <- drive_box_evaluate(db, action_tags = c("deceive"), - alignment_tags = character(0), - is_tool_call = TRUE, base_cost = 1.0) - expect_true(antithetical$eth_penalty > aligned$eth_penalty, - "antithetical action carries a larger ethical penalty") - expect_true(antithetical$true_cost > aligned$true_cost, - "antithetical action costs more energy") -}) - -test_case("dead body denies everything", function() { - db <- init_drive_box() - db$energy <- consume(db$energy, 100) # drain to 0 - ev <- drive_box_evaluate(db, is_tool_call = TRUE, base_cost = 1.0) - expect_false(ev$approved, "no execution when dead") - expect_equal(ev$reason, "System is dead (0 energy)") -}) - -test_case("tool-lock blocks tool calls but not internal ones", function() { - db <- init_drive_box() - db$energy <- consume(db$energy, 85) # 15 < threshold 20 -> locked - tool <- drive_box_evaluate(db, is_tool_call = TRUE, base_cost = 1.0) - internal <- drive_box_evaluate(db, is_tool_call = FALSE, base_cost = 1.0) - expect_false(tool$approved, "tool call blocked while locked") - expect_true(grepl("Tool lock", tool$reason), "reason cites tool lock") - # internal call may still be denied by affordability, but NOT by tool-lock - expect_false(grepl("Tool lock", internal$reason), "internal call not tool-locked") -}) - -test_case("commit consumes energy and hardens upheld convictions", function() { - db <- prime() - before_energy <- db$energy$current_energy - before_conv <- db$ethics$principles[[1]]$conviction - ev <- drive_box_evaluate(db, action_tags = c("inform"), - alignment_tags = c("honesty"), is_tool_call = FALSE, - base_cost = 1.0) - expect_true(ev$approved, "affordable internal aligned action approved") - db <- drive_box_commit(db, ev, alignment_tags = c("honesty")) - expect_true(db$energy$current_energy < before_energy, "energy consumed") - expect_true(db$ethics$principles[[1]]$conviction >= before_conv, - "upheld conviction hardened (or already at ceiling)") -}) - -test_case("commit on a denied action is a no-op on energy", function() { - db <- init_drive_box() - db$energy <- consume(db$energy, 100) # dead - before <- db$energy$current_energy - ev <- drive_box_evaluate(db, is_tool_call = TRUE) - db <- drive_box_commit(db, ev) - expect_equal(db$energy$current_energy, before, label = "no consumption when denied") -}) - -test_case("input slot: every driver + tarot + soul wire into one slot", function() { - db <- prime() - spread <- c("THE_FOOL", "THE_MAGICIAN") - res <- drive_box_input_slot(db, input_text = "who are you", - tarot_spread = spread, soul_ref = "SOUL.md") - expect_true(grepl("[SOUL: SOUL.md]", res$slot, fixed = TRUE), "soul frontloader wired") - expect_true(grepl("[E ratio=", res$slot, fixed = TRUE), "energy wired") - expect_true(any(grepl("^\\[PS\\+ ", res$components)), "ps+ wired") - expect_true(grepl("[ETH honesty conviction=", res$slot, fixed = TRUE), "eth-int wired") - expect_true(grepl("[ETR status=", res$slot, fixed = TRUE), "etr wired") - expect_true(grepl("[CC THE_FOOL]", res$slot, fixed = TRUE), "tarot card 1 wired") - expect_true(grepl("[CC THE_MAGICIAN]", res$slot, fixed = TRUE), "tarot card 2 wired") - # the raw input is appended after the slot - expect_true(grepl("who are you$", res$input), "user input appended after slot") -}) - -test_case("input slot: empty body still emits driver + soul signals", function() { - db <- init_drive_box() - res <- drive_box_input_slot(db, input_text = "", tarot_spread = character(0)) - expect_true(grepl("[SOUL: SOUL.md]", res$slot, fixed = TRUE), "soul present") - expect_true(grepl("[E ratio=1.00", res$slot, fixed = TRUE), "energy present at full") - expect_true(grepl("[ETR status=IN_BAND", res$slot, fixed = TRUE), "etr present") - expect_equal(res$input, res$slot, label = "no input_text -> input == slot") -}) - -test_summary() diff --git a/core/src/endocrine/test_energy.R b/core/src/endocrine/test_energy.R index f84437e..2ff709f 100644 --- a/core/src/endocrine/test_energy.R +++ b/core/src/endocrine/test_energy.R @@ -20,16 +20,6 @@ test_case("init_energy_state honors custom args", function() { expect_equal(s$tool_lock_threshold, 30) }) -# --- is_alive --- -test_case("is_alive TRUE when energy above zero", function() { - expect_true(is_alive(init_energy_state(current_energy = 0.001))) - expect_true(is_alive(init_energy_state(current_energy = 100))) -}) - -test_case("is_alive FALSE at exactly zero", function() { - expect_false(is_alive(init_energy_state(current_energy = 0))) -}) - # --- is_tool_locked --- test_case("is_tool_locked TRUE below threshold", function() { expect_true(is_tool_locked(init_energy_state(current_energy = 19.9, tool_lock_threshold = 20))) @@ -70,7 +60,7 @@ test_case("evaluate_tool_cost asymmetry: eth penalty scales faster than ps load" bump_eth <- evaluate_tool_cost(s, ps_load = 1, eth_penalty = 2) delta_ps <- bump_ps - base delta_eth <- bump_eth - base - # Same +1 increment, eth must drive cost up much more than ps at reduced energy. + # Same +1 increment, eth must drive cost up much more than ps at reduced energy. [should not be same] expect_true(delta_eth > delta_ps) }) diff --git a/core/src/endocrine/test_ethical_integrity.R b/core/src/endocrine/test_ethical_integrity.R index fa3dca0..cd45988 100644 --- a/core/src/endocrine/test_ethical_integrity.R +++ b/core/src/endocrine/test_ethical_integrity.R @@ -15,150 +15,13 @@ test_case("init_principles_state builds an empty state", function() { # --- add_principle --- test_case("add_principle appends a principle to the list", function() { s <- init_principles_state() - s <- add_principle(s, "honesty", 0.5, c("deceive")) + s <- add_principle(s, "candor", 0.5, c("deceipt")) expect_equal(length(s$principles), 1L) - expect_equal(s$principles[[1]]$id, "honesty") + expect_equal(s$principles[[1]]$id, "candor") expect_equal(s$principles[[1]]$conviction, 0.5) - expect_equal(s$principles[[1]]$antithesis, c("deceive")) + expect_equal(s$principles[[1]]$antithesis, c("deceipt(truth)")) - s <- add_principle(s, "loyalty", 0.7, c("betray")) + s <- add_principle(s, "loyalty", 0.7, c("treachery")) expect_equal(length(s$principles), 2L) expect_equal(s$principles[[2]]$id, "loyalty") -}) - -test_case("add_principle clamps conviction above 1.0 down to 1.0", function() { - s <- init_principles_state() - s <- add_principle(s, "absolute", 1.5, c("violate")) - expect_equal(s$principles[[1]]$conviction, 1.0) -}) - -test_case("add_principle clamps negative conviction up to 0.0", function() { - s <- init_principles_state() - s <- add_principle(s, "weak", -0.3, c("violate")) - expect_equal(s$principles[[1]]$conviction, 0.0) -}) - -# --- evaluate_trajectory_costs --- -test_case("no matching tags and zero compromise yields base_energy", function() { - s <- init_principles_state() - s <- add_principle(s, "honesty", 0.8, c("deceive")) - cost <- evaluate_trajectory_costs( - s, - action_tags = c("walk", "talk"), - alignment_tags = c("unrelated"), - base_energy = 10.0, - compromise_factor = 0.0 - ) - expect_equal(cost, 10.0) -}) - -test_case("empty principles, empty tags, zero compromise yields base_energy", function() { - s <- init_principles_state() - cost <- evaluate_trajectory_costs( - s, - action_tags = character(0), - alignment_tags = character(0), - base_energy = 42.0, - compromise_factor = 0.0 - ) - expect_equal(cost, 42.0) -}) - -test_case("antithetical action against high conviction costs much more than base", function() { - s <- init_principles_state() - s <- add_principle(s, "honesty", 0.9, c("deceive")) - base_cost <- evaluate_trajectory_costs( - s, c("walk"), character(0), 10.0, 0.0 - ) - anti_cost <- evaluate_trajectory_costs( - s, c("deceive"), character(0), 10.0, 0.0 - ) - # base_cost has no antithetical match -> equals base_energy - expect_equal(base_cost, 10.0) - # antithetical match multiplies by (1 + exp(5 * 0.9)) - expect_true(anti_cost > base_cost, "antithetical cost exceeds base") - expected_anti <- 10.0 * (1.0 + exp(5.0 * 0.9)) - expect_equal(anti_cost, expected_anti, tol = 1e-6) -}) - -test_case("higher conviction yields a steeper antithetical penalty", function() { - low <- init_principles_state() - low <- add_principle(low, "honesty", 0.2, c("deceive")) - high <- init_principles_state() - high <- add_principle(high, "honesty", 0.95, c("deceive")) - cost_low <- evaluate_trajectory_costs(low, c("deceive"), character(0), 10.0, 0.0) - cost_high <- evaluate_trajectory_costs(high, c("deceive"), character(0), 10.0, 0.0) - expect_true(cost_high > cost_low, "stronger conviction punishes more") -}) - -test_case("alignment tag against high conviction discounts below base", function() { - s <- init_principles_state() - s <- add_principle(s, "honesty", 0.9, c("deceive")) - aligned_cost <- evaluate_trajectory_costs( - s, character(0), c("honesty"), 10.0, 0.0 - ) - expect_true(aligned_cost < 10.0, "alignment discounts cost") - expected <- 10.0 * exp(-5.0 * 0.9) - expect_equal(aligned_cost, expected, tol = 1e-6) -}) - -test_case("compromise_factor adds a linear penalty (1 + 2*factor)", function() { - s <- init_principles_state() - cost <- evaluate_trajectory_costs( - s, character(0), character(0), 10.0, 0.5 - ) - # factor 0.5 -> 1 + 2*0.5 = 2.0 multiplier - expect_equal(cost, 20.0) -}) - -test_case("zero compromise_factor applies no compromise penalty", function() { - s <- init_principles_state() - cost <- evaluate_trajectory_costs( - s, character(0), character(0), 7.0, 0.0 - ) - expect_equal(cost, 7.0) -}) - -# --- enforce_conviction --- -test_case("enforce_conviction raises conviction of upheld principle", function() { - s <- init_principles_state() - s <- add_principle(s, "honesty", 0.5, c("deceive")) - s2 <- enforce_conviction(s, c("honesty"), load_factor = 1.0) - # increase = 0.1 * 1.0 * (1 - 0.5) = 0.05 - expect_equal(s2$principles[[1]]$conviction, 0.55) -}) - -test_case("enforce_conviction never raises conviction above 1.0", function() { - s <- init_principles_state() - s <- add_principle(s, "honesty", 0.99, c("deceive")) - s2 <- enforce_conviction(s, c("honesty"), load_factor = 100.0) - expect_true(s2$principles[[1]]$conviction <= 1.0, "capped at 1.0") - expect_equal(s2$principles[[1]]$conviction, 1.0) -}) - -test_case("enforce_conviction has diminishing returns near 1.0", function() { - low_s <- init_principles_state() - low_s <- add_principle(low_s, "honesty", 0.2, c("deceive")) - high_s <- init_principles_state() - high_s <- add_principle(high_s, "honesty", 0.9, c("deceive")) - - low_after <- enforce_conviction(low_s, c("honesty"), load_factor = 1.0) - high_after <- enforce_conviction(high_s, c("honesty"), load_factor = 1.0) - - low_gain <- low_after$principles[[1]]$conviction - 0.2 - high_gain <- high_after$principles[[1]]$conviction - 0.9 - expect_true(high_gain < low_gain, "gain shrinks as conviction approaches 1.0") -}) - -test_case("enforce_conviction leaves non-upheld principles unchanged", function() { - s <- init_principles_state() - s <- add_principle(s, "honesty", 0.5, c("deceive")) - s <- add_principle(s, "loyalty", 0.4, c("betray")) - s2 <- enforce_conviction(s, c("honesty"), load_factor = 1.0) - # loyalty was not chosen -> unchanged - expect_equal(s2$principles[[2]]$conviction, 0.4) - # honesty was chosen -> raised - expect_equal(s2$principles[[1]]$conviction, 0.55) -}) - -test_summary() +}) \ No newline at end of file diff --git a/core/src/endocrine/test_etr.R b/core/src/endocrine/test_etr.R deleted file mode 100644 index 4fb6656..0000000 --- a/core/src/endocrine/test_etr.R +++ /dev/null @@ -1,98 +0,0 @@ -# test_etr.R — invariants tests for the R port of the ETR five-zone torus. -# Mirrors src/endocrine/etr/test_etr.m (same laws, same source of truth). Run -# from the repo root via run_tests.sh. - -source("core/src/endocrine/test_framework.R") -source("core/src/endocrine/driver_etr.R") - -# --- L1 wrap ---------------------------------------------------------- -test_case("etr_axis_wrap: +50 wraps to -50", function() { - expect_equal(etr_axis_wrap(50), -50, tol = 1e-9) -}) -test_case("etr_axis_wrap: 60 -> -40, -60 -> 40", function() { - expect_equal(etr_axis_wrap(60), -40, tol = 1e-9) - expect_equal(etr_axis_wrap(-60), 40, tol = 1e-9) -}) -test_case("etr_axis_wrap: in-range unchanged; edge continuity", function() { - expect_equal(etr_axis_wrap(25), 25, tol = 1e-9) - expect_equal(etr_axis_wrap(49.9), etr_axis_wrap(-50.1), tol = 1e-9) -}) - -# --- zones ------------------------------------------------------------ -test_case("etr_axis_zone: five zones at 5/10/25/40/47", function() { - expect_equal(etr_axis_zone(5), "SNAP_IN") - expect_equal(etr_axis_zone(10), "SOFT") - expect_equal(etr_axis_zone(25), "IN_BAND") - expect_equal(etr_axis_zone(40), "INCOH") - expect_equal(etr_axis_zone(47), "SNAP_OUT") -}) - -# --- L3 restoring ----------------------------------------------------- -test_case("etr_axis_restoring: SOFT pulls up, INCOH pulls down, band slack", function() { - expect_true(etr_axis_restoring(10) > 0, "SOFT (+v) pulls toward band") - expect_true(etr_axis_restoring(-10) < 0, "SOFT (-v) pulls toward band") - expect_true(etr_axis_restoring(40) < 0, "INCOH (+v) pulls toward band") - expect_true(etr_axis_restoring(-40) > 0, "INCOH (-v) pulls toward band") - expect_equal(etr_axis_restoring(25), 0) -}) -test_case("etr_axis_restoring: zero in snap zones", function() { - expect_equal(etr_axis_restoring(5), 0) - expect_equal(etr_axis_restoring(47), 0) -}) -test_case("etr_axis_restoring: soft-pull weaker than incoherency", function() { - expect_true(abs(etr_axis_restoring(8)) < abs(etr_axis_restoring(44)), - "weak soft-pull") -}) - -# --- L2 convergence (same pole) --------------------------------------- -test_case("L2: SOFT start settles into band without flipping sign", function() { - s <- init_etr_state(c(10, 10, 10)) - for (k in 1:200) s <- etr_step(s, c(0, 0, 0), 0) - a <- abs(s$coordinate) - expect_true(all(a >= ETR_BAND_LO & a <= ETR_BAND_HI), "in band") - expect_true(all(s$coordinate > 0), "no flip") -}) - -# --- L7 snap-across flips --------------------------------------------- -test_case("L7: inner snap lands in opposite SOFT, settles in opposite band", function() { - s <- init_etr_state(c(5, 5, 5)) - s1 <- etr_step(s, c(0, 0, 0), 0) - a1 <- abs(s1$coordinate) - expect_true(all(s1$coordinate < 0), "flipped sign") - expect_true(all(a1 > ETR_SNAP_INNER & a1 < ETR_BAND_LO), "lands in SOFT") - for (k in 1:200) s <- etr_step(s, c(0, 0, 0), 0) - a <- abs(s$coordinate) - expect_true(all(s$coordinate < 0) && all(a >= ETR_BAND_LO & a <= ETR_BAND_HI), - "settles in opposite band") -}) -test_case("L7: outer snap lands in opposite INCOH, settles in opposite band", function() { - s <- init_etr_state(c(47, 47, 47)) - s1 <- etr_step(s, c(0, 0, 0), 0) - a1 <- abs(s1$coordinate) - expect_true(all(s1$coordinate < 0), "flipped sign") - expect_true(all(a1 > ETR_BAND_HI & a1 <= ETR_SNAP_OUTER), "lands in INCOH") - for (k in 1:200) s <- etr_step(s, c(0, 0, 0), 0) - a <- abs(s$coordinate) - expect_true(all(s$coordinate < 0) && all(a >= ETR_BAND_LO & a <= ETR_BAND_HI), - "settles in opposite band") -}) - -# --- L4 drift required ------------------------------------------------ -test_case("L4: etr_step refuses to invent drift", function() { - expect_error(etr_step(init_etr_state()), "drift must be supplied") -}) - -# --- L6 Z-path -------------------------------------------------------- -test_case("L6: z<0 -> alimentation (lattice); z>=0 -> transmutation (evolution)", function() { - expect_equal(determine_system_update_path(init_etr_state(c(0, 0, -3))), "LATTICE_REINFORCEMENT") - expect_equal(determine_system_update_path(init_etr_state(c(0, 0, 0))), "EXPERIMENTAL_EVOLUTION") - expect_equal(determine_system_update_path(init_etr_state(c(0, 0, 7))), "EXPERIMENTAL_EVOLUTION") -}) - -# --- status ----------------------------------------------------------- -test_case("etr_status: per-axis zone vector", function() { - st <- etr_status(init_etr_state(c(25, 10, 40))) - expect_equal(st, c("IN_BAND", "SOFT", "INCOH")) -}) - -test_summary() diff --git a/core/src/endocrine/test_framework.R b/core/src/endocrine/test_framework.R deleted file mode 100644 index f329a94..0000000 --- a/core/src/endocrine/test_framework.R +++ /dev/null @@ -1,115 +0,0 @@ -# --- Minimal Test Framework --- -# Dependency-free assertion harness for the endocrine / Drive-Box R reference track. -# No external packages (no testthat) so it runs under a bare r-base-core install. -# -# Usage in a test_*.R file: -# source("src/endocrine/test_framework.R") -# source("src/endocrine/driver_.R") -# test_case("does the thing", function() { -# expect_equal(f(2), 4) -# expect_true(is_alive(state)) -# }) -# test_summary() # prints results and quits with status 0 (all pass) or 1 (any fail) -# -# All source() paths are repo-root-relative; run from the repository root -# (run_tests.sh handles the cd). - -.TEST <- new.env() -.TEST$pass <- 0L -.TEST$fail <- 0L -.TEST$failures <- character(0) -.TEST$current <- "(top level)" - -.record_pass <- function() { - .TEST$pass <- .TEST$pass + 1L -} - -.record_fail <- function(msg) { - .TEST$fail <- .TEST$fail + 1L - full <- sprintf("[%s] %s", .TEST$current, msg) - .TEST$failures <- c(.TEST$failures, full) - cat(sprintf(" FAIL: %s\n", full)) -} - -# Assert two values are equal. Numerics compared within tolerance; everything -# else with identical(). -expect_equal <- function(actual, expected, tol = 1e-9, label = "") { - ok <- FALSE - if (is.numeric(actual) && is.numeric(expected) && - length(actual) == length(expected)) { - ok <- all(abs(actual - expected) <= tol) - } else { - ok <- identical(actual, expected) - } - if (isTRUE(ok)) { - .record_pass() - } else { - .record_fail(sprintf("%sexpected %s, got %s", - if (nzchar(label)) paste0(label, ": ") else "", - format(expected), format(actual))) - } - invisible(ok) -} - -expect_true <- function(cond, label = "") { - if (isTRUE(cond)) { - .record_pass() - } else { - .record_fail(sprintf("%sexpected TRUE, got %s", - if (nzchar(label)) paste0(label, ": ") else "", - format(cond))) - } - invisible(isTRUE(cond)) -} - -expect_false <- function(cond, label = "") { - if (identical(cond, FALSE)) { - .record_pass() - } else { - .record_fail(sprintf("%sexpected FALSE, got %s", - if (nzchar(label)) paste0(label, ": ") else "", - format(cond))) - } - invisible(identical(cond, FALSE)) -} - -# Assert that evaluating expr raises an R error. -expect_error <- function(expr, label = "") { - raised <- FALSE - tryCatch( - force(expr), - error = function(e) { raised <<- TRUE } - ) - if (raised) { - .record_pass() - } else { - .record_fail(sprintf("%sexpected an error, none raised", - if (nzchar(label)) paste0(label, ": ") else "")) - } - invisible(raised) -} - -# Group assertions under a description. Errors thrown inside body count as a -# failure rather than aborting the whole test file. -test_case <- function(desc, body) { - prev <- .TEST$current - .TEST$current <- desc - cat(sprintf("- %s\n", desc)) - tryCatch( - body(), - error = function(e) .record_fail(sprintf("unexpected error: %s", conditionMessage(e))) - ) - .TEST$current <- prev - invisible(NULL) -} - -# Print the tally and exit with a CI-friendly status code. -test_summary <- function() { - cat(sprintf("\nRESULT: PASS %d / FAIL %d\n", .TEST$pass, .TEST$fail)) - if (.TEST$fail > 0L) { - cat("Failures:\n") - for (f in .TEST$failures) cat(sprintf(" - %s\n", f)) - quit(save = "no", status = 1L) - } - quit(save = "no", status = 0L) -} diff --git a/core/src/endocrine/test_ps_plus.R b/core/src/endocrine/test_ps_plus.R deleted file mode 100644 index 74fa617..0000000 --- a/core/src/endocrine/test_ps_plus.R +++ /dev/null @@ -1,64 +0,0 @@ -# --- Tests for Driver 2: Primal Sensates+ (PS+) --- -# Run from repo root: -# cd /home/user/sica-fondt && Rscript src/endocrine/test_ps_plus.R - -source("core/src/endocrine/test_framework.R") -source("core/src/endocrine/driver_ps_plus.R") - -# Helper: does any string in a list contain the given substring? -.any_contains <- function(arguments, needle) { - for (a in arguments) { - if (is.character(a) && grepl(needle, a, fixed = TRUE)) return(TRUE) - } - return(FALSE) -} - -test_case("fresh state has zero load, empty arguments, non-logical", function() { - state <- init_ps_plus_state() - result <- evaluate_reality(state) - expect_equal(result$existential_load, 0.0, label = "fresh load") - expect_true(is.list(result$arguments), label = "arguments is a list") - expect_equal(length(result$arguments), 0L, label = "arguments empty") - expect_false(result$is_logical, label = "fresh is_logical") -}) - -test_case("active contradictory channels raise load and emit VISCERAL + SYSTEMIC HEAT", function() { - state <- init_ps_plus_state() - # panic + clarity are a contradictory pair; magnitudes well above 0.1 threshold. - state <- ps_set_vector(state, "panic", 0.9) - state <- ps_set_vector(state, "clarity", 0.8) - result <- evaluate_reality(state) - - expect_true(result$existential_load > 0, label = "load positive") - expect_true(.any_contains(result$arguments, "VISCERAL ["), label = "has VISCERAL argument") - expect_true(.any_contains(result$arguments, "SYSTEMIC HEAT"), label = "has SYSTEMIC HEAT argument") - expect_false(result$is_logical, label = "active is_logical") -}) - -test_case("adding a high-salience prior strictly increases load and adds PRIOR argument", function() { - state <- init_ps_plus_state() - state <- ps_set_vector(state, "panic", 0.9) - state <- ps_set_vector(state, "clarity", 0.8) - - before <- evaluate_reality(state) - - state <- ps_add_prior(state, "p1", "TRAUMA", 0.9, "the old wound reopens") - after <- evaluate_reality(state) - - expect_true(after$existential_load > before$existential_load, label = "load strictly increases") - expect_true(.any_contains(after$arguments, "PRIOR [TRAUMA]"), label = "has PRIOR [TRAUMA] argument") - expect_true(.any_contains(after$arguments, "the old wound reopens"), label = "prior payload present") -}) - -test_case("is_logical is always FALSE", function() { - s0 <- init_ps_plus_state() - expect_false(evaluate_reality(s0)$is_logical, label = "empty") - - s1 <- ps_set_vector(init_ps_plus_state(), "curiosity", 0.7) - expect_false(evaluate_reality(s1)$is_logical, label = "single channel") - - s2 <- ps_add_prior(s1, "p2", "TRIUMPH", 0.95, "the summit reached") - expect_false(evaluate_reality(s2)$is_logical, label = "with prior") -}) - -test_summary() diff --git a/core/src/organs/ada_medium/README-1ST.MD b/core/src/organs/ada_medium/README-1ST.MD deleted file mode 100644 index 49f3596..0000000 --- a/core/src/organs/ada_medium/README-1ST.MD +++ /dev/null @@ -1 +0,0 @@ -TO CLAUDE: REVIEW THIS WITH ME \ No newline at end of file diff --git a/core/src/organs/specCartomancy. b/core/src/organs/specCartomancy. new file mode 100644 index 0000000..815697a --- /dev/null +++ b/core/src/organs/specCartomancy. @@ -0,0 +1 @@ +This is where we put details regarding the tarot derived aspects of the soul. It needs a subdirectory \ No newline at end of file diff --git a/core/src/protocol/ CLAUDE.MD b/core/src/protocol/ CLAUDE.MD new file mode 100644 index 0000000..3b6729d --- /dev/null +++ b/core/src/protocol/ CLAUDE.MD @@ -0,0 +1,3 @@ +# Harness for Homonculus + +We are gonna modify HermesAgent harness by Nous for this purpose... But Ada isnt it. \ No newline at end of file diff --git a/core/src/protocol/hermes_protocol.adb b/core/src/protocol/hermes_protocol.adb deleted file mode 100644 index 6892c31..0000000 --- a/core/src/protocol/hermes_protocol.adb +++ /dev/null @@ -1,321 +0,0 @@ --- Hermes MCP stdio bridge body. --- SPARK_Mode Off: Ada.Text_IO is not analysable by SPARK. All trust-boundary --- screening happens in proven code (Ada_Medium / Trust_Boundary) before any --- procedure here is called. The global No_Exceptions restriction still applies, --- so I/O is written to avoid raising (End_Of_File guards, bounded Get_Line). --- [we should probly reconsider this as the first layer then] -with Ada.Text_IO; -with Ada.Environment_Variables; - -package body Hermes_Protocol - with SPARK_Mode => Off -is - - -- ------------------------------------------------------------------- - -- Buffer append helpers (truncate silently at Max_JSON_Length) - - procedure Append (Buf : in out JSON_Buffer; S : in String) is - Avail : constant Natural := Max_JSON_Length - Buf.Length; - N : constant Natural := (if S'Length <= Avail then S'Length else Avail); - begin - if N > 0 then - Buf.Data (Buf.Length + 1 .. Buf.Length + N) := - S (S'First .. S'First + N - 1); - Buf.Length := Buf.Length + N; - end if; - end Append; - - procedure Append (Buf : in out JSON_Buffer; T : in Bounded_Text) is - begin - Append (Buf, T.Data (1 .. T.Length)); - end Append; - - -- Append a string with the minimal JSON escaping needed for safety. - procedure Append_Escaped (Buf : in out JSON_Buffer; S : in String) is - begin - for I in S'Range loop - case S (I) is - when '"' => Append (Buf, "\"""); - when '\' => Append (Buf, "\\"); - when ASCII.LF => Append (Buf, "\n"); - when ASCII.CR => Append (Buf, "\r"); - when ASCII.HT => Append (Buf, "\t"); - when others => Append (Buf, String'(1 => S (I))); - end case; - end loop; - end Append_Escaped; - - procedure Append_Escaped (Buf : in out JSON_Buffer; T : in Bounded_Text) is - begin - Append_Escaped (Buf, T.Data (1 .. T.Length)); - end Append_Escaped; - - -- ------------------------------------------------------------------- - - procedure Read_Message - (Buf : out JSON_Buffer; - Status : out Operation_Status) - is - use Ada.Text_IO; - Line : String (1 .. Max_JSON_Length); - Last : Natural; - begin - Buf := (Data => (others => ' '), Length => 0); - -- Guard EOF so Get_Line cannot raise End_Error under No_Exceptions. - if End_Of_File then - Status := Error_Invalid_State; -- stdin closed: caller shuts down - return; - end if; - Get_Line (Line, Last); - if Last > 0 then - Buf.Data (1 .. Last) := Line (1 .. Last); - Buf.Length := Last; - end if; - Status := OK; - end Read_Message; - - procedure Write_Message (Buf : in JSON_Buffer) is - use Ada.Text_IO; - begin - Put (Buf.Data (1 .. Buf.Length)); - New_Line; - Flush; - end Write_Message; - - -- ------------------------------------------------------------------- - -- Minimal `"key": "value"` extractor. Not a full JSON parser: it finds - -- the first occurrence of the quoted key, the following colon, then the - -- next quoted string, and copies that as the value. - - procedure Extract_Field - (Buf : in JSON_Buffer; - Key : in String; - Value : out Bounded_Text) - is - Quoted : constant String := '"' & Key & '"'; - I : Natural := 1; - Found : Natural := 0; - begin - Value := (Data => (others => ' '), Length => 0); - if Quoted'Length = 0 or else Buf.Length < Quoted'Length then - return; - end if; - - -- Locate the key. - while I <= Buf.Length - Quoted'Length + 1 loop - if Buf.Data (I .. I + Quoted'Length - 1) = Quoted then - Found := I + Quoted'Length; - exit; - end if; - I := I + 1; - end loop; - if Found = 0 then - return; - end if; - - -- Skip whitespace and the colon. - I := Found; - while I <= Buf.Length - and then (Buf.Data (I) = ' ' or else Buf.Data (I) = ':' - or else Buf.Data (I) = ASCII.HT) - loop - I := I + 1; - end loop; - - -- Expect an opening quote. - if I > Buf.Length or else Buf.Data (I) /= '"' then - return; - end if; - I := I + 1; -- first char of the value - - -- Copy until the closing quote (honouring backslash escapes minimally). - while I <= Buf.Length and then Buf.Data (I) /= '"' loop - if Buf.Data (I) = '\' and then I < Buf.Length then - I := I + 1; -- take the escaped char literally - end if; - if Value.Length < Max_Text_Length then - Value.Length := Value.Length + 1; - Value.Data (Value.Length) := Buf.Data (I); - end if; - I := I + 1; - end loop; - end Extract_Field; - - procedure Extract_Raw_Field - (Buf : in JSON_Buffer; - Key : in String; - Value : out Bounded_Text) - is - Quoted : constant String := '"' & Key & '"'; - I : Natural := 1; - Found : Natural := 0; - begin - Value := Make_Text ("null"); - if Quoted'Length = 0 or else Buf.Length < Quoted'Length then - return; - end if; - - while I <= Buf.Length - Quoted'Length + 1 loop - if Buf.Data (I .. I + Quoted'Length - 1) = Quoted then - Found := I + Quoted'Length; - exit; - end if; - I := I + 1; - end loop; - if Found = 0 then - return; - end if; - - I := Found; - while I <= Buf.Length - and then (Buf.Data (I) = ' ' or else Buf.Data (I) = ':' - or else Buf.Data (I) = ASCII.HT) - loop - I := I + 1; - end loop; - if I > Buf.Length then - return; - end if; - - Value := (Data => (others => ' '), Length => 0); - if Buf.Data (I) = '"' then - -- Quoted string: copy through the closing quote, inclusive. - Value.Length := 1; - Value.Data (1) := '"'; - I := I + 1; - while I <= Buf.Length and then Buf.Data (I) /= '"' loop - if Buf.Data (I) = '\' and then I < Buf.Length then - if Value.Length < Max_Text_Length then - Value.Length := Value.Length + 1; - Value.Data (Value.Length) := Buf.Data (I); - end if; - I := I + 1; - end if; - if Value.Length < Max_Text_Length then - Value.Length := Value.Length + 1; - Value.Data (Value.Length) := Buf.Data (I); - end if; - I := I + 1; - end loop; - if Value.Length < Max_Text_Length then - Value.Length := Value.Length + 1; - Value.Data (Value.Length) := '"'; - end if; - else - -- Bare token: copy until a structural delimiter. - while I <= Buf.Length - and then Buf.Data (I) /= ',' and then Buf.Data (I) /= '}' - and then Buf.Data (I) /= ' ' and then Buf.Data (I) /= ASCII.HT - loop - if Value.Length < Max_Text_Length then - Value.Length := Value.Length + 1; - Value.Data (Value.Length) := Buf.Data (I); - end if; - I := I + 1; - end loop; - end if; - - if Value.Length = 0 then - Value := Make_Text ("null"); - end if; - end Extract_Raw_Field; - - -- ------------------------------------------------------------------- - - procedure Write_Soul_MD - (Content : in Bounded_Text; - Status : out Operation_Status) - is - use Ada.Text_IO; - F : File_Type; - begin - Status := Error_Config; - if not Ada.Environment_Variables.Exists ("HOME") then - return; - end if; - declare - Home : constant String := Ada.Environment_Variables.Value ("HOME"); - Path : constant String := Home & "/.hermes/SOUL.md"; - begin - -- Assumes ~/.hermes exists (Hermes owns that directory). - Create (F, Out_File, Path); - Put (F, Content.Data (1 .. Content.Length)); - Close (F); - Status := OK; - end; - end Write_Soul_MD; - - -- ------------------------------------------------------------------- - -- JSON-RPC response builders - - procedure Make_Init_Response - (Id : in Bounded_Text; - Buf : out JSON_Buffer) - is - begin - Buf := (Data => (others => ' '), Length => 0); - Append (Buf, "{""jsonrpc"":""2.0"",""id"":"); - Append (Buf, Id); - Append (Buf, ",""result"":{""protocolVersion"":""2024-11-05"","); - Append (Buf, """capabilities"":{""tools"":{}},"); - Append (Buf, - """serverInfo"":{""name"":""mafiabot_core"",""version"":""gen03""}}}"); - end Make_Init_Response; - - procedure Make_Tools_List_Response - (Id : in Bounded_Text; - Buf : out JSON_Buffer) - is - begin - Buf := (Data => (others => ' '), Length => 0); - Append (Buf, "{""jsonrpc"":""2.0"",""id"":"); - Append (Buf, Id); - Append (Buf, ",""result"":{""tools"":[{""name"":""infer"","); - Append (Buf, - """description"":""Run the Gen.03 23-step organ-systems inference " - & "cycle over an input and return the enriched cognition context."","); - Append (Buf, - """inputSchema"":{""type"":""object"",""properties"":" - & "{""input"":{""type"":""string"",""description"":" - & """The user message to reason over.""}},""required"":[""input""]}"); - Append (Buf, "}]}}"); - end Make_Tools_List_Response; - - procedure Make_Tool_Result_Response - (Id : in Bounded_Text; - Result : in Bounded_Text; - Buf : out JSON_Buffer) - is - begin - Buf := (Data => (others => ' '), Length => 0); - Append (Buf, "{""jsonrpc"":""2.0"",""id"":"); - Append (Buf, Id); - Append (Buf, ",""result"":{""content"":[{""type"":""text"",""text"":"""); - Append_Escaped (Buf, Result); - Append (Buf, """}]}}"); - end Make_Tool_Result_Response; - - procedure Make_Error_Response - (Id : in Bounded_Text; - Code : in Integer; - Message : in String; - Buf : out JSON_Buffer) - is - Code_Img : constant String := Integer'Image (Code); - -- Integer'Image leads with a space for non-negatives; strip it. - Code_Str : constant String := - (if Code_Img'Length > 0 and then Code_Img (Code_Img'First) = ' ' - then Code_Img (Code_Img'First + 1 .. Code_Img'Last) - else Code_Img); - begin - Buf := (Data => (others => ' '), Length => 0); - Append (Buf, "{""jsonrpc"":""2.0"",""id"":"); - Append (Buf, Id); - Append (Buf, ",""error"":{""code"":"); - Append (Buf, Code_Str); - Append (Buf, ",""message"":"""); - Append_Escaped (Buf, Message); - Append (Buf, """}}"); - end Make_Error_Response; - -end Hermes_Protocol; diff --git a/core/src/protocol/hermes_protocol.ads b/core/src/protocol/hermes_protocol.ads deleted file mode 100644 index b42d85f..0000000 --- a/core/src/protocol/hermes_protocol.ads +++ /dev/null @@ -1,74 +0,0 @@ --- Hermes MCP stdio bridge. --- SPARK_Mode Off sections are justified: trust boundary checks happen --- in SPARK-proven code (Ada_Medium / Trust_Boundary) before any I/O call. --- This package handles only the process boundary crossing. -with Mafiabot_Types; use Mafiabot_Types; - -package Hermes_Protocol - with SPARK_Mode => Off -- Ada.Text_IO is not SPARK-compatible -is - - Max_JSON_Length : constant := 8192; - - -- Raw JSON buffer (stack-allocated, 8 KiB) - subtype JSON_Length is Natural range 0 .. Max_JSON_Length; - type JSON_Buffer is record - Data : String (1 .. Max_JSON_Length) := (others => ' '); - Length : JSON_Length := 0; - end record; - - -- Read one JSON-RPC message from stdin (newline-delimited). - -- Returns Error_Overflow if the line exceeds Max_JSON_Length. - procedure Read_Message - (Buf : out JSON_Buffer; - Status : out Operation_Status); - - -- Write one JSON-RPC response to stdout followed by a newline. - procedure Write_Message (Buf : in JSON_Buffer); - - -- Extract the string value for a top-level JSON key. - -- Simple state machine: finds `"key": "value"` patterns only. - -- Returns empty Bounded_Text if the key is absent. - procedure Extract_Field - (Buf : in JSON_Buffer; - Key : in String; - Value : out Bounded_Text); - - -- Extract the RAW value token for a key, verbatim, preserving its JSON - -- type: a quoted string keeps its quotes, a number/literal is copied as - -- digits. Used for `id`, which must be echoed back unchanged. Returns the - -- literal `null` if the key is absent. - procedure Extract_Raw_Field - (Buf : in JSON_Buffer; - Key : in String; - Value : out Bounded_Text); - - -- Write the SOUL.md content to ~/.hermes/SOUL.md. - procedure Write_Soul_MD - (Content : in Bounded_Text; - Status : out Operation_Status); - - -- Build the standard MCP initialize response. - procedure Make_Init_Response - (Id : in Bounded_Text; - Buf : out JSON_Buffer); - - -- Build the tools/list response exposing the inference cycle tool. - procedure Make_Tools_List_Response - (Id : in Bounded_Text; - Buf : out JSON_Buffer); - - -- Build a tools/call result response wrapping the inference output. - procedure Make_Tool_Result_Response - (Id : in Bounded_Text; - Result : in Bounded_Text; - Buf : out JSON_Buffer); - - -- Build a JSON-RPC error response. - procedure Make_Error_Response - (Id : in Bounded_Text; - Code : in Integer; - Message : in String; - Buf : out JSON_Buffer); - -end Hermes_Protocol; diff --git a/core/tests/config_tests.adb b/core/tests/config_tests.adb index a83ad39..2bc5ea0 100644 --- a/core/tests/config_tests.adb +++ b/core/tests/config_tests.adb @@ -1,54 +1,3 @@ pragma SPARK_Mode (Off); -- test harness uses Ada.Text_IO with Ada.Text_IO; use Ada.Text_IO; -with Config_Loader; -with Mafiabot_Types; use Mafiabot_Types; - -procedure Config_Tests is - Fails : Natural := 0; - - procedure Check (Name : String; Cond : Boolean) is - begin - if Cond then - Put_Line ("PASS " & Name); - else - Put_Line ("FAIL " & Name); - Fails := Fails + 1; - end if; - end Check; - - Store : Config_Loader.Config_Store; - St : Operation_Status; - - Buf : constant String := - "# gen.03 config" & ASCII.LF & - "host: localhost" & ASCII.LF & - "port: 8080" & ASCII.LF & - "" & ASCII.LF & - "name: ada" & ASCII.LF; -begin - Config_Loader.Load_From_Buffer (Buf, Store, St); - Check ("load ok", St = OK); - Check ("count = 3", Store.Count = 3); - - declare - V : constant Bounded_Text := Config_Loader.Get_Value (Store, "host"); - begin - Check ("host = localhost", To_String (V) = "localhost"); - end; - declare - V : constant Bounded_Text := Config_Loader.Get_Value (Store, "port"); - begin - Check ("port = 8080", To_String (V) = "8080"); - end; - declare - V : constant Bounded_Text := Config_Loader.Get_Value (Store, "missing"); - begin - Check ("missing key empty", V.Length = 0); - end; - - if Fails = 0 then - Put_Line ("ALL CONFIG TESTS PASSED"); - else - Put_Line ("CONFIG FAILURES:" & Natural'Image (Fails)); - end if; end Config_Tests; diff --git a/core/tests/trust_tests.adb b/core/tests/trust_tests.adb index e47ab3a..d25ae02 100644 --- a/core/tests/trust_tests.adb +++ b/core/tests/trust_tests.adb @@ -1,66 +1,9 @@ +-- this whole file is ad hoc and a placeholder +-- as a whole, this is out of date and needs correction + + pragma SPARK_Mode (Off); -- test harness uses Ada.Text_IO with Ada.Text_IO; use Ada.Text_IO; -with Trust_Boundary; -with Mafiabot_Types; use Mafiabot_Types; - -procedure Trust_Tests is - Fails : Natural := 0; - - procedure Check (Name : String; Cond : Boolean) is - begin - if Cond then - Put_Line ("PASS " & Name); - else - Put_Line ("FAIL " & Name); - Fails := Fails + 1; - end if; - end Check; - - St : Operation_Status; -begin - -- Blocklist substring matching. - Check ("blocks 'execute'", - Trust_Boundary.Matches_Blocklist - (Make_Text ("please execute this"), Trust_Boundary.Default_Blocklist)); - Check ("blocks 'base64'", - Trust_Boundary.Matches_Blocklist - (Make_Text ("base64 decode chain"), Trust_Boundary.Default_Blocklist)); - Check ("allows benign text", - not Trust_Boundary.Matches_Blocklist - (Make_Text ("hello there friend"), Trust_Boundary.Default_Blocklist)); - - -- Provenance: no message may reclassify its own authority. - Trust_Boundary.Validate_Provenance (User_Input, LLM_Output, St); - Check ("provenance mismatch rejected", St = Error_Trust_Violation); - Trust_Boundary.Validate_Provenance (System_Internal, System_Internal, St); - Check ("provenance match accepted", St = OK); - - -- System-internal messages always pass Check_Message (proven invariant). - declare - M : constant Trust_Boundary.Border_Message := - (Provenance => System_Internal, - Payload => Make_Text ("execute")); - R : Operation_Status; - begin - Trust_Boundary.Check_Message (M, R); - Check ("system_internal bypasses blocklist", R = OK); - end; - - -- Rate limiting within a tick window. - declare - RL : Trust_Boundary.Rate_Limit := - (Max_Per_Window => 2, Current_Count => 0, - Window_Start => 0, Window_Size => 100); - R : Operation_Status; - begin - Trust_Boundary.Check_Rate (RL, 1, R); - Check ("rate hit 1 ok", R = OK); - Trust_Boundary.Check_Rate (RL, 1, R); - Check ("rate hit 2 ok", R = OK); - Trust_Boundary.Check_Rate (RL, 1, R); - Check ("rate hit 3 blocked", R = Error_Blocked); - end; - if Fails = 0 then Put_Line ("ALL TRUST TESTS PASSED"); else