mirror of
https://github.com/SHOGGOTH-SECTOR/sica-fondt.git
synced 2026-09-30 01:15:10 +00:00
Add Gen.03 organ-systems core: Ada Medium, Soul/Tarot, trust boundary, Hermes MCP bridge
Implements the Gen.03 organ-systems body in SPARK/Ada (Jorvik, No_Exceptions): - Shared types (mafiabot_types): Bounded_Text, Operation_Status, Organ_Id, Provenance_Tag, fixed-point drive/ratio/cost/axis types. - Config loader: SPARK-safe flat key-value parser (no heap/exceptions/finalization). - Trust boundary: blocklist substring matching, provenance enforcement, tick-based rate limiting, Trust_Guard protected object. - Soul / Silicon Dawn Tarot: 56-card alphabet, Celtic Cross spread, Big-3 identity anchors. The cross accretes from the cognitive loops (2 cards per layer at steps 6/9/13, stave of 4 at step 17) rather than being drawn whole. - Sessions: Soul_State is now keyed by (uid, channel, server). Each session has its own card pool, cross, and output counter; the Big-3 identity is global. A formed cross is held for the session (or 17 outputs, whichever is longer). Two users on two channels never share a deck or a cross. - Ada Medium: 23-step forward-only inference cycle wiring the cognitive loops, Celtic Cross injection, and outbound trust screening per session. - Hermes MCP stdio bridge: JSON-RPC over stdin/stdout (initialize, tools/list, tools/call), SOUL.md generation, verbatim id echo. SPARK_Mode Off for I/O; trust checks run in proven code first. - Main driver: organ init -> SOUL.md publish -> MCP serve loop. - Tests: soul, trust, cycle (session formation/isolation), config. Fixes an orchestrator bug where step 1 advanced onto Phase_Input after Reset, failing every cycle. Note: requires GNAT/Alire to build; no Ada toolchain in this environment, so compilation and gnatprove must run in CI.
This commit is contained in:
gravermistakes
@@ -0,0 +1,54 @@
|
||||
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;
|
||||
@@ -0,0 +1,96 @@
|
||||
pragma SPARK_Mode (Off); -- test harness uses Ada.Text_IO
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Soul.Tarot;
|
||||
with Soul.State;
|
||||
with Ada_Medium;
|
||||
with Mafiabot_Types; use Mafiabot_Types;
|
||||
|
||||
procedure Cycle_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;
|
||||
|
||||
B3 : constant Soul.Tarot.Big_Three :=
|
||||
(Sun => (Kind => Soul.Tarot.Major, Major_Value => Soul.Tarot.The_Sun),
|
||||
Moon => (Kind => Soul.Tarot.Major, Major_Value => Soul.Tarot.The_Moon),
|
||||
Ascendant => (Kind => Soul.Tarot.Major,
|
||||
Major_Value => Soul.Tarot.SD_Singularity));
|
||||
|
||||
St : Operation_Status;
|
||||
begin
|
||||
Soul.State.Soul_State.Initialize_Big_Three (B3, St);
|
||||
Check ("identity init ok", St = OK);
|
||||
|
||||
declare
|
||||
R : Operation_Status;
|
||||
begin
|
||||
Soul.State.Soul_State.Initialize_Big_Three (B3, R);
|
||||
Check ("double init rejected", R = Error_Already_Init);
|
||||
end;
|
||||
|
||||
-- Session A: full cycle forms and holds the cross.
|
||||
declare
|
||||
Key : constant Bounded_Text :=
|
||||
Soul.State.Make_Session_Key ("alice", "telegram", "srv1");
|
||||
Out1 : Bounded_Text;
|
||||
Ref : Soul.State.Session_Ref;
|
||||
R : Operation_Status;
|
||||
begin
|
||||
Ada_Medium.Run_Inference_Cycle (Key, Make_Text ("hello"), Out1, R);
|
||||
Check ("session A cycle ok", R = OK);
|
||||
Check ("session A output non-empty", Out1.Length > 0);
|
||||
|
||||
Soul.State.Soul_State.Open_Session (Key, Ref, R);
|
||||
Check ("session A reopen ok", R = OK and then Ref in Soul.State.Valid_Session);
|
||||
Check ("session A cross formed",
|
||||
Soul.State.Soul_State.Is_Spread_Formed (Ref));
|
||||
Check ("session A output count = 1",
|
||||
Soul.State.Soul_State.Output_Count (Ref) = 1);
|
||||
end;
|
||||
|
||||
-- Session A again: cross is HELD (already formed), counter advances.
|
||||
declare
|
||||
Key : constant Bounded_Text :=
|
||||
Soul.State.Make_Session_Key ("alice", "telegram", "srv1");
|
||||
Out2 : Bounded_Text;
|
||||
Ref : Soul.State.Session_Ref;
|
||||
R : Operation_Status;
|
||||
begin
|
||||
Ada_Medium.Run_Inference_Cycle (Key, Make_Text ("again"), Out2, R);
|
||||
Check ("session A second cycle ok", R = OK);
|
||||
Soul.State.Soul_State.Open_Session (Key, Ref, R);
|
||||
Check ("session A output count = 2",
|
||||
Soul.State.Soul_State.Output_Count (Ref) = 2);
|
||||
end;
|
||||
|
||||
-- Session B: a different (uid, channel, server) is fully independent.
|
||||
declare
|
||||
Key : constant Bounded_Text :=
|
||||
Soul.State.Make_Session_Key ("bob", "discord", "srv2");
|
||||
Out3 : Bounded_Text;
|
||||
Ref : Soul.State.Session_Ref;
|
||||
R : Operation_Status;
|
||||
begin
|
||||
Ada_Medium.Run_Inference_Cycle (Key, Make_Text ("hi"), Out3, R);
|
||||
Check ("session B cycle ok", R = OK);
|
||||
Soul.State.Soul_State.Open_Session (Key, Ref, R);
|
||||
Check ("session B output count = 1",
|
||||
Soul.State.Soul_State.Output_Count (Ref) = 1);
|
||||
end;
|
||||
|
||||
Check ("two live sessions", Soul.State.Soul_State.Session_Count = 2);
|
||||
|
||||
if Fails = 0 then
|
||||
Put_Line ("ALL CYCLE TESTS PASSED");
|
||||
else
|
||||
Put_Line ("CYCLE FAILURES:" & Natural'Image (Fails));
|
||||
end if;
|
||||
end Cycle_Tests;
|
||||
@@ -0,0 +1,68 @@
|
||||
pragma SPARK_Mode (Off); -- test harness uses Ada.Text_IO
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Soul.Tarot;
|
||||
with Soul.Celtic_Cross;
|
||||
with Mafiabot_Types; use Mafiabot_Types;
|
||||
|
||||
procedure Soul_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;
|
||||
|
||||
B3 : constant Soul.Tarot.Big_Three :=
|
||||
(Sun => (Kind => Soul.Tarot.Major, Major_Value => Soul.Tarot.The_Sun),
|
||||
Moon => (Kind => Soul.Tarot.Major, Major_Value => Soul.Tarot.The_Moon),
|
||||
Ascendant => (Kind => Soul.Tarot.Major,
|
||||
Major_Value => Soul.Tarot.SD_Singularity));
|
||||
|
||||
D : Soul.Tarot.Deck := Soul.Tarot.Full_Deck;
|
||||
St : Operation_Status;
|
||||
begin
|
||||
Check ("full deck = 56", Soul.Tarot.Present_Count (D) = 56);
|
||||
Check ("big-3 distinct", Soul.Tarot.Big_Three_Distinct (B3));
|
||||
|
||||
Soul.Tarot.Remove_Big_Three (D, B3, St);
|
||||
Check ("remove big-3 ok", St = OK);
|
||||
Check ("pool = 53", Soul.Tarot.Present_Count (D) = 53);
|
||||
|
||||
-- The cross accretes layer by layer (2 + 2 + 2 + stave of 4).
|
||||
declare
|
||||
Sp : Soul.Celtic_Cross.CC_Spread := Soul.Celtic_Cross.Empty_Spread;
|
||||
L1, L2, L3, Lv : Operation_Status;
|
||||
begin
|
||||
Check ("empty spread has no Present slot",
|
||||
Sp (Soul.Celtic_Cross.Present).State = Soul.Tarot.Absent);
|
||||
|
||||
Soul.Celtic_Cross.Draw_Layer (D, Sp, Soul.Celtic_Cross.Layer_1, L1);
|
||||
Check ("layer 1 ok", L1 = OK);
|
||||
Check ("pool = 51 after layer 1", Soul.Tarot.Present_Count (D) = 51);
|
||||
Check ("Present filled",
|
||||
Sp (Soul.Celtic_Cross.Present).State = Soul.Tarot.Present);
|
||||
Check ("Challenge filled",
|
||||
Sp (Soul.Celtic_Cross.Challenge).State = Soul.Tarot.Present);
|
||||
Check ("Outcome still empty",
|
||||
Sp (Soul.Celtic_Cross.Outcome).State = Soul.Tarot.Absent);
|
||||
|
||||
Soul.Celtic_Cross.Draw_Layer (D, Sp, Soul.Celtic_Cross.Layer_2, L2);
|
||||
Soul.Celtic_Cross.Draw_Layer (D, Sp, Soul.Celtic_Cross.Layer_3, L3);
|
||||
Soul.Celtic_Cross.Draw_Layer (D, Sp, Soul.Celtic_Cross.Stave, Lv);
|
||||
Check ("layers 2/3/stave ok", L2 = OK and then L3 = OK and then Lv = OK);
|
||||
Check ("pool = 43 after full cross", Soul.Tarot.Present_Count (D) = 43);
|
||||
Check ("Outcome filled after stave",
|
||||
Sp (Soul.Celtic_Cross.Outcome).State = Soul.Tarot.Present);
|
||||
end;
|
||||
|
||||
if Fails = 0 then
|
||||
Put_Line ("ALL SOUL TESTS PASSED");
|
||||
else
|
||||
Put_Line ("SOUL FAILURES:" & Natural'Image (Fails));
|
||||
end if;
|
||||
end Soul_Tests;
|
||||
@@ -0,0 +1,71 @@
|
||||
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.Organ_Message :=
|
||||
(Source => Ada_Medium,
|
||||
Destination => Soul_Organ,
|
||||
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
|
||||
Put_Line ("TRUST FAILURES:" & Natural'Image (Fails));
|
||||
end if;
|
||||
end Trust_Tests;
|
||||
Reference in New Issue
Block a user