test/test-tools.sgl

1(import (sigil test)

2 (sigil string)

3 (sigil env)

4 (sigil process)

5 (sigil mcp server)

6 (sigil mcp protocol)

7 (apiary markdown-irc)

8 (apiary tools))

10;; A literal backslash-n as it actually arrives from an LLM caller:

11;; the two characters #\\ and #\n, NOT a real newline.

12(define lit-nl (string #\\ #\n))

14;; Drive a tools/list JSON-RPC request through the server and read

15;; the entries the response advertises. This is the same path the

16;; MCP client hits during init — proves clients see the full tool

17;; surface even when the bridge hasn't connected.

18(define (advertised-tool-names server)

19 (let* ((req (jsonrpc-request id: 1 method: "tools/list" params: '()))

20 (resp (mcp-server-handle-message server req))

21 (result (jsonrpc-response-result resp))

22 (tools (or (assoc-ref 'tools result) '())))

23 (map (lambda (t) (assoc-ref 'name t)) tools)))

25;; ============================================================

26;; Bridge state defaults

27;; ============================================================

29(test-group "enclave-bridge-state"

30 (test "defaults"

31 (let ((s (make-enclave-bridge-state)))

32 (assert-false (enclave-bridge-state-conn s))

33 (assert-false (enclave-bridge-state-config s))

34 (assert-equal 'leader (enclave-bridge-state-mode s))

35 (assert-false (enclave-bridge-state-owner-nick s))

36 (assert-false (enclave-bridge-state-reports-to s))

37 (assert-equal '() (enclave-bridge-state-subordinates s))

38 (assert-equal '() (enclave-bridge-state-listened-peers s)))))

40;; ============================================================

41;; Mention syntax parser

42;; ============================================================

44(test-group "parse-mention-prefix"

45 (test "extracts nick from @-prefixed mention"

46 (call-with-values

47 (lambda () (parse-mention-prefix "@alice: hello there"))

48 (lambda (addressee body)

49 (assert-equal "alice" addressee)

50 (assert-equal "hello there" body))))

52 (test "tolerates dashes and underscores in nick"

53 (call-with-values

54 (lambda () (parse-mention-prefix "@worker-bot_3: ack"))

55 (lambda (addressee body)

56 (assert-equal "worker-bot_3" addressee)

57 (assert-equal "ack" body))))

59 (test "rejects bare nick:body when my-nick not provided (legacy mode)"

60 ;; Without my-nick context, only the legacy @-prefixed form is

61 ;; recognized — bare nick:body falls through to broadcast.

62 (call-with-values

63 (lambda () (parse-mention-prefix "alice: hello"))

64 (lambda (addressee body)

65 (assert-false addressee)

66 (assert-equal "alice: hello" body))))

68 (test "rejects unprefixed text"

69 (call-with-values

70 (lambda () (parse-mention-prefix "no prefix here"))

71 (lambda (addressee body)

72 (assert-false addressee)

73 (assert-equal "no prefix here" body))))

75 (test "rejects @ alone"

76 (call-with-values

77 (lambda () (parse-mention-prefix "@"))

78 (lambda (addressee body)

79 (assert-false addressee)

80 (assert-equal "@" body))))

82 (test "rejects @: with no nick"

83 (call-with-values

84 (lambda () (parse-mention-prefix "@: empty"))

85 (lambda (addressee body)

86 (assert-false addressee)

87 (assert-equal "@: empty" body))))

89 (test "rejects colon without trailing space"

90 (call-with-values

91 (lambda () (parse-mention-prefix "@alice:no-space"))

92 (lambda (addressee body)

93 (assert-false addressee)

94 (assert-equal "@alice:no-space" body))))

96 (test "rejects nick with invalid chars"

97 (call-with-values

98 (lambda () (parse-mention-prefix "@[admin]: text"))

99 (lambda (addressee body)

100 (assert-false addressee)

101 (assert-equal "@[admin]: text" body))))

102

103 (test "tolerates colons in body (no ambiguity)"

104 (call-with-values

105 (lambda () (parse-mention-prefix "@bee-3: STARTED: phase 1"))

106 (lambda (addressee body)

107 (assert-equal "bee-3" addressee)

108 (assert-equal "STARTED: phase 1" body))))

109

110 (test "handles non-string input"

111 (call-with-values

112 (lambda () (parse-mention-prefix #f))

113 (lambda (addressee body)

114 (assert-false addressee)

115 (assert-false body)))))

116

117;; ============================================================

118;; IRC-native bare mention parsing (v0.1.6+)

119;;

120;; With my-nick passed, parse-mention-prefix recognizes the IRC-native

121;; bare `<my-nick>: <body>` form. Tokens that don't match my-nick fall

122;; through to broadcast — apiary doesn't track channel membership, so

123;; the my-nick gate is the load-bearing safety net against

124;; misclassifying prose like "note: write this down" as a mention.

125;; ============================================================

126

127(test-group "parse-mention-prefix (IRC-native bare form)"

128 (test "bare nick:body is mention when nick equals my-nick"

129 (call-with-values

130 (lambda () (parse-mention-prefix "quinn: ping" "quinn"))

131 (lambda (addressee body)

132 (assert-equal "quinn" addressee)

133 (assert-equal "ping" body))))

134

135 (test "bare match is case-insensitive"

136 (call-with-values

137 (lambda () (parse-mention-prefix "Quinn: PING" "quinn"))

138 (lambda (addressee body)

139 (assert-equal "quinn" addressee)

140 (assert-equal "PING" body))))

141

142 (test "bare nick:body is broadcast when nick != my-nick"

143 (call-with-values

144 (lambda () (parse-mention-prefix "alice: hello" "quinn"))

145 (lambda (addressee body)

146 (assert-false addressee)

147 (assert-equal "alice: hello" body))))

148

149 (test "broadcast: prose-shaped nick:body (not actually a mention)"

150 (call-with-values

151 (lambda () (parse-mention-prefix "note: write this down" "quinn"))

152 (lambda (addressee body)

153 (assert-false addressee)

154 (assert-equal "note: write this down" body))))

155

156 (test "broadcast: token has whitespace (foo bar: ...)"

157 (call-with-values

158 (lambda () (parse-mention-prefix "foo bar: hello" "foo"))

159 (lambda (addressee body)

160 (assert-false addressee)

161 (assert-equal "foo bar: hello" body))))

162

163 (test "broadcast: no space after colon (key:value)"

164 (call-with-values

165 (lambda () (parse-mention-prefix "quinn:value" "quinn"))

166 (lambda (addressee body)

167 (assert-false addressee)

168 (assert-equal "quinn:value" body))))

169

170 (test "broadcast: mid-line nick: pattern is not a mention"

171 (call-with-values

172 (lambda () (parse-mention-prefix "Hello, quinn: how are you?" "quinn"))

173 (lambda (addressee body)

174 (assert-false addressee)

175 (assert-equal "Hello, quinn: how are you?" body))))

176

177 (test "legacy @<nick>: form still parsed for any nick (deprecation)"

178 ;; During the v0.2.x deprecation window, legacy @-prefixed mentions

179 ;; continue to parse for any token regardless of my-nick. Removed

180 ;; in v0.3.0 cleanup.

181 (call-with-values

182 (lambda () (parse-mention-prefix "@bee-3: ack" "quinn"))

183 (lambda (addressee body)

184 (assert-equal "bee-3" addressee)

185 (assert-equal "ack" body))))

186

187 (test "bare body may be empty"

188 (call-with-values

189 (lambda () (parse-mention-prefix "quinn: " "quinn"))

190 (lambda (addressee body)

191 (assert-equal "quinn" addressee)

192 (assert-equal "" body)))))

193

194;; ============================================================

195;; Mention formatter (v0.1.6: bare nick: form, no @ prefix)

196;; ============================================================

197

198(test-group "format-mention"

199 (test "wraps body with bare <nick>: prefix (no @)"

200 (assert-equal "bee-3: please proceed"

201 (format-mention "bee-3" "please proceed")))

202

203 (test "round-trips through parse-mention-prefix when my-nick matches"

204 (call-with-values

205 (lambda () (parse-mention-prefix

206 (format-mention "worker-7" "ack")

207 "worker-7"))

208 (lambda (addressee body)

209 (assert-equal "worker-7" addressee)

210 (assert-equal "ack" body)))))

211

212;; ============================================================

213;; Literal backslash-n normalization (outbound newline fix)

214;;

215;; LLM callers frequently pass a literal "\n" (two chars: #\\ #\n)

216;; where they mean a line break. Without normalization the literal

217;; never triggers the per-line split, and — on the DM path — the

218;; markdown->mIRC escape pass then strips the backslash, leaving a

219;; stray "n" where the break belonged (observed 2026-07-08:

220;; "...marketing.nnTrashed..."). normalize-literal-newlines runs at

221;; both outbound entry points BEFORE any markdown translation or line

222;; split, so send-message (DM) and send-channel both benefit.

223;; ============================================================

224

225(test-group "normalize-literal-newlines"

226 (test "converts a literal backslash-n to a real newline"

227 (assert-equal "a\nb"

228 (normalize-literal-newlines (string-append "a" lit-nl "b"))))

229

230 (test "a real newline is left untouched (no double-conversion)"

231 (assert-equal "a\nb"

232 (normalize-literal-newlines "a\nb")))

233

234 (test "converts every literal occurrence"

235 (assert-equal "one\ntwo\nthree"

236 (normalize-literal-newlines

237 (string-append "one" lit-nl "two" lit-nl "three"))))

238

239 (test "no literal present: string returned unchanged"

240 (assert-equal "no breaks here"

241 (normalize-literal-newlines "no breaks here")))

242

243 (test "a lone backslash (not followed by n) is preserved"

244 (assert-equal (string #\\ #\x)

245 (normalize-literal-newlines (string #\\ #\x))))

246

247 (test "non-string input passes through"

248 (assert-false (normalize-literal-newlines #f)))

249

250 ;; End-to-end shape checks — these mirror what the two outbound

251 ;; helpers do to the text before handing it to enclave-post-multiline.

252

253 (test "send-channel path: normalized literal splits into multiple lines"

254 ;; enclave-bridge-send-channel! normalizes, then splits on real "\n".

255 (let* ((raw (string-append "first" lit-nl "second"))

256 (lines (string-split (normalize-literal-newlines raw) "\n")))

257 (assert-equal 2 (length lines))

258 (assert-equal "first" (car lines))

259 (assert-equal "second" (cadr lines))))

260

261 (test "send-message (DM) path: normalize before markdown, then split"

262 ;; enclave-bridge-send-dm! normalizes, runs markdown->irc, then

263 ;; splits. Before the fix the markdown escape pass ate the

264 ;; backslash and the whole message stayed a single "firstnsecond"

265 ;; line. After it, two lines survive.

266 (let* ((raw (string-append "first" lit-nl "second"))

267 (rendered (markdown->irc (normalize-literal-newlines raw)))

268 (lines (string-split rendered "\n")))

269 (assert-equal 2 (length lines))

270 (assert-equal "first" (car lines))

271 (assert-equal "second" (cadr lines))))

272

273 (test "regression: without normalization the DM path collapses to one line"

274 ;; Documents the bug: feeding the raw literal straight to

275 ;; markdown->irc yields a single line whose break became a bare "n".

276 (let* ((raw (string-append "first" lit-nl "second"))

277 (rendered (markdown->irc raw))

278 (lines (string-split rendered "\n")))

279 (assert-equal 1 (length lines))

280 (assert-equal "firstnsecond" (car lines)))))

281

282;; ============================================================

283;; Trusted-set predicate

284;; ============================================================

285

286;; ============================================================

287;; register-apiary-tools! — capability declaration

288;;

289;; Registration is gated on APIARY_MODE alone, not on

290;; enclave-config-ready or on a live bridge connection. The MCP

291;; tools/list response at init must expose the full mode-appropriate

292;; tool set so clients with `tools.listChanged: false` see the right

293;; surface from the first reply. Tool *calls* that need a live

294;; bridge handle that runtime concern themselves.

295;; ============================================================

296

297(test-group "register-apiary-tools! mode-driven registration"

298 (test "leader mode registers all 9 tools, no live bridge required"

299 (let* ((server (mcp-server name: "x" version: "1.0"))

300 (state (make-enclave-bridge-state)))

301 (set-enclave-bridge-state-mode! state 'leader)

302 (register-apiary-tools! server state)

303 (let ((tool-names (advertised-tool-names server)))

304 (assert-equal 9 (length tool-names))

305 (assert-true (member "spawn-worker" tool-names))

306 (assert-true (member "revoke-worker" tool-names))

307 (assert-true (member "rotate-token" tool-names))

308 (assert-true (member "list-members" tool-names))

309 (assert-true (member "send-channel" tool-names))

310 (assert-true (member "send-message" tool-names))

311 (assert-true (member "send-react" tool-names))

312 (assert-true (member "listen-peer" tool-names))

313 (assert-true (member "unlisten-peer" tool-names)))))

314

315 (test "worker mode registers only the 4 worker tools"

316 (let* ((server (mcp-server name: "x" version: "1.0"))

317 (state (make-enclave-bridge-state)))

318 (set-enclave-bridge-state-mode! state 'worker)

319 (register-apiary-tools! server state)

320 (let ((tool-names (advertised-tool-names server)))

321 (assert-equal 4 (length tool-names))

322 (assert-true (member "send-channel" tool-names))

323 (assert-true (member "send-react" tool-names))

324 (assert-true (member "listen-peer" tool-names))

325 (assert-true (member "unlisten-peer" tool-names))

326 ;; Leader-only tools must NOT appear in worker mode.

327 (assert-false (member "spawn-worker" tool-names))

328 (assert-false (member "send-message" tool-names))

329 (assert-false (member "rotate-token" tool-names)))))

330

331 (test "registration is independent of enclave-config / bridge state"

332 ;; No config set, no conn — registration should still succeed

333 ;; and the full leader tool set should appear.

334 (let* ((server (mcp-server name: "x" version: "1.0"))

335 (state (make-enclave-bridge-state)))

336 (set-enclave-bridge-state-mode! state 'leader)

337 (assert-false (enclave-bridge-state-config state))

338 (assert-false (enclave-bridge-state-conn state))

339 (register-apiary-tools! server state)

340 (assert-equal 9 (length (advertised-tool-names server))))))

341

342(test-group "tool-call error path before bridge connects"

343 (test "send-channel returns informative error when bridge isn't connected"

344 (let ((state (make-enclave-bridge-state)))

345 ;; No conn set — direct call into the helper exercises the

346 ;; same path the registered tool's lambda hits.

347 (let ((result (enclave-bridge-send-channel! state #f "hello")))

348 (assert-true (string? result))

349 (assert-true (string-contains? result "not connected"))))))

350

351;; ============================================================

352;; Bug A — spawn-worker groups defaulting

353;;

354;; or-empty-env (caller-arg env-name) is the resolution shape used

355;; by spawn-worker for its `groups` argument: explicit non-empty

356;; arg wins, else the env var, else #f. Empty string is treated

357;; as "not provided" (the same as #f) so an MCP caller passing

358;; `groups: ""` falls back to the env default rather than

359;; sending an explicit no-group request.

360;; ============================================================

361

362(test-group "or-empty-env (groups defaulting helper)"

363 (test "non-empty arg wins over env"

364 (setenv! "APIARY_TEST_GROUP_AB" "from-env")

365 (assert-equal "from-arg"

366 (or-empty-env "from-arg" "APIARY_TEST_GROUP_AB"))

367 (setenv! "APIARY_TEST_GROUP_AB" ""))

368

369 (test "missing arg falls back to env"

370 (setenv! "APIARY_TEST_GROUP_AC" "ops-workers")

371 (assert-equal "ops-workers"

372 (or-empty-env #f "APIARY_TEST_GROUP_AC"))

373 (setenv! "APIARY_TEST_GROUP_AC" ""))

374

375 (test "empty-string arg falls back to env (NOT treated as explicit)"

376 (setenv! "APIARY_TEST_GROUP_AD" "ops-workers")

377 (assert-equal "ops-workers"

378 (or-empty-env "" "APIARY_TEST_GROUP_AD"))

379 (setenv! "APIARY_TEST_GROUP_AD" ""))

380

381 (test "missing arg + unset env returns #f"

382 ;; Use a never-touched name so it's reliably unset.

383 (assert-false (or-empty-env #f "APIARY_TEST_GROUP_NEVER_SET")))

384

385 (test "missing arg + empty-string env returns #f"

386 (setenv! "APIARY_TEST_GROUP_AF" "")

387 (assert-false (or-empty-env #f "APIARY_TEST_GROUP_AF")))

388

389 (test "non-string arg falls back to env"

390 (setenv! "APIARY_TEST_GROUP_AG" "fallback")

391 (assert-equal "fallback"

392 (or-empty-env 42 "APIARY_TEST_GROUP_AG"))

393 (setenv! "APIARY_TEST_GROUP_AG" "")))

394

395(test-group "env-or-false"

396 (test "returns env value when set and non-empty"

397 (setenv! "APIARY_TEST_EOB" "yes")

398 (assert-equal "yes" (env-or-false "APIARY_TEST_EOB"))

399 (setenv! "APIARY_TEST_EOB" ""))

400

401 (test "returns #f when unset"

402 (assert-false (env-or-false "APIARY_TEST_EOB_NEVER_SET")))

403

404 (test "returns #f when set to empty string"

405 (setenv! "APIARY_TEST_EOB_EMPTY" "")

406 (assert-false (env-or-false "APIARY_TEST_EOB_EMPTY"))))

407

408(test-group "trusted-sender?"

409 (test "owner is trusted (case-insensitive)"

410 (let ((s (make-enclave-bridge-state)))

411 (set-enclave-bridge-state-owner-nick! s "daviwil")

412 (assert-true (trusted-sender? s "daviwil"))

413 (assert-true (trusted-sender? s "DAVIWIL"))

414 (assert-true (trusted-sender? s "Daviwil"))

415 (assert-false (trusted-sender? s "stranger"))))

416

417 (test "reports-to is trusted"

418 (let ((s (make-enclave-bridge-state)))

419 (set-enclave-bridge-state-reports-to! s "quinn")

420 (assert-true (trusted-sender? s "quinn"))

421 (assert-true (trusted-sender? s "QUINN"))

422 (assert-false (trusted-sender? s "other"))))

423

424 (test "subordinates are trusted"

425 (let ((s (make-enclave-bridge-state)))

426 (set-enclave-bridge-state-subordinates!

427 s (list "worker-1" "worker-2"))

428 (assert-true (trusted-sender? s "worker-1"))

429 (assert-true (trusted-sender? s "WORKER-2"))

430 (assert-false (trusted-sender? s "worker-3"))))

431

432 (test "listened-peers are trusted"

433 (let ((s (make-enclave-bridge-state)))

434 (set-enclave-bridge-state-listened-peers!

435 s (list "bee-3" "bee-7"))

436 (assert-true (trusted-sender? s "bee-3"))

437 (assert-true (trusted-sender? s "BEE-7"))

438 (assert-false (trusted-sender? s "bee-99"))))

439

440 (test "non-string sender returns #f"

441 (let ((s (make-enclave-bridge-state)))

442 (set-enclave-bridge-state-owner-nick! s "daviwil")

443 (assert-false (trusted-sender? s #f))

444 (assert-false (trusted-sender? s '()))))

445

446 (test "empty trusted set rejects everyone"

447 (let ((s (make-enclave-bridge-state)))

448 (assert-false (trusted-sender? s "anyone"))

449 (assert-false (trusted-sender? s "owner")))))